diff --git a/.Attic/canary_docme/metta_comp_templates.pl b/.Attic/canary_docme/metta_comp_templates.pl new file mode 100644 index 00000000000..f089052ec52 --- /dev/null +++ b/.Attic/canary_docme/metta_comp_templates.pl @@ -0,0 +1,707 @@ +/* + * Project: MeTTaLog - A MeTTa to Prolog Transpiler/Interpreter + * Description: This file is part of the source code for a transpiler designed to convert + * MeTTa language programs into Prolog, utilizing the SWI-Prolog compiler for + * optimizing and transforming function/logic programs. It handles different + * logical constructs and performs conversions between functions and predicates. + * + * Author: Douglas R. Miles + * Contact: logicmoo@gmail.com / dmiles@logicmoo.org + * License: LGPL + * Repository: https://github.com/trueagi-io/metta-wam + * https://github.com/logicmoo/hyperon-wam + * Created Date: 8/23/2023 + * Last Modified: $LastChangedDate$ # You will replace this with Git automation + * + * Usage: This file is a part of the transpiler that transforms MeTTa programs into Prolog. For details + * on how to contribute or use this project, please refer to the repository README or the project documentation. + * + * Contribution: Contributions are welcome! For contributing guidelines, please check the CONTRIBUTING.md + * file in the repository. + * + * Notes: + * - Ensure you have SWI-Prolog installed and properly configured to use this transpiler. + * - This project is under active development, and we welcome feedback and contributions. + * + * Acknowledgments: Special thanks to all contributors and the open source community for their support and contributions. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the + * distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS + * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT + * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS + * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE + * COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, + * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; + * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER + * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN + * ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + * POSSIBILITY OF SUCH DAMAGE. + */ + + + +% # 1. Length of a List +% % Normal Recursive +% prolog +len([], 0). +len([_|T], N) :- + len(T, X), + N is X + 1. +% + +% % With Accumulator +% prolog +len_acc(L, N) :- + len_acc(L, 0, N). + +len_acc([], Acc, Acc). +len_acc([_|T], Acc, N) :- + NewAcc is Acc + 1, + len_acc(T, NewAcc, N). +% + +% # 2. Sum of a List +% % Normal Recursive +% prolog +sum([], 0). +sum([H|T], S) :- + sum(T, X), + S is X + H. +% + +% % With Accumulator +% prolog +sum_acc(L, S) :- + sum_acc(L, 0, S). + +sum_acc([], Acc, Acc). +sum_acc([H|T], Acc, S) :- + NewAcc is Acc + H, + sum_acc(T, NewAcc, S). +% + +% # 3. Factorial +% % Normal Recursive +% prolog +factorial(0, 1). +factorial(N, F) :- + N > 0, + X is N - 1, + factorial(X, Y), + F is N * Y. +% + +% % With Accumulator +% prolog +factorial_acc(N, F) :- + factorial_acc(N, 1, F). + +factorial_acc(0, Acc, Acc). +factorial_acc(N, Acc, F) :- + N > 0, + NewAcc is Acc * N, + NewN is N - 1, + factorial_acc(NewN, NewAcc, F). +% + +% # 4. Reverse List +% % Normal Recursive +% prolog +reverse_list([], []). +reverse_list([H|T], R) :- + reverse_list(T, RevT), + append(RevT, [H], R). +% + +% % With Accumulator +% prolog +reverse_list_acc(L, R) :- + reverse_list_acc(L, [], R). + +reverse_list_acc([], Acc, Acc). +reverse_list_acc([H|T], Acc, R) :- + reverse_list_acc(T, [H|Acc], R). +% + +% # 5. Fibonacci +% % Normal Recursive +% prolog +fibonacci(0, 0). +fibonacci(1, 1). +fibonacci(N, F) :- + N > 1, + N1 is N - 1, + N2 is N - 2, + fibonacci(N1, F1), + fibonacci(N2, F2), + F is F1 + F2. +% + +% % With Accumulator +% prolog +fibonacci_acc(N, F) :- + fibonacci_acc(N, 0, 1, F). + +fibonacci_acc(0, A, _, A). +fibonacci_acc(N, A, B, F) :- + N > 0, + NewN is N - 1, + NewB is A + B, + fibonacci_acc(NewN, B, NewB, F). +% + + + +% 6. Find an Element in a List +% # Normal Recursive +% prolog +element_in_list(X, [X|_]). +element_in_list(X, [_|T]) :- element_in_list(X, T). +% + +% # With Accumulator +% prolog +element_in_list_acc(X, L) :- element_in_list_acc(X, L, false). + +element_in_list_acc(X, [], Acc) :- Acc. +element_in_list_acc(X, [X|_], _) :- true. +element_in_list_acc(X, [_|T], Acc) :- element_in_list_acc(X, T, Acc). +% + +% 7. Check if a List is a Palindrome +% # Normal Recursive +% prolog +is_palindrome(L) :- reverse(L, L). +% + +% # With Accumulator +% prolog +is_palindrome_acc(L) :- reverse_acc(L, [], L). + +reverse_acc([], Acc, Acc). +reverse_acc([H|T], Acc, R) :- reverse_acc(T, [H|Acc], R). +% + +% 8. Calculate the Product of All Elements in a List +% # Normal Recursive +% prolog +product_list([], 1). +product_list([H|T], P) :- + product_list(T, Temp), + P is H * Temp. +% + +% # With Accumulator +% prolog +product_list_acc(L, P) :- product_list_acc(L, 1, P). + +product_list_acc([], Acc, Acc). +product_list_acc([H|T], Acc, P) :- + NewAcc is Acc * H, + product_list_acc(T, NewAcc, P). +% + +% 9. Find the Nth Element of a List +% # Normal Recursive +% prolog +nth_element(1, [H|_], H). +nth_element(N, [_|T], X) :- + N > 1, + M is N - 1, + nth_element(M, T, X). +% + +% # With Accumulator +% prolog +nth_element_acc(N, L, X) :- nth_element_acc(N, L, 1, X). + +nth_element_acc(N, [H|_], N, H). +nth_element_acc(N, [_|T], Acc, X) :- + NewAcc is Acc + 1, + nth_element_acc(N, T, NewAcc, X). +% + +% 10. Count the Occurrences of an Element in a List +% # Normal Recursive +% prolog +count_occurrences(_, [], 0). +count_occurrences(X, [X|T], N) :- + count_occurrences(X, T, M), + N is M + 1. +count_occurrences(X, [Y|T], N) :- + X \= Y, + count_occurrences(X, T, N). +% + +% # With Accumulator +% prolog +count_occurrences_acc(X, L, N) :- count_occurrences_acc(X, L, 0, N). + +count_occurrences_acc(_, [], Acc, Acc). +count_occurrences_acc(X, [X|T], Acc, N) :- + NewAcc is Acc + 1, + count_occurrences_acc(X, T, NewAcc, N). +count_occurrences_acc(X, [Y|T], Acc, N) :- + X \= Y, + count_occurrences_acc(X, T, Acc, N). +% + +% 11. Calculate the Greatest Common Divisor of Two Numbers +% # Normal Recursive +% prolog +gcd(A, 0, A) :- A > 0. +gcd(A, B, GCD) :- + B > 0, + R is A mod B, + gcd(B, R, GCD). +% + +% # With Accumulator +% prolog +gcd_acc(A, B, GCD) :- gcd_acc(A, B, 1, GCD). + +gcd_acc(A, 0, Acc, Acc) :- A > 0. +gcd_acc(A, B, Acc, GCD) :- + B > 0, + R is A mod B, + NewAcc is B * Acc, + gcd_acc(B, R, NewAcc, GCD). +% + +% 12. Check if a Number is Prime +% # Normal Recursive +% prolog +is_prime(2). +is_prime(N) :- + N > 2, + \+ (between(2, sqrt(N), X), N mod X =:= 0). +% + +% # With Accumulator +% prolog +is_prime_acc(N) :- is_prime_acc(N, 2). + +is_prime_acc(2, 2). +is_prime_acc(N, Acc) :- + N > 2, + ( + (Acc * Acc > N, !); + (N mod Acc =\= 0, NewAcc is Acc + 1, is_prime_acc(N, NewAcc)) + ). +% + +% 13. Merge Two Sorted Lists into a Sorted List +% # Normal Recursive +% prolog +merge_sorted([], L, L). +merge_sorted(L, [], L). +merge_sorted([H1|T1], [H2|T2], [H1|M]) :- + H1 =< H2, + merge_sorted(T1, [H2|T2], M). +merge_sorted([H1|T1], [H2|T2], [H2|M]) :- + H1 > H2, + merge_sorted([H1|T1], T2, M). +% + +% # With Accumulator +% prolog +merge_sorted_acc(L1, L2, L) :- merge_sorted_acc(L1, L2, [], L). + +merge_sorted_acc([], L, Acc, L) :- reverse(Acc, L), !. +merge_sorted_acc(L, [], Acc, L) :- reverse(Acc, L), !. +merge_sorted_acc([H1|T1], [H2|T2], Acc, [H|M]) :- + H1 =< H2, + merge_sorted_acc(T1, [H2|T2], [H1|Acc], M). +merge_sorted_acc([H1|T1], [H2|T2], Acc, [H|M]) :- + H1 > H2, + merge_sorted_acc([H1|T1], T2, [H2|Acc], M). + +% + +% 14. Find the Last Element of a List +% # Normal Recursive +% prolog +last_element([H], H). +last_element([_|T], X) :- last_element(T, X). +% + +% # With Accumulator +% prolog +last_element_acc([H|T], X) :- last_element_acc(T, H, X). + +last_element_acc([], Acc, Acc). +last_element_acc([H|T], _, X) :- last_element_acc(T, H, X). +% + +% 15. Remove Duplicate Elements from a List +% # Normal Recursive +% prolog +remove_duplicates([], []). +remove_duplicates([H|T], [H|T1]) :- \+ member(H, T), remove_duplicates(T, T1). +remove_duplicates([_|T], T1) :- remove_duplicates(T, T1). +% + +% # With Accumulator +% prolog +remove_duplicates_acc(L, R) :- remove_duplicates_acc(L, [], R). + +remove_duplicates_acc([], Acc, Acc). +remove_duplicates_acc([H|T], Acc, R) :- + (member(H, Acc) -> remove_duplicates_acc(T, Acc, R); + remove_duplicates_acc(T, [H|Acc], R)). +% + +% 16. Check if a Binary Tree is Balanced +% # Normal Recursive +% prolog +is_balanced(null). +is_balanced(tree(L, _, R)) :- + height(L, Hl), + height(R, Hr), + D is Hl - Hr, + abs(D) =< 1, + is_balanced(L), + is_balanced(R). +% + +% # With Accumulator +% prolog +is_balanced_acc(T) :- is_balanced_acc(T, 0). + +is_balanced_acc(null, 0). +is_balanced_acc(tree(L, _, R), H) :- + is_balanced_acc(L, Hl), + is_balanced_acc(R, Hr), + D is Hl - Hr, + abs(D) =< 1, + H is max(Hl, Hr) + 1. +% + +% 17. Calculate the Height of a Binary Tree +% # Normal Recursive +% prolog +height(null, 0). +height(tree(L, _, R), H) :- + height(L, Hl), + height(R, Hr), + H is max(Hl, Hr) + 1. +% + +% # With Accumulator +% prolog +height_acc(T, H) :- height_acc(T, 0, H). + +height_acc(null, Acc, Acc). +height_acc(tree(L, _, R), Acc, H) :- + NewAcc is Acc + 1, + height_acc(L, NewAcc, Hl), + height_acc(R, NewAcc, Hr), + H is max(Hl, Hr). +% + +% 18. Search for an Element in a Binary Search Tree +% # Normal Recursive +% prolog +search_bst(tree(_, X, _), X). +search_bst(tree(L, Y, _), X) :- + X < Y, + search_bst(L, X). +search_bst(tree(_, Y, R), X) :- + X > Y, + search_bst(R, X). +% + +% # With Accumulator +% prolog +% The accumulator is not very useful here, as the search path is already determined by the BST property. +search_bst_acc(Tree, X) :- search_bst(Tree, X). +% + +% 19. Insert an Element into a Binary Search Tree +% # Normal Recursive +% prolog +insert_bst(null, X, tree(null, X, null)). +insert_bst(tree(L, Y, R), X, tree(L1, Y, R)) :- + X < Y, + insert_bst(L, X, L1). +insert_bst(tree(L, Y, R), X, tree(L, Y, R1)) :- + X > Y, + insert_bst(R, X, R1). +% + +% # With Accumulator +% prolog +% The accumulator is not very useful here, as the insertion path is already determined by the BST property. +insert_bst_acc(Tree, X, NewTree) :- insert_bst(Tree, X, NewTree). +% + +% 20. Delete an Element from a Binary Search Tree +% # Normal Recursive +% prolog +delete_bst(Tree, X, NewTree) :- + remove_bst(Tree, X, NewTree). + +remove_bst(tree(L, X, R), X, Merged) :- merge_trees(L, R, Merged), !. +remove_bst(tree(L, Y, R), X, tree(L1, Y, R)) :- + X < Y, + remove_bst(L, X, L1). +remove_bst(tree(L, Y, R), X, tree(L, Y, R1)) :- + X > Y, + remove_bst(R, X, R1). + +merge_trees(null, Tree, Tree). +merge_trees(Tree, null, Tree). +merge_trees(tree(L1, X, R1), tree(L2, Y, R2), tree(Merged, Y, R2)) :- + merge_trees(tree(L1, X, R1), L2, Merged). +% + +% # With Accumulator +% prolog +% The accumulator is not very useful here, as the deletion path is already determined by the BST property. +delete_bst_acc(Tree, X, NewTree) :- delete_bst(Tree, X, NewTree). +% + +% 21. Find the Lowest Common Ancestor in a Binary Search Tree +% # Normal Recursive +% prolog +lowest_common_ancestor(tree(_, Y, _), X, Z, Y) :- + X < Y, Z > Y; + X > Y, Z < Y. +lowest_common_ancestor(tree(L, Y, _), X, Z, LCA) :- + X < Y, Z < Y, + lowest_common_ancestor(L, X, Z, LCA). +lowest_common_ancestor(tree(_, Y, R), X, Z, LCA) :- + X > Y, Z > Y, + + + lowest_common_ancestor(R, X, Z, LCA). +% + +% # With Accumulator +% prolog +% The accumulator is not very useful here, as the search path is already determined by the BST property. +lowest_common_ancestor_acc(Tree, X, Z, LCA) :- lowest_common_ancestor(Tree, X, Z, LCA). +% + +% 22. Check if a Graph is Cyclic +% For graphs, it's better to represent them in a Prolog-friendly format, such as adjacency lists. I will use a representation where each node has a list of its neighbors. +% # Normal Recursive +% prolog +is_cyclic(Graph) :- + member(Vertex-_, Graph), + dfs(Vertex, Graph, [Vertex], _), !. + +dfs(Vertex, Graph, Visited, [Vertex|Visited]) :- + member(Vertex-Neighbors, Graph), + member(Neighbor, Neighbors), + member(Neighbor, Visited), !. +dfs(Vertex, Graph, Visited, FinalVisited) :- + member(Vertex-Neighbors, Graph), + member(Neighbor, Neighbors), + \+ member(Neighbor, Visited), + dfs(Neighbor, Graph, [Neighbor|Visited], FinalVisited). +% + +% # With Accumulator +% prolog +% Due to the way depth-first search works, a typical accumulator wouldn't be very effective. +% The visited list already acts like an accumulator. +is_cyclic_acc(Graph) :- is_cyclic(Graph). +% + +% 23. Perform a Depth-First Search on a Graph +% # Normal Recursive +% prolog +dfs_graph(Vertex, Graph) :- dfs_vertex(Vertex, Graph, []). + +dfs_vertex(Vertex, _, Visited) :- member(Vertex, Visited), !. +dfs_vertex(Vertex, Graph, Visited) :- + write(Vertex), nl, + member(Vertex-Neighbors, Graph), + dfs_neighbors(Neighbors, Graph, [Vertex|Visited]). + +dfs_neighbors([], _, _). +dfs_neighbors([Neighbor|Neighbors], Graph, Visited) :- + dfs_vertex(Neighbor, Graph, Visited), + dfs_neighbors(Neighbors, Graph, Visited). +% + +% # With Accumulator +% prolog +% The visited list acts as an accumulator. +dfs_graph_acc(Vertex, Graph) :- dfs_graph(Vertex, Graph). +% + +% 24. Perform a Breadth-First Search on a Graph +% # Normal Recursive +% prolog +bfs_graph(Vertex, Graph) :- + bfs([Vertex], Graph, [Vertex]). + +bfs([], _, _). +bfs([Vertex|Vertices], Graph, Visited) :- + write(Vertex), nl, + member(Vertex-Neighbors, Graph), + filter_unvisited(Neighbors, Visited, NewNeighbors, NewVisited), + append(Vertices, NewNeighbors, NewVertices), + bfs(NewVertices, Graph, NewVisited). + +filter_unvisited([], Visited, [], Visited). +filter_unvisited([Neighbor|Neighbors], Visited, NewNeighbors, NewVisited) :- + (member(Neighbor, Visited) -> + filter_unvisited(Neighbors, Visited, NewNeighbors, NewVisited); + filter_unvisited(Neighbors, [Neighbor|Visited], NewNeighbors, [Neighbor|NewVisited]) + ). +% + +% # With Accumulator +% prolog +% The visited list acts as an accumulator. +bfs_graph_acc(Vertex, Graph) :- bfs_graph(Vertex, Graph). +% + +% 25. Check if a Graph is Connected +% # Normal Recursive +% prolog +is_connected(Graph) :- + Graph = [Vertex-_|_], + dfs_graph(Vertex, Graph), + \+ (member(OtherVertex-_, Graph), \+ member(OtherVertex, Visited)), !. +% + +% # With Accumulator +% prolog +% The visited list acts as an accumulator. +is_connected_acc(Graph) :- is_connected(Graph). +% + +% 26. Find the Shortest Path between Two Nodes in a Graph +% # Normal Recursive +% prolog +shortest_path(Start, End, Graph, Path) :- + shortest_path([Start], End, Graph, [Start], Path). + +shortest_path(_, End, _, Visited, ReversePath) :- + reverse(ReversePath, [End|_]), !. +shortest_path(Vertices, End, Graph, Visited, Path) :- + adjacent_unvisited(Vertices, Graph, Visited, Adjacent), + append(Visited, Adjacent, NewVisited), + append(Vertices, Adjacent, NewVertices), + shortest_path(NewVertices, End, Graph, NewVisited, Path). +% + +% # With Accumulator +% prolog +% The visited list and the list of vertices to explore act as accumulators. +shortest_path_acc(Start, End, Graph, Path) :- shortest_path(Start, End, Graph, Path). +% + +% 27. Check if a String is a Palindrome +% # Normal Recursive +% prolog +is_string_palindrome(Str) :- string_chars(Str, Chars), is_palindrome(Chars). +% + +% # With Accumulator +% prolog +is_string_pal + +indrome_acc(Str) :- string_chars(Str, Chars), is_palindrome_acc(Chars, []). +% + +% 28. Compute the Edit Distance between Two Strings +% # Normal Recursive +% prolog +edit_distance([], [], 0). +edit_distance([_|T1], [], D) :- + edit_distance(T1, [], D1), + D is D1 + 1. +edit_distance([], [_|T2], D) :- + edit_distance([], T2, D1), + D is D1 + 1. +edit_distance([H1|T1], [H2|T2], D) :- + edit_distance(T1, T2, D1), + D is D1 + (H1 \= H2). +% + +% # With Accumulator +% prolog +edit_distance_acc(S1, S2, D) :- edit_distance_acc(S1, S2, 0, D). + +edit_distance_acc([], [], Acc, Acc). +edit_distance_acc([_|T1], [], Acc, D) :- NewAcc is Acc + 1, edit_distance_acc(T1, [], NewAcc, D). +edit_distance_acc([], [_|T2], Acc, D) :- NewAcc is Acc + 1, edit_distance_acc([], T2, NewAcc, D). +edit_distance_acc([H1|T1], [H2|T2], Acc, D) :- + NewAcc is Acc + (H1 \= H2), + edit_distance_acc(T1, T2, NewAcc, D). +% + +% 29. Find the Longest Common Subsequence of Two Strings +% # Normal Recursive +% prolog +lcs([], _, []). +lcs(_, [], []). +lcs([H|T1], [H|T2], [H|Lcs]) :- lcs(T1, T2, Lcs), !. +lcs(S1, [_|T2], Lcs) :- lcs(S1, T2, Lcs). +lcs([_|T1], S2, Lcs) :- lcs(T1, S2, Lcs). +% + +% # With Accumulator +% prolog +lcs_acc(S1, S2, Lcs) :- lcs_acc(S1, S2, [], Lcs). + +lcs_acc([], _, Acc, Lcs) :- reverse(Acc, Lcs). +lcs_acc(_, [], Acc, Lcs) :- reverse(Acc, Lcs). +lcs_acc([H|T1], [H|T2], Acc, Lcs) :- lcs_acc(T1, T2, [H|Acc], Lcs). +lcs_acc(S1, [_|T2], Acc, Lcs) :- lcs_acc(S1, T2, Acc, Lcs). +lcs_acc([_|T1], S2, Acc, Lcs) :- lcs_acc(T1, S2, Acc, Lcs). +% + +% 30. Find the Longest Common Substring of Two Strings +% # Normal Recursive +% prolog +longest_common_substring(S1, S2, Lcs) :- + findall(Sub, (substring(S1, Sub), substring(S2, Sub)), Subs), + longest_string(Subs, Lcs). + +substring(Str, Sub) :- + append(_, Rest, Str), + append(Sub, _, Rest). + +longest_string([H|T], Longest) :- + longest_string(T, H, Longest). + +longest_string([], Acc, Acc). +longest_string([H|T], Acc, Longest) :- + length(H, LenH), + length(Acc, LenAcc), + (LenH > LenAcc -> longest_string(T, H, Longest); longest_string(T, Acc, Longest)). +% + +% # With Accumulator +% prolog +longest_common_substring_acc(S1, S2, Lcs) :- + findall(Sub, (substring(S1, Sub), substring(S2, Sub)), Subs), + longest_string_acc(Subs, [], Lcs). + +longest_string_acc([], Acc, Acc). +longest_string_acc([H|T], Acc, Longest) :- + length(H, LenH), + length(Acc, LenAcc), + (LenH > LenAcc -> longest_string_acc(T, H, Longest); longest_string_acc(T, Acc, Longest)). +% + + diff --git a/.Attic/canary_docme/metta_compiler.pl b/.Attic/canary_docme/metta_compiler.pl new file mode 100644 index 00000000000..7dbc7fbe31d --- /dev/null +++ b/.Attic/canary_docme/metta_compiler.pl @@ -0,0 +1,1433 @@ +/* + * Project: MeTTaLog - A MeTTa to Prolog Transpiler/Interpreter + * Description: This file is part of the source code for a transpiler designed to convert + * MeTTa language programs into Prolog, utilizing the SWI-Prolog compiler for + * optimizing and transforming function/logic programs. It handles different + * logical constructs and performs conversions between functions and predicates. + * + * Author: Douglas R. Miles + * Contact: logicmoo@gmail.com / dmiles@logicmoo.org + * License: LGPL + * Repository: https://github.com/trueagi-io/metta-wam + * https://github.com/logicmoo/hyperon-wam + * Created Date: 8/23/2023 + * Last Modified: $LastChangedDate$ # You will replace this with Git automation + * + * Usage: This file is a part of the transpiler that transforms MeTTa programs into Prolog. For details + * on how to contribute or use this project, please refer to the repository README or the project documentation. + * + * Contribution: Contributions are welcome! For contributing guidelines, please check the CONTRIBUTING.md + * file in the repository. + */ + +% Setting the file encoding to ISO-Latin-1 +:- encoding(iso_latin_1). +% Flushing the current output +:- flush_output. +% Setting the Rust backtrace to Full +:- setenv('RUST_BACKTRACE',full). +% Loading various library files +:- ensure_loaded(swi_support). +:- ensure_loaded(metta_testing). +:- ensure_loaded(metta_utils). +:- ensure_loaded(metta_reader). +:- ensure_loaded(metta_interp). +:- ensure_loaded(metta_space). +:- ensure_loaded(metta_compiler_inlining). +:- ensure_loaded(metta_mizer). +% ======================================= +% TODO move non flybase specific code between here and the compiler +%:- ensure_loaded(flybase_main). +% ======================================= +%:- set_option_value(encoding,utf8). + +:- dynamic(metta_compiled_predicate/2). +:- multifile(metta_compiled_predicate/2). +:- dynamic(metta_compiled_predicate/3). +:- multifile(metta_compiled_predicate/3). + + +w_cl(P1,F):- atom(F),!,w_cl(P1,F/_). +w_cl(P1,F/A):- atom(F),integer(A),!,functor(P,F,A),w_cl(P1,P). +w_cl(P1,F/A):- forall((current_predicate(F/A),A>0),w_cl(P1,F/A)). +w_cl(P1,P):- call(P1,P). + + + +dedupe_p1(P):- current_predicate(_,P), + forall((copy_term(P,P2), + clause(P,Bd,Ref), + clause(P2,Bd2,Ref2), Ref@', +% \+ file_decl_arity(F,_), length(Args,AA),!,A=AA. +function_arity(F,A):- current_self(KB), function_arity(KB,F,A). + + +defined_arity(F,A):- predicate_arity(F,A). +defined_arity(F,A):- current_predicate(F/A), \+ predicate_arity(F,_). + +% defined as (= .. .....) +decl_arity(F,A):- metta_atom_file_buffer([Eq,[FF|Len]|_]), + Eq=='=',nonvar(FF),F==FF,is_list(Len),length([FF|Len],A). + +import_arity(_,_):- fail, todo(metta_file_buffer(_Atom,_NamedVarsList,_Filename,_LineCount)). +is_data_functor(DataFunctor,DenotationalArity):- nonvar(DataFunctor), + metta_atom_file_buffer(['DataFunctor',DataFunctor,DenotationalArity]). +is_data_functor(F,_):- \+ import_arity(F,_), \+ decl_arity(F,_). + +% Certain constructs should not be converted to functions. +not_function(P):- symbol(P),!,not_function(P,0). +not_function(P):- callable(P),!,as_functor_args(P,F,A),not_function(F,A). +not_function(F,A):- is_arity_0(F,FF),!,not_function(FF,A). +not_function(!,0). +not_function(print,1). +not_function((':-'),2). +not_function((','),2). +not_function((';'),2). +not_function(('='),2). +not_function(('or'),2). + +not_function('a',0). +not_function('b',0). +not_function(F,A):- is_control_structure(F,A). +not_function(A,0):- symbol(A),!. +not_function('True',0). +not_function(F,A):- predicate_arity(F,A),AA is A+1, \+ decl_functional_predicate_arg(F,AA,_). + +needs_call_fr(P):- is_function(P,_Nth),as_functor_args(P,F,A),AA is A+1, \+ current_predicate(F/AA). + +is_control_structure(F,A):- symbol(F), atom_concat('if-',_,F),A>2. + +'=='(A, B, Res):- as_tf(equal_enough(A, B),Res). +'or'(G1,G2):- G1 *-> true ; G2. +'or'(G1,G2,Res):- as_tf((G1 ; G2),Res). + +% Function without arguments can be converted directly. +is_arity_0(AsFunction,F):- compound(AsFunction), compound_name_arity(AsFunction,F,0). + +% Determines whether a given term is a function and retrieves the position +% in the predicate where the function Result is stored/retrieved +is_function(AsFunction, _):- is_ftVar(AsFunction),!,fail. +is_function(AsFunction, _):- AsFunction=='$VAR',!, trace, fail. +is_function(AsFunction, Nth) :- is_arity_0(AsFunction,F), \+ not_function(F,0), !,Nth=1. +is_function(AsFunction, Nth) :- is_arity_0(AsFunction,_), !,Nth=1. +is_function([F|Function], Nth) :- + is_list(Function),length(Function,N), + functional_predicate_arg_maybe(F, N, Nth). + +is_function(AsFunction, Nth) :- + callable(AsFunction), + as_functor_args(AsFunction, Functor, A), + \+ not_function(Functor, A), + AA is A + 1, + functional_predicate_arg_maybe(Functor, AA, Nth). + +functional_predicate_arg_maybe(F, _, _):- \+ symbol(F),!,fail. +functional_predicate_arg_maybe(F, AA, Nth):- functional_predicate_arg(F, AA, Nth),!. +functional_predicate_arg_maybe(F, AA, _):- A is AA - 1,functional_predicate_arg(F,A,_),!,fail. +functional_predicate_arg_maybe(F, Nth, Nth):- asserta(decl_functional_predicate_arg(F, Nth, Nth)),!. + +% -------------------------------- +% FUNCTS_TO_PREDS EXPLANATION +% -------------------------------- + +% functs_to_preds is a predicate that converts all Term functions to their equivalent predicates. +% It takes three arguments - RetResult, which will hold the result of the function evaluation, +% Convert, which is the function that needs to be converted, and Converted, which will hold the equivalent predicate. +% Example: +% +% ?- functs_to_preds(RetResult, is(pi+pi), Converted). +% +% Converted = (pi(_A), +% +(_A, _A, _B), +% _C is _B, +% u_assign(_C, RetResult)). +% +functs_to_preds(I,OO):- + notrace(is_html->true; non_compat_io(color_g_mesg('yellow', (write_src(I),nl)))), + must_det_ll(functs_to_preds0(I,OO)),!. + +functs_to_preds0(I,OO):- \+ compound(I),!,OO=I. +%functs_to_preds0(I,OO):- data_term(I),!,OO=I. +functs_to_preds0(I,OO):- \+ is_conz(I), once(into_list_args(I,II)), I\=@=II, functs_to_preds(II,OO),!. +functs_to_preds0([Eq,H,B],OO):- Eq == '=', !, compile_for_assert(H, B, OO),!. +functs_to_preds0(=(H,B),OO):- !, compile_for_assert(H, B, OO),!. +functs_to_preds0(EqHB,OO):- compile_for_assert(EqHB,(X==X),OO),!. +functs_to_preds0(I,OO):- + must_det_ll(( + sexpr_s2p(I, M), + f2p(_,_,M,O), + expand_to_hb(O,H,B), + optimize_head_and_body(H,B,HH,BB),!, + OO = ':-'(HH,BB))). + +% ?- compile_for_exec(RetResult, is(pi+pi), Converted). + + +compile_for_exec(Res,I,O):- + %ignore(Res='$VAR'('RetResult')), + compile_for_exec0(Res,I,O),!. + +compile_for_exec0(Res,I,u_assign(I,Res)):- is_ftVar(I),!. +compile_for_exec0(Res,(:- I),O):- !, + compile_for_exec0(Res,I,O). +compile_for_exec0(Res,(?- I),O):- !, + compile_for_exec0(Res,I,O). +compile_for_exec0(Res,I,BB):- + %ignore(Res='$VAR'('RetResult')), + compound_name_arguments(EXEC1, exec1, []), + f2p(EXEC1,Res,I,O), + optimize_head_and_body(exec1(Res),O,_,BB). + +compile_for_exec0(Res,I,BB):- fail, + compound_name_arguments(EXEC0, exec0, []), + compile_for_assert(EXEC0, I, H:-BB), + arg(1,H,Res). + + + +compile_metta_defn(_KB,_F,_Len,Args,_BodyFn,_Clause):- \+ is_list(Args),!,fail. +%compile_metta_defn(_KB,_F,_Len,_Args,BodyFn,_Clause):- var(BodyFn),!,fail. +compile_metta_defn(KB,F,Len,Args,[WB|AL],ClauseU):- 'wam-body'==WB,!, + must_det_ll(( + if_t(var(Len), ignore((function_arity(KB,F,Len)))), + if_t(var(Arity),ignore((is_non_absorbed_return(KB,F,Len,_), ignore(Arity is Len+1)))), + if_t(var(Arity),ignore((is_absorbed_return(KB,F,Arity,_), ignore(Len is Arity)))), + if_t(var(Arity),ignore((predicate_arity(KB,F,Arity)))), + if_t(var(Arity),length(Args,Arity)), + if_t(var(Len),ignore(Len is Arity-1)), + if_t(var(Len),if_t(integer(SLen),Len = SLen)), + pfcAdd(metta_compiled_predicate(KB,F,Len)), + Clause=(H:-B), s2c([F|Args],H), maplist(s2c,AL,ALB), + list_to_conjuncts(ALB,B), + %nl,print_tree(Clause),nl, + add_unnumbered_clause(KB,F,Len,Clause,ClauseU))),!. +compile_metta_defn(KB,F,Len,Args,BodyFn,ClauseU):- + must_det_ll(( + if_t(var(Len),length(Args,Len)), + pfcAdd(metta_compiled_predicate(KB,F,Len)), + compile_for_assert([F|Args],BodyFn,Clause), + add_unnumbered_clause(KB,F,Len,Clause,ClauseU))). + +add_unnumbered_clause(KB,F,Len,ClauseN,Clause):- + must_det_ll(( + unnumbervars_clause(ClauseN,Clause), + pfcAdd(metta_compiled_predicate(KB,F,Len)), + add_assertion(KB,Clause))),!. + +compile_for_assert_eq('=',HeadInC, AsBodyFnC, Converted):- + subst_vars(['=',HeadInC, AsBodyFnC],['=',HeadIn, AsBodyFn],NamedVarsList), + maplist(cname_var,NamedVarsList),!, + compile_for_assert(HeadIn, AsBodyFn, Converted). +compile_for_assert_eq(':-',HeadIn, BodyIn, Converted):- + call(ensure_corelib_types), + Converted=(H:-B), s2p(HeadIn,H), s2p(BodyIn,B),!. + + + +/* +compile_for_assert_01(HeadIs, AsBodyFn, Converted) :- + ( AsBodyFn =@= HeadIs ; AsBodyFn == [] ), !, + compile_fact_for_assert(HeadIs,Converted). + +% If Convert is of the form (AsFunction=AsBodyFn), we perform conversion to obtain the equivalent predicate. + +compile_for_assert_01(Head, AsBodyFn, Converted) :- + once(compile_head_variablization(Head, HeadC, HeadCode)), + \+ atomic(HeadCode), !, + compile_for_assert_01(HeadC, + (HeadCode,AsBodyFn), Converted),!. + +compile_for_assert_01(HeadIn, AsBodyFn, Converted) :- + r2p(HeadIn,HResult,Head), + compile_for_assert_02(HResult,Head, AsBodyFn, Converted),!. +compile_for_assert_01(HeadIn, AsBodyFn, Converted) :- + compile_for_assert_02(_HResult, HeadIn, AsBodyFn, Converted),!. + + +compile_for_assert_02(HResult,HeadIs, AsBodyFn, Converted) + :- is_nsVar(AsBodyFn), + AsFunction = HeadIs,!, + must_det_ll(( + Converted = (HeadC :- BodyC), % Create a rule with Head as the converted AsFunction and NextBody as the converted AsBodyFn + %funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head), + f2p(HeadIs,HResult,AsFunction,HHead), + (var(HResult) -> (Result = HResult, HHead = Head) ; + funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head)), + NextBody = u_assign(AsBodyFn,Result), + optimize_head_and_body(Head,NextBody,HeadC,BodyC), + cname_var('HEAD_RES',Result))),!. + +compile_for_assert_02(HResult,HeadIs, AsBodyFn, Converted) :- + h2p(HeadIs,HResult,NewHead), + AsFunction = HeadIs, + must_det_ll(( + Converted = (HeadC :- NextBodyC), % Create a rule with Head as the converted AsFunction and NextBody as the converted AsBodyFn + % funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head), + f2p(NewHead,HResult,AsFunction,HHead), + (var(HResult) -> (Result = HResult, HHead = Head) ; + funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head)), + %verbose_unify(Converted), + f2p(HeadIs,Result,AsBodyFn,NextBody), + %RetResult = Converted, + %RetResult = _, + optimize_head_and_body(Head,NextBody,HeadC,NextBodyC), + %fbug([convert(Convert),optimize_head_and_body(HeadC:-NextBodyC)]), + %if_t(((Head:-NextBody)\=@=(HeadC:-NextBodyC)),fbug(was(Head:-NextBody))), + + cname_var('HEAD_RES',Result))),!. + +% If Convert is of the form (AsFunction=AsBodyFn), we perform conversion to obtain the equivalent predicate. +compile_for_assert_02(HResult,HeadIs, AsBodyFn, Converted) :- + Result = HResult, + AsFunction = HeadIs, Converted = (HeadCC :- BodyCC), + funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head), + compile_head_args(Head,HeadC,HeadCode), + f2p(HeadIs,Result,AsBodyFn,NextBody), + combine_code(HeadCode,NextBody,BodyC),!, + optimize_head_and_body(HeadC,BodyC,HeadCC,BodyCC),!. + + +*/ +merge_structures([F|HeadAsFunction0], AsBodyFn0,A,B,(=(NewVar,Cept),C)):- fail, + append(Left,[Merge|Right],HeadAsFunction0), nonvar(Merge), + append(Left,[Cept|Right],HeadAsFunctionM), + %HeadAsFunctionM=REPH, + HeadAsFunction0=REPH, + subst(AsBodyFn0+REPH,Merge,NewVar,NextBodyFn+NextHead), + NextBodyFn+NextHead \=@= AsBodyFn0+HeadAsFunctionM, + merge_structures([F|NextHead], NextBodyFn,A,B,C), + Cept=Merge. +merge_structures(A,B,A,B,true). + +compile_for_assert(HeadAsFunction0, AsBodyFn0, ConvertedO) :- + must_det_ll(( + call(ensure_corelib_types), + merge_structures(HeadAsFunction0, AsBodyFn0,HeadAsFunction, AsBodyFn,PreCode), + as_functor_args(HeadAsFunction,_F,Len), + h2p(Which,HeadAsFunction,ResultToHead,HeadAsPred), + compile_head_for_assert(Which,HeadAsPred,HeadC,_SupposedRT, + Len, NarrowRetType,ResultToHead, ResultFromBody,HeadCode,ResultCode), + f2p(HeadC,NarrowRetType,ResultFromBody,AsBodyFn,NextBody), + combine_code([PreCode,HeadCode,NextBody,ResultCode],BodyC),!, + optimize_head_and_body(HeadC,BodyC,HeadCC,BodyCC), + Convert = (HeadCC :- BodyCC), + fix_equals_in_head(Convert,Converted),!, + continue_opimize(Converted,ConvertedO))). + + +compile_head_for_assert(Which,Head, NewHead, SupposedRT, Len, NarrowRetType,ResultToHead,ResultFromBody,PreBodyCode,ResultCode):- + \+ is_list(Head), + as_functor_args(Head,F,_,ArgsL),!, + compile_head_for_assert(Which,[F|ArgsL], NewHead, SupposedRT, Len, NarrowRetType,ResultToHead,ResultFromBody,PreBodyCode,ResultCode),!. + +% compile_head_for_assert(Head, Head, true):- head_as_is(Head),!. +compile_head_for_assert(_Which,HeadAsPred,NewestHead,SupposedRT,Len,NarrowRetType, + ResultToHead,ResultFromBody, + PreBodyCode,ResultCode):- + must_det_ll(( + HeadAsPred=[F|PredArgs], + length(PredArgs,Arity), + length(NewPredArgs,Arity), + length(ParamTypes,Len), + length(FunctionArgs,Len),length(NewFunctionArgs,Len), + append(FunctionArgs,RetL,PredArgs), + append(NewFunctionArgs,RetL,NewPredArgs), + (RetL==[] -> true ; RetL=[ResultFromBody|_]), + get_operator_typedef(Self,F,ParamTypes,BodyRetType), + narrow_types(SupposedRT,BodyRetType,NarrowRetType), + compile_head_args(20,HeadAsPred,Self,F,1,ParamTypes,FunctionArgs,NewFunctionArgs,ParamCode), + FutureHead = [F|NewPredArgs], + compile_head_variablization(FutureHead, NewestHead, VHeadCode), + combine_code([ParamCode,VHeadCode],PreBodyCode), + ResultCode = eval_for(ret,BodyRetType,ResultFromBody,ResultToHead))). + + +compile_head_variablization(Head, NewHead, PreBodyCode) :- + must_det_ll( + (as_functor_args(Head,Functor,A,Args), + % Find non-singleton variables in Args + fix_non_singletons(Args, NewArgs, Conditions), + list_to_conjunction(Conditions,PreBodyCode), + as_functor_args(NewHead,Functor,A,NewArgs))),!. + + + + + +% Construct the new head args +compile_head_args(Depth,HeadIs,Self,F,Nth,[PT|ParamTypes],[A|Args],[N|NewArgs],CCode):- !, + compile_one_head_arg(Depth,HeadIs,Self,F,Nth,PT,A,N,C),!, + Nth1 is Nth+1, + compile_head_args(Depth,HeadIs,Self,F,Nth1,ParamTypes,Args,NewArgs,Code),!, + combine_code(C,Code,CCode). +compile_head_args(_Depth,_HeadIs,_Slf,_F,_Nth,[],Args,Args,true). +compile_head_args(_Depth,_HeadIs,_Slf,_F,_Nth,_ParamTypes,[],[],true). + + + +%compile_one_head_arg(_Head, NewArg, Arg, (NewArg=~Arg)):- data_term(Arg),!. +%compile_one_head_arg(_Head, NewArg, Arg, (NewArg=~Arg)):- !. +%compile_one_head_arg(Head, NewArg, Arg, Code):- f2p_assign(10,Head,NewArg,Arg,Code). + +compile_one_head_arg(_Depth,_HeadIs,_Slf,_F,_Nth,_PT,Arg,NewArg,eval_true(NewArg)):- Arg=='True',!. +compile_one_head_arg(_Depth,_HeadIs,_Slf,_F,_Nth,_PT,Arg,NewArg,eval_false(NewArg)):- Arg=='False',!. + +compile_one_head_arg(_Depth,_HeadIs,_Slf,_F,_Nth,PT,A,N,eval_for(h5,PT,N,A)):- PT\=='Atom', is_list(A),!. +compile_one_head_arg(Depth,HeadIs,Slf,F,Nth,RetType,Arg,NewArgO,CodeOut):- \+ is_list(Arg), + compound(Arg), as_functor_args(Arg,AF,_A,Args), Compile = [AF|Args], !, +compile_one_head_arg(Depth,HeadIs,Slf,F,Nth,RetType,Compile,NewArgO,CodeOut),!. +compile_one_head_arg(_Depth,_HeadIs,_Slf,_F,_Nth,PT,A,N,eval_for(h5,PT,N,A)):- PT\=='Atom', is_list(A),!. +compile_one_head_arg(_Depth,_HeadIs,_Slf,_F,_Nth,PT,A,N,eval_for(h5,PT,N,A)):- is_list(A),!. +compile_one_head_arg(_Depth,_HeadIs,_Slf,F,Nth,PT,A,N,eval_for(h4(Nth,F),PT,N,A)):- var(PT), var(A),!. +compile_one_head_arg(_Depth,_HeadIs,_Slf,_F,_Nth,PT,A,N,eval_for(h3,PT,N,A)):- var(PT), nonvar(A), get_type(A,PT),nonvar(PT),!. +compile_one_head_arg(_Depth,_HeadIs,_Slf,_F,_Nth,PT,A,N,once(get_type(A,PT))):- A=N,var(PT), !. +compile_one_head_arg(_Depth,_HeadIs,_Slf,_F,_Nth,_PT,A,A,true). + + + + + + + + + + + + + + + + + + + + +% If Convert is of the form (AsFunction=AsBodyFn), we perform conversion to obtain the equivalent predicate. +compile_fact_for_assert(HeadIs, (Head:-Body)):- + compile_head_for_assert(HeadIs, NewHeadIs,Converted), + optimize_head_and_body(NewHeadIs,Converted,Head,Body). + +head_as_is(Head):- + as_functor_args(Head,Functor,A,_),!, + head_as_is(Functor,A). +head_as_is('If',3). + +rewrite_sym(S,F):- \+ atomic(S),!,F=S. +rewrite_sym(':',F):- var(F),!, 'iz' == F,!. +rewrite_sym(F,F). + +as_functor_args(AsPred,F,A):- + as_functor_args(AsPred,F,A,_ArgsL),!. + +as_functor_args(AsPred,F,A,ArgsL):-var(AsPred),!, + (is_list(ArgsL);(integer(A),A>=0)),!, + length(ArgsL,A), + (symbol(F)->AsPred =..[F|ArgsL]; (AsPred = [F|ArgsL])). + +as_functor_args(AsPred,_,_,_Args):- is_ftVar(AsPred),!,fail. +as_functor_args(AsPred,F,A,ArgsL):- \+ iz_conz(AsPred), + AsPred=..List,!, as_functor_args(List,F,A,ArgsL),!. +%as_functor_args([Eq,R,Stuff],F,A,ArgsL):- (Eq == '='), +% into_list_args(Stuff,List),append(List,[R],AsPred),!, +% as_functor_args(AsPred,F,A,ArgsL). +as_functor_args([F|ArgsL],F,A,ArgsL):- length(ArgsL,A),!. + + + + + +is_f('S'):- fail. +is_mf(','). is_mf(';'). is_mf('call'). +is_lf(':'). + + +s2c(Args,true):- Args==[],!. +s2c(Args,call(Args)):- \+ iz_conz(Args),!. +s2c([F|Args],C):- \+ symbol(F), !, C=[F|Args]. +s2c([F|Args],C):- is_lf(F), !, C=[F|Args]. +s2c([At,F|Args],C):- symbol(F), At== '@', is_list(Args),!,maplist(s2c,Args,ArgsL), compound_name_arguments(C,F,ArgsL). +s2c([F|Args],C):- is_f(F), is_list(Args),!,maplist(s2ca,Args,ArgsL), compound_name_arguments(C,F,ArgsL). +s2c([F|Args],C):- is_mf(F), is_list(Args),!,maplist(s2c,Args,ArgsL), compound_name_arguments(C,F,ArgsL). +s2c([F|Args],C):- is_list(Args),!,maplist(s2ca,Args,ArgsL), compound_name_arguments(C,F,ArgsL). +s2c(C,call(C)). + + +s2ca(Args,Args):- \+ iz_conz(Args),!. +s2ca([H|T],[HH|TT]):- \+ symbol(H), !, s2ca(H,HH),s2ca(T,TT). +s2ca([F|Args],C):- is_lf(F), !, C=[F|Args]. +s2ca([At,F|Args],C):- symbol(F), At== '@', is_list(Args),!,maplist(s2ca,Args,ArgsL), compound_name_arguments(C,F,ArgsL). +s2ca([F|Args],C):- is_f(F), is_list(Args),!,maplist(s2ca,Args,ArgsL), compound_name_arguments(C,F,ArgsL). +s2ca([F|Args],C):- is_mf(F), is_list(Args),!,maplist(s2c,Args,ArgsL), compound_name_arguments(C,F,ArgsL). +s2ca([H|T],[HH|TT]):- s2ca(H,HH),s2ca(T,TT). + + + + + + + + +fix_non_singletons(Args, NewArgs, [Code|Conditions]) :- + sub_term_loc(Var, Args, Loc1), is_nsVar(Var), + sub_term_loc_replaced(==(Var), _Var2, Args, Loc2, ReplVar2, NewArgsM), + Loc1 \=@= Loc2, + Code = same(ReplVar2,Var), + fix_non_singletons(NewArgsM, NewArgs, Conditions),!. +fix_non_singletons(Args, Args, []):-!. + + +sub_term_loc(A,A,self). +sub_term_loc(E,Args,e(N,nth1)+Loc):- is_list(Args),!, nth1(N,Args,ST),sub_term_loc(E,ST,Loc). +sub_term_loc(E,Args,e(N,arg)+Loc):- compound(Args),arg(N,Args,ST),sub_term_loc(E,ST,Loc). + +sub_term_loc_replaced(P1,E,Args,LOC,Var,NewArgs):- is_list(Args), !, sub_term_loc_l(nth1,P1,E,Args,LOC,Var,NewArgs). +sub_term_loc_replaced(P1,E,FArgs,LOC,Var,NewFArgs):- compound(FArgs), \+ is_nsVar(FArgs),!, + compound_name_arguments(FArgs, Name, Args), + sub_term_loc_l(arg,P1,E,Args,LOC,Var,NewArgs), + compound_name_arguments(NewCompound, Name, NewArgs),NewFArgs=NewCompound. + sub_term_loc_replaced(P1,A,A,self,Var,Var):- call(P1,A),!. + + +sub_term_loc_l(Nth,P1,E,Args,e(N,Nth)+Loc,Var,NewArgs):- + reverse(Args,RevArgs), + append(Left,[ST|Right],RevArgs), + sub_term_loc_replaced(P1,E,ST,Loc,Var,ReplaceST), + append(Left,[ReplaceST|Right],RevNewArgs), + reverse(RevNewArgs,NewArgs), + length([_|Right], N),!. + + +% Convert a list of conditions into a conjunction +list_to_conjunction([], true). +list_to_conjunction([Cond], Cond). +list_to_conjunction([H|T], RestConj) :- H==true, + list_to_conjunction(T, RestConj). +list_to_conjunction([H|T], (H, RestConj)) :- + list_to_conjunction(T, RestConj),!. + +fix_equals_in_head(Convert,Convert):- \+ compound(Convert),!. +fix_equals_in_head(Convert:-Vert,Comp:-Vert):-!, + fix_equals_in_head(Convert,Converted), + as_compound_head(Converted,Comp). +fix_equals_in_head(R=C,Converted):- + append_term(C,R,Converted). + +fix_equals_in_head((A:B),iz(A,B)):- !. +fix_equals_in_head(Convert,Convert). + +as_compound_head([F|Converted],Comp):- symbol(F),!,compound_name_arguments(Comp,F,Converted). +as_compound_head(Comp,Comp). + +:- op(700,xfx,'=~'). + + +filter_head_arg(H,F):- var(H),!,H=F. +filter_head_arge(H,F):- H = F. + +code_callable(Term,_CTerm):- var(Term),!,fail. +code_callable(Term, CTerm):- current_predicate(_,Term),!,Term=CTerm. +%code_callable(Term, CTerm):- current_predicate(_,Term),!,Term=CTerm. + +compile_test_then_else(Depth,RetResult,If,Then,Else,Converted):- + f2p(Depth,HeadIs,RetType,ThenResult,Then,ThenCode), + f2p(Depth,HeadIs,RetType,ElseResult,Else,ElseCode), + Converted=(If*->(ThenCode,ThenResult=RetResult); + (ElseCode,ElseResult=RetResult)). + +:- discontiguous(f2q/6). +%:- discontiguous(f2q/6). + + +dif_functors(HeadIs,_):- var(HeadIs),!,fail. +dif_functors(HeadIs,_):- \+ compound(HeadIs),!. +dif_functors(HeadIs,Convert):- compound(HeadIs),compound(Convert), + compound_name_arity(HeadIs,F,A),compound_name_arity(Convert,F,A). + +is_compiled_and(AND):- member(AND,[ /*(','), ('and'),*/ ('and2')]). + +flowc. + +no_lists(Args):- maplist(not_a_function_in_arg,Args). + +not_a_function_in_arg(Arg):- is_ftVar(Arg),!. +not_a_function_in_arg(Arg):- \+ is_list(Arg),!. + + + + + %is_data_functor(F,A),!. +%f2q(_Depth,_HeadIs,_RetType,_RetResult, ie(N=V, Code)) :- !, into_equals(N,V,Code). + +% The catch-all If no specific case is matched, consider Convert as already converted. + +%f2q(_Depth,_HeadIs,_RetType,RetResult,Convert, Code):- into_u_assign(Convert,RetResult,Code). + + + + + +de_eval(u_assign(X),X):- compound(X),!. + +call1(G):- call(G). +call2(G):- call(G). +call3(G):- call(G). +call4(G):- call(G). +call5(G):- call(G). + +trace_break:- trace,break. + +%:- table(u_assign/2). +%u_assign(FList,R):- is_list(FList),!,u_assign(FList,R). +u_assign(FList,R):- var(FList),nonvar(R), !, u_assign(R,FList). +u_assign(FList,R):- FList=@=R,!,FList=R. +u_assign([F|List],[F|R]):- List=R, !. +%u_assign(FList,R):- number(FList), var(R),!,R=FList. +u_assign(FList,R):- \+ compound(FList), var(R),!,R=FList. +u_assign(FList,R):- self_eval(FList), var(R),!,R=FList. +u_assign(FList,RR):- (compound_non_cons(FList),u_assign_c(FList,RR))*->true;FList=~RR. +u_assign(FList,R):- FList =~ R, !. +u_assign(FList,R):- var(FList),!,/*trace,*/freeze(FList,u_assign(FList,R)). +u_assign([F|List],R):- F == ':-',!, trace_break,as_tf(clause(F,List),R). +%u_assign(FList,RR):- u_assign_list1(FList,RR)*->true;u_assign_list2(FList,RR). + +u_assign_list1([F|List],R):- fail,u_assign([F|List],R), nonvar(R), R\=@=[F|List]. +u_assign_list2([F|List],R):- symbol(F),append(List,[R],ListR), + catch(quietly(apply(F,ListR)),error(existence_error(procedure,F/_),_), + catch(quietly(as_tf(apply(F,List),R)),error(existence_error(procedure,F/_),_), + (fail, quietly(catch(u_assign([F|List],R),_, R=[F|List]))))). + +%u_assign([V|VI],[V|VO]):- nonvar(V),is_metta_data_functor(_Eq,V),!,maplist(u_assign,VI,VO). + +u_assign_c((F:-List),R):- !, R = (F:-List). +u_assign_c(FList,RR):- + as_functor_args(FList,F,_), + (catch(quietlY(call(FList,R)),error(existence_error(procedure,F/_),_), + catch(quietlY(as_tf(FList,R)),error(existence_error(procedure,F/_),_), + quietlY((p2m(FList,[F|List]),catch(u_assign([F|List],R),_, R=~[F|List])))))),!,R=RR. +u_assign_c(FList,RR):- as_tf(FList,RR),!. +u_assign_c(FList,R):- compound(FList), !, FList=~R. + +quietlY(G):- call(G). + +call_fr(G,Result,FA):- current_predicate(FA),!,call(G,Result). +call_fr(G,Result,_):- Result=G. + +% This predicate is responsible for converting functions to their equivalent predicates. +% It takes a function 'AsFunction' and determines the predicate 'AsPred' which will be +% equivalent to the given function, placing the result of the function at the 'Nth' position +% of the predicate arguments. The 'Result' will be used to store the result of the 'AsFunction'. +% +% It handles cases where 'AsFunction' is a variable and when it's an symbol or a compound term. +% For compound terms, it decomposes them to get the as_functor_args and arguments and then reconstructs +% the equivalent predicate with the 'Result' at the 'Nth' position. +% +% Example: +% funct_with_result_is_nth_of_pred(HeadIs,+(1, 2), Result, 3, +(1, 2, Result)). +into_callable(Pred,AsPred):- is_ftVar(Pred),!,AsPred=holds(Pred). +into_callable(Pred,AsPred):- Pred=AsPred,!. +into_callable(Pred,AsPred):- iz_conz(Pred), !,AsPred=holds(Pred). +into_callable(Pred,AsPred):- Pred=call_fr(_,_,_),!,AsPred=Pred. +into_callable(Pred,AsPred):- Pred =~ Cons, !,AsPred=holds(Cons). + + +%r2p(MeTTa,Result,IsPred):- r2p(_,MeTTa,Result,IsPred),!. + +%r2p(What,MeTTa,Result,IsPred):- h2p(What,MeTTa,Result,IsPred),!. +%r2p(What,MeTTa,Result,IsPred):- ar2q(What,MeTTa,Result,IsPred),!. + + +%h2p(MeTTa,Result,IsPred):- h2p(_,MeTTa,Result,IsPred). + + +absorbed_default('Bool',_AsPred,'True'). +absorbed_default(_,_AsPred,_). + +is_absorbed_return_value(F,A,Result):- + is_absorbed_return_value(F,A,_,Result). +is_absorbed_return_value(F,A,AsPred,Result):- + is_absorbed_return(F,A,Bool), + absorbed_default(Bool,AsPred,Result). + +h2p(boolean,AsPred,Result,IsPred):- + as_functor_args(AsPred,F,Len,PArgs), + is_absorbed_return_value(F,Len,Result),!, + safe_univ(IsPred,F,PArgs),!. + +h2p(func,AsFunction,Result,IsPred):- + as_functor_args(AsFunction,F,Len,Args), + is_non_absorbed_return(F,Len,_Type), + append(Args,[Result],PArgs), + safe_univ(IsPred,F,PArgs),!. + +h2p(pred,AsPred,Result,IsPred):- + as_functor_args(AsPred,F,Len,PArgs), + is_absorbed_return(F,Len,_Type), + Result = 'True', + cname_var('AbsorbedRetTrue',Result), + safe_univ(IsPred,F,PArgs),!. + +h2p(pred,AsPred,Result,IsPred):- + as_functor_args(AsPred,F,A,PArgs), + always_predicate_in_src(F,A),!, +% once(functional_predicate_arg(F, A, Nth);Nth=A), + %is_absorbed_return(F,A, _Bool), + %nth1(Nth,Args,Result), + Result = 'True', + cname_var('PRetTrue',Result), + safe_univ(IsPred,F,PArgs). + +h2p(func,AsPred,Result,IsPred):- + as_functor_args(AsPred,F,A,Args), + always_function_in_src(F,A), + append(Args,[Result],PArgs), + cname_var('FRet',Result), + safe_univ(IsPred,F,PArgs),!. + +h2p(func,AsPred,Result,IsPred):- + as_functor_args(AsPred,F,_A,Args), + append(Args,[Result],PArgs), + cname_var('Ret',Result), + safe_univ(IsPred,F,PArgs),!. + +safe_univ(IsPred,F,PArgs):- is_list(PArgs),atom(F),!,IsPred=..[F|PArgs]. +safe_univ(IsPred,F,PArgs):- compound(IsPred),var(F),!,IsPred=..[F|PArgs]. +safe_univ(IsPred,F,PArgs):- IsPred=fL(F,PArgs). + +/* + + +h2p(func,AsFunction,Result,IsPred):- + as_functor_args(AsFunction,F,Len,Args), + is_non_absorbed_return(F,Len, _Type), + append(Args,[Result],PArgs), + safe_univ(IsPred,F,PArgs),!. + + +h2p(W,Data,Result,IsPred):- + W\== boolean, + as_functor_args(Data,F,A,_Args), + is_data_functor(F,AA),!, + (AA=A + -> (IsPred = (Data =~ Result)) + ; was_predicate(Data,Result,IsPred)). +h2p(pred,AsPred,Result,IsPred):- + as_functor_args(AsPred,F,A,Args), + always_predicate_in_src(F,A),!, + once(functional_predicate_arg(F, A, Nth);Nth=A), + \+ is_absorbed_return(F,_, _Bool), + nth1(Nth,Args,Result), + IsPred=..[F|Args]. +h2p(func,AsFunction,Result,IsPred):- + as_functor_args(AsFunction,F,A0,FArgs), + \+ is_absorbed_return(F,A0, _Bool), + always_function_in_src(F,A0),!,A is A0 + 1, + once(functional_predicate_arg(F, A, Nth);Nth=A), + nth1(Nth,Args,Result,FArgs), + IsPred=..[F|Args]. +*/ + +ar2q(MeTTa,Result,IsPred):- ar2q(_,MeTTa,Result,IsPred). +ar2q(pred,AsPred,Result,IsPred):- + as_functor_args(AsPred,F,A,Args), + once(functional_predicate_arg(F, A, Nth);Nth=A), + nth1(Nth,Args,Result), + \+ is_absorbed_return(F,_, _Bool), + IsPred=..[F|Args]. +ar2q(funct,AsFunction,Result,IsPred):- + as_functor_args(AsFunction,F,A0,FArgs),A is A0 + 1, + \+ is_absorbed_return(F,_, _Bool), + once(functional_predicate_arg(F, A, Nth);Nth=A), + nth1(Nth,Args,Result,FArgs), + IsPred=..[F|Args]. + +ar2q(pred,AsPred,Result,IsPred):- + as_functor_args(AsPred,F,A,Args), + is_absorbed_return_value(F,A,AsPred,Result), + IsPred=..[F|Args],!. + +was_predicate(AsPred,Result,IsPred):- + as_functor_args(AsPred,F,A,Args), + is_absorbed_return_value(F,A,AsPred,Result), + IsPred=..[F|Args],!. + +was_predicate(AsPred,Result,IsPred):- + as_functor_args(AsPred,F,A,Args), + once(functional_predicate_arg(F, A, Nth);Nth=A), + \+ is_non_absorbed_return(F,A, _Bool), + nth1(Nth,Args,Result), + IsPred=..[F|Args]. + + +was_function(AsFunction,Result,IsPred):- + as_functor_args(AsFunction,F,A0,FArgs), + ( ( \+ is_absorbed_return(F,A0,_)) ; is_non_absorbed_return(F,A0,_)), + A is A0 + 1, + once(functional_predicate_arg(F, A, Nth);Nth=A), + nth1(Nth,Args,Result,FArgs), + IsPred=..[F|Args]. + + +funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, Nth, AsPred):- + var(AsPred),!, + funct_with_result_is_nth_of_pred0(HeadIs,AsFunction, Result, Nth, Pred), + into_callable(Pred,AsPred). + +funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, Nth, AsPred):- + var(AsFunction),!, + funct_with_result_is_nth_of_pred0(HeadIs,Function, Result, Nth, AsPred), + into_callable(Function,AsFunction). + +funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, Nth, AsPred):- + funct_with_result_is_nth_of_pred0(HeadIs,AsFunction, Result, Nth, AsPred). + +% Handles the case where AsFunction is a variable. +% It creates a compound term 'AsPred' and places the 'Result' at the 'Nth' position +% of the predicate arguments, and the 'AsFunction' represents the functional form with +% arguments excluding the result. +funct_with_result_is_nth_of_pred0(_HeadIs,AsFunction, Result, Nth, AsPred) :- + is_nsVar(AsFunction),!, + compound(AsPred), + compound_name_list(AsPred,FP,PredArgs), + nth1(Nth,PredArgs,Result,FuncArgs), + do_predicate_function_canonical(FP,F), + AsFunction =~ [F,FuncArgs]. + +% Handles the case where 'AsFunction' is not a variable. +% It decomposes 'AsFunction' to get the as_functor_args and arguments (FuncArgs) of the function +% and then it constructs the equivalent predicate 'AsPred' with 'Result' at the 'Nth' +% position of the predicate arguments. +funct_with_result_is_nth_of_pred0(HeadIs,AsFunctionO, Result, Nth, (AsPred)) :- + de_eval(AsFunctionO,AsFunction),!,funct_with_result_is_nth_of_pred0(HeadIs,AsFunction, Result, Nth, AsPred). + +funct_with_result_is_nth_of_pred0(HeadIs,AsFunction, Result, _Nth, AsPred) :- + nonvar(AsFunction), + compound(AsFunction), + \+ is_arity_0(AsFunction,_), + as_functor_args(AsFunction,F,A), + HeadIs\=@=AsFunction, + \+ (compound(HeadIs), (is_arity_0(HeadIs,HF);as_functor_args(HeadIs,HF,_))-> HF==F), + (into_u_assign(AsFunction, Result,AsPred) + -> true + ; (AA is A+1, + (FAA=(F/AA)), + \+ current_predicate(FAA), !, + AsPred = call_fr(AsFunction,Result,FAA))). + + +funct_with_result_is_nth_of_pred0(_HeadIs,AsFunction, Result, Nth, (AsPred)) :- + (symbol(AsFunction)->AsFunction =~ [F | FuncArgs]; compound_name_list(AsFunction,F,FuncArgs)), + ignore(var(Nth) -> is_function(AsFunction,Nth); true), + nth1(Nth, PredArgs, Result, FuncArgs), % It places 'Result' at the 'Nth' position + AA is Nth+1, \+ current_predicate(F/AA), + do_predicate_function_canonical(FP,F), + AsPred =~ [FP | PredArgs]. % It forms the predicate 'AsPred' by joining the as_functor_args with the modified arguments list. + + + +funct_with_result_is_nth_of_pred0(_HeadIs,AsFunction, Result, Nth, (AsPred)) :- + nonvar(AsFunction), + AsFunction =~ [F | FuncArgs], + do_predicate_function_canonical(FP,F), + length(FuncArgs, Len), + ignore(var(Nth) -> is_function(AsFunction,Nth); true), + ((number(Nth),Nth > Len + 1) -> (trace,throw(error(index_out_of_bounds, _))); true), + (var(Nth)->(between(1,Len,From1),Nth is Len-From1+1);true), + nth1(Nth,PredArgs,Result,FuncArgs), + AsPred =~ [FP | PredArgs]. + +% optionally remove next line +funct_with_result_is_nth_of_pred0(_HeadIs,AsFunction, _, _, _) :- + var(AsFunction), + throw(error(instantiation_error, _)). + +% The remove_funct_arg/3 predicate is a utility predicate that removes +% the Nth argument from a predicate term, effectively converting a +% predicate to a function. The first argument is the input predicate term, +% the second is the position of the argument to be removed, and the third +% is the output function term. +remove_funct_arg(AsPred, Nth, AsFunction) :- + % Decompose AsPred into its as_functor_args and arguments. + AsPred =~ [F | PredArgs], + % Remove the Nth element from PredArgs, getting the list FuncArgs. + nth1(Nth,PredArgs,_Result,FuncArgs), + % Construct AsFunction using the as_functor_args and the list FuncArgs. + do_predicate_function_canonical(F,FF), + compound_name_list(AsFunction,FF,FuncArgs). + +% deep_lhs_sub_sterm/2 predicate traverses through a given Term +% and finds a sub-term within it. The sub-term is unifiable with ST. +% This is a helper predicate used in conjunction with others to inspect +% and transform terms. + +deep_lhs_sub_sterm(ST, Term):- deep_lhs_sub_sterm0(ST, Term), ST\=@=Term. +deep_lhs_sub_sterm0(_, Term):- never_subterm(Term),!,fail. +deep_lhs_sub_sterm0(ST, Term):- Term =~ if(Cond,_Then,_Else),!,deep_lhs_sub_sterm0(ST, Cond). +deep_lhs_sub_sterm0(ST, Term):- Term =~ 'if-error'(Cond,_Then,_Else),!,deep_lhs_sub_sterm0(ST, Cond). +deep_lhs_sub_sterm0(ST, Term):- Term =~ 'if-decons'(Cond,_Then,_Else),!,deep_lhs_sub_sterm0(ST, Cond). +deep_lhs_sub_sterm0(ST, Term):- Term =~ 'chain'(Expr,_Var,_Next),!,deep_lhs_sub_sterm0(ST, Expr). +deep_lhs_sub_sterm0(ST, Term):- + % If Term is a list, it reverses the list and searches for a member + % in the reversed list that is unifiable with ST. + is_list(Term),!,member(E,Term),deep_lhs_sub_sterm0(ST, E). +deep_lhs_sub_sterm0(ST, Term):- + % If Term is a compound term, it gets its arguments and then recursively + % searches in those arguments for a sub-term unifiable with ST. + compound(Term), compound_name_list(Term,_,Args),deep_lhs_sub_sterm0(ST, Args). +deep_lhs_sub_sterm0(ST, ST):- + % If ST is non-var, not an empty list, and callable, it unifies + % ST with Term if it is unifiable. + nonvar(ST), ST\==[], callable(ST). + +never_subterm(Term):- is_ftVar(Term). +never_subterm([]). +never_subterm('Nil'). +%never_subterm(F):- symbol(F),not_function(F,0). + +% rev_member/2 predicate is a helper predicate used to find a member +% of a list. It is primarily used within deep_lhs_sub_sterm/2 to +% traverse through lists and find sub-terms. It traverses the list +% from the end to the beginning, reversing the order of traversal. +rev_member(E,[_|L]):- rev_member(E,L). +rev_member(E,[E|_]). + +% Continuing from preds_to_functs/2 +% Converts a given predicate representation to its equivalent function representation +preds_to_functs(Convert, Converted):- + % Verbose_unify/1 here may be used for debugging or to display detailed unification information + verbose_unify(Convert), + % Calls the auxiliary predicate preds_to_functs0/2 to perform the actual conversion + preds_to_functs0(Convert, Converted). + +% if Convert is a variable, Converted will be the same variable +preds_to_functs0(Convert, Converted) :- + is_ftVar(Convert), !, + Converted = Convert. + +% Converts the rule (Head :- Body) to its function equivalent +preds_to_functs0((Head:-Body), Converted) :- !, + % The rule is converted by transforming Head to a function AsFunction and the Body to ConvertedBody + ( + pred_to_funct(Head, AsFunction, Result), + cname_var('HEAD_RES',Result), + conjuncts_to_list(Body,List), + reverse(List,RevList),append(Left,[BE|Right],RevList), + compound(BE),arg(Nth,BE,ArgRes),sub_var(Result,ArgRes), + remove_funct_arg(BE, Nth, AsBodyFunction), + append(Left,[u_assign(AsBodyFunction,Result)|Right],NewRevList), + reverse(NewRevList,NewList), + list_to_conjuncts(NewList,NewBody), + preds_to_functs0(NewBody,ConvertedBody), + % The final Converted term is constructed + into_equals(AsFunction,ConvertedBody,Converted)). + +% Handles the case where Convert is a conjunction, and AsPred is not not_function. +% It converts predicates to functions inside a conjunction +preds_to_functs0((AsPred, Convert), Converted) :- + \+ not_function(AsPred), + pred_to_funct(AsPred, AsFunction, Result), + sub_var(Result, Convert), !, + % The function equivalent of AsPred replaces Result in Convert + subst(Convert, Result, AsFunction, Converting), + preds_to_functs0(Converting, Converted). + +% Handles the special case where u_assign/2 is used and returns the function represented by the first argument of u_assign/2 +preds_to_functs0(u_assign(AsFunction, _Result), AsFunction) :- !. + +% Handles the general case where Convert is a conjunction. +% It converts the predicates to functions inside a conjunction +preds_to_functs0((AsPred, Converting), (AsPred, Converted)) :- !, + preds_to_functs0(Converting, Converted). + +% Handles the case where AsPred is a compound term that can be converted to a function +preds_to_functs0(AsPred, u_assign(AsFunction, Result)) :- + pred_to_funct(AsPred, AsFunction, Result), !. + +% any other term remains unchanged +preds_to_functs0(X, X). + +% Converts a given predicate AsPred to its equivalent function term AsFunction +pred_to_funct(AsPred, AsFunction, Result) :- + compound(AsPred), % Checks if AsPred is a compound term + as_functor_args(AsPred, F, A), % Retrieves the as_functor_args F and arity A of AsPred + functional_predicate_arg(F, A, Nth),!, % Finds the Nth argument where the result should be + arg(Nth, AsPred, Result), % Retrieves the result from the Nth argument of AsPred + remove_funct_arg(AsPred, Nth, AsFunction). % Constructs the function AsFunction by removing the Nth argument from AsPred + +% If not found in functional_predicate_arg/3, it tries to construct AsFunction by removing the last argument from AsPred +pred_to_funct(AsPred, AsFunction, Result) :- + compound(AsPred), !, + as_functor_args(AsPred, _, Nth), + arg(Nth, AsPred, Result), + remove_funct_arg(AsPred, Nth, AsFunction). + +% body_member/4 is utility predicate to handle manipulation of body elements in the clause, but the exact implementation details and usage are not provided in the given code. +body_member(Body,BE,NewBE,NewBody):- + conjuncts_to_list(Body,List), + reverse(List,RevList),append(Left,[BE|Right],RevList), + append(Left,[NewBE|Right],NewRevList), + reverse(NewRevList,NewList), + list_to_conjuncts(NewList,NewBody). +% combine_clauses/3 is the main predicate combining clauses with similar heads and bodies. +% HeadBodiesList is a list of clauses (Head:-Body) +% NewHead will be the generalized head representing all clauses in HeadBodiesList +% NewCombinedBodies will be the combined bodies of all clauses in HeadBodiesList. +combine_clauses(HeadBodiesList, NewHead, NewCombinedBodies) :- + % If HeadBodiesList is empty, then NewCombinedBodies is 'false' and NewHead is an anonymous variable. + (HeadBodiesList = [] -> NewCombinedBodies = false, NewHead = _ ; + % Find all Heads in HeadBodiesList and collect them in the list Heads + findall(Head, member((Head:-_), HeadBodiesList), Heads), + % Find the least general head among the collected Heads + least_general_head(Heads, LeastHead), + as_functor_args(LeastHead,F,A),as_functor_args(NewHead,F,A), + % Transform and combine bodies according to the new head found + transform_and_combine_bodies(HeadBodiesList, NewHead, NewCombinedBodies)), + \+ \+ ( + Print=[converting=HeadBodiesList,newHead=NewHead], + numbervars(Print,0,_,[]),fbug(Print), + nop(in_cmt(print_pl_source(( NewHead :- NewCombinedBodies))))),!. + +% Predicate to find the least general unified head (LGU) among the given list of heads. +% Heads is a list of head terms, and LeastGeneralHead is the least general term that unifies all terms in Heads. +least_general_head(Heads, LeastGeneralHead) :- + lgu(Heads, LeastGeneralHead). + +% the LGU of a single head is the head itself. +lgu([Head], Head) :- !. +% find the LGU of the head and the rest of the list. +lgu([H1|T], LGU) :- + lgu(T, TempLGU), + % Find generalization between head H1 and temporary LGU + generalization(H1, TempLGU, LGU). + +% generalization/3 finds the generalization of two heads, Head1 and Head2, which is represented by GeneralizedHead. +% This predicate is conceptual and will require more complex processing depending on the actual structures of the heads. +generalization(Head1, Head2, GeneralizedHead) :- + % Ensure the as_functor_args names and arities are the same between Head1 and Head2. + as_functor_args(Head1, Name, Arity), + as_functor_args(Head2, Name, Arity), + as_functor_args(GeneralizedHead, Name, Arity), + % Generalize the arguments of the heads. + generalize_args(Arity, Head1, Head2, GeneralizedHead). + +% no more arguments to generalize. +generalize_args(0, _, _, _) :- !. +% generalize the corresponding arguments of the heads. +generalize_args(N, Head1, Head2, GeneralizedHead) :- + arg(N, Head1, Arg1), + arg(N, Head2, Arg2), + % If the corresponding arguments are equal, use them. Otherwise, create a new variable. + (Arg1 = Arg2 -> arg(N, GeneralizedHead, Arg1); arg(N, GeneralizedHead, _)), + % Continue with the next argument. + N1 is N - 1, + generalize_args(N1, Head1, Head2, GeneralizedHead). + +% transform_and_combine_bodies/3 takes a list of clause heads and bodies, a new head, and produces a combined body representing all the original bodies. +% The new body is created according to the transformations required by the new head. +transform_and_combine_bodies([(Head:-Body)|T], NewHead, CombinedBodies) :- + % Transform the body according to the new head. + transform(Head, NewHead, Body, TransformedBody), + % Combine the transformed body with the rest. + combine_bodies(T, NewHead, TransformedBody, CombinedBodies). + +/* OLD +% Define predicate combine_clauses to merge multiple Prolog clauses with the same head. +% It receives a list of clauses as input and returns a combined clause. +combine_clauses([Clause], Clause) :- !. % If there's only one clause, return it as is. +combine_clauses(Clauses, (Head :- Body)) :- % If there are multiple clauses, combine them. + Clauses = [(Head :- FirstBody)|RestClauses], % Decompose the list into the first clause and the rest. + combine_bodies(RestClauses, FirstBody, Body). % Combine the bodies of all the clauses. + +% Helper predicate to combine the bodies of a list of clauses. +% The base case is when there are no more clauses to combine; the combined body is the current body. +combine_bodies([], Body, Body). +combine_bodies([(Head :- CurrentBody)|RestClauses], PrevBody, Body) :- + % Combine the current body with the previous body using a conjunction (,). + combine_two_bodies(PrevBody, CurrentBody, CombinedBody), + % Recursively combine the rest of the bodies. + combine_bodies(RestClauses, CombinedBody, Body). + +% Predicate to combine two bodies. +% Handles the combination of different Prolog constructs like conjunctions, disjunctions, etc. +combine_two_bodies((A, B), (C, D), (A, B, C, D)) :- !. % Combine conjunctions. +combine_two_bodies((A; B), (C; D), (A; B; C; D)) :- !. % Combine disjunctions. +combine_two_bodies(A, B, (A, B)). % Combine simple terms using conjunction. +*/ + +% if there are no more bodies, the accumulated Combined is the final CombinedBodies. +combine_bodies([], _, Combined, Combined). +% combine the transformed body with the accumulated bodies. +combine_bodies([(Head:-Body)|T], NewHead, Acc, CombinedBodies) :- + transform(Head, NewHead, Body, TransformedBody), + % Create a disjunction between the accumulated bodies and the transformed body. + NewAcc = (Acc;TransformedBody), + combine_bodies(T, NewHead, NewAcc, CombinedBodies). + +% combine_code/3 combines Guard and Body to produce either Guard, Body, or a conjunction of both, depending on the values of Guard and Body. +combine_code(Guard, Body, Guard) :- Body==true, !. +combine_code(Guard, Body, Body) :- Guard==true, !. +combine_code((A,B,C), Body, Out):- combine_code(C,Body,CBody),combine_code(B,CBody,BCBody),combine_code(A,BCBody,Out). +combine_code((AB,C), Body, Out):- combine_code(C,Body,CBody),combine_code(AB,CBody,Out). +combine_code(Guard, Body, (Guard, Body)). + + +combine_code([A|Nil],O):- Nil==[],!,combine_code(A,O). +combine_code([A|B],O):- \+ is_list(B),combine_code(A,AA),combine_code(B,BB),!, + combine_code([AA,BB],O). +combine_code([A,B|C],O):- \+ is_list(B), + combine_code(A,AA),combine_code(B,BB),!, + combine_code(AA,BB,AB), + combine_code([AB|C],O),!. +combine_code((A;O),(AA;OO)):- !, combine_code(A,AA),combine_code(O,OO). +combine_code(AO,AO). + + + +% create_unifier/3 creates a unification code that unifies OneHead with NewHead. +% If OneHead and NewHead are structurally equal, then they are unified and the unification Guard is 'true'. +% Otherwise, the unification code is 'metta_unify(OneHead,NewHead)'. + +create_unifier(OneHead,NewHead,Guard):- OneHead=@=NewHead,OneHead=NewHead,!,Guard=true. +create_unifier(OneHead,NewHead,Guard):- compound(OneHead), + compound_name_list(OneHead,_,Args1), + compound_name_list(NewHead,_,Args2), + create_unifier_goals(Args1,Args2,Guard),!. +create_unifier(OneHead,NewHead,u(OneHead,NewHead)). + +create_unifier_goals([V1],[V2],u(V1,V2)):-!. +create_unifier_goals([V1|Args1],[V2|Args2],RightGuard):-!, + create_unifier_goals(Args1,Args2,Guard), + combine_code(u(V1,V2),Guard,RightGuard). +create_unifier_goals([],[],true). + + +% transform/4 combines unification code with Body to produce NewBody according to the transformations required by NewHead. +% It uses create_unifier/3 to generate the unification code between OneHead and NewHead. +transform(OneHead, NewHead, Body, NewBody):- create_unifier(OneHead,NewHead,Guard), + combine_code(Guard,Body,NewBody). + + +unnumbervars_clause(Cl,ClU):- + copy_term_nat(Cl,AC),unnumbervars(AC,UA),copy_term_nat(UA,ClU). +% =============================== +% Compile in memory buffer +% =============================== +is_clause_asserted(AC):- unnumbervars_clause(AC,UAC), + expand_to_hb(UAC,H,B),clause(H,B,Ref),clause(HH,BB,Ref), + strip_m(HH,HHH),HHH=@=H, + strip_m(BB,BBB),BBB=@=B,!. + +strip_m(M:BB,BB):- nonvar(BB),nonvar(M),!. +strip_m(BB,BB). + +get_clause_pred(UAC,F,A):- expand_to_hb(UAC,H,_),strip_m(H,HH),functor(HH,F,A). + +:- dynamic(needs_tabled/2). + +add_assertion(Space,List):- is_list(List),!,maplist(add_assertion(Space),List). +add_assertion(Space,AC):- unnumbervars_clause(AC,UAC), add_assertion1(Space,UAC). +add_assertion1(_,AC):- /*'&self':*/is_clause_asserted(AC),!. +add_assertion1(_,AC):- get_clause_pred(AC,F,A), \+ needs_tabled(F,A), !, pfcAdd(/*'&self':*/AC),!. + +add_assertion1(_KB,ACC) :- + copy_term(ACC,AC,_), + expand_to_hb(AC,H,_), + as_functor_args(H,F,A), as_functor_args(HH,F,A), + % assert(AC), + % Get the current clauses of my_predicate/1 + findall(HH:-B,clause(/*'&self':*/HH,B),Prev), + copy_term(Prev,CPrev,_), + % Create a temporary file and add the new assertion along with existing clauses + append(CPrev,[AC],NewList), + cl_list_to_set(NewList,Set), + length(Set,N), + if_t(N=2, + (Set=[X,Y], + numbervars(X), + numbervars(Y), + nl,display(X), + nl,display(Y), + nl)), + %wdmsg(list_to_set(F/A,N)), + abolish(/*'&self':*/F/A), + create_and_consult_temp_file(F/A, Set). + + +cl_list_to_set([A|List],Set):- + member(B,List),same_clause(A,B),!, + cl_list_to_set(List,Set). +cl_list_to_set([New|List],[New|Set]):-!, + cl_list_to_set(List,Set). +cl_list_to_set([A,B],[A]):- same_clause(A,B),!. +cl_list_to_set(List,Set):- list_to_set(List,Set). + +same_clause(A,B):- A==B,!. +same_clause(A,B):- A=@=B,!. +same_clause(A,B):- unnumbervars_clause(A,AA),unnumbervars_clause(B,BB),same_clause1(AA,BB). +same_clause1(A,B):- A=@=B. +same_clause1(A,B):- expand_to_hb(A,AH,AB),expand_to_hb(B,BH,BB),AB=@=BB, AH=@=BH,!. + +%clause('is-closed'(X),OO1,Ref),clause('is-closed'(X),OO2,Ref2),Ref2\==Ref, OO1=@=OO2. + +% Predicate to create a temporary file and write the tabled predicate +create_and_consult_temp_file(F/A, PredClauses) :- + % Generate a unique temporary memory buffer + tmp_file_stream(text, TempFileName, TempFileStream), + % Write the tabled predicate to the temporary file + format(TempFileStream, ':- multifile((~q)/~w).~n', [F, A]), + format(TempFileStream, ':- dynamic((~q)/~w).~n', [F, A]), + %if_t( \+ option_value('tabling',false), + if_t(option_value('tabling','True'),format(TempFileStream,':- ~q.~n',[table(F/A)])), + maplist(write_clause(TempFileStream), PredClauses), + % Close the temporary file + close(TempFileStream), + % Consult the temporary file + % abolish(F/A), + /*'&self':*/consult(TempFileName), + % Delete the temporary file after consulting + %delete_file(TempFileName), + true. + + +% Helper predicate to write a clause to the file +write_clause(Stream, Clause) :- + subst_vars(Clause,Can), + write_canonical(Stream, Can), + write(Stream, '.'), + nl(Stream). + +same(X,Y):- X =~ Y. + + +end_of_file. + + + + % If any sub-term of Convert is a control flow imperative, convert that sub-term and then proceed with the conversion. + f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- fail, + % Get the least deepest sub-term AsFunction of Convert + get_first_p1(AsFunction,Convert,N1Cmpd), + arg(2,N1Cmpd,Cmpd), + Cmpd \= ( ==(_,_) ), + (Cmpd = [EE,_,_] -> (EE \== '==') ; true ), + AsFunction\=@= Convert, + callable(AsFunction), % Check if AsFunction is callable + Depth2 is Depth -0, + % check that that is is a control flow imperative + f2q(Depth2,HeadIs,RetType,Result,AsFunction, AsPred), + HeadIs\=@=AsFunction,!, + subst(Convert, AsFunction, Result, Converting), % Substitute AsFunction by Result in Convert + f2p(Depth2,HeadIs,RetType,RetResult,(AsPred,Result==AsFunction,Converting), Converted). % Proceed with the conversion of the remaining terms + + + % If any sub-term of Convert is a control flow imperative, convert that sub-term and then proceed with the conversion. + f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- fail, + deep_lhs_sub_sterm(AsFunction, Convert), + AsFunction\=@= Convert, + % Get the deepest sub-term AsFunction of Convert + % sub_term(AsFunction, Convert), AsFunction\==Convert, + callable(AsFunction), % Check if AsFunction is callable + Depth2 is Depth -0, + f2q(Depth2,HeadIs,RetType,Result,AsFunction, AsPred), + HeadIs\=@=AsFunction,!, + subst(Convert, AsFunction, Result, Converting), % Substitute AsFunction by Result in Convert + f2p(Depth2,HeadIs,RetType,RetResult,(AsPred,Converting), Converted). % Proceed with the conversion of the remaining terms + + % If any sub-term of Convert is a function, convert that sub-term and then proceed with the conversion. + f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- fail, + deep_lhs_sub_sterm(AsFunction, Convert), % Get the deepest sub-term AsFunction of Convert + AsFunction\=@= Convert, + callable(AsFunction), % Check if AsFunction is callable + %is_function(AsFunction, Nth), % Check if AsFunction is a function and get the position Nth where the result is stored/retrieved + HeadIs\=@=AsFunction, + funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, AsPred), % Convert AsFunction to a predicate AsPred + subst(Convert, AsFunction, Result, Converting), % Substitute AsFunction by Result in Convert + f2p(Depth,HeadIs,RetType,RetResult, (AsPred, Converting), Converted). % Proceed with the conversion of the remaining terms + /* + % If AsFunction is a recognized function, convert it to a predicate. + f2q(Depth,HeadIs,RetType,RetResult,AsFunction,AsPred):- % HeadIs\=@=AsFunction, + is_function(AsFunction, Nth), % Check if AsFunction is a recognized function and get the position Nth where the result is stored/retrieved + funct_with_result_is_nth_of_pred(HeadIs,AsFunction, RetResult, Nth, AsPred), + \+ ( compound(AsFunction), arg(_,AsFunction, Arg), is_function(Arg,_)),!. + */ + + % If any sub-term of Convert is an u_assign/2, convert that sub-term and then proceed with the conversion. + f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- fail, + deep_lhs_sub_sterm0(ConvertFunction, Convert), % Get the deepest sub-term AsFunction of Convert + callable(ConvertFunction), % Check if AsFunction is callable + ConvertFunction = u_assign(AsFunction,Result), + ignore(is_function(AsFunction, Nth)), + funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, Nth, AsPred), % Convert AsFunction to a predicate AsPred + subst(Convert, ConvertFunction, Result, Converting), % Substitute AsFunction by Result in Convert + f2p(Depth,HeadIs,RetType,RetResult, (AsPred, Converting), Converted). % Proceed with the conversion of the remaining terms + diff --git a/.Attic/canary_docme/metta_compiler_inlining.pl b/.Attic/canary_docme/metta_compiler_inlining.pl new file mode 100644 index 00000000000..851ad26246c --- /dev/null +++ b/.Attic/canary_docme/metta_compiler_inlining.pl @@ -0,0 +1,981 @@ + + +eval_for(_,Var,B,C):- var(Var),!, B=C. +eval_for(_, _, B, C):- B==C,!. +eval_for(b_C, A, B, C):- !, eval_for1(b_C,A,B,C), \+ \+ ((get_type(C,CT),can_assign(CT,A))). +eval_for(Why, A, B, C):- eval_for1(Why,A,B,C). + +eval_for1(_Why,_,B,C):- \+ callable(B),!, B= C. +eval_for1(_Why,_,B,C):- compound(B),compound(C),B=C,!. +eval_for1(_Why,'Any',B,C):- !, eval(B,C). +eval_for1(_Why,'AnyRet',B,C):- !, eval(B,C). +eval_for1(b_6,'Atom',B,C):- !, eval(B,C). +eval_for1(_,'Atom',B,C):- !, B=C. +eval_for1(_Why,A,B,C):- eval_for(A,B,C). + +why_call(_,Goal):- %println(Y),trace, + call(Goal). + + +u_assign1(B,C):- u_assign5(B,C). +u_assign2(B,C):- u_assign5(B,C). +u_assign3(B,C):- u_assign5(B,C). +u_assign4(B,C):- u_assign5(B,C). +u_assign6(B,C):- u_assignI(B,C). +u_assign7(B,C):- u_assignI(B,C). +u_assign8(B,C):- u_assign5(B,C). +u_assign9(B,C):- u_assign5(B,C). +u_assignA(B,C):- u_assign5(B,C). +u_assignB(B,C):- u_assign5(B,C). +u_assignC(B,C):- u_assign5(B,C). +u_assign5(B,C):- \+ compound(B),!,B=C. +u_assign5(B,C):- u_assignI(B,C). + +u_assignI(B,C):- var(B),!,B=C. +u_assignI(B,C):- u_assign(B,C). + +:- op(700,xfx,'=~'). + +:- discontiguous f2q/6. + + +f2p(RetResult,Convert, Converted):- + f2p(my_head,_ANY_,RetResult,Convert, Converted). + +f2p(HeadIs,RetResult,Convert, Converted):- + f2p(HeadIs,_ANY_,RetResult,Convert, Converted),!. + +f2p(HeadIs,RetType,RetResult,Convert, Converted):- + f2p(40,HeadIs,RetType,RetResult,Convert, Converted). + +f2p(Depth,HeadIs,RetType,RetResult,Convert, Converted):- + Depth2 is Depth-1, + f2q(Depth2,HeadIs,RetType,RetResult,Convert, Converting), + convert_fromi(Depth2,Converting, Converted),!. + +%f2p(_Depth,_HeadIs,_RetType,RetResult,Convert, eval(Convert,RetResult)). + + +convert_fromi(_Depth,Converted, Converted):- !. +convert_fromi(_Depth,Converted, Converted):- is_ftVar(Converted),!. +convert_fromi(_Depth,Converted, Converted):- \+ compound(Converted),!. +%convert_fromi(_Depth, u_assign(E,R), UA):- !, u_assign(E,R)=UA. +convert_fromi(Depth,(A,B), (AA,BB)):- !, convert_fromi(Depth,A,AA), convert_fromi(Depth,B,BB). +convert_fromi(Depth,Converting, Converted):- is_list(Converting),!,maplist(convert_fromi(Depth),Converting, Converted). +convert_fromi(Depth,Converting, Converted):- compound_name_arguments(Converting,F,Args),!, + maplist(convert_fromi(Depth),Args, NewArgs),!, + compound_name_arguments(Converted,F,NewArgs). + +%convert_fromi(Depth,Converting, Converted):- f2q(Depth,Converting, Converted). +is_fqVar(Var2):- is_ftVar(Var2),!. +is_fqVar(Var2):- symbol(Var2),!. + + +%f2q(_Depth,_HeadIs,RetType,Var1, Var2, ((Var1=Var2))):- +% is_fqVar(Var1),is_fqVar(Var2),!. + + +f2q(_Depth,_HeadIs, RetType,RetVar, Convert, true) :- + is_ftVar(RetVar),is_ftVar(RetType),is_ftVar(Convert), + RetVar=Convert,!. % Check if Convert is a variable + +f2q(_Depth,_HeadIs, RetType,RetVar, Convert, eval_for(b_C,RetType,Convert,RetVar)) :- + is_ftVar(Convert),!.% Check if Convert is a variable + +f2q(_Depth,_HeadIs,RetType,RetVar, [C|Convert], eval_for(b_B,RetType,[C|Convert],RetVar)) :- + is_ftVar(C),!.% Check if Convert is a variable + +f2q(Depth,HeadIs,RetType,RetResult, eval(Convert), Code):- !, + DepthM1 is Depth-1, f2q(DepthM1,HeadIs,RetType,RetResult, Convert, Code). + + + +f2q(_Depth,_HeadIs,_RetType,_RetResult, u_assign(E,R), UA):- !, + u_assign2(E,R)=UA. + +f2q(_Depth,_HeadIs,_RetType,RetResult,Convert, Converted) :- % HeadIs\=@=Convert, + is_arity_0(Convert,F), !, Converted = u_assign3([F],RetResult),!. + +% If Convert is a ":-" (if) function, we convert it to the equivalent ":-" (if) predicate. +f2q(_Depth,_HeadIs,RetType,RetResult, Convert, true) :- ignore(RetType='Atom'), + (Convert = (H:-B)), + (RetResult= (H:-B)). + + +get_ret_type([F|Args],RetType):- is_list(Args),!, + ((length(Args,Len),(PL = Len ; PL is Len + 1 ; PL is Len - 1), + PL>=0, + length(Params,PL), + get_operator_typedef1(_Self,F,Params,RetType), + RetType \== 'RetAny')*->true;RetType=_/*'%Undefined%'*/). +get_ret_type(F,RetType):- get_type(F,RetType). + + +f2q(Depth,HeadIs,RetType,RetVar, Data, CodeOut):- var(RetType), nonvar(Data), + get_ret_type(Data,PRT),nonvar(PRT),!,RetType=PRT, + f2q(Depth,HeadIs,RetType,RetVar, Data, CodeOut). + +f2q(Depth,HeadIs,RetType,RetVar, Data, CodeOut):- var(RetType), nonvar(RetVar), + get_ret_type(RetVar,PRT),nonvar(PRT),!,RetType=PRT, + f2q(Depth,HeadIs,RetType,RetVar, Data, CodeOut). + +f2q(Depth,HeadIs,RetType,RetVal,Convert,Code):- + compound_non_cons(Convert),into_list_args(Convert,ConvertL), + f2q(Depth,HeadIs,RetType,RetVal,ConvertL,Code),!. + +f2q(Depth,HeadIs,RetType,C,Convert,CodeOut):- + Convert =~ ['-',A,B], + f2p(Depth,HeadIs,RetType,NewA, A, ACodeOut), + f2p(Depth,HeadIs,RetType,NewB, B, BCodeOut), + combine_code([ACodeOut,BCodeOut,'-'(NewA,NewB,C)],CodeOut). + +f2q(_Depth,_HeadIs,_RetType,RetResult,Convert,eval_true(Convert)):- fail, + %nl,print(Convert),nl, + as_functor_args(Convert,F,A,Args), + \+ (member(Arg,Args),(is_list(Arg);compound(Arg))), + is_absorbed_return_value(F,A,RResult), + RResult=RetResult. + +f2q(Depth,_HeadIs,_RetType,RetResult, Convert, u_assign4(Convert,RetResult)) :- Depth=<0,!. + +f2q(_Depth,_HeadIs,_RetType,RetResult, Convert, true) :- + (number(Convert)),RetResult=Convert,!.% Check if Convert is a ... + + +% If Convert is a number or an symbol, it is considered as already converted. +f2q(_Depth,_HeadIs,_RetType,RetResult, Convert, why_call(is_data, Convert = RetResult )) :- % HeadIs,RetType\=@=Convert, + once(number(Convert); symbol(Convert); data_term(Convert)), % Check if Convert is a number or an symbol + !. % Set RetResult to Convert as it is already in predicate form + +data_term(Convert):- \+ compound(Convert), + self_eval(Convert),!, + (iz_conz(Convert) ; \+ compound(Convert)). + +f2q(_Depth,_HeadIs,_RetType,RetResult, Convert, (RetResult =~ Convert)) :- data_term(Convert),!.% Check if Convert is a ... + +f2q(_Depth,_HeadIs,_RetType,RetResult, Convert, true) :- + (data_term(Convert)),RetResult=Convert,!.% Check if Convert is a ... + +% If Convert is a variable, the corresponding predicate is just u_assign(Convert, RetResult) +f2q(_Depth,_HeadIs,_RetType,RetResult,Convert, RetResultConverted) :- + is_ftVar(Convert),!,% Check if Convert is a variable + into_equals(RetResult,Convert,RetResultConverted). + % Converted = u_assign(Convert, RetResult). % Set Converted to u_assign(Convert, RetResult) + +f2q(_Depth,_HeadIs,_RetType,RetResult,Convert, RetResultConverted) :- + number(Convert),!,into_equals(RetResult,Convert,RetResultConverted). + +% If Convert is a "," (and) function, we convert it to the equivalent "," (and) predicate. +f2q(Depth,HeadIs,_RetType,RetResult,SOR,CC) :- + SOR =~ [LogOp, AsPredI, Convert], ',' == LogOp, + RetResult = [LogOp,RetResult1, RetResult2], + must_det_ll((f2p(Depth,HeadIs,_RetType1,RetResult1,AsPredI, AsPredO), + f2p(Depth,HeadIs,_RetType2,RetResult2,Convert, Converted))),!, + combine_code(AsPredO,Converted,CC). + + + f2q(Depth,HeadIs,RetType,RetResult,SOR,(AsPredO,Converted)) :- + SOR =~ [LogOp, AsPredI, Convert], 'and' == LogOp,!, + must_det_ll((f2p(Depth,HeadIs,'Bool','True',AsPredI, AsPredO), + f2p(Depth,HeadIs,RetType,RetResult,Convert, Converted))),!. + +f2q(Depth,HeadIs,RetType,RetResult,SOR,CC) :- + SOR =~ [LogOp, AsPredI, Convert], 'and' == LogOp, + %RetType = 'Bool', RetResultB = 'True', RetResultA = 'True', + must_det_ll((f2p(Depth,HeadIs,RetTypeA,RetResultA,AsPredI, AsPredO), + f2p(Depth,HeadIs,RetTypeB,RetResultB,Convert, Converted))),!, + combine_code([ AsPredO, RetResult=RetResultA, Converted, + why_call(merge_rettypes,narrow_types([RetTypeA,RetTypeB],RetType)), + why_call(same_result,RetResultA==RetResultB), + why_call(return_val,RetResult=RetResultB)],CC). + + f2q(Depth,HeadIs,RetType,RetResult,SOR,(AsPredO;Converted)) :- + SOR =~ [LogOp, AsPredI, Convert], 'or' == LogOp,!, + must_det_ll((f2p(Depth,HeadIs,RetType,RetResult,AsPredI, AsPredO), + f2p(Depth,HeadIs,RetType,RetResult,Convert, Converted))),!. + + + +f2q(Depth,HeadIs,RetType,RetResult,SOR,CC) :- + SOR =~ [LogOp, AsPredI, Convert], 'or' == LogOp, + % RetType = 'Bool', + %RetResultB = 'True', RetResultA = 'True', + must_det_ll((f2p(Depth,HeadIs,RetTypeA,RetResultA,AsPredI, AsPredO), + f2p(Depth,HeadIs,RetTypeB,RetResultB,Convert, Converted))),!, + combine_code(( AsPredO, RetResult=RetResultA,RetType=RetTypeA); + (Converted,RetResult=RetResultB,RetType=RetTypeB),CC). + + +f2q(_Depth,_HeadIs,_RetType,RetResult,Convert, eval(Convert,RetResult)):- fail, + interpet_this(Convert),!. + +f2q(_Depth,_HeadIs,_RetType,RetResult,Convert,Converted) :- fail, % dif_functors(HeadIs,Convert), + Convert =~ [H|_], \+ symbol(H), \+ is_non_evaluatable(H), + Converted = (Convert=RetResult),!. + +f2q(Depth,HeadIs,RetType,Atom,Convert,Converted) :- + Convert=~ match(Space,Q,T),Q==T,Atom=Q,!, + f2p(Depth,HeadIs,RetType,Atom,'get-atoms'(Space),Converted). + +f2q(Depth,HeadIs,_RetType,AtomsVar,Convert,Converted) :- + Convert=~ 'get-atoms'(Space), Pattern = AtomsVar, + compile_pattern(Depth,HeadIs,Space,Pattern,Converted). + +f2q(Depth,HeadIs,RetType,RetResult,Convert,Converted) :- %dif_functors(HeadIs,Convert), + Convert =~ 'match'(ESpace,Pattern,Template),!, + must_det_ll(( + f2p(Depth,HeadIs,_SpaceT,SpaceV,ESpace,Code), + %term_variables(Template,TemplateVars), + compile_pattern(Depth,HeadIs,SpaceV,Pattern,SpacePatternCode), + f2p(Depth,HeadIs,RetType,RetResult,Template,TemplateCode), + combine_code((Code,SpacePatternCode),TemplateCode,Converted))). + + compile_pattern(_Depth,_HeadIs,Space,Pattern,SpaceMatchCode):- + SpaceMatchCode = metta_atom_iter(Space,Pattern). + + +/* + f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- dif_functors(HeadIs,Convert), + Convert =~ 'match'(_Space,Match,Template),!, + must_det_ll(( + f2p(Depth,HeadIs,RetType,_,Match,MatchCode), + into_equals(RetResult,Template,TemplateCode), + combine_code(MatchCode,TemplateCode,Converted))). +*/ + + +interpet_this(_Convert):-!, fail. + +interpet_this(Convert):- as_functor_args(Convert,F,A,Args), interpet_this(Convert,F,A,Args). +interpet_this(_,F,_,_):- \+ symbolic(F),!. +interpet_this(_,F,_,_):- compile_this_s(F),!,fail. +interpet_this(_,F,_,_):- interpet_this_f(F),!. +% stable workarround until the '=~' bug is fixed for numbers +interpet_this(Convert,F,A,Args):- compile_this(Convert,F,A,Args),!,fail. +interpet_this(_,_,_,_). + +interpet_this_f(_Convert):-!, fail. +interpet_this_f(F):- metta_atom_file_buffer_isa(F,'Compiled'),!,fail. +interpet_this_f(F):- metta_atom_file_buffer_isa(F,'Interpreted'),!. +interpet_this_f(F):- op_decl(F, [ 'Number', 'Number' ], 'Number'). + +compile_this(_):-!. +compile_this(Convert):- as_functor_args(Convert,F,A,Args), compile_this(Convert,F,A,Args). +compile_this(_,F,_,_):- \+ symbolic(F),!, fail. +compile_this(_,F,_,_):- compile_this_f(F),!. + + compile_this_f(_):-!. +compile_this_f(F):- metta_atom_file_buffer_isa(F,'Compiled'). +compile_this_f(F):- interpet_this_f(F),!,fail. +compile_this_f(F):- compile_this_s(F),!. +compile_this_f(F):- metta_atom_file_buffer([':',F,[Ar|_]]), Ar=='->', !. +compile_this_s('superpose'). +compile_this_s('match'). +compile_this_s('do'). +compile_this_s('do-all'). + + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- fail, dif_functors(HeadIs,Convert), + get_inline_def(Convert,NewDef),!, + must_det_ll((f2p(Depth,HeadIs,RetType,RetResult,NewDef,Converted))). + +f2q(Depth,HeadIs,RetType,RetResult,Convert, do(Converted)) :- % dif_functors(HeadIs,Convert), + Convert =~ ['do',Body],!, + ignore(RetResult='Empty'), + f2p(Depth,HeadIs,RetType,_RetResult,Body, Converted). + +f2q(Depth,HeadIs,_RetTypeD,RetResult,Convert, (doall(Converted),RetResult='Empty')) :- % dif_functors(HeadIs,Convert), + Convert =~ ['do-all',Body],!, + f2p(Depth,HeadIs,_RetTypeB,_RetResultB,Body, Converted). + + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), + Convert =~ ['let',Var,Value1,Body],!, + f2p(Depth,HeadIs,_,ResValue1,Value1,CodeForValue1), + into_equals(Var,ResValue1,CodeEquals), + f2p(Depth,HeadIs,RetType,RetResult,Body,BodyCode), + combine_code([CodeForValue1,CodeEquals,BodyCode],Converted). + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), + Convert =~ ['let',Var,Value1,Body],!, + f2p(Depth,HeadIs,_,Var,Value1, BindingCode), + f2p(Depth,HeadIs,RetType,RetResult,Body, BodyCode), + combine_code(BindingCode,BodyCode,Converted). + +is_Nil(Nil):- Nil==[],!. +is_Nil(Nil):- Nil=='Nil',!. +is_Nil(Nil):- Nil=='()',!. + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- %dif_functors(HeadIs,Convert), + Convert =~ ['let*',Nil,Body],is_Nil(Nil), !, + must_det_ll((f2p(Depth,HeadIs,RetType,RetResult,Body, Converted))). + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- %dif_functors(HeadIs,Convert), + Convert =~ ['let*',AAAA,Body],AAAA=~[VE|Bindings],VE=~[V,E], + f2q(Depth,HeadIs,RetType,RetResult,['let',V,E,['let*',Bindings,Body]], Converted). + + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- fail, dif_functors(HeadIs,Convert), + Convert =~ ['let*',Bindings,Body],!, + must_det_ll(( + maplist(compile_let_star(Depth,HeadIs,RetType),Bindings,CodeList), + combine_code(CodeList,BindingCode), + f2p(Depth,HeadIs,RetType,RetResult,Body,BodyCode), + combine_code(BindingCode,BodyCode,Converted))). + +compile_let_star(Depth,HeadIs,RetType,NV,Converted):- + must_det_ll((NV =~ [Expression,Var], + (var(Var)-> f2p(Depth,HeadIs,RetType,Var,Expression,Converted); + (var(Expression)-> f2p(Depth,HeadIs,RetType,Expression,Var,Converted); + (f2p(Depth,HeadIs,RetType,Eval1Result,Expression,Code), + into_equals(Eval1Result,Var,Eval1ResultVar), + combine_code(Code,Eval1ResultVar,Converted)))))),!. + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- + Convert =~ ['superpose',COL],compound_equals(COL,'collapse'(Value1)), !, + f2p(Depth,HeadIs,RetType,ResValue1,Value1,CodeForValue1), + Converted = (find_ne(ResValue1,CodeForValue1,Gathered),member(RetResult,Gathered)). + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- + Convert =~ ['sequential'|ValueL], + ReConvert =~ ['superpose'|ValueL],!, + f2q(Depth,HeadIs,RetType,RetResult,ReConvert, Converted). + +f2q(Depth,HeadIs,RetType,RetResult,Convert, (Converted)) :- + Convert =~ ['sequential',ValueL],is_list(ValueL),!, + %maybe_unlistify(UValueL,ValueL,URetResult,RetResult), + maplist(f2p_assign(Depth,HeadIs,RetType),RetResultL,ValueL,CodeForValueL), + last(RetResultL,RetResult), + combine_code(CodeForValueL,Converted),!. + +f2q(Depth,HeadIs,RetType,RetResult,Convert, (Converted)) :- + Convert =~ ['superpose',ValueL],is_list(ValueL),!, + %maybe_unlistify(UValueL,ValueL,URetResult,RetResult), + must_det_ll(( ignore(cname_var('SP_Ret',RetResult)), + maplist(f2p(Depth,HeadIs,RetType,RetResult),ValueL,CodeForValueL), + list_to_disjuncts(CodeForValueL,Converted))),!. + +f2q(_Depth,_HeadIs,_RetType,RetResult,Convert, (Converted)) :- + Convert =~ ['superpose',ValueL],is_nsVar(ValueL),!, + %maybe_unlistify(UValueL,ValueL,URetResult,RetResult), + Converted = call('superpose'(ValueL,RetResult)), + cname_var('MeTTa_SP_',ValueL). + + +:- op(700,xfx, =~). +f2q(Depth,HeadIs,RetType,RetResult,Convert, (Code1,Eval1Result=Result,Converted)) :- % dif_functors(HeadIs,Convert), + Convert =~ 'chain'(Eval1,Result,Eval2),!, + f2p(Depth,HeadIs,RetType,Eval1Result,Eval1,Code1), + f2p(Depth,HeadIs,RetType,RetResult,Eval2,Converted). + +f2q(Depth,HeadIs,RetType,ResValue2,Convert, (CodeForValue1,Converted)) :- % dif_functors(HeadIs,Convert), + Convert =~ ['eval-in-space',Value1,Value2], + f2p(Depth,HeadIs,RetType,ResValue1,Value1,CodeForValue1), + f2p(Depth,HeadIs,RetType,ResValue2,Value2,CodeForValue2), + Converted = with_space(ResValue1,CodeForValue2). + + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), + once(Convert =~ 'if'(Cond,Then,Else);Convert =~ 'If'(Cond,Then,Else)), + !,Test = is_True(CondResult), + f2p(Depth,HeadIs,RetType,CondResult,Cond,CondCode), + compile_test_then_else(Depth,RetResult,(CondCode,Test),Then,Else,Converted). + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- dif_functors(HeadIs,Convert), + once(Convert =~ 'if'(Cond,Then);Convert =~ 'If'(Cond,Then)), + f2p(Depth,HeadIs,RetType,CondResult,Cond,CondCode), + f2p(Depth,HeadIs,RetType,RetResult,Then,ThenCode), + combine_code([CondCode,is_True(CondResult),ThenCode],Converted). + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), + Convert =~ 'if-error'(Value,Then,Else),!,Test = is_Error(ValueResult), + f2p(Depth,HeadIs,RetType,ValueResult,Value,ValueCode), + combine_code(ValueCode,Test,ValueCodeTest), + compile_test_then_else(Depth,RetResult,ValueCodeTest,Then,Else,Converted). + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), + Convert =~ 'if-empty'(Value,Then,Else),!,Test = is_Empty(ValueResult), + f2p(Depth,HeadIs,RetType,ValueResult,Value,ValueCode), + compile_test_then_else(Depth,RetResult,(ValueCode,Test),Then,Else,Converted). + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), + (Convert =~ 'if-non-empty-expression'(Value,Then,Else)),!, + (Test = ( \+ is_Empty(ValueResult))), + f2p(Depth,HeadIs,RetType,ValueResult,Value,ValueCode), + compile_test_then_else(Depth,RetResult,(ValueCode,Test),Then,Else,Converted). + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), + Convert =~ ['if-equals',Value1,Value2,Then,Else],!,Test = equal_enough(ResValue1,ResValue2), + f2p(Depth,HeadIs,RetType,ResValue1,Value1,CodeForValue1), + f2p(Depth,HeadIs,RetType,ResValue2,Value2,CodeForValue2), + compile_test_then_else(Depth,RetResult,(CodeForValue1,CodeForValue2,Test),Then,Else,Converted). + +cname_var(Sym,_Src):- var(Sym),!. +cname_var(Sym,Src):- var(Src),!,must_det_ll((gensym(Sym,SrcV),Src='$VAR'(SrcV))). +cname_var(Sym,Src):- Src='$VAR'(_),!,must_det_ll((gensym(Sym,SrcV),nb_setarg(1,Src,SrcV))). +cname_var(_Sym,_Src). +cname_var(Name=Var):- cname_var(Name,Var). +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- + Convert =~ ['assertEqual',Value1,Value2],!, + cname_var('Src_',Src), + cname_var('FA_',ResValue1), + cname_var('FA_',ResValue2), + cname_var('FARL_',L1), + cname_var('FARL_',L2), + f2p(Depth,HeadIs,RetType,ResValue1,Value1,CodeForValue1), + f2p(Depth,HeadIs,RetType,ResValue2,Value2,CodeForValue2), + Converted = + (Src = Convert, + loonit_assert_source_tf_empty(Src,L1,L2, + (findall_ne(ResValue1,CodeForValue1,L1), + findall_ne(ResValue2,CodeForValue2,L2)), + equal_enough_for_test(L1,L2),RetResult)). + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- + Convert =~ ['assertEqualToResult',Value1,Value2],!, + f2p(Depth,HeadIs,RetType,ResValue1,Value1,CodeForValue1), + Src = Convert, + Goal = findall_ne(ResValue1,CodeForValue1,L1), + Converted = ( + loonit_assert_source_tf_empty(Src,L1,Value2, + Goal, + equal_enough_for_test(L1,Value2),RetResult)). + +maybe_unlistify([UValueL],ValueL,RetResult,[URetResult]):- fail, is_list(UValueL),!, + maybe_unlistify(UValueL,ValueL,RetResult,URetResult). +maybe_unlistify(ValueL,ValueL,RetResult,RetResult). + +list_to_disjuncts([],false). +list_to_disjuncts([A],A):- !. +list_to_disjuncts([A|L],(A;D)):- list_to_disjuncts(L,D). + + +%f2p_assign(Depth,_HeadIs,_RetType,V,Value,is_True(V)):- Value=='True'. +f2p_assign(_Depth,_HeadIs,_RetType,ValueR,Value,ValueR=Value):- is_nsVar(Value),!. +f2p_assign(_Depth,_HeadIs,_RetType,ValueR,Value,ValueR=Value):- \+ compound(Value),!. +f2p_assign(_Depth,_HeadIs,_RetType,ValueResult,Value,Converted):- + f2p(Value,ValueResult,Converted),!. +f2p_assign(Depth,HeadIs,RetType,ValueResult,Value,Converted):- + f2p(Depth,HeadIs,RetType,ValueResultR,Value,CodeForValue), + %into_equals(ValueResultR,ValueResult,ValueResultRValueResult), + ValueResultRValueResult = (ValueResultR=ValueResult), + combine_code(CodeForValue,ValueResultRValueResult,Converted). + + +f2p_arg(_Depth,_HeadIs,_RetType,Value,Value,true):- is_nsVar(Value),!. +f2p_arg(_Depth,_HeadIs,_RetType,Value,Value,true):- \+ compound(Value),!. +f2p_arg(_Depth,_HeadIs,_RetType,ValueResult,Value,Converted):- h2p(Value,ValueResult,Converted),!. +f2p_arg(Depth,HeadIs,RetType,ValueResult,Value,Converted):- + f2p_assign(Depth,HeadIs,RetType,ValueResult,Value,Converted). + + +f2q(Depth,HeadIs,RetType,RetResult,Convert, keep(Converted)) :- + Convert =~ ['case',Value,PNil],[]==PNil,!,Converted = (ValueCode,RetResult=[]), + f2p(Depth,HeadIs,RetType,_ValueResult,Value,ValueCode). + + +f2q(Depth,HeadIs,RetType,RetResult,Convert, (ValueCode, Converted)) :- + Convert =~ ['case',Value|Options], \+ is_nsVar(Value),!, + cname_var('CASE_VAR_',ValueResult), + f2q(Depth,HeadIs,RetType,RetResult,['case',ValueResult|Options], Converted), + f2p(Depth,HeadIs,RetType,ValueResult,Value,ValueCode). + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- + Convert =~ ['case',Value,Options],!, + must_det_ll(( + maplist(compile_case_bodies(Depth,HeadIs,RetType),Options,Cases), + cname_var('SWITCH_',AllCases), + cname_var('CASE_RESULT_',RetResult), + Converted = + ( AllCases = Cases, + select_case(AllCases,Value,RetResult)))). + +select_case(AllCases,Value,BodyResult):- + once((member(caseOption(MatchVar,MatchCode,BodyResult,BodyCode),AllCases), + rtrace_on_error(MatchCode),unify_case(Value,MatchVar))) + ,!, + rtrace_on_error(BodyCode). + + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- + Convert =~ ['case',Value,[Opt|Options]],nonvar(Opt),!, + must_det_ll(( + compile_case_bodies(Depth,HeadIs,RetType,Opt,caseOption(Value,If,RetResult,Then)), + Converted = ( If -> Then ; Else ), + ConvertCases =~ ['case',Value,Options], + f2q(Depth,HeadIs,RetType,RetResult,ConvertCases,Else))). + + +/* +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- + Convert =~ ['case',Value,Options],!, + must_det_ll(( + maplist(compile_case_bodies(Depth,HeadIs,RetType),Options,Cases), + Converted = + (( AllCases = Cases, + once((member(caseOption(MatchVar,MatchCode,BodyResult,BodyCode),AllCases), + (MatchCode,unify_enough(Value,MatchVar)))), + (BodyCode), + BodyResult=RetResult)))). + +f2q(Depth,HeadIs,RetType,_,Convert, Converted) :- + Convert =~ ['case',Value,Options,RetResult],!, + must_det_ll(( + f2p(Depth,HeadIs,RetType,ValueResult,Value,ValueCode), + maplist(compile_case_bodies(Depth,HeadIs,RetType),Options,Cases), + Converted = + (( AllCases = Cases, + call(ValueCode), + once((member(caseOption(MatchVar,MatchCode,BodyResult,BodyCode),AllCases), + both_of(ValueResult,MatchCode,unify_enough(ValueResult,MatchVar)))), + call(BodyCode), + BodyResult=RetResult)))). + + +both_of(Var,G1,G2):- nonvar(Var),!,call(G2),call(G1). +both_of(_Var,G1,G2):- call(G1),call(G2). + +*/ + +compile_case_bodies(Depth,HeadIs,RetType,[Match,Body],caseOption(_,true,BodyResult,BodyCode)):- Match == '%void%',!, + f2p(Depth,HeadIs,RetType,BodyResult,Body,BodyCode). +compile_case_bodies(Depth,HeadIs,RetType,[Match,Body],caseOption(MatchResult,If,BodyResult,BodyCode)):- !, + f2p(Depth,HeadIs,RetType,MatchResultV,Match,MatchCode), + combine_code(MatchCode,unify_case(MatchResult,MatchResultV),If), + f2p(Depth,HeadIs,RetType,BodyResult,Body,BodyCode). +compile_case_bodies(Depth,HeadIs,RetType,MatchBody,CS):- compound(MatchBody), MatchBody =~ MB,compile_case_bodies(Depth,HeadIs,RetType,MB,CS). + + +compound_equals(COL1,COL2):- COL1=@=COL2,!,COL1=COL2. +compound_equals(COL1,COL2):- compound_equals1(COL1,COL2). +compound_equals1(COL1,COL2):- is_nsVar(COL1),!,is_nsVar(COL2),ignore(COL1=COL2),!. +compound_equals1(COL1,COL2):- compound(COL1),!,compound(COL2), COL1=COL2. + + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- + Convert =~ ['collapse',Value1],!, + f2p(Depth,HeadIs,RetType,ResValue1,Value1,CodeForValue1), + Converted = (findall_ne(ResValue1,CodeForValue1,RetResult)). + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- + Convert =~ ['compose',Value1],!, + Convert2 =~ ['collapse',Value1],!, + f2q(Depth,HeadIs,RetType,RetResult,Convert2, Converted). + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), + Convert =~ ['unify',Value1,Value2,Then,Else],!,Test = metta_unify(ResValue1,ResValue2), + f2p(Depth,HeadIs,RetType,ResValue1,Value1,CodeForValue1), + f2p(Depth,HeadIs,RetType,ResValue2,Value2,CodeForValue2), + compile_test_then_else(Depth,RetResult,(CodeForValue1,CodeForValue2,Test),Then,Else,Converted). + + + + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- dif_functors(HeadIs,Convert), + + Convert =~ ['if-decons',Atom,Head,Tail,Then,Else],!,Test = unify_cons(AtomResult,ResHead,ResTail), + f2p(Depth,HeadIs,RetType,AtomResult,Atom,AtomCode), + f2p(Depth,HeadIs,RetType,ResHead,Head,CodeForHead), + f2p(Depth,HeadIs,RetType,ResTail,Tail,CodeForTail), + compile_test_then_else(Depth,RetResult,(AtomCode,CodeForHead,CodeForTail,Test),Then,Else,Converted). + + + +f2q(_Depth,_HeadIs,_RetType,RetResult,Convert, was_True(RetResult)) :- is_compiled_and(AND), + Convert =~ [AND],!. + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- is_compiled_and(AND), + Convert =~ [AND,Body],!, + f2p(Depth,HeadIs,RetType,RetResult,Body,BodyCode), + compile_test_then_else(Depth,RetResult,BodyCode,'True','False',Converted). + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- is_compiled_and(AND), + Convert =~ [AND,Body1,Body2],!, + f2p(Depth,HeadIs,RetType,B1Res,Body1,Body1Code), + f2p(Depth,HeadIs,RetType,RetResult,Body2,Body2Code), + into_equals(B1Res,'True',AE), + Converted = (Body1Code,AE,Body2Code),!. + + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- is_compiled_and(AND), + Convert =~ [AND,Body1,Body2],!, + f2p(Depth,HeadIs,RetType,B1Res,Body1,Body1Code), + f2p(Depth,HeadIs,RetType,_,Body2,Body2Code), + into_equals(B1Res,'True',AE), + compile_test_then_else(Depth,RetResult,(Body1Code,AE,Body2Code),'True','False',Converted). + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- is_compiled_and(AND), + Convert =~ [AND,Body1,Body2|BodyMore],!, + And2 =~ [AND,Body2|BodyMore], + Next =~ [AND,Body1,And2], + f2q(Depth,HeadIs,RetType,RetResult, Next, Converted). + +% If Convert is an "or" function, we convert it to the equivalent ";" (or) predicate. +f2q(Depth,HeadIs,RetType,RetResult,SOR,or(AsPredO, Converted)) :- + SOR =~ or(AsPredI, Convert), + must_det_ll((f2p(Depth,HeadIs,RetType,RetResult,AsPredI, AsPredO), + f2p(Depth,HeadIs,RetType,RetResult,Convert, Converted))),!. +f2q(Depth,HeadIs,RetType,RetResult,or(AsPredI,Convert), (AsPredO *-> true; Converted)) :- fail, !, + must_det_ll((f2p(Depth,HeadIs,RetType,RetResult,AsPredI, AsPredO), + f2p(Depth,HeadIs,RetType,RetResult,Convert, Converted))). +f2q(Depth,HeadIs,RetType,RetResult,(AsPredI; Convert), (AsPredO; Converted)) :- !, + must_det_ll((f2p(Depth,HeadIs,RetType,RetResult,AsPredI, AsPredO), + f2p(Depth,HeadIs,RetType,RetResult,Convert, Converted))). + +'True'(X):- ignore(is_True(X)). +'False'(X):- is_False(X). + +get_inline_case_list(HeadDef,Quot,CaseList):- + findall([HeadDef,NewDef],get_inline_def1(HeadDef,NewDef),DefList),DefList\==[], + findall([Quot,NewDef],member([HeadDef,NewDef],DefList),CaseList). + +get_inline_def(HeadDef,NewDef):- + findall(NewDef,get_inline_def1(HeadDef,NewDef),EachDef), EachDef\==[], + disj_def(EachDef,NewDef). + + + +get_inline_def1(HeadDef,NewDef):- + into_list_args(HeadDef,UHeadDef), + copy_term(UHeadDef,CopyUHeadDef), + [UHead|_UArgs] = UHeadDef, nonvar(UHead), + metta_atom_file_buffer([Eq,UHeadDef|Body]),Eq=='=', once(xform_body(Body,NewDef)), + (UHeadDef=@=CopyUHeadDef). + +%xform_body([Body],Body):-!. +%xform_body(Items,[progn|Body]). + +xform_body(Var,Var):-is_ftVar(Var), !. +xform_body([],call(true)):-!. +xform_body([Body],Body):-!. +xform_body([Body1,Body2],(Body1,Body2)):-!. +xform_body([Body1|Body2L],(Body1,Body2)):-xform_body(Body2L,Body2). + +disj_def(Var,Var):-is_ftVar(Var), !. +disj_def([],call(fail)):-!. +disj_def([Body],Body):-!. +disj_def([Body1,Body2],(Body1;Body2)):-!. +disj_def([Body1|Body2L],(Body1;Body2)):-disj_def(Body2L,Body2). + + +/* +f2q(Depth,HeadIs,RetType,RetResult,transpose(Convert), Converted,Code) :- !, + maplist(each_result(Depth,HeadIs,RetType,RetResult),Convert, Converted), + list_to_disjuncts(Converted,Code). + +each_result(Depth,HeadIs,RetType,RetResult,Convert,Converted):- + f2p(Depth,HeadIs,RetType,OneResult,Convert,Code1), + into_equals(OneResult,RetResult,Code2), + combine_code(Code1,Code2,Converted). + +*/ +/* +f2q(Depth,HeadIs,RetType,RetResult,Convert, once(u_assign(Body,RetResult))) :- + Convert=~ first_of(Body), is_ftVar(Body),!. +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- + Convert=~ first_of(Body), + must_det_ll((as_functor_args(Body,F,A,Args), + as_functor_args(Quot,quot,A,NewArgs), + as_functor_args(QConvert,quot,A,Args))), + get_inline_case_list([F|NewArgs],Quot,DefList),!, + must_det_ll((f2p(Depth,HeadIs,RetType,RetResult,[case,QConvert,DefList],Converted))).*/ +f2q(Depth,HeadIs,RetType,RetResult,Convert, once(Converted)) :- + Convert=~ first_of(Body),!, f2p(Depth,HeadIs,RetType,RetResult,Body,Converted). + +f2q(Depth,HeadIs,RetType,RetResult,Convert, catch(BodyCode,Ex,HandlerCode)) :- + Convert=~ catch(Body,E,Handler),!, s2p(E,Ex), + f2p(Depth,HeadIs,RetType,RetResult,Body,BodyCode), + f2p(Depth,HeadIs,RetType,RetResult,Handler,HandlerCode). + +f2q(Depth,HeadIs,RetType,RetResult,Convert, call_cleanup(BodyCode,HandlerCode)) :- + Convert=~ finally(Body,Handler),!, + f2p(Depth,HeadIs,RetType,RetResult,Body,BodyCode), + f2p(Depth,HeadIs,RetType,RetResult,Handler,HandlerCode). + + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- fail, dif_functors(HeadIs,Convert), + get_inline_def(Convert,InlineDef),!, + must_det_ll((f2p(Depth,HeadIs,RetType,RetResult,InlineDef,Converted))). + + +% If Convert is a "not" function, we convert it to the equivalent ";" (or) predicate. +f2q(Depth,HeadIs,RetType,RetResult,Convert, \+ eval_true(AsPredO)) :- + '=~'(Convert , (not(AsPredI))), + must_det_ll(f2p(Depth,HeadIs,RetType,RetResult,AsPredI, AsPredO)). + + + +get_first_p1(_,Cmpd,_):- \+ compound(Cmpd),!, fail. +get_first_p1(E,Cmpd,set_nth1(N1,Cmpd)):- is_list(Cmpd), nth1(N1,Cmpd,E). +get_first_p1(E,Cmpd,Result) :- is_list(Cmpd),!, member(Ele,Cmpd), get_first_p1(E,Ele,Result). +get_first_p1(_,Cmpd,_) :- is_conz(Cmpd),!,fail. +get_first_p1(E,Cmpd,set_arg(N1,Cmpd)) :- arg(N1,Cmpd,E). +get_first_p1(E,Cmpd,Result) :- arg(_,Cmpd,Ele),!,get_first_p1(E,Ele,Result). + +non_simple_arg(E):- compound(E),!, \+ is_ftVar(E). + + +f2q(Depth,HeadIs,RetType,RetResult,Converting, (PreArgs,Converted)):- fail, + as_functor_args(Converting,F,A,Args), + \+ \+ (member(E,Args), non_simple_arg(E)), + cname_var('Self',Self), + %Self = '$VAR'('RetType'), + maplist(type_fit_childs('=',Depth,Self),_RetTypes1,ArgsCode,Args,NewArgs), + combine_code(ArgsCode,PreArgs), + nop(non_compat_io(color_g_mesg('magenta', + ((write_src(type_fit_childs('=',Depth,F,_RetTypes2,PreArgs,Args,NewArgs)),nl))))), + as_functor_args(Convert,F,A,NewArgs), + \+ (member(E,NewArgs), non_simple_arg(E)),!, + f2p(Depth,HeadIs,RetType,RetResult,Convert, Converted). + + + /* +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), + Convert =~ if(Cond,Then),!, + f2p(Depth,HeadIs,RetType,CondResult,Cond,CondCode), + f2p(Depth,HeadIs,RetType,RetResult,Then,ThenCode), + Converted = ((CondCode,is_True(CondResult)),ThenCode). + +f2q(Depth,HeadIs,RetType,RetResult,Converter, Converted):- + de_eval(Converter,Convert),!, + f2p(Depth,HeadIs,RetType,RetResult,Convert, Converted). + +f2q(Depth,HeadIs,RetType,_Result,Convert, Converted) + :- fail, + as_functor_args(Convert,Func,PA), + functional_predicate_arg(Func,PA,Nth), + Convert =~ [Func|PredArgs], + nth1(Nth,PredArgs,Result,FuncArgs), + RetResult = Result, + AsFunct =~ [Func|FuncArgs], + f2p(Depth,HeadIs,RetType,RetResult,AsFunct, Converted). + + */ + +% f2q(_Depth,_HeadIs,_RetType, _RetVal, Convert, Convert) :- compound(Convert), (Convert= (_,_)),!. + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- fail, + must_det_ll(( + as_functor_args(Convert,F,A,Args), + as_functor_args(Quot,quot,A,NewArgs), + as_functor_args(QConvert,quot,A,Args))), + get_inline_case_list([F|NewArgs],Quot,DefList),!, + must_det_ll((f2p(Depth,HeadIs,RetType,RetResult,case(QConvert,DefList),Converted))). + +is_non_evaluatable(S):- \+ compound(S),!. +is_non_evaluatable(S):- is_ftVar(S),!. +is_non_evaluatable([H|_]):- \+ symbol(H), \+ is_non_evaluatable(H). +f2q(_Depth,_HeadIs,_RetType,RetResult,Convert, Converted) :- fail, is_non_evaluatable(Convert), + Converted = call_why(non_eval,Convert=RetResult),!. + + +f2q(_Depth,_HeadIs,_RetType,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), + Convert =~ 'bind!'(Var,Value),is_ftVar(Value),!, + Converted = u_assign8('bind!'(Var,Value),RetResult). + +f2q(_Depth,_HeadIs,_RetType,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), + Convert =~ 'bind!'(Var,Value), Value =~ 'new-space'(),!, + Converted = eval('bind!'(Var,Value),RetResult). + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), + Convert =~ 'bind!'(Var,Value), !, + f2p(Depth,HeadIs,RetType,ValueResult,Value,ValueCode), + Eval = eval_args(['bind!',Var,ValueResult],RetResult), + combine_code(ValueCode,Eval,Converted). + + +returns_empty('add-atom'). +returns_empty('remove-atom'). + +f2q(_Depth,_HeadIs,_RetType,RetResult,Convert, Converted) :- + (Convert =~ [EmptyResultFunction,Where,What,RetResult]; + Convert =~ [EmptyResultFunction,Where,What]), + nonvar(EmptyResultFunction), + returns_empty(EmptyResultFunction), + current_predicate(EmptyResultFunction/2), + =(What,WhatP),!, + Converted = as_nop(call(EmptyResultFunction,Where,WhatP),RetResult). + +f2q(Depth,HeadIs,RetType,RetResult,Convert,Converted) :- + Convert =~ ['println!',Value],!, + Converted = (ValueCode,eval(['println!',ValueResult], RetResult)), + f2p(Depth,HeadIs,RetType,ValueResult,Value,ValueCode). + + + +f2q(Depth,HeadIs,RetType,RetResult,Convert,CodeForValueConverted) :- fail, + Convert =~ [Plus,N,Value], symbol(Plus), current_predicate(Plus/3), number(N), + \+ number(Value), \+ is_nsVar(Value),!, + f2p(Depth,HeadIs,RetType,ValueResult,Value,CodeForValue),!, + Converted =.. [Plus,N,ValueResult,RetResult], + combine_code(CodeForValue,Converted,CodeForValueConverted). +/* +% match(Space,f(1)=Y,Y) +f2q(Depth,HeadIs,RetType,Y,Convert,Converted) :- dif_functors(HeadIs,Convert), + Convert=~ match(Space,AsFunctionY,YY), + nonvar(AsFunctionY),( AsFunctionY =~ (AsFunction=Y)), nonvar(AsFunction), + !, Y==YY, + f2p(Depth,HeadIs,RetType,Y,AsFunction,Converted),!. +*/ + +metta_atom_iter(Space,Match):- + metta_atom_iter('=',10,Space,Space,Match). + +make_with_space(Space,MatchCode,MatchCode):- Space=='&self',!. +make_with_space(Space,MatchCode,with_space(Space,MatchCode)):- Space\=='&self'. + +% If Convert is a Value, and RetResult is a Variable bind them together and mark the compiler used them +f2q(_Depth,_HeadIs,_RetType, _RetResult,(A =~ B), (A =~ B)) :-!. + + +% If Convert is an "u_assign" function, we convert it to the equivalent "is" predicate. +f2q(Depth,HeadIs,RetType,RetResult,EvalConvert,Converted):- + EvalConvert =~ eval(Convert), !, + must_det_ll((f2p(Depth,HeadIs,RetType,RetResult,Convert, Converted))). + + +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted):- fail, + compound(Convert), Convert = u_assign(C, Var), compound_non_cons(C),into_list_args(C,CC),!, + f2p(Depth,HeadIs,RetType,RetResult,u_assign(CC, Var), Converted). + +f2q(_Depth,_HeadIs,_RetType,_RetResult,Convert, Converted):- fail, + compound(Convert), + Convert = u_assign(C, _Var), + is_list(C),Converted = Convert,!. + + +f2q(_Depth,HeadIs,_RetType,RetResult,Convert, Converted) :- fail, + symbol(Convert), functional_predicate_arg(Convert,Nth,Nth2), + Nth==1,Nth2==1, + HeadIs\=@=Convert, + Convert = F,!, + must_det_ll(( + do_predicate_function_canonical(FP,F), + compound_name_list(Converted,FP,[RetResult]))). + + +% If Convert is an "is" function, we convert it to the equivalent "is" predicate. +f2q(Depth,HeadIs,RetType,RetResult,is(Convert),(Converted,is(RetResult,Result))):- !, + must_det_ll((f2p(Depth,HeadIs,RetType,Result,Convert, Converted))). + +into_equals(Eval,Result,Code):- + into_u_assign(Eval,Result,Code). + +into_u_assign(Eval,Result,true):- is_nsVar(Eval), is_nsVar(Result), Eval=Result,!. +into_u_assign(Eval,Result,Code):- Result=='True',!,f2p(Eval,_Result,Code). +into_u_assign(Eval,Result,Code):- var(Eval), \+ var(Result), !, into_u_assign(Result,Eval,Code). +into_u_assign(Eval,Result,Code):- f2p(Eval,Result,Code),!. +into_u_assign(Eval,Result,Code):- Code = u_assign5(Eval,Result). + +% check if this is a flow control operation +%f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted):- +% compound(Convert), \+ compound_name_arity(Convert,_,0), +% f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted),!. + +f2q(Depth,HeadIs,RetType,RetResultL, ConvertL, Converted) :- is_list(ConvertL), + ConvertL = [Convert], is_list(Convert), + f2p(Depth,HeadIs,RetType,RetResult,Convert, Code),!, + into_equals(RetResultL,[RetResult],Equals), + combine_code(Code,Equals,Converted). +f2q(_Depth,_HeadIs,_RetType,ResultVar,'cdr-atom'(Atom), 'cdr-atom'(Atom,ResultVar)) :- !. +f2q(_Depth,_HeadIs,_RetType,ResultVar,'car-atom'(Atom), 'car-atom'(Atom,ResultVar)) :- !. + +% If Convert is a list, we convert it to its termified form and then proceed with the functs_to_preds conversion. +f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- fail, is_list(Convert), + once((sexpr_s2p(Convert,IS), \+ IS=@=Convert)), !, % Check if Convert is a list and not in predicate form + must_det_ll((f2p(Depth,HeadIs,RetType,RetResult, IS, Converted))). % Proceed with the conversion of the predicate form of the list. + + +f2q(Depth,HeadIs,RetType,RetResult, ConvertL, Converted) :- fail, is_list(ConvertL), + maplist(f2p_assign(Depth,HeadIs,RetType),RetResultL,ConvertL, ConvertedL), + combine_code(ConvertedL,Conjs), + into_u_assign(RetResultL,RetResult,Code), + combine_code(Conjs,Code,Converted). + + + +/* MAYBE USE ? +% If Convert is a compound term, we need to recursively convert its arguments. +f2q(Depth,HeadIs,RetType,RetResult, Convert, Converted) :- fail, + compound(Convert), !, + Convert =~ [Functor|Args], % Deconstruct Convert to as_functor_args and arguments + maplist(convert_argument, Args, ConvertedArgs), % Recursively convert each argument + Converted =~ [Functor|ConvertedArgs], % Reconstruct Converted with the converted arguments + (callable(Converted) -> f2p(Depth,HeadIs,RetType,RetResult, Converted, _); true). % If Converted is callable, proceed with its conversion +% Helper predicate to convert an argument of a compound term +convert_argument(Arg, ConvertedArg) :- + (callable(Arg) -> ftp(_, _, Arg, ConvertedArg); ConvertedArg = Arg). +*/ + +% convert Funtion +% f2q(Depth,HeadIs,RetType,ResultVar,Convert, Converted) :- h2p(Convert, ResultVar, Converted). + + +/* +f2q(Depth,_HeadIs,_RetType,RetResult,AsPred,Converted):- + compound(AsPred), + as_functor_args(AsPred,F,A,Args), + no_lists(Args), + always_predicate_in_src(F,A), + was_predicate(AsPred,RetResult,Converted). + +f2q(Depth,_HeadIs,_RetType,RetResult,AsPred,Converted):- + compound(AsPred), + as_functor_args(AsPred,F,A,Args), + no_lists(Args), + always_function_in_src(F,A), + was_predicate(AsPred,RetResult,Converted). +*/ + +f2q(_Depth,_HeadIs,_RetType,_RetResult,u_assign(Convert,Res), u_assignA(Convert,Res)):-!. + + + +f2q(Depth,_HeadIs,RetType,RetVar, Data, CodeOut):- + as_functor_args(Data,F,A,Args), + current_self(Self), + length(NewArgs,A), + length(ParamTypes,A), + most_true([get_operator_typedef(Self,F,ParamTypes,RetTypeF), + can_assign(RetTypeF,RetType)]), + if_t(F==(fL), println(Data)), + narrow_types(RetTypeF,RetType,NarrowType), + Call=[F|NewArgs], + append(ParamTypes,[RetType|_],ParamTypesO), + into_eval_for_l(Depth,Call,Self,F,1,ParamTypesO,Args,NewArgs,ParamCode), + combine_code(ParamCode,eval_for(b_6,NarrowType,Call,RetVar),CodeOut). + +f2q(_Depth,_HeadIs,RetType,RetVar,Data,eval_for(b_8,RetType,Data,RetVar)). + +most_true([]):-!. +most_true([A|List]):- call(A),!,most_true(List). +most_true([A|List]):- most_true(List),ignore(A). + + +into_eval_for_l(Depth,HeadIs,Self,F,Nth,[PT|ParamTypes],[A|Args],[N|NewArgs],CCode):- !, + into_eval_for(Depth,HeadIs,Self,F,Nth,PT,A,N,C), + Nth1 is Nth+1, + into_eval_for_l(Depth,HeadIs,Self,F,Nth1,ParamTypes,Args,NewArgs,Code), + combine_code(C,Code,CCode). +into_eval_for_l(_Depth,_HeadIs,_Slf,_F,_Nth,[],Args,Args,true). +into_eval_for_l(_Depth,_HeadIs,_Slf,_F,_Nth,_ParamTypes,[],[],true). + +into_eval_for(_Depth,_HeadIs,_Slf,_F,_Nth,PT,A,A,true):- number(A),!,ignore(PT='Number'). +into_eval_for(_Depth,_HeadIs,_Slf,_F,_Nth,PT,A,N,eval_for(b_5,PT,A,N)):- nonvar(PT), PT\=='Atom',var(A),!. +into_eval_for(_Depth,_HeadIs,_Slf,F,Nth,PT,A,N,eval_for(b_4(Nth,F),PT,A,N)):- var(PT), var(A),!. +%into_eval_for(Depth,HeadIs,_Slf,_F,_Nth,RetType,[-,A,B],C,(ACodeOut,BCodeOut,-(NewA,NewB,C))):- +%f2p(Depth,HeadIs,RetType,NewA, A, ACodeOut), +%f2p(Depth,HeadIs,RetType,NewB, B, BCodeOut),!. + +into_eval_for(Depth,HeadIs,_Slf,_F,_Nth,RetType,Arg,NewArg,CodeOut):- is_list(Arg), + f2p(Depth,HeadIs,RetType,NewArg,Arg, CodeOut),!. + +into_eval_for(Depth,HeadIs,Slf,F,Nth,RetType,Arg,NewArgO,CodeOut):- + compound(Arg), as_functor_args(Arg,AF,_A,Args), + Compile = [AF|Args], !, into_eval_for(Depth,HeadIs,Slf,F,Nth,RetType,Compile,NewArgO,CodeOut),!. + +into_eval_for(_Depth,_HeadIs,_Slf,_F,_Nth,PT,A,N,eval_for(b_3,PT,A,N)):- var(PT), get_type(A,PT),nonvar(PT),!. +into_eval_for(_Depth,_HeadIs,_Slf,F,Nth,PT,A,N,eval_for(b_2(Nth,F),PT,A,N)):- var(PT), !. +into_eval_for(_Depth,_HeadIs,_Slf,_F,_Nth,PT,A,N,eval_for(b_1,PT,A,N)):- nonvar(PT),PT\=='Atom', !. +into_eval_for(_Depth,_HeadIs,_Slf,_F,_Nth,_PT,A,A,true). + diff --git a/.Attic/canary_docme/metta_convert.pl b/.Attic/canary_docme/metta_convert.pl new file mode 100644 index 00000000000..c7c65ab08e0 --- /dev/null +++ b/.Attic/canary_docme/metta_convert.pl @@ -0,0 +1,771 @@ +/* + * Project: MeTTaLog - A MeTTa to Prolog Transpiler/Interpeter + * Description: This file is part of the source code for a transpiler designed to convert + * MeTTa language programs into Prolog, utilizing the SWI-Prolog compiler for + * optimizing and transforming functional/logic programs. It handles different + * logical constructs and performs conversions between functions and predicates. + * + * Author: Douglas R. Miles + * Contact: logicmoo@gmail.com / dmiles@logicmoo.org + * License: LGPL + * Repository: https://github.com/trueagi-io/metta-wam + * https://github.com/logicmoo/hyperon-wam + * Created Date: 8/23/2023 + * Last Modified: $LastChangedDate$ # You will replace this with Git automation + * + * Usage: This file is a part of the transpiler that transforms MeTTa programs into Prolog. For details + * on how to contribute or use this project, please refer to the repository README or the project documentation. + * + * Contribution: Contributions are welcome! For contributing guidelines, please check the CONTRIBUTING.md + * file in the repository. + * + * Notes: + * - Ensure you have SWI-Prolog installed and properly configured to use this transpiler. + * - This project is under active development, and we welcome feedback and contributions. + * + * Acknowledgments: Special thanks to all contributors and the open source community for their support and contributions. + */ + + +:- encoding(iso_latin_1). +:- flush_output. +:- setenv('RUST_BACKTRACE',full). +:- op(700,xfx,'=~'). +:- ensure_loaded(metta_interp). + +% =============================== +% TESTING +% =============================== +% Define 'fb', a rule that calls 'make' and writes information for each clause of 'fb0'. +% 'make' compiles the program. +% The 'forall' loop will write and call all goals of the 'fb0' clauses. + + +fb:- make, + writeln(';; ==========================================='), + forall((clause(fb0,Goal),write(';; '),writeq(?- Goal),nl,call(Goal)), + writeln(';; ===========================================')). + +% The 'fb0' rule showing mettalog sources with specific definitions. +fb0:- show_mettalog_src((two_pi(R):-(pi(A), +(A, A, B), R is B))). +fb0:- show_mettalog_src(factorial_tail_basic). +fb0:- show_mettalog_src(funct). + +print_metta_src :- show_mettalog_src. +% 'show_mettalog_src' rule compiles the program and shows mettalog sources for each source file containing 'metta'. +show_mettalog_src:- make, + forall((source_file(AsPred,File), + symbol_contains(File,metta)), + show_mettalog_src(AsPred)). + + +% Handling different cases for 'show_mettalog_src' with different input parameters. +% These rules use nonvar, current_predicate, and other built-ins to perform various checks and actions +% based on the type and value of the input to 'show_mettalog_src'. +show_mettalog_src(F/A):- nonvar(F),!, forall(current_predicate(F/A), show_mettalog_src(F,A)). +show_mettalog_src(AsPred):- functor(AsPred,F,A), \+ \+ current_predicate(F/A), !, forall(current_predicate(F/A), show_mettalog_src(F,A)). +show_mettalog_src(F):- atom(F), \+ \+ current_predicate(F/_),!, forall(current_predicate(F/A), show_mettalog_src(F,A)). +show_mettalog_src(C):- atom(C), \+ \+ (current_predicate(F/_),once(atom_contains(F,C))),!, forall((current_predicate(F/A),once(atom_contains(F,C))), show_mettalog_src(F,A)). +show_mettalog_src(C):- show_cvts(C),!. + +% The 'show_space_src' rules compile the program and show space sources for each space predicate. +show_space_src:- make, + forall(space_preds(AsPred),show_space_src(AsPred)). + + +% Similar to the 'show_mettalog_src' rules, these rules handle different cases for 'show_space_src' +% with different input parameters and perform various checks and actions based on the type and value of the input. +show_space_src(F/A):- nonvar(F),!, forall(current_predicate(F/A), show_space_src(F,A)). +show_space_src(AsPred):- functor(AsPred,F,A), \+ \+ current_predicate(F/A), !, forall(current_predicate(F/A), show_space_src(F,A)). +show_space_src(F):- atom(F), \+ \+ current_predicate(F/_),!, forall(current_predicate(F/A), show_space_src(F,A)). +show_space_src(C):- atom(C), \+ \+ (current_predicate(F/_),once(atom_contains(F,C))),!, forall((current_predicate(F/A),once(atom_contains(F,C))), show_space_src(F,A)). +show_space_src(C):- show_cvts(C),!. + +% 'show_cvts' rule processes a term, performing different actions based on the structure of the term. +show_cvts(Term):- + once((is_list(Term), sexpr_s2p(Term,PF))), \+ is_list(PF),!,show_cvts(PF). + +% 'show_cvts' continues processing, performing conversions between predicates and functions, +% and pretty-printing original terms, function forms, and Prolog forms. +show_cvts(Term):- iz_conz(Term),!, ppc(orig,Term),Term = FunctForm, + functs_to_preds(FunctForm,Prolog), ppc(preds,Prolog), + preds_to_functs(Prolog,NFunctForm), ppc(functs,NFunctForm). +show_cvts(Term):- ppc(orig,Term), + preds_to_functs(Term,FunctForm), ppc(functs,FunctForm), + functs_to_preds(FunctForm,Prolog), ppc(preds,Prolog). + +% 'show_mettalog_src' for specific predicate, prints metta clauses if they exist in the source file containing 'metta'. +show_mettalog_src(F,A):- functor(Head,F,A), + ignore((predicate_property(Head,number_of_clauses(_)), + source_file(Head,File),atom_contains(File,metta),!, + nl,findall((Head:-Body), + clause(Head,Body), Clauses), + print_metta_clauses(Clauses))),nl. + +% 'print_metta_clauses' rule is handling the printing of metta clauses. +% It checks the form of the input clauses and calls 'print_metta_clause' accordingly. +print_metta_clauses([]):- !. +print_metta_clauses([Head:-Body]):- !, print_metta_clause(Head,Body). +print_metta_clauses(Clauses):- combine_clauses(Clauses,Head,Body),!,print_metta_clause(Head,Body). +print_metta_clause(Head,Body):- + print_metta_clause0(Head,Body), + show_cvts(Head:-Body). + +% 'print_metta_clause0' rule prints metta clauses based on the body. +% It transforms the body to a list, if needed, and prints it in a sequential form. +print_metta_clause0(Head,Body):- Body == true,!, pp_metta([=,Head,'True']). +print_metta_clause0(Head,Body):- Body == false,!, pp_metta([=,Head,'False']). +print_metta_clause0(Head,Body):- conjuncts_to_list(Body,List), into_sequential([':-'],List,SP), pp_metta([=,Head,SP]). + + + +% ========================================= +% STERM -> PTERM +% ========================================= + +iz_exact_symbol(N,_):- \+ atom(N),!,fail. +iz_exact_symbol(N,P):- nonvar(P),!,iz_exact_symbol(N,PP),zalwayz(P=PP). +iz_exact_symbol(':-',':-'). +iz_exact_symbol('?-','?-'). +iz_exact_symbol('??',_). + +%:- baseKB:ensure_loaded(logicmoo('plarkc/logicmoo_i_cyc_rewriting')). + +maybe_varz(S,Name,'$VAR'(Name)):- S=='?',atom(Name),!. + +%% sexpr_s2p(Fn,?VAR, ?V) is det. +% +% S-expression Sterm Converted To Pterm. +% +sexpr_s2p(HB,P):- fail, compound(HB), HB=~ (H=B), compile_for_assert(H,B,Cl), + clause_to_code(Cl,P),!. +sexpr_s2p(S,P):- sexpr_s2p(progn,1,S,P). + + +clause_to_code(P,P):- is_ftVar(P),!. +%clause_to_code(P:-True,P):- True == true,!. +clause_to_code((H:-B),P):- B==true, !, combine_code(B,H,P). +clause_to_code(P,P). + +sexpr_s2p(_Fn,_Nth,VAR,VAR):-is_ftVar(VAR),!. +sexpr_s2p(_Fn,_Nth,S,P):- iz_exact_symbol(S,P),!. +sexpr_s2p(_Fn,_Nth,'#'(S),P):- iz_exact_symbol(S,P),!. +sexpr_s2p(_Fn,_Nth,VAR,'$VAR'(Name)):- atom(VAR),svar(VAR,Name),!. +sexpr_s2p(Fn,Nth,S,P):- S==[], iz_fun_argz(Fn,Nth),!,P=S. + +%sexpr_s2p(Fn,Nth,S,P):- expects_type(Fn,Nth,Type),will_become_type(Type,S,P),!. + +sexpr_s2p(_Fn,_Nth,[F|SList],P):- is_list(SList), length(SList,Len),is_syspred(F,Len,Pred), sexpr_s2p_arglist(F,1,SList,PList), !, P=..[Pred|PList]. +:- style_check(-singleton). + +sexpr_s2p(Fn,Nth,[S|SList],[P|PList]):- iz_fun_argz(Fn,Nth),!,sexpr_s2p(S,P), sexpr_s2p(Fn,Nth,SList,PList). +sexpr_s2p(Fn,Nth,[S|SList],[P|PList]):- ( \+ atom(S) ; \+ is_list(SList)), !,sexpr_s2p(list(Fn),Nth,S,P), sexpr_s2p(list(Fn),Nth,SList,PList). +sexpr_s2p(_Fn,_Nth,[S,STERM0],PTERM):- iz_quoter(S),sexpr_s2p_pre_list(S,0,STERM0,STERM), !,PTERM=..[S,STERM],!. +sexpr_s2p(_Fn,_Nth,[S|SList],P):- atom(S), SList == [], compound_name_arity(P,S,0). +% sexpr_s2p(Fn,Nth,List,PTERM):- append(Left,[S,Name|TERM],List),maybe_varz(S,Name,Var),!,append(Left,[Var|TERM],NewList), sexpr_s2p(Fn,Nth,NewList,PTERM). +% sexpr_s2p(Fn,Nth,[S|TERM],dot_holds(PTERM)):- \+ (is_list(TERM)),sexpr_s2p_arglist(Fn,Nth,[S|TERM],PTERM),!. +%sexpr_s2p(Fn,Nth,[S|TERM],PTERM):- \+ atom(S),sexpr_s2p_arglist(Fn,Nth,[S|TERM],PTERM),!. +/* +sexpr_s2p(Fn,Nth,[S,Vars|TERM],PTERM):- nonvar(S), + call_if_defined(common_logic_snark:iz_quantifier(S)), + zalwayz((sexpr_s2p_arglist(Fn,Nth,TERM,PLIST), + PTERM =~ [S,Vars|PLIST])),!. +*/ +% sexpr_s2p(progn,_,[S|TERM],PTERM):- S==AND,!,zalwayz((maplist(sexpr_s2p,TERM,PLIST),list_to_conjuncts(',',PLIST,PTERM))). +%sexpr_s2p(Fn,Nth,[S|TERM],PTERM):- (number(S); (atom(S),fail,atom_concat_or_rtrace(_,'Fn',S))),sexpr_s2p_arglist(Fn,Nth,[S|TERM],PTERM),!. +%sexpr_s2p(Fn,Nth,[S],O):- is_ftVar(S),sexpr_s2p(Fn,Nth,S,Y),!,z_univ(Fn,Nth,O,[Y]),!. +%sexpr_s2p(Fn,Nth,[S],O):- nonvar(S),sexpr_s2p(Fn,Nth,S,Y),!,z_univ(Fn,Nth,O,[Y]),!. +%sexpr_s2p(Fn,Nth,[S|TERM],PTERM):- S==and,!,zalwayz((maplist(sexpr_s2p,TERM,PLIST),list_to_conjuncts(',',PLIST,PTERM))). +% sexpr_s2p(Fn,Nth,[S|TERM],PTERM):- iz_va_relation(S),!,zalwayz((maplist(sexpr_s2p,TERM,PLIST),list_to_conjuncts(S,PLIST,PTERM))). +%sexpr_s2p(Fn,Nth,[S|TERM],PTERM):- iz_relation_sexpr(S),zalwayz((sexpr_s2p_arglist(Fn,Nth,TERM,PLIST),PTERM =~ [S|PLIST])),!. +%sexpr_s2p(Fn,Nth,STERM,PTERM):- STERM =~ [S|TERM],sexpr_s2p_arglist(Fn,Nth,TERM,PLIST),z_univ(Fn,Nth,PTERM,[S|PLIST]),!. +sexpr_s2p(Fn,Nth,[S|STERM0],PTERM):- + sexpr_s2p_pre_list(Fn,Nth,STERM0,STERM), + sexpr_s2p_arglist(S,1,STERM,PLIST), z_univ(Fn,Nth,PTERM,[S|PLIST]),!. +sexpr_s2p(_Fn,_Nth,VAR,VAR). + + +expects_type(Fn,Nth,Type):- + get_operator_typedef(Self,Fn,Params,RetType), + nth0(Nth,[RetType|Params],Type),nonvar(Type). + +will_become_type(Type,S,P):- try_adjust_arg_types(=,_RetType,88,_Self,[Type],[S],[PS]),PS=P,!. +will_become_type(Type,S,P):- is_ftVar(S),!,P=S. +will_become_type(Type,S,P):- + get_type(S,T),!, + (is_subtype(T,Type)->S=P; P=coerce(Type,S)). +will_become_type(_Type,S,P):-!,S=P. + +is_subtype(T,TT):- T=@=TT,!,T=TT. +is_subtype(T,TT):- T=TT,!. + +iz_quoter('#BQ'):- iz_common_lisp. +iz_quoter('#COMMA'):- iz_common_lisp. +iz_quoter('quote'). +iz_quoter(superpose). + +iz_fun_argz(list(_),_). +iz_fun_argz(defmacro,2). +iz_fun_argz(defun,2). +iz_fun_argz(let,1). +iz_fun_argz('let*',1). +iz_fun_argz('member',2). +%iz_fun_argz('let*',2). +iz_fun_argz(F,1):- iz_quoter(F). + +z_functor(F):- \+ atom(F), !,fail. +z_functor(F):- \+ atom_concat('?',_,F). +z_functor(F):- \+ atom_concat('$',_,F). + +%z_univ(_Fn,1,S,S):-!. +z_univ(_Fn,_,P,[F|ARGS]):- z_functor(F),is_list(ARGS),length(ARGS,A),l_arity_l(F,A),compound_name_arguments(P,F,ARGS),!. +z_univ(_Fn,0,P,[F|ARGS]):- z_functor(F),is_list(ARGS),compound_name_arguments(P,F,ARGS),!. +z_univ(_Fn,_Nth,P,[F|ARGS]):- z_functor(F),is_list(ARGS),compound_name_arguments(P,F,ARGS),!. +z_univ(_Fn,_Nth,P,S):-P=S. + +l_arity_l(F,A):- clause_b(arity(F,A)). +l_arity_l(function,1). +l_arity_l(quote,1). +l_arity_l('#BQ',1):- iz_common_lisp. +l_arity_l(F,A):-current_predicate(F/A). +l_arity_l(_,1). + +sexpr_s2p_arglist(_Fn,_,VAR,VAR):-is_ftVar(VAR),!. +sexpr_s2p_arglist(Fn,Nth,[S|SList],[P|PList]):-sexpr_s2p(Fn,Nth,S,P), + (Nth>0->Nth2 is Nth+1;Nth2=0),sexpr_s2p_arglist(Fn,Nth2,SList,PList),!. +sexpr_s2p_arglist(Fn,Nth,S,P):-sexpr_s2p(Fn,Nth,S,P),!. +sexpr_s2p_arglist(_Fn,_Nth,VAR,VAR). + +sexpr_s2p_pre_list(_Fn,_,STERM,STERM):- \+ compound(STERM), !. +sexpr_s2p_pre_list(_Fn,_,STERM,STERM):- \+ is_list(STERM), !. +% sexpr_s2p_pre_list(Fn,_,[S|STERM],[S|STERM]):- STERM == [], !. +sexpr_s2p_pre_list(Fn,Nth,[S0|STERM0],[S|STERM]):- + (is_list(S0)->sexpr_s2p(Fn,Nth,S0,S);sexpr_s2p_pre_list(Fn,Nth,S0,S)), + sexpr_s2p_pre_list(Fn,Nth,STERM0,STERM),!. +sexpr_s2p_pre_list(_Fn,_,STERM,STERM). + + + + +% p2m/2 is a translation utility to convert Prolog constructs to MeTTa constructs. +% It handles a variety of cases, including different types of compound terms, +% control structures, and predicate definitions. +% The first argument is the input in Prolog syntax, +% and the second argument is the output converted to MeTTa syntax. + +p2m(I):-forall( + no_repeats(current_predicate(I/A)), + (functor(P,I,A), + forall(clause(P,Body), + (numbervars(P+Body,0,_,[]), + write_src(=(P,'call!'(Body))))))). + + + +p2m(I,O):- p2m([progn],I,O). + +p2m(_OC,NC, NC) :- var(NC), !. % If NC is a variable, do not translate. +p2m(_OC,NC, NC) :- is_ftVar(NC), !. % If NC is a free term variable, do not translate. + +p2m(OC,[H|T],'::'(L)):- is_list([H|T]),maplist(p2m(OC),[H|T],L). +p2m(OC,[H|T], 'Cons'(OH,OT)):- p2m(OC,H, OH), p2m(OC,T, OT). + + +% Conversion for any atomic term +p2m(_OC,A, A):- string(A),!. +p2m(_OC,[], 'Nil'). % empty list +p2m(_OC,[], 'Nil'). % empty list +p2m(_OC,'[|]','Cons'). +p2m(_OC,!, ['set-det']). % Translate the cut operation directly. +p2m(_OC,!, '!'). % Translate the cut operation directly. +p2m(_OC,false, 'False'). +p2m(_OC,true, 'True'). % Translate Prolog?s true to MeTTa?s True. +p2m([progn|_],Atom,[O]):- atom(Atom),!,p2m([arg],Atom,O),!. +p2m(_OC,( ';' ),'xor'). +p2m(_OC,( ',' ),'and2'). +%p2m(_OC,( ',' ),and). +%p2m(_OC,( '\\+' ),unless). +%p2m(_OC,( ':-' ),entailed_by). +p2m(_OC,'=..','atom_2_list'). +p2m([progn|_], (fail), [empty]). % Translate Prolog?s fail to MeTTa?s False. +p2m(_OC,'atom','is-symbol'). +p2m(_OC,'atomic','symbolic'). +p2m(OC,ASymbolProc,O):- atom(ASymbolProc), + symbolic_list_concat(LS,'$',ASymbolProc),LS\==[],LS\=[_],!, + symbolic_list_concat(LS,'%',SymbolProc),into_hyphens(SymbolProc,O). +p2m(OC,ASymbolProc,O):- atom(ASymbolProc),into_hyphens(ASymbolProc,O). +p2m(_,A, H):- atom(A),into_hyphens(A,H),!. +p2m(_OC,A, A):- atomic(A). +p2m(_OC,NC,NC):- \+ compound(NC),!. + + +p2m(_OC,NC,[F]):- compound_name_arity(NC,F,0),!. +p2m(OC,M:I, O):- M==user,!, p2m(OC,I,O),!. +p2m(OC,M:I, O):- M==user,!, p2m(OC,I,O),!. +p2m(_OC,M:I, 'scoped'(N,O)):- p2m(OC,M,N),p2m(I,O). +% Conversion for lists +p2m(OC,NC, OO) :- + % If NC is a list, map each element of the list from Prolog to MeTTa + is_list(NC),!, + maplist(p2m(OC), NC, OO). + p2m([progn|_], (!,fail), [empty]). % Translate Prolog?s fail to MeTTa?s False. +% p2m(_OC,fail, 'False'). % Translate Prolog?s fail to MeTTa?s False. +% p2m(_OC,prolog, meTTa). % Translate the atom prolog to meTTa. + + +p2m([progn|_],A, [H]):- atom(A),into_hyphens(A,H),!. + +% Conversion for the negation as failure +p2m(_OC,(\+ A), O):- !, p2m(_OC,naf(A), O). + +p2m(OC,(G,E),O):- conjuncts_to_list((G,E),List),!,into_sequential(OC,List,O),!. + +% Conversion for arithmetic evaluation +%p2m(_OC,is(A, B), O):- !, p2m(_OC,eval(B, A), O). +%p2m(_OC,is(V,Expr),let(V,Expr,'True')). +p2m(_OC,(Head:-Body),O):- Body == true,!, O = (=(Head,'True')). +p2m(_OC,(Head:-Body),O):- Body == fail,!, O = (=(Head,[empty])). +p2m(OC,(Head:-Body),O):- + p2m(Head,H),conjuncts_to_list(Body,List),maplist(p2m([progn|OC]),List,SP),!, + O = ['=',H|SP]. + +p2m(OC,(:-Body),O):- !, + conjuncts_to_list(Body,List),into_sequential([progn|OC],List,SP),!, O= exec(SP). +p2m(OC,( ?- Body),O):- !, + conjuncts_to_list(Body,List),into_sequential([progn|OC],List,SP),!, O= exec('?-'(SP)). + +%p2m(_OC,(Head:-Body),O):- conjuncts_to_list(Body,List),into_sequential(OC,List,SP),!,O=(=(Head,SP)). + +% Conversion for if-then-else constructs +p2m(OC,(A->B;C),O):- !, p2m(OC,det_if_then_else(A,B,C),O). +p2m(OC,(A;B),O):- !, p2m(OC,or(A,B),O). +p2m(OC,(A*->B;C),O):- !, p2m(OC,if(A,B,C),O). +p2m(OC,(A->B),O):- !, p2m(OC,det_if_then(A,B),O). +p2m(OC,(A*->B),O):- !, p2m(OC,if(A,B),O). +p2m(_OC,metta_defn(Eq,Self,H,B),'add-atom'(Self,[Eq,H,B])). +p2m(_OC,metta_type,'get-type'). +p2m(_OC,metta_atom,'get-atoms'). +%p2m(_OC,get_metta_atom,'get-atoms'). +p2m(_OC,clause(H,B), ==([=,H,B],'get-atoms'('&self'))). +p2m(_OC,assert(X),'add-atom'('&self',X)). +p2m(_OC,assertz(X),'add-atom'('&self',X)). +p2m(_OC,asserta(X),'add-atom'('&self',X)). +p2m(_OC,retract(X),'remove-atom'('&self',X)). +p2m(_OC,retractall(X),'remove-all-atoms'('&self',X)). +% The catch-all case for the other compound terms. +%p2m(_OC,I,O):- I=..[F|II],maplist(p2m,[F|II],OO),O=..OO. + +% It will break down compound terms into their functor and arguments and apply p2m recursively +p2m(OC,I, O):- + compound(I), + I =.. [F|II], % univ operator to convert between a term and a list consisting of functor name and arguments + maplist(p2m([F|OC]), II, OO), % applying p2m recursively on each argument of the compound term + into_hyphens(F,FF), + O = [FF|OO]. % constructing the output term with the converted arguments + + +% In the context of this conversion predicate, each branch of the p2m predicate +% is handling a different type or structure of term, translating it into its +% equivalent representation in another logic programming language named MeTTa. +% The actual transformations are dependent on the correspondence between Prolog +% constructs and MeTTa constructs, as defined by the specific implementations +% of Prolog and MeTTa being used. +prolog_to_metta(V, D) :- + % Perform the translation from Prolog to MeTTa + p2m([progn], V, D),!. + + +% Define predicates to support the transformation from Prolog to MeTTa syntax +% (Continuing the translation from Prolog to MeTTa syntax as per the given code) +% Handle the case where the body is a conjunction of terms +into_sequential(OC,Body, SP) :- + % Check if Body is not a list and convert conjunctions in Body to a list of conjuncts. + \+ is_list(Body), + conjuncts_to_list(Body, List), + is_list(List), % Converts a list of conjunctions into a sequential representation in MeTTa + into_sequential(OC,List, SP), !. +into_sequential([progn|_],Nothing,'True'):- Nothing ==[],!. +into_sequential(_OC,Nothing,'Nil'):- Nothing ==[],!. +% If theres only one element +into_sequential(_,[SP],O):- prolog_to_metta(SP,O). +% Otherwise, construct sequential representation using AND. +into_sequential([progn|_],List, SPList) :- + maplist(prolog_to_metta, List, SPList),!. +into_sequential(_CA,List, [AND|SPList]) :- + is_compiled_and(AND), maplist(prolog_to_metta, List, SPList),!. + + + + +list_direct_subdirectories(Directory, DirectSubdirectories) :- + directory_files(Directory, Entries), + findall(Path, + (member(Entry, Entries), + \+ member(Entry, ['.', '..']), % Exclude '.' and '..' + symbolic_list_concat([Directory, '/', Entry], Path), + is_directory(Path)), + DirectSubdirectories). + +% List all subdirectories of a given directory recursively +list_all_subdirectories(Directory, AllSubdirectories) :- + list_direct_subdirectories(Directory, DirectSubdirectories), + findall(Sub, + (member(SubDir, DirectSubdirectories), + list_all_subdirectories(SubDir, Subs), + member(Sub, Subs)), + NestedSubdirectories), + append(DirectSubdirectories, NestedSubdirectories, AllSubdirectories). + +% Processes a list of filenames, applying 'convert_to_metta' to each. + +with_file_lists(Rel,P1,FileSpec):- FileSpec=='.pl',!. +with_file_lists(Rel,P1,FileSpec):- is_list(FileSpec),!, + ignore(maplist(with_file_lists(Rel,P1),FileSpec)). + + +with_file_lists(Rel,P1,Filename):- atomic(Filename), exists_file(Filename),!, + ignore(call(P1,Filename)). + +with_file_lists(Rel,P1,Filename):- + absolute_file_name(Rel, Dir, [access(read), file_errors(fail), file_type(directory)]), + Rel \=@= Dir,!, + with_file_lists(Dir,P1,Filename). +with_file_lists(Rel,P1,Filename):- \+ exists_directory(Rel), !, + with_file_lists('.',P1,Filename). + + +with_file_lists(Rel,P1, File) :- + compound(File), + absolute_file_name(File, Dir, [access(read), relative_to(Rel), file_errors(fail), + extensions(['pl', 'prolog', 'pfc'])]), + '\\=@='(Dir, File), !, + with_file_lists(Rel,P1, Dir). + +with_file_lists(Rel,P1, File) :- + compound(File), + absolute_file_name(File, Dir, [access(read), file_errors(fail),relative_to(Rel), file_type(directory)]), + '\\=@='(Dir, File), !, + with_file_lists(Rel,P1, Dir). + +/* +with_file_lists(Rel,P1, File) :- + compound(File), + absolute_file_name(File, Dir, [access(read), file_errors(fail), file_type(directory)]), + '\\=@='(Dir, File), !, + with_file_lists(Rel,P1, Dir). +with_file_lists(Rel,P1, File) :- + compound(File), !, + absolute_file_name(File, Dir, [access(read), file_errors(fail), file_type(['csv', 'tsv', ''])]), + '\\=@='(Dir, File), !, + with_file_lists(Rel,P1, Dir). +with_file_lists(Rel,P1, File) :- + symbol_contains(File, '*'), + expand_file_name(File, List),List\==[], !, + maplist(with_wild_path(Fnicate), List). +with_file_lists(Rel,P1, File) :- + exists_directory(File), + directory_file_path(File, '*.*sv', Wildcard), + expand_file_name(Wildcard, List), !, + maplist(Fnicate, List). +*/ + + + +with_file_lists(Rel,P1,Wildcard):- atom(Wildcard), + \+ exists_file(Wildcard), + once(atom_contains(Wildcard,'*');atom_contains(Wildcard,'?');atom_contains(Wildcard,'|')), + expand_file_name(Wildcard, Files), Files\==[], !, + ignore(maplist(with_file_lists(Rel,P1),Files)). + +with_file_lists(Rel,P1,Wildcard):- atom(Wildcard), + once(atom_contains(Wildcard,'*');atom_contains(Wildcard,'?');atom_contains(Wildcard,'|')), + \+ exists_file(Wildcard), + absolute_file_name(Wildcard,AbsWildcard,[relative_to(Rel)]), + \+ exists_file(AbsWildcard), + expand_file_name(AbsWildcard, Files), Files\==[], !, + ignore(maplist(with_file_lists(Rel,P1),Files)). + +/* +with_file_lists(Rel,P1,Local):- (Local=='.';Local=='';Local=='*.pl'),Directory = Rel, + absolute_file_name(Directory,AbsDirectory,[relative_to(Rel),file_type(directory)]), + exists_directory(AbsDirectory), + findall(File,directory_source_files(AbsDirectory, File, [recursive(false),if(true)]),Files), + ignore(maplist(with_file_lists(Rel,P1),Files)),!. +*/ +with_file_lists(Rel,P1,Local):- (Local=='**';Local=='**.pl'), + must_det_ll((absolute_file_name(Directory,AbsDirectory,[file_type(directory)]), + exists_directory(AbsDirectory))), + findall(File,directory_source_files(AbsDirectory, File, [recursive(true),if(true)]),Files),!, + ignore(maplist(with_file_lists(Rel,P1),Files)). + + +with_file_lists(Rel,P1,Filename):- + symbolic_list_concat(['**',S|More],'/',Filename), + symbolic_list_concat([S|More],'/',Rest), + list_all_subdirectories(Rel, AllSubdirectories),!, + forall(member(SubDir,AllSubdirectories),with_file_lists(SubDir,P1,Rest)). + +with_file_lists(Rel,P1,Filename):- + symbolic_list_concat([WildDir,S|More],'/',Filename), + symbolic_list_concat([Rel,WildDir,''],'/',WildMaskDir), + expand_file_name(WildMaskDir, AllSubdirectories), + symbolic_list_concat([S|More],'/',Rest),!, + forall(member(SubDir,AllSubdirectories),with_file_lists(SubDir,P1,Rest)). + + + +with_file_lists(Rel,P1,FileSpec):- atomic(FileSpec), + absolute_file_name(FileSpec,AbsFile,[relative_to(Rel),access(read), file_errors(fail)]), + exists_file(AbsFile), !, ignore(call(P1,AbsFile)). + +with_file_lists(Rel,P1,Directory):- atomic(Directory), + absolute_file_name(Directory,AbsDirectory,[relative_to(Rel),access(read), file_errors(fail), file_type(directory)]), + exists_directory(AbsDirectory), !, + findall(File,directory_source_files(AbsDirectory, File, [recursive(true),if(true)]),Files),!, + ignore(maplist(with_file_lists(Rel,P1),Files)). + +with_file_lists(Rel,P1,Wildcard):- atom(Wildcard), + absolute_file_name(Wildcard,AbsWildcard,[relative_to(Rel)]), + \+ exists_file(AbsWildcard), + expand_file_name(AbsWildcard, Files), Files\==[], !, + ignore(maplist(with_file_lists(Rel,P1),Files)). + +%with_file_lists(Rel,P1,Filename):- must_det_ll(call(P1,Filename)). +with_file_lists(Rel,P1,Filename):- write_src(with_file_lists(Rel,P1,Filename)),nl. + + + + + % Entry point for printing to Metta format. It clears the screen, sets the working directory, + % expands the filenames with a specific extension, and processes each file. + % cls, % Clears the screen (assumes a custom or system-specific implementation). + % with_pwd( + % '/opt/logicmoo_opencog/hyperon-wam/tests/gpt2-like/language_models/', + %Filt = 'tests/gpt2-like/language_models/*.pl', + % Filt = '/opt/logicmoo_opencog/hyperon-wam/tests/performance/nondet_unify/*.pl', + % Finds all Prolog files in the specified directory. + % convert_to_metta(Filt), % Processes each found file. + % MC = '/opt/logicmoo_opencog/hyperon-wam/src/main/metta_convert.pl', + % convert_to_metta(MC), % Processes each found file. + % Example of a no-operation (nop) call for a specific file path, indicating a placeholder or unused example. + %$nop(convert_to_metta('/opt/logicmoo_opencog/hyperon-wam/src/main/metta_convert.pl')). + +default_pl_mask(Mask):- Mask = [ + %'src/main/metta_*.pl', + %'src/main/flybase_*.pl', + '*/*.pl', + '*/*/*.pl', + '*/*/*/.pl', + '*/*/*/*/.pl', + '*/*/*/*/*/.pl', + '*/*/*/*/*/*.pl', + '*.pl' + ],!. +default_pl_mask(Mask):- Mask = ['**/*.pl']. + +convert_to_metta_console :- default_pl_mask(Mask), + ignore(convert_to_metta_console(Mask)),!, writeln(';; convert_to_metta_console. '). + +convert_to_metta_file :- default_pl_mask(Mask), + ignore(convert_to_metta_file(Mask)),!, writeln(';; convert_to_metta_file. '). + + +convert_to_metta :- default_pl_mask(Mask), + %locally(set_prolog_flag(gc,true), + + call( + ignore(convert_to_metta(Mask))),!, writeln(';; convert_to_metta. '). + +ctm:- convert_to_metta. +% Processes a list of filenames, applying 'convert_to_metta' to each. +convert_to_metta_console(FileSpec):- with_file_lists('.',convert_to_metta_now(user_output),FileSpec). +convert_to_metta_file(FileSpec):- with_file_lists('.',convert_to_metta_now(_Create),FileSpec). +convert_to_metta(Filename):- atomic(Filename), exists_file(Filename),!, + ignore(convert_to_metta_file(Filename)), + ignore(convert_to_metta_console(Filename)),!. +convert_to_metta(FileSpec):- with_file_lists('.',convert_to_metta,FileSpec). + +convert_to_metta_now(OutputIn,Filename):- + user_io(convert_to_metta_now_out(OutputIn,Filename)). + +% Processes a single filename by opening the file, translating its content, and then closing the file. +convert_to_metta_now_out(OutputIn,Filename):- + atom(Filename), % Verifies that the filename is an atom. + % Generate the new filename with .metta extension. + file_name_extension(Base, _OldExt, Filename), + file_name_extension(Base, metta, NewFilename), + file_base_name(Base,Module), + % Setup step: open both the input and output files. + %format('~N~n~w~n', [convert_to_metta(Filename,NewFilename)]), % Prints the action being performed. + convert_to_metta_file(Module,OutputIn,Filename,NewFilename). + +write_src_cmt(G):- ignore((with_output_to(string(S),write_src(G)),in_cmt(write(S)))). + +convert_to_metta_file(Module,OutputIn,Filename,NewFilename):- + + copy_term(OutputIn,Output), + + if_t(var(OutputIn), + user_io(write_src_cmt(convert_to_metta_file(Module,OutputIn,Filename,NewFilename)))), + %Output = user_output, + setup_call_cleanup( + open(Filename, read, Input, [encoding(iso_latin_1)]), + % Call step: perform the translation and write to the output file. + setup_call_cleanup( + (if_t(var(Output),open(NewFilename, write, Output, [encoding(utf8)]))), + with_output_to(Output, + (write_src_cmt(convert_to_metta_file(Module,OutputIn,Filename,NewFilename)), + translate_to_metta(Module,Input))), + % Cleanup step for the output file: close the output stream. + close(Output) + ), + % Cleanup step for the input file: close the input stream. + close(Input) + ). + +into_namings(N=V):- ignore(V='$VAR'(N)). + +% Recursively translates content, stopping at the end of the file. +translate_to_metta(Module,Input):- + at_end_of_stream(Input), % Checks for the end of the file. + !, nl. + +% Processes whitespace characters, maintaining their presence in the output. +translate_to_metta(Module,Input):- + peek_char(Input, Char), % Peeks at the next character without consuming it. + is_reprint_char(Char), !, + get_char(Input, _), % Consumes the character. + put_char(Char), % Prints the character. + translate_to_metta(Module,Input). + +% Converts Prolog comments to Metta-style comments, then continues processing. + translate_to_metta(Module,Input):- + peek_char(Input, Char), + Char == '%', % Checks for Prolog comment start. + get_char(Input, _), put_char(';'), + read_line_to_string(Input, Cmt), % Reads the comment line. + print_metta_comments(Cmt),nl, % Converts and prints the comment in Metta style. + translate_to_metta(Module,Input). % Continues with the next line. + + translate_to_metta(Module,Input):- + peek_char(Input, Char), + Char == '#', % Checks for Prolog comment start. + get_char(Input, _), put_char(';'), + read_line_to_string(Input, Cmt), % Reads the comment line. + print_metta_comments(Cmt),nl, % Converts and prints the comment in Metta style. + translate_to_metta(Module,Input). % Continues with the next line. + +% Reads a clause along with its metadata, then continues translation. +translate_to_metta(Module,Input):- + read_clause_with_info(Input),!, + translate_to_metta(Module,Input). + +% Helper predicates and processing functions follow... + +% Determines if a character should be reprinted (spaces and period). +is_reprint_char(Char):- char_type(Char, space). +is_reprint_char(Char):- Char == '.'. + +% Translates Prolog comments to Metta comments, applying string replacements. +translate_comment(Cmt,Str):- replace_in_string(["%"=";", + "prolog"="MeTTa", + "PROLOG"="MeTTa", + "Prolog"="MeTTa"],Cmt,Str). + +% Reads a clause while capturing various pieces of metadata. + +read_clause_with_info(Stream) :- at_end_of_stream(Stream),!. +read_clause_with_info(Stream):- catch(read_clause_with_info_0(Stream),E, + ((user_io(write_src_cmt(E)),write_src_cmt(E)))). + +read_clause_with_info_0(Stream) :- + Options = [ variable_names(Bindings), + term_position(Pos), + subterm_positions(RawLayout), + syntax_errors(error), + comments(Comments), + module(trans_mod)], + read_term(Stream, Term, Options), + ( (fail,Term == end_of_file) + -> true + ; b_setval('$term_position', Pos), + b_setval('$variable_names', Bindings), + display_term_info(Stream, Term, Bindings, Pos, RawLayout, Comments)). + +% Displays term information and processes comments. +display_term_info(Stream, Term, Bindings, Pos, RawLayout, Comments):- + maplist(into_namings,Bindings), + ignore(process_term(Stream,Term)), + print_metta_comments(Comments),!. + +print_metta_comments(Comments):- print_metta_comment(Comments). +print_metta_comment([]):-!. +print_metta_comment(_TP-Cmt):-!, print_metta_comment(Cmt). +print_metta_comment([Cmt|Cs]):- !, print_metta_comment(Cmt),!, print_metta_comment(Cs). +print_metta_comment(Cmt):- translate_comment(Cmt,String), print_cmt_lines(String). + +print_cmt_lines(String):- + normalize_space(string(TaxM),String), + atomics_to_string(List,'\n',TaxM),!, + maplist(print_cmt_line,List). +print_cmt_line(Str):- format('~N; ~w',[Str]). + + +echo_as_commnents_until_eof(Stream):- + repeat, + (at_end_of_stream(Stream)-> !; + (read_line_to_string(Stream,Cmt), + ignore((print_metta_comments(Cmt))), + fail)). + + + +% Processes each term based on its type (directive or other). +process_term(Stream,end_of_file):- !, echo_as_commnents_until_eof(Stream). +process_term(Stream,Term):- + is_directive(Term), + ignore(maybe_call_directive(Stream,Term)), + !, ignore(print_directive(Term)). +process_term(_,Term):- + expand_to_hb(Term,H,B), + p2m((H:-B),STerm), + push_term_ctx(Term), + write_pl_metta(STerm). + +maybe_call_directive(Stream,(:- X)):- !, maybe_call_directive(Stream,X). +maybe_call_directive(_Stream,op(X,F,Y)):- trans_mod:op(X,F,Y). +maybe_call_directive(_Stream,use_module(library(W))):- trans_mod:use_module(library(W)). +maybe_call_directive(Stream,encoding(Enc)):- + set_stream(Stream,encoding(Enc)). + +% Checks if a term is a directive. +is_directive((:- _)). + +push_term_ctx(X):- \+ compound(X),!, + (nb_current(term_ctx,Was)->true;Was=[]), + (Was =@= X -> true; (nb_setval(term_ctx,X),nl)). +push_term_ctx((X:-_)):- !, push_term_ctx(X). +push_term_ctx(X):- compound_name_arity(X,F,_A),push_term_ctx(F). +% Print a Prolog directive in a specific format. +print_directive((:- Directive)):- + push_term_ctx(exec), % pc + p2m([':-'],Directive,STerm), % p2m + write_pl_metta(exec(STerm)). %we + +write_pl_metta(STerm):- + \+ \+ write_pl_metta_0(STerm). + write_pl_metta_0(STerm):- numbervars(STerm,0,_,[singletons(true),attvar(skip)]), + write_src(STerm). + + +:- ensure_loaded(metta_compiler). +:- ensure_loaded(metta_convert). +:- ensure_loaded(metta_types). +:- ensure_loaded(metta_space). +:- ensure_loaded(metta_testing). +:- ensure_loaded(metta_utils). +:- ensure_loaded(metta_printer). +:- ensure_loaded(metta_eval). + + + diff --git a/.Attic/canary_docme/metta_debug.pl b/.Attic/canary_docme/metta_debug.pl new file mode 100644 index 00000000000..9a559cdab09 --- /dev/null +++ b/.Attic/canary_docme/metta_debug.pl @@ -0,0 +1,2181 @@ +/* + * Project: MeTTaLog - A MeTTa to Prolog Transpiler/Interpreter + * Description: This file is part of the source code for a transpiler designed to convert + * MeTTa language programs into Prolog, utilizing the SWI-Prolog compiler for + * optimizing and transforming function/logic programs. It handles different + * logical constructs and performs conversions between functions and predicates. + * + * Author: Douglas R. Miles + * Contact: logicmoo@gmail.com / dmiles@logicmoo.org + * License: LGPL + * Repository: https://github.com/trueagi-io/metta-wam + * https://github.com/logicmoo/hyperon-wam + * Created Date: 8/23/2023 + * Last Modified: $LastChangedDate$ # You will replace this with Git automation + * + * Usage: This file is a part of the transpiler that transforms MeTTa programs into Prolog. For details + * on how to contribute or use this project, please refer to the repository README or the project documentation. + * + * Contribution: Contributions are welcome! For contributing guidelines, please check the CONTRIBUTING.md + * file in the repository. + * + * Notes: + * - Ensure you have SWI-Prolog installed and properly configured to use this transpiler. + * - This project is under active development, and we welcome feedback and contributions. + * + * Acknowledgments: Special thanks to all contributors and the open source community for their support and contributions. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the + * distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS + * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT + * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS + * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE + * COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, + * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; + * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER + * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN + * ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + * POSSIBILITY OF SUCH DAMAGE. + */ + +:- dynamic(is_cached_call/3). + +%% cached_call(+ForSeconds, :Call) is nondet. +% Attempts to use cached results for Call, or executes Call if no valid cache is present. +% ForSeconds - Expire after so many seconds +% Call - The Goal that is cached +cached_call(ForSeconds, Call) :- + get_time(CurrentTime), % Get the current time for cache validation. + copy_term(Call, CallCopied), % Create a copy of the Call for consistent comparison. + numbervars(CallCopied, 0, _, [attvar(bind)]), % Ensure variables in Call are standardized. + NewerThan is CurrentTime - ForSeconds, % Calculate the cutoff time for cache validity. + ( + % Check if a valid cache entry exists. + is_cached_call(CallCopied, CachedTime, Result), + NewerThan > CachedTime + -> + true % Use cached result if valid. + ; + % Otherwise, execute Call and update cache. + (retractall(is_cached_call(CallCopied, _, _)), % Remove any existing cache for Call. + call_ndet(Call, IsLast), % Execute the Call, expecting it to be nondeterministic. + nop(assertion(IsLast)), % Assert that the last call succeeded, for debugging purposes. + assertz(is_cached_call(CallCopied, CurrentTime, Result)) % Cache the new result. + ) + ), + Call = Result. % Return the result. + + +%% debugging_metta(+G) is nondet. +% Debugging utility for metta-related goals. +debugging_metta(G) :- notrace((is_debugging((eval)) -> ignore(G); true)). + + +:- nodebug(metta(eval)). % Ensure no debugging for metta(eval). + +%% depth_to_use(+InDepth, -UseThis) is det. +% Determine a depth value to use, based on a modulo operation. +% InDepth - The input depth. +% UseThis - The depth to actually use, calculated by modulo 50. +depth_to_use(InDepth, UseThis) :- + Depth is abs(InDepth), % Ensure the depth is non-negative. + UseThis is Depth mod 50, % Calculate modulo 50. + !. % Cut to prevent backtracking. +depth_to_use(_InDepth, 5). % Default to depth 5 if other cases fail. + + +%% w_indent(+Depth, :Goal) is det. +% Execute a goal with indentation based on depth. +% Depth - The depth to determine indentation. +% Goal - The goal to execute with indentation. +w_indent(Depth, Goal) :- + must_det_ll(( + depth_to_use(Depth, UseThis), % Determine the depth to use. + format('~N'), % Start a new line. + setup_call_cleanup(i_this(UseThis), Goal, format('~N')) % Execute the goal with indentation. + )). + +%% i_this(+UseThis) is det. +% Helper predicate to create indentation based on depth. +i_this(UseThis) :- + ignore(catch(forall(between(1, UseThis, _), write(' ')), _, true)), % Write indentation spaces. + write(';;'). % End with a delimiter. + +%% indentq2(+Depth, +Term) is det. +% Print a term with indentation based on depth. +% Depth - The depth for indentation. +% Term - The term to print. +indentq2(Depth, Term) :- + w_indent(Depth, format('~q', [Term])), % Print the term with indentation. + !. +indentq2(_Depth, Term) :- + format('~q', [Term]). % Fallback printing without indentation. + +%% print_padded(+EX, +DR, +AR) is det. +% Print a padded line with extra formatting, if certain conditions are met. +% EX - The EX component for padding. +% DR - The DR component for padding. +% AR - The AR component to print. +print_padded(_DR, _EX, _AR) :- is_fast_mode, !. % Skip printing in fast mode. +print_padded(EX, DR, AR) :- + integer(EX), integer(DR), EX > 0, DR > 0, + nb_current('$print_padded', print_padded(EX, DR, _)), % Check if padding is active. + !, + format("~| |", []), % Print the initial padding. + DRA is abs(round(DR) mod 24), % Calculate padding size. + forall(between(2, DRA, _), write(' |')), % Write additional padding. + write(' '), write(' '), write(AR). % Write the AR value. +print_padded(EX, DR, AR) :- + format("~|~` t~d~5+:~d~5+|", [EX, DR]), % Print padded EX and DR values. + nb_setval('$print_padded', print_padded(EX, DR, AR)), % Set the current padding. + DRA is abs(round(DR) mod 24), % Calculate padding size. + forall(between(1, DRA, _), write(' |')), % Write additional padding. + write('-'), write(AR). % Write the AR value. + +%% indentq_d(+Depth, +Prefix4, +Message) is det. +% Print a message with depth-based indentation and prefix. +% Depth - The depth for indentation. +% Prefix4 - The prefix to include. +% Message - The message to print. +indentq_d(_DR, _EX, _AR) :- is_fast_mode, !. % Skip printing in fast mode. +indentq_d(Depth, Prefix4, Message) :- + flag(eval_num, EX0, EX0), + EX is EX0 mod 500, + DR is 99 - (Depth mod 100), + indentq(DR, EX, Prefix4, Message). % Call indentq with the formatted values. + +%% indentq(+DR, +EX, +AR, +Term) is det. +% Print a term with depth and EX-based indentation. +% DR - Depth for indentation. +% EX - EX component for formatting. +% AR - AR component for formatting. +% Term - The term to print. +indentq(_DR, _EX, _AR, _Term) :- is_fast_mode, !. % Skip printing in fast mode. +indentq(DR, EX, AR, retval(Term)) :- + nonvar(Term), !, + indentq(DR, EX, AR, Term). % Handle return values specially. +indentq(DR, EX, AR, [E, Term]) :- + E == e, !, + indentq(DR, EX, AR, Term). % Special case for list elements. +%indentq(_DR,_EX,_AR,_Term):- flag(trace_output_len,X,X+1), XX is (X mod 1000), XX>100,!. +indentq(DR, EX, AR, ste(S, Term, E)) :- !, + indentq(DR, EX, AR, S, Term, E). % Special case for structured terms. +indentq(DR, EX, AR, Term) :- + indentq(DR, EX, AR, '', Term, ''). % Default case with empty prefix/suffix. + +%% indentq(+DR, +EX, +AR, +S, +Term, +E) is det. +% Print a term with depth-based indentation, including start and end strings. +% DR - Depth for indentation. +% EX - EX component for formatting. +% AR - AR component for formatting. +% S - Start string. +% Term - The term to print. +% E - End string. +indentq(DR, EX, AR, S, Term, E) :- + setup_call_cleanup( + notrace(format('~N;')), + ( + wots(Str, indentq0(DR, EX, AR, S, Term, E)), % Format the term. + newlines_to_spaces(Str, SStr), % Convert newlines to spaces. + write(SStr) % Write the formatted string. + ), + notrace(format('~N')) % End with a newline. + ). + +%% newlines_to_spaces(+Str, -SStr) is det. +% Convert newlines in a string to spaces. +% Str - Input string with newlines. +% SStr - Output string with spaces. +newlines_to_spaces(Str, SStr) :- + atomics_to_string(L, '\n', Str), % Split the string by newlines. + atomics_to_string(L, ' ', SStr). % Join the parts with spaces. + +%% indentq0(+DR, +EX, +AR, +S, +Term, +E) is det. +% Print a term with padding and depth-based indentation. +% DR - Depth for indentation. +% EX - EX component for formatting. +% AR - AR component for formatting. +% S - Start string. +% Term - The term to print. +% E - End string. +indentq0(DR, EX, AR, S, Term, E) :- + as_trace(( + print_padded(EX, DR, AR), % Print the padded line. + format(S, []), % Print the start string. + with_indents(false, write_src(Term)), % Print the term. + format(E, []) % Print the end string. + )). + +%% reset_eval_num is det. +% Reset evaluation-related flags. +reset_eval_num :- + flag(eval_num, _, 0), % Reset eval_num flag. + flag(trace_output_len, _, 0). % Reset trace_output_len flag. + +%% reset_only_eval_num is det. +% Reset only the eval_num flag. +reset_only_eval_num :- + flag(eval_num, _, 0). % Reset eval_num flag. + +%% is_fast_mode is semidet. +% Check if the system is in fast mode. +is_fast_mode :- fail, \+ is_debugging(eval), !. + +%% ignore_trace_once(:Goal) is nondet. +% Ignore trace for a single execution of a goal. +% Goal - The goal to execute. +ignore_trace_once(Goal) :- ignore(notrace(catch(ignore(Goal), _, fail))), !. +%ignore_trace_once(Goal):- must_det_ll(Goal). + +%% as_trace(:Goal) is nondet. +% Execute a goal while suppressing trace output. +% Goal - The goal to execute. +as_trace(Goal) :- + ignore_trace_once(\+ with_no_screen_wrap(color_g_mesg('#2f2f2f', Goal))). + +%% with_no_screen_wrap(:Goal) is nondet. +% Execute a goal without screen wrapping. +% Goal - The goal to execute. +with_no_screen_wrap(Goal) :- !, call(Goal). +with_no_screen_wrap(Goal) :- with_no_wrap(6000, Goal). + +%% with_no_wrap(+Cols, :Goal) is nondet. +% Execute a goal with a specific number of columns, without wrapping. +% Cols - Number of columns to use. +% Goal - The goal to execute. +with_no_wrap(Cols, Goal) :- + % Setup: Save current terminal settings and disable line wrapping + setup_call_cleanup( + begin_no_wrap(Cols, OriginalCols, OriginalRows), % Begin no-wrap mode. + Goal, % Execute the goal. + end_no_wrap(OriginalCols, OriginalRows) % Restore original settings. + ). + +%% begin_no_wrap(+Cols, -OriginalCols, -OriginalRows) is det. +% Begin no-wrap mode by setting terminal size. +% Cols - Desired number of columns. +% OriginalCols - Original number of columns. +% OriginalRows - Original number of rows. +begin_no_wrap(Cols, OriginalCols, OriginalRows) :- + cached_call(30.0, get_current_terminal_settings(OriginalCols, OriginalRows)), % Get current terminal settings. + set_terminal_size(Cols, OriginalRows), % Set the new terminal size. + format('~s', ["\e[?7l"]). % Disable line wrapping. + +%% end_no_wrap(+OriginalCols, +OriginalRows) is det. +% End no-wrap mode by restoring terminal size. +% OriginalCols - Original number of columns. +% OriginalRows - Original number of rows. +end_no_wrap(OriginalCols, OriginalRows) :- + set_terminal_size(OriginalCols, OriginalRows), % Restore original terminal size. + format('~s', ["\e[?7h"]). % Re-enable line wrapping. + +%% get_current_terminal_settings(-Cols, -Rows) is det. +% Get the current terminal size. +% Cols - Number of columns. +% Rows - Number of rows. +get_current_terminal_settings(Cols, Rows) :- + % Use 'stty size' to get the current dimensions of the terminal + process_create(path(stty), ['size'], [stdout(pipe(Stream))]), % Execute stty size command. + read_line_to_string(Stream, SizeStr), % Read the output. + close(Stream), % Close the stream. + split_string(SizeStr, " ", "", [RowsStr, ColsStr]), % Split the string into rows and columns. + number_string(Rows, RowsStr), % Convert rows to number. + number_string(Cols, ColsStr), % Convert columns to number. + !. +get_current_terminal_settings(_, _). + +%% set_terminal_size(+Cols, +Rows) is det. +% Set the terminal size (conceptual, may not work in all terminals). +% Cols - Number of columns. +% Rows - Number of rows. +set_terminal_size(Cols, Rows) :- + % Conceptual; actual resizing may not work in all terminals + if_t(integer(Cols), + if_t(integer(Rows), format('~s~w;~w~s', ["\e[8;", Rows, Cols, "t"]))). + +%% with_debug(+Flag, :Goal) is nondet. +% Execute a goal with debugging enabled based on a flag. +% Flag - Debugging flag. +% Goal - The goal to execute. +with_debug(Flag, Goal) :- + is_debugging(Flag), + !, + call(Goal). +with_debug(Flag, Goal) :- + reset_only_eval_num, + setup_call_cleanup(set_debug(Flag, true), call(Goal), set_debug(Flag, false)). + +%% flag_to_var(+Flag, -Var) is det. +% Convert a debugging flag to a variable name. +% Flag - The debugging flag. +% Var - The resulting variable name. +flag_to_var(Flag, Var) :- atom(Flag), \+ atom_concat('trace-on-', _, Flag), !, atom_concat('trace-on-', Flag, Var). +flag_to_var(metta(Flag), Var) :- !, nonvar(Flag), flag_to_var(Flag, Var). +flag_to_var(Flag, Var) :- Flag = Var. + +%% set_debug(+Flag, +TF) is det. +% Set debugging on or off based on a flag. +% Flag - The debugging flag. +% TF - Boolean flag for true/false. +set_debug(metta(Flag), TF) :- nonvar(Flag), !, set_debug(Flag, TF). +%set_debug(Flag,Val):- \+ atom(Flag), flag_to_var(Flag,Var), atom(Var),!,set_debug(Var,Val). + + +set_debug(Flag, TF) :- TF == 'True', !, set_debug(Flag, true). +set_debug(Flag, TF) :- TF == 'False', !, set_debug(Flag, false). +set_debug(Flag, true) :- !, debug(metta(Flag)). %, flag_to_var(Flag, Var), set_fast_option_value(Var, true). +set_debug(Flag, false) :- nodebug(metta(Flag)). %, flag_to_var(Flag, Var), set_fast_option_value(Var, false). + +%% if_trace(+Flag, :Goal) is nondet. +% Conditionally execute a goal if tracing is enabled for the flag. +% Flag - The tracing flag. +% Goal - The goal to execute. +if_trace(Flag, Goal) :- + notrace(real_notrace((catch_err(ignore((is_debugging(Flag), Goal)), E, + fbug(E --> if_trace(Flag, Goal)))))). + + +%% is_showing(+Flag) is semidet. +% Check if showing is enabled for a flag. +% Flag - The flag to check. +is_showing(Flag) :- fast_option_value(Flag, 'silent'), !, fail. +is_showing(Flag) :- is_verbose(Flag), !. +is_showing(Flag) :- fast_option_value(Flag, 'show'), !. + +%% if_show(+Flag, :Goal) is nondet. +% Conditionally execute a goal if showing is enabled for the flag. +% Flag - The showing flag. +% Goal - The goal to execute. +if_show(Flag, Goal) :- + real_notrace((catch_err(ignore((is_showing(Flag), Goal)), E, + fbug(E --> if_show(Flag, Goal))))). + + +%% fast_option_value(+N, -V) is semidet. +% Get the value of a fast option. +% N - Option name. +% V - Option value. +fast_option_value(N, V) :- atom(N), current_prolog_flag(N, V). + +%% is_verbose(+Flag) is semidet. +% Check if verbose mode is enabled for a flag. +% Flag - The flag to check. +is_verbose(Flag) :- fast_option_value(Flag, 'silent'), !, fail. +is_verbose(Flag) :- fast_option_value(Flag, 'verbose'), !. +is_verbose(Flag) :- is_debugging(Flag), !. + +%% if_verbose(+Flag, :Goal) is nondet. +% Conditionally execute a goal if verbose mode is enabled for the flag. +% Flag - The verbose flag. +% Goal - The goal to execute. +if_verbose(Flag, Goal) :- + real_notrace((catch_err(ignore((is_verbose(Flag), Goal)), E, + fbug(E --> if_verbose(Flag, Goal))))). + +%% maybe_efbug(+SS, :G) is nondet. +% Execute a goal and potentially report it as an efbug. +% SS - The string to report. +% G - The goal to execute. + +%maybe_efbug(SS,G):- efbug(SS,G)*-> if_trace(eval,fbug(SS=G)) ; fail. +maybe_efbug(_, G) :- call(G). + +%% efbug(+_, :G) is nondet. +% Execute a goal, suppressing trace errors. +% _ - Ignored parameter. +% G - The goal to execute. + +%efbug(P1,G):- call(P1,G). +efbug(_, G) :- call(G). + +%% is_debugging_always(+_Flag) is semidet. +% Always return true for debugging, used as a placeholder. +is_debugging_always(_Flag) :- !. + +%% is_debugging(+Flag) is semidet. +% Check if debugging is enabled for a flag. +% Flag - The flag to check. + +%is_debugging(Flag):- !, fail. +is_debugging(Flag) :- var(Flag), !, fail. +is_debugging((A; B)) :- !, (is_debugging(A); is_debugging(B)). +is_debugging((A, B)) :- !, (is_debugging(A), is_debugging(B)). +is_debugging(not(Flag)) :- !, \+ is_debugging(Flag). +is_debugging(Flag) :- Flag == false, !, fail. +is_debugging(Flag) :- Flag == true, !. +%is_debugging(e):- is_testing, \+ fast_option_value(compile,'full'),!. +%is_debugging(e):- is_testing,!. +%is_debugging(eval):- is_testing,!. +%is_debugging(_):-!,fail. +is_debugging(Flag) :- fast_option_value(Flag, 'debug'), !. +is_debugging(Flag) :- fast_option_value(Flag, 'trace'), !. +is_debugging(Flag) :- debugging(metta(Flag), TF), !, TF == true. +%is_debugging(Flag):- debugging(Flag,TF),!,TF==true. +%is_debugging(Flag):- once(flag_to_var(Flag,Var)), +% (fast_option_value(Var,true)->true;(Flag\==Var -> is_debugging(Var))). + +% overflow = trace +% overflow = fail +% overflow = continue +% overflow = debug + +%% trace_eval(:P4, +TNT, +D1, +Self, +X, +Y) is det. +% Perform trace evaluation of a goal, managing trace output and depth. +% P4 - The predicate to call. +% TNT - The trace name/type. +% D1 - The current depth. +% Self - The self-referential term. +% X - Input term. +% Y - Output term. +trace_eval(P4, TNT, D1, Self, X, Y) :- + must_det_ll(( + notrace(( + flag(eval_num, EX0, EX0 + 1), % Increment eval_num flag. + EX is EX0 mod 500, % Calculate EX modulo 500. + DR is 99 - (D1 mod 100), % Calculate DR based on depth. + PrintRet = _, % Initialize PrintRet. + option_else('trace-length', Max, 500), % Get trace-length option. + option_else('trace-depth', DMax, 30) % Get trace-depth option. + )), + quietly((if_t((nop(stop_rtrace), EX > Max), (set_debug(eval, false), MaxP1 is Max + 1, + %set_debug(overflow,false), + nop(format('; Switched off tracing. For a longer trace: !(pragma! trace-length ~w)', [MaxP1])), + nop((start_rtrace, rtrace)))))), + nop(notrace(no_repeats_var(NoRepeats))))), + + ((sub_term(TN, TNT), TNT \= TN) -> true ; TNT = TN), % Ensure proper subterm handling. + %if_t(DR', [TN, X]))) ), + + Ret = retval(fail), !, + + (Display = ( \+ \+ (flag(eval_num, EX1, EX1 + 1), + ((Ret \=@= retval(fail), nonvar(Y)) + -> indentq(DR, EX1, '<--', [TN, Y]) + ; indentq(DR, EX1, '<--', [TN, Ret]))))), + + call_cleanup(( + (call(P4, D1, Self, X, Y) *-> nb_setarg(1, Ret, Y); + (fail, trace, (call(P4, D1, Self, X, Y)))), + ignore((notrace(( \+ (Y \= NoRepeats), nb_setarg(1, Ret, Y)))))), + % cleanup + ignore((PrintRet == 1 -> ignore(Display) ; + (notrace(ignore((( % Y\=@=X, + if_t(DRtrue;(fail,trace,(call(P4,D1,Self,X,Y)),fail)). + + + +:- set_prolog_flag(expect_pfc_file, unknown). + +% ======================================================= +/* +% +%= predicates to examine the state of pfc +% interactively exploring Pfc justifications. +% +% Logicmoo Project PrologMUD: A MUD server written in Prolog +% Maintainer: Douglas Miles +% Dec 13, 2035 +% +*/ +% ======================================================= +% File: /opt/PrologMUD/pack/logicmoo_base/prolog/logicmoo/mpred/pfc_list_triggers.pl +:- if(( ( \+ ((current_prolog_flag(logicmoo_include,Call),Call))) )). +pfc_listing_module :- nop(module(pfc_listing, + [ draw_line/0, + loop_check_just/1, + pinfo/1, + pp_items/2, + pp_item/2, + pp_filtered/1, + pp_facts/2, + pp_facts/1, + pp_facts/0, + pfc_list_triggers_types/1, + pfc_list_triggers_nlc/1, + pfc_list_triggers_1/1, + pfc_list_triggers_0/1, + pfc_list_triggers/1, + pfc_contains_term/2, + pfc_classify_facts/4, + lqu/0, + get_clause_vars_for_print/2, + %pfcWhyBrouse/2, + %pfcWhy1/1, + %pfcWhy/1, + %pfcWhy/0, + pp_rules/0, + pfcPrintSupports/0, + pfcPrintTriggers/0, + print_db_items/1, + print_db_items/2, + print_db_items/3, + print_db_items/4, + print_db_items_and_neg/3, + show_pred_info/1, + show_pred_info_0/1, + pfc_listing_file/0 + ])). + +%:- include('pfc_header.pi'). + +:- endif. + +% Operator declarations +:- op(500, fx, '~'). +:- op(1050, xfx, ('==>')). +:- op(1050, xfx, '<==>'). + :- op(1050,xfx,('<-')). + :- op(1100,fx,('==>')). +:- op(1150, xfx, ('::::')). + +% :- use_module(logicmoo(util/logicmoo_util_preddefs)). + +:- multifile(( + user:portray/1, + user:prolog_list_goal/1, + user:prolog_predicate_name/2, + user:prolog_clause_name/2)). + +:- dynamic user:portray/1. + +%:- dynamic(whybuffer/2). + +%% lqu is semidet. +% Lists all clauses of the predicate que/2. +lqu :- listing(que/2). + +:- ensure_loaded(metta_pfc_base). + +% File : pfcdebug.pl +% Author : Tim Finin, finin@prc.unisys.com +% Author : Dave Matuszek, dave@prc.unisys.com +% Author : Douglas R. Miles, dmiles@teknowledge.com +% Updated: +% Purpose: provides predicates for examining the database and debugging +% for Pfc. + +:- dynamic pfcTraced/1. +:- dynamic pfcSpied/2. +:- dynamic pfcTraceExecution/0. +:- dynamic pfcWarnings/1. + +:- pfcDefault(pfcWarnings(_), pfcWarnings(true)). + +%% pfcQueue is semidet. +% Lists all clauses of the predicate pfcQueue/1. +pfcQueue :- listing(pfcQueue/1). + +%% pfcPrintDB is semidet. +% Prints the entire Pfc database, including facts, rules, triggers, and supports. +pfcPrintDB :- + pfcPrintFacts, + pfcPrintRules, + pfcPrintTriggers, + pfcPrintSupports,!. + +%% printLine is semidet. +% Draws a line in the console output for formatting purposes. +printLine :- ansi_format([underline], "~N=========================================~n", []). + +%% pfcPrintFacts is semidet. +% Prints all facts in the Pfc database. +pfcPrintFacts :- pfcPrintFacts(_, true). + +%% pfcPrintFacts(+Pattern) is semidet. +% Prints all facts in the Pfc database that match a given pattern. +% Pattern - The pattern to match facts against. +pfcPrintFacts(Pattern) :- pfcPrintFacts(Pattern, true). + +%% pfcPrintFacts(+Pattern, +Condition) is semidet. +% Prints all facts in the Pfc database that match a given pattern and condition. +% Pattern - The pattern to match facts against. +% Condition - The condition to filter facts. +pfcPrintFacts(P, C) :- + pfcFacts(P, C, L), + pfcClassifyFacts(L, User, Pfc, _Rule), + printLine, + pfcPrintf("User added facts:~n", []), + pfcPrintitems(User), + printLine, + pfcPrintf("MettaLog-Pfc added facts:~n", []), + pfcPrintitems(Pfc), + printLine,!. + +%% pfcPrintitems(+List) is det. +% Prints a list of items. Note that this predicate clobbers its arguments, so beware. +% List - The list of items to print. +pfcPrintitems([]). +pfcPrintitems([H|T]) :- + % numbervars(H,0,_), + %format('~N ~p.',[H]), + \+ \+ ( pretty_numbervars(H, H1), format(" ", []), portray_clause_w_vars(H1)), + pfcPrintitems(T). + +%% pfcClassifyFacts(+Facts, -UserFacts, -PfcFacts, -RuleFacts) is det. +% Classifies a list of facts into user-added facts, Pfc-added facts, and rule facts. +% Facts - The list of facts to classify. +% UserFacts - The list of user-added facts. +% PfcFacts - The list of Pfc-added facts. +% RuleFacts - The list of rule facts. +pfcClassifyFacts([], [], [], []). + +pfcClassifyFacts([H|T], User, Pfc, [H|Rule]) :- + pfcType(H, rule), + !, + pfcClassifyFacts(T, User, Pfc, Rule). + +pfcClassifyFacts([H|T], [H|User], Pfc, Rule) :- + matches_why_UU(UU), + pfcGetSupport(H, UU), + !, + pfcClassifyFacts(T, User, Pfc, Rule). + +pfcClassifyFacts([H|T], User, [H|Pfc], Rule) :- + pfcClassifyFacts(T, User, Pfc, Rule). + +%% pfcPrintRules is semidet. +% Prints all rules in the Pfc database. +pfcPrintRules :- + printLine, + pfcPrintf("Rules:...~n", []), + bagof_or_nil((P==>Q), clause((P==>Q), true), R1), + pfcPrintitems(R1), + bagof_or_nil((P<==>Q), clause((P<==>Q), true), R2), + pfcPrintitems(R2), + bagof_or_nil((P<-Q), clause((P<-Q), true), R3), + pfcPrintitems(R3), + printLine. + +%% pfcGetTrigger(-Trigger) is nondet. +% Retrieves a trigger from the Pfc database. +% Trigger - The retrieved trigger. +pfcGetTrigger(Trigger) :- pfc_call(Trigger). + +%% pfcPrintTriggers is semidet. +% Pretty prints all triggers in the Pfc database. +pfcPrintTriggers :- + print_db_items("Positive triggers", '$pt$'(_, _)), + print_db_items("Negative triggers", '$nt$'(_, _, _)), + print_db_items("Goal triggers", '$bt$'(_, _)). + +pp_triggers :- pfcPrintTriggers. + +%% pfcPrintSupports is semidet. +% Pretty prints all supports in the Pfc database. +pfcPrintSupports :- + % temporary hack. + draw_line, + fmt("Supports ...~n", []), + setof_or_nil((P =< S), (pfcGetSupport(P, S), \+ pp_filtered(P)), L), + pp_items('Support', L), + draw_line,!. +pp_supports :- pfcPrintSupports. + +%% pp_filtered(+Predicate) is semidet. +% Checks if a predicate should be filtered out from pretty-printing. +% Predicate - The predicate to check. +pp_filtered(P) :- var(P),!,fail. +pp_filtered(_:P) :- !, pp_filtered(P). +pp_filtered(P) :- safe_functor(P, F, A), F\==(/),!, pp_filtered(F/A). +pp_filtered(F/_) :- F==pfc_prop. + +%% pfcFact(+Predicate) is semidet. +% Checks if a fact was asserted into the database via pfcAdd. +% Predicate - The fact to check. +pfcFact(P) :- pfcFact(P, true). + +%% pfcFact(+Predicate, +Condition) is semidet. +% Checks if a fact was asserted into the database via pfcAdd and a condition is satisfied. +% Predicate - The fact to check. +% Condition - The condition to check. +% Example: pfcFact(X,pfcUserFact(X)) +pfcFact(F, C) :- + filter_to_pattern_call(F, P, Call), + pfcFact1(P, C), + pfcCallSystem(Call). + +%% pfcFact1(+Predicate, +Condition) is semidet. +% Helper predicate for pfcFact/2. +% Predicate - The fact to check. +% Condition - The condition to check. +pfcFact1(P, C) :- + pfcGetSupport(P, _), + pfcType(P, fact(_)), + pfcCallSystem(C). + +%% pfcFacts(-ListofPfcFacts) is det. +% Returns a list of facts added to the Pfc database. +% ListofPfcFacts - The list of facts. +pfcFacts(L) :- pfcFacts(_, true, L). + +%% pfcFacts(+Pattern, -ListofPfcFacts) is det. +% Returns a list of facts added to the Pfc database that match a given pattern. +% Pattern - The pattern to match facts against. +% ListofPfcFacts - The list of facts. +pfcFacts(P, L) :- pfcFacts(P, true, L). + +%% pfcFacts(+Pattern, +Condition, -ListofPfcFacts) is det. +% Returns a list of facts added to the Pfc database that match a given pattern and condition. +% Pattern - The pattern to match facts against. +% Condition - The condition to filter facts. +% ListofPfcFacts - The list of facts. +pfcFacts(P, C, L) :- setof_or_nil(P, pfcFact(P, C), L). + +%% brake(+Predicate) is det. +% Calls a system predicate and breaks execution. +% Predicate - The predicate to call. +brake(X) :- pfcCallSystem(X), ibreak. + +%% pfcTraceAdd(+Predicate) is det. +% Adds a predicate to the Pfc trace. +% Predicate - The predicate to trace. +pfcTraceAdd(P) :- + % this is here for upward compat. - should go away eventually. + pfcTraceAdd(P, (o, o)). + +%% pfcTraceAdd(+Trigger, +Support) is det. +% Adds a trigger and its support to the Pfc trace. +% Trigger - The trigger to trace. +% Support - The support of the trigger. +pfcTraceAdd('$pt$'(_, _), _) :- !. % Never trace positive triggers. +pfcTraceAdd('$nt$'(_, _), _) :- !. % Never trace negative triggers. + +pfcTraceAdd(P, S) :- + pfcTraceAddPrint(P, S), + pfcTraceBreak(P, S). + +%% pfcTraceAddPrint(+Predicate, +Support) is det. +% Prints a predicate being added to the Pfc trace. +% Predicate - The predicate to print. +% Support - The support of the predicate. +pfcTraceAddPrint(P, S) :- + pfcIsTraced(P), + !, + \+ \+ (pretty_numbervars(P, Pcopy), + % numbervars(Pcopy,0,_), + matches_why_UU(UU), + (S=UU + -> pfcPrintf("Adding (u) ~@", [fmt_cl(Pcopy)]) + ; pfcPrintf("Adding ~@", [fmt_cl(Pcopy)]))). + +pfcTraceAddPrint(_, _). + +%% pfcTraceBreak(+Predicate, +Support) is det. +% Breaks execution if a predicate is spied in the Pfc trace. +% Predicate - The predicate to check. +% Support - The support of the predicate. +pfcTraceBreak(P, _S) :- + pfcSpied(P, +) -> + (pretty_numbervars(P, Pcopy), + % numbervars(Pcopy,0,_), + pfcPrintf("Breaking on pfcAdd(~p)", [Pcopy]), + ibreak) + ; true. + +%% pfcTraceRem(+Trigger) is det. +% Removes a trigger from the Pfc trace. +% Trigger - The trigger to remove. +pfcTraceRem('$pt$'(_, _)) :- !. % Never trace positive triggers. +pfcTraceRem('$nt$'(_, _)) :- !. % Never trace negative triggers. + +pfcTraceRem(P) :- + (pfcIsTraced(P) + -> pfcPrintf("Removing: ~p.", [P]) + ; true), + (pfcSpied(P, -) + -> (pfcPrintf("Breaking on pfcRem(~p)", [P]), + ibreak) + ; true). + +%% pfcIsTraced(+Predicate) is semidet. +% Checks if a predicate is being traced. +% Predicate - The predicate to check. +pfcIsTraced(P) :- pfcIsNotTraced(P),!,fail. +pfcIsTraced(P) :- compound_eles(1, P, Arg), pfcTraced(Arg). + +%% pfcIsNotTraced(+Predicate) is semidet. +% Checks if a predicate is not being traced. +% Predicate - The predicate to check. +pfcIsNotTraced(P) :- compound_eles(1, P, Arg), pfcIgnored(Arg). + +:- dynamic(pfcIgnored/1). + +%% compound_eles(+Level, +Compound, -Element) is det. +% Extracts elements from a compound term. +% Level - The level of extraction. +% Compound - The compound term. +% Element - The extracted element. +compound_eles(Lvl, P, Arg) :- var(P),!, get_attr(P, A, AV), compound_eles(Lvl, attvar(A, AV), Arg). +compound_eles(Lvl, P, Arg) :- (\+ compound(P); Lvl<1),!, Arg=P. +compound_eles(Lvl, P, Arg) :- LvlM1 is Lvl-1, compound_eles(P, E), compound_eles(LvlM1, E, Arg). + +compound_eles(P, E) :- is_list(P),!, member(E, P). +compound_eles(P, E) :- compound(P), compound_name_arguments(P, F, Args),!, member(E, [F|Args]). + +%% mpred_trace_exec is det. +% Enables tracing and watching in Pfc. +mpred_trace_exec :- pfcWatch, pfcTrace. + +%% mpred_notrace_exec is det. +% Disables tracing and watching in Pfc. +mpred_notrace_exec :- pfcNoTrace, pfcNoWatch. +%% pfcTrace is det. +% Enables tracing in Pfc. +pfcTrace :- pfcTrace(_). + +%% pfcTrace(+Form) is det. +% Enables tracing for a specific form in Pfc. +% Form - The form to trace. +pfcTrace(Form) :- + assert(pfcTraced(Form)). + +%% pfcTrace(+Form, +Condition) is det. +% Enables tracing for a specific form under a given condition in Pfc. +% Form - The form to trace. +% Condition - The condition under which to trace the form. +pfcTrace(Form, Condition) :- + assert((pfcTraced(Form) :- Condition)). + +%% pfcSpy(+Form) is det. +% Adds a form to the Pfc spy list. +% Form - The form to spy on. +pfcSpy(Form) :- pfcSpy(Form, [+,-], true). + +%% pfcSpy(+Form, +Modes) is det. +% Adds a form to the Pfc spy list with specific modes. +% Form - The form to spy on. +% Modes - The modes to use for spying. +pfcSpy(Form, Modes) :- pfcSpy(Form, Modes, true). + +%% pfcSpy(+Form, +Modes, +Condition) is det. +% Adds a form to the Pfc spy list with specific modes and a condition. +% Form - The form to spy on. +% Modes - The modes to use for spying. +% Condition - The condition under which to spy the form. +pfcSpy(Form, [H|T], Condition) :- + !, + pfcSpy1(Form, H, Condition), + pfcSpy(Form, T, Condition). + +pfcSpy(Form, Mode, Condition) :- + pfcSpy1(Form, Mode, Condition). + +%% pfcSpy1(+Form, +Mode, +Condition) is det. +% Helper predicate for pfcSpy/3. +% Form - The form to spy on. +% Mode - The mode to use for spying. +% Condition - The condition under which to spy the form. +pfcSpy1(Form, Mode, Condition) :- + assert((pfcSpied(Form, Mode) :- Condition)). + +%% pfcNospy is det. +% Removes all forms from the Pfc spy list. +pfcNospy :- pfcNospy(_,_,_). + +%% pfcNospy(+Form) is det. +% Removes a specific form from the Pfc spy list. +% Form - The form to remove. +pfcNospy(Form) :- pfcNospy(Form,_,_). + +%% pfcNospy(+Form, +Mode, +Condition) is det. +% Removes a specific form from the Pfc spy list with a given mode and condition. +% Form - The form to remove. +% Mode - The mode to remove. +% Condition - The condition to remove. +pfcNospy(Form, Mode, Condition) :- + clause(pfcSpied(Form, Mode), Condition, Ref), + erase(Ref), + fail. + +pfcNospy(_,_,_). + +%% pfcNoTrace is det. +% Disables tracing in Pfc. +pfcNoTrace :- pfcUntrace. + +%% pfcUntrace is det. +% Untraces all forms in Pfc. +pfcUntrace :- pfcUntrace(_). + +%% pfcUntrace(+Form) is det. +% Untraces a specific form in Pfc. +% Form - The form to untrace. +pfcUntrace(Form) :- retractall(pfcTraced(Form)). + +%% pfcTraceMsg(+Message) is det. +% Traces a message in Pfc. +% Message - The message to trace. +pfcTraceMsg(Msg) :- pfcTraceMsg('~p', [Msg]). + +%% pfcTraceMsg(+Message, +Arguments) is det. +% Traces a message with arguments in Pfc. +% Message - The message to trace. +% Arguments - The arguments for the message. +pfcTraceMsg(Msg, Args) :- + pfcTraceExecution, + !, + pfcPrintf(user_output, Msg, Args). +pfcTraceMsg(Msg, Args) :- + member(P, Args), pfcIsTraced(P), + !, + pfcPrintf(user_output, Msg, Args). +pfcTraceMsg(_, _). + +%% pfcPrintf(+Message, +Arguments) is det. +% Prints a formatted message in Pfc. +% Message - The message to print. +% Arguments - The arguments for the message. +pfcPrintf(Msg, Args) :- + pfcPrintf(user_output, Msg, Args). + +%% pfcPrintf(+Where, +Message, +Arguments) is det. +% Prints a formatted message to a specific location in Pfc. +% Where - The location to print the message. +% Message - The message to print. +% Arguments - The arguments for the message. +pfcPrintf(Where, Msg, Args) :- + format(Where, '~N', []), + with_output_to(Where, + color_g_mesg_ok(blue, format(Msg, Args))). + +%% pfcWatch is det. +% Enables execution tracing in Pfc. +pfcWatch :- clause(pfcTraceExecution, true),!. +pfcWatch :- assert(pfcTraceExecution). + +%% pfcNoWatch is det. +% Disables execution tracing in Pfc. +pfcNoWatch :- retractall(pfcTraceExecution). + +%% pfcError(+Message) is det. +% Prints an error message in Pfc. +% Message - The error message to print. +pfcError(Msg) :- pfcError(Msg, []). + +%% pfcError(+Message, +Arguments) is det. +% Prints an error message with arguments in Pfc. +% Message - The error message to print. +% Arguments - The arguments for the message. +pfcError(Msg, Args) :- + format("~N~nERROR/Pfc: ", []), + format(Msg, Args). + +% % +% % These control whether or not warnings are printed at all. +% % pfcWarn. +% % nopfcWarn. +% % +% % These print a warning message if the flag pfcWarnings is set. +% % pfcWarn(+Message) +% % pfcWarn(+Message,+ListOfArguments) +% % + + + + + + +%% pfcWarn is det. +% Enables warning messages in Pfc. +pfcWarn :- + retractall(pfcWarnings(_)), + assert(pfcWarnings(true)). + +%% nopfcWarn is det. +% Disables warning messages in Pfc. +nopfcWarn :- + retractall(pfcWarnings(_)), + assert(pfcWarnings(false)). + +%% pfcWarn(+Message) is det. +% Prints a warning message in Pfc. +% Message - The warning message to print. +pfcWarn(Msg) :- pfcWarn('~p', [Msg]). + +%% pfcWarn(+Message, +Arguments) is det. +% Prints a warning message with arguments in Pfc. +% Message - The warning message to print. +% Arguments - The arguments for the message. +pfcWarn(Msg, Args) :- + pfcWarnings(true), + !, + ansi_format([underline, fg(red)], "~N==============WARNING/Pfc================~n", []), + ansi_format([fg(yellow)], Msg, Args), + printLine. +pfcWarn(_, _). + +%% pfcWarnings is det. +% Enables warning messages in Pfc. +% sets flag to cause pfc warning messages to print. +pfcWarnings :- + retractall(pfcWarnings(_)), + assert(pfcWarnings(true)). + +%% pfcNoWarnings is det. +% Disables warning messages in Pfc. +% sets flag to cause pfc warning messages not to print. +pfcNoWarnings :- + retractall(pfcWarnings(_)). + +%% pp_facts is semidet. +% Pretty prints all facts in the Pfc database. +pp_facts :- pp_facts(_, true). + +%% pp_facts(+Pattern) is semidet. +% Pretty prints facts in the Pfc database that match a given pattern. +% Pattern - The pattern to match facts against. +pp_facts(Pattern) :- pp_facts(Pattern, true). + +%% pp_facts(+Pattern, +Condition) is semidet. +% Pretty prints facts in the Pfc database that match a given pattern and condition. +% Pattern - The pattern to match facts against. +% Condition - The condition to filter facts. +pp_facts(P, C) :- + pfcFacts(P, C, L), + pfc_classify_facts(L, User, Pfc, _Rule), + draw_line, + fmt("User added facts:", []), + pp_items(user, User), + draw_line, + draw_line, + fmt("MettaLog-Pfc added facts:", []), + pp_items(system, Pfc), + draw_line. + +%% pp_deds is semidet. +% Pretty prints all deduced facts in the Pfc database. +pp_deds :- pp_deds(_, true). + +%% pp_deds(+Pattern) is semidet. +% Pretty prints deduced facts in the Pfc database that match a given pattern. +% Pattern - The pattern to match facts against. +pp_deds(Pattern) :- pp_deds(Pattern, true). + +%% pp_deds(+Pattern, +Condition) is semidet. +% Pretty prints deduced facts in the Pfc database that match a given pattern and condition. +% Pattern - The pattern to match facts against. +% Condition - The condition to filter facts. +pp_deds(P, C) :- + pfcFacts(P, C, L), + pfc_classify_facts(L, _User, Pfc, _Rule), + draw_line, + fmt("MettaLog-Pfc added facts:", []), + pp_items(system, Pfc), + draw_line. + +%% show_deds_w(+Pattern) is semidet. +% Shows deduced facts that match a given pattern. +% Pattern - The pattern to match deduced facts against. +show_deds_w(F) :- pp_deds(F). + +%% show_info(+Pattern) is semidet. +% Shows information about facts that match a given pattern. +% Pattern - The pattern to match facts against. +show_info(F) :- + pfcFacts(_, true, L), + include(sub_functor(F), L, FL), + pfc_classify_facts(FL, User, Pfc, _Rule), + draw_line, + fmt("User added facts with ~q:", [F]), + pp_items(user, User), + draw_line, + draw_line, + fmt("MettaLog-Pfc added facts with ~q:", [F]), + pp_items(system, Pfc), + draw_line. + +%% maybe_filter_to_pattern_call(+Pattern, +Predicate, -Condition) is det. +% Converts a pattern and predicate to a condition for filtering. +% Pattern - The pattern to filter. +% Predicate - The predicate to filter. +% Condition - The resulting condition. +maybe_filter_to_pattern_call(F, _, true) :- var(F), !, fail. +maybe_filter_to_pattern_call(F, P, true) :- atom(F), !, (P = F ; freeze(P, (P \== F, sub_functor(F, P)))). +maybe_filter_to_pattern_call(F, P, true) :- \+ compound(F), !, P = _ ; freeze(P, (P \== F, sub_functor(F, P))). +maybe_filter_to_pattern_call(F/A, P, true) :- !, freeze(P, (P \== F, sub_functor(F/A, P))). +%maybe_filter_to_pattern_call(F,P,true):-P=F. + +%% filter_to_pattern_call(+Pattern, +Predicate, -Condition) is det. +% Converts a pattern and predicate to a condition for filtering, with alternative handling. +% Pattern - The pattern to filter. +% Predicate - The predicate to filter. +% Condition - The resulting condition. +filter_to_pattern_call(F, P, Call) :- + maybe_filter_to_pattern_call(F, P, Call) *-> true; alt_filter_to_pattern_call(F, P, Call). + +%% alt_filter_to_pattern_call(+Pattern, +Predicate, -Condition) is det. +% Alternative handling for filter_to_pattern_call/3. +% Pattern - The pattern to filter. +% Predicate - The predicate to filter. +% Condition - The resulting condition. +alt_filter_to_pattern_call(P, P, true). + +%% sub_functor(+Functor, +Term) is semidet. +% Checks if a term contains a specific functor. +% Functor - The functor to check for. +% Term - The term to check. +sub_functor(F-UnF, Term) :- !, sub_functor(F, Term), \+ sub_functor(UnF, Term). +sub_functor(F, Term) :- var(F), !, sub_var(F, Term), !. +sub_functor(F/A, Term) :- !, sub_term(E, Term), compound(E), compound_name_arity(E, F, A). +sub_functor(F, Term) :- sub_term(E, Term), E =@= F, !. +sub_functor(F, Term) :- sub_term(E, Term), compound(E), compound_name_arity(E, FF, AA), (AA == F ; FF == F). + +%% pp_items(+Type, +Items) is semidet. +% Pretty prints a list of items. +% Type - The type of items. +% Items - The list of items to print. +pp_items(_Type, []) :- !. +pp_items(Type, [H|T]) :- + ignore(pp_item(Type, H)), !, + pp_items(Type, T). +pp_items(Type, H) :- ignore(pp_item(Type, H)). + +:- thread_local t_l:print_mode/1. + +%% pp_item(+Mode, +Item) is semidet. +% Pretty prints a single item. +% Mode - The mode for printing. +% Item - The item to print. +pp_item(_M, H) :- pp_filtered(H), !. +pp_item(MM, (H :- B)) :- B == true, pp_item(MM, H). +pp_item(MM, H) :- flag(show_asserions_offered, X, X+1), find_and_call(get_print_mode(html)), (\+ \+ if_defined(pp_item_html(MM, H))), !. + +pp_item(MM, '$spft$'(W0, U, ax)) :- W = (_KB:W0), !, pp_item(MM, U:W). +pp_item(MM, '$spft$'(W0, F, U)) :- W = (_KB:W0), atom(U), !, fmt('~N%~n', []), pp_item(MM, U:W), fmt('rule: ~p~n~n', [F]), !. +pp_item(MM, '$spft$'(W0, F, U)) :- W = (_KB:W0), !, fmt('~w~nd: ~p~nformat: ~p~n', [MM, W, F]), pp_item(MM, U). +pp_item(MM, '$nt$'(Trigger0, Test, Body)) :- Trigger = (_KB:Trigger0), !, fmt('~w n-trigger(-): ~p~ntest: ~p~nbody: ~p~n', [MM, Trigger, Test, Body]). +pp_item(MM, '$pt$'(F0, Body)) :- F = (_KB:F0), !, fmt('~w p-trigger(+):~n', [MM]), pp_item('', (F:-Body)). +pp_item(MM, '$bt$'(F0, Body)) :- F = (_KB:F0), !, fmt('~w b-trigger(?):~n', [MM]), pp_item('', (F:-Body)). + +pp_item(MM, U:W) :- !, format(string(S), '~w ~w:', [MM, U]), !, pp_item(S, W). +pp_item(MM, H) :- \+ \+ (get_clause_vars_for_print(H, HH), fmt("~w ~p~N", [MM, HH])). +%% get_clause_vars_for_print(+Clause, -ClauseWithVars) is det. +% Prepares a clause for printing by handling variables. +% Clause - The clause to prepare. +% ClauseWithVars - The clause with variables prepared for printing. +get_clause_vars_for_print(HB, HB) :- ground(HB), !. +get_clause_vars_for_print(I, I) :- is_listing_hidden(skipVarnames), fail. +get_clause_vars_for_print(H0, MHB) :- get_clause_vars_copy(H0, MHB), H0 \=@= MHB, !. +get_clause_vars_for_print(HB, HB) :- numbervars(HB, 0, _, [singletons(true), attvars(skip)]), !. + +%% pfc_classify_facts(+Facts, -UserFacts, -PfcFacts, -Rules) is det. +% Classifies facts into user facts, Pfc deductions, and rules. +% Facts - The facts to classify. +% UserFacts - The User Added facts. +% PfcFacts - The System Added facts. +% Rules - Classified as rules +pfc_classify_facts([],[],[],[]). + +pfc_classify_facts([H|T],User,Pfc,[H|Rule]) :- + pfcType(H,rule), + !, + pfc_classify_facts(T,User,Pfc,Rule). + +pfc_classify_facts([H|T],[H|User],Pfc,Rule) :- + pfcGetSupport(H,(mfl4(_VarNameZ,_,_,_),ax)), + !, + pfc_classify_facts(T,User,Pfc,Rule). + +pfc_classify_facts([H|T],User,[H|Pfc],Rule) :- + pfc_classify_facts(T,User,Pfc,Rule). + + +%= + +% % print_db_items( ?T, ?I) is semidet. +% +% Print Database Items. +% T - The title or label for the items being printed. +% I - The items or goals to be printed. +% +print_db_items(T, I):- + draw_line, % Draw a separator line before printing. + fmt("~N~w ...~n",[T]), % Print the title. + print_db_items(I), % Print the database items. + draw_line, % Draw a separator line after printing. + !. + +%= + +%% print_db_items( ?I) is semidet. +% +% Print Database Items. +% I - The predicate or item to be printed. +% +print_db_items(F/A):- + number(A),!, % Check if A is a number, ensuring F/A is a valid functor/arity pair. + safe_functor(P,F,A),!, % Safely create a functor from F and A. + print_db_items(P). % Print the functor. +print_db_items(H):- + bagof(H,clause(H,true),R1), % Collect all clauses matching H into a list R1. + pp_items((':'),R1), % Pretty print the collected items. + R1\==[],!. % Succeed if the list is non-empty. +print_db_items(H):- + \+ current_predicate(_,H),!. % Succeed if H is not a current predicate. +print_db_items(H):- + catch( ('$find_predicate'(H,_),call_u(listing(H))),_,true),!, % Try to list the predicate, catching any errors. + nl,nl. % Print two newlines after listing. + +%= + +% % pp_rules is semidet. +% +% Pretty Print Rules. +% This predicate prints different types of rules and facts in the database. +% +pp_rules :- + print_db_items("Forward Rules",(_ ==> _)), % Print forward rules. + print_db_items("Bidirectional Rules",(_ <==> _)), % Print bidirectional rules. + print_db_items("Implication Rules",=>(_ , _)), % Print implication rules. + print_db_items("Bi-conditional Rules",<=>(_ , _)), % Print bi-conditional rules. + print_db_items("Backchaining Rules",(_ <- _)), % Print backchaining rules. + print_db_items("Positive Facts",(==>(_))), % Print positive facts. + print_db_items("Negative Facts",(~(_))). % Print negative facts. + +%= + +% % draw_line is semidet. +% +% Draw Line. +% This predicate draws a line separator in the console output. +% +draw_line:- + \+ thread_self_main,!. % Do nothing if not in the main thread. +draw_line:- printLine,!. % Attempt to use printLine to draw a line. +draw_line:- + (t_l:print_mode(H)->true;H=unknown), % Get the current print mode or set to unknown. + fmt("~N% % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % %~n",[]), % Draw the line using format. + H=H. + +:- meta_predicate loop_check_just(0). + +%= + +% % loop_check_just( :GoalG) is semidet. +% +% Loop Check Justification. +% GoalG - The goal to check for loops. +% +loop_check_just(G):- + loop_check(G,ignore(arg(1,G,[]))). % Perform loop check, ignoring goals with an empty first argument. + +%= + +% % show_pred_info( ?F) is semidet. +% +% Show Predicate Info. +% PI - The predicate indicator (F/A) for which information is to be shown. +% +show_pred_info(PI):- + (( + pi_to_head_l(PI,Head), % Convert predicate indicator to head. + % doall(show_call(why,call_u(isa(Head,_)))), + safe_functor(Head,F,_), % Extract the functor from the head. + doall(show_call(why,call_u(isa(F,_)))), % Show all instances where F is a certain type. + ((current_predicate(_,M:Head), (\+ predicate_property(M:Head,imported_from(_)))) + -> show_pred_info_0(M:Head); % Show predicate info if not imported. + wdmsg_pretty(cannot_show_pred_info(Head))))),!. % Display a message if unable to show info. + +%= + +% % show_pred_info_0( ?Head) is semidet. +% +% Show Predicate Info Primary Helper. +% Head - The head of the predicate for which information is to be shown. +% +show_pred_info_0(Head):- + doall(show_call(why,predicate_property(Head,_))), % Show all properties of the predicate. + (has_cl(Head)->doall((show_call(why,clause(Head,_))));quietly((listing(Head)))),!. % List the predicate clauses or show the listing. + +% =================================================== +% Pretty Print Formula +% =================================================== + +%= + +% % print_db_items( ?Title, ?Mask, ?What) is semidet. +% +% Print Database Items. +% Title - The title to be printed. +% Mask - The mask or pattern to match. +% What - The items to print. +% +print_db_items(Title,Mask,What):- + print_db_items(Title,Mask,Mask,What). % Print items with the given title, mask, and what parameters. + +%= + + +%% print_db_items(+Title, +Mask, +Show, +What) is semidet. +% Prints database items based on a mask, show predicate, and a condition. +% Title - The title for the items. +% Mask - The mask to filter items. +% Show - The show predicate for the items. +% What - The condition to filter items. +print_db_items(Title, Mask, Show, What0) :- + get_pi(Mask, H), get_pi(What0, What), + format(atom(Showing), '~p for ~p...', [Title, What]), + statistics(cputime, Now), Max is Now + 2, !, + gripe_time(1.0, + doall((once(statistics(cputime, NewNow)), NewNow < Max, clause_or_call(H, B), + quietly(pfc_contains_term(What, (H:-B))), + flag(print_db_items, LI, LI+1), + ignore(quietly(pp_item(Showing, Show)))))), + ignore(pp_item(Showing, done)),!. + +%% pfc_contains_term(+Term, +Inside) is semidet. +% Checks if a term contains another term. +% Term - The term to check. +% Inside - The term to look for inside the term. +pfc_contains_term(What, _) :- is_ftVar(What), !. +pfc_contains_term(What, Inside) :- compound(What), !, (\+ \+ ((copy_term_nat(Inside, Inside0), snumbervars(Inside0), occurs:contains_term(What, Inside0)))), !. +pfc_contains_term(What, Inside) :- (\+ \+ once((subst(Inside, What, foundZadooksy, Diff), Diff \=@= Inside ))), !. + +%% hook_pfc_listing(+What) is semidet. +% Hook for Pfc listing. +% What - The condition to filter items. +:- current_prolog_flag(pfc_shared_module, BaseKB), + assert_if_new((BaseKB:hook_pfc_listing(What) :- on_x_debug(pfc_list_triggers(What)))). + +:- thread_local t_l:pfc_list_triggers_disabled/0. +% listing(L):-locally(t_l:pfc_list_triggers_disabled,listing(L)). + + +%% pfc_list_triggers(+What) is semidet. +% Lists triggers in the Pfc database. +% What - The condition to filter triggers. +pfc_list_triggers(_) :- t_l:pfc_list_triggers_disabled, !. +pfc_list_triggers(What) :- loop_check(pfc_list_triggers_nlc(What)). + +%% pfc_list_triggers_nlc(+What) is semidet. +% Lists triggers in the Pfc database (no loop check). +% What - The condition to filter triggers. +:- meta_predicate(pfc_list_triggers_nlc(?)). +pfc_list_triggers_nlc(MM:What) :- atom(MM), !, MM:pfc_list_triggers(What). +pfc_list_triggers_nlc(What) :- loop_check(pfc_list_triggers_0(What), true). + +%% pfc_list_triggers_0(+What) is semidet. +% Lists triggers in the Pfc database (primary helper). +% What - The condition to filter triggers. +pfc_list_triggers_0(What) :- get_pi(What, PI), PI \=@= What, pfc_list_triggers(PI). +pfc_list_triggers_0(What) :- nonvar(What), What = ~(Then), !, \+ \+ pfc_list_triggers_1(Then), \+ \+ pfc_list_triggers_1(What). +pfc_list_triggers_0(What) :- \+ \+ pfc_list_triggers_1(~(What)), \+ \+ pfc_list_triggers_1(What). + +%% pfc_list_triggers_types(-TriggerType) is semidet. +% Lists trigger types in the Pfc database. +% TriggerType - The trigger type to list. +pfc_list_triggers_types('Triggers'). +pfc_list_triggers_types('Instances'). +pfc_list_triggers_types('Subclasses'). +pfc_list_triggers_types('ArgTypes'). +pfc_list_triggers_types('Arity'). +pfc_list_triggers_types('Forward'). +pfc_list_triggers_types('Bidirectional'). +pfc_list_triggers_types('Backchaining'). +pfc_list_triggers_types('Negative'). +pfc_list_triggers_types('Sources'). +pfc_list_triggers_types('Supports'). +pfc_list_triggers_types('Edits'). + +%% print_db_items_and_neg(+Title, +Fact, +What) is semidet. +% Prints database items and their negations. +% Title - The title for the items. +% Fact - The fact to check. +% What - The condition to filter items. +print_db_items_and_neg(Title, Fact, What) :- print_db_items(Title, Fact, What). +print_db_items_and_neg(Title, Fact, What) :- print_db_items(Title, ~(Fact), What). + +%% pfc_list_triggers_1(+What) is semidet. +% Lists triggers in the Pfc database (secondary helper). +% What - The condition to filter triggers. +pfc_list_triggers_1(What) :- var(What), !. +pfc_list_triggers_1(~(What)) :- var(What), !. +pfc_list_triggers_1(~(_What)) :- !. +pfc_list_triggers_1(What) :- + print_db_items('Supports User', spft_precanonical(P, mfl4(VarNameZ, _, _, _), ax), '$spft$'(P, mfl4(VarNameZ, _, _, _), ax), What), + print_db_items('Forward Facts', (nesc(F)), F, What), + print_db_items('Forward Rules', (_==>_), What), + ignore((What\= ~(_), safe_functor(What, IWhat, _), + print_db_items_and_neg('Instance Of', isa(IWhat, _), IWhat), + print_db_items_and_neg('Instances: ', isa(_, IWhat), IWhat), + print_db_items_and_neg('Subclass Of', genls(IWhat, _), IWhat), + print_db_items_and_neg('Subclasses: ', genls(_, IWhat), IWhat))), + forall(suggest_m(M), print_db_items('PFC Watches', pfc_prop(M, _, _, _), What)), + print_db_items('Triggers Negative', '$nt$'(_, _, _, _), What), + print_db_items('Triggers Goal', '$bt$'(_, _, _), What), + print_db_items('Triggers Positive', '$pt$'(_, _, _), What), + print_db_items('Bidirectional Rules', (_<==>_), What), + dif(A, B), print_db_items('Supports Deduced', spft_precanonical(P, A, B), '$spft$'(P, A, B), What), + dif(G, ax), print_db_items('Supports Nonuser', spft_precanonical(P, G, G), '$spft$'(P, G, G), What), + print_db_items('Backchaining Rules', (_<-_), What), + % print_db_items('Edits',is_disabled_clause(_),What), + print_db_items('Edits', is_edited_clause(_, _, _), What), + print_db_items('Instances', isa(_, _), What), + print_db_items('Subclasses', genls(_, _), What), + print_db_items('Negative Facts', ~(_), What), + + print_db_items('ArgTypes', argGenls(_, _, _), What), + print_db_items('ArgTypes', argIsa(_, _, _), What), + print_db_items('ArgTypes', argQuotedIsa(_, _, _), What), + print_db_items('ArgTypes', meta_argtypes(_), What), + print_db_items('ArgTypes', predicate_property(G, meta_predicate(G)), What), + print_db_items('ArgTypes', resultGenls(_, _), What), + print_db_items('ArgTypes', resultIsa(_, _), What), + print_db_items('Arity', arity(_, _), What), + print_db_items('Arity', current_predicate(_), What), + print_db_items('MetaFacts Predicate', predicate_property(_, _), What), + print_db_items('Sources', module_property(_, _), What), + print_db_items('Sources', predicateConventionMt(_, _), What), + print_db_items('Sources', source_file(_, _), What), + print_db_items('Sources', _:man_index(_, _, _, _, _), What), + print_db_items('Sources', _:'$pldoc'(_, _, _, _), What), + print_db_items('Sources', _:'$pred_option'(_, _, _, _), What), + print_db_items('Sources',_:'$mode'(_,_),What), + !. + +%% pinfo(+Functor_Arity) is semidet. +% Shows predicate information for a specific functor and arity. +% F - Functor of the predicate. +% A - Arity of the predicate. +pinfo(F/A) :- + listing(F/A), % List the definition of the predicate. + safe_functor(P,F,A), % Create a functor from F/A. + findall(Prop, predicate_property(P,Prop), List), % Collect all properties of the predicate. + wdmsg_pretty(pinfo(F/A) == List), % Display the properties in a formatted way. + !. + + + +%% pp_DB is semidet. +% Pretty print all facts, rules, triggers, and supports in the default module. + +%pp_DB:- defaultAssertMt(M),clause_b(mtHybrid(M)),!,pp_DB(M). +%pp_DB:- forall(clause_b(mtHybrid(M)),pp_DB(M)). +pp_DB :- prolog_load_context(module, M), pp_DB(M). + +%% with_exact_kb(+Module, +Goal) is det. +% Executes a goal within the context of a specific module. +% Module - The module context. +% Goal - The goal to execute. +with_exact_kb(M, G) :- M:call(G). + +%% pp_DB(+Module) is semidet. +% Pretty prints the Pfc database for a specific module. +% Module - The module context. +pp_DB(M) :- + with_exact_kb(M, + M:must_det_l(( + pp_db_facts, + pp_db_rules, + pp_db_triggers, + pp_db_supports))). + +%% pp_db_facts is semidet. +% Pretty prints all facts in the current module's Pfc database. +pp_db_facts :- context_module(M), pp_db_facts(M). + +%% pp_db_rules is semidet. +% Pretty prints all rules in the current module's Pfc database. +pp_db_rules :- context_module(M), pp_db_rules(M). + +%% pp_db_triggers is semidet. +% Pretty prints all triggers in the current module's Pfc database. +pp_db_triggers :- context_module(M), pp_db_triggers(M). + +%% pp_db_supports is semidet. +% Pretty prints all supports in the current module's Pfc database. +pp_db_supports :- context_module(M), pp_db_supports(M). + +:- system:import(pp_DB/0). +:- system:export(pp_DB/0). + +%% pp_db_facts(+Module) is semidet. +% Pretty prints all facts in a specific module's Pfc database. +% Module - The module context. +pp_db_facts(MM) :- ignore(pp_db_facts(MM, _, true)). + +%% pp_db_facts(+Module, +Pattern) is semidet. +% Pretty prints facts in a specific module's Pfc database that match a given pattern. +% Module - The module context. +% Pattern - The pattern to match facts against. +pp_db_facts(MM, Pattern) :- pp_db_facts(MM, Pattern, true). + +%% pp_db_facts(+Module, +Pattern, +Condition) is semidet. +% Pretty prints facts in a specific module's Pfc database that match a given pattern and condition. +% Module - The module context. +% Pattern - The pattern to match facts against. +% Condition - The condition to filter facts. +pp_db_facts(MM, P, C) :- + pfc_facts_in_kb(MM, P, C, L), + pfc_classifyFacts(L, User, Pfc, _ZRule), + length(User, UserSize), length(Pfc, PfcSize), + format("~N~nUser added facts in [~w]: ~w", [MM, UserSize]), + pp_db_items(User), + format("~N~nSystem added facts in [~w]: ~w", [MM, PfcSize]), + pp_db_items(Pfc). + +%% pp_db_items(+Items) is det. +% Pretty prints a list of database items. +% Items - The list of items to print. + +pp_db_items(Var):-var(Var),!,format("~N ~p",[Var]). +pp_db_items([]) :- !. +pp_db_items([H|T]) :- !, + % numbervars(H,0,_), + format("~N ~p", [H]), + nonvar(T), pp_db_items(T). + +pp_db_items((P >= FT)) :- is_hidden_pft(P, FT), !. + +pp_db_items(Var) :- + format("~N ~p", [Var]). + +%% is_hidden_pft(+Predicate, +FactType) is semidet. +% Checks if a fact type should be hidden. +% Predicate - The predicate to check. +% FactType - The fact type to check. +is_hidden_pft(_,(mfl4(_VarNameZ, BaseKB, _, _), ax)) :- current_prolog_flag(pfc_shared_module, BaseKB), !. +is_hidden_pft(_,(why_marked(_), ax)). + +%% pp_mask(+Type, +Module, +Mask) is semidet. +% Prints masked items in a module's Pfc database. +% Type - The type of items. +% Module - The module context. +% Mask - The mask to filter items. +pp_mask(Type, MM, Mask) :- + bagof_or_nil(Mask, lookup_kb(MM, Mask), Nts), + list_to_set_variant(Nts, NtsSet), !, + pp_mask_list(Type, MM, NtsSet). + +%% pp_mask_list(+Type, +Module, +List) is semidet. +% Pretty prints a list of masked items. +% Type - The type of items. +% Module - The module context. +% List - The list of masked items. +pp_mask_list(Type, MM, []) :- !, + format("~N~nNo ~ws in [~w]...~n", [Type, MM]). +pp_mask_list(Type, MM, NtsSet) :- length(NtsSet, Size), !, + format("~N~n~ws (~w) in [~w]...~n", [Type, Size, MM]), + pp_db_items(NtsSet). + +%% pfc_classifyFacts(+Facts, -UserFacts, -PfcFacts, -Rules) is det. +% Classifies facts into user facts, Pfc facts, and rule facts. +% Facts - The facts to classify. +% UserFacts - The classified Output list of user-added facts. +% PfcFacts - The classified Output list of system-added facts. +% Rules - The classified Output list of rules. +pfc_classifyFacts([], [], [], []). + +pfc_classifyFacts([H|T], User, Pfc, [H|Rule]) :- + pfcType(H, rule(_)), !, + pfc_classifyFacts(T, User, Pfc, Rule). + +pfc_classifyFacts([H|T], [H|User], Pfc, Rule) :- + % get_source_uu(UU), + get_first_user_reason(H, _UU), !, + pfc_classifyFacts(T, User, Pfc, Rule). + +pfc_classifyFacts([H|T], User, [H|Pfc], Rule) :- + pfc_classifyFacts(T, User, Pfc, Rule). + +%% pp_db_rules(+Module) is det. +% Pretty print all types of rules in a specified module. +% Module - The module to operate within. +pp_db_rules(MM) :- + pp_mask("Forward Rule", MM, ==>(_,_)), + pp_mask("Bidirectional Rule", MM, <==>(_,_)), + pp_mask("Backchaining Rule", MM, <-(_, _)), + pp_mask("Implication Rule", MM, =>(_, _)), + pp_mask("Bi-conditional Rule", MM, <=>(_, _)), + pp_mask("Negative Fact",MM,(~(_))), +%pp_mask("Material-implRule",MM,<=(_,_)), +%pp_mask("PrologRule",MM,:-(_,_)), +!. + +%% pp_db_triggers(+Module) is det. +% Pretty prints all triggers in a specific module's Pfc database. +% Module - The module to operate within. +pp_db_triggers(MM) :- + pp_mask("Positive trigger(+)", MM, '$pt$'(_, _)), + pp_mask("Negative trigger(-)", MM, '$nt$'(_, _, _)), + pp_mask("Goal trigger(?)", MM, '$bt$'(_, _)), !. + +%% pp_db_supports(+Module) is semidet. +% Pretty prints all supports in a specific module's Pfc database. +% Module - The module context. +pp_db_supports(MM) :- + % temporary hack. + format("~N~nSupports in [~w]...~n", [MM]), + with_exact_kb(MM, bagof_or_nil((P >= S), pfcGetSupport(P, S), L)), + list_to_set_variant(L, LS), + pp_db_items(LS), !. + +%% list_to_set_variant(+List, -Unique) is det. +% Convert a list to a set, removing variants. +% List - The input list. +% Unique - The output set. +list_to_set_variant(List, Unique) :- + list_unique_1(List, [], Unique), !. + +%% list_unique_1(+List, +So_far, -Unique) is det. +% Helper predicate for list_to_set_variant/2. +% List - The input list. +% So_far - Accumulator of unique items. +% Unique - The output set. +list_unique_1([], _, []). +list_unique_1([X|Xs], So_far, Us) :- + memberchk_variant(X, So_far), !, + list_unique_1(Xs, So_far, Us). +list_unique_1([X|Xs], So_far, [X|Us]) :- + list_unique_1(Xs, [X|So_far], Us). + +%% memberchk_variant(+Val, +List) is semidet. +% Deterministic check of membership using =@= rather than +% unification. + +memberchk_variant(X, [Y|Ys]) :- + (X =@= Y -> true ; memberchk_variant(X, Ys)). + +%% lookup_kb(+MM, -MHB) is nondet. +% Lookup a clause in the knowledge base module. +% MM - The module to operate within. +% MHB - The head-body clause found. +lookup_kb(MM, MHB) :- + strip_module(MHB,M,HB), + expand_to_hb(HB, H, B), + (MM:clause(M:H, B, Ref) *-> true; M:clause(MM:H, B, Ref)), + %clause_ref_module(Ref), + clause_property(Ref, module(MM)). + +%% has_cl(+Head) is semidet. +% Checks if a clause exists for a specific head. +% Head - The head to check. +has_cl(H) :- predicate_property(H, number_of_clauses(_)). + +%% clause_or_call( +H, ?B) is semidet. +% Determine if a predicate can be called directly or needs to match a clause. + +% PFC2.0 clause_or_call(M:H,B):-is_ftVar(M),!,no_repeats(M:F/A,(f_to_mfa(H,M,F,A))),M:clause_or_call(H,B). +% PFC2.0 clause_or_call(isa(I,C),true):-!,call_u(isa_asserted(I,C)). +% PFC2.0 clause_or_call(genls(I,C),true):-!,on_x_log_throw(call_u(genls(I,C))). +clause_or_call(H, B) :- clause(src_edit(_Before, H), B). +clause_or_call(H, B) :- + predicate_property(H, number_of_clauses(C)), + predicate_property(H, number_of_rules(R)), + ((R*2 < C) -> (clause(H, B) *-> ! ; fail) ; clause(H, B)). + +% PFC2.0 clause_or_call(H,true):- call_u(should_call_for_facts(H)),no_repeats(on_x_log_throw(H)). + + /* + + + +% as opposed to simply using clause(H,true). + +% % should_call_for_facts( +H) is semidet. +% +% Should Call For Facts. +% +should_call_for_facts(H):- get_functor(H,F,A),call_u(should_call_for_facts(H,F,A)). + +% % should_call_for_facts( +VALUE1, ?F, ?VALUE3) is semidet. +% +% Should Call For Facts. +% +should_call_for_facts(_,F,_):- a(prologSideEffects,F),!,fail. +should_call_for_facts(H,_,_):- modulize_head(H,HH), \+ predicate_property(HH,number_of_clauses(_)),!. +should_call_for_facts(_,F,A):- clause_b(pfc_prop(_M,F,A,pfcRHS)),!,fail. +should_call_for_facts(_,F,A):- clause_b(pfc_prop(_M,F,A,pfcMustFC)),!,fail. +should_call_for_facts(_,F,_):- a(prologDynamic,F),!. +should_call_for_facts(_,F,_):- \+ a(pfcControlled,F),!. + + */ + +%% no_side_effects(+Predicate) is semidet. +% Checks if a predicate has no side effects. +% Predicate - The predicate to check. +no_side_effects(P) :- (\+ is_side_effect_disabled -> true; (get_functor(P, F, _), a(prologSideEffects, F))). + +%% pfc_facts_in_kb(+Module, +Pattern, +Condition, -Facts) is det. +% Retrieves facts from a specific module's knowledge base. +% Module - The module context. +% Pattern - The pattern to match facts against. +% Condition - The condition to filter facts. +% Facts - The retrieved facts. +pfc_facts_in_kb(MM, P, C, L) :- with_exact_kb(MM, setof_or_nil(P, pfcFact(P, C), L)). + +%% lookup_spft(+Predicate, -Fact, -Type) is nondet. +% Looks up a support fact type for a specific predicate. +% Predicate - The predicate to look up. +% Fact - The support fact. +% Type - The support type. +lookup_spft(P, F, T) :- pfcGetSupport(P, (F, T)). +% why_dmsg(Why,Msg):- with_current_why(Why,dmsg_pretty(Msg)). + +%% u_to_uu(+U, -UU) is det. +% Converts a user fact or support to a user fact type (U to UU). +% U - The user fact or support. +% UU - The resulting user fact type. +u_to_uu(U, (U, ax)) :- var(U), !. +u_to_uu(U, U) :- nonvar(U), U = (_, _), !. +u_to_uu([U|More], UU) :- list_to_conjuncts([U|More], C), !, u_to_uu(C, UU). +u_to_uu(U, (U, ax)) :- !. + +%% get_source_uu(-UU) is det. +% Retrieves the source reference for the current context. +% UU - The retrieved source reference. +% (Current file or User) +:- module_transparent((get_source_uu)/1). +get_source_uu(UU) :- must_ex((get_source_ref1(U), u_to_uu(U, UU))), !. +%% get_source_ref1(-U) is det. +% Retrieves the source reference for the current context (helper predicate). +% U - The retrieved source reference. +get_source_ref1(U) :- quietly_ex((current_why(U), nonvar(U))); ground(U), !. +get_source_ref1(U) :- quietly_ex((get_source_mfl(U))), !. + +%% get_why_uu(-UU) is det. +% Retrieves the current "why" reference as a user fact type (UU). +% UU - The retrieved user fact type. +:- module_transparent((get_why_uu)/1). +get_why_uu(UU) :- findall(U, current_why(U), Whys), Whys \== [], !, u_to_uu(Whys, UU). +get_why_uu(UU) :- get_source_uu(UU), !. + +%% get_startup_uu(-UU) is det. +% Retrieves the startup "why" reference as a user fact type (UU). +% UU - The retrieved user fact type. +get_startup_uu(UU) :- + prolog_load_context(module, CM), + u_to_uu((isRuntime, mfl4(VarNameZ, CM, user_input, _)), UU), varnames_load_context(VarNameZ). + +%% is_user_reason(+UserFact) is semidet. +% Checks if a user fact is a valid user reason. +% UserFact - The user fact to check. +is_user_reason((_, U)) :- atomic(U). +only_is_user_reason((U1, U2)) :- freeze(U2, is_user_reason((U1, U2))). + +%% is_user_fact(+Predicate) is semidet. +% Checks if a predicate is a user-added fact. +% Predicate - The predicate to check. +is_user_fact(P) :- get_first_user_reason(P, UU), is_user_reason(UU). + +%% get_first_real_user_reason(+Predicate, -UU) is semidet. +% Retrieves the first real user reason for a predicate. +% Predicate - The predicate to check. +% UU - The retrieved user reason. +get_first_real_user_reason(P, UU) :- nonvar(P), UU = (F, T), + quietly_ex(((((lookup_spft(P, F, T))), is_user_reason(UU)) *-> true; + ((((lookup_spft(P, F, T))), \+ is_user_reason(UU)) *-> (!, fail) ; fail))). + +%% get_first_user_reason(+Predicate, -UU) is semidet. +% Retrieves the first user reason for a predicate. +% Predicate - The predicate to check. +% UU - The retrieved user reason. +get_first_user_reason(P, (F, T)) :- + UU = (F, T), + ((((lookup_spft(P, F, T))), is_user_reason(UU)) *-> true; + ((((lookup_spft(P, F, T))), \+ is_user_reason(UU)) *-> (!, fail) ; + (clause_asserted(P), get_source_uu(UU), is_user_reason(UU)))), !. +get_first_user_reason(_, UU) :- get_why_uu(UU), is_user_reason(UU), !. +get_first_user_reason(_, UU) :- get_why_uu(UU), !. +get_first_user_reason(P, UU) :- must_ex(ignore((get_first_user_reason0(P, UU)))), !. +%get_first_user_reason(_,UU):- get_source_uu(UU),\+is_user_reason(UU). % ignore(get_source_uu(UU)). + + + +%% get_first_user_reason0(+Predicate, -UU) is semidet. +% Helper predicate for get_first_user_reason/2. +% Predicate - The predicate to check. +% UU - The retrieved user reason. +get_first_user_reason0(_, (M, ax)) :- get_source_mfl(M). + +%:- export(pfc_at_box:defaultAssertMt/1). +%:- system:import(defaultAssertMt/1). +%:- pfc_lib:import(pfc_at_box:defaultAssertMt/1). + +%% get_source_mfl(-MFL) is det. +% Retrieves the source reference for the current module/file location. +% MFL - The retrieved source reference. +:- module_transparent((get_source_mfl)/1). +get_source_mfl(M):- current_why(M), nonvar(M) , M =mfl4(_VarNameZ,_,_,_). +get_source_mfl(mfl4(VarNameZ, M, F, L)) :- defaultAssertMt(M), current_source_location(F, L), varnames_load_context(VarNameZ). +get_source_mfl(mfl4(VarNameZ, M, F, L)) :- defaultAssertMt(M), current_source_file(F:L), varnames_load_context(VarNameZ). +get_source_mfl(mfl4(VarNameZ, M, F, _L)) :- defaultAssertMt(M), current_source_file(F), varnames_load_context(VarNameZ). +get_source_mfl(mfl4(VarNameZ, M, _F, _L)) :- defaultAssertMt(M), varnames_load_context(VarNameZ). +%get_source_mfl(M):-(defaultAssertMt(M)->true;(atom(M)->(module_property(M,class(_)),!);(var(M),module_property(M,class(_))))). +get_source_mfl(M):-fail,dtrace, +((defaultAssertMt(M)->!; +(atom(M)->(module_property(M,class(_)),!); +pfcError(no_source_ref(M))))). + +is_source_ref1(_). + +defaultAssertMt(M):-prolog_load_context(module,M). + + + +%% pfc_pp_db_justifications(+Predicate, +Justifications) is det. +% Pretty prints the justifications for a predicate. +% Predicate - The predicate to print justifications for. +% Justifications - The justifications to print. +pfc_pp_db_justifications(P, Js) :- + show_current_source_location, + must_ex(quietly_ex((format("~NJustifications for ~p:", [P]), + pfc_pp_db_justification1('', Js, 1)))). + +%% pfc_pp_db_justification1(+Prefix, +Justifications, +N) is det. +% Helper predicate for pfc_pp_db_justifications/2. +% Prefix - The prefix for printing. +% Justifications - The justifications to print. +% N - The current justification number. +pfc_pp_db_justification1(_, [], _). +pfc_pp_db_justification1(Prefix, [J|Js], N) :- + % show one justification and recurse. + nl, + pfc_pp_db_justifications2(Prefix, J, N, 1), + %reset_shown_justs, + N2 is N+1, + pfc_pp_db_justification1(Prefix, Js, N2). + +%% pfc_pp_db_justifications2(+Prefix, +Justification, +JustNo, +StepNo) is det. +% Helper predicate for pfc_pp_db_justification1/3. +% Prefix - The prefix for printing. +% Justification - The justification to print. +% JustNo - The current justification number. +% StepNo - The current step number. +pfc_pp_db_justifications2(_, [], _, _). +pfc_pp_db_justifications2(Prefix, [C|Rest], JustNo, StepNo) :- +(nb_hasval('$last_printed',C)-> dmsg_pretty(chasVal(C)) ; + ((StepNo==1->fmt('~N~n',[]);true), + backward_compatibility:sformat(LP,' ~w.~p.~p',[Prefix,JustNo,StepNo]), + nb_pushval('$last_printed',LP), + format("~N ~w ~p",[LP,C]), + ignore(loop_check(pfcWhy_sub_sub(C))), + StepNext is 1+StepNo, + pfc_pp_db_justifications2(Prefix,Rest,JustNo,StepNext))). + + +%% pfcWhy_sub_sub(+Predicate) is det. +% Sub-function for pfcWhy to handle sub-subjustifications. +% Predicate - The predicate to check. +pfcWhy_sub_sub(P) :- + justifications(P, Js), + clear_proofs, + % retractall_u(t_l:whybuffer(_,_)), + (nb_hasval('$last_printed', P) -> dmsg_pretty(hasVal(P)) ; + (( + assertz(t_l:whybuffer(P, Js)), + nb_getval('$last_printed', LP), + ((pfc_pp_db_justification1(LP, Js, 1), fmt('~N~n', [])))))). + +% File : pfcwhy.pl +% Author : Tim Finin, finin@prc.unisys.com +% Updated: +% Purpose: predicates for interactively exploring Pfc justifications. + +% ***** predicates for browsing justifications ***** + +:- use_module(library(lists)). + +:- dynamic(t_l:whybuffer/2). + +%% pfcWhy is semidet. +% Interactively explores Pfc justifications. +pfcWhy :- + t_l:whybuffer(P, _), + pfcWhy(P). + +%% pfcTF(+Predicate) is semidet. +% Prints the truth value of a predicate. +% Predicate - The predicate to check. +pfcTF(P) :- pfc_call(P) *-> foreach(pfcTF1(P), true); pfcTF1(P). + +%% pfcTF1(+Predicate) is semidet. +% Helper predicate for pfcTF/1. +% Predicate - The predicate to check. +pfcTF1(P) :- + ansi_format([underline], "~N=========================================", []), + (ignore(pfcWhy(P))), ignore(pfcWhy(~P)), + printLine. + +%% pfcWhy(+N) is semidet. +%% pfcWhy(+Predicate) is semidet. +% Interactively explores the Nth justification for a predicate. +% N - The justification number. +% Predicate - The predicate to explore. +pfcWhy(N) :- + number(N), !, + t_l:whybuffer(P, Js), + pfcWhyCommand(N, P, Js). +pfcWhy(P) :- + justifications(P, Js), + retractall(t_l:whybuffer(_,_)), + assert(t_l:whybuffer(P, Js)), + pfcWhyBrouse(P, Js). + +%% pfcWhy1(+Predicate) is semidet. +% Interactively explores the first justification for a predicate. +% Predicate - The predicate to explore. +pfcWhy1(P) :- + justifications(P, Js), + pfcWhyBrouse(P, Js). + +%% pfcWhy2(+Predicate, +N) is semidet. +% Interactively explores the Nth justification for a predicate. +% Predicate - The predicate to explore. +% N - The justification number. +pfcWhy2(P, N) :- + justifications(P, Js), pfcShowJustification1(Js, N). + +%% pfcWhyBrouse(+Predicate, +Justifications) is semidet. +% Interactively explores justifications for a predicate. +% Predicate - The predicate to explore. +% Justifications - The justifications to explore. +pfcWhyBrouse(P, Js) :- + % rtrace(pfc_pp_db_justifications(P,Js)), + pfcShowJustifications(P, Js), + nop((pfcAsk(' >> ', Answer), + pfcWhyCommand(Answer, P, Js))). + +%% pfcWhyCommand(+Command, +Predicate, +Justifications) is semidet. +% Executes a command during Pfc justification exploration. +% Command - The command to execute. +% Predicate - The predicate being explored. +% Justifications - The justifications being explored. +pfcWhyCommand(q, _, _) :- !. % Quit. +pfcWhyCommand(h, _, _) :- !, % Help. + format("~nJustification Browser Commands: + q quit. + N focus on Nth justification. + N.M browse step M of the Nth justification + u up a level~n", []). + +pfcWhyCommand(N, _P, Js) :- float(N), !, + pfcSelectJustificationNode(Js, N, Node), + pfcWhy1(Node). + +pfcWhyCommand(u, _, _) :- !. % Up a level. + +pfcCommand(N, _, _) :- integer(N), !, + pfcPrintf("~p is a yet unimplemented command.", [N]), + fail. + +pfcCommand(X, _, _) :- pfcPrintf("~p is an unrecognized command, enter h. for help.", [X]), + fail. + +%% pfcShowJustifications(+Predicate, +Justifications) is semidet. +% Pretty prints justifications for a predicate. +% Predicate - The predicate to print justifications for. +% Justifications - The justifications to print. +pfcShowJustifications(P, Js) :- + show_current_source_location, + reset_shown_justs, + %color_line(yellow,1), + format("~N~nJustifications for ", []), + ansi_format([fg(green)], '~@', [pp(P)]), + format(" :~n", []), + pfcShowJustification1(Js, 1),!, + printLine. + +%% pfcShowJustification1(+Justifications, +N) is semidet. +% Pretty prints the Nth justification in a list. +% Justifications - The list of justifications. +% N - The justification number. +pfcShowJustification1([J|Js], N) :- !, + % show one justification and recurse. + %reset_shown_justs, + pfcShowSingleJustStep(N, J),!, + N2 is N+1, + pfcShowJustification1(Js, N2). + +pfcShowJustification1(J, N) :- + %reset_shown_justs, % nl, + pfcShowSingleJustStep(N, J),!. + +%% pfcShowSingleJustStep(+JustNo, +Justification) is semidet. +% Pretty prints a single step in a justification. +% JustNo - The justification number. +% Justification - The justification step. +pfcShowSingleJustStep(N, J) :- + pfcShowSingleJust(N, step(1), J),!. +pfcShowSingleJustStep(N, J) :- + pp(pfcShowSingleJustStep(N, J)),!. + +%% incrStep(+StepNo, -Step) is det. +% Increments the step number. +% StepNo - The current step number. +% Step - The incremented step number. +incrStep(StepNo, Step) :- compound(StepNo), arg(1, StepNo, Step), X is Step+1, nb_setarg(1, StepNo, X). + +%% pfcShowSingleJust(+JustNo, +StepNo, +Justification) is semidet. +% Pretty prints a single justification step. +% JustNo - The justification number. +% StepNo - The step number. +% Justification - The justification step. +pfcShowSingleJust(JustNo, StepNo, C) :- is_ftVar(C), !, incrStep(StepNo, Step), + ansi_format([fg(cyan)], "~N ~w.~w ~w ", [JustNo, Step, C]), !, maybe_more_c(C). +pfcShowSingleJust(_JustNo,_StepNo,[]):-!. +pfcShowSingleJust(JustNo, StepNo, (P, T)) :- !, + pfcShowSingleJust(JustNo, StepNo, P), + pfcShowSingleJust(JustNo, StepNo, T). +pfcShowSingleJust(JustNo, StepNo, (P, F, T)) :- !, + pfcShowSingleJust1(JustNo, StepNo, P), + pfcShowSingleJust(JustNo, StepNo, F), + pfcShowSingleJust1(JustNo, StepNo, T). +pfcShowSingleJust(JustNo, StepNo, (P *-> T)) :- !, + pfcShowSingleJust1(JustNo, StepNo, P), format(' *-> ', []), + pfcShowSingleJust1(JustNo, StepNo, T). + +pfcShowSingleJust(JustNo, StepNo, (P :- T)) :- !, + pfcShowSingleJust1(JustNo, StepNo, P), format(':- ~p.', [T]). + +pfcShowSingleJust(JustNo, StepNo, (P : - T)) :- !, + pfcShowSingleJust1(JustNo, StepNo, P), format(' :- ', []), + pfcShowSingleJust(JustNo, StepNo, T). + +pfcShowSingleJust(JustNo, StepNo, (P :- T)) :- !, + pfcShowSingleJust1(JustNo, StepNo, call(T)), + pfcShowSingleJust1(JustNo, StepNo, P). + +pfcShowSingleJust(JustNo, StepNo, [P|T]) :- !, + pfcShowSingleJust(JustNo, StepNo, P), + pfcShowSingleJust(JustNo, StepNo, T). + +pfcShowSingleJust(JustNo, StepNo, '$pt$'(P, Body)) :- !, + pfcShowSingleJust1(JustNo, StepNo, '$pt$'(P)), + pfcShowSingleJust(JustNo, StepNo, Body). + +pfcShowSingleJust(JustNo, StepNo, C) :- + pfcShowSingleJust1(JustNo, StepNo, C). + +%% fmt_cl(+Clause) is det. +% Formats and writes a clause to the output. +% Clause - The clause to format. +fmt_cl(P) :- \+ \+ (numbervars(P, 666, _, [attvars(skip), singletons(true)]), write_src(P)), !. +fmt_cl(P) :- \+ \+ (pretty_numbervars(P, PP), numbervars(PP, 126, _, [attvar(skip), singletons(true)]), + write_term(PP, [portray(true), portray_goal(fmt_cl)])), write('.'). +fmt_cl(S,_):- term_is_ansi(S), !, write_keeping_ansi(S). +fmt_cl(G,_):- is_grid(G),write('"'),user:print_grid(G),write('"'),!. +% fmt_cl(P,_):- catch(arc_portray(P),_,fail),!. +fmt_cl(P,_):- is_list(P),catch(p_p_t_no_nl(P),_,fail),!. +%ptg(PP,Opts):- is_list(PP),select(portray_goal(ptg),Opts,Never),write_term(PP,Never). + + + +%% unwrap_litr(+Clause, -UnwrappedClause) is det. +% Unwraps a literal clause. +% Clause - The clause to unwrap. +% UnwrappedClause - The unwrapped clause. +unwrap_litr(C, CCC+VS) :- copy_term(C, CC, VS), + numbervars(CC+VS, 0, _), + unwrap_litr0(CC, CCC), !. +unwrap_litr0(call(C), CC) :- unwrap_litr0(C, CC). +unwrap_litr0('$pt$'(C), CC) :- unwrap_litr0(C, CC). +unwrap_litr0(body(C), CC) :- unwrap_litr0(C, CC). +unwrap_litr0(head(C), CC) :- unwrap_litr0(C, CC). +unwrap_litr0(C, C). + +:- thread_local t_l:shown_why/1. + +%% pfcShowSingleJust1(+JustNo, +StepNo, +Clause) is det. +% Pretty prints a single clause in a justification. +% JustNo - The justification number. +% StepNo - The step number. +% Clause - The clause to print. +pfcShowSingleJust1(JustNo, _, MFL) :- is_mfl(MFL), JustNo \== 1, !. +pfcShowSingleJust1(JustNo, StepNo, C) :- unwrap_litr(C, CC), !, pfcShowSingleJust4(JustNo, StepNo, C, CC). + +%% pfcShowSingleJust4(+JustNo, +StepNo, +Clause, +UnwrappedClause) is det. +% Helper predicate for pfcShowSingleJust1/3. +% JustNo - The justification number. +% StepNo - The step number. +% Clause - The clause to print. +% UnwrappedClause - The unwrapped clause to print. +pfcShowSingleJust4(_, _, _, CC) :- t_l:shown_why(C), C =@= CC, !. +pfcShowSingleJust4(_, _, _, MFL) :- is_mfl(MFL), !. +pfcShowSingleJust4(JustNo, StepNo, C, CC) :- assert(t_l:shown_why(CC)), !, + incrStep(StepNo, Step), + ansi_format([fg(cyan)], "~N ~w.~w ~@ ", [JustNo, Step, user:fmt_cl(C)]), + %write('<'), + pfcShowSingleJust_C(C),!,%write('>'), + format('~N'), + ignore((maybe_more_c(C))), + assert(t_l:shown_why(C)), + format('~N'), !. + +%% is_mfl(+Term) is semidet. +% Checks if a term is an mfl (module/file/line) reference. +% Term - The term to check. +is_mfl(MFL) :- compound(MFL), MFL = mfl4(_, _, _, _). + +%% maybe_more_c(+Term) is det. +% Triggers exploration of more clauses if needed. +% Term - The term to check. +maybe_more_c(MFL) :- is_mfl(MFL), !. +maybe_more_c(_) :- t_l:shown_why(no_recurse). +maybe_more_c(C) :- t_l:shown_why(more(C)), !. +maybe_more_c(C) :- t_l:shown_why((C)), !. +maybe_more_c(C) :- assert(t_l:shown_why(more(C))), assert(t_l:shown_why((C))), + locally(t_l:shown_why(no_recurse), + locally(t_l:shown_why((C)), locally(t_l:shown_why(more(C)), + ignore(catch(pfcWhy2(C, 1.1), E, fbugio(E)))))), !. + +%% pfcShowSingleJust_C(+Clause) is det. +% Helper predicate for pfcShowSingleJust1/3. +% Clause - The clause to print. +pfcShowSingleJust_C(C) :- is_file_ref(C), !. +pfcShowSingleJust_C(C) :- find_mfl(C, MFL), assert(t_l:shown_why(MFL)), !, pfcShowSingleJust_MFL(MFL). +pfcShowSingleJust_C(_) :- ansi_format([hfg(black)], " % [no_mfl] ", []), !. + +%% short_filename(+File, -ShortFilename) is det. +% Extracts a short filename from a full file path. +% File - The full file path. +% ShortFilename - The extracted short filename. +short_filename(F, FN) :- symbolic_list_concat([_, FN], '/pack/', F), !. +short_filename(F, FN) :- symbolic_list_concat([_, FN], swipl, F), !. +short_filename(F, FN) :- F = FN, !. + +%% pfcShowSingleJust_MFL(+MFL) is det. +% Helper predicate for pfcShowSingleJust_C/1. +% MFL - The mfl (module/file/line) reference to print. +pfcShowSingleJust_MFL(MFL) :- MFL = mfl4(VarNameZ, _M, F, L), atom(F), short_filename(F, FN), !, varnames_load_context(VarNameZ), + ansi_format([hfg(black)], " % [~w:~w] ", [FN, L]). + +pfcShowSingleJust_MFL(MFL) :- MFL = mfl4(V, M, F, L), my_maplist(var, [V, M, F, L]), !. +pfcShowSingleJust_MFL(MFL) :- ansi_format([hfg(black)], " % [~w] ", [MFL]), !. + +%% pfcAsk(+Message, -Answer) is det. +% Asks the user for input during Pfc justification exploration. +% Message - The message to display. +% Answer - The user's input. +pfcAsk(Msg, Ans) :- + format("~n~w", [Msg]), + read(Ans). + +%% pfcSelectJustificationNode(+Justifications, +Index, -Node) is det. +% Selects a specific node in a justification based on an index. +% Justifications - The list of justifications. +% Index - The index to select. +% Node - The selected node. +pfcSelectJustificationNode(Js, Index, Step) :- + JustNo is integer(Index), + nth1(JustNo, Js, Justification), + StepNo is 1 + integer(Index*10 - JustNo*10), + nth1(StepNo, Justification, Step). diff --git a/.Attic/canary_docme/metta_eval.pl b/.Attic/canary_docme/metta_eval.pl new file mode 100644 index 00000000000..da5789a84d4 --- /dev/null +++ b/.Attic/canary_docme/metta_eval.pl @@ -0,0 +1,2622 @@ +/* + * Project: MeTTaLog - A MeTTa to Prolog Transpiler/Interpreter + * Description: This file is part of the source code for a transpiler designed to convert + * MeTTa language programs into Prolog, utilizing the SWI-Prolog compiler for + * optimizing and transforming function/logic programs. It handles different + * logical constructs and performs conversions between functions and predicates. + * + * Author: Douglas R. Miles + * Contact: logicmoo@gmail.com / dmiles@logicmoo.org + * License: LGPL + * Repository: https://github.com/trueagi-io/metta-wam + * https://github.com/logicmoo/hyperon-wam + * Created Date: 8/23/2023 + * Last Modified: $LastChangedDate$ # You will replace this with Git automation + * + * Usage: This file is a part of the transpiler that transforms MeTTa programs into Prolog. For details + * on how to contribute or use this project, please refer to the repository README or the project documentation. + * + * Contribution: Contributions are welcome! For contributing guidelines, please check the CONTRIBUTING.md + * file in the repository. + * + * Notes: + * - Ensure you have SWI-Prolog installed and properly configured to use this transpiler. + * - This project is under active development, and we welcome feedback and contributions. + * + * Acknowledgments: Special thanks to all contributors and the open source community for their support and contributions. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the + * distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS + * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT + * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS + * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE + * COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, + * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; + * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER + * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN + * ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + * POSSIBILITY OF SUCH DAMAGE. + */ + +% +% post match modew +%:- style_check(-singleton). +:- multifile(fake_notrace/1). +:- meta_predicate(fake_notrace(0)). +:- meta_predicate(color_g_mesg(+,0)). +:- multifile(color_g_mesg/2). + +self_eval0(X):- \+ callable(X),!. +self_eval0(X):- py_is_py(X),!. +%self_eval0(X):- py_type(X,List), List\==list,!. +self_eval0(X):- is_valid_nb_state(X),!. +%self_eval0(X):- string(X),!. +%self_eval0(X):- number(X),!. +%self_eval0([]). +self_eval0(X):- is_metta_declaration(X),!. +self_eval0([_,Ar,_]):- (Ar=='-->';Ar=='<->';Ar=='<--'),!. +self_eval0([F|X]):- !, is_list(X),length(X,Len),!,nonvar(F), is_self_eval_l_fa(F,Len),!. +self_eval0(X):- typed_list(X,_,_),!. +%self_eval0(X):- compound(X),!. +%self_eval0(X):- is_ref(X),!,fail. +self_eval0('True'). self_eval0('False'). % self_eval0('F'). +self_eval0('Empty'). +self_eval0([]). +self_eval0('%Undefined%'). +self_eval0(X):- atom(X),!, \+ nb_bound(X,_),!. + + +nb_bound(Name,X):- atom(Name), atom_concat('&', _, Name), + nb_current(Name, X). + + +coerce(Type,Value,Result):- nonvar(Value),Value=[Echo|EValue], Echo == echo, EValue = [RValue],!,coerce(Type,RValue,Result). +coerce(Type,Value,Result):- var(Type), !, Value=Result, freeze(Type,coerce(Type,Value,Result)). +coerce('Atom',Value,Result):- !, Value=Result. +coerce('Bool',Value,Result):- var(Value), !, Value=Result, freeze(Value,coerce('Bool',Value,Result)). +coerce('Bool',Value,Result):- is_list(Value),!,as_tf(call_true(Value),Result), +set_list_value(Value,Result). + +set_list_value(Value,Result):- nb_setarg(1,Value,echo),nb_setarg(1,Value,[Result]). + +%is_self_eval_l_fa('S',1). % cheat to comment + +% these should get uncomented with a flag +%is_self_eval_l_fa(':',2). +% is_self_eval_l_fa('=',2). +% eval_20(Eq,RetType,Depth,Self,['quote',Eval],RetVal):- !, Eval = RetVal, check_returnval(Eq,RetType,RetVal). +is_self_eval_l_fa('quote',_). +is_self_eval_l_fa('Error',_). +is_self_eval_l_fa('{...}',_). +is_self_eval_l_fa('[...]',_). + +self_eval(X):- notrace(self_eval0(X)). + +:- set_prolog_flag(access_level,system). +hyde(F/A):- functor(P,F,A), redefine_system_predicate(P),'$hide'(F/A), '$iso'(F/A). +:- 'hyde'(option_else/2). +:- 'hyde'(atom/1). +:- 'hyde'(quietly/1). +%:- 'hyde'(fake_notrace/1). +:- 'hyde'(var/1). +:- 'hyde'(is_list/1). +:- 'hyde'(copy_term/2). +:- 'hyde'(nonvar/1). +:- 'hyde'(quietly/1). +%:- 'hyde'(option_value/2). + + +is_metta_declaration([F|_]):- F == '->',!. +is_metta_declaration([F,H,_|T]):- T ==[], is_metta_declaration_f(F,H). + +is_metta_declaration_f(F,H):- F == ':<', !, nonvar(H). +is_metta_declaration_f(F,H):- F == ':>', !, nonvar(H). +is_metta_declaration_f(F,H):- F == '=', !, is_list(H), \+ (current_self(Space), is_user_defined_head_f(Space,F)). + +% is_metta_declaration([F|T]):- is_list(T), is_user_defined_head([F]),!. + +% Sets the current self space to '&self'. This is likely used to track the current context or scope during the evaluation of Metta code. +:- nb_setval(self_space, '&self'). + +%! eval_to(+X,+Y) is semidet. +% checks if X evals to Y +evals_to(XX,Y):- Y=@=XX,!. +evals_to(XX,Y):- Y=='True',!, is_True(XX),!. + +%current_self(Space):- nb_current(self_space,Space). + +do_expander('=',_,X,X):-!. +do_expander(':',_,X,Y):- !, get_type(X,Y)*->X=Y. + +get_type(Arg,Type):- eval_H(['get-type',Arg],Type). + + +%! eval_true(+X) is semidet. +% Evaluates the given term X and succeeds if X is not a constraint (i.e. \+ iz_conz(X)) and is callable, and calling X succeeds. +% +% If X is not callable, this predicate will attempt to evaluate the arguments of X (using eval_args/2) and succeed if the result is not False. +eval_true(X):- \+ iz_conz(X), callable(X), call(X). +eval_true(X):- eval_args(X,Y), once(var(Y) ; \+ is_False(Y)). + +eval(Depth,Self,X,Y):- eval('=',_,Depth,Self,X,Y). +eval(Eq,RetType,Depth,Self,X,Y):- + catch_metta_return(eval_args(Eq,RetType,Depth,Self,X,Y),Y). + +%:- set_prolog_flag(gc,false). +/* +eval_args(Eq,RetTyp e,Depth,Self,X,Y):- + locally(set_prolog_flag(gc,true), + rtrace_on_existence_error( + eval(Eq,RetType,Depth,Self,X,Y))). +*/ + + +%! eval_args(+X,-Y) is semidet. +eval_args(X,Y):- current_self(Self), eval_args(500,Self,X,Y). +%eval_args(Eq,RetType,Depth,_Self,X,_Y):- forall(between(6,Depth,_),write(' ')),writeqln(eval_args(Eq,RetType,X)),fail. +eval_args(Depth,Self,X,Y):- eval_args('=',_RetType,Depth,Self,X,Y). + +eval_args(_Eq,_RetType,_Dpth,_Slf,X,Y):- var(X),nonvar(Y),!,X=Y. +eval_args(_Eq,_RetType,_Dpth,_Slf,X,Y):- notrace(self_eval(X)),!,Y=X. +eval_args(Eq,RetType,Depth,Self,X,Y):- + notrace(nonvar(Y)), var(RetType), + get_type(Depth,Self,Y,WasType), + can_assign(WasType,RetType), + nonvar(RetType),!, + eval_args(Eq,RetType,Depth,Self,X,Y). +eval_args(Eq,RetType,Depth,Self,X,Y):- notrace(nonvar(Y)),!, + eval_args(Eq,RetType,Depth,Self,X,XX),evals_to(XX,Y). + +eval_args(Eq,RetType,_Dpth,_Slf,[X|T],Y):- T==[], number(X),!, do_expander(Eq,RetType,X,YY),Y=[YY]. + +/* +eval_args(Eq,RetType,Depth,Self,[F|X],Y):- + (F=='superpose' ; ( option_value(no_repeats,false))), + notrace((D1 is Depth-1)),!, + eval_args(Eq,RetType,D1,Self,[F|X],Y). +*/ + +eval_args(Eq,RetType,Depth,Self,X,Y):- atom(Eq), ( Eq \== ('='), Eq \== ('match')) ,!, + call(call,Eq,'=',RetType,Depth,Self,X,Y). + +eval_args(_Eq,_RetType,_Dpth,_Slf,X,Y):- self_eval(X),!,Y=X. +eval_args(Eq,RetType,Depth,Self,X,Y):- + eval_00(Eq,RetType,Depth,Self,X,Y). +%eval_ret(Eq,RetType,1000,Self,X,Y):- !, +% catch_metta_return(eval_ret(Eq,RetType,99,Self,X,Y),Y). + +eval_ret(Eq,RetType,Depth,Self,X,Y):- + eval_00(Eq,RetType,Depth,Self,X,Y), is_returned(Y). + +catch_metta_return(G,Y):- + catch(G,metta_return(Y),ignore(retract(thrown_metta_return(Y)))). + +allow_repeats_eval_(_):- !. +allow_repeats_eval_(_):- option_value(no_repeats,false),!. +allow_repeats_eval_(X):- \+ is_list(X),!,fail. +allow_repeats_eval_([F|_]):- atom(F),allow_repeats_eval_f(F). +allow_repeats_eval_f('superpose'). +allow_repeats_eval_f('collapse'). + + +:- nodebug(metta(overflow)). +eval_00(_Eq,_RetType,_Depth,_Slf,X,Y):- self_eval(X),!,X=Y. +eval_00(Eq,RetType,Depth,Self,X,YO):- + eval_01(Eq,RetType,Depth,Self,X,YO). +eval_01(Eq,RetType,Depth,Self,X,YO):- + if_t((Depth<1, trace_on_overflow), + debug(metta(eval_args))), + notrace((Depth2 is Depth-1, copy_term(X, XX))), + trace_eval(eval_20(Eq,RetType),e,Depth2,Self,X,M), + (self_eval(M)-> YO=M ; + (((M=@=XX)-> Y=M + ;eval_01(Eq,RetType,Depth2,Self,M,Y)), + eval_02(Eq,RetType,Depth2,Self,Y,YO))). + +eval_02(Eq,RetType,Depth2,Self,Y,YO):- + once(if_or_else((subst_args_here(Eq,RetType,Depth2,Self,Y,YO)), + if_or_else((fail,finish_eval(Eq,RetType,Depth2,Self,Y,YO)), + Y=YO))). + + + subst_args_here(Eq,RetType,Depth2,Self,Y,YO):- + Y =@= [ house, _59198,_59204,==,fish,fish],!,break. + +subst_args_here(Eq,RetType,Depth2,Self,Y,YO):- + subst_args(Eq,RetType,Depth2,Self,Y,YO), + nop(notrace(if_t(Y\=@=YO,wdmsg(subst_args(Y,YO))))). + +finish_eval_here(Eq,RetType,Depth2,Self,Y,YO):- + finish_eval(Eq,RetType,Depth2,Self,Y,YO), + notrace(if_t(Y\=@=YO,wdmsg(finish_eval(Y,YO)))). + +:- nodebug(metta(e)). + +:- discontiguous eval_20/6. +:- discontiguous eval_40/6. +:- discontiguous eval_70/6. +%:- discontiguous eval_30fz/5. +%:- discontiguous eval_31/5. +%:- discontiguous eval_maybe_defn/5. + +eval_20(Eq,RetType,_Dpth,_Slf,Name,Y):- + atom(Name), !, + (nb_bound(Name,X)->do_expander(Eq,RetType,X,Y); + Y = Name). + + +eval_20(Eq,RetType,_Dpth,_Slf,X,Y):- no_eval(X),!,do_expander(Eq,RetType,X,Y). + +args_not_evaled(X):- ( \+ is_list(X); maplist(no_eval,X)),!. +no_eval(X):- self_eval(X),!. +no_eval([SL|X]):- atomic(SL), !, is_sl(SL), args_not_evaled(X). +no_eval([SL|X]):- ( \+ atom(SL), \+ is_list(SL)), !, + args_not_evaled(X). +is_sl(N):- number(N). +is_sl('ExtSet'). +is_sl('IntSet'). +%is_sl('___'). + +% ================================================================= +% ================================================================= +% ================================================================= +% VAR HEADS/ NON-LISTS +% ================================================================= +% ================================================================= +% ================================================================= + +eval_20(Eq,RetType,_Dpth,_Slf,[X|T],Y):- T==[], \+ callable(X),!, do_expander(Eq,RetType,X,YY),Y=[YY]. +%eval_20(Eq,RetType,_Dpth,Self,[X|T],Y):- T==[], atom(X), +% \+ is_user_defined_head_f(Self,X), +% do_expander(Eq,RetType,X,YY),!,Y=[YY]. + +eval_20(Eq,RetType,Depth,Self,X,Y):- atom(Eq), ( Eq \== ('=')) ,!, + call(Eq,'=',RetType,Depth,Self,X,Y). + + +eval_20(_Eq,_RetType,_Depth,_Self,[V|VI],VO):- atomic(V), py_is_object(V),!, + is_list(VI),!, py_eval_object([V|VI],VO). + +eval_20(Eq,RetType,Depth,Self,[V|VI],VO):- is_list(V), V \== [], + eval_20(Eq,_FRype,Depth,Self,V,VV), V\==VV, atomic(VV), !, + eval_20(Eq,RetType,Depth,Self,[VV|VI],VO). + +eval_20(Eq,RetType,Depth,Self,[F,[Eval,V]|VI],VO):- Eval == eval,!, + ((eval_args(Eq,_FRype,Depth,Self,V,VV), V\=@=VV)*-> true; VV = V), + eval_20(Eq,RetType,Depth,Self,[F,VV|VI],VO). + + +% DMILES @ TODO make sure this isnt an implicit curry +eval_20(Eq,_RetType,Depth,Self,[V|VI],VO):- \+ callable(V), is_list(VI),!, + maplist(eval_ret(Eq,_ArgRetType,Depth,Self),[V|VI],VOO),VO=VOO. + + +eval_20(Eq,RetType,Depth,Self,[V|VI],VVO):- \+ is_list(VI),!, + eval_args(Eq,RetType,Depth,Self,VI,VM), + ( VM\==VI -> eval_args(Eq,RetType,Depth,Self,[V|VM],VVO) ; + (eval_args(Eq,RetType,Depth,Self,V,VV), (V\==VV -> eval_args(Eq,RetType,Depth,Self,[VV|VI],VVO) ; VVO = [V|VI]))). + +eval_20(Eq,RetType,_Dpth,_Slf,X,Y):- \+ is_list(X),!,do_expander(Eq,RetType,X,Y). + +eval_20(Eq,_RetType,Depth,Self,[V|VI],[V|VO]):- var(V),is_list(VI),!,maplist(eval_args(Eq,_ArgRetType,Depth,Self),VI,VO). + +eval_20(_,_,_,_,['echo',Value],Value):- !. +eval_20(=,Type,_,_,['coerce',Type,Value],Result):- !, coerce(Type,Value,Result). + +% ================================================================= +% ================================================================= +% ================================================================= +% LET* +% ================================================================= +% ================================================================= +% ================================================================= + + %eval_20(Eq,RetType,Depth2,Self,[Qw,X,Y],YO):- Qw == ('=='),!, + % eval_args(X,XX),eval_args(Y,YY), !, as_tf(XX==YY,YO). + + + eval_20(Eq,RetType,Depth,Self,['let*',Lets,Body],RetVal):- + expand_let_star(Lets,Body,NewLet),!, + eval_20(Eq,RetType,Depth,Self,NewLet,RetVal). + + + +expand_let_star(Lets,Body,Body):- Lets==[],!. +expand_let_star([H|LetRest],Body,['let',V,E,NewBody]):- + is_list(H), H = [V,E], !, + expand_let_star(LetRest,Body,NewBody). + +eval_20(Eq,RetType,Depth,Self,X,RetVal):- + once(expand_eval(X,XX)),X\==XX,!, + %fbug(expand_eval(X,XX)), + eval_20(Eq,RetType,Depth,Self,XX,RetVal). + +expand_eval(X,Y):- \+ is_list(X),!, X=Y. +expand_eval([H|A],[H|AA]):- \+ ground(H),!,maplist(expand_eval,A,AA). +expand_eval(['let*',Lets,Body],NewBody):- expand_let_star(Lets,Body,NewBody),!. +expand_eval([H|A],[H|AA]):- maplist(expand_eval,A,AA). + +% ================================================================= +% ================================================================= +% ================================================================= +% EVAL LAZY +% ================================================================= +% ================================================================= +% ================================================================= + + +is_progn(C):- var(C),!,fail. +is_progn('chain-body'). +is_progn('progn'). + +eval_20(Eq,RetType,Depth,Self,[Comma,X ],Res):- is_progn(Comma),!, eval_args(Eq,RetType,Depth,Self,X,Res). +%eval_20(Eq,RetType,Depth,Self,[Comma,X,Y],Res):- is_progn(Comma),!, eval_args(Eq,_,Depth,Self,X,_), +% eval_args(Eq,RetType,Depth,Self,Y,Res). +eval_20(Eq,RetType,Depth,Self,[Comma,X|Y],Res):- is_progn(Comma),!, eval_args(Eq,_,Depth,Self,X,_), + eval_args(Eq,RetType,Depth,Self,[Comma|Y],Res). + +eval_20(Eq,RetType,Depth,Self,['chain',Atom,Var|Y],Res):- !, eval_args(Eq,_RetType,Depth,Self,Atom,R), + Var = R, eval_args(Eq,RetType,Depth,Self,['chain-body'|Y],Res). + +%eval_20(Eq,RetType,Depth,Self,['chain-body',X],Res):- !,eval_args(Eq,RetType,Depth,Self,X,Res). +%eval_20(Eq,RetType,Depth,Self,['chain-body',X|Y],Res):- !, eval_args(Eq,RetType,Depth,Self,X,_), eval_args(Eq,RetType,Depth,Self,['chain-body'|Y],Res). + +eval_20(Eq,RetType,Depth,Self,['eval',X],Res):- !, + eval_args(Eq,RetType,Depth,Self,X, Res). + + +eval_20(Eq,RetType,Depth,Self,['eval-for',Type,X],Res):- !, + ignore(Type=RetType), + eval_args(Eq,Type,Depth,Self,X, Res). + +eval_20(Eq,RetType,Depth,Self,['eval-for',_Why,Type,X],Res):- !, + ignore(Type=RetType), + eval_args(Eq,Type,Depth,Self,X, Res). + + +% ================================================================= +% ================================================================= +% ================================================================= +% LET +% ================================================================= +% ================================================================= +% ================================================================= + + + +eval_until_unify(_Eq,_RetType,_Dpth,_Slf,X,X):- !. +eval_until_unify(Eq,RetType,Depth,Self,X,Y):- eval_until_eq(Eq,RetType,Depth,Self,X,Y),!. + +eval_until_eq(Eq,RetType,_Dpth,_Slf,X,Y):- X=Y,check_returnval(Eq,RetType,Y). +%eval_until_eq(Eq,RetType,Depth,Self,X,Y):- var(Y),!,eval_in_steps_or_same(Eq,RetType,Depth,Self,X,XX),Y=XX. +%eval_until_eq(Eq,RetType,Depth,Self,Y,X):- var(Y),!,eval_in_steps_or_same(Eq,RetType,Depth,Self,X,XX),Y=XX. +eval_until_eq(Eq,RetType,Depth,Self,X,Y):- \+is_list(Y),!,eval_in_steps_some_change(Eq,RetType,Depth,Self,X,XX),Y=XX. +eval_until_eq(Eq,RetType,Depth,Self,Y,X):- \+is_list(Y),!,eval_in_steps_some_change(Eq,RetType,Depth,Self,X,XX),Y=XX. +eval_until_eq(Eq,RetType,Depth,Self,X,Y):- eval_in_steps_some_change(Eq,RetType,Depth,Self,X,XX),eval_until_eq(Eq,RetType,Depth,Self,Y,XX). +eval_until_eq(_Eq,_RetType,_Dpth,_Slf,X,Y):- length(X,Len), \+ length(Y,Len),!,fail. +eval_until_eq(Eq,RetType,Depth,Self,X,Y):- nth1(N,X,EX,RX), nth1(N,Y,EY,RY), + EX=EY,!, maplist(eval_until_eq(Eq,RetType,Depth,Self),RX,RY). +eval_until_eq(Eq,RetType,Depth,Self,X,Y):- nth1(N,X,EX,RX), nth1(N,Y,EY,RY), + ((var(EX);var(EY)),eval_until_eq(Eq,RetType,Depth,Self,EX,EY)), + maplist(eval_until_eq(Eq,RetType,Depth,Self),RX,RY). +eval_until_eq(Eq,RetType,Depth,Self,X,Y):- nth1(N,X,EX,RX), nth1(N,Y,EY,RY), + h((is_list(EX);is_list(EY)),eval_until_eq(Eq,RetType,Depth,Self,EX,EY)), + maplist(eval_until_eq(Eq,RetType,Depth,Self),RX,RY). + + eval_1change(Eq,RetType,Depth,Self,EX,EXX):- + eval_20(Eq,RetType,Depth,Self,EX,EXX), EX \=@= EXX. + +eval_complete_change(Eq,RetType,Depth,Self,EX,EXX):- + eval_args(Eq,RetType,Depth,Self,EX,EXX), EX \=@= EXX. + +eval_in_steps_some_change(_Eq,_RetType,_Dpth,_Slf,EX,_):- \+ is_list(EX),!,fail. +eval_in_steps_some_change(Eq,RetType,Depth,Self,EX,EXX):- eval_1change(Eq,RetType,Depth,Self,EX,EXX). +eval_in_steps_some_change(Eq,RetType,Depth,Self,X,Y):- append(L,[EX|R],X),is_list(EX), + eval_in_steps_some_change(Eq,RetType,Depth,Self,EX,EXX), EX\=@=EXX, + append(L,[EXX|R],XX),eval_in_steps_or_same(Eq,RetType,Depth,Self,XX,Y). + +eval_in_steps_or_same(Eq,RetType,Depth,Self,X,Y):-eval_in_steps_some_change(Eq,RetType,Depth,Self,X,Y). +eval_in_steps_or_same(Eq,RetType,_Dpth,_Slf,X,Y):- X=Y,check_returnval(Eq,RetType,Y). + + % (fail,make_nop(RetType,[],Template))). + + +possible_type(_Self,_Var,_RetTypeV). + +eval_20(Eq,RetType,Depth,Self,['let',E,V,Body],OO):- var(V), nonvar(E), !, + %(var(V)->true;trace), + possible_type(Self,V,RetTypeV), + eval_args(Eq,RetTypeV,Depth,Self,E,ER), V=ER, + eval_args(Eq,RetType,Depth,Self,Body,OO). + +eval_20(Eq,RetType,Depth,Self,['let',V,E,Body],OO):- !, % var(V), nonvar(E), !, + %(var(V)->true;trace), + possible_type(Self,V,RetTypeV), + eval_args(Eq,RetTypeV,Depth,Self,E,ER), V=ER, + eval_args(Eq,RetType,Depth,Self,Body,OO). +/* + +eval_20(Eq,RetType,Depth,Self,['let',V,E,Body],OO):- nonvar(V),nonvar(E),!, + possible_type(Self,V,RetTypeV), + possible_type(Self,E,RetTypeV), + ((V=E,fail) -> true; + (eval_args(Eq,RetTypeV,Depth,Self,E,ER), + (V=ER -> true; + (eval_args(Eq,RetTypeV,Depth,Self,V,VR), + (E=VR -> true; ER=VR))))), + eval_args(Eq,RetType,Depth,Self,Body,OO). + + +eval_20(Eq,RetType,Depth,Self,['let',V,E,Body],OO):- var(V), nonvar(E), !, + %(var(V)->true;trace), + possible_type(Self,V,RetTypeV), + eval_args(Eq,RetTypeV,Depth,Self,E,ER), V=ER, + eval_args(Eq,RetType,Depth,Self,Body,OO). + +eval_20(Eq,RetType,Depth,Self,['let',V,E,Body],OO):- var(V), var(E), !, + V=E, eval_args(Eq,RetType,Depth,Self,Body,OO). + + +%eval_20(Eq,RetType,Depth,Self,['let',V,E,Body],BodyO):- !,eval_args(Eq,RetType,Depth,Self,E,V),eval_args(Eq,RetType,Depth,Self,Body,BodyO). +eval_20(Eq,RetType,Depth,Self,['let*',[],Body],RetVal):- !, eval_args(Eq,RetType,Depth,Self,Body,RetVal). +%eval_20(Eq,RetType,Depth,Self,['let*',[[Var,Val]|LetRest],Body],RetVal):- !, +% eval_until_unify(Eq,_RetTypeV,Depth,Self,Val,Var), +% eval_20(Eq,RetType,Depth,Self,['let*',LetRest,Body],RetVal). +eval_20(Eq,RetType,Depth,Self,['let*',[[Var,Val]|LetRest],Body],RetVal):- !, + eval_20(Eq,RetType,Depth,Self,['let',Var,Val,['let*',LetRest,Body]],RetVal). +*/ +% ================================================================= +% ================================================================= +% ================================================================= +% TRACE/PRINT +% ================================================================= +% ================================================================= +% ================================================================= + +eval_20(Eq,RetType,_Dpth,_Slf,['repl!'],Y):- !, repl,check_returnval(Eq,RetType,Y). +%eval_20(Eq,RetType,Depth,Self,['enforce',Cond],Res):- !, enforce_true(Eq,RetType,Depth,Self,Cond,Res). +eval_20(Eq,RetType,Depth,Self,['!',Cond],Res):- !, call(eval_args(Eq,RetType,Depth,Self,Cond,Res)). +eval_20(Eq,RetType,Depth,Self,['rtrace!',Cond],Res):- !, rtrace(eval_args(Eq,RetType,Depth,Self,Cond,Res)). +eval_20(Eq,RetType,Depth,Self,['no-rtrace!',Cond],Res):- !, quietly(eval_args(Eq,RetType,Depth,Self,Cond,Res)). +eval_20(Eq,RetType,Depth,Self,['trace!',A,B],C):- !, % writeln(trace(A)), + stream_property(S,file_no(2)),!, + eval_args(Eq,RetType,Depth,Self,B,C), + ignore((eval_args(Eq,_RetType,Depth,Self,A,AA), + with_output_to(S,(format('~N'), write_src(AA),format('~N'))))). +eval_20(Eq,RetType,Depth,Self,['trace',Cond],Res):- !, with_debug(eval_args,eval_args(Eq,RetType,Depth,Self,Cond,Res)). +eval_20(Eq,RetType,Depth,Self,['profile!',Cond],Res):- !, time_eval(profile(Cond),profile(eval_args(Eq,RetType,Depth,Self,Cond,Res))). +eval_20(Eq,RetType,Depth,Self,['time!',Cond],Res):- !, time_eval(eval_args(Cond),eval_args(Eq,RetType,Depth,Self,Cond,Res)). +eval_20(Eq,RetType,Depth,Self,['print',Cond],Res):- !, eval_args(Eq,RetType,Depth,Self,Cond,Res),format('~N'),print(Res),format('~N'). +% !(print! $1) +eval_20(Eq,RetType,Depth,Self,['princ!'|Cond],Res):- !, + maplist(eval_args(Eq,RetType,Depth,Self),Cond,Out), + maplist(princ_impl,Out), + make_nop(RetType,[],Res),check_returnval(Eq,RetType,Res). +% !(println! $1) +eval_20(Eq,RetType,Depth,Self,['println!'|Cond],Res):- !, + maplist(eval_args(Eq,RetType,Depth,Self),Cond,Out), + maplist(println_impl,Out), + make_nop(RetType,[],Res),check_returnval(Eq,RetType,Res). + +println_impl(X):- format("~N~@~N",[write_sln(X)]),!. +println_impl(X):- user_io((ansi_format(fg('#c7ea46'),"~N~@~N",[write_sln(X)]))). + +princ_impl(X):- format("~@",[write_sln(X)]),!. + +write_sln(X):- string(X), !, write(X). +write_sln(X):- write_src_woi(X). + +with_output_to_str( Sxx , Goal ):- + wots( Sxx , Goal ). + +% ================================================================= +% ================================================================= +% ================================================================= +% UNIT TESTING/assert +% ================================================================= +% ================================================================= +% ================================================================= + + +eval_20(Eq,RetType,Depth,Self,['assertTrue', X],TF):- !, + eval_20(Eq,RetType,Depth,Self,['assertEqual',X,'True'],TF). +eval_20(Eq,RetType,Depth,Self,['assertFalse',X],TF):- !, + eval_20(Eq,RetType,Depth,Self,['assertEqual',X,'False'],TF). + +eval_20(Eq,_RetType,Depth,Self,['assertEqual',X,Y],RetVal):- !, + loonit_assert_source_tf_empty( + ['assertEqual',X,Y],XX,YY, + (findall_eval(Eq,_ARetType,Depth,Self,X,XX), + findall_eval(Eq,_BRetType,Depth,Self,Y,YY)), + equal_enough_for_test(XX,YY), RetVal). + +eval_20(Eq,_RetType,Depth,Self,['assertNotEqual',X,Y],RetVal):- !, + loonit_assert_source_tf_empty( + ['assertNotEqual',X,Y],XX,YY, + (findall_eval(Eq,_ARetType,Depth,Self,X,XX), + findall_eval(Eq,_BRetType,Depth,Self,Y,YY)), + ( \+ equal_enough(XX,YY)), RetVal). + +eval_20(Eq,_RetType,Depth,Self,['assertEqualToResult',X,Y],RetVal):- !, + loonit_assert_source_tf_empty( + ['assertEqualToResult',X,Y],XX,YY, + (findall_eval(Eq,_ARetType,Depth,Self,X,XX), + =(Y,YY)), + equal_enough_for_test(XX,YY), RetVal). + +loonit_assert_source_tf_empty(Src,XX,YY,Goal,Check,RetVal):- + loonit_assert_source_tf(Src,Goal,Check,TF), + tf_to_empty(TF,['Error'(got(XX),expected(YY))],RetVal). + +tf_to_empty(TF,Else,RetVal):- + (TF=='True'->as_nop(RetVal);RetVal=Else). + +val_sort(Y,YY):- is_list(Y),!,sort(Y,YY). +val_sort(Y,[Y]). + +loonit_assert_source_tf(_Src,Goal,Check,TF):- fail, \+ is_testing,!, + reset_eval_num, + call(Goal), + as_tf(Check,TF),!. + +loonit_assert_source_tf(Src,Goal,Check,TF):- + copy_term(Goal,OrigGoal), + reset_eval_num, + call_cleanup(loonit_asserts(Src, time_eval('\n; EVAL TEST\n;',Goal), Check), + (as_tf(notrace(Check),TF),!, + ignore(( + once((TF='True', trace_on_pass);(TF='False', trace_on_fail)), + with_debug((eval_args),time_eval('Trace',OrigGoal)))))). + +sort_result(Res,Res):- \+ compound(Res),!. +sort_result([And|Res1],Res):- is_and(And),!,sort_result(Res1,Res). +sort_result([T,And|Res1],Res):- is_and(And),!,sort_result([T|Res1],Res). +sort_result([H|T],[HH|TT]):- !, sort_result(H,HH),sort_result(T,TT). +sort_result(Res,Res). + + +unify_case(A,B):- A=@=B,!,A=B. +unify_case(A,B):- A=B,!. + +unify_enough(L,L). +unify_enough(L,C):- into_list_args(L,LL),into_list_args(C,CC),unify_lists(CC,LL). + +%unify_lists(C,L):- \+ compound(C),!,L=C. +%unify_lists(L,C):- \+ compound(C),!,L=C. +unify_lists(L,L):-!. +unify_lists([C|CC],[L|LL]):- unify_enough(L,C),!,unify_lists(CC,LL). + +is_blank(X):- var(X),!,fail. +is_blank(E):- is_empty(E),!. +is_blank([]). +is_blank([X]):-!,is_blank(X). +has_let_star(Y):- sub_var('let*',Y). + +sort_univ(L,S):- cl_list_to_set(L,E),sort(E,S). +% !(pragma! unit-tests tollerant) ; tollerant or exact +is_tollerant:- \+ option_value('unit-tests','exact'). + +equal_enough_for_test(X,Y):- X==Y,!. +equal_enough_for_test(X,Y):- X=@=Y,!. +equal_enough_for_test(X,Y):- is_list(X),is_list(Y),sort(X,X0),sort(Y,Y0), + Y0=[YY],X0=[XX],!,equal_enough_for_test(XX,YY). +equal_enough_for_test(X,Y):- is_list(X),is_list(Y),X=[ErrorX|_],Y=[ErrorY|_],ErrorX=='Error', + ErrorY == ErrorX,!. +equal_enough_for_test(X,Y):- is_blank(X),!,is_blank(Y). +equal_enough_for_test(X,Y):- has_let_star(Y),!,\+ is_blank(X). +equal_enough_for_test(X,Y):- is_list(X),is_list(Y), + Y=[YY],X=[XX],!,equal_enough_for_test(XX,YY). + %length(XX,XL),length(YY,YL), + +%equal_enough_for_test(X,Y):-!,fail. + +equal_enough_for_test(X,Y):- must_det_ll((subst_vars(X,XX),subst_vars(Y,YY))),!, + equal_enough_for_test2(XX,YY),!. +equal_enough_for_test2(X,Y):- equal_enough(X,Y). + +equal_enough(R,V):- is_list(R),is_list(V),sort_univ(R,RR),sort_univ(V,VV),!,equal_enouf(RR,VV),!. +equal_enough(R,V):- copy_term(R,RR),copy_term(V,VV),equal_enouf(R,V),!,R=@=RR,V=@=VV. +equal_enouf(R,V):- is_ftVar(R), is_ftVar(V), R=V,!. +equal_enouf(X,Y):- is_blank(X),!,is_blank(Y). +equal_enouf(X,Y):- symbol(X),symbol(Y),atom_concat('&',_,X),atom_concat('Grounding',_,Y). +equal_enouf(R,V):- R=@=V, R=V, !. +equal_enouf(_,V):- V=@='...',!. + +equal_enouf(L,C):- is_tollerant, is_list(L),is_list(C), + maybe_remove_nils(C,CC),equal_enouf(L,CC). + +equal_enouf(L,C):- is_list(L),into_list_args(C,CC),!,equal_enouf_l(CC,L). +equal_enouf(C,L):- is_list(L),into_list_args(C,CC),!,equal_enouf_l(CC,L). +%equal_enouf(R,V):- (var(R),var(V)),!, R=V. +equal_enouf(R,V):- (var(R);var(V)),!, R==V. +equal_enouf(R,V):- number(R),number(V),!, RV is abs(R-V), RV < 0.03 . +equal_enouf(R,V):- atom(R),!,atom(V), has_unicode(R),has_unicode(V). +equal_enouf(R,V):- (\+ compound(R) ; \+ compound(V)),!, R==V. +equal_enouf(L,C):- into_list_args(L,LL),into_list_args(C,CC),!,equal_enouf_l(CC,LL). + +equal_enouf_l([S1,V1|_],[S2,V2|_]):- S1 == 'State',S2 == 'State',!, equal_enouf(V1,V2). +equal_enouf_l(C,L):- \+ compound(C),!,L=@=C. +equal_enouf_l(L,C):- \+ compound(C),!,L=@=C. +equal_enouf_l([C|CC],[L|LL]):- !, equal_enouf(L,C),!,equal_enouf_l(CC,LL). + +maybe_remove_nils(I,O):- always_remove_nils(I,O),!,I\=@=O. +always_remove_nils(I,O):- \+ compound(I),!,I=O. +always_remove_nils([H|T], TT):- H==[],!, always_remove_nils(T,TT). +always_remove_nils([H|T], TT):- H=='Empty',!, always_remove_nils(T,TT). +always_remove_nils([H|T],[H|TT]):- always_remove_nils(T,TT). + +has_unicode(A):- atom_codes(A,Cs),member(N,Cs),N>127,!. + +set_last_error(_). + +% ================================================================= +% ================================================================= +% ================================================================= +% SPACE EDITING +% ================================================================= +% ================================================================= +% ================================================================= + +eval_20(Eq,RetType,_Dpth,_Slf,['new-space'],Space):- !, 'new-space'(Space),check_returnval(Eq,RetType,Space). + +eval_20(Eq,RetType,Depth,Self,[Op,Space|Args],Res):- is_space_op(Op),!, + eval_space_start(Eq,RetType,Depth,Self,[Op,Space|Args],Res). +eval_20(Eq,RetType,Depth,Self,['unify',Space|Args],Res):- !, + eval_space_start(Eq,RetType,Depth,Self,['match',Space|Args],Res). + +eval_space_start(Eq,RetType,_Depth,_Self,[_Op,_Other,Atom],Res):- + (Atom == [] ; Atom =='Empty'; Atom =='Nil'),!,make_nop(RetType,'False',Res),check_returnval(Eq,RetType,Res). + +eval_space_start(Eq,RetType,Depth,Self,[Op,Other|Args],Res):- + into_space(Depth,Self,Other,Space), + eval_space(Eq,RetType,Depth,Self,[Op,Space|Args],Res). + + +eval_space(Eq,RetType,_Dpth,_Slf,['add-atom',Space,PredDecl],Res):- !, + do_metta(python,load,Space,PredDecl,TF),make_nop(RetType,TF,Res),check_returnval(Eq,RetType,Res). + +eval_space(Eq,RetType,_Dpth,_Slf,['remove-atom',Space,PredDecl],Res):- !, + do_metta(python,unload_all,Space,PredDecl,TF), + make_nop(RetType,TF,Res),check_returnval(Eq,RetType,Res). + +eval_space(Eq,RetType,_Dpth,_Slf,['atom-count',Space],Count):- !, + ignore(RetType='Number'),ignore(Eq='='), + 'atom-count'(Space, Count). + %findall(Atom, metta_atom(Space, Atom),Atoms), + %length(Atoms,Count). + +eval_space(Eq,RetType,_Dpth,_Slf,['atom-replace',Space,Rem,Add],TF):- !, + copy_term(Rem,RCopy), as_tf((metta_atom_iter_ref(Space,RCopy,Ref), RCopy=@=Rem,erase(Ref), do_metta(Space,load,Add)),TF), + check_returnval(Eq,RetType,TF). + +eval_space(Eq,RetType,_Dpth,_Slf,['get-atoms',Space],Atom):- !, + ignore(RetType='Atom'), + get_metta_atom_from(Space, Atom), + check_returnval(Eq,RetType,Atom). + +% Match-ELSE +eval_space(Eq,RetType,Depth,Self,['match',Other,Goal,Template,Else],Template):- !, + ((eval_space(Eq,RetType,Depth,Self,['match',Other,Goal,Template],Template), + \+ make_nop(RetType,[],Template))*->true;Template=Else). +% Match-TEMPLATE + +eval_space(Eq,RetType,Depth,Self,['match',Other,Goal,Template],Res):- !, + metta_atom_iter(Eq,Depth,Self,Other,Goal), + eval_args(Eq,RetType,Depth,Self,Template,Res). + +%metta_atom_iter(Eq,_Depth,_Slf,Other,[Equal,[F|H],B]):- Eq == Equal,!, % trace, +% metta_eq_def(Eq,Other,[F|H],B). + +/* +metta_atom_iter(Eq,Depth,Self,Other,[Equal,[F|H],B]):- Eq == Equal,!, % trace, + metta_eq_def(Eq,Other,[F|H],BB), + eval_sometimes(Eq,_RetType,Depth,Self,B,BB). +*/ + +metta_atom_iter(_Eq,Depth,_,_,_):- Depth<3,!,fail. +metta_atom_iter(Eq,Depth,Self,Other,[And|Y]):- atom(And), is_comma(And),!, + (Y==[] -> true ; + ( D2 is Depth -1, Y = [H|T], + metta_atom_iter(Eq,D2,Self,Other,H),metta_atom_iter(Eq,D2,Self,Other,[And|T]))). + +%metta_atom_iter(Eq,Depth,_Slf,Other,X):- dcall0000000000(eval_args_true(Eq,_RetType,Depth,Other,X)). +metta_atom_iter(Eq,Depth,Self,Other,X):- + %copy_term(X,XX), + dcall0000000000(metta_atom_true(Eq,Depth,Self,Other,XX)), X=XX. + +metta_atom_true(_Eq,Depth,Self,Other,H):- + can_be_ok(metta_atom_true,H), + into_space(Depth,Self,Other,Space), + metta_atom(Space,H). +% is this OK? +%metta_atom_true(Eq,Depth,Self,Other,H):- nonvar(H), metta_eq_def(Eq,Other,H,B), D2 is Depth -1, eval_args_true(Eq,_,D2,Self,B). +% is this OK? +%metta_atom_true(Eq,Depth,Self,Other,H):- Other\==Self, nonvar(H), metta_eq_def(Eq,Other,H,B), D2 is Depth -1, eval_args_true(Eq,_,D2,Other,B). + + + +eval_args_true_r(Eq,RetType,Depth,Self,X,TF1):- + ((eval_ne(Eq,RetType,Depth,Self,X,TF1), \+ is_False(TF1)); + ( \+ is_False(TF1),metta_atom_true(Eq,Depth,Self,Self,X))). + +eval_args_true(Eq,RetType,Depth,Self,X):- + % can_be_ok(eval_args_true,X), + % metta_atom_true(Eq,Depth,Self,Self,X); + (nonvar(X),eval_ne(Eq,RetType,Depth,Self,X,TF1), \+ is_False(TF1)). + + +metta_atom_iter_ref(Other,H,Ref):-clause(metta_atom_asserted(Other,H),true,Ref). +can_be_ok(A,B):- cant_be_ok(A,B),!,fbug(cant_be_ok(A,B)),trace. +can_be_ok(_,_). + +cant_be_ok(_,[Let|_]):- Let==let. +% ================================================================= +% ================================================================= +% ================================================================= +% CASE/SWITCH +% ================================================================= +% ================================================================= +% ================================================================= +% Macro: case +:- nodebug(metta(case)). + +eval_20(Eq,RetType,Depth,Self,['switch',A,CL|T],Res):- !, + eval_20(Eq,RetType,Depth,Self,['case',A,CL|T],Res). + +% if there is only a void then always return nothing for each Case +eval_20(Eq,_RetType,Depth,Self,['case',A,[[Void,_]]],Res):- + '%void%' == Void, + eval_args(Eq,_UnkRetType,Depth,Self,A,_),!,Res =[]. + +% if there is nothing for case just treat like a collapse +eval_20(Eq,RetType,Depth,Self,['case',A,[]],NoResult):- !, + %forall(eval_args(Eq,_RetType2,Depth,Self,Expr,_),true), + once(eval_args(Eq,_RetType2,Depth,Self,A,_)), + make_nop(RetType,[],NoResult). + + +into_case_keys(_,[],[]). +into_case_keys(Nth,[Case0|CASES],[Key-Value|KVs]):- + Nth1 is Nth+1, + is_case(Key,Case0,Value), + if_trace((case),(format('~N'),writeqln(c(Nth,Key)=Value))), + into_case_keys(Nth1,CASES,KVs). + +% Macro: case +eval_20(Eq,RetType,Depth,Self,['case',A,CL|T],Res):- !, + must_det_ll(T==[]), + into_case_list(CL,CASES), + into_case_keys(1,CASES,KVs), + eval_case(Eq,RetType,Depth,Self,A,KVs,Res). + +eval_case(Eq,CaseRetType,Depth,Self,A,KVs,Res):- + if_trace((case),(writeqln('case'=A))), + ((eval_args(Eq,_UnkRetType,Depth,Self,A,AA), + if_trace((case),writeqln('switch'=AA)), + (select_case(Depth,Self,AA,KVs,Value)->true;(member(Void -Value,KVs),Void=='%void%'))) + *->true;(member(Void -Value,KVs),Void=='%void%')), + eval_args(Eq,CaseRetType,Depth,Self,Value,Res). + + select_case(Depth,Self,AA,Cases,Value):- + (best_key(AA,Cases,Value) -> true ; + (maybe_special_keys(Depth,Self,Cases,CasES), + (best_key(AA,CasES,Value) -> true ; + (member(Void -Value,CasES),Void=='%void%')))). + + best_key(AA,Cases,Value):- member(Match-Value,Cases),AA = Match,!. + best_key(AA,Cases,Value):- + ((member(Match-Value,Cases),AA ==Match)->true; + ((member(Match-Value,Cases),AA=@=Match)->true; + (member(Match-Value,Cases),AA = Match))). + + into_case_list(CASES,CASES):- is_list(CASES),!. + is_case(AA,[AA,Value],Value):-!. + is_case(AA,[AA|Value],Value). + + maybe_special_keys(Depth,Self,[K-V|KVI],[AK-V|KVO]):- + eval_args(Depth,Self,K,AK), K\=@=AK,!, + maybe_special_keys(Depth,Self,KVI,KVO). + maybe_special_keys(Depth,Self,[_|KVI],KVO):- + maybe_special_keys(Depth,Self,KVI,KVO). + maybe_special_keys(_Depth,_Self,[],[]). + + +% ================================================================= +% ================================================================= +% ================================================================= +% COLLAPSE/SUPERPOSE +% ================================================================= +% ================================================================= +% ================================================================= + +%;; collapse-bind because `collapse` doesnt guarentee shared bindings +eval_20(Eq,RetType,Depth,Self,['collapse-bind',List],Res):-!, + maplist_ok_fails(eval_ne(Eq,RetType,Depth,Self),List,Res). + +maplist_ok_fails(Pred2,[A|AA],BBB):- !, + (call(Pred2,A,B) -> (BBB=[B|BB], maplist_ok_fails(Pred2,AA,BB)) + ; maplist_ok_fails(Pred2,AA,BBB)). +maplist_ok_fails(_Pred2,[],[]). + +%;; superpose-bind because `superpose` doesnt guarentee shared bindings +% @TODO need to keep bindings +eval_20(Eq,RetType,Depth,Self,['superpose-bind',List],Res):- !, + re_member(Res,E,List), + eval_ret(Eq,RetType,Depth,Self,E,Res). + +re_member(Res,E,List):- term_variables(Res+E+List,TV),copy_term(TV,Copy), + member(E,List),TV=Copy. + +%[collapse,[1,2,3]] +eval_20(Eq,RetType,Depth,Self,['collapse',List],Res):-!, + findall_eval(Eq,RetType,Depth,Self,List,Res). + + +eval_20(Eq,RetType,Depth,Self,['superpose',List],Res):- !, + member(E,List), + eval_ret(Eq,RetType,Depth,Self,E,Res). + +%[superpose,[1,2,3]] +old_eval_20(_Eq,RetType,_Depth,_Self,['superpose',List],Res):- List==[], !, + make_empty(RetType,[],Res). +old_eval_20(Eq,RetType,Depth,Self,['superpose',List],Res):- !, + ((( + is_user_defined_head(Eq,Self,List) ,eval_args(Eq,RetType,Depth,Self,List,UList), + List\=@=UList) + *-> eval_20(Eq,RetType,Depth,Self,['superpose',UList],Res) + ; ((member(E,List),eval_args(Eq,RetType,Depth,Self,E,Res))*->true;make_nop(RetType,[],Res)))), + \+ Res = 'Empty'. + +%[sequential,[1,2,3]] +eval_20(Eq,RetType,Depth,Self,['sequential',List],Res):- !, + (((fail,is_user_defined_head(Eq,Self,List) ,eval_args(Eq,RetType,Depth,Self,List,UList), List\=@=UList) + *-> eval_20(Eq,RetType,Depth,Self,['sequential',UList],Res) + ; ((member(E,List),eval_ne(Eq,RetType,Depth,Self,E,Res))*->true;make_nop(RetType,[],Res)))). + + +get_sa_p1(P3,E,Cmpd,SA):- compound(Cmpd), get_sa_p2(P3,E,Cmpd,SA). +get_sa_p2(P3,E,Cmpd,call(P3,N1,Cmpd)):- arg(N1,Cmpd,E). +get_sa_p2(P3,E,Cmpd,SA):- arg(_,Cmpd,Arg),get_sa_p1(P3,E,Arg,SA). +eval20_failed(Eq,RetType,Depth,Self, Term, Res):- + notrace(( get_sa_p1(setarg,ST,Term,P1), % ST\==Term, + compound(ST), ST = [F,List],F=='superpose',nonvar(List), %maplist(atomic,List), + call(P1,Var))), !, + %max_counting(F,20), + member(Var,List), + eval_args(Eq,RetType,Depth,Self, Term, Res). + + +sub_sterm(Sub,Sub). +sub_sterm(Sub,Term):- sub_sterm1(Sub,Term). +sub_sterm1(_ ,List):- \+ compound(List),!,fail. +sub_sterm1(Sub,List):- is_list(List),!,member(SL,List),sub_sterm(Sub,SL). +sub_sterm1(_ ,[_|_]):-!,fail. +sub_sterm1(Sub,Term):- arg(_,Term,SL),sub_sterm(Sub,SL). +eval20_failed_2(Eq,RetType,Depth,Self, Term, Res):- + notrace(( get_sa_p1(setarg,ST,Term,P1), + compound(ST), ST = [F,List],F=='collapse',nonvar(List), %maplist(atomic,List), + call(P1,Var))), !, findall_eval(Eq,RetType,Depth,Self,List,Var), + eval_args(Eq,RetType,Depth,Self, Term, Res). + + +% ================================================================= +% ================================================================= +% ================================================================= +% NOP/EQUALITU/DO +% ================================================================= +% ================================================================= +% ================================================================ +eval_20(_Eq,RetType,_Depth,_Self,['nop'], NoResult ):- !, + make_nop(RetType,[], NoResult). +eval_20(_Eq,RetType,_Depth,_Self,['empty'], Empty ):- !, + make_empty(RetType, Empty). +eval_20(_Eq,RetType,Depth,Self,['nop',Expr], NoResult ):- !, + make_nop(RetType,[], NoResult), + ignore(eval_args('=',_RetType2,Depth,Self,Expr,_)). + + +eval_20(Eq,RetType,Depth,Self,['do',Expr], NoResult):- !, + forall(eval_args(Eq,_RetType2,Depth,Self,Expr,_),true), + %eval_ne(Eq,_RetType2,Depth,Self,Expr,_),!, + make_empty(RetType,[],NoResult). + +eval_20(_Eq,_RetType1,_Depth,_Self,['call!',S], TF):- !, eval_call(S,TF). +eval_20(_Eq,_RetType1,_Depth,_Self,['call-fn!',S], R):- !, eval_call_fn(S,R). +eval_20(_Eq,_RetType1,_Depth,_Self,['call-fn-nth!',Nth,S], R):- + length(Left,Nth), + append(Left,Right,S), + append(Left,[R|Right],NewS),!, + eval_call(NewS,_). + +max_counting(F,Max):- flag(F,X,X+1), X true; (flag(F,_,10),!,fail). + + +% ================================================================= +% ================================================================= +% ================================================================= +% CONS/DECONS +% ================================================================= +% ================================================================= +% ================================================================= + +must_unify(A,A):-!. +must_unify(A,B):- fail, throw('Error-last-form'(must_unify(A,B))). % @TODO + +% OLD +eval_20(_Eq,_RetType,_Depth,_Self,['decons-atom',OneArg],[H,T]):- OneArg==[], !, fail. %H=[],T=[],!. +eval_20(_Eq,_RetType,_Depth,_Self,['decons-atom',OneArg],[H,T]):- !, must_unify(OneArg,[H|T]). +eval_20(_Eq,_RetType,_Depth,_Self,['cons-atom'|TwoArgs],[H|T]):-!, must_unify(TwoArgs,[H,T]). +% NEW +eval_20(_Eq,_RetType,_Depth,_Self,['decons',OneArg],[H,T]):- !, must_unify(OneArg,[H|T]). +eval_20(_Eq,_RetType,_Depth,_Self,['cons'|TwoArgs],[H|T]):-!, must_unify(TwoArgs,[H,T]). + + +% ================================================================= +% ================================================================= +% ================================================================= +% if/If +% ================================================================= +% ================================================================= +% ================================================================= + +eval_20(Eq,RetType,Depth,Self,['unify',X,Y,Then,Else],Res):- !, + (X=Y + -> eval_args(Eq,RetType,Depth,Self,Then,Res) + ; eval_args(Eq,RetType,Depth,Self,Else,Res)). + + +eval_20(Eq,RetType,Depth,Self,['if-equal',X,Y,Then,Else],Res):- !, + eval_args(Eq,'Bool',Depth,Self,['==',X,Y],TF), + (is_True(TF) + -> eval_args(Eq,RetType,Depth,Self,Then,Res) + ; eval_args(Eq,RetType,Depth,Self,Else,Res)). + + +eval_20(Eq,RetType,Depth,Self,['if',Cond,Then,Else],Res):- !, + eval_args(Eq,'Bool',Depth,Self,Cond,TF), + (is_True(TF) + -> eval_args(Eq,RetType,Depth,Self,Then,Res) + ; eval_args(Eq,RetType,Depth,Self,Else,Res)). + +eval_20(Eq,RetType,Depth,Self,['If',Cond,Then,Else],Res):- !, + eval_args(Eq,'Bool',Depth,Self,Cond,TF), + (is_True(TF) + -> eval_args(Eq,RetType,Depth,Self,Then,Res) + ; eval_args(Eq,RetType,Depth,Self,Else,Res)). + +eval_20(Eq,RetType,Depth,Self,['If',Cond,Then],Res):- !, + eval_args(Eq,'Bool',Depth,Self,Cond,TF), + (is_True(TF) -> eval_args(Eq,RetType,Depth,Self,Then,Res) ; + (!, fail,Res = [],!)). + +eval_20(Eq,RetType,Depth,Self,['if',Cond,Then],Res):- !, + eval_args(Eq,'Bool',Depth,Self,Cond,TF), + (is_True(TF) -> eval_args(Eq,RetType,Depth,Self,Then,Res) ; + (!, fail,Res = [],!)). + + +eval_20(Eq,RetType,_Dpth,_Slf,[_,Nothing],NothingO):- + 'Nothing'==Nothing,!,do_expander(Eq,RetType,Nothing,NothingO). + + +% ================================================================= +% ================================================================= +% ================================================================= +% CONS/CAR/CDR +% ================================================================= +% ================================================================= +% ================================================================= + + + +into_pl_list(Var,Var):- var(Var),!. +into_pl_list(Nil,[]):- Nil == 'Nil',!. +into_pl_list([Cons,H,T],[HH|TT]):- Cons == 'Cons', !, into_pl_list(H,HH),into_pl_list(T,TT),!. +into_pl_list(X,X). + +into_metta_cons(Var,Var):- var(Var),!. +into_metta_cons([],'Nil'):-!. +into_metta_cons([Cons, A, B ],['Cons', AA, BB]):- 'Cons'==Cons, no_cons_reduce, !, + into_metta_cons(A,AA), into_metta_cons(B,BB). +into_metta_cons([H|T],['Cons',HH,TT]):- into_metta_cons(H,HH),into_metta_cons(T,TT),!. +into_metta_cons(X,X). + +into_listoid(AtomC,Atom):- AtomC = [Cons,H,T],Cons=='Cons',!, Atom=[H,[T]]. +into_listoid(AtomC,Atom):- is_list(AtomC),!,Atom=AtomC. +into_listoid(AtomC,Atom):- typed_list(AtomC,_,Atom),!. + +:- if( \+ current_predicate( typed_list / 3 )). +typed_list(Cmpd,Type,List):- compound(Cmpd), Cmpd\=[_|_], compound_name_arguments(Cmpd,Type,[List|_]),is_list(List). +:- endif. + +%eval_20(Eq,RetType,Depth,Self,['colapse'|List], Flat):- !, maplist(eval_args(Eq,RetType,Depth,Self),List,Res),flatten(Res,Flat). + +%eval_20(Eq,RetType,Depth,Self,['flatten'|List], Flat):- !, maplist(eval_args(Eq,RetType,Depth,Self),List,Res),flatten(Res,Flat). + + +eval_20(Eq,RetType,_Dpth,_Slf,['car-atom',Atom],CAR_Y):- !, Atom=[CAR|_],!,do_expander(Eq,RetType,CAR,CAR_Y). +eval_20(Eq,RetType,_Dpth,_Slf,['cdr-atom',Atom],CDR_Y):- !, Atom=[_|CDR],!,do_expander(Eq,RetType,CDR,CDR_Y). + +eval_20(Eq,RetType,Depth,Self,['Cons', A, B ],['Cons', AA, BB]):- no_cons_reduce, !, + eval_args(Eq,RetType,Depth,Self,A,AA), eval_args(Eq,RetType,Depth,Self,B,BB). + +%eval_20(_Eq,_RetType,Depth,Self,['::'|PL],Prolog):- maplist(as_prolog(Depth,Self),PL,Prolog),!. +%eval_20(_Eq,_RetType,Depth,Self,['@'|PL],Prolog):- as_prolog(Depth,Self,['@'|PL],Prolog),!. + +eval_20(Eq,RetType,Depth,Self,['Cons', A, B ],[AA|BB]):- \+ no_cons_reduce, !, + eval_args(Eq,RetType,Depth,Self,A,AA), eval_args(Eq,RetType,Depth,Self,B,BB). + + + +% ================================================================= +% ================================================================= +% ================================================================= +% STATE EDITING +% ================================================================= +% ================================================================= +% ================================================================= + +eval_20(Eq,RetType,Depth,Self,['change-state!',StateExpr, UpdatedValue], Ret):- !, + call_in_shared_space(((eval_args(Eq,RetType,Depth,Self,StateExpr,StateMonad), + eval_args(Eq,RetType,Depth,Self,UpdatedValue,Value), + catch_metta_return('change-state!'(Depth,Self,StateMonad, Value, Ret),Ret)))). +eval_20(Eq,RetType,Depth,Self,['new-state',UpdatedValue],StateMonad):- !, + call_in_shared_space(((eval_args(Eq,RetType,Depth,Self,UpdatedValue,Value), 'new-state'(Depth,Self,Value,StateMonad)))). +eval_20(Eq,RetType,Depth,Self,['get-state',StateExpr],Value):- !, + call_in_shared_space((eval_args(Eq,RetType,Depth,Self,StateExpr,StateMonad), 'get-state'(StateMonad,Value))). + +call_in_shared_space(G):- call_in_thread(main,G). + +% eval_20(Eq,RetType,Depth,Self,['get-state',Expr],Value):- !, eval_args(Eq,RetType,Depth,Self,Expr,State), arg(1,State,Value). + + +check_state_type:- !. +check_type:- option_else(typecheck,TF,'False'),!, TF=='True'. + +:- dynamic is_registered_state/1. +:- flush_output. +:- setenv('RUST_BACKTRACE',full). + +% Function to check if an value is registered as a state name +:- dynamic(is_registered_state/1). +is_nb_state(G):- is_valid_nb_state(G) -> true ; + is_registered_state(G),nb_bound(G,S),is_valid_nb_state(S). + + +:- multifile(state_type_method/3). +:- dynamic(state_type_method/3). +state_type_method(is_nb_state,new_state,init_state). +state_type_method(is_nb_state,clear_state,clear_nb_values). +state_type_method(is_nb_state,add_value,add_nb_value). +state_type_method(is_nb_state,remove_value,'change-state!'). +state_type_method(is_nb_state,replace_value,replace_nb_value). +state_type_method(is_nb_state,value_count,value_nb_count). +state_type_method(is_nb_state,'get-state','get-state'). +state_type_method(is_nb_state,value_iter,value_nb_iter). +%state_type_method(is_nb_state,query,state_nb_query). + +% Clear all values from a state +clear_nb_values(StateNameOrInstance) :- + fetch_or_create_state(StateNameOrInstance, State), + nb_setarg(1, State, []). + + + +% Function to confirm if a term represents a state +is_valid_nb_state(State):- compound(State),compound_name_arity(State,'State',N),N>0. + +% Find the original name of a given state +state_original_name(State, Name) :- + is_registered_state(Name), + call_in_shared_space(nb_bound(Name, State)). + +% Register and initialize a new state +init_state(Name) :- + State = 'State'(_,_), + asserta(is_registered_state(Name)), + call_in_shared_space(nb_setval(Name, State)). + +% Change a value in a state +'change-state!'(Depth,Self,StateNameOrInstance, UpdatedValue, Out) :- + fetch_or_create_state(StateNameOrInstance, State), + arg(2, State, Type), + ( (check_type,\+ get_type(Depth,Self,UpdatedValue,Type)) + -> (Out = ['Error', UpdatedValue, 'BadType']) + ; (nb_setarg(1, State, UpdatedValue), Out = State) ). + +% Fetch all values from a state +'get-state'(StateNameOrInstance, Values) :- + fetch_or_create_state(StateNameOrInstance, State), + arg(1, State, Values). + +'new-state'(Depth,Self,Init,'State'(Init, Type)):- check_type->get_type(Depth,Self,Init,Type);true. + +'new-state'(Init,'State'(Init, Type)):- check_type->get_type(10,'&self',Init,Type);true. + +fetch_or_create_state(Name):- fetch_or_create_state(Name,_). +% Fetch an existing state or create a new one + +fetch_or_create_state(State, State) :- is_valid_nb_state(State),!. +fetch_or_create_state(NameOrInstance, State) :- + ( atom(NameOrInstance) + -> (is_registered_state(NameOrInstance) + -> nb_bound(NameOrInstance, State) + ; init_state(NameOrInstance), + nb_bound(NameOrInstance, State)) + ; is_valid_nb_state(NameOrInstance) + -> State = NameOrInstance + ; writeln('Error: Invalid input.') + ), + is_valid_nb_state(State). + +% ================================================================= +% ================================================================= +% ================================================================= +% GET-TYPE +% ================================================================= +% ================================================================= +% ================================================================= + +eval_20(_Eq,_RetType,Depth,Self,['get-types',Val],TypeO):- !, + get_types(Depth,Self,Val,TypeO). + +% use default self +eval_20(Eq,RetType,Depth,Self,['get-type',Val,Self],Type):- current_self(Self), !, + eval_20(Eq,RetType,Depth,Self,['get-type',Val],Type). + +% use other space +eval_20(Eq,RetType,Depth,Self,['get-type',Val,Other],Type):- !, + into_space(Depth,Self,Other,Space), + eval_20(Eq,RetType,Depth,Space,['get-type',Val],Type). + +eval_20(_Eq,_RetType,Depth,Self,['get-type',Val],Type):- is_list(Val), !, + catch_metta_return(get_type(Depth,Self,Val,Type),TypeM), + var(TypeM). + +eval_20(Eq,RetType,Depth,Self,['get-type',Val],TypeO):- !, + if_or_else(get_type(Depth,Self,Val,Type),Type='%Undefined%'), + %term_singletons(Type,[]), + %Type\==[], Type\==Val,!, + do_expander(Eq,RetType,Type,TypeO). + +% eval_20(Eq,RetType,Depth,Self,['get-type-space',Other,Val],Type):- !, +% into_space(Depth,Self,Other,Space), +% eval_20(Eq,RetType,Depth,Space,['get-type',Val],Type). + +eval_20(Eq,RetType,Depth,Self,['length',L],Res):- !, eval_args(Eq,RetType,Depth,Self,L,LL), !, (is_list(LL)->length(LL,Res);Res=1). +eval_20(Eq,RetType,Depth,Self,['CountElement',L],Res):- !, eval_args(Eq,RetType,Depth,Self,L,LL), !, (is_list(LL)->length(LL,Res);Res=1). + +eval_20(_Eq,_RetType,_Depth,_Self,['get-metatype',Val],TypeO):- !, + 'get-metatype'(Val,TypeO). + +'get-metatype'(Val,Type):- get_metatype0(Val,Was),!,Type=Was. + get_metatype0(Val,'Variable'):- var(Val),!. + get_metatype0(Val,Type):- symbol(Val), !, get_symbol_metatype(Val,Type). + get_metatype0(Val,'Expression'):- is_list(Val),!. +get_metatype0(_Val,'Grounded'). + +get_symbol_metatype(Val,Type):- get_type(Val,Want),get_symbol_metatype(Val,Want,Type). +get_symbol_metatype(_Vl,'Bool','Grounded'). +get_symbol_metatype(Val,_Want,Type):- nb_current(Val,NewVal),'get-metatype'(NewVal,Type). +get_symbol_metatype(_Vl,'%Undefined%','Symbol'). +get_symbol_metatype(_Vl,_Want,'Grounded'). + +% ================================================================= +% ================================================================= +% ================================================================= +% STRINGS +% ================================================================= +% ================================================================= +% ================================================================= + +as_metta_char(X,'#\\'(X)). + +eval_20(Eq,RetType,Depth,Self,['stringToChars',String],Chars):- !, eval_args(Eq,RetType,Depth,Self,String,SS), string_chars(SS,Chars0), maplist(as_metta_char,Chars0,Chars). +eval_20(Eq,RetType,Depth,Self,['charsToString',Chars],String):- !, eval_args(Eq,RetType,Depth,Self,Chars,CC), maplist(as_metta_char,CC0,CC), string_chars(String,CC0). + +% We deal with indexing, but not formatting (the stuff following the ':')(yet) +% https://doc.rust-lang.org/std/fmt/ used as a reference + +format_args_get_index([C|FormatRest1], FormatRest2, Index2) :- char_code(C, Ccode), Ccode >= 48, Ccode =< 57, !, % in the range ['0'..'9'] + Index1 is Ccode-48, + format_args_get_index1(FormatRest1, FormatRest2, Index1, Index2). +format_args_get_index(FormatRest, FormatRest, none). + +% have at least one digit already. This is separate from format_args_get_index to distinguish {} and {0} cases +format_args_get_index1([C|FormatRest1], FormatRest2, Index1, Index3) :- char_code(C, Ccode), Ccode >= 48, Ccode =< 57, !, % in the range ['0'..'9'] + Index2 is (Index1*10)+(Ccode-48), + format_args_get_index1(FormatRest1, FormatRest2, Index2, Index3). +format_args_get_index1(FormatRest, FormatRest, Index, Index). + +% Placeholder to deal with formatting {:} later +format_args_get_format(FormatRest, FormatRest, _). + +format_args_write(Arg,_) :- string(Arg), !, write(Arg). +format_args_write('#\\'(Arg),_) :- !, write(Arg). +format_args_write(Arg,_) :- write_src_woi(Arg). + +format_nth_args([], _, _). +format_nth_args(['{','{'|FormatRest], Iterator, Args) :- !, put('{'), format_nth_args(FormatRest, Iterator, Args). % escaped +format_nth_args(['}','}'|FormatRest], Iterator, Args) :- !, put('}'), format_nth_args(FormatRest, Iterator, Args). % escaped +format_nth_args(['{'|FormatRest1], Iterator1, Args) :- + format_args_get_index(FormatRest1, FormatRest2, Index), + format_args_get_format(FormatRest2, ['}'|FormatRest3], Format), + % check that the closing '}' is not escaped with another '}' + ((FormatRest3=[] ; ((FormatRest3=[C|_],C\='}')) )), + % The Rust behaviour of advancing the iterator if an index is not specified + (((Index == none)) + -> ((nth0(Iterator1,Args,Arg),Iterator2 is Iterator1+1)) + ; ((nth0(Index,Args,Arg), Iterator2 is Iterator1))), + format_args_write(Arg,Format), + format_nth_args(FormatRest3, Iterator2, Args). +format_nth_args([C|FormatRest], Iterator, Args) :- put(C), format_nth_args(FormatRest, Iterator, Args). + +eval_20(Eq,RetType,Depth,Self,['format-args',Format,Args],Result):- + eval_args(Eq,RetType,Depth,Self,Format,EFormat), + eval_args(Eq,RetType,Depth,Self,Args,EArgs), + is_list(EArgs),string_chars(EFormat, FormatChars), !, + user_io(with_output_to_str( Result, format_nth_args(FormatChars, 0, EArgs))). +eval_20(Eq,RetType,Depth,Self,['format-args',_Fmt,Args],_Result) :- + eval_args(Eq,RetType,Depth,Self,Args,EArgs), + \+ is_list(EArgs),!,throw_metta_return(['Error',Args,'BadType']). + +eval_20(Eq,RetType,_Depth,_Self,['flip'],Bool):- + ignore(RetType='Bool'), !, as_tf(random(0,2,0),Bool), + check_returnval(Eq,RetType,Bool). + +eval_20( Eq, RetType, Depth, Self, [ 'parse' , L ] , Exp ):- !, + eval_args( Eq, RetType, Depth, Self, L, Str ), + once(parse_sexpr_metta1( Str, Exp )). + +eval_20( _Eq, _RetType, _Depth, _Self, [ 'repr' , L ] , Sxx ):- !, + %eval_args( Eq, RetType, Depth, Self, L, Lis2 ), + with_output_to_str( Sxx , write_src_woi( L ) ). + +eval_20( Eq, RetType, Depth, Self, [ 'output-to-string' , L ] , Sxx ):- !, + with_output_to_str( Sxx , eval_args( Eq, RetType, Depth, Self, L, _ )). + +% ================================================================= +% ================================================================= +% ================================================================= +% IMPORT/BIND +% ================================================================= +% ================================================================= +% ================================================================= +nb_bind(Name,Value):- nb_current(Name,Was),same_term(Value,Was),!. +nb_bind(Name,Value):- call_in_shared_space(nb_setval(Name,Value)),!. +eval_20(_Eq,_RetType,_Dpth,_Slf,['extend-py!',Module],Res):- !, 'extend-py!'(Module,Res). +eval_20(Eq,RetType,Depth,Self,['register-module!',Dir],RetVal):- !, + eval_20(Eq,'Directory',Depth,Self,Dir,Folder), + register_module(Self,Folder),!, + %Folder = RetVal, + ignore(make_nop(RetType,Self,RetVal)). +eval_20(Eq,RetType,Depth,Self,['register-module!',Name,Dir],RetVal):- !, + eval_20(Eq,'Symbol',Depth,Self,Name,ModuleName), + eval_20(Eq,'Directory',Depth,Self,Dir,Folder), + register_module(Self,ModuleName,Folder),!, + %Folder = RetVal, + ignore(make_nop(RetType,Self,RetVal)). + + +eval_20(Eq,RetType,Depth,Self,['include!',Other,File],RetVal):- !, + into_space(Depth,Self,Other,Space), include_metta(Space,File),!, + make_nr(Eq,RetType,RetVal). +% from metta in Rust +eval_20(Eq,RetType,_Depth,Self,['include',File],RetVal):- !, + include_metta(Self,File),!, + make_nr(Eq,RetType,RetVal). +eval_20(Eq,RetType,Depth,Self,['load-ascii',Other,File],RetVal):- !, + into_space(Depth,Self,Other,Space), include_metta(Space,File),!, + make_nr(Eq,RetType,RetVal). +eval_20(Eq,RetType,Depth,Self,['import!',Other,File],RetVal):- !, + into_space(Depth,Self,Other,Space), import_metta(Space,File),!, + make_nr(Eq,RetType,RetVal). +eval_20(Eq,RetType,Depth,Self,['load-file!',Other,File],RetVal):- !, + into_space(Depth,Self,Other,Space), load_metta(Space,File),!, + make_nr(Eq,RetType,RetVal). + +make_nr(_Eq,_RetType,RetVal):- as_nop(RetVal). + + + + +eval_20(Eq,RetType,_Depth,_Slf,['bind!',Other,['new-space']],RetVal):- atom(Other),!, + assert(was_asserted_space(Other)), + make_nop(RetType,[],RetVal), check_returnval(Eq,RetType,RetVal). +eval_20(Eq,RetType,Depth,Self,['bind!',Other,Expr],RetVal):- !, + must_det_ll((into_name(Self,Other,Name),!,eval_args(Eq,RetType,Depth,Self,Expr,Value), + nb_bind(Name,Value), make_nop(RetType,Value,RetVal))), + check_returnval(Eq,RetType,RetVal). +eval_20(Eq,RetType,Depth,Self,['pragma!',Other,Expr],RetVal):- !, + must_det_ll((into_name(Self,Other,Name),nd_ignore((eval_args(Eq,RetType,Depth,Self,Expr,Value), + set_option_value_interp(Name,Value))), make_nop(RetType,Value,RetVal), + check_returnval(Eq,RetType,RetVal))). +eval_20(Eq,RetType,_Dpth,Self,['transfer!',File],RetVal):- !, must_det_ll((include_metta(Self,File), + make_nop(RetType,Self,RetVal),check_returnval(Eq,RetType,RetVal))). + + +eval_20(Eq,RetType,Depth,Self,['save-space!',Other,File],RetVal):- !, + (( into_space(Depth,Self,Other,Space), 'save-space!'(Space,File),!,make_nop(RetType,RetVal))), + check_returnval(Eq,RetType,RetVal). + + +nd_ignore(Goal):- call(Goal)*->true;true. + + +% ================================================================= +% ================================================================= +% ================================================================= +% AND/OR +% ================================================================= +% ================================================================= +% ================================================================= + +is_True(T):- atomic(T), T\=='False', T\==0. + +is_and(S):- \+ atom(S),!,fail. +%is_and(','). +is_and(S):- is_and(S,_). + +is_and(S,_):- \+ atom(S),!,fail. +%is_and('and','True'). +is_and('and2','True'). +%is_and('#COMMA','True'). %is_and(',','True'). % is_and('And'). + +is_comma(C):- var(C),!,fail. +is_comma(','). +is_comma('{}'). + +bool_xor(A,B) :- (A == 'True'; B == 'True'), \+ (A == B). + +eval_20(Eq,RetType,Depth,Self,['and',X,Y],TF):- !, + as_tf(( (eval_args_true(Eq,RetType,Depth,Self,X), + eval_args_true(Eq,RetType,Depth,Self,Y))), TF). + + +eval_20(Eq,RetType,Depth,Self,['or',X,Y],TF):- !, + as_tf(( (eval_args_true(Eq,RetType,Depth,Self,X); + eval_args_true(Eq,RetType,Depth,Self,Y))), TF). + +eval_20(Eq,RetType,Depth,Self,['xor',X,Y],TF):- !, + as_tf( (eval_args_true(Eq,RetType,Depth,Self,X)), XTF), % evaluate X + as_tf( (eval_args_true(Eq,RetType,Depth,Self,Y)), YTF), % evaluate Y + as_tf( (bool_xor(XTF,YTF)) , TF). + + +eval_20(Eq,RetType,Depth,Self,['not',X],TF):- !, + as_tf(( \+ eval_args_true(Eq,RetType,Depth,Self,X)), TF). + + +% ================================================ +% === function / return of minimal metta +eval_20(Eq,RetType,Depth,Self,['function',X],Res):- !, gensym(return_,RetF), + RetUnit=..[RetF,Res], + catch(locally(nb_setval('$rettag',RetF), + eval_args(Eq,RetType,Depth,Self,X, Res)), + return(RetUnitR),RetUnitR=RetUnit). +eval_20(Eq,RetType,Depth,Self,['return',X],_):- !, + nb_current('$rettag',RetF),RetUnit=..[RetF,Val], + eval_args(Eq,RetType,Depth,Self,X, Val), throw(return(RetUnit)). +% ================================================ + +% ================================================ +% === catch / throw of mettalog +eval_20(Eq,RetType,Depth,Self,['catch',X,EX,Handler],Res):- !, + catch(eval_args(Eq,RetType,Depth,Self,X, Res), + EX,eval_args(Eq,RetType,Depth,Self,Handler, Res)). +eval_20(Eq,_TRetType,Depth,Self,['throw',X],_):- !, + eval_args(Eq,_RetType,Depth,Self,X, Val), throw(Val). +% ================================================ + +eval_20(Eq,RetType,Depth,Self,['number-of',X],N):- !, + findall_eval(Eq,RetType,Depth,Self,X,ResL), + length(ResL,N), ignore(RetType='Number'). + +eval_20(Eq,RetType,Depth,Self,['number-of',X,N],TF):- !, + findall_eval(Eq,RetType,Depth,Self,X,ResL), + length(ResL,N), true_type(Eq,RetType,TF). + +eval_20(Eq,RetType,Depth,Self,['findall!',Template,X],ResL):- !, + findall(Template,eval_args(Eq,RetType,Depth,Self,X,_),ResL). + + + +eval_20(Eq,RetType,Depth,Self,['limit!',N,E],R):- !, eval_20(Eq,RetType,Depth,Self,['limit',N,E],R). +eval_20(Eq,RetType,Depth,Self,['limit',NE,E],R):- !, + eval_args('=','Number',Depth,Self,NE,N), + limit(N,eval_ne(Eq,RetType,Depth,Self,E,R)). + +eval_20(Eq,RetType,Depth,Self,['offset!',N,E],R):- !, eval_20(Eq,RetType,Depth,Self,['offset',N,E],R). +eval_20(Eq,RetType,Depth,Self,['offset',NE,E],R):- !, + eval_args('=','Number',Depth,Self,NE,N), + offset(N,eval_ne(Eq,RetType,Depth,Self,E,R)). + +eval_20(Eq,RetType,Depth,Self,['max-time!',N,E],R):- !, eval_20(Eq,RetType,Depth,Self,['max-time',N,E],R). +eval_20(Eq,RetType,Depth,Self,['max-time',NE,E],R):- !, + eval_args('=','Number',Depth,Self,NE,N), + cwtl(N,eval_ne(Eq,RetType,Depth,Self,E,R)). + + +eval_20(Eq,RetType,Depth,Self,['call-cleanup!',NE,E],R):- !, + call_cleanup(eval_args(Eq,RetType,Depth,Self,NE,R), + eval_args(Eq,_U_,Depth,Self,E,_)). + +eval_20(Eq,RetType,Depth,Self,['setup-call-cleanup!',S,NE,E],R):- !, + setup_call_cleanup( + eval_args(Eq,_,Depth,Self,S,_), + eval_args(Eq,RetType,Depth,Self,NE,R), + eval_args(Eq,_,Depth,Self,E,_)). + +eval_20(Eq,RetType,Depth,Self,['with-output-to!',S,NE],R):- !, + eval_args(Eq,'Sink',Depth,Self,S,OUT), + with_output_to_stream(OUT, + eval_args(Eq,RetType,Depth,Self,NE,R)). + + + +% ================================================================= +% ================================================================= +% ================================================================= +% DATA FUNCTOR +% ================================================================= +% ================================================================= +% ================================================================= +eval20_failked(Eq,RetType,Depth,Self,[V|VI],[V|VO]):- + nonvar(V),is_metta_data_functor(V),is_list(VI),!, + maplist(eval_args(Eq,RetType,Depth,Self),VI,VO). + + +% ================================================================= +% ================================================================= +% ================================================================= +% EVAL FAILED +% ================================================================= +% ================================================================= +% ================================================================= + +eval_failed(Depth,Self,T,TT):- + eval_failed('=',_RetType,Depth,Self,T,TT). + +finish_eval(Depth,Self,T,TT):- + finish_eval('=',_RetType,Depth,Self,T,TT). + +eval_failed(Eq,RetType,Depth,Self,T,TT):- + finish_eval(Eq,RetType,Depth,Self,T,TT). + +%finish_eval(Eq,RetType,_,_,X,X):-!. + +finish_eval(_Eq,_RetType,_Dpth,_Slf,T,TT):- var(T),!,TT=T. +finish_eval(_Eq,_RetType,_Dpth,_Slf,[],[]):-!. +finish_eval(Eq,RetType,Depth,Self,[F|LESS],Res):- + once(eval_selfless(Eq,RetType,Depth,Self,[F|LESS],Res)),fake_notrace([F|LESS]\==Res),!. +%finish_eval(Eq,RetType,Depth,Self,[V|Nil],[O]):- Nil==[], once(eval_args(Eq,RetType,Depth,Self,V,O)),V\=@=O,!. +finish_eval(Eq,RetType,Depth,Self,[H|T],[HH|TT]):- !, + eval_args(Depth,Self,H,HH), + finish_eval(Eq,RetType,Depth,Self,T,TT). +finish_eval(_Eq,_RetType,Depth,Self,T,TT):- eval_args(Depth,Self,T,TT). + + %eval_args(Eq,RetType,Depth,Self,X,Y):- eval_20(Eq,RetType,Depth,Self,X,Y)*->true;Y=[]. + +%eval_20(Eq,RetType,Depth,_,_,_):- Depth<1,!,fail. +%eval_20(Eq,RetType,Depth,_,X,Y):- Depth<3, !, ground(X), (Y=X). +%eval_20(Eq,RetType,_Dpth,_Slf,X,Y):- self_eval(X),!,Y=X. + +% Kills zero arity functions eval_20(Eq,RetType,Depth,Self,[X|Nil],[Y]):- Nil ==[],!,eval_args(Eq,RetType,Depth,Self,X,Y). + + + +% ================================================================= +% ================================================================= +% ================================================================= +% METTLOG PREDEFS +% ================================================================= +% ================================================================= +% ================================================================= + + +eval_20(Eq,RetType,Depth,Self,['maplist!',Pred,ArgL1],ResL):- !, + maplist(eval_pred(Eq,RetType,Depth,Self,Pred),ArgL1,ResL). +eval_20(Eq,RetType,Depth,Self,['maplist!',Pred,ArgL1,ArgL2],ResL):- !, + maplist(eval_pred(Eq,RetType,Depth,Self,Pred),ArgL1,ArgL2,ResL). +eval_20(Eq,RetType,Depth,Self,['maplist!',Pred,ArgL1,ArgL2,ArgL3],ResL):- !, + maplist(eval_pred(Eq,RetType,Depth,Self,Pred),ArgL1,ArgL2,ArgL3,ResL). + + eval_pred(Eq,RetType,Depth,Self,Pred,Arg1,Res):- + eval_args(Eq,RetType,Depth,Self,[Pred,Arg1],Res). + eval_pred(Eq,RetType,Depth,Self,Pred,Arg1,Arg2,Res):- + eval_args(Eq,RetType,Depth,Self,[Pred,Arg1,Arg2],Res). + eval_pred(Eq,RetType,Depth,Self,Pred,Arg1,Arg2,Arg3,Res):- + eval_args(Eq,RetType,Depth,Self,[Pred,Arg1,Arg2,Arg3],Res). + +eval_20(Eq,RetType,Depth,Self,['concurrent-maplist!',Pred,ArgL1],ResL):- !, + metta_concurrent_maplist(eval_pred(Eq,RetType,Depth,Self,Pred),ArgL1,ResL). +eval_20(Eq,RetType,Depth,Self,['concurrent-maplist!',Pred,ArgL1,ArgL2],ResL):- !, + concurrent_maplist(eval_pred(Eq,RetType,Depth,Self,Pred),ArgL1,ArgL2,ResL). +eval_20(Eq,RetType,Depth,Self,['concurrent-maplist!',Pred,ArgL1,ArgL2,ArgL3],ResL):- !, + concurrent_maplist(eval_pred(Eq,RetType,Depth,Self,Pred),ArgL1,ArgL2,ArgL3,ResL). +eval_20(Eq,RetType,Depth,Self,['concurrent-forall!',Gen,Test|Options],NoResult):- !, + maplist(s2p,Options,POptions), + call(thread:concurrent_forall( + user:eval_ne(Eq,RetType,Depth,Self,Gen,_), + user:forall(eval_args(Eq,RetType,Depth,Self,Test,_),true), + POptions)), + make_nop(RetType,[],NoResult). + +eval_20(Eq,RetType,Depth,Self,['hyperpose',ArgL],Res):- !, metta_hyperpose(Eq,RetType,Depth,Self,ArgL,Res). + + +% ================================================================= +% ================================================================= +% ================================================================= +% METTLOG COMPILER PREDEFS +% ================================================================= +% ================================================================= +% ================================================================= + + +eval_20(_Eq,_RetType,_Dpth,_Slf,['predicate-arity',F],A):- !, + eval_for('Symbol',F,FF), + predicate_arity(FF,A). +eval_20(_Eq,_RetType,_Dpth,_Slf,['function-arity',F],A):- !, + eval_for('Symbol',F,FF), + function_arity(FF,A). + + + +eval_20(_Eq,_RetType,_Depth,_Self,['compile-space!'],Res):- !, + as_nop('compile-space!'(_), Res). + +eval_20(_Eq,_RetType,_Depth,_Self,['compile-space!',Space],Res):- !, + as_nop('compile-space!'(Space), Res). + +'compile-space!'(X,TF):- + as_tf('compile-space!'(X), TF). + +'compile-space!'(KB):- + load_ontology, + %((ignore(pfcRemove(do_compile_space(X))), + % pfcWatch, + pfcAdd_Now(do_compile_space(KB)), + forall(function_arity(KB,F,_Len),'compile!'(F)), + % pfcNoWatch, + true,!. + + +eval_20(_Eq,_RetType,_Depth,_Self,['compile!'],Res):- !, + as_nop('compile!'(_), Res). + +eval_20(_Eq,_RetType,_Depth,_Self,['compile!',Space],Res):- !, + as_nop('compile!'(Space), Res). + +'compile!'(X,TF):- + as_tf('compile!'(X), TF). + +'compile!'(X):- X=='S',!. +'compile!'(X):- + load_ontology, + current_self(KB), + %((ignore(pfcRemove(do_compile(KB,X,_))), + % pfcWatch, + pfcAdd_Now(do_compile(KB,X,_)), + if_t( \+ current_predicate(X/_), + forall(metta_defn(KB,[X | Args] ,BodyFn), + compile_metta_defn(KB,X,Len,Args,BodyFn,_Clause))), + if_t( \+ current_predicate(X/_), + (ignore(nortrace),forall(metta_defn(KB,[X | Args] ,BodyFn), + (trace,compile_metta_defn(KB,X,Len,Args,BodyFn,_ClauseU))))), + % pfcNoWatch, + true,!, + notrace(catch((wdmsg(?-listing(X)),listing(X)),E, + (!,write_src(E),fail))),!. + + +empty('Empty'). +','(A,B,(AA,BB)):- eval_args(A,AA),eval_args(B,BB). +':'(A,B,[':',A,B]). +'<'(A,B,TFO):- as_tf(A'(A,B,TFO):- as_tf(A Len,!, + append(AdjustedM1,[Res],Adjusted), + Call =.. [Pred|Adjusted], + %indentq2(2,call_pl_rv(Call)), + catch_warn(efbug(show_call,rtrace_on_error(Call))). + +eval_201(_Eq,_RetType,_Depth,_Self,Pred,Adjusted,_Arity,_Len,Res):- + Call =.. [Pred|Adjusted], + %indentq2(2,call_pl_tf(Call)), + catch_warn(efbug(show_call,eval_call(rtrace_on_error(Call),Res))). + + + +% ================================================================= +% ================================================================= +% ================================================================= +% METTLOG EXTRA PREDEFS +% ================================================================= +% ================================================================= +% ================================================================= + +%eval_20(Eq,RetType,_Dpth,_Slf,['trace!',A],A):- !, format('~N'),fbug(A),format('~N'). + +eval_20(Eq,RetType,_Dpth,_Slf,List,YY):- is_list(List),maplist(self_eval,List),List=[H|_], \+ atom(H), !,Y=List,do_expander(Eq,RetType,Y,YY). + +eval_20(Eq,_ListOfRetType,Depth,Self,['TupleConcat',A,B],OO):- fail, !, + eval_args(Eq,RetType,Depth,Self,A,AA), + eval_args(Eq,RetType,Depth,Self,B,BB), + append(AA,BB,OO). +eval_20(Eq,OuterRetType,Depth,Self,['range',A,B],OO):- fail, (is_list(A);is_list(B)), + ((eval_args(Eq,RetType,Depth,Self,A,AA), + eval_args(Eq,RetType,Depth,Self,B,BB))), + ((AA+BB)\=@=(A+B)), + eval_20(Eq,OuterRetType,Depth,Self,['range',AA,BB],OO),!. + + +/* + fromNumber(Var1,Var2):- var(Var1),var(Var2),!, + freeze(Var1,fromNumber(Var1,Var2)), + freeze(Var2,fromNumber(Var1,Var2)). +fromNumber(0,'Z'):-!. +fromNumber(N,['S',Nat]):- integer(N), M is N -1,!,fromNumber(M,Nat). + +eval_20(Eq,RetType,Depth,Self,['fromNumber',NE],RetVal):- !, + eval_args('=','Number',Depth,Self,NE,N), + fromNumber(N,RetVal), check_returnval(Eq,RetType,RetVal). +*/ + +%% lazy_union(:P2, +E1_Call1, +E2_Call2, -E) is nondet. +% - Performs a union operation using lazy evaluation +% Arguments: +% - P2: Any arity 2 predicate +% - E1^Call1: The first goal (Call1) generating elements (E1) +% - E2^Call2: The second goal (Call2) generating elements (E2) +% - E: The resulting element that is part of the union of the two sets +lazy_union(P2, E1^Call1, E2^Call2, E) :- + % Step 1: Use lazy_findall/3 to declare that all elements satisfying Call1 are supposedly in List1 + lazy_findall(E1, Call1, List1), + % Step 2: Use lazy_findall/3 to declare that all elements satisfying Call2 are supposedly in List2 + lazy_findall(E2, Call2, List2), + % Step 3: Perform the union logic + ( % Case 1: If E is a member of List1, include it in the result + member(E, List1) + % Case 2: Otherwise, check if E is a member of List2 + % Additionally, ensure that E does not already exist in List1 + ; (member(E, List2), \+ (member(E1, List1), call(P2, E1, E))) + ). + + +variant_by_type(X,Y):- var(X),!,X==Y. +variant_by_type(X,Y):- X=@=Y. + +eval_20(Eq,RetType,Depth,Self,['unique',Eval],RetVal):- !, + term_variables(Eval+RetVal,Vars), + no_repeats_var(YY), + eval_20(Eq,RetType,Depth,Self,Eval,RetVal),YY=Vars. + +eval_20(Eq,RetType,Depth,Self,['pred-unique',P2,Eval],RetVal):- !, + no_repeats_var(P2,YY), + eval_20(Eq,RetType,Depth,Self,Eval,RetVal),YY=RetVal. + + +eval_20(Eq,RetType,Depth,Self,['subtraction',Eval1,Eval2],RetVal):- !, + lazy_subtraction(variant_by_type,RetVal1^eval_args(Eq,RetType,Depth,Self,Eval1,RetVal1), + RetVal2^eval_args(Eq,RetType,Depth,Self,Eval2,RetVal2), + RetVal). + +eval_20(Eq,RetType,Depth,Self,['pred-subtraction',P2,Eval1,Eval2],RetVal):- !, + lazy_subtraction(P2,RetVal1^eval_args(Eq,RetType,Depth,Self,Eval1,RetVal1), + RetVal2^eval_args(Eq,RetType,Depth,Self,Eval2,RetVal2), + RetVal). + +eval_20(Eq,RetType,Depth,Self,['union',Eval1,Eval2],RetVal):- !, + lazy_union(variant_by_type,RetVal1^eval_args(Eq,RetType,Depth,Self,Eval1,RetVal1), + RetVal2^eval_args(Eq,RetType,Depth,Self,Eval2,RetVal2), + RetVal). + +eval_20(Eq,RetType,Depth,Self,['pred-union',P2,Eval1,Eval2],RetVal):- !, + lazy_union(P2,RetVal1^eval_args(Eq,RetType,Depth,Self,Eval1,RetVal1), + RetVal2^eval_args(Eq,RetType,Depth,Self,Eval2,RetVal2), + RetVal). + +%eval_20(Eq,RetType,_Dpth,_Slf,['py-list',Atom_list],CDR_Y):- +% !, Atom=[_|CDR],!,do_expander(Eq,RetType,Atom_list, CDR_Y ). + +eval_20(Eq,RetType,Depth,Self,['intersection',Eval1,Eval2],RetVal):- !, + lazy_intersection(variant_by_type,RetVal1^eval_args(Eq,RetType,Depth,Self,Eval1,RetVal1), + RetVal2^eval_args(Eq,RetType,Depth,Self,Eval2,RetVal2), + RetVal). + +eval_20(Eq,RetType,Depth,Self,['pred-intersection',P2,Eval1,Eval2],RetVal):- !, + lazy_intersection(P2,RetVal1^eval_args(Eq,RetType,Depth,Self,Eval1,RetVal1), + RetVal2^eval_args(Eq,RetType,Depth,Self,Eval2,RetVal2), + RetVal). + +%% lazy_intersection(:P2, +E1_Call1, +E2_Call2, -E) is nondet. +% - Performs a intersection operation using lazy evaluation. +% - It intersects elements generated by Call2 from those generated by Call1. +% Arguments: +% - P2: Any arity 2 predicate +% - E1^Call1: The first goal (Call1) generating elements (E1). +% - E2^Call2: The second goal (Call2) generating elements (E2). +% - E: The resulting element after subtracting elements of the second set from the first set. +lazy_intersection(P2, E1^Call1, E2^Call2, E1) :- + % Step 1: Evaluate Call1 to generate E1 + call(Call1), + % Step 2: Use lazy_findall/3 to declare that all elements satisfying Call2 are supposedly in List2 + lazy_findall(E2, Call2, List2), + % Step 3: Perform the intersection logic + % Only return E1 if it is not a member of List2 + member(E2, List2), call(P2,E1,E2). + + +%% lazy_subtraction(:P2, +E1_Call1, +E2_Call2, -E) is nondet. +% - Performs a subtraction operation using lazy evaluation. +% - It subtracts elements generated by Call2 from those generated by Call1. +% Arguments: +% - P2: Any arity 2 predicate +% - E1^Call1: The first goal (Call1) generating elements (E1). +% - E2^Call2: The second goal (Call2) generating elements (E2). +% - E: The resulting element after subtracting elements of the second set from the first set. +lazy_subtraction(P2,E1^Call1, E2^Call2, E1) :- + % Step 1: Evaluate Call1 to generate E1 + call(Call1), + % Step 2: Use lazy_findall/3 to declare that all elements satisfying Call2 are supposedly in List2 + lazy_findall(E2, Call2, List2), + % Step 3: Perform the subtraction logic + % Only return E1 if it is not a member of List2 + \+ (member(E2, List2), call(P2, E1, E2)). + + +eval_20(Eq,RetType,Depth,Self,PredDecl,Res):- + Do_more_defs = do_more_defs(true), + clause(eval_21(Eq,RetType,Depth,Self,PredDecl,Res),Body), + Do_more_defs == do_more_defs(true), + call_ndet(Body,DET), + nb_setarg(1,Do_more_defs,false), + (DET==true -> ! ; true). + +eval_21(_Eq,_RetType,_Depth,_Self,['fb-member',Res,List],TF):-!, as_tf(fb_member(Res,List),TF). +eval_21(_Eq,_RetType,_Depth,_Self,['fb-member',List],Res):-!, fb_member(Res,List). + + +eval_21(Eq,RetType,Depth,Self,['CollapseCardinality',List],Len):-!, + findall_eval(Eq,RetType,Depth,Self,List,Res), + length(Res,Len). +/* +eval_21(_Eq,_RetType,_Depth,_Self,['TupleCount', [N]],N):- number(N),!. + + +*/ +eval_21(Eq,_RetType,Depth,Self,['Tuple-Count',List],Len):- fail,!, + (\+ is_list(List)->findall_eval(Eq,_,Depth,Self,List,Res);Res=List),!, + length(Res,Len). +eval_21(_Eq,_RetType,_Depth,_Self,['tuple-count',List],Len):-!, + length(List,Len). + + +%eval_20(Eq,RetType,Depth,Self,['colapse'|List], Flat):- !, maplist(eval_args(Eq,RetType,Depth,Self),List,Res),flatten(Res,Flat). + +eval_20(_Eq,_OuterRetType,_Depth,_Self,[P,_,B],_):-P=='/',B==0,!,fail. + + +eval_20(Eq,RetType,Depth,Self,['CountElement',L],Res):- !, eval_args(Eq,RetType,Depth,Self,L,LL), !, (is_list(LL)->length(LL,Res);Res=1),check_returnval(Eq,RetType,Res). +eval_20(Eq,RetType,_Dpth,_Slf,['make_list',List],MettaList):- !, into_metta_cons(List,MettaList),check_returnval(Eq,RetType,MettaList). + +simple_math(Var):- attvar(Var),!,fail. +simple_math([F|XY]):- !, atom(F),atom_length(F,1), is_list(XY),maplist(simple_math,XY),!. +simple_math(X):- number(X),!. + + +eval_20(_Eq,_RetType,_Depth,_Self,['call-string!',Str],NoResult):- !,'call-string!'(Str,NoResult). + +'call-string!'(Str,NoResult):- + read_term_from_atom(Str,Term,[variables(Vars)]),!, + call(Term),NoResult=Vars. + + +/* +into_values(List,Many):- List==[],!,Many=[]. +into_values([X|List],Many):- List==[],is_list(X),!,Many=X. +into_values(Many,Many). +eval_40(Eq,RetType,_Dpth,_Slf,Name,Value):- atom(Name), nb_current(Name,Value),!. +*/ +% Macro Functions +%eval_20(Eq,RetType,Depth,_,_,_):- Depth<1,!,fail. +/* +eval_40(_Eq,_RetType,Depth,_,X,Y):- Depth<3, !, fail, ground(X), (Y=X). +eval_40(Eq,RetType,Depth,Self,[F|PredDecl],Res):- + fail, + Depth>1, + fake_notrace((sub_sterm1(SSub,PredDecl), ground(SSub),SSub=[_|Sub], is_list(Sub), maplist(atomic,SSub))), + eval_args(Eq,RetType,Depth,Self,SSub,Repl), + fake_notrace((SSub\=Repl, subst(PredDecl,SSub,Repl,Temp))), + eval_args(Eq,RetType,Depth,Self,[F|Temp],Res). +*/ +% ================================================================= +% ================================================================= +% ================================================================= +% PLUS/MINUS +% ================================================================= +% ================================================================= +% ================================================================= +eval_40(Eq,RetType,Depth,Self,LESS,Res):- + ((((eval_selfless(Eq,RetType,Depth,Self,LESS,Res),fake_notrace(LESS\==Res))))),!. + +eval_40(Eq,RetType,Depth,Self,['+',N1,N2],N):- number(N1), + eval_args(Eq,RetType,Depth,Self,N2,N2Res), fake_notrace(catch_err(N is N1+N2Res,_E,(set_last_error(['Error',N2Res,'Number']),fail))). +eval_40(Eq,RetType,Depth,Self,['-',N1,N2],N):- number(N1), + eval_args(Eq,RetType,Depth,Self,N2,N2Res), fake_notrace(catch_err(N is N1-N2Res,_E,(set_last_error(['Error',N2Res,'Number']),fail))). +eval_40(Eq,RetType,Depth,Self,['*',N1,N2],N):- number(N1), + eval_args(Eq,RetType,Depth,Self,N2,N2Res), fake_notrace(catch_err(N is N1*N2Res,_E,(set_last_error(['Error',N2Res,'Number']),fail))). + +eval_20(_Eq,_RetType,_Depth,_Self,['rust',Bang,PredDecl],Res):- Bang == '!', !, + rust_metta_run(exec(PredDecl),Res), nop(write_src(res(Res))). +eval_20(_Eq,_RetType,_Depth,_Self,['rust',PredDecl],Res):- !, + rust_metta_run((PredDecl),Res), nop(write_src(res(Res))). +eval_20(_Eq,_RetType,_Depth,_Self,['rust!',PredDecl],Res):- !, + rust_metta_run(exec(PredDecl),Res), nop(write_src(res(Res))). + +eval_70(_Eq,_RetType,_Depth,_Self,['py-atom',Arg],Res):- !, + must_det_ll((py_atom(Arg,Res))). +eval_40(_Eq,_RetType,_Depth,_Self,['py-atom',Arg,Type],Res):- !, + must_det_ll((py_atom_type(Arg,Type,Res))). +eval_40(_Eq,_RetType,_Depth,_Self,['py-dot',Arg1,Arg2],Res):- !, + must_det_ll((py_dot([Arg1,Arg2],Res))). +eval_40(_Eq,_RetType,_Depth,_Self,['py-list',Arg],Res):- !, + must_det_ll((py_list(Arg,Res))). +eval_40(_Eq,_RetType,_Depth,_Self,['py-dict',Arg],Res):- !, + must_det_ll((py_dict(Arg,Res))). +eval_40(_Eq,_RetType,_Depth,_Self,['py-tuple',Arg],Res):- !, + must_det_ll((py_tuple(Arg,Res))). +eval_40(_Eq,_RetType,_Depth,_Self,['py-eval',Arg],Res):- !, + must_det_ll((py_eval(Arg,Res))). + +eval_40(Eq,RetType,Depth,Self,['length',L],Res):- !, eval_args(Depth,Self,L,LL), + (is_list(LL)->length(LL,Res);Res=1), + check_returnval(Eq,RetType,Res). + + +eval_20(Eq,RetType,Depth,Self,[P,X|More],YY):- is_list(X),X=[_,_,_],simple_math(X), + eval_selfless_2(X,XX),X\=@=XX,!, eval_20(Eq,RetType,Depth,Self,[P,XX|More],YY). + +/* +eval_40(Eq,RetType,Depth,Self,[P,A,X|More],YY):- is_list(X),X=[_,_,_],simple_math(X), + eval_selfless_2(X,XX),X\=@=XX,!, + eval_40(Eq,RetType,Depth,Self,[P,A,XX|More],YY). +*/ +%eval_40(Eq,RetType,_Dpth,_Slf,['==',X,Y],Res):- !, subst_args(Eq,RetType,_Dpth,_Slf,['==',X,Y],Res). + +eval_40(Eq,RetType,_Dpth,_Slf,[EQ,X,Y],Res):- EQ=='==', !, + suggest_type(RetType,'Bool'), + eq_unify(Eq,_SharedType, X, Y, Res). + +eval_20(_Eq,RetType,_Dpth,_Slf,[EQ,X,Y],TF):- EQ=='===', !, + suggest_type(RetType,'Bool'), + as_tf(X==Y,TF). + +eval_20(_Eq,RetType,_Dpth,_Slf,[EQ,X,Y],TF):- EQ=='====', !, + suggest_type(RetType,'Bool'), + as_tf(same_terms(X,Y),TF). + + +eq_unify(_Eq,_SharedType, X, Y, TF):- as_tf(X=:=Y,TF),!. +eq_unify(_Eq,_SharedType, X, Y, TF):- as_tf( '#='(X,Y),TF),!. +eq_unify( Eq, SharedType, X, Y, TF):- as_tf(eval_until_unify(Eq,SharedType, X, Y), TF). + + +suggest_type(_RetType,_Bool). + +naive_eval_args:- + false. + +eval_41(Eq,RetType,Depth,Self,[AE|More],Res):- naive_eval_args,!, + maplist(must_eval_args(Eq,_,Depth,Self),More,Adjusted), + eval_70(Eq,RetType,Depth,Self,[AE|Adjusted],Res), + check_returnval(Eq,RetType,Res). + +eval_41(Eq,RetType,Depth,Self,AEMore,ResOut):- \+ naive_eval_args,!, + eval_adjust_args(Eq,RetType,ResIn,ResOut,Depth,Self,AEMore,AEAdjusted), + if_trace((e;args), + (AEMore\==AEAdjusted -> color_g_mesg('#773733',indentq2(Depth,AEMore -> AEAdjusted)) + ; nop(indentq2(Depth,same(AEMore))))), + eval_70(Eq,RetType,Depth,Self,AEAdjusted,ResIn), + check_returnval(Eq,RetType,ResOut). + + +eval_20(Eq,RetType,Depth,Self,X,Y):- + (eval_40(Eq,RetType,Depth,Self,X,M)*-> M=Y ; + % finish_eval(Depth,Self,M,Y); + (eval_failed(Depth,Self,X,Y)*->true;X=Y)). +eval_40(Eq,RetType,Depth,Self,AEMore,ResOut):- eval_41(Eq,RetType,Depth,Self,AEMore,ResOut). +eval_70(Eq,RetType,Depth,Self,PredDecl,Res):- + if_or_else(eval_maybe_python(Eq,RetType,Depth,Self,PredDecl,Res), + if_or_else(eval_maybe_host_predicate(Eq,RetType,Depth,Self,PredDecl,Res), + if_or_else(eval_maybe_host_function(Eq,RetType,Depth,Self,PredDecl,Res), + if_or_else(eval_maybe_defn(Eq,RetType,Depth,Self,PredDecl,Res), + eval_maybe_subst(Eq,RetType,Depth,Self,PredDecl,Res))))). + + +eval_all_args:- true_flag. +fail_missed_defn:- true_flag. +fail_on_constructor:- true_flag. + + +eval_adjust_args(Eq,RetType,ResIn,ResOut,Depth,Self,X,Y):- + if_or_else((eval_all_args,eval_adjust_args2(Eq,RetType,ResIn,ResOut,Depth,Self,X,Y)), + eval_adjust_args1(Eq,RetType,ResIn,ResOut,Depth,Self,X,Y)). + +eval_adjust_args1(Eq,RetType,ResIn,ResOut,Depth,Self,[AE|More],[AE|Adjusted]):- + adjust_args_90(Eq,RetType,ResIn,ResOut,Depth,Self,AE,More,Adjusted). +adjust_args_90(Eq,RetType,ResIn,ResOut,Depth,Self,AE,More,Adjusted):- \+ is_debugging(eval_args),!, + adjust_args_9(Eq,RetType,ResIn,ResOut,Depth,Self,AE,More,Adjusted). +adjust_args_90(Eq,RetType,ResIn,ResOut,Depth,Self,AE,More,Adjusted):- + if_or_else(adjust_args_9(Eq,RetType,ResIn,ResOut,Depth,Self,AE,More,Adjusted), + if_or_else(with_debug(eval_args,adjust_args_9(Eq,RetType,ResIn,ResOut,Depth,Self,AE,More,Adjusted), + if_or_else(More=Adjusted, + if_or_else((trace, throw(adjust_args_9(Eq,RetType,ResIn,ResOut,Depth,Self,AE,More,Adjusted)))))))). + + + +eval_adjust_args2(Eq,_RetType,ResIn,ResOut,Depth,Self,[AE|More],[AE|Adjusted]):- + maplist(must_eval_args(Eq,_,Depth,Self),More,Adjusted), + ResIn = ResOut. + + +must_eval_args(Eq,RetType,Depth,Self,More,Adjusted):- \+ is_debugging(eval_args),!, eval_args(Eq,RetType,Depth,Self,More,Adjusted). +must_eval_args(Eq,RetType,Depth,Self,More,Adjusted):- + (eval_args(Eq,RetType,Depth,Self,More,Adjusted)*->true; + (with_debug(eval_args,eval_args(Eq,RetType,Depth,Self,More,Adjusted))*-> true; + ( + %nl,writeq(eval_args(Eq,RetType,Depth,Self,More,Adjusted)),writeln('.'), + (More=Adjusted -> true ; + (trace, throw(must_eval_args(Eq,RetType,Depth,Self,More,Adjusted))))))). + + +eval_maybe_subst(Eq,RetType,Depth,Self,PredDecl,Res):- !, + subst_args_here(Eq,RetType,Depth,Self,PredDecl,Res). + + +eval_maybe_subst(_Eq,_RetType,_Dpth,_Slf,[H|PredDecl],Res):- fail, + is_rust_operation([H|PredDecl]),!, % run + must_det_ll((rust_metta_run(exec([H|PredDecl]),Res), + nop(write_src(res(Res))))). + +eval_maybe_subst(_Eq,_RetType,_Dpth,_Slf,Res,Res):- nb_current(eval_maybe_subst,false),!. +eval_maybe_subst(Eq,RetType,Depth,Self,PredDecl,Res):- + locally(nb_setval(eval_maybe_subst,false), + finish_eval(Eq,RetType,Depth,Self,PredDecl,Res)). + +:- nb_setval(eval_maybe_subst,true). +/* +eval_maybe_subst(Eq,RetType,Depth,Self,PredDecl,Res):- + if_or_else((finish_eval(Eq,RetType,Depth,Self,PredDecl,Res), + PredDec\=@=Res), + subst_args(Eq,RetType,Depth,Self,PredDecl,Res)). +*/ + +/* +eval_70(Eq,RetType,Depth,Self,PredDecl,Res):- + Do_more_defs = do_more_defs(true), + clause(eval_80(Eq,RetType,Depth,Self,PredDecl,Res),Body), + Do_more_defs == do_more_defs(true), + call_ndet(Body,DET), + nb_setarg(1,Do_more_defs,false), + (DET==true -> ! ; true). +*/ +% ================================================================= +% ================================================================= +% ================================================================= +% inherited by system +% ================================================================= +% ================================================================= +% ================================================================= +is_system_pred(S):- atom(S),atom_concat(_,'!',S). +is_system_pred(S):- atom(S),atom_concat(_,'-fn',S). +is_system_pred(S):- atom(S),atom_concat(_,'-p',S). +%is_system_pred(S):- atom(S),upcase_symbol(S,U),downcase_symbol(S,U). + +% eval_80/6: Evaluates a Python function call within MeTTa. +% Parameters: +% - Eq: denotes get-type, match, or interpret call. +% - RetType: Expected return type of the MeTTa function. +% - Depth: Recursion depth or complexity control. +% - Self: Context or environment for the evaluation. +% - [MyFun|More]: List with MeTTa function and additional arguments. +% - RetVal: Variable to store the result of the Python function call. +eval_maybe_python(Eq, RetType, _Depth, Self, [MyFun|More], RetVal) :- + % MyFun as a registered Python function with its module and function name. + metta_atom(Self, ['registered-python-function', PyModule, PyFun, MyFun]),!, + % Tries to fetch the type definition for MyFun, ignoring failures. + %adjust_args_9(Eq,RetType,MVal,RetVal,Depth,Self,MyFun,More,Adjusted), + More=Adjusted,MVal=RetVal, + % Constructs a compound term for the Python function call with adjusted arguments. + compound_name_arguments(Call, PyFun, Adjusted), + % Optionally prints a debug tree of the Python call if tracing is enabled. + if_trace(host;python, print_tree(py_call(PyModule:Call, RetVal))), + % Executes the Python function call and captures the result in MVal which propagates to RetVal. + py_call(PyModule:Call, MVal), + % Checks the return value against the expected type and criteria. + check_returnval(Eq, RetType, RetVal). + + +%eval_80(_Eq,_RetType,_Dpth,_Slf,LESS,Res):- fake_notrace((once((eval_selfless(LESS,Res),fake_notrace(LESS\==Res))))),!. + +% predicate inherited by system +eval_maybe_host_predicate(Eq,RetType,_Depth,_Self,[AE|More],TF):- allow_host_functions, + once((is_system_pred(AE), + length(More,Len), + is_syspred(AE,Len,Pred))), + \+ (atom(AE), atom_concat(_,'-fn',AE)), + %current_predicate(Pred/Len), + %fake_notrace( \+ is_user_defined_goal(Self,[AE|More])),!, + %adjust_args(Depth,Self,AE,More,Adjusted), + maplist(as_prolog, More , Adjusted), + if_trace(host;prolog,print_tree(apply(Pred,Adjusted))), + catch_warn(efbug(show_call,eval_call(apply(Pred,Adjusted),TF))), + check_returnval(Eq,RetType,TF). + +show_ndet(G):- call(G). +%show_ndet(G):- call_ndet(G,DET),(DET==true -> ! ; fbug(show_ndet(G))). + +:- if( \+ current_predicate( adjust_args / 2 )). + + :- discontiguous eval_80/6. + +is_user_defined_goal(Self,Head):- + is_user_defined_head(Self,Head). + +:- endif. + +adjust_args_mp(_Eq,_RetType,Res,Res,_Depth,_Self,_Pred,_Len,_AE,Args,Adjusted):- Args==[],!,Adjusted=Args. +adjust_args_mp(Eq,RetType,Res,NewRes,Depth,Self,Pred,Len,AE,Args,Adjusted):- + + functor(P,Pred,Len), + predicate_property(P,meta_predicate(Needs)), + account_needs(1,Needs,Args,More),!, + adjust_args(Eq,RetType,Res,NewRes,Depth,Self,AE,More,Adjusted). +adjust_args_mp(Eq,RetType,Res,NewRes,Depth,Self,_Pred,_Len,AE,Args,Adjusted):- + adjust_args(Eq,RetType,Res,NewRes,Depth,Self,AE,Args,Adjusted). + +acct(0,A,call(eval_args(A,_))). +acct(':',A,call(eval_args(A,_))). +acct(_,A,A). +account_needs(_,_,[],[]). +account_needs(N,Needs,[A|Args],[M|More]):- arg(N,Needs,What),!, + acct(What,A,M),plus(1,N,NP1), + account_needs(NP1,Needs,Args,More). + +:- nodebug(metta(call)). +allow_host_functions. + +s2ps(S,P):- S=='Nil',!,P=[]. +s2ps(S,P):- \+ is_list(S),!,P=S. +s2ps([F|S],P):- atom(F),maplist(s2ps,S,SS),join_s2ps(F,SS,P),!. +s2ps(S,S):-!. +join_s2ps('Cons',[H,T],[H|T]):-!. +join_s2ps(F,Args,P):-atom(F),P=..[F|Args]. + +eval_call(S,TF):- + s2ps(S,P), !, + fbug(eval_call(P,'$VAR'('TF'))),as_tf(P,TF). + +eval_call_fn(S,R):- + s2ps(S,P), !, + fbug(eval_call_fn(P,'$VAR'('R'))),as_tf(call(P,R),TF),TF\=='False'. + +% function inherited from system +eval_maybe_host_function(Eq,RetType,_Depth,_Self,[AE|More],Res):- allow_host_functions, + is_system_pred(AE), + length([AE|More],Len), + is_syspred(AE,Len,Pred), + \+ (symbol(AE), symbol_concat(_,'-p',AE)), % thus maybe -fn or ! + %fake_notrace( \+ is_user_defined_goal(Self,[AE|More])),!, + %adjust_args(Depth,Self,AE,More,Adjusted),!, + %Len1 is Len+1, + %current_predicate(Pred/Len1), + maplist(as_prolog,More,Adjusted), + append(Adjusted,[Res],Args),!, + if_trace(host;prolog,print_tree(apply(Pred,Args))), + efbug(show_call,catch_warn(apply(Pred,Args))), + check_returnval(Eq,RetType,Res). + +% user defined function +%eval_20(Eq,RetType,Depth,Self,[H|PredDecl],Res):- + % fake_notrace(is_user_defined_head(Self,H)),!, + % eval_defn(Eq,RetType,Depth,Self,[H|PredDecl],Res). + +/*eval_maybe_defn(Eq,RetType,Depth,Self,PredDecl,Res):- + eval_defn(Eq,RetType,Depth,Self,PredDecl,Res). + +eval_maybe_subst(Eq,RetType,Depth,Self,PredDecl,Res):- + subst_args_h(Eq,RetType,Depth,Self,PredDecl,Res). +*/ + + + +:- if( \+ current_predicate( check_returnval / 3 )). +check_returnval(_,_RetType,_TF). +:- endif. + +:- if( \+ current_predicate( adjust_args / 5 )). +adjust_args(_Depth,_Self,_V,VI,VI). +:- endif. + + +last_element(T,E):- \+ compound(T),!,E=T. +last_element(T,E):- is_list(T),last(T,L),last_element(L,E),!. +last_element(T,E):- compound_name_arguments(T,_,List),last_element(List,E),!. + + + + +catch_warn(G):- (catch_err(G,E,(fbug(catch_warn(G)-->E),fail))). +catch_nowarn(G):- (catch_err(G,error(_,_),fail)). + + +% less Macro-ey Functions + +%Metta +as_nop([]). +%mettalog +%as_nop('Empty'). + +as_nop(G,NoResult):- G\=[_|_], rtrace_on_failure(G),!, + as_nop(NoResult). +as_tf(G,TF):- G\=[_|_], catch_nowarn((call(G)*->TF='True';TF='False')). +as_tf_tracabe(G,TF):- G\=[_|_], ((call(G)*->TF='True';TF='False')). +%eval_selfless_1(['==',X,Y],TF):- as_tf(X=:=Y,TF),!. +%eval_selfless_1(['==',X,Y],TF):- as_tf(X=@=Y,TF),!. + +is_assignment(V):- \+ atom(V),!, fail. +is_assignment('is'). is_assignment('is!'). +%is_assignment('='). +%is_assignment('=='). +%is_assignment('=:='). is_assignment(':='). + +eval_selfless(_Eq,_RetType,_Depth,_Self,E,R):- eval_selfless_0(E,R). +eval_selfless(E,R):- eval_selfless_0(E,R). + +eval_selfless_0([F|_],_):- var(F),!,fail. +eval_selfless_0([F,X,XY],TF):- is_assignment(F), fake_notrace(args_to_mathlib([X,XY],Lib)),!,eval_selfless3(Lib,['=',X,XY],TF). +eval_selfless_0([F|XY],TF):- eval_selfless_1([F|XY],TF),!. +eval_selfless_0(E,R):- eval_selfless_2(E,R). + +allow_clp:- false_flag. + +eval_selfless_1([F|XY],TF):- allow_clp, \+ ground(XY),!,fake_notrace(args_to_mathlib(XY,Lib)),!,eval_selfless3(Lib,[F|XY],TF). +eval_selfless_1(['>',X,Y],TF):-!,as_tf(X>Y,TF). +eval_selfless_1(['<',X,Y],TF):-!,as_tf(X',X,Y],TF):-!,as_tf(X>=Y,TF). +eval_selfless_1(['<=',X,Y],TF):-!,as_tf(X=',X,Y],TF):-!,as_tf(X#>Y,TF). +%compare_selfless0(clpfd,['<',X,Y],TF):-!,as_tf(X#',X,Y],TF):-!,as_tf(X#>=Y,TF). +compare_selfless0(clpfd,['<=',X,Y],TF):-!,as_tf(X#=',X,Y],TF):-!,as_tf(Lib:{X>Y},TF). +compare_selfless0(Lib,['<',X,Y],TF):-!,as_tf(Lib:{X',X,Y],TF):-!,as_tf(Lib:{X>=Y},TF). +compare_selfless0(Lib,['<=',X,Y],TF):-!,as_tf(Lib:{X=!;true). + + + +:- dynamic(is_metta_type_constructor/3). + +curried_arity(X,_,_):- var(X),!,fail. +curried_arity([F|T],F,A):-var(F),!,fail,len_or_unbound(T,A). +curried_arity([[F|T1]|T2],F,A):- nonvar(F),!,len_or_unbound(T1,A1), + (var(A1)->A=A1;(len_or_unbound(T2,A2),(var(A2)->A=A2;A is A1+A2))). +curried_arity([F|T],F,A):-len_or_unbound(T,A). + +%curried_arity(_,_,_). + + +len_or_unbound(T,A):- is_list(T),!,length(T,A). +len_or_unbound(T,A):- integer(A),!,length(T,A). +len_or_unbound(_,_). + + +:-if(true). +:- nodebug(metta('defn')). + +eval_maybe_defn(Eq,RetType,Depth,Self,X,Res):- + \+ \+ (curried_arity(X,F,A), + is_metta_type_constructor(Self,F,AA), + ( \+ AA\=A ),!, + if_trace(e,color_g_mesg('#772000', + indentq2(Depth,defs_none_cached((F/A/AA)=X))))),!, + \+ fail_on_constructor, + eval_constructor(Eq,RetType,Depth,Self,X,Res). +eval_maybe_defn(Eq,RetType,Depth,Self,X,Y):- can_be_ok(eval_maybe_defn,X),!, + trace_eval(eval_defn_choose_candidates(Eq,RetType),'defn',Depth,Self,X,Y). + +eval_constructor(Eq,RetType,Depth,Self,X,Res):- + eval_maybe_subst(Eq,RetType,Depth,Self,X,Res). + + +eval_defn_choose_candidates(Eq,RetType,Depth,Self,X,Y):- + findall((XX->B0),get_defn_expansions(Eq,RetType,Depth,Self,X,XX,B0),XXB0L),!, + eval_defn_bodies(Eq,RetType,Depth,Self,X,Y,XXB0L). +eval_defn_choose_candidates(Eq,RetType,Depth,Self,X,Y):- + eval_defn_bodies(Eq,RetType,Depth,Self,X,Y,[]),!. + +multiple_typesigs(TypesSet):- is_list(TypesSet), + length(TypesSet,Len),Len>1,maplist(is_list,TypesSet),!. + + +eval_defn_bodies(Eq,RetType,Depth,Self,X,Res,[]):- !, + \+ \+ ignore((curried_arity(X,F,A),assert(is_metta_type_constructor(Self,F,A)))),!, + if_trace(e,color_g_mesg('#773700',indentq2(Depth,defs_none(X)))),!, + \+ fail_on_constructor, + eval_constructor(Eq,RetType,Depth,Self,X,Res). + +eval_defn_bodies(Eq,RetType,Depth,Self,X,Y,XXB0L):- + if_trace(e,maplist(print_templates(Depth,' '),XXB0L)),!, + if_or_else((member(XX->B0,XXB0L), copy_term(XX->B0,USED), + eval_defn_success(Eq,RetType,Depth,Self,X,Y,XX,B0,USED)), + eval_defn_failure(Eq,RetType,Depth,Self,X,Y)). + + +eval_defn_success(Eq,RetType,Depth,Self,X,Y,XX,B0,USED):- + X=XX, Y=B0, X\=@=B0, + if_trace(e,color_g_mesg('#773700',indentq2(Depth,defs_used(USED)))), + light_eval(Eq,RetType,Depth,Self,B0,Y),!. +eval_defn_failure(_Eq,_RetType,Depth,_Self,X,Res):- + if_trace(e,color_g_mesg('#773701',indentq2(Depth,defs_failed(X)))), + !, \+ fail_missed_defn, X=Res. + + +:-else. +eval_maybe_defn(Eq,RetType,Depth,Self,X,Y):- can_be_ok(eval_maybe_defn,X),!, + trace_eval(eval_defn_choose_candidates(Eq,RetType),'defn',Depth,Self,X,Y). + +eval_defn_choose_candidates(Eq,RetType,Depth,Self,X,Y):- + findall((XX->B0),get_defn_expansions(Eq,RetType,Depth,Self,X,XX,B0),XXB0L), + XXB0L\=[],!, + Depth2 is Depth-1, + if_trace((defn;metta_defn), + maplist(print_templates(Depth,' '),XXB0L)),!, + member(XX->B0,XXB0L), X=XX, Y=B0, X\=@=B0, + %(X==B0 -> trace; eval_args(Eq,RetType,Depth,Self,B0,Y)). + light_eval(Depth2,Self,B0,Y). +eval_defn_choose_candidates(_Eq,_RetType,_Depth,_Self,_X,_Y):- \+ is_debugging(metta_defn),!,fail. +eval_defn_choose_candidates(_Eq,_RetType,_Depth,_Self,X,_Y):- + color_g_mesg('#773700',write(no_def(X))),!,fail. +:- endif. + +pl_clause_num(Head,Body,Ref,Index):- + clause(Head,Body,Ref), + nth_clause(Head,Index,Ref). + +same_len_copy(Args,NewArgs):- length(Args,N),length(NewArgs,N). + +get_defn_expansions(Eq,_RetType,_Depth,Self,[H|Args],[H|NewArgs],B0):- same_len_copy(Args,NewArgs), + metta_eq_def(Eq,Self,[H|NewArgs],B0). + +get_defn_expansions(Eq,RetType,Depth,Self,[[H|Start]|T1],[[H|NewStart]|NewT1],[Y|T1]):- is_list(Start), + same_len_copy(Start,NewStart), + X = [H|NewStart], + findall((XX->B0),get_defn_expansions(Eq,RetType,Depth,Self,X,XX,B0),XXB0L), + XXB0L\=[], if_trace((defn;metta_defn;eval_args),maplist(print_templates(Depth,'curry 1'),XXB0L)),!, + member(XX->B0,XXB0L), X=XX, Y=B0, X\=@=B0, + light_eval(Eq,RetType,Depth,Self,B0,Y), + same_len_copy(T1,NewT1). + +get_defn_expansions(Eq,RetType,Depth,Self,[[H|Start]|T1],RW,Y):- is_list(Start), append(Start,T1,Args), + get_defn_expansions(Eq,RetType,Depth,Self,[H|Args],RW,Y), + if_trace((defn;metta_defn;eval_args),indentq_d(Depth,'curry 2 ', [[[H|Start]|T1] ,'----->', RW])). + +print_templates(Depth,_T,guarded_defn(Types,XX,B0)):-!, + Depth2 is Depth+2, + if_t(is_list(Types),indentq_d(Depth,'guarded',['->'|Types])), + indentq_d(Depth2,'(=',XX), + indentq_d(Depth2,' ',ste('',B0,')')). +print_templates(Depth,_T,XX->B0):-!, + indentq_d(Depth,'(=',XX), + indentq_d(Depth,'',ste('',B0,')')). +print_templates(Depth,T,XXB0):- ignore(indentq_d(Depth,'<<>>'(T),template(XXB0))),!. + +light_eval(Depth,Self,X,B):- + light_eval(_Eq,_RetType,Depth,Self,X,B). +light_eval(_Eq,_RetType,_Depth,_Self,B,B). + +not_template_arg(TArg):- var(TArg), !, \+ attvar(TArg). +not_template_arg(TArg):- atomic(TArg),!. +%not_template_arg(TArg):- is_list(TArg),!,fail. + + +% ================================================================= +% ================================================================= +% ================================================================= +% AGREGATES +% ================================================================= +% ================================================================= +% ================================================================= + +cwdl(DL,Goal):- call_with_depth_limit(Goal,DL,R), (R==depth_limit_exceeded->(!,fail);true). + +cwtl(DL,Goal):- catch(call_with_time_limit(DL,Goal),time_limit_exceeded(_),fail). + + +%findall_eval(Eq,RetType,Depth,Self,X,L):- findall_eval(Eq,RetType,_RT,Depth,Self,X,L). +%findall_eval(Eq,RetType,Depth,Self,X,S):- findall(E,eval_ne(Eq,RetType,Depth,Self,X,E),S)*->true;S=[]. +findall_eval(_Eq,_RetType,_Dpth,_Slf,X,L):- self_eval(X),!,L=[X]. +findall_eval(_Eq,_RetType,_Dpth,_Slf,X,L):- typed_list(X,_Type,L),!. +findall_eval(Eq,RetType,Depth,Self,Funcall,L):- + findall_ne(E, + catch_metta_return(eval_args(Eq,RetType,Depth,Self,Funcall,E),E),L). + +%bagof_eval(Eq,RetType,Depth,Self,X,L):- bagof_eval(Eq,RetType,_RT,Depth,Self,X,L). +%bagof_eval(Eq,RetType,Depth,Self,X,S):- bagof(E,eval_ne(Eq,RetType,Depth,Self,X,E),S)*->true;S=[]. +bagof_eval(_Eq,_RetType,_Dpth,_Slf,X,L):- self_eval(X),!,L=[X]. +bagof_eval(_Eq,_RetType,_Dpth,_Slf,X,L):- typed_list(X,_Type,L),!. +bagof_eval(Eq,RetType,Depth,Self,Funcall,L):- + bagof_ne(E, + catch_metta_return(eval_args(Eq,RetType,Depth,Self,Funcall,E),E),L). + +setof_eval(Depth,Self,Funcall,L):- setof_eval('=',_RT,Depth,Self,Funcall,L). +setof_eval(Eq,RetType,Depth,Self,Funcall,S):- findall_eval(Eq,RetType,Depth,Self,Funcall,L), + sort(L,S). + +bagof_ne(E,Call,L):- + bagof(E,(rtrace_on_error(Call), is_returned(E)),L). + +findall_ne(E,Call,L):- + findall(E,(rtrace_on_error(Call), is_returned(E)),L). + +eval_ne(Eq,RetType,Depth,Self,Funcall,E):- + ((eval_args(Eq,RetType,Depth,Self,Funcall,E)) + *-> is_returned(E);(fail,E=Funcall)). + +is_returned(E):- notrace( \+ is_empty(E)). +is_empty(E):- notrace(( nonvar(E), sub_var('Empty',E))),!. + + +:- ensure_loaded(metta_subst). + +solve_quadratic(A, B, I, J, K) :- + %X in -1000..1000, % Define a domain for X + (X + A) * (X + B) #= I*X*X + J*X + K. % Define the quadratic equation + %label([X]). % Find solutions for X + + +as_type(B,_Type,B):- var(B),!. +as_type(B,_Type,B):- \+ compound(B),!. + +as_type([OP|B],Type,Res):- var(Type), + len_or_unbound(B,Len), + get_operator_typedef(_Self,OP,Len,_ParamTypes,RetType), + Type=RetType, + eval_for(RetType,[OP|B],Res). + +as_type(B,RetType,Res):- is_pro_eval_kind(RetType), + eval_for(RetType,B,Res). + +as_type(B,_Type,B). + +same_types(A,C,_Type,A1,C1):- + A1=A,C1=C,!. +same_types(A,C,Type,A1,C1):- + freeze(A,guess_type(A,Type)), + freeze(C,guess_type(C,Type)), + A1=A,C1=C. + +guess_type(A,Type):- + current_self(Self), + get_type(20,Self,A,Was), + can_assign(Was,Type). + +eval_for(RetType,X,Y):- + current_self(Self), + eval_args('=',RetType,20,Self,X,Y). + +%if_debugging(G):- ignore(call(G)). +if_debugging(_). +bcc:- trace, + bc_fn([:,Prf,[in_tad_with,[sequence_variant,rs15],[gene,d]]], + ['S',['S',['S',['S','Z']]]], + OUT), + write_src(prf=Prf), write_src(OUT). + + +bci:- trace, + bc_impl([:,Prf,[in_tad_with,[sequence_variant,rs15],[gene,d]]], + ['S',['S',['S',['S','Z']]]], + OUT), + write_src(prf=Prf), write_src(OUT). + + + +bcm:- % trace, + bc_impl([:,Prf,[member,_A,_B,_C]], + ['S',['S',['S','Z']]], + OUT), + write_src(prf=Prf), write_src(OUT). + + +bc_fn(A,B,C):- %trace, + same_types(A,C,_,A1,C1), + as_type(B,'Nat',B1), + bc_impl(A1,B1,C1). + +bc_impl([:, _prf, _ccln], _, [:, _prf, _ccln]) :- + if_debugging(println_impl(['bc-base', [:, _prf, _ccln]])), + metta_atom('&kb', [:, _prf, _ccln]), + if_debugging(println_impl(['bc-base-ground', [:, _prf, _ccln]])), + true. + +bc_impl([:, [_prfabs, _prfarg], _ccln], ['S', _k], [:, [_prfabs, _prfarg], _ccln]) :- + if_debugging(println_impl(['bc-rec', [:, [_prfabs, _prfarg], _ccln], ['S', _k]])), + bc_impl([:, _prfabs, ['->', _prms, _ccln]], _k, [:, _prfabs, [->, _prms, _ccln]]), + bc_impl([:, _prfarg, _prms], _k, [:, _prfarg, _prms]). + + + + + + + + + + + + + + + + +end_of_file. + + + + eval_20(Eq,RetType,Depth,Self,X,Y):- fail, + once(type_fit_childs(Eq,Depth,Self,RetType,X,XX)), + X\=@=XX, fbug(type_fit_childs(X,XX)),fail, + eval_evals(Eq,RetType,Depth,Self,XX,Y). + + + into_arg_code([],true):-!. + into_arg_code(H,TT):- \+ iz_conz(H), TT = H. + into_arg_code([H,T],TT):- H==true,!,into_arg_code(T,TT). + into_arg_code([T,H],TT):- H==true,!,into_arg_code(T,TT). + into_arg_code([H,T],','(HH,TT)):- !, into_arg_code(H,HH),into_arg_code(T,TT). + into_arg_code([H|T],TT):- H==true,!,into_arg_code(T,TT). + into_arg_code([H|T],','(HH,TT)):- !, into_arg_code(H,HH),into_arg_code(T,TT). + into_arg_code(TT,TT). + into_arg_code([H|T],next(H,TT)):- into_arg_code(T,TT). + + + % reduce args to match types even inside atoms + type_fit_childs(_Eq,_Depth,_Self,_RetType,true,X,Y):- is_ftVar(X),!,Y=X. + type_fit_childs(_Eq,_Depth,_Self,_RetType,true,X,Y):- symbolic(X),!,Y=X. + type_fit_childs(Eq,Depth,Self,RetType,CodeForArg,X,Y):- compound_non_cons(X),!, + into_list_args(X,XX),!,type_fit_childs(Eq,Depth,Self,RetType,CodeForArg,XX,Y). + type_fit_childs(_Eq,_Depth,_Self,_RetType,true,X,Y):- \+ is_list(X),iz_conz(X), trace, !,Y=X. + type_fit_childs(_Eq,_Depth,_Self,_RetType,true,X,Y):- self_eval(X),!,Y=X. + + type_fit_childs(_Eq,_Depth,_Self,_RetType,true,[H|Args],[H|Args]):- (H=='eval_args';H=='eval_args-for'),!. + + type_fit_childs(Eq,Depth,Self,RetType,CodeForArg,['let*',Lets,Body],RetVal):- !, + expand_let_star(Lets,Body,NewLet),!, + type_fit_childs(Eq,Depth,Self,RetType,CodeForArg,NewLet,RetVal). + + /* e,CodeForCond,['If',Cond,Then,Else], + pe_fit_childs(Eq,Depth,Self,RetType,CodeForCond,['If',Cond,Then,Else], + ['If',ConVal,(CodeForThen),CodeForElse]):- + type_fit_childs(Eq,Depth,Self,'Bool',CodeForCond,Cond,ConVal). + type_fit_childs(Eq,Depth,Self,RetType,CodeForThen,Then,ThenVal). + type_fit_childs(Eq,Depth,Self,RetType,CodeForElse,Else,ElseVal). + */ + + type_fit_childs(Eq,Depth,Self,RetType,FullCodeForArgs,[H|Args],Y):- H\==':', + ignore(get_operator_typedef1(Self,H,ParamTypes,RType)), + ignore(eager_for_type(RType,RetType)),!, + must_det_ll((maplist(type_fit_childs(Eq,Depth,Self),ParamTypes,CodeForArgs,Args,NewArgs), + into_arg_code(CodeForArgs,MCodeForArgs), + into_arg_code([MCodeForArgs,'eval_args'(XX,Y)],FullCodeForArgs), + + XX = [H|NewArgs], + Y = _)). + %eval_args(Eq,RetType,CodeForArg,Depth,Self,XX,Y). + + type_fit_childs(Eq,Depth,Self,RetType,FullCodeForArgs,[H|Args],Y):- + must_det_ll((ignore(get_operator_typedef1(Self,H,ParamTypes,RetType)), + maplist(type_fit_childs(Eq,Depth,Self),ParamTypes,CodeForArgs,Args,NewArgs), + into_arg_code(CodeForArgs,FullCodeForArgs), + Y = [H|NewArgs])). + type_fit_childs(_Eq,_Depth,_Self,_RetType,true,X,Y):-!,must_det_ll((X=Y)). + + eager_for_type(_RType,'Atom'):- !, fail. + eager_for_type(_RType,'Type'):- !, fail. + eager_for_type(RType,RetType):- RType==RetType,!. + eager_for_type(RType,'Expression'):- !, RType=='Expression'. + eager_for_type('Atom','Expression'):- !, fail. + eager_for_type('Symbol','Expression'):- !, fail. + eager_for_type(RType,Var):- var(Var),!,RType=Var. + eager_for_type(_RType,_):-!. + %eager_for_type(_RType,'Any'):- !. + %eager_for_type(_RType,'Number'). + %eager_for_type(_RType,'Nat'). + + + eval_evals(_Eq,_Depth,_Self,_RetType,X,Y):-self_eval(X),!,Y=X. + eval_evals(_Eq,_Depth,_Self,_RetType,X,Y):- \+ is_list(X),!,Y=X. + eval_evals(Eq,Depth,Self,RetType,[Eval,X],Y):- Eval == 'eval_args',!, + eval_evals(Eq,Depth,Self,RetType,X,XX), + eval_args(Eq,RetType,Depth,Self,XX,Y). + eval_evals(Eq,Depth,Self,RetType,[Eval,SomeType,X],Y):- Eval == 'eval_args-for',!, + eval_evals(Eq,Depth,Self,RetType,X,XX), + eval_args(Eq,SomeType,Depth,Self,XX,Y). + eval_evals(Eq,Depth,Self,RetType,[H|Args],Y):- + ignore(get_operator_typedef1(Self,H,ParamTypes,RetType)), + maplist(eval_evals(Eq,Depth,Self),ParamTypes,Args,NewArgs), + XX = [H|NewArgs],Y=XX. + eval_evals(_Eq,_Depth,_Self,_RetType,X,X):-!. + diff --git a/.Attic/canary_docme/metta_interp.pl b/.Attic/canary_docme/metta_interp.pl new file mode 100644 index 00000000000..aa087700ebc --- /dev/null +++ b/.Attic/canary_docme/metta_interp.pl @@ -0,0 +1,1814 @@ +/* + * Project: MeTTaLog - A MeTTa to Prolog Transpiler/Interpreter + * Description: This file is part of the source code for a transpiler designed to convert + * MeTTa language programs into Prolog, utilizing the SWI-Prolog compiler for + * optimizing and transforming function/logic programs. It handles different + * logical constructs and performs conversions between functions and predicates. + * + * Author: Douglas R. Miles + * Contact: logicmoo@gmail.com / dmiles@logicmoo.org + * License: LGPL + * Repository: https://github.com/trueagi-io/metta-wam + * https://github.com/logicmoo/hyperon-wam + * Created Date: 8/23/2023 + * Last Modified: $LastChangedDate$ # You will replace this with Git automation + * + * Usage: This file is a part of the transpiler that transforms MeTTa programs into Prolog. For details + * on how to contribute or use this project, please refer to the repository README or the project documentation. + * + * Contribution: Contributions are welcome! For contributing guidelines, please check the CONTRIBUTING.md + * file in the repository. + * + * Notes: + * - Ensure you have SWI-Prolog installed and properly configured to use this transpiler. + * - This project is under active development, and we welcome feedback and contributions. + * + * Acknowledgments: Special thanks to all contributors and the open source community for their support and contributions. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the + * distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS + * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT + * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS + * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE + * COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, + * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; + * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER + * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN + * ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + * POSSIBILITY OF SUCH DAMAGE. + */ + +:- encoding(utf8). +:- set_prolog_flag(encoding, utf8). +:- nb_setval(cmt_override,lse('; ',' !(" ',' ") ')). +:- set_prolog_flag(source_search_working_directory,true). +:- set_prolog_flag(backtrace,true). +:- set_prolog_flag(backtrace_depth,100). +:- set_prolog_flag(backtrace_goal_dept,100). +:- set_prolog_flag(backtrace_show_lines,true). +:- set_prolog_flag(write_attributes,portray). +:- set_prolog_flag(debug_on_interrupt,true). +:- set_prolog_flag(debug_on_error,true). +:- ensure_loaded(swi_support). +%:- set_prolog_flag(compile_meta_arguments,control). +:- (prolog_load_context(directory, Value);Value='.'), absolute_file_name('../packs/',Dir,[relative_to(Value)]), + atom_concat(Dir,'predicate_streams',PS), + atom_concat(Dir,'logicmoo_utils',LU), + attach_packs(Dir,[duplicate(replace),search(first)]), + pack_attach(PS,[duplicate(replace),search(first)]), + pack_attach(LU,[duplicate(replace),search(first)]). +% :- attach_packs. +%:- ensure_loaded(metta_interp). +is_win64:- current_prolog_flag(windows,_). +is_win64_ui:- is_win64,current_prolog_flag(hwnd,_). + +dont_change_streams:- true. + +:- dynamic(user:is_metta_src_dir/1). +:- prolog_load_context(directory,Dir), + retractall(user:is_metta_src_dir(_)), + asserta(user:is_metta_src_dir(Dir)). + +metta_root_dir(Dir):- is_metta_src_dir(Value), absolute_file_name('../../',Dir,[relative_to(Value)]). +metta_root_dir(Dir):- getenv('METTA_DIR',Dir),!. + +metta_library_dir(Dir):- metta_root_dir(Value), absolute_file_name('./library/',Dir,[relative_to(Value)]). + +metta_dir(Dir):- metta_library_dir(Value), absolute_file_name('./genome/',Dir,[relative_to(Value)]). +metta_dir(Dir):- is_metta_src_dir(Dir). +metta_dir(Dir):- metta_library_dir(Dir). +metta_dir(Dir):- metta_root_dir(Dir). +metta_dir(Dir):- is_metta_src_dir(Value), absolute_file_name('../flybase/',Dir,[relative_to(Value)]). + +:- dynamic user:file_search_path/2. +:- multifile user:file_search_path/2. +user:file_search_path(library,Dir):- metta_dir(Dir). +user:file_search_path(mettalog,Dir):- metta_dir(Dir). + + +:- is_win64 -> ensure_loaded(library(logicmoo_utils)) ; true. + +% :- initialization(attach_packs). +:- nodebug(metta(eval)). +:- nodebug(metta(exec)). +:- nodebug(metta(load)). +:- nodebug(metta(prolog)). + +:- dynamic(function_arity/2). +:- dynamic(predicate_arity/2). + + +:-multifile(user:metta_file/3). +:-dynamic(user:metta_file/3). + +:- multifile(reset_cache/0). + + :-multifile(metta_type/3). + :-dynamic(metta_type/3). + + :-multifile(metta_defn/3). + :-dynamic(metta_defn/3). + + +:-multifile(user:asserted_metta_pred/2). +:-dynamic(user:asserted_metta_pred/2). +:-multifile(user:loaded_into_kb/2). +:-dynamic(user:loaded_into_kb/2). +:- dynamic(user:is_metta_dir/1). + +once_writeq_ln(_):- \+ clause(pfcTraceExecution,true),!. +once_writeq_ln(P):- nb_current('$once_writeq_ln',W),W=@=P,!. +once_writeq_ln(P):- + \+ \+ (numbervars(P,444,_,[attvar(skip),singletons(true)]), + ansi_format([fg(cyan)],'~N~q.~n',[P])),nb_setval('$once_writeq_ln',P),!. +% TODO uncomment this next line but it is breaking the curried chainer +% pfcAdd_Now(P):- pfcAdd(P),!. +pfcAdd_Now(P):- current_predicate(pfcAdd/1),!, once_writeq_ln(pfcAdd(P)),pfcAdd(P). +pfcAdd_Now(P):- once_writeq_ln(asssert(P)),assert(P). +%:- endif. + +system:copy_term_g(I,O):- ground(I),!,I=O. +system:copy_term_g(I,O):- copy_term(I,O). + +:- ensure_loaded(metta_debug). + +is_metta_flag(What):- notrace(is_flag0(What)). + +true_flag. +false_flag:- fail. + +is_tRuE(TF):- TF=='True',!. +is_tRuE(TF):- TF=='true',!. +is_flag0(What):- nb_current(What,TF),TF\==[],!,is_tRuE(TF). +is_flag0(What):- current_prolog_flag(What,TF),TF\==[],!,is_tRuE(TF). +is_flag0(What):- + symbol_concat('--',What,FWhat),symbol_concat(FWhat,'=true',FWhatTrue), + symbol_concat('--no-',What,NoWhat),symbol_concat(FWhat,'=false',FWhatFalse), + is_flag0(What,[FWhat,FWhatTrue],[NoWhat,FWhatFalse]). + +is_flag0(What,_FWhatTrue,FWhatFalse):- + current_prolog_flag(os_argv,ArgV), + member(FWhat,FWhatFalse),member(FWhat,ArgV),!, + notrace(catch(set_prolog_flag(What,false),_,true)), + set_option_value(What,'False'),!,fail. +is_flag0(What,FWhatTrue,_FWhatFalse):- + current_prolog_flag(os_argv,ArgV), + member(FWhat,FWhatTrue),member(FWhat,ArgV),!, + notrace(catch(set_prolog_flag(What,true),_,true)), + set_option_value(What,'True'),!. +is_flag0(What,_FWhatTrue,_FWhatFalse):- + current_prolog_flag(os_argv,ArgV), + symbolic_list_concat(['--',What,'='],Starts), + member(FWhat,ArgV),symbol_concat(Starts,Rest,FWhat), + set_option_value_interp(What,Rest),!. + +is_compiling:- current_prolog_flag(os_argv,ArgV),member(E,ArgV), (E==qcompile_mettalog;E==qsave_program),!. +is_compiled:- current_prolog_flag(os_argv,ArgV), member('-x',ArgV),!. +is_compiled:- current_prolog_flag(os_argv,ArgV),\+ member('swipl',ArgV),!. + +is_converting:- is_metta_flag('convert'). + +is_compat:- is_metta_flag('compat'). + +is_mettalog:- is_win64,!. +is_mettalog:- is_metta_flag('log'). + +is_synthing_unit_tests:- notrace(is_synthing_unit_tests0). +is_synthing_unit_tests0:- is_testing. +%is_synthing_unit_tests0:- is_html. +% is_synthing_unit_tests0:- is_compatio,!,fail. + +is_testing:- is_metta_flag('test'). +is_html:- is_metta_flag('html'). + +:- ensure_loaded(metta_printer). +:- ensure_loaded(metta_loader). + + +:- nodebug(metta('trace-on-eval')). + +is_compatio:- notrace(is_compatio0). +is_compatio0:- is_win64,!,fail. +is_compatio0:- is_testing,!,fail. +is_compatio0:- is_flag0('compatio'). +is_compatio0:- is_mettalog,!,fail. +%is_compatio0:- is_html,!,fail. +is_compatio0:- !. + +keep_output:- !. +keep_output:- dont_change_streams,!. +keep_output:- is_win64,!. +keep_output:- is_mettalog,!. +keep_output:- is_testing,!. +keep_output:- is_compatio,!,fail. + + +:- volatile(original_user_output/1). +:- dynamic(original_user_output/1). +original_user_output(X):- stream_property(X,file_no(1)). +original_user_error(X):- stream_property(X,file_no(2)). +:- original_user_output(_)->true;current_output(Out),asserta(original_user_output(Out)). +unnullify_output:- current_output(MFS), original_user_output(OUT), MFS==OUT, !. +unnullify_output:- original_user_output(MFS), set_prolog_IO(user_input,MFS,user_error). + +null_output(MFS):- dont_change_streams,!, original_user_output(MFS),!. +null_output(MFS):- use_module(library(memfile)), + new_memory_file(MF),open_memory_file(MF,append,MFS). +:- volatile(null_user_output/1). +:- dynamic(null_user_output/1). +:- null_user_output(_)->true;(null_output(MFS), + asserta(null_user_output(MFS))). + + +nullify_output:- keep_output,!. +nullify_output:- dont_change_streams,!. +nullify_output:- nullify_output_really. +nullify_output_really:- current_output(MFS), null_user_output(OUT), MFS==OUT, !. +nullify_output_really:- null_user_output(MFS), set_prolog_IO(user_input,MFS,MFS). + +set_output_stream :- dont_change_streams,!. +set_output_stream :- \+ keep_output -> nullify_output; unnullify_output. +:- set_output_stream. +% :- nullify_output. + +switch_to_mettalog:- + unnullify_output, + set_option_value('compatio',false), + set_option_value('compat',false), + set_option_value('load',show), + set_option_value('load',verbose), + set_option_value('log',true), + %set_option_value('test',true), + set_output_stream. + +switch_to_mettarust:- + nullify_output, + set_option_value('compatio',true), + set_option_value('compat',true), + set_option_value('log',false), + set_option_value('test',false), + set_output_stream. + + + +show_os_argv:- is_compatio,!. +show_os_argv:- current_prolog_flag(os_argv,ArgV),write('; libswipl: '),writeln(ArgV). +is_pyswip:- current_prolog_flag(os_argv,ArgV),member( './',ArgV). +:- multifile(is_metta_data_functor/1). +:- dynamic(is_metta_data_functor/1). +:- multifile(is_nb_space/1). +:- dynamic(is_nb_space/1). +%:- '$set_source_module'('user'). +:- use_module(library(filesex)). +:- use_module(library(system)). +:- use_module(library(shell)). +%:- use_module(library(tabling)). + +:- nb_setval(self_space, '&self'). +current_self(Self):- ((nb_current(self_space,Self),Self\==[])->true;Self='&self'). +:- nb_setval(repl_mode, '+'). + +%:- set_stream(user_input,tty(true)). +%:- use_module(library(editline)). +:- set_prolog_flag(encoding,iso_latin_1). +:- set_prolog_flag(encoding,utf8). +%:- set_output(user_error). +%:- set_prolog_flag(encoding,octet). + + + +/* +Now PASSING NARS.TEC:\opt\logicmoo_workspace\packs_sys\logicmoo_opencog\MeTTa\hyperon-wam\src\pyswip\metta_interp.pl +C:\opt\logicmoo_workspace\packs_sys\logicmoo_opencog\MeTTa\hyperon-wam\src\pyswip1\metta_interp.pl +STS1.01) +Now PASSING TEST-SCRIPTS.B5-TYPES-PRELIM.08) +Now PASSING TEST-SCRIPTS.B5-TYPES-PRELIM.14) +Now PASSING TEST-SCRIPTS.B5-TYPES-PRELIM.15) +Now PASSING TEST-SCRIPTS.C1-GROUNDED-BASIC.15) +Now PASSING TEST-SCRIPTS.E2-STATES.08) +PASSING TEST-SCRIPTS.B5-TYPES-PRELIM.02) +PASSING TEST-SCRIPTS.B5-TYPES-PRELIM.07) +PASSING TEST-SCRIPTS.B5-TYPES-PRELIM.09) +PASSING TEST-SCRIPTS.B5-TYPES-PRELIM.11) +PASSING TEST-SCRIPTS.C1-GROUNDED-BASIC.14) +PASSING TEST-SCRIPTS.E2-STATES.07) +----------------------------------------- +FAILING TEST-SCRIPTS.D5-AUTO-TYPES.01) +Now FAILING TEST-SCRIPTS.00-LANG-CASE.03) +Now FAILING TEST-SCRIPTS.B5-TYPES-PRELIM.19) +Now FAILING TEST-SCRIPTS.C1-GROUNDED-BASIC.20) + +*/ + + +%option_value_def('repl',auto). +option_value_def('prolog',false). +option_value_def('compat',auto). +option_value_def('compatio',true). +%option_value_def('compatio',false). +option_value_def('compile',false). +%option_value_def('compile',true). +%option_value_def('compile',full). +option_value_def('tabling',true). +option_value_def('optimize',true). +option_value_def(no_repeats,false). +%option_value_def('time',false). +option_value_def('test',false). +option_value_def('html',false). +option_value_def('python',true). +%option_value_def('halt',false). +option_value_def('doing_repl',false). +option_value_def('test-retval',false). +option_value_def('exeout','./Sav.gitlab.MeTTaLog'). + +option_value_def('synth_unit_tests',false). + +option_value_def('trace-length',500). +option_value_def('stack-max',500). +option_value_def('trace-on-overtime',4.0). +option_value_def('trace-on-overflow',false). +option_value_def('trace-on-error',true). +option_value_def('trace-on-exec',false). +option_value_def('trace-on-fail',false). +option_value_def('trace-on-pass',false). + + +option_value_def('exec',true). % vs skip + +option_value_def('trace-on-load',false). +option_value_def('load','silent'). + +option_value_def('trace-on-eval',false). +option_value_def('eval',silent). + +option_value_def('transpiler',silent). +option_value_def('result',show). + +option_value_def('maximum-result-count',inf). % infinate answers + +% MeTTaLog --log mode only +% if print the first 10 answers without stopping +option_value_def('initial-result-count',10). + + + + +fbugio(_,_):- is_compatio,!. +fbugio(TF,P):-!, ignore(( TF,!,fbug(P))). +fbugio(IO):-fbugio(true,IO). + +different_from(N,V):- \+ \+ option_value_def(N,V),!,fail. +different_from(N,V):- \+ \+ nb_current(N,V),!,fail. +different_from(_,_). + +set_option_value_interp(N,V):- symbol(N), symbolic_list_concat(List,',',N),List\=[_],!, + forall(member(E,List),set_option_value_interp(E,V)). +set_option_value_interp(N,V):- + %(different_from(N,V)->Note=true;Note=false), + Note = true, + fbugio(Note,set_option_value(N,V)),set_option_value(N,V), + ignore(forall(on_set_value(Note,N,V),true)). + +on_set_value(Note,N,'True'):- on_set_value(Note,N,true). +on_set_value(Note,N,'False'):- on_set_value(Note,N,false). +on_set_value(_Note,log,true):- switch_to_mettalog. +on_set_value(_Note,compatio,true):- switch_to_mettarust. +on_set_value(Note,N,V):- symbol(N), symbol_concat('trace-on-',F,N),fbugio(Note,set_debug(F,V)),set_debug(F,V). +on_set_value(Note,N,V):- symbol(N), is_debug_like(V,TF),fbugio(Note,set_debug(N,TF)),set_debug(N,TF). + +is_debug_like(trace, true). +is_debug_like(notrace, false). +is_debug_like(debug, true). +is_debug_like(nodebug, false). +is_debug_like(silent, false). +%is_debug_like(false, false). + +'is-symbol'(X):- symbol(X). +%:- (is_mettalog->switch_to_mettalog;switch_to_mettarust). + +set_is_unit_test(TF):- + forall(option_value_def(A,B),set_option_value_interp(A,B)), + set_option_value_interp('trace-on-pass',false), + set_option_value_interp('trace-on-fail',false), + set_option_value_interp('load',show), + set_option_value_interp('test',TF), + %set_option_value_interp('trace-on-load',TF), +/* if_t(TF,set_option_value_interp('exec',debug)), + if_t(TF,set_option_value_interp('eval',debug)), + set_option_value_interp('trace-on-exec',TF), + set_option_value_interp('trace-on-eval',TF),*/ + % if_t( \+ TF , set_prolog_flag(debug_on_interrupt,true)), + !. + +:- meta_predicate fake_notrace(0). +fake_notrace(G):- tracing,!,real_notrace(G). +fake_notrace(G):- !,once(G). +% `quietly/1` allows breaking in and inspection (real `no_trace/1` does not) +fake_notrace(G):- quietly(G),!. +:- meta_predicate real_notrace(0). +real_notrace(Goal) :- + setup_call_cleanup('$notrace'(Flags, SkipLevel), + once(Goal), + '$restore_trace'(Flags, SkipLevel)). + + +:- dynamic(is_answer_output_stream/2). +answer_output(Stream):- is_testing,original_user_output(Stream),!. +answer_output(Stream):- !,original_user_output(Stream),!. % yes, the cut is on purpose +answer_output(Stream):- is_answer_output_stream(_,Stream),!. +answer_output(Stream):- tmp_file('answers',File), + open(File,write,Stream,[encoding(utf8)]), + asserta(is_answer_output_stream(File,Stream)). + +write_answer_output:- + retract(is_answer_output_stream(File,Stream)),!, + ignore(catch_log(close(Stream))), + sformat(S,'cat ~w',[File]), + catch_log(ignore(shell(S))),nl. +write_answer_output. + + +null_io(G):- null_user_output(Out), !, with_output_to(Out,G). +user_io(G):- original_user_output(Out), !, with_output_to(Out,G). +user_err(G):- original_user_error(Out), !, with_output_to(Out,G). +with_output_to_s(Out,G):- current_output(COut), + redo_call_cleanup(set_prolog_IO(user_input, Out,user_error), G, + set_prolog_IO(user_input,COut,user_error)). + + in_answer_io(_):- nb_current(suspend_answers,true),!. + in_answer_io(G):- answer_output(Out), !, with_output_to(Out,G). + not_compatio(G):- if_t(once(is_mettalog;is_testing),user_err(G)). + +%if_compatio(G):- if_t(is_compatio,user_io(G)). +% if_compat_io(G):- if_compatio(G). +not_compat_io(G):- not_compatio(G). +non_compat_io(G):- not_compatio(G). + + +trace_on_fail:- option_value('trace-on-fail',true). +trace_on_overflow:- option_value('trace-on-overflow',true). +trace_on_pass:- option_value('trace-on-pass',true). +doing_repl:- option_value('doing_repl',true). +if_repl(Goal):- doing_repl->call(Goal);true. + +any_floats(S):- member(E,S),float(E),!. + +show_options_values:- + forall((nb_current(N,V), \+((symbol(N),symbol_concat('$',_,N)))),write_src_nl(['pragma!',N,V])). + +:- prolog_load_context(source,File), assert(interpreter_source_file(File)). + + +:- ensure_loaded(metta_utils). +%:- ensure_loaded(mettalog('metta_ontology.pfc.pl')). +:- ensure_loaded(metta_pfc_base). +:- ensure_loaded(metta_pfc_support). +:- ensure_loaded(metta_compiler). +:- ensure_loaded(metta_convert). +:- ensure_loaded(metta_types). +:- ensure_loaded(metta_space). +:- ensure_loaded(metta_eval). + +:- set_is_unit_test(false). + +extract_prolog_arity([Arrow|ParamTypes],PrologArity):- + Arrow == ('->'),!, + len_or_unbound(ParamTypes,PrologArity). + +add_prolog_code(_KB,AssertZIfNew):- + fbug(writeln(AssertZIfNew)), + assertz_if_new(AssertZIfNew). +gen_interp_stubs(KB,Symb,Def):- + ignore((is_list(Def), + must_det_ll(( + extract_prolog_arity(Def,PrologArity), + symbol(Symb), + symbol_concat('i_',Symb,Tramp), + length(PrologArgs,PrologArity), + append(MeTTaArgs,[RetVal],PrologArgs), + TrampH =.. [Tramp|PrologArgs], + add_prolog_code(KB, + (TrampH :- eval_H([Symb|MeTTaArgs], RetVal))))))). + +% 'int_fa_format-args'(FormatArgs, Result):- eval_H(['format-args'|FormatArgs], Result). +% 'ext_fa_format-args'([EFormat, EArgs], Result):- int_format-args'(EFormat, EArgs, Result) +/* + +'ext_format-args'(Shared,Format, Args, EResult):- + pred_in('format-args',Shared,3), + argn_in(1,Shared,Format,EFormat), + argn_in(2,Shared,Args,EArgs), + argn_in(3,Shared,EResult,Result), + int_format-args'(Shared,EFormat, EArgs, Result), + arg_out(1,Shared,EFormat,Format), + arg_out(2,Shared,EArgs,Args), + arg_out(3,Shared,Result,EResult). + + you are goign to create the clause based on the first 2 args + +?- gen_form_body('format-args',3, HrnClause). + +HrnClause = + ('ext_format-args'(Shared, Arg1, Arg2, EResult):- + pred_in('format-args',Shared,3), + argn_in(1,Shared,Arg1,EArg1), + argn_in(2,Shared,Arg2,EArg2), + argn_in(3,Shared,EResult,Result), + 'int_format-args'(Shared,EArg1, EArg2, Result), + arg_out(1,Shared,EArg1,Arg1), + arg_out(2,Shared,EArg2,Arg2), + arg_out(3,Shared,Result,EResult)). + +*/ + + + +% Helper to generate head of the clause +generate_head(Shared,Arity, FormName, Args, Head) :- + atom_concat('ext_', FormName, ExtFormName), + number_string(Arity, ArityStr), + atom_concat(ExtFormName, ArityStr, FinalFormName), % Append arity to form name for uniqueness + append([FinalFormName, Shared | Args], HeadArgs), + Head =.. HeadArgs. + +% Helper to generate body of the clause, swapping arguments +generate_body(Shared,Arity, FormName, Args, EArgs, Body) :- + atom_concat('int_', FormName, IntFormName), + number_string(Arity, ArityStr), + atom_concat(IntFormName, ArityStr, FinalIntFormName), % Append arity to internal form name for uniqueness + reverse(EArgs, ReversedEArgs), % Reverse the order of evaluated arguments for internal processing + % Generate predicates for input handling + findall(argn_in(Index, Shared, Arg, EArg), + (nth1(Index, Args, Arg), nth1(Index, EArgs, EArg)), ArgIns), + % Internal processing call with reversed arguments + append([Shared | ReversedEArgs], IntArgs), + InternalCall =.. [FinalIntFormName | IntArgs], + % Generate predicates for output handling + findall(arg_out(Index, Shared, EArg, Arg), + (nth1(Index, EArgs, EArg), nth1(Index, Args, Arg)), ArgOuts), + % Combine predicates + PredIn = pred_in(FormName, Shared, Arity), + append([PredIn | ArgIns], [InternalCall | ArgOuts], BodyParts), + list_to_conjunction(BodyParts, Body). + +% Main predicate to generate form body clause +gen_form_body(FormName, Arity, Clause) :- + length(Args,Arity), + length(EArgs,Arity), + generate_head(Shared,Arity, FormName, Args, Head), + generate_body(Shared,Arity, FormName, Args, EArgs, Body), + Clause = (Head :- Body). + + +% Helper to format atoms +format_atom(Format, N, Atom) :- format(atom(Atom), Format, [N]). + + +% 'int_format-args'(Shared,Format, Args, Result):- +% .... actual impl .... + + + +metta_argv(Args):- current_prolog_flag(metta_argv, Args),!. +metta_argv(Before):- current_prolog_flag(os_argv,OSArgv), append(_,['--args'|AArgs],OSArgv), + before_arfer_dash_dash(AArgs,Before,_),!,set_metta_argv(Before). +argv_metta(Nth,Value):- metta_argv(Args),nth1(Nth,Args,Value). + +set_metta_argv(Before):- maplist(read_argv,Before,Args),set_prolog_flag(metta_argv, Args),!. +read_argv(AArg,Arg):- \+ symbol(AArg),!,AArg=Arg. +read_argv(AArg,Arg):- atom_string(AArg,S),read_metta(S,Arg),!. + +metta_cmd_args(Rest):- current_prolog_flag(late_metta_opts,Rest),!. +metta_cmd_args(Rest):- current_prolog_flag(os_argv,P),append(_,['--'|Rest],P),!. +metta_cmd_args(Rest):- current_prolog_flag(argv,P),append(_,['--'|Rest],P),!. +metta_cmd_args(Rest):- current_prolog_flag(argv,Rest). + +:- dynamic(has_run_cmd_args/0). +:- volatile(has_run_cmd_args/0). +run_cmd_args_prescan:- has_run_cmd_args, !. +run_cmd_args_prescan:- assert(has_run_cmd_args), do_cmdline_load_metta(prescan). + +run_cmd_args:- + run_cmd_args_prescan, + set_prolog_flag(debug_on_interrupt,true), + do_cmdline_load_metta(execute). + + +metta_make_hook:- loonit_reset, option_value(not_a_reload,true),!. +metta_make_hook:- + metta_cmd_args(Rest), into_reload_options(Rest,Reload), do_cmdline_load_metta(reload,'&self',Reload). + +:- multifile(prolog:make_hook/2). +:- dynamic(prolog:make_hook/2). +prolog:make_hook(after, _Some):- nop( metta_make_hook). + +into_reload_options(Reload,Reload). + +is_cmd_option(Opt,M, TF):- symbol(M), + symbol_concat('-',Opt,Flag), + atom_contains(M,Flag),!, + get_flag_value(M,FV), + TF=FV. + +get_flag_value(M,V):- symbolic_list_concat([_,V],'=',M),!. +get_flag_value(M,false):- atom_contains(M,'-no'),!. +get_flag_value(_,true). + + +:- ignore((( + \+ prolog_load_context(reloading,true), + nop((forall(option_value_def(Opt,Default),set_option_value_interp(Opt,Default))))))). + +%process_option_value_def:- \+ option_value('python',false), skip(ensure_loaded(metta_python)). +process_option_value_def:- fail, \+ option_value('python',false), ensure_loaded(mettalog(metta_python)), + real_notrace((ensure_mettalog_py)). +process_option_value_def. + + +process_late_opts:- forall(process_option_value_def,true). +process_late_opts:- once(option_value('html',true)), set_is_unit_test(true). +%process_late_opts:- current_prolog_flag(os_argv,[_]),!,ignore(repl). +%process_late_opts:- halt(7). +process_late_opts. + + +do_cmdline_load_metta(Phase):- metta_cmd_args(Rest), !, do_cmdline_load_metta(Phase,'&self',Rest). + +%do_cmdline_load_metta(Phase,_Slf,Rest):- select('--prolog',Rest,RRest),!, +% set_option_value_interp('prolog',true), +% set_prolog_flag(late_metta_opts,RRest). +do_cmdline_load_metta(Phase,Self,Rest):- + set_prolog_flag(late_metta_opts,Rest), + forall(process_option_value_def,true), + cmdline_load_metta(Phase,Self,Rest),!, + forall(process_late_opts,true). + +:- if( \+ current_predicate(load_metta_file/2)). +load_metta_file(Self,Filemask):- symbol_concat(_,'.metta',Filemask),!, load_metta(Self,Filemask). +load_metta_file(_Slf,Filemask):- load_flybase(Filemask). +:- endif. + +catch_abort(From,Goal):- + catch_abort(From,Goal,Goal). +catch_abort(From,TermV,Goal):- + catch(Goal,'$aborted',fbug(aborted(From,TermV))). +% done + +before_arfer_dash_dash(Rest,Args,NewRest):- + append(Args,['--'|NewRest],Rest)->true;([]=NewRest,Args=Rest). + +cmdline_load_metta(_,_,Nil):- Nil==[],!. + +cmdline_load_metta(Phase,Self,['--'|Rest]):- !, + cmdline_load_metta(Phase,Self,Rest). + +cmdline_load_metta(Phase,Self,['--args'|Rest]):- !, + before_arfer_dash_dash(Rest,Before,NewRest),!, + set_metta_argv(Before), + cmdline_load_metta(Phase,Self,NewRest). + +cmdline_load_metta(Phase,Self,['--repl'|Rest]):- !, + if_phase(Phase,execute,repl), + cmdline_load_metta(Phase,Self,Rest). +cmdline_load_metta(Phase,Self,['--log'|Rest]):- !, + if_phase(Phase,execute,switch_to_mettalog), + cmdline_load_metta(Phase,Self,Rest). +cmdline_load_metta(Phase,Self,[Filemask|Rest]):- symbol(Filemask), \+ symbol_concat('-',_,Filemask), + if_phase(Phase,execute,cmdline_load_file(Self,Filemask)), + cmdline_load_metta(Phase,Self,Rest). + +cmdline_load_metta(Phase,Self,['-g',M|Rest]):- !, + if_phase(Phase,execute,catch_abort(['-g',M],((read_term_from_atom(M, Term, []),ignore(call(Term)))))), + cmdline_load_metta(Phase,Self,Rest). + +cmdline_load_metta(Phase,Self,['-G',Str|Rest]):- !, + current_self(Self), + if_phase(Phase,execute,catch_abort(['-G',Str],ignore(call_sexpr('!',Self,Str,_S,_Out)))), + cmdline_load_metta(Phase,Self,Rest). + +cmdline_load_metta(Phase,Self,[M|Rest]):- + m_opt(M,Opt), + is_cmd_option(Opt,M,TF), + fbug(is_cmd_option(Phase,Opt,M,TF)), + set_option_value_interp(Opt,TF), !, + %set_tty_color_term(true), + cmdline_load_metta(Phase,Self,Rest). + +cmdline_load_metta(Phase,Self,[M|Rest]):- + format('~N'), fbug(unused_cmdline_option(Phase,M)), !, + cmdline_load_metta(Phase,Self,Rest). + +install_ontology:- !. +%load_ontology:- option_value(compile,false),!. +load_ontology:- ensure_loaded(mettalog('metta_ontology.pfc.pl')). + +%cmdline_load_file(Self,Filemask):- is_converting,!, + +cmdline_load_file(Self,Filemask):- + Src=(user:load_metta_file(Self,Filemask)), + catch_abort(Src, + (must_det_ll(( + not_compatio((nl,write('; '),write_src(Src),nl)), + catch_red(Src),!,flush_output)))),!. + +if_phase(Current,Phase,Goal):- ignore((sub_var(Current,Phase),!, Goal)). + +set_tty_color_term(TF):- + current_output(X),set_stream(X,tty(TF)), + set_stream(current_output,tty(TF)), + set_prolog_flag(color_term ,TF). + +m_opt(M,Opt):- + m_opt0(M,Opt1), + m_opt1(Opt1,Opt). + +m_opt1(Opt1,Opt):- symbolic_list_concat([Opt|_],'=',Opt1). + +m_opt0(M,Opt):- symbol_concat('--no-',Opt,M),!. +m_opt0(M,Opt):- symbol_concat('--',Opt,M),!. +m_opt0(M,Opt):- symbol_concat('-',Opt,M),!. + +:- set_prolog_flag(occurs_check,true). + +start_html_of(_Filename):- \+ tee_file(_TEE_FILE),!. +start_html_of(_Filename):-!. +start_html_of(_Filename):- + must_det_ll(( + S = _, + %retractall(metta_eq_def(Eq,S,_,_)), + nop(retractall(metta_type(S,_,_))), + %retractall(get_metta_atom(Eq,S,_,_,_)), + loonit_reset, + tee_file(TEE_FILE), + sformat(S,'cat /dev/null > "~w"',[TEE_FILE]), + + writeln(doing(S)), + ignore(shell(S)))). + +save_html_of(_Filename):- \+ tee_file(_TEE_FILE),!. +save_html_of(_):- \+ has_loonit_results, \+ option_value('html',true). +save_html_of(_):- loonit_report, !, writeln('
Return to summaries
'). +save_html_of(_Filename):-!. +save_html_of(Filename):- + must_det_ll(( + file_name_extension(Base,_,Filename), + file_name_extension(Base,'metta.html',HtmlFilename), + loonit_reset, + tee_file(TEE_FILE), + writeln('
Return to summaries
'), + sformat(S,'ansi2html -u < "~w" > "~w" ',[TEE_FILE,HtmlFilename]), + writeln(doing(S)), + ignore(shell(S)))). + +tee_file(TEE_FILE):- getenv('TEE_FILE',TEE_FILE),!. +tee_file(TEE_FILE):- metta_dir(Dir),directory_file_path(Dir,'TEE.ansi',TEE_FILE),!. + + +clear_spaces:- clear_space(_). +clear_space(S):- + retractall(user:loaded_into_kb(S,_)), + %retractall(metta_eq_def(_,S,_,_)), + nop(retractall(metta_type(S,_,_))), + retractall(metta_atom_asserted(S,_)). + +dcall(G):- call(G). + +lsm:- lsm(_). +lsm(S):- + listing(metta_file(S,_,_)), + %listing(mdyn_type(S,_,_,_)), + forall(mdyn_type(S,_,_,Src),color_g_mesg('#22a5ff',write_f_src(Src))), + nl,nl,nl, + forall(mdyn_defn(S,_,_,Src),color_g_mesg('#00ffa5',write_f_src(Src))), + %listing(mdyn_defn(S,_,_,_)), + !. + +write_f_src(H,B):- H=@=B,!,write_f_src(H). +write_f_src(H,B):- write_f_src(['=',H,B]). + +hb_f(HB,ST):- sub_term(ST,HB),(symbol(ST),ST\==(=),ST\==(:)),!. +write_f_src(HB):- + hb_f(HB,ST), + option_else(current_def,CST,[]),!, + (CST == ST -> true ; (nl,nl,nl,set_option_value_interp(current_def,ST))), + write_src(HB). + + + +debug_only(G):- notrace(ignore(catch_warn(G))). +debug_only(_What,G):- ignore((fail,notrace(catch_warn(G)))). + + +'True':- true. +'False':- fail. + + +'mettalog::vspace-main':- repl. + +into_underscores(D,U):- symbol(D),!,symbolic_list_concat(L,'-',D),symbolic_list_concat(L,'_',U). +into_underscores(D,U):- descend_and_transform(into_underscores,D,U),!. + + +descend_and_transform(P2, Input, Transformed) :- + ( var(Input) + -> Transformed = Input % Keep variables as they are + ; compound(Input) + -> (compound_name_arguments(Input, Functor, Args), + maplist(descend_and_transform(P2), Args, TransformedArgs), + compound_name_arguments(Transformed, Functor, TransformedArgs)) + ; (symbol(Input),call(P2,Input,Transformed)) + -> true % Transform atoms using xform_atom/2 + ; Transformed = Input % Keep other non-compound terms as they are + ). + +/* +is_syspred(H,Len,Pred):- notrace(is_syspred0(H,Len,Pred)). +is_syspred0(H,_Ln,_Prd):- \+ symbol(H),!,fail. +is_syspred0(H,_Ln,_Prd):- upcase_atom(H,U),downcase_atom(H,U),!,fail. +is_syspred0(H,Len,Pred):- current_predicate(H/Len),!,Pred=H. +is_syspred0(H,Len,Pred):- symbol_concat(Mid,'!',H), H\==Mid, is_syspred0(Mid,Len,Pred),!. +is_syspred0(H,Len,Pred):- into_underscores(H,Mid), H\==Mid, is_syspred0(Mid,Len,Pred),!. + +fn_append(List,X,Call):- + fn_append1(List,X,ListX), + into_fp(ListX,Call). + + + + + +is_metta_data_functor(Eq,F):- + current_self(Self),is_metta_data_functor(Eq,Self,F). + +is_metta_data_functor(Eq,Other,H):- + metta_type(Other,H,_), + \+ get_metta_atom(Eq,Other,[H|_]), + \+ metta_eq_def(Eq,Other,[H|_],_). +*/ +is_function(F):- symbol(F). + +is_False(X):- X\=='True', (is_False1(X)-> true ; (eval_H(X,Y),is_False1(Y))). +is_False1(Y):- (Y==0;Y==[];Y=='False'). + +is_conz(Self):- compound(Self), Self=[_|_]. + +%dont_x(eval_H(Depth,Self,metta_if(A=1,symbol_concat(metta_,_,F). +needs_expanded(eval_H(Term,_),Expand):- !,sub_term(Expand,Term),compound(Expand),Expand\=@=Term, + compound(Expand), \+ is_conz(Expand), \+ is_ftVar(Expand), needs_expand(Expand). +needs_expanded([A|B],Expand):- sub_term(Expand,[A|B]), compound(Expand), \+ is_conz(Expand), \+ is_ftVar(Expand), needs_expand(Expand). + +fn_append1(eval_H(Term,X),X,eval_H(Term,X)):-!. +fn_append1(Term,X,eval_H(Term,X)). + + + + + +assert_preds(Self,Load,List):- is_list(List),!,maplist(assert_preds(Self,Load),List). +%assert_preds(_Self,_Load,_Preds):- \+ show_transpiler,!. +assert_preds(_Self,Load,Preds):- + expand_to_hb(Preds,H,_B),functor(H,F,A), + if_t((show_transpiler), + color_g_mesg_ok('#005288',( + ignore(( + % \+ predicate_property(H,defined), + %if_t(is_transpiling,catch_i(dynamic(F,A))), + if_t( \+ predicate_property(H,defined), + not_compatio(format(' :- ~q.~n',[dynamic(F/A)]))), + if_t(option_value('tabling','True'), + not_compatio(format(' :- ~q.~n',[table(F/A)]))))), + not_compatio(format('~N~n ~@',[portray_clause(Preds)]))))), + + + if_t(is_transpiling, + if_t( \+ predicate_property(H,static), + %add_assertion(Self,Preds) + true)), + nop(metta_anew1(Load,Preds)). + + +%load_hook(_Load,_Hooked):- !. +load_hook(Load,Hooked):- + ignore(( \+ ((forall(load_hook0(Load,Hooked),true))))),!. + + +%rtrace_on_error(G):- catch(G,_,fail). +rtrace_on_error(G):- + catch_err(G,E, + (%notrace, + write_src_uo(E=G), + %catch(rtrace(G),E,throw(E)), + catch(rtrace(G),E,throw(give_up(E=G))), + throw(E))). + +rtrace_on_failure(G):- tracing,!,call(G). +rtrace_on_failure(G):- + catch_err((G*->true;(write_src_uo(rtrace_on_failure(G)), + ignore(rtrace(G)), + write_src_uo(rtrace_on_failure(G)), + !,fail)),E, + (%notrace, + write_src_uo(E=G), + %catch(rtrace(G),E,throw(E)), + catch(rtrace(G),E,throw(give_up(E=G))), + throw(E))). + +rtrace_on_failure_and_break(G):- tracing,!,call(G). +rtrace_on_failure_and_break(G):- + catch_err((G*->true;(write_src(rtrace_on_failure(G)), + ignore(rtrace(G)), + write_src(rtrace_on_failure(G)), + !,break,fail)),E, + (%notrace, + write_src_uo(E=G), + %catch(rtrace(G),E,throw(E)), + catch(rtrace(G),E,throw(give_up(E=G))), + throw(E))). + +assertion_hb(metta_eq_def(Eq,Self,H,B),Self,Eq,H,B):-!. +assertion_hb(metta_defn(Self,H,B),Self,'=',H,B):-!. +assertion_hb(metta_atom_asserted(KB,HB),Self,Eq,H,B):- !, assertion_hb(metta_atom(KB,HB),Self,Eq,H,B). +assertion_hb(metta_atom(Self,[Eq,H,B]),Self,Eq,H,B):- assert_type_cl(Eq),!. +assertion_hb(metta_atom(Self,[Eq,H|B]),Self,Eq,H,B):- assert_type_cl(Eq),!. + +assert_type_cl(Eq):- \+ symbol(Eq),!,fail. +assert_type_cl('='). +assert_type_cl(':-'). + + +load_hook0(_,_):- \+ show_transpiler, \+ is_transpiling, !. +load_hook0(Load,Assertion):- fail, + assertion_hb(Assertion,Self,H,B), + functs_to_preds([=,H,B],Preds), + assert_preds(Self,Load,Preds). +load_hook0(Load,Assertion):- fail, + assertion_hb(Assertion,Self, Eq, H,B), + rtrace_on_error(compile_for_assert_eq(Eq, H, B, Preds)),!, + rtrace_on_error(assert_preds(Self,Load,Preds)). +load_hook0(_,_):- \+ current_prolog_flag(metta_interp,ready),!. +/* +load_hook0(Load,get_metta_atom(Eq,Self,H)):- B = 'True', + H\=[':'|_], functs_to_preds([=,H,B],Preds), + assert_preds(Self,Load,Preds). +*/ +is_transpiling:- use_metta_compiler. +use_metta_compiler:- notrace(option_value('compile','full')), !. +preview_compiler:- \+ option_value('compile',false), !. +%preview_compiler:- use_metta_compiler,!. +show_transpiler:- option_value('code',Something), Something\==silent,!. +show_transpiler:- preview_compiler. + +option_switch_pred(F):- + current_predicate(F/0),interpreter_source_file(File), + source_file(F, File), \+ \+ (member(Prefix,[is_,show_,trace_on_]), symbol_concat(Prefix,_,F)). + +do_show_option_switches :- + forall(option_switch_pred(F),(call(F)-> writeln(yes(F)); writeln(not(F)))). +do_show_options_values:- + forall((nb_current(N,V), \+((symbol(N),symbol_concat('$',_,N)))),write_src_nl(['pragma!',N,V])), + do_show_option_switches. + +:- dynamic(metta_atom_asserted/2). +:- multifile(metta_atom_asserted/2). +:- dynamic(metta_atom_asserted_deduced/2). +:- multifile(metta_atom_asserted_deduced/2). +metta_atom_asserted(X,Y):- + metta_atom_asserted_deduced(X,Y), + \+ clause(metta_atom_asserted(X,Y),true). + +%get_metta_atom(Eq,KB, [F|List]):- KB='&flybase',fb_pred(F, Len), length(List,Len),apply(F,List). + + +get_metta_atom_from(KB,Atom):- metta_atom(KB,Atom). + +get_metta_atom(Eq,Space, Atom):- metta_atom(Space, Atom), \+ (Atom =[EQ,_,_], EQ==Eq). + +metta_atom(Atom):- current_self(KB),metta_atom(KB,Atom). +%metta_atom([Superpose,ListOf], Atom):- Superpose == 'superpose',is_list(ListOf),!,member(KB,ListOf),get_metta_atom_from(KB,Atom). +metta_atom(Space, Atom):- typed_list(Space,_,L),!, member(Atom,L). +metta_atom(KB, [F, A| List]):- KB=='&flybase',fb_pred_nr(F, Len),current_predicate(F/Len), length([A|List],Len),apply(F,[A|List]). +%metta_atom(KB,Atom):- KB=='&corelib',!, metta_atom_corelib(Atom). +metta_atom(KB,Atom):- metta_atom_in_file( KB,Atom). +metta_atom(KB,Atom):- metta_atom_asserted( KB,Atom). +metta_atom(KB,Atom):- KB \== '&corelib', !, should_inherit_from_corelib(Atom), metta_atom('&corelib',Atom). +should_inherit_from_corelib([H|_]):- nonvar(H),should_inherit_op_from_corelib(H). +should_inherit_op_from_corelib('='). +should_inherit_op_from_corelib(':'). + +metta_atom_asserted('&self','&corelib'). +metta_atom_asserted('&self','&stdlib'). +metta_atom_asserted('&stdlib','&corelib'). +metta_atom_asserted('&flybase','&corelib'). +metta_atom_asserted('&catalog','&corelib'). +metta_atom_asserted('&catalog','&stdlib'). + +/* +'mod-space'(top,'&self'). +'mod-space'(catalog,'&catalog'). +'mod-space'(corelib,'&corelib'). +'mod-space'(stdlib,'&stdlib'). +'mod-space'(Top,'&self'):- Top == self. +*/ + +%metta_atom_asserted_fallback( KB,Atom):- metta_atom_stdlib(KB,Atom) + + +%metta_atom(KB,[F,A|List]):- metta_atom(KB,F,A,List), F \== '=',!. +is_metta_space(Space):- \+ \+ is_space_type(Space,_Test). + +metta_eq_def(Eq,KB,H,B):- ignore(Eq = '='),if_or_else(metta_atom(KB,[Eq,H,B]),metta_atom_corelib(KB,[Eq,H,B])). + +%metta_defn(KB,Head,Body):- metta_eq_def(_Eq,KB,Head,Body). +metta_defn(KB,H,B):- metta_eq_def('=',KB,H,B). +metta_type(KB,H,B):- metta_eq_def(':',KB,H,B). +%metta_type(S,H,B):- S == '&corelib', metta_atom_stdlib_types([':',H,B]). +%typed_list(Cmpd,Type,List):- compound(Cmpd), Cmpd\=[_|_], compound_name_arguments(Cmpd,Type,[List|_]),is_list(List). + +metta_atom_corelib(KB,Atom):- KB\='&corelib',!,metta_atom('&corelib',Atom). + +%maybe_xform(metta_atom(KB,[F,A|List]),metta_atom(KB,F,A,List)):- is_list(List),!. +maybe_xform(metta_eq_def(Eq,KB,Head,Body),metta_atom(KB,[Eq,Head,Body])). +maybe_xform(metta_defn(KB,Head,Body),metta_atom(KB,['=',Head,Body])). +maybe_xform(metta_type(KB,Head,Body),metta_atom(KB,[':',Head,Body])). +maybe_xform(metta_atom(KB,HeadBody),metta_atom_asserted(KB,HeadBody)). +maybe_xform(_OBO,_XForm):- !, fail. + +metta_anew1(Load,_OBO):- var(Load),trace,!. +metta_anew1(Ch,OBO):- metta_interp_mode(Ch,Mode), !, metta_anew1(Mode,OBO). +metta_anew1(Load,OBO):- maybe_xform(OBO,XForm),!,metta_anew1(Load,XForm). +metta_anew1(load,OBO):- OBO= metta_atom(Space,Atom),!,'add-atom'(Space, Atom). +metta_anew1(unload,OBO):- OBO= metta_atom(Space,Atom),!,'remove-atom'(Space, Atom). +metta_anew1(unload_all,OBO):- OBO= forall(metta_atom(Space,Atom),ignore('remove-atom'(Space, Atom))). + +metta_anew1(load,OBO):- !, + must_det_ll((load_hook(load,OBO), + subst_vars(OBO,Cl), + pfcAdd_Now(Cl))). %to_metta(Cl). +metta_anew1(load,OBO):- !, + must_det_ll((load_hook(load,OBO), + subst_vars(OBO,Cl), + show_failure(pfcAdd_Now(Cl)))). +metta_anew1(unload,OBO):- subst_vars(OBO,Cl),load_hook(unload,OBO), + expand_to_hb(Cl,Head,Body), + predicate_property(Head,number_of_clauses(_)), + ignore((clause(Head,Body,Ref),clause(Head2,Body2,Ref), + (Head+Body)=@=(Head2+Body2),erase(Ref),pp_m(unload(Cl)))). +metta_anew1(unload_all,OBO):- subst_vars(OBO,Cl),load_hook(unload_all,OBO), + expand_to_hb(Cl,Head,Body), + predicate_property(Head,number_of_clauses(_)), + forall( + (clause(Head,Body,Ref),clause(Head2,Body2,Ref)), + must_det_ll((((Head+Body)=@=(Head2+Body2)) + ->(erase(Ref),nop(pp_m(unload_all(Ref,Cl)))) + ;(pp_m(unload_all_diff(Cl,(Head+Body)\=@=(Head2+Body2))))))). + + +/* +metta_anew2(Load,_OBO):- var(Load),trace,!. +metta_anew2(Load,OBO):- maybe_xform(OBO,XForm),!,metta_anew2(Load,XForm). +metta_anew2(Ch,OBO):- metta_interp_mode(Ch,Mode), !, metta_anew2(Mode,OBO). +metta_anew2(load,OBO):- must_det_ll((load_hook(load,OBO),subst_vars_not_last(OBO,Cl),assertz_if_new(Cl))). %to_metta(Cl). +metta_anew2(unload,OBO):- subst_vars_not_last(OBO,Cl),load_hook(unload,OBO), + expand_to_hb(Cl,Head,Body), + predicate_property(Head,number_of_clauses(_)), + ignore((clause(Head,Body,Ref),clause(Head2,Body2,Ref),(Head+Body)=@=(Head2+Body2),erase(Ref),pp_m(Cl))). +metta_anew2(unload_all,OBO):- subst_vars_not_last(OBO,Cl),load_hook(unload_all,OBO), + expand_to_hb(Cl,Head,Body), + predicate_property(Head,number_of_clauses(_)), + forall((clause(Head,Body,Ref),clause(Head2,Body2,Ref),(Head+Body)=@=(Head2+Body2),erase(Ref),pp_m(Cl)),true). +*/ + +metta_anew(Load,Src,OBO):- maybe_xform(OBO,XForm),!,metta_anew(Load,Src,XForm). +metta_anew(Ch, Src, OBO):- metta_interp_mode(Ch,Mode), !, metta_anew(Mode,Src,OBO). +metta_anew(Load,_Src,OBO):- silent_loading,!,metta_anew1(Load,OBO). +metta_anew(Load,Src,OBO):- + not_compat_io(( + if_show(load,color_g_mesg('#ffa500', ((format('~N '), write_src(Src))))), + % format('~N'), + if_verbose(load,color_g_mesg('#0f0f0f',(write(' ; Action: '),writeq(Load=OBO),nl))))), + metta_anew1(Load,OBO),not_compat_io((format('~N'))). + +subst_vars_not_last(A,B):- + functor(A,_F,N),arg(N,A,E), + subst_vars(A,B), + nb_setarg(N,B,E),!. + +con_write(W):-check_silent_loading, not_compat_io((write(W))). +con_writeq(W):-check_silent_loading, not_compat_io((writeq(W))). +writeqln(Q):- check_silent_loading,not_compat_io((write(' '),con_writeq(Q),connl)). + + +into_space(Self,'&self',Self):-!. +into_space(_,Other,Other):-!. + + +into_space(Self,Myself,SelfO):- into_space(30,Self,Myself,SelfO). + +into_space(_Dpth,Self,Myself,Self):-Myself=='&self',!. +into_space(_Dpth,Self,None,Self):- 'None' == None,!. +into_space(Depth,Self,Other,Result):- eval_H(Depth,Self,Other,Result). +into_name(_,Other,Other). + +%eval_f_args(Depth,Self,F,ARGS,[F|EARGS]):- maplist(eval_H(Depth,Self),ARGS,EARGS). + + +combine_result(TF,R2,R2):- TF == [], !. +combine_result(TF,_,TF):-!. + + +do_metta1_e(_Self,_,exec(Exec)):- !,write_exec(Exec),!. +do_metta1_e(_Self,_,[=,A,B]):- !, with_concepts(false, + (con_write('(= '), with_indents(false,write_src(A)), + (is_list(B) -> connl ; true), + con_write(' '),with_indents(true,write_src(B)),con_write(')'))),connl. +do_metta1_e(_Self,_LoadExec,Term):- write_src(Term),connl. + +write_exec(Exec):- real_notrace(write_exec0(Exec)). +%write_exec0(Exec):- symbol(Exec),!,write_exec0([Exec]). + +write_exec0(Exec):- + wots(S,write_src(exec(Exec))), + nb_setval(exec_src,Exec), + format('~N'), + ignore((notrace((color_g_mesg('#0D6328',writeln(S)))))). + +%!(let* (( ($a $b) (collapse (get-atoms &self)))) ((bind! &stdlib $a) (bind! &corelib $b))) + +asserted_do_metta(Space,Ch,Src):- metta_interp_mode(Ch,Mode), !, asserted_do_metta(Space,Mode,Src). + +asserted_do_metta(Space,Load,Src):- Load==exec,!,do_metta_exec(python,Space,Src,_Out). +asserted_do_metta(Space,Load,Src):- asserted_do_metta2(Space,Load,Src,Src). + +asserted_do_metta2(Space,Ch,Info,Src):- nonvar(Ch), metta_interp_mode(Ch,Mode), !, asserted_do_metta2(Space,Mode,Info,Src). +/* +asserted_do_metta2(Self,Load,[TypeOp,Fn,Type], Src):- TypeOp == ':', \+ is_list(Type),!, + must_det_ll(( + color_g_mesg_ok('#ffa501',metta_anew(Load,Src,metta_atom(Self,[':',Fn,Type]))))),!. + +asserted_do_metta2(Self,Load,[TypeOp,Fn,TypeDecL], Src):- TypeOp == ':',!, + must_det_ll(( + decl_length(TypeDecL,Len),LenM1 is Len - 1, last_element(TypeDecL,LE), + color_g_mesg_ok('#ffa502',metta_anew(Load,Src,metta_atom(Self,[':',Fn,TypeDecL]))), + metta_anew1(Load,metta_arity(Self,Fn,LenM1)), + arg_types(TypeDecL,[],EachArg), + metta_anew1(Load,metta_params(Self,Fn,EachArg)),!, + metta_anew1(Load,metta_last(Self,Fn,LE)))). +*/ +/* +asserted_do_metta2(Self,Load,[TypeOp,Fn,TypeDecL,RetType], Src):- TypeOp == ':',!, + must_det_ll(( + decl_length(TypeDecL,Len), + append(TypeDecL,[RetType],TypeDecLRet), + color_g_mesg_ok('#ffa503',metta_anew(Load,Src,metta_atom(Self,[':',Fn,TypeDecLRet]))), + metta_anew1(Load,metta_arity(Self,Fn,Len)), + arg_types(TypeDecL,[RetType],EachArg), + metta_anew1(Load,metta_params(Self,Fn,EachArg)), + metta_anew1(Load,metta_return(Self,Fn,RetType)))),!. +*/ +/*do_metta(File,Self,Load,PredDecl, Src):-fail, + metta_anew(Load,Src,metta_atom(Self,PredDecl)), + ignore((PredDecl=['=',Head,Body], metta_anew(Load,Src,metta_eq_def(Eq,Self,Head,Body)))), + ignore((Body == 'True',!,do_metta(File,Self,Load,Head))), + nop((fn_append(Head,X,Head), fn_append(PredDecl,X,Body), + metta_anew((Head:- Body)))),!.*/ +/* +asserted_do_metta2(Self,Load,[EQ,Head,Result], Src):- EQ=='=', !, + color_g_mesg_ok('#ffa504',must_det_ll(( + discover_head(Self,Load,Head), + metta_anew(Load,Src,metta_eq_def(EQ,Self,Head,Result)), + discover_body(Self,Load,Result)))). +*/ +asserted_do_metta2(Self,Load,PredDecl, Src):- + %ignore(discover_head(Self,Load,PredDecl)), + color_g_mesg_ok('#ffa505',metta_anew(Load,Src,metta_atom(Self,PredDecl))). + +never_compile(X):- always_exec(X). + +always_exec(exec(W)):- !, is_list(W), always_exec(W). +always_exec(Comp):- compound(Comp),compound_name_arity(Comp,Name,N),symbol_concat('eval',_,Name),Nm1 is N-1, arg(Nm1,Comp,TA),!,always_exec(TA). +always_exec(List):- \+ is_list(List),!,fail. +always_exec([Var|_]):- \+ symbol(Var),!,fail. +always_exec(['extend-py!'|_]):- !, fail. +always_exec([H|_]):- symbol_concat(_,'!',H),!. %pragma!/print!/transfer!/include! etc +always_exec(['assertEqualToResult'|_]):-!,fail. +always_exec(['assertEqual'|_]):-!,fail. +always_exec(_):-!,fail. % everything else + +file_hides_results([W|_]):- W== 'pragma!'. + +if_t(A,B,C):- trace,if_t((A,B),C). + +check_answers_for(_,_):- nb_current(suspend_answers,true),!,fail. +check_answers_for(TermV,Ans):- (string(TermV);var(Ans);var(TermV)),!,fail. +check_answers_for(TermV,_):- sformat(S,'~q',[TermV]),atom_contains(S,"[assert"),!,fail. +check_answers_for(_,Ans):- contains_var('BadType',Ans),!,fail. +check_answers_for(TermV,_):- inside_assert(TermV,BaseEval), always_exec(BaseEval),!,fail. + +%check_answers_for([TermV],Ans):- !, check_answers_for(TermV,Ans). +%check_answers_for(TermV,[Ans]):- !, check_answers_for(TermV,Ans). +check_answers_for(_,_). + + /* +got_exec_result2(Val,Nth,Ans):- is_list(Ans), exclude(==(','),Ans,Ans2), Ans\==Ans2,!, + got_exec_result2(Val,Nth,Ans2). +got_exec_result2(Val,Nth,Ans):- + must_det_ll(( + Nth100 is Nth+100, + get_test_name(Nth100,TestName), + nb_current(exec_src,Exec), + if_t( ( \+ is_unit_test_exec(Exec)), + ((equal_enough(Val,Ans) + -> write_pass_fail_result_now(TestName,exec,Exec,'PASS',Ans,Val) + ; write_pass_fail_result_now(TestName,exec,Exec,'FAIL',Ans,Val)))))). + +write_pass_fail_result_now(TestName,exec,Exec,PASS_FAIL,Ans,Val):- + (PASS_FAIL=='PASS'->flag(loonit_success, X, X+1);flag(loonit_failure, X, X+1)), + (PASS_FAIL=='PASS'->Color=cyan;Color=red), + color_g_mesg(Color,write_pass_fail_result_c(TestName,exec,Exec,PASS_FAIL,Ans,Val)),!,nl, + nl,writeln('--------------------------------------------------------------------------'),!. + +write_pass_fail_result_c(TestName,exec,Exec,PASS_FAIL,Ans,Val):- + nl,write_mobj(exec,[(['assertEqualToResult',Exec,Ans])]), + nl,write_src('!'(['assertEqual',Val,Ans])), + write_pass_fail_result(TestName,exec,Exec,PASS_FAIL,Ans,Val). +*/ + +is_unit_test_exec(Exec):- sformat(S,'~w',[Exec]),sub_atom(S,_,_,_,'assert'). +is_unit_test_exec(Exec):- sformat(S,'~q',[Exec]),sub_atom(S,_,_,_,"!',"). + +make_empty(Empty):- 'Empty'=Empty. +make_empty(_,Empty):- make_empty(Empty). +make_empty(_RetType,_,Empty):- make_empty(Empty). + + +make_nop(Nop):- []=Nop. +make_nop(_,Nop):- make_nop(Nop). +make_nop(_RetType,_,Nop):- make_nop(Nop). + + +convert_tax(_How,Self,Tax,Expr,NewHow):- + metta_interp_mode(Ch,Mode), + string_concat(Ch,TaxM,Tax),!, + normalize_space(string(NewTax),TaxM), + convert_tax(Mode,Self,NewTax,Expr,NewHow). +convert_tax(How,_Self,Tax,Expr,How):- + %parse_sexpr_metta(Tax,Expr). + normalize_space(string(NewTax),Tax), + parse_sexpr_metta1(NewTax,Expr). + +%:- if( \+ current_predicate(notrace/1) ). +% notrace(G):- once(G). +%:- endif. + +metta_interp_mode('+',load). +metta_interp_mode('-',unload). +metta_interp_mode('--',unload_all). +metta_interp_mode('!',exec). +metta_interp_mode('?',call). +metta_interp_mode('^',load_like_file). + + +call_sexpr(How,Self,Tax,_S,Out):- + (symbol(Tax);string(Tax)), + normalize_space(string(TaxM),Tax), + convert_tax(How,Self,TaxM,Expr,NewHow),!, + show_call(do_metta(python,NewHow,Self,Expr,Out)). + +/* +do_metta(File,Load,Self,Cmt,Out):- + fail, + if_trace(do_metta, fbug(do_metta(File,Load,Self,Cmt,Out))),fail. +*/ + +do_metta(_File,_Load,_Self,In,Out):- var(In),!,In=Out. +do_metta(_From,_Mode,_Self,end_of_file,'Empty'):- !. %, halt(7), writeln('\n\n% To restart, use: ?- repl.'). +do_metta(_File,Load,_Self,Cmt,Out):- Load \==exec, Cmt==[],!, ignore(Out=[]). + +do_metta(From,Load,Self,'$COMMENT'(Expr,_,_),Out):- !, do_metta(From,comment(Load),Self,Expr,Out). +do_metta(From,Load,Self,'$STRING'(Expr),Out):- !, do_metta(From,comment(Load),Self,Expr,Out). +do_metta(From,comment(Load),Self,[Expr],Out):- !, do_metta(From,comment(Load),Self,Expr,Out). +do_metta(From,comment(Load),Self,Cmt,Out):- write_comment(Cmt), !, + ignore(( symbolic(Cmt),symbolic_list_concat([_,Src],'MeTTaLog only: ',Cmt),!,atom_string(Src,SrcCode),do_metta(mettalog_only(From),Load,Self,SrcCode,Out))), + ignore(( symbolic(Cmt),symbolic_list_concat([_,Src],'MeTTaLog: ',Cmt),!,atom_string(Src,SrcCode),do_metta(mettalog_only(From),Load,Self,SrcCode,Out))),!. + +do_metta(From,How,Self,Src,Out):- string(Src),!, + normalize_space(string(TaxM),Src), + convert_tax(How,Self,TaxM,Expr,NewHow),!, + do_metta(From,NewHow,Self,Expr,Out). + +do_metta(From,_,Self,exec(Expr),Out):- !, do_metta(From,exec,Self,Expr,Out). +do_metta(From,_,Self, call(Expr),Out):- !, do_metta(From,call,Self,Expr,Out). +do_metta(From,_,Self, ':-'(Expr),Out):- !, do_metta(From,call,Self,Expr,Out). +do_metta(From,call,Self,TermV,FOut):- !, + if_t(into_simple_op(call,TermV,OP),pfcAdd_Now('next-operation'(OP))), + call_for_term_variables(TermV,Term,NamedVarsList,X), must_be(nonvar,Term), + copy_term(NamedVarsList,Was), + Output = NamedVarsList, + user:interactively_do_metta_exec(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut). + +do_metta(_File,Load,Self,Src,Out):- Load\==exec, !, + if_t(into_simple_op(Load,Src,OP),pfcAdd_Now('next-operation'(OP))), + dont_give_up(as_tf(asserted_do_metta(Self,Load,Src),Out)). + +do_metta(file(Filename),exec,Self,TermV,Out):- + must_det_ll((inc_exec_num(Filename), + get_exec_num(Filename,Nth), + Nth>0)), + (( + is_synthing_unit_tests, + file_answers(Filename, Nth, Ans), + check_answers_for(TermV,Ans))),!, + if_t(into_simple_op(exec,TermV,OP),pfcAdd_Now('next-operation'(OP))), + must_det_ll(( + ensure_increments((color_g_mesg_ok('#ffa509', + (writeln(';; In file as: '), + color_g_mesg([bold,fg('#FFEE58')], write_src(exec(TermV))), + write(';; To unit test case:'))),!, + call(do_metta_exec(file(Filename),Self,['assertEqualToResult',TermV,Ans],Out)))))). + +do_metta(From,exec,Self,TermV,Out):- !, + if_t(into_simple_op(exec,TermV,OP),pfcAdd_Now('next-operation'(OP))), + dont_give_up(do_metta_exec(From,Self,TermV,Out)). + +do_metta_exec(From,Self,TermV,FOut):- + Output = X, + ignore(catch(((not_compatio(write_exec(TermV)), + notrace(into_metta_callable(Self,TermV,Term,X,NamedVarsList,Was)),!, + user:interactively_do_metta_exec(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut))), + give_up(Why),pp_m(red,gave_up(Why)))),!. + + +o_s(['assertEqual'|O],S):- o_s(O,S). +o_s(['assertEqualToResult'|O],S):- o_s(O,S). +o_s([O|_],S):- !, o_s(O,S). +o_s(S,S). +into_simple_op(Load,[Op|O],op(Load,Op,S)):- o_s(O,S),!. + +call_for_term_variables(TermV,catch_red(show_failure(Term)),NamedVarsList,X):- + term_variables(TermV, AllVars), call_for_term_variables4v(TermV,AllVars,Term,NamedVarsList,X),!, + must_be(callable,Term). +call_for_term_variables(TermV,catch_red(show_failure(Term)),NamedVarsList,X):- + get_term_variables(TermV, DCAllVars, Singletons, NonSingletons), + call_for_term_variables5(TermV, DCAllVars, Singletons, NonSingletons, Term,NamedVarsList,X),!, + must_be(callable,Term). + +into_metta_callable(_Self,TermV,Term,X,NamedVarsList,Was):- \+ never_compile(TermV), + is_transpiling, !, + must_det_ll(((( + + % ignore(Res = '$VAR'('ExecRes')), + RealRes = Res, + compile_for_exec(Res,TermV,ExecGoal),!, + subst_vars(Res+ExecGoal,Res+Term,NamedVarsList), + copy_term_g(NamedVarsList,Was), + term_variables(Term,Vars), + %notrace((color_g_mesg('#114411',print_pl_source(answer(Res):-ExecGoal)))), + %nl,writeq(Term),nl, + ((\+ \+ + ((numbervars(v(TermV,Term,NamedVarsList,Vars),999,_,[attvar(bind)]), + %nb_current(variable_names,NamedVarsList), + %nl,print(subst_vars(Term,NamedVarsList,Vars)), + nop(nl))))), + nop(maplist(verbose_unify,Vars)), + %NamedVarsList=[_=RealRealRes|_], + var(RealRes), X = RealRes)))),!. + + +into_metta_callable(Self,TermV,CALL,X,NamedVarsList,Was):-!, + option_else('stack-max',StackMax,100), + CALL = eval_H(StackMax,Self,Term,X), + notrace(( must_det_ll(( + if_t(show_transpiler,write_compiled_exec(TermV,_Goal)), + subst_vars(TermV,Term,NamedVarsList), + copy_term_g(NamedVarsList,Was) + %term_variables(Term,Vars), + %nl,writeq(Term),nl, + %skip((\+ \+ + %((numbervars(v(TermV,Term,NamedVarsList,Vars),999,_,[attvar(bind)]), %nb_current(variable_names,NamedVarsList), + %nl,print(subst_vars(TermV,Term,NamedVarsList,Vars)),nl)))), + %nop(maplist(verbose_unify,Vars)))))),!. + )))),!. + + + +eval_S(Self,Form):- nonvar(Form), + current_self(SelfS),SelfS==Self,!, + do_metta(true,exec,Self,Form,_Out). +eval_H(Term,X):- catch_metta_return(eval_args(Term,X),X). +eval_H(StackMax,Self,Term,X):- catch_metta_return(eval_args('=',_,StackMax,Self,Term,X),X). +/* +eval_H(StackMax,Self,Term,X). + +eval_H(StackMax,Self,Term,X):- + Time = 90.0, + ((always_exec(Term)) -> + if_or_else(t1('=',_,StackMax,Self,Term,X), + (t2('=',_,StackMax,Self,Term,X))); + call_max_time(t1('=',_,StackMax,Self,Term,X), Time, + (t2('=',_,StackMax,Self,Term,X)))). + +eval_H(Term,X):- + current_self(Self), StackMax = 100, + if_or_else((t1('=',_,StackMax,Self,Term,X),X\==Term),(t2('=',_,StackMax,Self,Term,X),nop(X\==Term))). + + +t1('=',_,StackMax,Self,Term,X):- eval_args('=',_,StackMax,Self,Term,X). +t2('=',_,StackMax,Self,Term,X):- fail, subst_args('=',_,StackMax,Self,Term,X). +*/ + +%eval_H(Term,X):- if_or_else((subst_args(Term,X),X\==Term),(eval_args(Term,Y),Y\==Term)). + +print_goals(TermV):- write_src(TermV). + + +if_or_else(Goal,Else):- call(Goal)*->true;call(Else). + +interacting:- tracing,!. +interacting:- current_prolog_flag(debug,true),!. +interacting:- option_value(interactive,true),!. +interacting:- option_value(prolog,true),!. + +% call_max_time(+Goal, +MaxTime, +Else) +call_max_time(Goal,_MaxTime, Else) :- interacting,!, if_or_else(Goal,Else). +call_max_time(Goal,_MaxTime, Else) :- !, if_or_else(Goal,Else). +call_max_time(Goal, MaxTime, Else) :- + catch(if_or_else(call_with_time_limit(MaxTime, Goal),Else), time_limit_exceeded, Else). + + +catch_err(G,E,C):- catch(G,E,(always_rethrow(E)->(throw(E));C)). +dont_give_up(G):- catch(G,give_up(E),write_src_uo(dont_give_up(E))). + +not_in_eq(List, Element) :- + member(V, List), V == Element. + +:- ensure_loaded(metta_repl). + + +:- nodebug(metta(eval)). +:- nodebug(metta(exec)). +:- nodebug(metta(load)). +:- nodebug(metta(prolog)). +% Measures the execution time of a Prolog goal and displays the duration in seconds, +% milliseconds, or microseconds, depending on the execution time. +% +% Args: +% - Goal: The Prolog goal to be executed and timed. +% +% The predicate uses the `statistics/2` predicate to measure the CPU time before +% and after executing the provided goal. It calculates the elapsed time in seconds +% and converts it to milliseconds and microseconds. The output is formatted to +% provide clear timing information: +% +% - If the execution takes more than 2 seconds, it displays the time in seconds. +% - If the execution takes between 1 millisecond and 2 seconds, it displays the time +% in milliseconds. +% - If the execution takes less than 1 millisecond, it displays the time in microseconds. +% +% Example usage: +% ?- time_eval(my_goal(X)). +% +% ?- time_eval(sleep(0.95)). +% +% Output examples: +% ; Evaluation took 2.34 seconds. +% ; Evaluation took 123.45 ms. +% ; Evaluation took 0.012 ms. (12.33 microseconds) +% +time_eval(Goal):- + time_eval('Evaluation',Goal). +time_eval(What,Goal) :- + timed_call(Goal,Seconds), + give_time(What,Seconds). + +give_time(_What,_Seconds):- is_compatio,!. +give_time(What,Seconds):- + Milliseconds is Seconds * 1_000, + (Seconds > 2 + -> format('~N; ~w took ~2f seconds.~n~n', [What, Seconds]) + ; (Milliseconds >= 1 + -> format('~N; ~w took ~3f secs. (~2f milliseconds) ~n~n', [What, Seconds, Milliseconds]) + ;( Micro is Milliseconds * 1_000, + format('~N; ~w took ~6f secs. (~2f microseconds) ~n~n', [What, Seconds, Micro])))). + +timed_call(Goal,Seconds):- + statistics(cputime, Start), + ( \+ rtrace_this(Goal)->rtrace_on_error(Goal);rtrace(Goal)), + statistics(cputime, End), + Seconds is End - Start. + +rtrace_this(eval_H(_, _, P , _)):- compound(P), !, rtrace_this(P). +rtrace_this([P|_]):- P == 'pragma!',!,fail. +rtrace_this([P|_]):- P == 'import!',!,fail. +rtrace_this([P|_]):- P == 'rtrace!',!. +rtrace_this(_Call):- option_value(rtrace,true),!. +rtrace_this(_Call):- is_debugging(rtrace),!. + +%:- nb_setval(cmt_override,lse('; ',' !(" ',' ") ')). + +:- abolish(fbug/1). +fbug(_):- is_compatio,!. +fbug(Info):- real_notrace(in_cmt(color_g_mesg('#2f2f2f',write_src(Info)))). +example0(_):- fail. +example1(a). example1(_):- fail. +example2(a). example2(b). example2(_):- fail. +example3(a). example3(b). example3(c). example3(_):- fail. +%eval_H(100,'&self',['change-state!','&var',[+,1,['get-state','&var']]],OUT) +%dcall(X):- (call(X),deterministic(YN)),trace,((YN==true)->!;true). +chkdet_call(XX):- !, call(XX). +chkdet_call0(XX):- !, call(XX). + +dcall0000000000(XX):- + USol = sol(dead), + copy_term_g(XX,X), + call_nth(USol,X,Nth,Det,Prev), + %fbug(call_nth(USol,X,Nth,Det,Prev)), + XX=Prev, + (Det==yes -> (!, (XX=Prev;XX=X)) ; + (((var(Nth) -> ( ! , Prev\==dead) ; + true), + (Nth==1 -> ! ; true)))). + +call_nth(USol,XX,Nth,Det,Prev):- + repeat, + ((call_nth(XX,Nth),deterministic(Det),arg(1,USol,Prev))*-> + ( nb_setarg(1,USol,XX)) + ; (!, arg(1,USol,Prev))). + +catch_red(Term):- catch_err(Term,E,pp_m(red,in(Term,E))). +%catch_red(Term):- call(Term). + +s2p(I,O):- sexpr_s2p(I,O),!. + +discover_head(Self,Load,Head):- + ignore(([Fn|PredDecl]=Head, + nop(( arg_types(PredDecl,[],EachArg), + metta_anew1(Load,metta_head(Self,Fn,EachArg)))))). + +discover_body(Self,Load,Body):- + nop(( [Fn|PredDecl] = Body, arg_types(PredDecl,[],EachArg), + metta_anew1(Load,metta_body(Self,Fn,EachArg)))). + +decl_length(TypeDecL,Len):- is_list(TypeDecL),!,length(TypeDecL,Len). +decl_length(_TypeDecL,1). + +arg_types([Ar|L],R,LR):- Ar == '->', !, arg_types(L,R,LR). +arg_types([[Ar|L]],R,LR):- Ar == '->', !, arg_types(L,R,LR). +arg_types(L,R,LR):- append(L,R,LR). + +%:- ensure_loaded('../../examples/factorial'). +%:- ensure_loaded('../../examples/fibonacci'). + +%print_preds_to_functs:-preds_to_functs_src(factorial_tail_basic) +ggtrace(G):- call(G). +ggtrace0(G):- ggtrace, + leash(-all), + visible(-all), + % debug, + %visible(+redo), + visible(+call), + visible(+exception), + maybe_leash(+exception), + setup_call_cleanup(trace,G,notrace). +:- dynamic(began_loon/1). +loon:- loon(typein). + + +catch_red_ignore(G):- if_or_else(catch_red(G),true). + +:- export(loon/1). +:- public(loon/1). + + +%loon(Why):- began_loon(Why),!,fbugio(begun_loon(Why)). +loon(Why):- is_compiling,!,fbug(compiling_loon(Why)),!. +%loon( _Y):- current_prolog_flag(os_argv,ArgV),member('-s',ArgV),!. +% Why\==toplevel,Why\==default, Why\==program,! +loon(Why):- is_compiled, Why\==toplevel,!,fbugio(compiled_loon(Why)),!. +loon(Why):- began_loon(_),!,fbugio(skip_loon(Why)). +loon(Why):- fbugio(began_loon(Why)), assert(began_loon(Why)), + do_loon. + +do_loon:- + ignore(( + \+ prolog_load_context(reloading,true), + maplist(catch_red_ignore,[ + + %if_t(is_compiled,ensure_mettalog_py), + install_readline_editline, + %nts1, + %install_ontology, + metta_final, + % ensure_corelib_types, + set_output_stream, + if_t(is_compiled,update_changed_files), + run_cmd_args, + write_answer_output, + maybe_halt(7)]))),!. + + +need_interaction:- \+ option_value('had_interaction',true), + \+ is_converting, \+ is_compiling, \+ is_pyswip,!, + option_value('prolog',false), option_value('repl',false), \+ metta_file(_Self,_Filename,_Directory). + +pre_halt1:- is_compiling,!,fail. +pre_halt1:- loonit_report,fail. +pre_halt2:- is_compiling,!,fail. +pre_halt2:- option_value('prolog',true),!,set_option_value('prolog',started),call_cleanup(prolog,pre_halt2). +pre_halt2:- option_value('repl',true),!,set_option_value('repl',started),call_cleanup(repl,pre_halt2). +pre_halt2:- need_interaction, set_option_value('had_interaction',true),call_cleanup(repl,pre_halt2). + +%loon:- time(loon_metta('./examples/compat/test_scripts/*.metta')),fail. +%loon:- repl, (option_value('halt',false)->true;halt(7)). +%maybe_halt(Seven):- option_value('prolog',true),!,call_cleanup(prolog,(set_option_value_interp('prolog',false),maybe_halt(Seven))). +%maybe_halt(Seven):- option_value('repl',true),!,call_cleanup(repl,(set_option_value_interp('repl',false),maybe_halt(Seven))). +%maybe_halt(Seven):- option_value('repl',true),!,halt(Seven). + +maybe_halt(_):- once(pre_halt1), fail. +maybe_halt(Seven):- option_value('repl',false),!,halt(Seven). +maybe_halt(Seven):- option_value('halt',true),!,halt(Seven). +maybe_halt(_):- once(pre_halt2), fail. +maybe_halt(Seven):- fbugio(maybe_halt(Seven)), fail. +%maybe_halt(_):- !. +maybe_halt(H):- halt(H). + + +:- initialization(nb_setval(cmt_override,lse('; ',' !(" ',' ") ')),restore). + + +%needs_repl:- \+ is_converting, \+ is_pyswip, \+ is_compiling, \+ has_file_arg. +% libswipl: ['./','-q',--home=/usr/local/lib/swipl] + +:- initialization(show_os_argv). + +:- initialization(loon(program),program). +:- initialization(loon(default)). + +ensure_mettalog_system_compilable:- + %ensure_loaded(library(metta_python)), + ensure_mettalog_system. +ensure_mettalog_system:- + abolish(began_loon/1), + dynamic(began_loon/1), + system:use_module(library(quasi_quotations)), + system:use_module(library(hashtable)), + system:use_module(library(gensym)), + system:use_module(library(sort)), + system:use_module(library(writef)), + system:use_module(library(rbtrees)), + system:use_module(library(dicts)), + system:use_module(library(shell)), + system:use_module(library(edinburgh)), + % system:use_module(library(lists)), + system:use_module(library(statistics)), + system:use_module(library(nb_set)), + system:use_module(library(assoc)), + system:use_module(library(pairs)), + if_t(exists_source(library(swi_ide)),user:use_module(library(swi_ide))), + user:use_module(library(prolog_profile)), + %metta_python, + %ensure_loaded('./src/main/flybase_convert'), + %ensure_loaded('./src/main/flybase_main'), + %ensure_loaded(library(flybase_convert)), + %ensure_loaded(library(flybase_main)), + autoload_all, + make, + autoload_all, + %pack_install(predicate_streams, [upgrade(true),global(true)]), + %pack_install(logicmoo_utils, [upgrade(true),global(true)]), + %pack_install(dictoo, [upgrade(true),global(true)]), + !. + +file_save_name(E,_):- \+ symbol(E),!,fail. +file_save_name(E,Name):- file_base_name(E,BN),BN\==E,!,file_save_name(BN,Name). +file_save_name(E,E):- symbol_concat('Sav.',_,E),!. +file_save_name(E,E):- symbol_concat('Bin.',_,E),!. +before_underscore(E,N):-symbolic_list_concat([N|_],'_',E),!. +save_name(Name):- current_prolog_flag(os_argv,ArgV),member(E,ArgV),file_save_name(E,Name),!. +next_save_name(Name):- save_name(E), + before_underscore(E,N), + symbol_concat(N,'_',Stem), + gensym(Stem,Name), + \+ exists_file(Name), + Name\==E,!. +next_save_name(SavMeTTaLog):- option_value(exeout,SavMeTTaLog), + symbolic(SavMeTTaLog),atom_length(SavMeTTaLog,Len),Len>1,!. +next_save_name('Sav.MeTTaLog'). +qcompile_mettalog:- + ensure_mettalog_system, + option_value(exeout,Named), + catch_err(qsave_program(Named, + [class(development),autoload(true),goal(loon(goal)), + toplevel(loon(toplevel)), stand_alone(true)]),E,writeln(E)), + halt(0). +qsave_program:- ensure_mettalog_system, next_save_name(Name), + catch_err(qsave_program(Name, + [class(development),autoload(true),goal(loon(goal)), toplevel(loon(toplevel)), stand_alone(false)]),E,writeln(E)), + !. + + +:- ensure_loaded(library(flybase_main)). +:- ensure_loaded(metta_server). +:- initialization(update_changed_files,restore). + +nts1:- !. % disable redefinition +nts1:- redefine_system_predicate(system:notrace/1), + %listing(system:notrace/1), + abolish(system:notrace/1), + dynamic(system:notrace/1), + meta_predicate(system:notrace(0)), + asserta((system:notrace(G):- (!,once(G)))). +nts1:- !. + +:- nts1. + +nts0:- redefine_system_predicate(system:notrace/0), + abolish(system:notrace/0), + asserta((system:notrace:- wdmsg(notrace))). +%:- nts0. + +override_portray:- + forall( + clause(user:portray(List), Where:Body, Cl), + (assert(user:portray_prev(List):- Where:Body), + erase(Cl))), + asserta((user:portray(List) :- metta_portray(List))). + +metta_message_hook(A, B, C) :- + user: + ( B==error, + fbug(metta_message_hook(A, B, C)), + fail + ). + +override_message_hook:- + forall( + clause(user:message_hook(A,B,C), Where:Body, Cl), + (assert(user:message_hook(A,B,C):- Where:Body), erase(Cl))), + asserta((user:message_hook(A,B,C) :- metta_message_hook(A,B,C))). + +fix_message_hook:- + clause(message_hook(A, B, C), + user: + ( B==error, + fbug(user:message_hook(A, B, C)), + fail + ), Cl),erase(Cl). + +:- unnullify_output. + +%:- ensure_loaded(metta_python). + +%:- ensure_loaded('../../library/genome/flybase_loader'). + +:- ensure_loaded(metta_python). +:- initialization(use_corelib_file). + +:- ignore((( + use_corelib_file, + (is_testing -> UNIT_TEST=true; UNIT_TEST=false), + set_is_unit_test(UNIT_TEST), + \+ prolog_load_context(reloading,true), + initialization(loon(restore),restore), + % nts1, + metta_final + ))). + +:- set_prolog_flag(metta_interp,ready). + +:- use_module(library(clpr)). % Import the CLP(R) library +%:- ensure_loaded('metta_ontology.pfc.pl'). + +% Define a predicate to relate the likelihoods of three events +complex_relationship3_ex(Likelihood1, Likelihood2, Likelihood3) :- + { Likelihood1 = 0.3 * Likelihood2 }, + { Likelihood2 = 0.5 * Likelihood3 }, + { Likelihood3 < 1.0 }, + { Likelihood3 > 0.0 }. + +% Example query to find the likelihoods that satisfy the constraints +%?- complex_relationship(L1, L2, L3). diff --git a/.Attic/canary_docme/metta_loader.pl b/.Attic/canary_docme/metta_loader.pl new file mode 100644 index 00000000000..5f2a0b50767 --- /dev/null +++ b/.Attic/canary_docme/metta_loader.pl @@ -0,0 +1,1172 @@ +/* + * Project: MeTTaLog - A MeTTa to Prolog Transpiler/Interpreter + * Description: This file is part of the source code for a transpiler designed to convert + * MeTTa language programs into Prolog, utilizing the SWI-Prolog compiler for + * optimizing and transforming function/logic programs. It handles different + * logical constructs and performs conversions between functions and predicates. + * + * Author: Douglas R. Miles + * Contact: logicmoo@gmail.com / dmiles@logicmoo.org + * License: LGPL + * Repository: https://github.com/trueagi-io/metta-wam + * https://github.com/logicmoo/hyperon-wam + * Created Date: 8/23/2023 + * Last Modified: $LastChangedDate$ # You will replace this with Git automation + * + * Usage: This file is a part of the transpiler that transforms MeTTa programs into Prolog. For details + * on how to contribute or use this project, please refer to the repository README or the project documentation. + * + * Contribution: Contributions are welcome! For contributing guidelines, please check the CONTRIBUTING.md + * file in the repository. + * + * Notes: + * - Ensure you have SWI-Prolog installed and properly configured to use this transpiler. + * - This project is under active development, and we welcome feedback and contributions. + * + * Acknowledgments: Special thanks to all contributors and the open source community for their support and contributions. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the + * distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS + * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT + * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS + * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE + * COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, + * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; + * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER + * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN + * ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + * POSSIBILITY OF SUCH DAMAGE. + */ + + + +when_tracing(Goal):- tracing,!,notrace(Goal),!. +when_tracing(_). + +:- multifile(user:asserted_metta_pred/2). +:- dynamic(user:asserted_metta_pred/2). + +exists_virtually(corelib). +exists_virtually(stdlib). + +path_chars(A,C):- symbol_chars(A,C). + +with_wild_path(Fnicate, Dir):- + working_directory(PWD,PWD), + wwp(Fnicate, Dir). + +inner_compound(Inner,'.',Inner):- \+ compound(Inner),!. +inner_compound(Cmpd,Outter,Inner):- + compound_name_arguments(Cmpd,F,[X|Args]), + compound_name_arguments(Outter,F,[Midder|Args]), + inner_compound(X,Midder,Inner). + +afn(A,B):- quietly(absolute_file_name(A,B)). +afn(A,B,C):- quietly(absolute_file_name(A,B,C)). + +% Process a file or directory path with a given predicate. +wwp(Fnicate, Dir) :- extreme_debug(fbug(wwp(Fnicate, Dir))),fail. +wwp(_Fnicate, []) :- !. +wwp(_Fnicate, Virtual) :- exists_virtually(Virtual),!. +wwp(Fnicate, Virtual) :- var(Virtual),!,throw(var_wwp(Fnicate, Virtual)). +wwp(Fnicate, Dir) :- is_scryer, symbol(Dir), !, must_det_ll((path_chars(Dir,Chars), wwp(Fnicate, Chars))). + + +wwp(Fnicate, File) :- is_list(File), !, + must_det_ll((maplist(wwp(Fnicate), File))). + +wwp(Fnicate, Cmpd):- compound(Cmpd), + inner_compound(Cmpd,Outter,Inner),!, + afn(Outter, Dir,[solutions(all), access(read), file_errors(fail)]), + with_cwd(Dir,wwp(Fnicate, Inner)),!. + +wwp(Fnicate, Chars) :- \+ is_scryer, \+ symbol(Chars), !, must_det_ll((name(Atom,Chars), wwp(Fnicate, Atom))). + +wwp(Fnicate, File) :- exists_file(File), !, must_det_ll(( call(Fnicate, File))). + +wwp(Fnicate, ColonS) :- fail, symbolic(ColonS), symbol_contains(ColonS, ':'),!, + symbolic_list_concat([Top|Rest],':',ColonS), + symbolic_list_concat(Rest,':',FileNext), + when_tracing(listing(is_metta_module_path)), + find_top_dirs(Top,Dir), + ((fail,symbol_length(FileNext,0)) + -> wwp(Fnicate, Dir) + ; (exists_directory(Dir) + -> with_cwd(Dir,wwp(Fnicate, FileNext)) + ; fail)),!. + +wwp(Fnicate, ColonS) :- symbolic(ColonS), symbol_contains(ColonS, ':'),!, + symbolic_list_concat([Top|Rest],':',ColonS), + symbolic_list_concat(Rest,':',FileNext),!, + when_tracing(listing(is_metta_module_path)), + must_det_ll((call(( + quietly(find_top_dirs(Top,Dir)), + exists_directory(Dir), + with_cwd(Dir,wwp(Fnicate, FileNext)))))),!. + +wwp(Fnicate, File) :- + symbol_contains(File, '*'), + expand_file_name(File, List), + maplist(wwp(Fnicate), List),!. + +wwp(Fnicate, Dir) :- exists_directory(Dir), + quietly(afn_from('__init__.py', PyFile, [access(read), file_errors(fail), relative_to(Dir)])), + wwp(Fnicate, PyFile). + + +wwp(Fnicate, File) :- + \+ exists_directory(File), \+ exists_file(File), %\+ symbol_contains(File,'.'), + extension_search_order(Ext), + symbolic_list_concat([File|Ext],MeTTafile), + exists_file(MeTTafile), + call(Fnicate, MeTTafile). + +wwp(Fnicate, File) :- + \+ exists_directory(File), \+ exists_file(File), symbol_contains(File,'..'), + extension_search_order(Ext), + symbolic_list_concat([File|Ext],MeTTafile0), + afn_from(MeTTafile0, MeTTafile, [access(read), file_errors(fail)]), + exists_file(MeTTafile), + call(Fnicate, MeTTafile). + +wwp(Fnicate, File) :- + exists_directory(File), + directory_file_path(File, '*.*sv', Wildcard), + expand_file_name(Wildcard, List), !, + maplist(Fnicate, List). + +wwp(Fnicate, Dir) :- exists_directory(Dir), !, + must_det_ll((directory_files(Dir, Files), + maplist(directory_file_path(Dir,Files),Paths), + maplist(path_chars,Paths,CharPaths), + maplist(wwp(Fnicate), CharPaths))), !. + +wwp(Fnicate, File) :- must_det_ll((call(Fnicate, File))). + +extension_search_order(['.metta']). +extension_search_order(['.py']). +extension_search_order(['']). + +:- if( \+ current_predicate(load_metta_file/2)). +load_metta_file(Self,Filemask):- symbol_concat(_,'.metta',Filemask),!, load_metta(Self,Filemask). +load_metta_file(_Slf,Filemask):- load_flybase(Filemask). +:- endif. + +afn_from(RelFilename,Filename):- + afn_from(RelFilename,Filename,[]). + +afn_from(RelFilename,Filename,Opts):- + select(relative_to(RelFrom),Opts,NewOpts), + afn_from(RelFrom,RelFromNew,NewOpts), + quietly(afn(RelFilename,Filename,[relative_to(RelFromNew)|NewOpts])). +afn_from(RelFilename,Filename,Opts):- + is_metta_module_path(ModPath), + quietly(afn(RelFilename,Filename,[relative_to(ModPath)|Opts])). + +register_module(Dir):- current_self(Space), register_module(Space,Dir). + +register_module(Space,Path):- + register_module(Space,'%top%',Path), + file_directory_name(Path,Dir), + file_base_name(Path, ModuleName), + register_module(Space,ModuleName,Dir). + +register_module(Space,ModuleName,Dir):- + space_name(Space,SpaceName), + absolute_dir(Dir,AbsDir), + asserta(is_metta_module_path(SpaceName,ModuleName,AbsDir)). + + +find_top_dirs(Top,Dir):- current_self(Self),space_name(Self,SpaceName), find_top_dirs(SpaceName,Top,Dir). + +find_top_dirs(SpaceName,Top,Abs):- is_metta_module_path(SpaceName,Top,Abs). +find_top_dirs(SpaceName,Top,Dir):- is_metta_module_path(SpaceName,'%top%',Root),absolute_dir(Top,Root,Dir). +find_top_dirs(SpaceName,Top,Dir):- working_directory(PWD,PWD), + parent_dir_of(PWD,Top,Dir), assert(is_metta_module_path(SpaceName,Top,Dir)). + +parent_dir_of(PWD,Top,Dir):- directory_file_path(Parent,TTop,PWD), + (TTop==Top->Dir=PWD;parent_dir_of(Parent,Top,Dir)). + + +space_name(Space,SpaceName):- symbol(Space),!,SpaceName = Space,!. +space_name(Space,SpaceName):- is_space_name(SpaceName), same_space(SpaceName,Space),!. +space_name(Space,SpaceName):- 'get-atoms'(Space,['space-symbol',SpaceName]),!. + +same_space(Space1,Space2):- Space1=Space2. +same_space(SpaceName1,Space2):- symbol(SpaceName1),eval(SpaceName1,Space1),!,same_space(Space2,Space1). + +absolute_dir(Dir,AbsDir):- afn(Dir, AbsDir, [access(read), file_errors(fail), file_type(directory)]). +absolute_dir(Dir,From,AbsDir):- afn(Dir, AbsDir, [relative_to(From),access(read), file_errors(fail), file_type(directory)]),!. + + + + +:- dynamic(is_metta_module_path/3). +:- dynamic(is_metta_module_path/1). +is_metta_module_path('.'). + +load_metta(Filename):- + %clear_spaces, + load_metta('&self',Filename). + +load_metta(_Self,Filename):- Filename=='--repl',!,repl. +load_metta(Self,Filename):- + (\+ symbol(Filename); \+ exists_file(Filename)),!, + with_wild_path(load_metta(Self),Filename),!,loonit_report. +load_metta(Self,RelFilename):- + atom(RelFilename), + exists_file(RelFilename),!, + afn_from(RelFilename,Filename), + track_load_into_file(Filename, + include_metta(Self,RelFilename)). + +import_metta(Self,Module):- current_predicate(py_is_module/1),py_is_module(Module),!, + must_det_ll(self_extend_py(Self,Module)),!. +import_metta(Self,Filename):- + (\+ symbol(Filename); \+ exists_file(Filename)),!, + must_det_ll(with_wild_path(import_metta(Self),Filename)),!. +import_metta(Self,RelFilename):- + must_det_ll(( + symbol(RelFilename), + exists_file(RelFilename), + absolute_file_name(RelFilename,Filename), + directory_file_path(Directory, _, Filename), + pfcAdd_Now(metta_file(Self,Filename,Directory)), + locally(nb_setval(suspend_answers,true), + include_metta_directory_file(Self,Directory, Filename)))). + +include_metta(Self,Filename):- + (\+ symbol(Filename); \+ exists_file(Filename)),!, + must_det_ll(with_wild_path(include_metta(Self),Filename)),!. +include_metta(Self,RelFilename):- + must_det_ll(( + symbol(RelFilename), + exists_file(RelFilename),!, + afn_from(RelFilename,Filename), + directory_file_path(Directory, _, Filename), + pfcAdd_Now(metta_file(Self,Filename,Directory)), + pfcAdd_Now(user:loaded_into_kb(Self,Filename)), + include_metta_directory_file(Self,Directory, Filename))), + pfcAdd_Now(user:loaded_into_kb(Self,Filename)), + nop(listing(user:loaded_into_kb/2)). + + + +% count_lines_up_to(TwoK,Filename, Count). +count_lines_up_to(TwoK,Filename, Count) :- + open(Filename, read, Stream,[encoding(utf8)]), + count_lines_in_stream(TwoK,Stream, 0, Count), + close(Stream). + +% count_lines_in_stream(Stream, CurrentCount, FinalCount). +count_lines_in_stream(TwoK,Stream, CurrentCount, FinalCount) :- + ( CurrentCount >= TwoK + -> FinalCount = TwoK + ; read_line_to_codes(Stream, Codes), + ( Codes == end_of_file + -> FinalCount = CurrentCount + ; NewCount is CurrentCount + 1, + count_lines_in_stream(TwoK, Stream, NewCount, FinalCount) + ) + ). + + +include_metta_directory_file_prebuilt(Self, _Directory, Filename):- + symbol_concat(_, '.metta', Filename), + symbol_concat(Filename, '.qlf', QlfFile), + exists_file(QlfFile), + time_file(Filename, MettaTime), + time_file(QlfFile, QLFTime), + QLFTime > MettaTime,!, % Ensure QLF file is newer than the METTA file + pfcAdd_Now(user:loaded_into_kb(Self,Filename)), + ensure_loaded(QlfFile),!. + + +include_metta_directory_file_prebuilt(Self,_Directory, Filename):- just_load_datalog, + symbol_concat(_,'.metta',Filename), + symbol_concat(Filename,'.datalog',DatalogFile), + exists_file(DatalogFile), + time_file(Filename, MettaTime), + time_file(DatalogFile, DatalogTime), + DatalogTime > MettaTime, !, % Ensure Datalog file is newer than the METTA file + size_file(Filename, MettaSize), + size_file(DatalogFile, DatalogSize), + % Ensure the size of the Datalog file is at least 25% of the METTA file + DatalogSize >= 0.25 * MettaSize, + !, % Cut to prevent backtracking + pfcAdd_Now(user:loaded_into_kb(Self,Filename)), + ensure_loaded(DatalogFile),!. + +include_metta_directory_file_prebuilt(Self,_Directory, Filename):- + symbol_concat(_,'.metta',Filename), + symbol_concat(Filename,'.datalog',DatalogFile), + exists_file(DatalogFile),!, + size_file(Filename, MettaSize), + size_file(DatalogFile, DatalogSize), + % Ensure the size of the Datalog file is at least 25% of the METTA file + DatalogSize >= 0.25 * MettaSize, + !, % Cut to prevent backtracking + convert_datalog_to_loadable(DatalogFile,QlfFile),!, + exists_file(QlfFile),!, + pfcAdd_Now(user:loaded_into_kb(Self,Filename)), + ensure_loaded(QlfFile),!. + + + +include_metta_directory_file(Self,Directory, Filename):- + include_metta_directory_file_prebuilt(Self,Directory, Filename),!. +include_metta_directory_file(Self,_Directory, Filename):- + count_lines_up_to(2000,Filename, Count), Count > 1980, + once(convert_metta_to_loadable(Filename,QlfFile)), + exists_file(QlfFile),!, + pfcAdd_Now(user:loaded_into_kb(Self,Filename)), + ensure_loaded(QlfFile). + +include_metta_directory_file(Self,Directory,Filename):- + with_cwd(Directory,must_det_ll(setup_call_cleanup(open(Filename,read,In, [encoding(utf8)]), + must_det_ll( load_metta_file_stream(Filename,Self,In)), + close(In)))). + +convert_metta_to_datalog(Filename,DatalogFile):- + % Generate the Datalog file name + ignore(symbol_concat(Filename,'.datalog',DatalogFile)), + % Open the METTA file for reading + setup_call_cleanup( + open(Filename, read, Input, [encoding(utf8)]), + % Open the Datalog file for writing + setup_call_cleanup( + open(DatalogFile, write, Output, [encoding(utf8)]), + % Perform the conversion + translate_metta_file_to_datalog_io(Filename,Input,Output), + % Cleanup: Close the Datalog file + close(Output) + ), + % Cleanup: Close the METTA file + close(Input) + ), + % Ensure the generated Datalog file is at least 50% the size of the METTA file + size_file(Filename, MettaSize), + size_file(DatalogFile, DatalogSize), + ( + DatalogSize >= 0.5 * MettaSize + -> true % If the size condition is met, succeed + ; delete_file(DatalogFile), fail % If not, delete the Datalog file and fail + ), + !. % Prevent backtracking + +% atom_subst(+Source, +Replacements, -Result) +% Replacements is a list of Search-Replace pairs. +atom_subst(Source, Replacements, Result) :- + foldl(replace_in_symbol, Replacements, Source, Result). + +% replace_in_symbol(+Search-Replace, +CurrentSource, -NewSource) +% Helper predicate to apply a single search-replace operation. +replace_in_symbol(Search-Replace, CurrentSource, NewSource) :- + symbolic_list_concat(Split, Search, CurrentSource), + symbolic_list_concat(Split, Replace, NewSource). + + +% filename_to_mangled_pred(+Filename, -MangleP) +filename_to_mangled_pred(Filename, MangleP) :- + get_time(Time), + symbolic_list_concat(['data', Filename, Time], '_', GS), + Replacements = [ '.metta_'- '_', + '_1710'-'_', + '/'- '_', + '/'- '_', '.'- '_', '-'- '_', '__'- '_'], + atom_subst(GS, Replacements, IntermediateResult), + trim_to_last_nchars(24, IntermediateResult, MangleP). + + +% trim_to_last_32(+Atom, -TrimmedAtom) +% Trims the given Atom to its last 32 characters, producing TrimmedAtom. +trim_to_last_nchars(Len, Atom, TrimmedAtom) :- + atom_length(Atom, Length), + ( Length =< Len + -> TrimmedAtom = Atom % Atom is shorter than or exactly 32 characters, no trimming needed + ; Before is Length - 32, + sub_atom(Atom, Before, 32, _, TrimmedAtom) + ). + + +translate_metta_file_to_datalog_io(Filename,Input,Output):- + must_det_ll(( + %write header + write(Output,'/* '),write(Output,Filename),writeln(Output,' */'), + % write the translation time and date + get_time(Time),stamp_date_time(Time,Date,'UTC'), + format_time(string(DateStr),'%FT%T%z',Date), + write(Output,'/* '),write(Output,DateStr),writeln(Output,' */'), + % make the predicate dynamic/multifile + filename_to_mangled_pred(Filename,MangleP2), + mangle_iz(MangleP2,MangleIZ), + + format(Output,':- style_check(-discontiguous). ~n',[]), + format(Output,':- dynamic((~q)/2). ~n',[MangleP2]), + format(Output,':- dynamic((~q)/3). ~n',[MangleP2]), + format(Output,':- dynamic((~q)/4). ~n',[MangleP2]), + format(Output,':- dynamic((~q)/5). ~n',[MangleP2]), + format(Output,':- dynamic((~q)/6). ~n',[MangleP2]), + format(Output,':- dynamic((~q)/7). ~n',[MangleP2]), + + format(Output,':- dynamic((~q)/4). ~n',[MangleIZ]), + format(Output,':- dynamic((~q)/5). ~n',[MangleIZ]), + format(Output,':- dynamic((~q)/6). ~n',[MangleIZ]), + format(Output,':- dynamic((~q)/7). ~n',[MangleIZ]), + format(Output,':- dynamic((~q)/8). ~n',[MangleIZ]), + writeln(Output,':- dynamic(user:asserted_metta_pred/2).'), + writeln(Output,':- multifile(user:asserted_metta_pred/2).'), + format(Output,'user:asserted_metta_pred(~q,~q). ~n',[MangleP2,Filename]), + with_output_to(Output,produce_iz(MangleP2)), + %format(Output,':- user:register_asserted_metta_pred(~q,~q). ~n',[MangleP2,Filename]), + flag(translated_forms,_,0), + LastTime = t(Time), + % translate the file + once(call(( + repeat, + (at_end_of_stream(Input)->!; + ( must_det_ll(( + line_count(Input,Lineno), + read_sform(Input,Term))), + (Term==end_of_file->!; + (once((( + % if_t((0 is (Lineno mod 10000)),writeln(Term:Lineno)), + /*non_compat_io*/( + if_t(( + get_time(NTime),arg(1,LastTime,Last), + Elapsed is (NTime-Last), Elapsed > 4), + (nb_setarg(1,LastTime,NTime), + move_cursor_to_first_column, + format(user_error,'; ~@ ; line: ~w ',[write_src_woi(Term),Lineno]), + write(user_error,'\033[K'), + move_cursor_to_first_column))), + flag(translated_forms,X,X+1), + write_metta_datalog_term(Output,Term,MangleP2,Lineno))))),fail)))))), + flush_output(Output), + % teell the user we are done + flag(translated_forms,TF,TF), + format(user_error,'~N; Done translating ~w forms: ~q.', + [TF,asserted_metta_pred(MangleP2,Filename)]))). + +write_src_woi(Term):- with_indents(false,write_src(Term)). + +% write comments +write_metta_datalog_term(Output,'$COMMENT'(Term,_,_),_MangleP2,_Lineno):- + format(Output,"/* ~w */~n",[Term]). +% write executed terms +write_metta_datalog_term(Output,exec(Term),MangleP2,Lineno):- + format(Output,":-eval_Line(~q,~q,~q).~n",[Term,MangleP2,Lineno]). +% write asserted terms +write_metta_datalog_term(Output,STerm,MangleP2,Lineno):- + s2t_iz(MangleP2,P,STerm,Term), + relistify(Term,TermL), + Data =..[P,Lineno|TermL], + format(Output,"~q.~n",[Data]). + +relistify(Term,TermL):- is_list(Term),!,TermL=Term. +relistify([H|T],TermL):- flatten([H|T],TermL),!. +relistify(Term,[Term]). + +eval_Line(A,B,C):- format('~N'), + write_src(eval_Line(A,B,C)),nl. + +translate_metta_datalog(Input,Output):- translate_metta_datalog('',Input,Output),!. + +translate_metta_datalog(_,Input,_):- at_end_of_stream(Input),!. +translate_metta_datalog(Ch,Input,Output):- peek_char(Input,Char), + translate_metta_datalog(Ch,Input,Output,Char). + +translate_metta_datalog(_,Input,Output,')'):- !, get_char(Input,_), + writeq(Output,']'),translate_metta_datalog(',',Input,Output). +translate_metta_datalog(Ch,Input,Output,'('):- !,get_char(Input,_), + write(Output,Ch),writeq(Output,'['),translate_metta_datalog('',Input,Output). +translate_metta_datalog(Ch,Input,Output,Space):-char_type(Space,space),!, + get_char(Input,Char), write(Output,Char),translate_metta_datalog(Ch,Input,Output). +translate_metta_datalog(Ch,Input,Output,';'):-!,read_line_to_string(Input, Comment), + format(Output, '/* ~w */',[Comment]),translate_metta_datalog(Ch,Input,Output). +translate_metta_datalog(Ch,Input,Output,'"'):-!,read_term(Input,Term,[]), + write(Output,Ch),writeq(Output,Term),translate_metta_datalog(',',Input,Output). +translate_metta_datalog(Ch,Input,Output,'`'):-!,read_term(Input,Term,[]), + write(Output,Ch),writeq(Output,Term),translate_metta_datalog(',',Input,Output). +translate_metta_datalog(Ch,Input,Output,'\''):-!,read_term(Input,Term,[]), + write(Output,Ch),writeq(Output,Term),translate_metta_datalog(',',Input,Output). +translate_metta_datalog(Ch,Input,Output,'$'):-!, + read_chars_until([type(space),')'],Input,Codes),name(Term,Codes), + write(Output,Ch),writeq(Output,Term),translate_metta_datalog(',',Input,Output). +translate_metta_datalog(Ch,Input,Output,Peek):-!, + read_chars_until([type(space),')'],Peek,Input,Codes),name(Term,Codes), + write(Output,Ch),writeq(Output,Term),translate_metta_datalog(',',Input,Output). + +read_chars_until(_StopsBefore,Input,[]):- at_end_of_stream(Input),!. +read_chars_until(StopsBefore,Input,Codes):- peek_char(Input,Char), + read_chars_until(StopsBefore, Char, Input, Codes). + +stops_before([type(Type)|StopsBefore],Char):- char_type(Char,Type); stops_before(StopsBefore,Char). +stops_before([Ch|StopsBefore],Char):- Ch==Char; stops_before(StopsBefore,Char). + +read_chars_until(StopsBefore,Char,_, []):- stops_before(StopsBefore,Char),!. +read_chars_until(StopsBefore, '\\', Input, [Code|Codes]):- get_char(Input,Code), + read_chars_until(StopsBefore, Input, Codes). +read_chars_until(StopsBefore, Char, Input, [Char|Codes]):- get_char(Input,_), + read_chars_until(StopsBefore, Input, Codes). + + just_load_datalog:-!, fail. +convert_datalog_to_loadable(DatalogFile,DatalogFile):-just_load_datalog,!. +convert_datalog_to_loadable(DatalogFile,QlfFile):- + sformat(S,'swipl -g "qcompile(~q)" -t halt',[DatalogFile]), + shell(S,_), + file_name_extension(Base, _, DatalogFile), + file_name_extension(Base,'qlf',QlfFile). + +convert_metta_to_loadable(Filename,QlfFile):- + must_det_ll(( + convert_metta_to_datalog(Filename,DatalogFile), + convert_datalog_to_loadable(DatalogFile,QlfFile))),!. + +convert_metta_to_loadable(Filename,_):- + metta_dir(Dir), + sformat(S,'~w/cheap_convert.sh --verbose=1 ~w',[Dir,Filename]), + shell(S,Ret),!,Ret==0. + +accept_line(_Self,end_of_file):-!. +accept_line(Self,I):- normalize_space(string(Str),I),!,accept_line2(Self,Str),!. + +accept_line2(_Self,S):- string_concat(";",_,S),!,writeln(S). +accept_line2(Self,S):- string_concat('(',RS,S),string_concat(M,')',RS),!, + symbolic_list_concat([F|LL],' ',M),PL =..[F,Self|LL],pfcAdd_Now(PL),!,flag(next_assert,X,X+1), + if_t((0 is X mod 10_000_000),(writeln(X=PL),statistics)). +accept_line2(Self,S):- fbug(accept_line2(Self,S)),!. + + +load_metta_file_stream(Filename,Self,In):- + if_t((atomic(Filename),exists_file(Filename)), size_file(Filename, Size)), + if_t(var(Size),is_file_stream_and_size(In, Size)), + %once((is_file_stream_and_size(In, Size),Size>102400) -> P2 = read_sform2 ; + P2 = read_metta2, %) + with_option(loading_file,Filename, + %current_exec_file(Filename), + must_det_ll((must_det_ll(( + set_exec_num(Filename,1), + load_answer_file(Filename), + set_exec_num(Filename,0))), + load_metta_file_stream_fast(Size,P2,Filename,Self,In)))). + +% use_fast_buffer makes tmp .buffer files that get around long load times +use_fast_buffer:- nb_current(may_use_fast_buffer,t). + +:- dynamic(metta_file_buffer/5). +:- multifile(metta_file_buffer/5). + + +load_metta_file_stream_fast(_Size,_P2,Filename,Self,S):- fail, + symbolic_list_concat([_,_,_|_],'.',Filename), + \+ option_value(html,true), + atomic(S),is_stream(S),stream_property(S,input),!, + repeat, + read_line_to_string(S,I), + accept_line(Self,I), + I==end_of_file,!. + +load_metta_file_stream_fast(_Size, _P2, Filename, Self, _In) :- + use_fast_buffer, + symbol_concat(Filename, '.buffer~', BufferFile), + exists_file(BufferFile), + time_file(Filename, FileTime), + time_file(BufferFile, BufferFileTime), + ( (BufferFileTime > FileTime) + -> (fbugio(using(BufferFile)),ensure_loaded(BufferFile), !, load_metta_buffer(Self, Filename)) + ; (fbugio(deleting(BufferFile)),delete_file(BufferFile), fail) + ). + +load_metta_file_stream_fast(_Size,P2,Filename,Self,In):- + if_t(use_fast_buffer, + ((symbol_concat(Filename, '.buffer~', BufferFile), + fbugio(creating(BufferFile)), + write_bf(BufferFile, ( :- dynamic(metta_file_buffer/5))), + write_bf(BufferFile, ( :- multifile(metta_file_buffer/5)))))), + repeat, + my_line_count(In, LineCount), + current_read_mode(file,Mode), + must_det_ll(call(P2, In,Expr)), %write_src(read_metta=Expr),nl, + subst_vars(Expr, Term, [], NamedVarsList), + BufferTerm = metta_file_buffer(Mode,Term,NamedVarsList,Filename,LineCount), + assertz(BufferTerm), + if_t(use_fast_buffer,write_bf(BufferFile,BufferTerm)), + + flush_output, + at_end_of_stream(In),!, + %listing(metta_file_buffer/5), + load_metta_buffer(Self,Filename). + +write_bf(BufferFile,BufferTerm):- + setup_call_cleanup(open(BufferFile,append,Out), + format(Out,'~q.~n',[BufferTerm]), + close(Out)). + + +my_line_count(In, seek($,0,current,CC)):- + stream_property(In,reposition(true)), + seek(In,0,current,CC),fail. +my_line_count(In,position(Pos)):- + stream_property(In,position(Pos)). + + +load_metta_buffer(Self,Filename):- + set_exec_num(Filename,1), + load_answer_file(Filename), + set_exec_num(Filename,0), + pfcAdd_Now(user:loaded_into_kb(Self,Filename)), + forall(metta_file_buffer(Mode,Expr,NamedVarsList,Filename,_LineCount), + (maplist(maybe_assign,NamedVarsList), + must_det_ll((((do_metta(file(Filename),Mode,Self,Expr,_O))) + ->true + ; (trace,pp_m(unknown_do_metta(file(Filename),Mode,Self,Expr))))))). + + + +%read_metta(In,Expr):- current_input(CI), \+ is_same_streams(CI,In), !, read_sform(In,Expr). +read_metta(_,O):- clause(t_l:s_reader_info(O),_,Ref),erase(Ref). +read_metta(I,O):- string(I),normalize_space(string(M),I),!,parse_sexpr_metta1(M,O),!. +read_metta(In,Expr):- current_input(In0),In==In0,!, repl_read(Expr). +read_metta(In,Expr):- read_metta1(In,Expr). + +read_metta1(In,Expr):- is_file_stream_and_size(In, Size) , Size>10240,!,read_sform1([],In,Expr). +read_metta1(In,Expr):- read_metta2(In,Expr). + +read_metta2(_,O):- clause(t_l:s_reader_info(O),_,Ref),erase(Ref). +read_metta2(In,Expr):- peek_char(In,Char), read_metta2(In,Char,Expr). +read_metta2(In,Char,Expr):- char_type(Char,space),get_char(In,Char),not_compatio(put(Char)),!,read_metta2(In,Expr). +%read_metta2(In,'"',Expr):- read_sform2(In,Expr),!. +%read_metta2(In,'\'',Expr):- read_sform2(In,Expr),!. +read_metta2(In,'!',Expr):- get_char(In,_), !, read_metta2(In,Read1),!,Expr=exec(Read1). +read_metta2(In,';',Expr):- get_char(In,_), !, (maybe_read_pl(In,Expr)-> true ; + (read_line_to_string(In,Str),Expr='$COMMENT'(Str,0,0))). +% write_comment(Str),!,read_metta2(In,Expr))),!. +% read_metta2(In,_,Expr):- maybe_read_pl(In,Expr),!. +read_metta2(In,_,Read1):- parse_sexpr_metta(In,Expr),!,must_det_ll(Expr=Read1). + + +% Predicate to check if a stream is a file stream and get its size. +is_file_stream_and_size(Stream, Size) :- + % Check if the stream is associated with a file. + stream_property(Stream, file_name(FileName)), + % Check if the file is accessible and get its size. + exists_file(FileName), + size_file(FileName, Size). + + +maybe_read_pl(In,Expr):- + peek_line(In,Line1), Line1\=='', atom_contains(Line1, '.'),atom_contains(Line1, ':-'), + notrace(((catch_err((read_term_from_atom(Line1, Term, []), Term\==end_of_file, Expr=call(Term)),_, fail),!, + read_term(In, Term, [])))). + + +% Define the peek_line predicate. +% It uses a temporary string buffer to peek at the current line. +peek_line(Line) :- + current_input(Stream), + peek_line(Stream, Line). + +% Helper predicate to peek the line from a specific stream. +peek_line(Stream, Line) :- + % Remember the current stream position. + stream_property(Stream, position(Pos)), + % Read the next line. + read_line_to_string(Stream, Line), + % Set the stream back to the remembered position. + set_stream_position(Stream, Pos). + + + +maybe_read_sform_line(Stream, P2, Form) :- fail, + % Check if the stream is repositionable + % Get the current position in the stream + stream_property(Stream, position(Pos)), + % Read a line from the stream + read_line_to_string(Stream, Line), + maybe_read_sform_line_pos(Stream, Line, Pos, P2, Form). + + +maybe_read_sform_line_pos(Stream, Line, _Pos, P2, Form):- normalize_space(string(M),Line),M="",!, + maybe_read_sform_line(Stream, P2, Form). + +maybe_read_sform_line_pos(Stream, Line, Pos, P2, Form):- + % Call P2 with the line. If P2 fails, reset the stream position + ( call(P2,Line,Form) + -> true % If P2 succeeds, do nothing more + ; set_stream_position(Stream, Pos), fail % If P2 fails, reset position and fail + ). + + + +%read_line_to_sexpr(Stream,UnTyped), +read_sform(Str,F):- string(Str),open_string(Str,S),!,read_sform(S,F). +read_sform(S,F):- + read_sform1([],S,F1), + ( F1\=='!' -> F=F1 ; + (read_sform1([],S,F2), F = exec(F2))). + + +%read_sform2(S,F1):- !, read_metta2(S,F1). +read_sform2(S,F1):- read_sform1([],S,F1). + +read_sform1(_,_,O):- clause(t_l:s_reader_info(O),_,Ref),erase(Ref). +read_sform1( AltEnd,Str,F):- string(Str),open_string(Str,S),!,read_sform1( AltEnd,S,F). +read_sform1(_AltEnd,S,F):- at_end_of_stream(S),!,F=end_of_file. +read_sform1( AltEnd,S,M):- get_char(S,C),read_sform3(s, AltEnd,C,S,F), + untyped_to_metta(F,M). +%read_sform1( AltEnd,S,F):- profile(parse_sexpr_metta(S,F)). + +read_sform3(_AoS,_AltEnd,C,_,F):- C == end_of_file,!,F=end_of_file. +read_sform3( s, AltEnd,C,S,F):- char_type(C,space),!,read_sform1( AltEnd,S,F). +%read_sform3(AoS,_AltEnd,';',S,'$COMMENT'(F,0,0)):- !, read_line_to_string(S,F). +read_sform3( s, AltEnd,';',S,F):- read_line_to_string(S,_),!,read_sform1( AltEnd,S,F). +read_sform3( s, AltEnd,'!',S,exec(F)):- !,read_sform1( AltEnd,S,F). + +read_sform3(s,_AltEnd,_,S,F1):- maybe_read_sform_line(S, parse_sexpr_metta1, F1),!. + +read_sform3(_AoS,_AltEnd,'"',S,Text):- !,must_det_ll(atom_until(S,[],'"',Text)). +read_sform3(_AoS,_AltEnd,'`',S,Text):- !,atom_until(S,[],'`',Text). +read_sform3(_AoS,_AltEnd,'\'',S,Text):- fail, !,atom_until(S,[],'\'',Text). +read_sform3(_AoS,_AltEnd,',',_,','):- fail, !. +read_sform3( s , AltEnd,C,S,F):- read_sform4( AltEnd,C,S,F),!. +read_sform3(_AoS, AltEnd,P,S,Sym):- peek_char(S,Peek),!,read_symbol_or_number( AltEnd,Peek,S,[P],Expr),into_symbol_or_number(Expr,Sym). + +into_symbol_or_number(Expr,Sym):- atom_number(Expr,Sym),!. +into_symbol_or_number(Sym,Sym). + +read_sform4(_AltEnd,B,S,Out):- read_sform5(s,B,S,List,E), c_list(E,List,Out). +c_list(')',List,List). c_list('}',List,['{...}',List]). c_list(']',List,['[...]',List]). + + +read_sform5(AoS,'(',S,List,')'):- !,collect_list_until(AoS,S,')',List),!. +read_sform5(AoS,'{',S,List,'}'):- !,collect_list_until(AoS,S,'}',List),!. +read_sform5(AoS,'[',S,List,']'):- !,collect_list_until(AoS,S,']',List),!. + + +read_symbol_or_number( AltEnd,Peek,S,SoFar,Expr):- SoFar\==[], Peek=='\\', !, + get_char(S,_),get_char(S,C),append(SoFar,[C],NSoFar), + peek_char(S,NPeek), read_symbol_or_number(AltEnd,NPeek,S,NSoFar,Expr). + +read_symbol_or_number(_AltEnd,Peek,_S,SoFar,Expr):- Peek==end_of_file,!, + must_det_ll(( symbolic_list_concat(SoFar,Expr))). + + + + +read_symbol_or_number(_AltEnd,Peek,_S,SoFar,Expr):- char_type(Peek,space),!, + must_det_ll(( symbolic_list_concat(SoFar,Expr))). + +read_symbol_or_number( AltEnd,Peek,_S,SoFar,Expr):- member(Peek,AltEnd),!, + must_det_ll(( do_symbolic_list_concat(Peek,SoFar,Expr))). +read_symbol_or_number(AltEnd,B,S,SoFar,Expr):- fail,read_sform5(AltEnd,B,S,List,E), + flatten([List,E],F), append(SoFar,F,NSoFar),!, + peek_char(S,NPeek), read_symbol_or_number(AltEnd,NPeek,S,NSoFar,Expr). +read_symbol_or_number( AltEnd,_Peek,S,SoFar,Expr):- get_char(S,C),append(SoFar,[C],NSoFar), + peek_char(S,NPeek), read_symbol_or_number(AltEnd,NPeek,S,NSoFar,Expr). + +atom_until(S,SoFar,End,Text):- get_char(S,C),atom_until(S,SoFar,C,End,Text). +atom_until(_,SoFar,C,End,Expr):- C ==End,!,must_det_ll((do_symbolic_list_concat(End,SoFar,Expr))). +atom_until(S,SoFar,'\\',End,Expr):-get_char(S,C),!,atom_until2(S,SoFar,C,End,Expr). +atom_until(S,SoFar,C,End,Expr):- atom_until2(S,SoFar,C,End,Expr). +atom_until2(S,SoFar,C,End,Expr):- append(SoFar,[C],NSoFar),get_char(S,NC), + atom_until(S,NSoFar,NC,End,Expr). + +do_symbolic_list_concat('"',SoFar,Expr):- \+ string_to_syms,!, atomics_to_string(SoFar,Expr),!. +do_symbolic_list_concat(_End,SoFar,Expr):- symbolic_list_concat(SoFar,Expr). + +collect_list_until(AoS,S,End,List):- get_char(S,C), cont_list(AoS,C,End,S,List). + +cont_list(_AoS,End,_End1,_,[]):- End==end_of_file, !. +cont_list(_AoS,End,End1,_,[]):- End==End1, !. +cont_list( AoS,C,End,S,[F|List]):- read_sform3(AoS,[End],C,S,F),!,collect_list_until(AoS,S,End,List). + + + +in2_stream(N1,S1):- integer(N1),!,stream_property(S1,file_no(N1)),!. +in2_stream(N1,S1):- atom(N1),stream_property(S1,alias(N1)),!. +in2_stream(N1,S1):- is_stream(N1),S1=N1,!. +in2_stream(N1,S1):- atom(N1),stream_property(S1,file_name(N1)),!. +is_same_streams(N1,N2):- in2_stream(N1,S1),in2_stream(N2,S2),!,S1==S2. + + + +parse_sexpr_metta(I,O):- (\+ atomic(I) ; \+ is_stream(I)),!,text_to_string(I,S),!,parse_sexpr_metta1(S,O),!. +parse_sexpr_metta(S,F1):- fail, %line_count(S, LineNumber), + maybe_read_sform_line(S, parse_sexpr_metta1, F1),!. +parse_sexpr_metta(S,F1):- parse_sexpr_metta_IO(S,F1),!. + +parse_sexpr_metta_IO(S,F1):- at_end_of_stream(S),!,F1=end_of_file. +parse_sexpr_metta_IO(S,F1):- peek_char(S,Char),char_type(Char,space),!, + get_char(S,Char), parse_sexpr_metta_IO(S,F1). +parse_sexpr_metta_IO(S,F1):- + %line_count(S, LineNumber), + % Get the character position within the current line + %line_position(S, LinePos), + nop((character_count(S, Offset),move_cursor_to_first_column, + write(user_error,'File Offset: '),write(user_error,Offset))), + parse_sexpr_untyped(S, M),!, + nop((write(user_error,'.'),!,move_cursor_to_first_column)), + trly(untyped_to_metta,M,F1), + nop(writeqln(user_error,F1)),!. + +move_cursor_to_first_column:- write(user_error,'\033[1G'). +move_cursor_to_first_column_out:- write(user_output,'\033[1G'). + +parse_sexpr_metta1(I,O):- normalize_space(string(M),I),!,parse_sexpr_metta2(M,U),!, + trly(untyped_to_metta,U,O). +parse_sexpr_metta2(M,exec(O)):- string_concat('!',I,M),!,parse_sexpr_metta2(I,O). +parse_sexpr_metta2(M,(O)):- string_concat('+',I,M),!,parse_sexpr_metta2(I,O). +parse_sexpr_metta2(I,U):- parse_sexpr_untyped(I,U),!,writeqln(user_error,U). + +test_parse_sexpr_metta1:- + ignore((parse_sexpr_metta1( +"(: synonyms-gene-ENSG00000085491 (synonyms (gene ENSG00000085491) (ATP-Mg/P\\(i\\)_co-transporter_1 calcium-binding_mitochondrial_carrier_protein_SCaMC-1 HGNC:20662 mitochondrial_ATP-Mg/Pi_carrier_protein_1 small_calcium-binding_mitochondrial_carrier_protein_1 mitochondrial_Ca\\(2+\\)-dependent_solute_carrier_protein_1 mitochondrial_adenyl_nucleotide_antiporter_SLC25A24 solute_carrier_family_25_member_24 calcium-binding_transporter APC1 short_calcium-binding_mitochondrial_carrier_1 solute_carrier_family_25_\\(mitochondrial_carrier;_phosphate_carrier\\),_member_24 SCAMC1 SLC25A24 short_calcium-binding_mitochondrial_carrier_protein_1 SCAMC-1)))",O), + writeq(parse_sexpr_metta1(O)))),break. + +writeqln(W,Q):- nop(format(W,'; ~q~n',[Q])). + +write_comment(_):- is_compatio,!. +write_comment(_):- silent_loading,!. +write_comment(Cmt):- connlf,format(';;~w~n',[Cmt]). +do_metta_cmt(_,'$COMMENT'(Cmt,_,_)):- write_comment(Cmt),!. +do_metta_cmt(_,'$STRING'(Cmt)):- write_comment(Cmt),!. +do_metta_cmt(Self,[Cmt]):- !, do_metta_cmt(Self, Cmt),!. + +metta_atom_in_file(Self,Term):- metta_atom_in_file(Self,Term,_,_). +metta_atom_in_file(Self,STerm,Filename,Lineno):- + user:loaded_into_kb(Self,Filename), + once(user:asserted_metta_pred(Mangle,Filename)), + %s2t_iz(Mangle,P,CTerm,Term), + %CTerm=Term,Mangle=P, + current_predicate(Mangle/Arity), + notrace((length(STerm,Arity), + term_variables(STerm,SVs), + copy_term(STerm+SVs,CTerm+CVs), + Data =..[Mangle,Lineno|CTerm])), + %write_src_woi(Data), + call(Data), + maplist(mapvar,CVs,SVs). + +%mapvar(CV,SV):- var(CV),!,SV=CV. +mapvar(CV,SV):- t2s(CV,CCV),!,SV=CCV. + +%constrain_sterm(STerm):- var(STerm),!,between(1,5,Len),length(STerm,Len). +%constrain_sterm(STerm):- is_list(STerm),!. +constrain_sterm(NV):- nonvar(NV),!. +constrain_sterm([_,_,_]). +constrain_sterm([_,_,_,_]). +constrain_sterm([_,_,_,_,_]). +constrain_sterm([_,_]). + +s2t_iz(Mangle,Iz,[Colon,Name,Info],[Name|InfoL]):- Colon == ':', + is_list(Info), mangle_iz(Mangle,Iz), + maplist(s2t,Info,InfoL). +s2t_iz(Mangle,Mangle,Info,InfoL):- s2tl(Info,InfoL). + +mangle_iz(Mangle,Iz):- symbol_concat(Mangle,'_iz',Iz). + +produce_iz(Mangle):- + mangle_iz(Mangle,Iz), + forall(between(1,5,Len), + once((length(Args,Len), + produce_iz_hb([Mangle,Lineno,[:,Name,[Pred|Args]]],[Iz,Lineno,Name,Pred|Args])))). + +produce_iz_hb(HList,BList):- + H=..HList,B=..BList, HB=(H:-B), + numbervars(HB,0,_), + writeq(HB),writeln('.'). + +t2s(SList,List):- \+ compound(SList),!,SList=List. +t2s([H|SList],[HH|List]):- !, t2s(H,HH),!,t2s(SList,List). +t2s(X,XX):- compound(X),compound_name_arguments(X,t,Args),!, + maplist(t2s,Args,XX). +t2s(X,X):-!. + +s2tl(SList,List):- \+ compound(SList),!,SList=List. +s2tl([H|SList],[HH|List]):- !, s2t(H,HH),!,s2tl(SList,List). +s2tl(List,List). +%s2tl(SList,List):- is_list(SList), maplist(s2t,SList,List),!. + +s2t(SList,List):- \+ compound(SList), !, SList=List. +s2t([A|SList],Term):- A == '->',!, s2tl(SList,List), Term =.. [A,List]. +s2t([A|SList],Term):- A == 'Cons',!,s2tl(SList,List), Term =.. [A|List]. +s2t([A|SList],Term):- A == '=',!, s2tl(SList,List), Term =.. [A|List]. +s2t(List,Term):- is_list(List),!,maplist(s2t,List,TermList), + compound_name_arguments(Term,t,TermList),!. +s2t(STerm,Term):- s2tl(STerm,Term),!. + +mlog_sym('@'). + +%untyped_to_metta(I,exec(O)):- compound(I),I=exec(M),!,untyped_to_metta(M,O). +untyped_to_metta(I,O):- + must_det_ll(( + trly(mfix_vars1,I,M), + trly(cons_to_c,M,OM), + trly(cons_to_l,OM,O))). + + +trly(P2,A,B):- once(call(P2,A,M)),A\=@=M,!,trly(P2,M,B). +trly(_,A,A). + +mfix_vars1(I,O):- var(I),!,I=O. +mfix_vars1('$_','$VAR'('_')). +mfix_vars1('$','$VAR'('__')). +mfix_vars1(I,'$VAR'(O)):- atom(I),symbol_concat('$',N,I),symbol_concat('_',N,O). +%mfix_vars1('$t','$VAR'('T')):-!. +%mfix_vars1('$T','$VAR'('T')):-!. +%mfix_vars1(I,O):- I=='T',!,O='True'. +%mfix_vars1(I,O):- I=='F',!,O='False'. +%mfix_vars1(I,O):- is_i_nil(I),!,O=[]. +mfix_vars1(I,O):- I=='true',!,O='True'. +mfix_vars1(I,O):- I=='false',!,O='False'. +mfix_vars1('$STRING'(I),O):- I=O,!. +mfix_vars1('$STRING'(I),O):- \+ string_to_syms, mfix_vars1(I,OO),text_to_string(OO,O),!. +%mfix_vars1('$STRING'(I),O):- \+ string_to_syms, text_to_string(I,O),!. +mfix_vars1('$STRING'(I),O):- !, mfix_vars1(I,M),atom_chars(O,M),!. +%mfix_vars1('$STRING'(I),O):- !, mfix_vars1(I,M),name(O,M),!. +mfix_vars1([H|T],O):- H=='[', is_list(T), last(T,L),L==']',append(List,[L],T), !, O = ['[...]',List]. +mfix_vars1([H|T],O):- H=='{', is_list(T), last(T,L),L=='}',append(List,[L],T), !, O = ['{...}',List]. +mfix_vars1([H|T],O):- is_list(T), last(T,L),L=='}',append(List,[L],T), + append(Left,['{'|R],List),append([H|Left],[['{}',R]],NewList),mfix_vars1(NewList,O). +mfix_vars1('$OBJ'(claz_bracket_vector,List),O):- is_list(List),!, O = ['[...]',List]. +mfix_vars1(I,O):- I = ['[', X, ']'], nonvar(X), !, O = ['[...]',X]. +mfix_vars1(I,O):- I = ['{', X, '}'], nonvar(X), !, O = ['{...}',X]. +mfix_vars1('$OBJ'(claz_bracket_vector,List),Res):- is_list(List),!, append(['['|List],[']'],Res),!. +mfix_vars1(I,O):- I==[Quote, S], Quote==quote,S==s,!, O=is. +mfix_vars1([K,H|T],Cmpd):- fail, + atom(K),mlog_sym(K),is_list(T), + mfix_vars1([H|T],[HH|TT]),atom(HH),is_list(TT),!, + compound_name_arguments(Cmpd,HH,TT). +%mfix_vars1([H|T],[HH|TT]):- !, mfix_vars1(H,HH),mfix_vars1(T,TT). +mfix_vars1(List,ListO):- is_list(List),!,maplist(mfix_vars1,List,ListO). +mfix_vars1(I,O):- string(I),string_to_syms,!,atom_string(O,I). + +mfix_vars1(I,O):- compound(I),!,compound_name_arguments(I,F,II),F\=='$VAR',maplist(mfix_vars1,II,OO),!,compound_name_arguments(O,F,OO). +mfix_vars1(I,O):- \+ symbol(I),!,I=O. +mfix_vars1(I,I). + +no_cons_reduce. +svar_fixvarname_dont_capitalize(O,O):-!. +svar_fixvarname_dont_capitalize(M,O):- svar_fixvarname(M,O),!. + + +%dvar_name(t,'T'):- !. +dvar_name(N,O):- symbol_concat('_',_,N),!,O=N. +dvar_name(N,O):- integer(N),symbol_concat('_',N,O). +dvar_name(N,O):- atom(N),atom_number(N,Num),dvar_name(Num,O),!. +dvar_name(N,O):- \+ symbol(N),!,format(atom(A),'~w',[N]),dvar_name(A,O). +dvar_name(N,O):- !, format(atom(A),'_~w',[N]),dvar_name(A,O). +%dvar_name( '',''):-!. % "$" +%dvar_name('_','__'):-!. % "$_" +dvar_name(N,O):- symbol_concat('_',_,N),!,symbol_concat('_',N,O). +dvar_name(N,O):- svar_fixvarname_dont_capitalize(N,O),!. +dvar_name(N,O):- must_det_ll((atom_chars(N,Lst),maplist(c2vn,Lst,NList),symbolic_list_concat(NList,S),svar_fixvarname_dont_capitalize(S,O))),!. +c2vn(A,A):- char_type(A,prolog_identifier_continue),!. +c2vn(A,A):- char_type(A,prolog_var_start),!. +c2vn(A,AA):- char_code(A,C),symbolic_list_concat(['_C',C,'_'],AA). + +cons_to_l(I,I):- no_cons_reduce,!. +cons_to_l(I,O):- var(I),!,O=I. +cons_to_l(I,O):- is_i_nil(I),!,O=[]. +cons_to_l(I,O):- I=='nil',!,O=[]. +cons_to_l(C,O):- \+ compound(C),!,O=C. +cons_to_l([Cons,H,T|List],[HH|TT]):- List==[], atom(Cons),is_cons_f(Cons), t_is_ttable(T), cons_to_l(H,HH),!,cons_to_l(T,TT). +cons_to_l(List,ListO):- is_list(List),!,maplist(cons_to_l,List,ListO). +cons_to_l(I,I). + +cons_to_c(I,I):- no_cons_reduce,!. +cons_to_c(I,O):- var(I),!,O=I. +cons_to_c(I,O):- is_i_nil(I),!,O=[]. +cons_to_c(I,O):- I=='nil',!,O=[]. +cons_to_c(C,O):- \+ compound(C),!,O=C. +cons_to_c([Cons,H,T|List],[HH|TT]):- List==[], atom(Cons),is_cons_f(Cons), t_is_ttable(T), cons_to_c(H,HH),!,cons_to_c(T,TT). +cons_to_c(I,O):- \+ is_list(I), compound_name_arguments(I,F,II),maplist(cons_to_c,II,OO),!,compound_name_arguments(O,F,OO). +cons_to_c(I,I). + + + +t_is_ttable(T):- var(T),!. +t_is_ttable(T):- is_i_nil(T),!. +t_is_ttable(T):- is_ftVar(T),!. +t_is_ttable([F|Args]):- F=='Cons',!,is_list(Args). +t_is_ttable([_|Args]):- !, \+ is_list(Args). +t_is_ttable(_). + +is_cons_f(Cons):- is_cf_nil(Cons,_). +is_cf_nil('Cons','NNNil'). +%is_cf_nil('::','nil'). + +is_i_nil(I):- + is_cf_nil('Cons',Nil), I == Nil. + +subst_vars(TermWDV, NewTerm):- + subst_vars(TermWDV, NewTerm, NamedVarsList), + maybe_set_var_names(NamedVarsList). + +subst_vars(TermWDV, NewTerm, NamedVarsList) :- + subst_vars(TermWDV, NewTerm, [], NamedVarsList). + +subst_vars(Term, Term, NamedVarsList, NamedVarsList) :- var(Term), !. +subst_vars([], [], NamedVarsList, NamedVarsList):- !. +subst_vars([TermWDV|RestWDV], [Term|Rest], Acc, NamedVarsList) :- !, + subst_vars(TermWDV, Term, Acc, IntermediateNamedVarsList), + subst_vars(RestWDV, Rest, IntermediateNamedVarsList, NamedVarsList). +subst_vars('$VAR'('_'), _, NamedVarsList, NamedVarsList) :- !. +subst_vars('$VAR'(VName), Var, Acc, NamedVarsList) :- nonvar(VName), svar_fixvarname_dont_capitalize(VName,Name), !, + (memberchk(Name=Var, Acc) -> NamedVarsList = Acc ; ( !, Var = _, NamedVarsList = [Name=Var|Acc])). +subst_vars(Term, Var, Acc, NamedVarsList) :- atom(Term),symbol_concat('$',DName,Term), + dvar_name(DName,Name),!,subst_vars('$VAR'(Name), Var, Acc, NamedVarsList). + +subst_vars(TermWDV, NewTerm, Acc, NamedVarsList) :- + compound(TermWDV), !, + compound_name_arguments(TermWDV, Functor, ArgsWDV), + subst_vars(ArgsWDV, Args, Acc, NamedVarsList), + compound_name_arguments(NewTerm, Functor, Args). +subst_vars(Term, Term, NamedVarsList, NamedVarsList). + + +connlf:- check_silent_loading, not_compat_io((format('~N'))). +connl:- check_silent_loading,not_compat_io((nl)). +% check_silent_loading:- silent_loading,!,trace,break. +check_silent_loading. +silent_loading:- option_value('load','silent'), !. +silent_loading:- is_converting,!. +silent_loading:- option_value('html','True'), !,fail. +silent_loading:- option_value('trace-on-load','False'), !. + + + + +uncompound(OBO,Src):- \+ compound(OBO),!, Src = OBO. +uncompound('$VAR'(OBO),'$VAR'(OBO)):-!. +uncompound(IsList,Src):- is_list(IsList),!,maplist(uncompound,IsList,Src). +uncompound([Is|NotList],[SrcH|SrcT]):-!, uncompound(Is,SrcH),uncompound(NotList,SrcT). +uncompound(Compound,Src):- compound_name_arguments(Compound,Name,Args),maplist(uncompound,[Name|Args],Src). + +assert_to_metta(_):- reached_file_max,!. +assert_to_metta(OBO):- + must_det_ll((OBO=..[Fn|DataLL], + maplist(better_arg,DataLL,DataL), + into_datum(Fn, DataL, Data), + functor(Data,Fn,A),decl_fb_pred(Fn,A), + real_assert(Data),!, + incr_file_count(_))). + +assert_to_metta(OBO):- + ignore(( A>=2,A<700, + OBO=..[Fn|Cols], + must_det_ll(( + make_assertion4(Fn,Cols,Data,OldData), + functor(Data,FF,AA), + decl_fb_pred(FF,AA), + ((fail,call(Data))->true;( + must_det_ll(( + real_assert(Data), + incr_file_count(_), + ignore((((should_show_data(X), + ignore((fail,OldData\==Data,write('; oldData '),write_src(OldData),format(' ; ~w ~n',[X]))), + write_src(Data),format(' ; ~w ~n',[X]))))), + ignore(( + fail, option_value(output_stream,OutputStream), + is_stream(OutputStream), + should_show_data(X1),X1<1000,must_det_ll((display(OutputStream,Data),writeln(OutputStream,'.'))))))))))))),!. + +assert_MeTTa(OBO):- !, assert_to_metta(OBO). +%assert_MeTTa(OBO):- !, assert_to_metta(OBO),!,heartbeat. +/* +assert_MeTTa(Data):- !, heartbeat, functor(Data,F,A), A>=2, + decl_fb_pred(F,A), + incr_file_count(_), + ignore((((should_show_data(X), + write(newData(X)),write(=),write_src(Data))))), + assert(Data),!. +*/ + + +%:- dynamic((metta_type/3,metta_defn/3,get_metta_atom/2)). + + +:- dynamic(progress_bar_position/1). + +% Initialize the progress bar and remember its starting position +init_progress_bar(Width) :- + current_output(Stream), + stream_property(Stream, position(Pos)), + asserta(progress_bar_position(Pos)), + write('['), + forall(between(1, Width, _), write(' ')), + write(']'), + flush_output. + +% Check if the progress bar needs to be redrawn and update it accordingly +update_progress_bar(Current, Total, Width) :- + current_output(Stream), + % Get the current position + stream_property(Stream, position(CurrentPos)), + % Get the remembered position + progress_bar_position(SavedPos), + % Compare positions; if they differ, redraw the entire progress bar + ( SavedPos \= CurrentPos + -> redraw_progress_bar(Width) + ; true + ), + % Update the progress bar + Percentage is Current / Total, + Filled is round(Percentage * Width), + write('\r['), + forall(between(1, Filled, _), write('#')), + Remaining is Width - Filled, + forall(between(1, Remaining, _), write(' ')), + write(']'), + flush_output. + +% Redraw the progress bar if the position has changed +redraw_progress_bar(Width) :- + nl, + init_progress_bar(Width). + +% Adjusted example predicate for 1 million steps +progress_bar_example :- + TotalSteps = 1000000, % Adjust the total steps to 1 million + ProgressBarWidth = 30, + init_progress_bar(ProgressBarWidth), + between(1, TotalSteps, Step), + update_progress_bar(Step, TotalSteps, ProgressBarWidth), + % Simulate work + sleep(0.00001), % Adjust sleep time as needed for demonstration + fail. % Continue looping until between/3 fails +progress_bar_example. + +:- dynamic(using_corelib_file/0). + + +use_corelib_file:- using_corelib_file,!. +use_corelib_file:- asserta(using_corelib_file), fail. +use_corelib_file:- load_corelib_file, generate_interpreter_stubs. + +generate_interpreter_stubs:- + forall(metta_type('&corelib',Symb,Def), + gen_interp_stubs('&corelib',Symb,Def)). + +load_corelib_file:- is_metta_src_dir(Dir), really_use_corelib_file(Dir,'corelib.metta'),!. +load_corelib_file:- is_metta_src_dir(Dir), really_use_corelib_file(Dir,'stdlib_mettalog.metta'),!. +% !(import! &corelib "src/canary/stdlib_mettalog.metta") +really_use_corelib_file(Dir,File):- absolute_file_name(File,Filename,[relative_to(Dir)]), + locally(nb_setval(may_use_fast_buffer,t), + locally(nb_setval(suspend_answers,true), + with_output_to(string(_),include_metta_directory_file('&corelib',Dir,Filename)))). + diff --git a/.Attic/canary_docme/metta_mizer.pl b/.Attic/canary_docme/metta_mizer.pl new file mode 100644 index 00000000000..e08380327e3 --- /dev/null +++ b/.Attic/canary_docme/metta_mizer.pl @@ -0,0 +1,695 @@ +% Disables the optimizer +% Always evaluates to false, effectively a no-op. +disable_optimizer:- false. +% Base clause for disabling optimizer; never succeeds. +disable_optimizer. + +% Operator definitions for pattern matching +% Defines custom operator '=~' with precedence level 700. +:- op(700,xfx,'=~'). +% Defines custom operator '=~' with precedence level 690. +:- op(690,xfx, =~ ). + +%% assumed_true(+HB, +B2) is semidet. +% Verifies that certain conditions hold true, taking into account dynamic disabling of the optimizer. +% Arguments: +% - HB: Context or helper structure used in the optimization process. +% - B2: The condition to be verified. +% If the optimizer is disabled, or if B2 does not meet specific criteria, the predicate fails. +% Otherwise, it verifies the condition based on the structure of B2. +% +/* previous: % disables*/ +assumed_true(_,_):- disable_optimizer, !, fail. +% Fails if the second argument is unbound. +assumed_true(_ ,B2):- var(B2),!,fail. +% Recursively checks truth of embedded evaluations. +assumed_true(HB,eval_true(B2)):-!,assumed_true(HB,B2). +% Checks if B2 is explicitly the term 'is_True('True')'. +assumed_true(_ ,B2):- B2==is_True('True'). +% Checks if B2 is the string 'True'. +%assumed_true(_ ,A=B):- A==B,!. +assumed_true(_ ,B2):- B2=='True'. +% Checks if B2 is the boolean true. +assumed_true(_ ,B2):- B2== true,!. +% Evaluates to true if both A and B are equal and Atom is 'Atom'. +assumed_true(_ ,eval_for(b_5,Atom,A,B)):- 'Atom' == Atom, A=B. +% Evaluates to true if both A and B are equal and Atom is 'Any'. +assumed_true(_ ,eval_for(b_5,Atom,A,B)):- 'Any' == Atom, A=B. +%assumed_true(_ ,eval_for(b_1,Atom,A,B)):- 'Atom' == Atom, A=B. +% Fails if B2 is a user assignment with 'True'. +assumed_true(_ ,B2):- B2==u_assign('True', '$VAR'('_')),!. +% Recursively checks equality by evaluating X=Y. +assumed_true(HB,X==Y):- !, assumed_true(HB,X=Y). +%assumed_true( _,X=Y):- X==Y,!. +% Evaluates equality between X and Y if both are namespace variables and counts are appropriate. +assumed_true(HB,X=Y):- is_nsVar(X),is_nsVar(Y), + ( \+ (X\=Y)), + % Ensure X and Y are not explicitly different + (count_var_gte(HB,Y,2);count_var_gte(HB,X,2)), + % Ensure variable occurs enough times + X=Y,!. + +% Optimizes variable assignment with respect to unary functions. +% Fails immediately if optimizer is disabled. + optimize_u_assign_1(_,_):- disable_optimizer,!, fail. +% Fails if Var is a namespace variable. +optimize_u_assign_1(_,Var,_,_):- is_nsVar(Var),!,fail. +% Checks symbol arity and generates code if matching. +optimize_u_assign_1(_HB,[H|T],R,Code):- symbol(H),length([H|T],Arity), + predicate_arity(F,A),Arity==A, \+ (predicate_arity(F,A2),A2\=A), + append([H|T],[R],ArgsR),Code=..ArgsR,!. +% Optimizes non-compound terms. +optimize_u_assign_1(HB,Compound,R,Code):- \+ compound(Compound),!, optimize_u_assign(HB,Compound,R,Code). +% Continues optimization for lists. +optimize_u_assign_1(HB,[H|T],R,Code):- !, optimize_u_assign(HB,[H|T],R,Code). +% Handles the case of unbound compound and list in R. +optimize_u_assign_1(_ ,Compound,R,Code):- + is_list(R),var(Compound), + into_u_assign(R,Compound,Code),!. + +%optimize_u_assign_1(_,Compound,R,Code):- f2p(Compound,R,Code),!. +optimize_u_assign_1(_,Compound,R,Code):- + compound(Compound), + as_functor_args(Compound,F,N0), N is N0 +1, + (predicate_arity(F,N); functional_predicate_arg(F, N, N)), + append_term_or_call(Compound,R,Code). +% Translates MeTTa to optimized code. +optimize_u_assign_1(HB,Compound,R,Code):- p2s(Compound,MeTTa), optimize_u_assign(HB,MeTTa,R,Code). +%optimize_u_assign_1(_,[Pred| ArgsL], R, u_assign([Pred| ArgsL],R)). + + + +% disables +%append_term_or_call(F,R,call(F,R)):- disable_optimizer, !. +% Appends terms or calls to generate code. +% Appends terms for lists with symbol F. +append_term_or_call([F|Compound],R,Code):- symbol(F), + is_list(Compound),append(Compound,[R],CodeL), Code=..[F|CodeL],!. +% Handles symbols directly. +append_term_or_call(F,R,Code):- symbol(F),!, Code=..[F,R]. +% General append for term and result. +append_term_or_call(F,R,Code):- append_term(F,R,Code),!. +% Default case calls function with R. +append_term_or_call(F,R,call(F,R)). + + +%% optimize_unit1(+Input, +Output) is semidet. +% Performs optimization on the given `Input` and produces an optimized `Output`. +% This predicate applies various optimization strategies depending on the structure of `Input`. +% Arguments: +% - Input: The term or structure to be optimized. +% - Output: The result after applying optimization techniques. +% This predicate fails if the optimizer is disabled or if specific conditions are not met. +% + +% Optimization unit for specific true evaluations. +% Fails by default, preventing unintended evaluations. +optimize_unit11(_,_):- !, fail. +% Matches true directly for optimization. +optimize_unit11(True,true):-True==true,!. +/* +optimize_unit11(B1,true):- B1 = eval_for(b_1,NonEval, A, B), A=B, is_non_eval_kind(NonEval),!. +optimize_unit11(B1,true):- B1 = eval_for(b_5,NonEval, A, B), A=B, is_non_eval_kind(NonEval),!. + +optimize_unit11(B1,true):- B1 = eval_for(b_6,NonEval, A, B), A=B, is_non_eval_kind(NonEval),!. +*/ + + +% Handles specific structured evaluations. +optimize_unit11(eval_true([GM, Val, Eval]), call(GM, Val, Eval)):- + symbol(GM), \+ iz_conz(Val), \+ iz_conz(Eval), + GM = '==',!. + +optimize_unit11(eval_true([GM0, [GM, Eval], Val]), call(GM,Eval,Val)):- + GM0 = '==', + symbol(GM), predicate_arity(GM,2), \+ predicate_arity(GM,1), + nonvar(Val),var(Eval),!. +% Handles undefined evaluations that resolve to true. +optimize_unit11(I,true):- I=eval_for(_,'%Undefined%', A, C), \+ iz_conz(A),\+ iz_conz(C), A=C. + + +% disables +optimize_unit1(_,_):- disable_optimizer, !, fail. % Disable the optimizer, failing immediately. +optimize_unit1(Var,_):- var(Var),!,fail. % Fail if the first argument is unbound. +optimize_unit1(true,true):-!. % Succeed immediately if the first argument is `true`. + +optimize_unit1(I,O):- fail, \+ is_list(I), I\=(_,_), compound(I), + predicate_property(I,number_of_rule(1)),predicate_property(I,number_of_causes(1)), + clause(I,O), O\==true, O\=(_,_). + +% Optimize the case where `eval_for/4` checks for equality of `A` and `B`. +optimize_unit1(eval_for(b_6,'Atom', A,B), A=B):- \+ iz_conz(A),\+ iz_conz(B), \+ \+ (A=B). +% Optimize when `NonEval` is 'Bool' and `B` is 'True'. +optimize_unit1(B1,eval_true(A)):- B1 = eval_for(_,NonEval, A, B),NonEval=='Bool', B=='True',!. + +%% optimize_unit1(+Input, +Output) is semidet. +% Continues optimization based on specific patterns in the `Input`. +% Optimizations include equality checks, freezing variables, and pattern matching. +% This version preserves existing predicate definitions for specialized cases. +% +optimize_unit1(_,_):- disable_optimizer, !, fail. % Ensure the optimizer can be disabled. +optimize_unit1(eval_for(b_6,Atom,A,B),eval(A,B)):- 'Atom' == Atom,!. % Specific case optimization for `Atom`. +% Optimize `eval_for/4` by freezing variables and checking equality. +optimize_unit1(eval_for(_,Atom,A,B),print(A=B)):- 'Atom' == Atom, freeze(A, A=B),freeze(B, A=B), \+ \+ (A=B). +% Handle boolean comparisons where both `B` and `True` are 'True'. +optimize_unit1(B=True, B=True):- B='True','True'==True. +% General optimization for evaluations known to be true. +optimize_unit1(ISTRUE,true):- assumed_true(_ ,ISTRUE),!. +% Flatten nested conjunctions. +optimize_unit1(((A,B),C),(A,B,C)). +% Optimize equality of constants and variables. +optimize_unit1(=(Const,Var),true):- is_nsVar(Var),symbol(Const),=(Const,Var). +% Attempt to further optimize equality, though this path fails by default. +optimize_unit1(=(Const,Var),=(Var,Const)):- fail, is_nsVar(Var),symbol(Const),!. + +% Optimize calls to `get-metatype/2` with specific patterns. +optimize_unit1( + ==(['get-metatype', A], Sym, _B), + call('get-metatype',A,Sym)). + +% Handle specific cases where `eval_true/1` is checking a metatype. +optimize_unit1( + eval_true([==, ['get-metatype', A], 'Expression']), + call('get-metatype',A,'Expression')). + +% General optimization for binary operations, particularly `==/2`. +optimize_unit1( eval_true([GM, Val, Eval]), call(GM, Val, Eval)):- + symbol(GM), \+ iz_conz(Val), \+ iz_conz(Eval), + GM = '==',!. + +% Optimize unary operations that match specific criteria. +optimize_unit1( eval_true([GM, Eval]), call(GM,Eval)):- + symbol(GM), predicate_arity(GM,1), \+ predicate_arity(GM,2), + var(Eval),!. + +% Optimize match operations involving equality and argument unification. +optimize_unit1( ==([GM,Eval],Val,C), call(GM,Eval,Val)):- C==Eval, + symbol(GM), predicate_arity(GM,2), \+ predicate_arity(GM,1), + symbol(Val),var(Eval),!. + +%% optimize_u_assign(+Head, +Args, +Result, -Code) is semidet. +% Optimizes variable assignments and function calls in a MeTTa program. +% Arguments: +% - Head: The head of the clause, typically a compound term. +% - Args: The list of arguments to be optimized. +% - Result: The result of the optimization, typically a variable. +% - Code: The generated code after optimization. +% This predicate includes specific patterns for arithmetic, logical operations, and function calls. +% + +optimize_u_assign(_,_,_,_):- disable_optimizer, !, fail. +% Disable optimizer if necessary. + + + +% Fail if the first argument in the list is a namespace variable. +optimize_u_assign(_,[Var|_],_,_):- is_nsVar(Var),!,fail. +% Optimize empty lists to a fail predicate. +optimize_u_assign(_,[Empty], _, (!,fail)):- Empty == empty,!. +% Optimize binary equality checks in specific contexts. +optimize_u_assign(_,[EqEq,[GM,Eval],Val],C, call(GM,Eval,Val)):- + EqEq == '==',C==Eval, + symbol(GM), predicate_arity(GM,2), \+ predicate_arity(GM,1), + symbol(Val),var(Eval),!. + +% Optimize arithmetic operations with basic operations like addition and subtraction. +optimize_u_assign(_,[+, A, B], C, plus(A , B, C)):- number_wang(A,B,C), !. +optimize_u_assign(_,[-, A, B], C, plus(B , C, A)):- number_wang(A,B,C), !. +optimize_u_assign(_,[+, A, B], C, +(A , B, C)):- !. +optimize_u_assign(_,[-, A, B], C, +(B , C, A)):- !. +optimize_u_assign(_,[*, A, B], C, *(A , B, C)):- number_wang(A,B,C), !. +optimize_u_assign(_,['/', A, B], C, *(B , C, A)):- number_wang(A,B,C), !. +optimize_u_assign(_,[*, A, B], C, *(A , B, C)):- !. +optimize_u_assign(_,['/', A, B], C, *(B , C, A)):- !. +% Optimize Fibonacci calculations. +optimize_u_assign(_,[fib, B], C, fib(B, C)):- !. +optimize_u_assign(_,[fib1, A,B,C,D], R, fib1(A, B, C, D, R)):- !. +% Optimize pragma settings in MeTTa. +optimize_u_assign(_,['pragma!',N,V],Empty,set_option_value_interp(N,V)):- + nonvar(N),ignore((fail,Empty='Empty')), !. +% Optimize filter operations, matching against specific patterns in the head. +optimize_u_assign((H:-_),Filter,A,filter_head_arg(A,Filter)):- fail, compound(H), arg(_,H,HV), + HV==A, is_list(Filter),!. +% Optimize arithmetic operations using CLP(FD) constraints. +optimize_u_assign(_,[+, A, B], C, '#='(C , A + B)):- number_wang(A,B,C), !. +optimize_u_assign(_,[-, A, B], C, '#='(C , A - B)):- number_wang(A,B,C), !. +% Optimize match operations involving queries and templates. +optimize_u_assign(_,[match,KB,Query,Template], R, Code):- match(KB,Query,Template,R) = Code. + +% Further optimize MeTTa code after translation into an intermediate form. +optimize_u_assign(HB,MeTTaEvalP, R, Code):- \+ is_nsVar(MeTTaEvalP), + compound_non_cons(MeTTaEvalP), p2s(MeTTaEvalP,MeTTa), + MeTTa\=@=MeTTaEvalP,!, optimize_body(HB, u_assign(MeTTa, R), Code). + +/*% optimize_u_assign(_,_,_,_):- !,fail.*/ + +% Default case for function application optimization. +optimize_u_assign((H:-_),[Pred| ArgsL], R, Code):- var(R), symbol(Pred), ok_to_append(Pred), + append([Pred| ArgsL],[R], PrednArgs),Code=..PrednArgs, + (H=..[Pred|_] -> nop(set_option_value('tabling',true)) ; current_predicate(_,Code)),!. + +%% optimize_conj(+Head, +B1, +B2, -Optimized) is semidet. +% Optimizes conjunctions within a clause body. +% This involves combining or transforming predicates to improve efficiency. +% Arguments: +% - Head: The head of the clause. +% - B1, B2: The conjunctions within the body. +% - Optimized: The resulting optimized conjunction. +% This predicate also handles special cases for true evaluations. +% + +optimize_conj(_, _, _, _):- disable_optimizer, !, fail. % Disable optimization if needed. + +% Optimize evaluation of true statements. +optimize_conj(_Head, B1,B2,eval_true(E)):- + B2 = is_True(True_Eval), + B1 = eval(E,True_Eval1), + True_Eval1 == True_Eval,!. + +% Optimize conjunctions involving variable assignments. +optimize_conj(HB, RR, C=A, RR):- compound(RR),is_nsVar(C),is_nsVar(A), + as_functor_args(RR,_,_,Args),is_list(Args), member(CC,Args),var(CC), CC==C, + count_var(HB,C,N),N=2,C=A,!. + +% Optimize u_assign for true evaluations. +optimize_conj(_, u_assign(Term, C), u_assign(True,CC), eval_true(Term)):- + 'True'==True, CC==C. +optimize_conj(_, u_assign(Term, C), is_True(CC), eval_true(Term)):- CC==C, !. +optimize_conj(HB, u_assign(Term, C), C=A, u_assign(Term,A)):- is_ftVar(C),is_ftVar(A),count_var(HB,C,N),N=2,!. +optimize_conj(_, u_assign(Term, C), is_True(CC), eval_true(Term)):- CC==C, !. +% Optimize by verifying assumptions. +optimize_conj(HB, B1,BT,B1):- assumed_true(HB,BT),!. +optimize_conj(HB, BT,B1,B1):- assumed_true(HB,BT),!. +%optimize_conj(Head, u_assign(Term, C), u_assign(True,CC), Term):- 'True'==True, +% optimize_conj(Head, u_assign(Term, C), is_True(CC), CTerm). +%optimize_conj(Head,B1,BT,BN1):- assumed_true(HB,BT),!, optimize_body(Head,B1,BN1). +%optimize_conj(Head,BT,B1,BN1):- assumed_true(HB,BT),!, optimize_body(Head,B1,BN1). +% Optimize conjunctions within the body of a clause. +optimize_conj(Head,B1,B2,(BN1,BN2)):- + optimize_body(Head,B1,BN1), optimize_body(Head,B2,BN2). + +% Preserve the following commented-out code for future reference or extended use cases. + +%% optimize_head_and_body(+Head, +Body, -HeadNew, -BodyNew) is det. +% Optimizes both the head and body of a clause. +% This includes labeling, merging, and recursively optimizing the body. +% Arguments: +% - Head: The original head of the clause. +% - Body: The original body of the clause. +% - HeadNew: The optimized head. +% - BodyNew: The optimized body. +% +optimize_head_and_body(Head,Body,HeadNewest,BodyNewest):- + label_body_singles(Head,Body), + % Label single occurrences in the body. + (merge_and_optimize_head_and_body(Head,Body,HeadNew,BodyNew), + (((Head,Body)=@=(HeadNew,BodyNew)) + -> (HeadNew=HeadNewest,BodyNew=BodyNewest) + ; + + (color_g_mesg('#404064',print_pl_source(( HeadNew :- BodyNew))), + optimize_head_and_body(HeadNew,BodyNew,HeadNewest,BodyNewest)))),!. + +%% continue_opimize(+HeadBody, -OptimizedClause) is det. +% Continues the optimization process on a given head-body clause. +% Arguments: +% - HeadBody: The original head-body pair. +% - OptimizedClause: The resulting optimized clause. +% +continue_opimize(HB,(H:-BB)):- expand_to_hb(HB,H,B), must_optimize_body(HB,B,BB),!. +/*%continue_opimize(Converted,Converted).*/ + + +% Further optimization continues below, including merging heads and optimizing bodies. + +%% merge_and_optimize_head_and_body(+AHead, +Body, -Head, -BodyNew) is det. +% Merges and optimizes the head and body of a clause. +% This includes handling special cases for head structures and optimizing the body. +% Arguments: +% - AHead: The head of the clause before optimization. +% - Body: The body of the clause. +% - Head: The optimized head. +% - BodyNew: The optimized body. +% +merge_and_optimize_head_and_body(Head,Converted,HeadO,Body):- nonvar(Head), + Head = (PreHead,True),!, + merge_and_optimize_head_and_body(PreHead,(True,Converted),HeadO,Body),!. +merge_and_optimize_head_and_body(AHead,Body,Head,BodyNew):- + assertable_head(AHead,Head), + % Convert the head to an assertable form if needed. + must_optimize_body(Head,Body,BodyNew),!. + +%% assertable_head(+FListR, -Head) is det. +% Converts specific patterns in the head to a more assertable form. +% This is used to transform functional heads into a predicate form. +% Arguments: +% - FListR: The original function list and result. +% - Head: The transformed, assertable head. +% +assertable_head(u_assign(FList,R),Head):- FList =~ [F|List], + append(List,[R],NewArgs), symbol(F), Head=..[F|NewArgs],!. +assertable_head(Head,Head). +% Default case, the head is already assertable. + +%% label_body_singles(+Head, +Body) is det. +% Labels single occurrences of variables in the body for optimization purposes. +% This is necessary for certain optimizations that rely on variable occurrences. +% Arguments: +% - Head: The head of the clause. +% - Body: The body of the clause. +% +label_body_singles(Head,Body):- + term_singletons(Body+Head,BodyS), + % Find singletons in the body relative to the head. + maplist(label_body_singles_2(Head),BodyS). + +% Helper predicate to label single variables if not already in the head. +label_body_singles_2(Head,Var):- sub_var(Var,Head),!. +label_body_singles_2(_,Var):- ignore(Var='$VAR'('_')). + +%! metta_predicate(+Signature) is det. +% Declares various MeTTa predicates used in optimizations. +%ThesedeclarationsassistinpatternmatchingandoptimizationsinMeTTa. +%Arguments: +%-Signature:ThesignatureoftheMeTTapredicate. +% +metta_predicate(u_assign(evaluable,eachvar)). +metta_predicate(eval_true(matchable)). +metta_predicate(with_space(space,matchable)). +metta_predicate(limit(number,matchable)). +metta_predicate(findall(template,matchable,listvar)). +metta_predicate(match(space,matchable,template,eachvar)). + +%% must_optimize_body(+Head, +Body, -OptimizedBody) is det. +% Recursively optimizes the body of a clause. +% It applies optimizations iteratively until no further optimizations can be made. +% Arguments: +% - Head: The head of the clause. +% - Body: The body of the clause. +% - OptimizedBody: The final optimized version of the body. +% +must_optimize_body(A,B,CC):- once(optimize_body(A,B,C)), C \=@= B,!, must_optimize_body(A,C,CC). +must_optimize_body(_,B,C):- B =C. +% If no further optimization is possible, return the body as is. +%! optimize_body(+HB, +Body, -BodyNew) is det. +% +% Core optimization logic for a clause body. +% This predicate optimizes various constructs within the body of a clause, including function calls, conditional statements, and more. +% +% @arg HB The head-body context or clause being optimized. +% @arg Body The original body of the clause. +% @arg BodyNew The resulting optimized body. +% +optimize_body(_HB, Body, BodyNew) :- + % If the body is a namespace variable, return it as is. + is_nsVar(Body), !, Body = BodyNew. + +/* previously: +% optimize_body( HB, u_assign(VT,R), u_assign(VT,R)) :- +% This optimization was commented out, possibly because it was redundant or unnecessary. +% must_optimize_body(HB, VT, VTT). +*/ + +optimize_body(HB, with_space(V, T), with_space(V, TT)) :- + % Optimize the body within the with_space construct. + !, must_optimize_body(HB, T, TT). + +optimize_body(HB, call(T), call(TT)) :- + % Optimize the body within a call construct. + !, must_optimize_body(HB, T, TT). + +optimize_body(HB, rtrace_on_error(T), rtrace_on_error(TT)) :- + % Optimize the body within rtrace_on_error for error tracing. + !, must_optimize_body(HB, T, TT). + +optimize_body(HB, limit(V, T), limit(V, TT)) :- + % Optimize the body within a limit construct. + !, must_optimize_body(HB, T, TT). + +optimize_body(HB, findall_ne(V, T, R), findall_ne(V, TT, R)) :- + % Optimize within a findall_ne construct, expanding the head-body if necessary. + !, expand_to_hb(HB, H, _), must_optimize_body((H :- findall_ne(V, T, R)), T, TT). + +optimize_body(HB, findall(V, T, R), findall(V, TT, R)) :- + % Optimize within a findall construct, expanding the head-body if necessary. + !, expand_to_hb(HB, H, _), must_optimize_body((H :- findall(V, T, R)), T, TT). + +optimize_body(HB, loonit_assert_source_tf(V, T, R3, R4), loonit_assert_source_tf(V, TT, R3, R4)) :- + % Optimize within a loonit_assert_source_tf construct. + !, must_optimize_body(HB, T, TT). + +optimize_body(HB, loonit_assert_source_empty(V, X, Y, T, R3, R4), loonit_assert_source_empty(V, X, Y, TT, R3, R4)) :- + % Optimize within a loonit_assert_source_empty construct. + !, must_optimize_body(HB, T, TT). + +optimize_body(HB, (B1 *-> B2 ; B3), (BN1 *-> BN2 ; BN3)) :- + % Optimize conditional constructs with potential non-determinism. + !, must_optimize_body(HB, B1, BN1), optimize_body(HB, B2, BN2), optimize_body(HB, B3, BN3). + +optimize_body(HB, (B1 -> B2 ; B3), (BN1 -> BN2 ; BN3)) :- + % Optimize conditional constructs with determinism. + !, must_optimize_body(HB, B1, BN1), must_optimize_body(HB, B2, BN2), must_optimize_body(HB, B3, BN3). + +optimize_body(HB, (B1 :- B2), (BN1 :- BN2)) :- + % Optimize body in the context of a clause definition. + !, optimize_body(HB, B1, BN1), optimize_body(HB, B2, BN2). + +optimize_body(HB, (B1 *-> B2), (BN1 *-> BN2)) :- + % Optimize a soft-cut conditional construct. + !, must_optimize_body(HB, B1, BN1), optimize_body(HB, B2, BN2). + +optimize_body(HB, (B1 -> B2), (BN1 -> BN2)) :- + % Optimize a hard-cut conditional construct. + !, must_optimize_body(HB, B1, BN1), optimize_body(HB, B2, BN2). + +optimize_body(HB, (B1 ; B2), (BN1 ; BN2)) :- + % Optimize disjunction constructs. + !, optimize_body(HB, B1, BN1), optimize_body(HB, B2, BN2). + +optimize_body(HB, (B1, B2), (BN1)) :- + % Optimize conjunctions, ensuring optimization of both parts. + optimize_conjuncts(HB, (B1, B2), BN1). + +/* previously: +% optimize_body(_HB, ==(Var, C), Var=C):- self_eval(C), !. +% This code was commented out, possibly because it relied on a specific evaluation context or was redundant. +*/ + +optimize_body(HB, u_assign(A, B), R) :- + % Optimize assignments, possibly using an optimized version of u_assign. + optimize_u_assign_1(HB, A, B, R), !. + +optimize_body(HB, eval(A, B), R) :- + % Optimize evaluation constructs. + optimize_u_assign_1(HB, A, B, R), !. + +/* previously: +% optimize_body(_HB, u_assign(A, B), u_assign(AA, B)) :- +% This code was commented out, possibly because the optimization logic was handled elsewhere. +% p2s(A, AA), !. +*/ + +optimize_body(_HB, Body, BodyNew) :- + % Fall back to unit-level optimization if no other rules apply. + optimize_body_unit(Body, BodyNew). + +%! optimize_body_unit(+I, -O) is det. +% +% Unit-level optimization of body elements. +% This predicate handles simple transformations and straightforward optimizations within the body. +% +% @arg I The original body element to be optimized. +% @arg O The optimized body element. +% +optimize_body_unit(I, O) :- + % If the body element is 'true', return it as is. + I == true, !, I = O. + +optimize_body_unit(I, O) :- + % If the body element is a trivial equality, simplify it to 'true'. + I == ('True' = 'True'), !, O = true. + +optimize_body_unit(I, O) :- + % This branch was intended for more complex optimizations but was commented out. + fail, copy_term(I, II), optimize_unit1(I, Opt), I =@= II, !, optimize_body_unit(Opt, O). + +optimize_body_unit(I, O) :- + % This branch was intended for another level of optimization but was commented out. + fail, optimize_unit11(I, Opt), optimize_body_unit(Opt, O). + +optimize_body_unit(O, O). + +%! ok_to_append(+Symbol) is semidet. +% +% Predicate to determine if appending is allowed for a given symbol. +% +% @arg Symbol The symbol to check. +% +ok_to_append('$VAR') :- + % '$VAR' cannot be appended. + !, fail. +ok_to_append(_). + +%! number_wang(+A, +B, +C) is det. +% +% Helper predicate to handle numeric operations in optimization. +% Ensures that the arguments are numeric or variables, and declares them as numeric if necessary. +% +% @arg A The first numeric value or variable. +% @arg B The second numeric value or variable. +% @arg C The third numeric value or variable. +% +number_wang(A, B, C) :- + % Ensure that the arguments are numeric or variables, and declare them as numeric if necessary. + (numeric(C) ; numeric(A) ; numeric(B)), !, + maplist(numeric_or_var, [A, B, C]), + maplist(decl_numeric, [A, B, C]), !. + +%! p2s(+P, -S) is det. +% +% Converts a Prolog term into a list of arguments for further processing. +% +% @arg P The Prolog term to be converted. +% @arg S The resulting list of arguments. +% +p2s(P, S) :- + % Convert the term P into a list of its arguments. + into_list_args(P, S). + +%! get_decl_type(+N, -DT) is semidet. +% +% Retrieves the declared type of a variable based on attributes. +% +% @arg N The variable whose declared type is being retrieved. +% @arg DT The declared type of the variable. +% +get_decl_type(N, DT) :- + % If N is an attributed variable, retrieve its declared type. + attvar(N), get_atts(N, AV), sub_term(DT, AV), symbol(DT). + +%! numeric(+N) is semidet. +% +% Checks if a term is numeric, either by being a number or having the 'Number' attribute. +% +% @arg N The term to check. +% +numeric(N) :- + % Check if N is a number. + number(N), !. +numeric(N) :- + % Check if N has the 'Number' attribute. + get_attr(N, 'Number', 'Number'). +numeric(N) :- + % Check if N's declared type is numeric. + get_decl_type(N, DT), (DT == 'Int', DT == 'Number'). + +%! decl_numeric(+N) is det. +% +% Declares a variable as numeric if it is not already numeric. +% +% @arg N The variable to be declared as numeric. +% +decl_numeric(N) :- + % Declare N as numeric if it is already numeric. + numeric(N), !. +decl_numeric(N) :- + % If N is a variable, assign it the 'Number' attribute. + ignore((var(N), put_attr(N, 'Number', 'Number'))). + +%! numeric_or_var(+N) is semidet. +% +% Checks if a term is either numeric or a variable. +% +% @arg N The term to check. +% +numeric_or_var(N) :- + % If N is a variable, it passes the check. + var(N), !. +numeric_or_var(N) :- + % If N is numeric, it passes the check. + numeric(N), !. +numeric_or_var(N) :- + % Fail if N is neither numeric nor a variable. + \+ compound(N), !, fail. +numeric_or_var('$VAR'(_)). + +%! non_compound(+S) is semidet. +% +% Helper to check if a term is non-compound. +% +% @arg S The term to check. +% +non_compound(S) :- + % Check if S is not a compound term. + \+ compound(S). + +%! did_optimize_conj(+Head, +B1, +B2, -B12) is semidet. +% +% Attempts to optimize conjunctions and evaluate results. +% +% @arg Head The head-body context. +% @arg B1 The first term in the conjunction. +% @arg B2 The second term in the conjunction. +% @arg B12 The optimized conjunction of B1 and B2. +% +did_optimize_conj(Head, B1, B2, B12) :- + % Attempt to optimize a conjunction and verify the result differs from the original. + once(optimize_conj(Head, B1, B2, B12)), B12 \=@= (B1, B2), !. + +%! optimize_conjuncts(+Head, +Conj, -BN) is det. +% +% Optimizes conjunctions of three terms, with special handling for compound terms. +% +% @arg Head The head-body context. +% @arg Conj The conjunction to be optimized. +% @arg BN The resulting optimized conjunction. +% +optimize_conjuncts(Head, (B1, B2, B3), BN) :- + % Optimize a conjunction of three terms, with special consideration for B3 being a simple term. + B3 \= (_, _), + did_optimize_conj(Head, B2, B3, B23), + must_optimize_body(Head, (B1, B23), BN), !. + +optimize_conjuncts(Head, (B1, B2, B3), BN) :- + % Optimize a conjunction of three terms, with special consideration for B1 being a simple term. + did_optimize_conj(Head, B1, B2, B12), + must_optimize_body(Head, (B12, B3), BN), !. + +/* previously: +% optimize_conjuncts(Head, (B1, B2), BN1) :- optimize_conj(Head, B1, B2, BN1). +% This was likely commented out due to redundancy with did_optimize_conj. +*/ + +optimize_conjuncts(Head, (B1, B2), BN1) :- + % Optimize a conjunction of two terms. + did_optimize_conj(Head, B1, B2, BN1), !. + +optimize_conjuncts(Head, (B1 *-> B2), (BN1 *-> BN2)) :- + % Optimize a soft-cut conditional conjunction. + !, optimize_conjuncts(Head, B1, BN1), optimize_conjuncts(Head, B2, BN2). + +optimize_conjuncts(Head, (B1 -> B2), (BN1 -> BN2)) :- + % Optimize a hard-cut conditional conjunction. + !, optimize_conjuncts(Head, B1, BN1), optimize_conjuncts(Head, B2, BN2). + +optimize_conjuncts(Head, (B1 ; B2), (BN1 ; BN2)) :- + % Optimize a disjunction of two terms. + !, optimize_conjuncts(Head, B1, BN1), optimize_conjuncts(Head, B2, BN2). + +optimize_conjuncts(Head, (B1, B2), (BN1, BN2)) :- + % Optimize a conjunction of two terms. + !, must_optimize_body(Head, B1, BN1), must_optimize_body(Head, B2, BN2). + +optimize_conjuncts(_, A, A). + +%! count_var_gte(+HB, +V, +Ct) is det. +% +% Counts the occurrences of a variable in a term, ensuring it meets or exceeds a threshold. +% +% @arg HB The head-body context. +% @arg V The variable to be counted. +% @arg Ct The minimum count threshold. +% +count_var_gte(HB, V, Ct) :- + % Count the occurrences of V in HB and compare with the threshold Ct. + count_var(HB, V, CtE), Ct >= CtE. diff --git a/.Attic/canary_docme/metta_ontology.pfc.pl b/.Attic/canary_docme/metta_ontology.pfc.pl new file mode 100644 index 00000000000..8fe2560b6dc --- /dev/null +++ b/.Attic/canary_docme/metta_ontology.pfc.pl @@ -0,0 +1,475 @@ +/* + * Project: MeTTaLog - A MeTTa to Prolog Transpiler/Interpreter + * Description: This file is part of the source code for a transpiler designed to convert + * MeTTa language programs into Prolog, utilizing the SWI-Prolog compiler for + * optimizing and transforming function/logic programs. It handles different + * logical constructs and performs conversions between functions and predicates. + * + * Author: Douglas R. Miles + * Contact: logicmoo@gmail.com / dmiles@logicmoo.org + * License: LGPL + * Repository: https://github.com/trueagi-io/metta-wam + * https://github.com/logicmoo/hyperon-wam + * Created Date: 8/23/2023 + * Last Modified: $LastChangedDate$ # You will replace this with Git automation + * + * Usage: This file is a part of the transpiler that transforms MeTTa programs into Prolog. For details + * on how to contribute or use this project, please refer to the repository README or the project documentation. + * + * Contribution: Contributions are welcome! For contributing guidelines, please check the CONTRIBUTING.md + * file in the repository. + */ + + +%:- multifile(baseKB:agent_action_queue/3). +%:- dynamic(baseKB:agent_action_queue/3). + +:- set_prolog_flag(gc,true). + +:- thread_local(t_l:disable_px/0). +:- retractall(t_l:disable_px). + +:- must(\+ t_l:disable_px). + +:- op(500,fx,'~'). +:- op(1050,xfx,('=>')). +:- op(1050,xfx,'<==>'). +:- op(1050,xfx,('<-')). +:- op(1100,fx,('==>')). +:- op(1150,xfx,('::::')). +:- + current_prolog_flag(access_level,Was), + set_prolog_flag(access_level,system), + op(1190,xfx,('::::')), + op(1180,xfx,('==>')), + op(1170,xfx,'<==>'), + op(1160,xfx,('<-')), + op(1150,xfx,'=>'), + op(1140,xfx,'<='), + op(1130,xfx,'<=>'), + op(600,yfx,'&'), + op(600,yfx,'v'), + op(350,xfx,'xor'), + op(300,fx,'~'), + op(300,fx,'-'), + op(1199,fx,('==>')), + set_prolog_flag(access_level,Was). + +%:- style_check(-discontiguous). +%:- enable_mpred_expansion. +%:- expects_dialect(pfc). + +/* +:- dynamic lmcache:session_io/4, lmcache:session_agent/2, lmcache:agent_session/2, telnet_fmt_shown/3, agent_action_queue/3). +:- dynamic lmcache:session_io/4, lmcache:session_agent/2, lmcache:agent_session/2, telnet_fmt_shown/3, agent_action_queue/3). + +*/ +%:- nop('$set_source_module'( baseKB)). +:- set_prolog_flag(runtime_speed, 0). +:- set_prolog_flag(runtime_safety, 2). +:- set_prolog_flag(runtime_debug, 2). +:- set_prolog_flag(unsafe_speedups, false). +:- set_prolog_flag(expect_pfc_file,always). + + + +:- set_prolog_flag(pfc_term_expansion,false). + + +params_and_return_type([->|TypeList],Len,Params,Ret):- + append(Params,[Ret], TypeList), + length(Params,Len). + +merge_fp(_,_,N) :- N<1. +merge_fp(T1,T2,N) :- + N>0, + arg(N,T1,X), + arg(N,T2,X), + N1 is N-1, + merge_fp(T1,T2,N1). + +:- set_prolog_flag(pfc_term_expansion,true). + +'functional-predicate'(Name,Arity) ==> + {functor(P1,Name,Arity), + functor(P2,Name,Arity), + arg(Arity,P1,PV1), + arg(Arity,P2,PV2), + N is Arity-1, + merge_fp(P1,P2,N)}, + (P1,{P2,PV1\==PV2} ==> ~P2). + + +==> 'functional-predicate'('next-operation',1). +==> 'functional-predicate'('previous-operation',1). + +:- dynamic('op-complete'/1). + +'previous-operation'(none). + +('next-operation'(Current), + { + if_t( retract('previous-operation'(Previous)), + (if_t(Previous==Current, + nop(wdmsg(continue(Previous)))), + if_t(Previous\=@=Current, + if_t( \+ 'op-complete'(Previous), + (nop(wdmsg(begun(op_complete(Previous)))), + pfcAdd('op-complete'(Previous)), + nop(wdmsg(ended(op_complete(Previous))))))))), + nop(wdmsg(op_next(Current))), + assert('previous-operation'(Current))} + ==> + 'seen-operation'(Current)). + + +% ==> 'next-operation'(next). + + +((properties(KB,A,B),{member(E,B),nonvar(E)})==>property(KB,A,E)). +property(_,Op,E) ==> (form_op(Op),form_prop(E)). + +((property(KB,F,PA),p_arity(PA,A)) ==> (predicate_arity(KB,F,A))). +((property(KB,F,FA),f_arity(FA,A)) ==> (functional_arity(KB,F,A))). + + +% (metta_compiled_predicate(KB,F,A)==>predicate_arity(KB,F,A)). + + + +(metta_atom_asserted(KB,[C,H,T])/(C==':')) ==> metta_type(KB,H,T). +(metta_atom_asserted(KB,[C,H,T|Nil])/(Nil==[],C=='=',H=II)) ==> metta_defn(KB,II,T). +(metta_atom_asserted(KB,[C,H,A1,A2|AL])/(C=='=')) ==> metta_defn(KB,H,[A1,A2|AL]). +(metta_atom_asserted(KB,[C,H|AL])/(C==':-')) ==> metta_defn(KB,H,['wam-body'|AL]). + +metta_defn(KB,[F|Args],_)/length(Args,Len) + ==>src_code_for(KB,F,Len). + +'op-complete'(op(+,'=',F)), + metta_defn(KB,[F|Args],_)/length(Args,Len) + ==>src_code_for(KB,F,Len),{nop(dedupe_cl(/*'&self':*/F))}. + +(src_code_for(KB,F,Len)==>function_arity(KB,F,Len)). + +('op-complete'(op(+,':',F)) + ==> + (( metta_type(KB,F,TypeList)/is_list(TypeList), + {params_and_return_type(TypeList,Len,Params,Ret)}) ==> + metta_params_and_return_type(KB,F,Len,Params,Ret),{do_once(show_deds_w(F))})). + +metta_params_and_return_type(KB,F,Len,Params,Ret), + {is_absorbed_return_type(Params,Ret)} + ==>(function_arity(KB,F,Len),is_absorbed_return(KB,F,Len,Ret),predicate_arity(KB,F,Len)). + +metta_params_and_return_type(KB,F,Len,Params,Ret), + { is_non_absorbed_return_type(Params,Ret), Len1 is Len+1} + ==>(function_arity(KB,F,Len),is_non_absorbed_return(KB,F,Len,Ret),predicate_arity(KB,F,Len1)). + +(need_corelib_types,op_decl(F,Params,Ret),{nonvar(Ret),length(Params,Len)})==> + metta_params_and_return_type('&corelib',F,Len,Params,Ret). + + +ensure_corelib_types:- pfcAdd(please_do_corelib_types). +%(need_corelib_types, metta_atom_corelib(Term)) ==> metta_atom_asserted('&corelib', Term). +(need_corelib_types, metta_atom(KB,Atom)) ==> metta_atom_asserted(KB, Atom). +:- dynamic(need_corelib_types/0). +(please_do_corelib_types, { \+ need_corelib_types }) ==> need_corelib_types. +'ensure-compiler!':- ensure_corelib_types. +if(Cond,Then,Else,Result):- eval_true(Cond)*-> eval(Then,Result); eval(Else,Result). + + + +:- dynamic(can_compile/2). + +src_code_for(KB,F,Len) ==> ( \+ metta_compiled_predicate(KB,F,Len) ==> do_compile(KB,F,Len)). + +do_compile_space(KB) ==> (src_code_for(KB,F,Len) ==> do_compile(KB,F,Len)). + +%do_compile_space('&self'). + +do_compile(KB,F,Len),src_code_for(KB,F,Len) ==> really_compile(KB,F,Len). + + +metta_defn(KB,[F|Args],BodyFn),really_compile(KB,F,Len)/length(Args,Len)==> + really_compile_src(KB,F,Len,Args,BodyFn),{dedupe_ls(F)}. + +really_compile_src(KB,F,Len,Args,BodyFn), + {compile_metta_defn(KB,F,Len,Args,BodyFn,Clause)} + ==> (compiled_clauses(KB,F,Clause)). + + + +%:- ensure_loaded('metta_ontology_level_1.pfc'). + + + + +a==>b. +b==>bb. + +a. +:- b. +:- bb. + +%:- pfcWhy1(a). +%:- pfcWhy1(b). + +:- set_prolog_flag(expect_pfc_file,never). +:- set_prolog_flag(pfc_term_expansion,false). + + +test_fwc:- + pfcAdd_Now(c(X)==>d(X)), + pfcAdd_Now(c(1)), + c(_), + d(_), + pfcWhy1(c(_)), + pfcWhy1(d(_)), + pfcAdd(e(2)), + e(_), + pfcAdd(e(X)<==>f(X)), + f(_), + pfcWhy1(e(_)), + pfcWhy1(f(_)). + + +%:- forall(==>(X,Y),pfcFwd(==>(X,Y))). + +%:- break. + +%:- must_det_ll(property('length',list_operations)). + + + + +end_of_file. + + + +/* + really_compile(KB,F,Len)==> + ((metta_defn(KB,[F|Args],BodyFn)/compile_metta_defn(KB,F,Len,Args,BodyFn,Clause)) + ==> (compiled_clauses(KB,F,Clause))). +*/ + + + + +% Predicate and Function Arity Definitions: +% Specifies the number of arguments (arity) for predicates and functions, which is fundamental +% for understanding the complexity and capabilities of various logical constructs. Predicates are defined +% from Nullary (no arguments) up to Denary (ten arguments), reflecting a range of logical conditions or assertions. +% Functions are similarly defined but focus on operations that return a value, extending up to Nonary (nine arguments). +% Enforcing Equivalency Between Predicates and Functions: +% Establishes a logical framework to equate the conceptual roles of predicates and functions based on arity. +% This equivalence bridges the functional programming and logical (declarative) paradigms within Prolog, +% allowing a unified approach to defining operations and assertions. + +(equivalentTypes(PredType,FunctType) ==> + ( property(KB,FunctorObject,PredType) + <==> + property(KB,FunctorObject,FunctType))). +% Automatically generating equivalency rules based on the arity of predicates and functions. +% This facilitates a dynamic and flexible understanding of function and predicate equivalences, +% enhancing Prolog's expressive power and semantic richness. +(((p_arity(PredType,PA), {plus(KB,FA,1,PA), FA>=0}, f_arity(KB,FunctType,FA))) + ==> equivalentTypes(PredType,FunctType)). + +p_arity('NullaryPredicate', 0). % No arguments. +p_arity('UnaryPredicate', 1). % One argument. +p_arity('BinaryPredicate', 2). % Two arguments. +p_arity('TernaryPredicate', 3). % Three arguments, and so on. +p_arity('QuaternaryPredicate', 4). +p_arity('QuinaryPredicate', 5). +p_arity('SenaryPredicate', 6). +p_arity('SeptenaryPredicate', 7). +p_arity('OctaryPredicate', 8). +p_arity('NonaryPredicate', 9). +p_arity('DenaryPredicate', 10). + +f_arity('NullaryFunction', 0). % No return value, essentially a procedure. +f_arity('UnaryFunction', 1). % Returns a single value, and so on. +f_arity('BinaryFunction', 2). +f_arity('TernaryFunction', 3). +f_arity('QuaternaryFunction', 4). +f_arity('QuinaryFunction', 5). +f_arity('SenaryFunction', 6). +f_arity('SeptenaryFunction', 7). +f_arity('OctaryFunction', 8). +f_arity('NonaryFunction', 9). + + +% "Nondeterministic" - Can produce more than one result for the same inputs. +form_prop('Nondeterministic'). +% "Deterministic" - Always produces the same output for the same input. +form_prop('Deterministic'). +% "IdiomaticTranspilation" - Converts code to a more idiomatic form in another language. +form_prop('DirectTranspilation'). +% "FunCompiled" - Functions are compiled to machine code for performance. +form_prop('Compiled'). +% "FunInterpreted" - Functions are executed by an interpreter, without compilation. +form_prop('Interpreted'). + +% "Boolean" - Maps success/failure in Prolog to True/False. +form_prop('BooleanFunction'). + +% "EvalNoArgs" - dont evaluate or type check args +form_prop('EvalNoArgs'). +% "CoerceArgsToTypes" - Arguments are automatically coerced to specified types. +form_prop('CoerceArgsToTypes', 'List'). + % check EvalNoArgs/CoerceArgsToTypes then return the whole value unevaluated +form_prop('TypeConstructor'). +% this is the default for MeTTa in rust +form_prop('OnFailReturnSelf'). +% except for flow control instuctructions functions +form_prop('OnFailBacktrack'). + + +% "FixedArityFunction" - Functions or predicates with a fixed number of arguments. +form_prop('FixedArityFunction'). +% "ReturnNthArg" - Functions return the Nth argument passed to them. +form_prop('ReturnNthArg', 'Integer'). +% "FunctionArity" - The number of arguments a function takes (2 here). +form_prop('FunctionArity', 'Integer'). +% "PredicateArity" - The number of arguments a predicate has after being converted to a function +form_prop('PredicateArity', 'Integer'). +% "VariableArity" - Functions or predicates with a variable number of arguments. +form_prop('ArityMinMax', 'Integer', 'Integer'). % Min Max + + +%(: Z Nat) +%(: S (-> Nat Nat)) +%(: S TypeConstructor) + +% --- Control Flow and Conditional Execution --- +properties('&corelib','if', [flow_control, qhelp("Conditional execution."), conditional_execution]). +properties('&corelib','case', [flow_control, qhelp("Case selection."), conditional_execution]). +properties('&corelib','let', [variable_assignment, qhelp("Variable assignment.")]). +properties('&corelib','let*', [variable_assignment, qhelp("Sequential variable assignment."), sequential]). +properties('&corelib','function', [function_definition, qhelp("Function block.")]). +properties('&corelib','return', [function_definition, qhelp("Return value of a function block."), return_value]). +properties('&corelib','Error', [error_handling, qhelp("Defines or triggers an error.")]). + +% --- Error Handling and Advanced Control Flow --- +properties('&corelib','catch', [error_handling, qhelp("Catches exceptions."), exception_handling]). +properties('&corelib','throw', [error_handling, qhelp("Throws exceptions."), exception_handling]). + +% --- Data Structures and Manipulation --- +properties('&corelib','collapse', [data_structures, qhelp("Collapses a structure."), manipulation]). +properties('&corelib','sequential', [data_structures, qhelp("Sequentially applies operations."), sequential_operations]). +properties('&corelib','superpose', [data_structures, qhelp("Superposes data structures."), manipulation]). + +% --- Iteration and Loop Control --- +properties('&corelib','dedup!', [iteration_control, qhelp("Removes duplicate elements from iteration."), manipulation]). +properties('&corelib','nth!', [iteration_control, qhelp("Allows only the Nth iteration."), manipulation]). +properties('&corelib','limit!', [iteration_control, qhelp("Limits the number of iterations.")]). +properties('&corelib','time-limit!', [iteration_control, qhelp("Sets a time limit for operations."), time_management]). +properties('&corelib','offset!', [iteration_control, qhelp("Adjusts the starting point of iteration.")]). +properties('&corelib','number-of', [iteration_control, qhelp("Returns iteration count.")]). +properties('&corelib','nop', [iteration_control, qhelp("Suppresses iteration result."), suppression]). +properties('&corelib','do', [iteration_control, qhelp("Suppresses iteration result."), suppression]). + +% --- Compiler Directives and Optimization --- +properties('&corelib','pragma!', [compiler_directive, qhelp("Compiler directive for optimizations/settings."), optimization]). +properties('&corelib','include!', [code_inclusion, qhelp("Includes code from another file or context.")]). +properties('&corelib','load-ascii', [file_handling, qhelp("Loads ASCII file content.")]). +properties('&corelib','extend-py!', [integration, qhelp("Extends integration with Python."), python]). +properties('&corelib','registered-python-function', [integration, qhelp("Interacts with Python functions."), python]). +properties('&corelib','import!', [module_import, qhelp("Imports an external module or file.")]). + +% --- Evaluation and Dynamic Calls --- +properties('&corelib','eval', [evaluation, qhelp("Evaluates an expression.")]). +properties('&corelib','eval-for', [evaluation, qhelp("Evaluates assuming a return type."), type_assumption]). +properties('&corelib','call!', [dynamic_call, qhelp("Tries to dynamically guess if predicate or function.")]). +properties('&corelib','call-p!', [dynamic_call, qhelp("Dynamically calls a predicate."), predicate]). +properties('&corelib','predicate-arity', [function_definition, qhelp("Defines the arity of predicates/functions."), arity]). +properties('&corelib','call-fn!', [dynamic_call, qhelp("Calls a function dynamically."), function]). +properties('&corelib','pyr!', [integration, qhelp("Call python."), python]). +properties('&corelib','call-string!', [evaluation, qhelp("Evaluates a string of Prolog code."), prolog_code]). + +% --- Miscellaneous and Newly Included Properties --- +properties('&corelib','match', [pattern_matching, qhelp("Matches patterns within structures or data.")]). +properties('&corelib','get-atoms', [data_retrieval, qhelp("Retrieves atoms from a structure.")]). +properties('&corelib','new-space', [memory_allocation, qhelp("Allocates new space or memory region.")]). +properties('&corelib','remove-atom', [manipulation, qhelp("Removes an atom from a structure.")]). +properties('&corelib','add-atom', [manipulation, qhelp("Replaces an atom within a structure.")]). +properties('&corelib',',', [logical_operation, qhelp("Conjunction; and."), conjunction]). +properties('&corelib',';', [logical_operation, qhelp("Disjunction; or."), disjunction]). +properties('&corelib','replace-atom', [manipulation, qhelp("Replaces an atom within a structure.")]). +properties('&corelib','transfer!', [memory_management, qhelp("Transfers space content to another space.")]). + +% --- Symbolic Arithmetic and Type Conversion --- +properties('&corelib','S', [arithmetic, qhelp("Successor in Peano arithmetic."), peano_arithmetic]). +properties('&corelib','Z', [arithmetic, qhelp("Zero in Peano arithmetic."), peano_arithmetic]). +properties('&corelib','fromNumber', [type_conversion, qhelp("Converts from a numeric type to another type.")]). +properties('&corelib','coerce', [type_conversion, qhelp("Forces argument types for compatibility."), compatibility]). + +% --- Arithmetic Operations --- +properties('&corelib','+', [arithmetic, qhelp("Addition."), addition]). +properties('&corelib','-', [arithmetic, qhelp("Subtraction."), subtraction]). +properties('&corelib','*', [arithmetic, qhelp("Multiplication."), multiplication]). +properties('&corelib','mod', [arithmetic, qhelp("Modulus operation."), modulus]). +properties('&corelib','<', [comparison, qhelp("Less than."), less_than]). +properties('&corelib','>=', [comparison, qhelp("Greater than or equal to."), greater_than_or_equal]). +properties('&corelib','=>', [comparison, qhelp("Greater than or equal to."), greater_than_or_equal]). +properties('&corelib','<=', [comparison, qhelp("Less than or equal to."), less_than_or_equal]). +properties('&corelib','=<', [comparison, qhelp("Less than or equal to."), less_than_or_equal]). +properties('&corelib','>', [comparison, qhelp("Greater than."), greater_than]). + +% --- Logic Comparison and Evaluation Control --- +properties('&corelib','=', [logic, qhelp("Equality/unification operator."), equality]). +properties('&corelib','\\=', [logic, qhelp("Inequality test."), inequality]). +properties('&corelib','==', [logic, qhelp("Equality test."), equality_test]). +properties('&corelib','or', [logic, qhelp("Logical OR."), logical_or]). +properties('&corelib','xor', [logic, qhelp("Logical XOR."), logical_xor]) +properties('&corelib','and', [logic, qhelp("Logical AND."), logical_and]). +properties('&corelib','not', [logic, qhelp("Logical NOT."), logical_not]). +properties('&corelib','quote', [evaluation_control, qhelp("Prevents evaluation, treating input as literal.")]). +properties('&corelib','unquote', [evaluation_control, qhelp("Retrieves value of a quote."), retrieval]). + +% --- Debugging, Output, and Assertions --- +properties('&corelib','repl!', [debugging, qhelp("Interactive read-eval-print loop."), interactive]). +properties('&corelib','time!', [execution_timing, qhelp("Execution timing.")]). +properties('&corelib','trace!', [debugging, qhelp("Prints some debug information."), information_printing]). +properties('&corelib','no-rtrace!', [debugging, qhelp("Disables tracing for debugging."), trace_control]). +properties('&corelib','rtrace!', [debugging, qhelp("Enables tracing for debugging."), trace_control]). +properties('&corelib','println!', [output, qhelp("Prints text with newline to output."), text_printing]). +properties('&corelib','with-output-to!', [output, qhelp("Redirects output to a specified target."), redirection]). +properties('&corelib','print', [output, qhelp("Prints text to output."), text_printing]). +properties('&corelib','assertEqual', [testing, qhelp("Asserts a condition is true."), assertion]). +properties('&corelib','assertFalse', [testing, qhelp("Asserts a condition is false."), assertion]). +properties('&corelib','assertEqual', [testing, qhelp("Asserts two values are equal."), assertion]). +properties('&corelib','assertNotEqual', [testing, qhelp("Asserts two values are not equal."), assertion]). +properties('&corelib','assertEqualToResult', [testing, qhelp("Asserts equality to a result."), assertion]). + +% --- System Integration and State Management --- +properties('&corelib','change-state!', [state_management, qhelp("Changes the state of a system component."), system_integration]). +properties('&corelib','set-state', [state_management, qhelp("Sets the state of a component or system.")]). +properties('&corelib','get-state', [state_management, qhelp("Gets the state of a component or system."), data_retrieval]). + +% --- List Operations --- +properties('&corelib','car-atom', [list_operations, qhelp("Retrieves the head of a list."), head_retrieval]). +properties('&corelib','cdr-atom', [list_operations, qhelp("Retrieves the tail of a list."), tail_retrieval]). +properties('&corelib','range', [list_operations, qhelp("Generates a range of numbers."), range_generation]). +properties('&corelib','make_list', [list_operations, qhelp("Creates a list with specified elements."), creation]). +properties('&corelib','Cons', [list_operations, qhelp("Constructs a list."), construction]). +properties('&corelib','length', [list_operations, qhelp("Determines the length of a list."), length_determination]). +properties('&corelib','countElement', [list_operations, qhelp("Counts occurrences of an element."), element_counting]). +properties('&corelib','tuple-count', [data_structures, qhelp("Counts tuples within a structure."), counting]). +%properties('&corelib','TupleConcat', [data_structures, qhelp("Concatenates tuples."), concatenation]). +%properties('&corelib','collapseCardinality', [data_structures, qhelp("Collapses structures with cardinality consideration."), manipulation, cardinality]). + +% --- Nondet unique,union,intersection,subtraction Operations --- +properties('&corelib','unique', [nondet_sets, qhelp("Makes nondet results unique."), no_repeats_var]). +properties('&corelib','subtraction', [nondet_sets, qhelp("It subtracts elements generated by Call2 from those generated by Call1."), lazy_subtraction]). +properties('&corelib','intersection', [nondet_sets, qhelp("It gives the intersection duplicates are not removed ."), lazy_intersection]). + + +% --- String and Character manipulation --- +properties('&corelib','stringToChars', [string_operations, qhelp("Convert a string to a list of chars."), string_to_chars]). +properties('&corelib','charsToString', [string_operations, qhelp("Convert a list of chars to a string."), chars_to_string]). +properties('&corelib','format-args', [string_operations, qhelp("Generate a formatted string using a format specifier."), format_args]). +properties('&corelib','flip', [random, qhelp("Return a random boolean."), random_boolean]). + +properties('&corelib','repr', [string_operations, qhelp("Convert an atom to a string."), repr ]). +properties('&corelib','parse', [string_operations, qhelp("Convert a string to an atom."), parse ]). diff --git a/.Attic/canary_docme/metta_pfc_base.pl b/.Attic/canary_docme/metta_pfc_base.pl new file mode 100644 index 00000000000..aad619a51fe --- /dev/null +++ b/.Attic/canary_docme/metta_pfc_base.pl @@ -0,0 +1,1811 @@ +/* + * Project: MeTTaLog - A MeTTa to Prolog Transpiler/Interpreter + * Description: This file is part of the source code for a transpiler designed to convert + * MeTTa language programs into Prolog, utilizing the SWI-Prolog compiler for + * optimizing and transforming function/logic programs. It handles different + * logical constructs and performs conversions between functions and predicates. + * + * Author: Douglas R. Miles + * Contact: logicmoo@gmail.com / dmiles@logicmoo.org + * License: LGPL + * Repository: https://github.com/trueagi-io/metta-wam + * https://github.com/logicmoo/hyperon-wam + * Created Date: 8/23/2023 + * Last Modified: $LastChangedDate$ # You will replace this with Git automation + * + * Usage: This file is a part of the transpiler that transforms MeTTa programs into Prolog. For details + * on how to contribute or use this project, please refer to the repository README or the project documentation. + * + * Contribution: Contributions are welcome! For contributing guidelines, please check the CONTRIBUTING.md + * file in the repository. + * + * Notes: + * - Ensure you have SWI-Prolog installed and properly configured to use this transpiler. + * - This project is under active development, and we welcome feedback and contributions. + * + * Acknowledgments: Special thanks to all contributors and the open source community for their support and contributions. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the + * distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS + * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT + * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS + * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE + * COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, + * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; + * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER + * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN + * ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + * POSSIBILITY OF SUCH DAMAGE. + */ + +/* + LogicMOO Base FOL/PFC Setup +% Dec 13, 2035 +% Douglas Miles + +*/ +% :- if( \+ current_predicate(set_fileAssertMt/1)). + +:- set_prolog_flag(pfc_shared_module,user). +%:- set_prolog_flag(pfc_shared_module,baseKB). + +must_ex(X):- catch(X,E,rtrace(E))*->true;(dmsg(failed(must_ex(X))),rtrace(X)). +quietly_ex(X):-call(X). + +% @TODO undisable when we have defined into_type/3 to not fail +control_arg_types(A,B):- fail, once(control_arg_types1(20,[],A,B)),A\==B,!. + +%:- listing(control_arg_types/3). + +control_arg_types1( Max,_,A,B):- Max<1,!,A=B. +control_arg_types1(_Max,_,A,B):- \+ compound(A),!,A=B. +control_arg_types1(_Max,_,A,B):- iz_conz(A), \+ is_list(A),!, A = B. +control_arg_types1(_Max,_,A,B):- (current_predicate(check_args/2)->check_args(A,B)->A\=@=B),!. +%control_arg_types1(Max,Pre,A,B):- is_list(A), !, maplist(control_arg_types1(Max,Pre),A,B). +control_arg_types1( Max,Pre,A,B):- Max0 is Max-1, + compound_name_arguments(A,F,AA), + length(AA,N), + do_control_arg_types1(Max0,F/N,1,Pre,AA,BB), + compound_name_arguments(B,F,BB). + +do_control_arg_types1(_Max,_FofN,_ArgNp1,_Pre,[],[]):-!. +do_control_arg_types1( Max,FofN,ArgN,Pre,[A|AA],[B|BB]):- + do_control_1arg_type(Max,FofN,ArgN,Pre,A,B), + ArgNp1 is ArgN+1, + do_control_arg_types1(Max,FofN,ArgNp1,Pre,AA,BB). + +do_control_1arg_type(_Max,_FN,_N,_Pre,A,B):- var(A),!,B=A. +do_control_1arg_type(_Max,F/_, N,_Pre,A,B):- arg_n_isa(F,N,ISA),into_type(ISA,A,B),!. +do_control_1arg_type(Max,FofN,_,Pre,A,B):- + Max0 is Max-1, control_arg_types1(Max0,[FofN|Pre],A,B). + + +%arg_n_isa(_F,_N,_ISA):- fail. +arg_n_isa(F,N,ISA):- clause_b(argIsa(F,N,ISA)). + +save_pfc_state:- + %tell(pfcState), + forall((pfcStateTerm(F/A),current_predicate(F/A)),listing(F/A)), + %told. + !. + +pfcDoAll(Goal):- forall(call(Goal),true). + +pfcStateTerm(F/A):- pfcDatabaseTerm(F/A). +pfcStateTerm(F/A):- + member((F/A),[ + fcUndoMethod/2, + fcAction/2, + fcTmsMode/1, + pfcQueue/1, + pfcCurrentDb/1, + pfcHaltSignal/1, + pfcDebugging/0, + pfcSelect/1, + pfcSearch/1]). + + + +:- if(( current_prolog_flag(xref,true) ; + ('$current_source_module'(SM),'context_module'(M),'$current_typein_module'(CM), + current_prolog_flag(pfc_shared_module,BaseKB),asserta(BaseKB:'wusing_pfc'(M,CM,SM,pfc_rt))))). +:- endif. +:- if(current_prolog_flag(xref,true)). +%:- module(pfc_rt,[]). +:- endif. +:- if((prolog_load_context(source,File),prolog_load_context(file,File))). +%:- prolog_load_context(file,File),unload_file(File). +:- use_module(library(logicmoo_utils)). +:- endif. +%:- pfc_lib:use_module(pfc_lib). +:- if( \+ current_prolog_flag(xref,true)). +:- current_prolog_flag(pfc_shared_module,BaseKB), + must_ex(retract(BaseKB:'wusing_pfc'(M,CM,SM,pfc_rt))), + nop(fbugio(BaseKB:'chusing_pfc'(M,CM,SM,pfc_rt))), + (M==SM -> + (nop(maybe_ensure_abox(SM)),nop((M:ain(genlMt(SM,BaseKB))))); + nop(fbugio(BaseKB:'lusing_pfc'(M,CM,SM,pfc_rt)))), + assert(BaseKB:'$using_pfc'(M,CM,SM,pfc_rt)), + asserta(SM:'$does_use_pfc_mod'(M,CM,SM,pfc_rt)). + %backtrace(200). + +/* +:- multifile '$exported_op'/3. +:- dynamic '$exported_op'/3. +:- discontiguous '$exported_op'/3. +'$exported_op'(_,_,_):- fail. +*/ + +:- multifile '$pldoc'/4. +:- dynamic '$pldoc'/4. +:- discontiguous '$pldoc'/4. +'$pldoc'(_,_,_,_):- fail. + +:- multifile '$autoload'/3. +:- discontiguous '$autoload'/3. +:- dynamic '$autoload'/3. +'$autoload'(_,_,_):- fail. + +:- system:use_module(library(make)). +%:- set_prolog_flag(retry_undefined, kb_shared). +%:- set_prolog_flag(pfc_ready, true). +:- set_prolog_flag(expect_pfc_file,unknown). +:- endif. + +:- ifprolog:import(date:day_of_the_week/2). +:- ifprolog:import(date:day_of_the_year/2). + + +tilded_negation. + +bagof_or_nil(T,G,L):- bagof(T,G,L)*->true;L=[]. +setof_or_nil(T,G,L):- setof(T,G,L)*->true;L=[]. + +call_u(G):- pfcCallSystem(G). +clause_u(H,B):- clause(H,B). + +mpred_ain(P):- arc_assert(P). +arc_assert(P:-True):- True==true,!,arc_assert(P). +arc_assert(P):- % fbugio(arc_assert(P)), + must_ex(current_why_UU(UU)),nop(fbugio(pfcAdd(P, UU))),!, +(P, UU),asserta_if_new(P). + +pfc_retract(P):- fbugio(pfc_retract(P)),pfcRetract(P). +pfc_retractall(P):- fbugio(pfc_retractall(P)),pfcRetractAll(P). + +:- dynamic((~)/1). +~(_):- fail. + +add(X):- pfcAdd(X). + + +mpred_test(call_u(X)):- nonvar(X),!,pfcCallSystem(X),pfcWhy(X). +mpred_test(\+ call_u(X)):- nonvar(X),!, (call_u(X)-> (fbugio(warn(failed(mpred_test(\+ call_u(X))))),mpred_test_why(X)); mpred_test_why(~(X))). +mpred_test(X):- (mpred_test_why(X) *-> true ; mpred_test_why(~(X))). + +:- thread_local t_l:shown_child/1. +:- thread_local t_l:shown_dep/2. + +pfc_info(X):- mpred_info(X). +mpred_info(X):- + retractall(t_l:shown_child(_)), + retractall(t_l:shown_dep(_,_)), + ignore(( + forall(mpred_test_why(X),true), + forall(mpred_child_info(X),true))). + +mpred_child_info(P):- + retractall(t_l:shown_child(_)), + show_child_info(P),!, + printLine. + +show_child_info(P):- + pfcChildren(P,L), + show_child_info(P,L),!. + +show_child_info(P,_):- t_l:shown_child(Q),P=@=Q,!. +show_child_info(P,_):- asserta(t_l:shown_child(P)),fail. +show_child_info(_,[]):-!. +show_child_info(P,L):- list_to_set(L,S), + format("~N~nChildren for ",[]), + ansi_format([fg(green)],'~@',[pp(P)]), + format(" :~n",[]), + forall((member(D,S), \+ t_l:shown_dep(P,D)),(asserta(t_l:shown_dep(P,D)),ansi_format([fg(yellow)],'~N ~@. ~n',[pp(D)]))), + my_maplist(show_child_info,S). + +mpred_why(X):- mpred_test_why(X). + +mpred_test_why(X):- + pfcCallSystem(X)*->pfcTF1(X);(pfcTF1(X),!,fail). + +mpred_literal(X):- pfcLiteral(X). +mpred_positive_literal(X):- pfcPositiveLiteral(X). +pfcAtom(X):- pfcLiteral(X). +rem(X):- pfcWithdraw(X). +rem2(X):- pfcRemove(X). +remove(X):- pfcBlast(X). + +% :- mpred_ain_in_thread. +% :- current_thread_pool(ain_pool)->true;thread_pool_create(ain_pool,20,[]). +:- multifile thread_pool:create_pool/1. +:- dynamic thread_pool:create_pool/1. +thread_pool:create_pool(ain_pool) :- + thread_pool_create(ain_pool, 50, [detached(true)] ). + +:- use_module(library(http/thread_httpd)). +:- use_module(library(thread_pool)). + +is_ain_pool_empty:- thread_pool_property(ain_pool,running(N)),!,N==0. +is_ain_pool_empty. + +show_ain_pool:- forall(thread_pool_property(ain_pool,PP),fmt(show_ain_pool(PP))). + +await_ain_pool:- is_ain_pool_empty->true;(repeat, sleep(0.005), is_ain_pool_empty). + +ain_in_thread(MAIN):- strip_module(MAIN,M,AIN), call_in_thread(M:pfcAdd(AIN)). + +call_in_thread(MG):- strip_module(MG,M,G), notrace((copy_term(M:G,GG,_),numbervars(GG,0,_,[attvar(skip),singletons(true)]),term_to_atom(GG,TN))), + call_in_thread(TN,M,G), + dmsg_pretty(call_in_thread(TN,M,G)). + +call_in_thread(TN,M,G):- thread_property(_,alias(TN)),!,dmsg_pretty(already_queued(M,G)). +call_in_thread(TN,M,G):- must_ex(current_why(Why)), thread_create_in_pool(ain_pool,call_in_thread_code(M,G,Why,TN),_Id,[alias(TN)]). + +call_in_thread_code(M,G,Why,TN):- + with_only_current_why(Why, + catch(( M:G-> nop(dmsg_pretty(suceeded(exit,TN)));dmsg_pretty(failed(exit,TN))),E, dmsg_pretty(error(E-->TN)))). + +%:- call_in_thread(fbugio(call_in_thread)). +% why_dmsg(Why,Msg):- with_current_why(Why,dmsg_pretty(Msg)). + +% File : pfc +% Author : Tim Finin, finin@umbc.edu +% Updated: 10/11/87, ... +% Purpose: consult system file for ensure + +pfcVersion(3.0). + +/* +pfcFile('pfcsyntax'). % operator declarations. +pfcFile('pfccore'). % core of Pfc. +pfcFile('pfcsupport'). % support maintenance +pfcFile('pfcdb'). % predicates to manipulate database. +pfcFile('pfcdebug'). % debugging aids (e.g. tracing). +pfcFile('pfcjust'). % predicates to manipulate justifications. +pfcFile('pfcwhy'). % interactive exploration of justifications. + +pfcLoad :- pfcFile(F), ensure_loaded(F), fail. +pfcLoad. +*/ + +%pfcFcompile :- pfcFile(F), compile(F), fail. +%pfcFcompile. + +%:- pfcLoad. + +% File : pfccompile.pl +% Author : Tim Finin, finin@prc.unisys.com +% Updated: 10/11/87, ... +% Purpose: compile system file for Pfc +/* +:- compile(pfcsyntax). +:- compile(pfccore). +:- compile(pfcdb). +:- compile(pfcjust). +:- compile(pfcwhy). +:- compile(pfcdebug). +*/ + +% File : pfcsyntax.pl +% Author : Tim Finin, finin@prc.unisys.com +% Purpose: syntactic sugar for Pfc - operator definitions and term expansions. + +:- op(500,fx,'~'). +:- op(1050,xfx,('==>')). +:- op(1050,xfx,'<==>'). +:- op(1050,xfx,('<-')). +:- op(1100,fx,('==>')). +:- op(1150,xfx,('::::')). + + +:- dynamic(pfctmp:knows_will_table_as/2). + +will_table_as(Stuff,As):- pfctmp:knows_will_table_as(Stuff,As),!. +will_table_as(Stuff,As):- assert(pfctmp:knows_will_table_as(Stuff,As)), + must_ex(react_tabling(Stuff,As)),!,fail. + +react_tabling(Stuff,_):- dynamic(Stuff). + +:- dynamic(lmconf:is_treated_like_pfc_file/1). +:- dynamic(lmconf:is_pfc_module/1). +if_pfc_indicated :- source_location(F,_),(sub_string(F, _, _, _, '.pfc')->true;lmconf:is_treated_like_pfc_file(F)),!. +if_pfc_indicated :- prolog_load_context(module, M),lmconf:is_pfc_module(M),!. + +skip_pfc_term_expansion(Var):- var(Var),!. +skip_pfc_term_expansion(begin_of_file). +skip_pfc_term_expansion(end_of_file). + +:- export(pfc_term_expansion/2). +:- system:import(pfc_term_expansion/2). +pfc_term_expansion(I,O):- skip_pfc_term_expansion(I),!, I=O. +pfc_term_expansion((:- table Stuff as Type), [:- pfcAdd(tabled_as(Stuff,Type)),(:- table Stuff as Type)]):- nonvar(Stuff), !, if_pfc_indicated, \+ will_table_as(Stuff, Type). +pfc_term_expansion((:- table Stuff ), [:- pfcAdd(tabled_as(Stuff,incremental)),(:- table Stuff as incremental)]):- if_pfc_indicated, \+ will_table_as(Stuff,incremental). +pfc_term_expansion((:- _),_):- !, fail. +pfc_term_expansion((P==>Q),(:- pfcAdd((P==>Q)))). +%term_expansion((P==>Q),(:- pfcAdd(('<-'(Q,P))))). % speed-up attempt +pfc_term_expansion(('<-'(P,Q)),(:- pfcAdd(('<-'(P,Q))))). +pfc_term_expansion((P<==>Q),(:- pfcAdd((P<==>Q)))). +pfc_term_expansion((RuleName :::: Rule),(:- pfcAdd((RuleName :::: Rule)))). +pfc_term_expansion((==>P),(:- pfcAdd(P))). +pfc_term_expansion(I,I):- I == end_of_file,!. +pfc_term_expansion( P ,(:- pfcAdd(P))):- if_pfc_indicated. + +%use_pfc_term_expansion:- current_prolog_flag(pfc_term_expansion,false),!,fail. +% maybe switch to prolog_load_context(file,...)? +%use_pfc_term_expansion:- source_location(File,_), atom_concat(_,'.pfc.pl',File). + +term_subst(P,O):- term_subst(clause,P,O),!. + +term_subst(_, P,O):- \+ compound(P),!,O=P. + +term_subst(tilded_negation,P,O):- !, term_subst( + [(not)-(~), + (=>)-(==>), + (<=>)-(<==>), + (<=)-(<-)],P,O). + +term_subst(Subst,P,O):- + compound_name_arguments(P,F,Args), + my_maplist(term_subst(Subst),Args,ArgsL), + termf_subst(Subst,F,F2), + compound_name_arguments(O,F2,ArgsL). + +termf_subst(Subst,F,F2):-member(F-F2,Subst)->true;F=F2. + + +% File : pfccore.pl +% Author : Tim Finin, finin@prc.unisys.com +% Updated: 10/11/87, ... +% 4/2/91 by R. McEntire: added calls to valid_dbref as a +% workaround for the Quintus 3.1 +% bug in the recorded database. +% Purpose: core Pfc predicates. + +:- use_module(library(lists)). + + +%==>(_). + +% ==>(G):- arc_assert(G). + +%:- multifile ('<-')/2. +%:- dynamic ('<-')/2. +%:- discontiguous(('<-')/2). +%'<-'(_,_). + +%:- multifile ('==>')/2. +%:- dynamic ('==>')/2. +%:- discontiguous(('==>')/2). +%'==>'(_,_). + +%:- multifile ('==>')/2. +%:- dynamic ('::::')/2. +%:- dynamic '<==>'/2. +:- dynamic '$pt$'/2. +:- dynamic '$nt$'/3. +:- dynamic '$bt$'/2. +:- dynamic fcUndoMethod/2. +:- dynamic fcAction/2. +:- dynamic fcTmsMode/1. +:- dynamic pfcQueue/1. +:- dynamic pfcCurrentDb/1. +:- dynamic pfcHaltSignal/1. +:- dynamic pfcDebugging/0. +:- dynamic pfcSelect/1. +:- dynamic pfcSearch/1. + +:- thread_local(t_l:pfcSearchTL/1). + +:- dynamic '$spft$'/3. + +% % % initialization of global assertons + +pfcSetVal(Stuff):- + duplicate_term(Stuff,DStuff), + functor(DStuff,_,N), + setarg(N,DStuff,_), + retractall(DStuff), + assert(Stuff). + +% % pfcDefault/1 initialized a global assertion. +% % pfcDefault(P,Q) - if there is any fact unifying with P, then do +% % nothing, else assert Q. + +pfcDefault(GeneralTerm,Default) :- + clause(GeneralTerm,true) -> true ; assert(Default). + +% % fcTmsMode is one of {none,local,cycles} and controles the tms alg. +:- pfcDefault(fcTmsMode(_), fcTmsMode(cycles)). + +% Pfc Search strategy. pfcSearch(X) where X is one of {direct,depth,breadth} +:- pfcDefault(pfcSearch(_), pfcSearch(direct)). + + +% + +% % pfcAdd/2 and pfcPost/2 are the main ways to assert new clauses into the +% % database and have forward reasoning done. + +% % pfcAdd(P,S) asserts P into the dataBase with support from S. + +pfcAdd(P) :- must_ex(current_why_UU(UU)), + pfcAdd(P, UU). + +%pfcAdd(P) :- must_ex(current_why_UU(UU)),%with_current_why(pfcAdd(P), pfcAdd(P, UU)). + +pfcAdd((==>P),S) :- !, pfcAdd(P,S). + +pfcAdd(P,S) :- + pfcPost(P,S), + pfcRun,!. + +%pfcAdd(_,_). +pfcAdd(P,S) :- pfcWarn("pfcAdd(~p,~p) failed",[P,S]). + + +% pfcPost(+Ps,+S) tries to add a fact or set of fact to the database. For +% each fact (or the singelton) pfcPost1 is called. It always succeeds. + +pfcPost(List,S):- pfcPost_rev(S,List). + +pfcPost_rev(S,Term) :- + is_list(Term) + -> my_maplist(pfcPost_rev(S),Term) + ; pfcPost1(Term,S). + + +% pfcPost1(+P,+S) tries to add a fact to the database, and, if it succeeded, +% adds an entry to the pfc queue for subsequent forward chaining. +% It always succeeds. + +pfcPost1(Fact,S) :- control_arg_types(Fact,Fixed),!,pfcPost1(Fixed,S). + + +pfcPost1(P,S):- + locally(set_prolog_flag(occurs_check, true), + catch(pfcPost11(P,S),E,(notrace,wdmsg(P => E),trace))). + +pfcPost11(P,S) :- + % % db pfcAddDbToHead(P,P2), + % pfcRemoveOldVersion(P), + must_ex(pfcAddSupport(P,S)), + (pfcUnique(post, P)-> pfcPost2(P,S) ; nop(pfcWarn(not_pfcUnique(post, P)))). + +pfcPost2(P,S):- + must_ex(once(\+ \+ is_asserted_exact(P);assert(P))), + must_ex(pfcTraceAdd(P,S)), + !, + must_ex(pfcEnqueue(P,S)), + !. + +is_asserted_exact(MH,B):- + strip_module(MH,M,H), + is_asserted_exact(M,H,B). +is_asserted_exact(MHB):- + strip_module(MHB,M,HB), + expand_to_hb(HB,H,B), + is_asserted_exact(M,H,B). +is_asserted_exact(M,H,B):- + M=MM, + (MM:clause(M:H,B,Ref)*->true; M:clause(MM:H,B,Ref)), + %clause_ref_module(Ref), + clause_property(Ref,module(MM)), + %module_checks_out + is_asserted_exact(MM,H,B,Ref). +is_asserted_exact(_,H,B,Ref):- + clause(CH,CB,Ref),strip_m(CH,HH),HH=@=H,strip_m(CB,BB),cl(HH,BB)=@=cl(H,B). + + + +%pfcPost1(_,_). +%pfcPost1(P,S) :- + %pfcWarn("pfcPost1: ~p\n (support: ~p) failed",[P,S]). + +% % pfcAddDbToHead(+P,-NewP) is semidet. +% talkes a fact P or a conditioned fact +% (P:-C) and adds the Db context. +% + +pfcAddDbToHead(P,NewP) :- + pfcCallSystem(pfcCurrentDb(Db)), + (Db=true -> NewP = P; + P=(Head:-Body) -> NewP = (Head :- (Db,Body)); + true -> NewP = (P :- Db)). + +:- dynamic(pfcCurrentDb/1). +pfcCurrentDb(true). + +% % pfcUnique(X) is det. +% +% is true if there is no assertion X in the prolog db. +% + +pfcUnique(Type,(Head:-Tail)) :- !,pfcUnique(Type,Head,Tail). +pfcUnique(Type, P) :- pfcUnique(Type,P,true). + +%pfcUnique(post,Head,Tail):- !, \+ is_clause_asserted(Head,Tail). +pfcUnique(_,Head,Tail):- \+ is_asserted_exact(Head,Tail),!. +/* +pfcUnique(_,H,B):- \+ is_asserted(H,B),!. +pfcUnique(_,H,B):- \+ ( + clause(H, B, Ref), + clause(HH, BB, Ref), + strip_m(HH, HHH), + HHH=@=H, + strip_m(BB, BBB), + BBB=@=B). +*/ + + +% % pfcEnqueue(P,Q) is det. +% +% Enqueu according to settings +% +pfcSetSearch(Mode):- pfcSetVal(pfcSearch(Mode)). + +pfcGetSearch(Mode):- (t_l:pfcSearchTL(ModeT)->true;pfcSearch(ModeT))->Mode=ModeT. + +pfcEnqueue(P,S) :- pfcGetSearch(Mode),!, + pfcEnqueue(Mode,P,S). +pfcEnqueue(P,S) :- pfcWarn("No pfcSearch mode"), + pfcEnqueue(direct,P,S). + +pfcEnqueue(Mode,P,S):- + Mode=direct -> pfcFwd(P) ; + Mode=thread -> pfcThreadFwd(P,S) ; + Mode=depth -> pfcAsserta(pfcQueue(P),S) ; + Mode=breadth -> pfcAssert(pfcQueue(P),S) ; + true -> pfcWarn("Unrecognized pfcSearch mode: ~p", Mode),pfcEnqueue(direct,P,S). + + + +% % pfcRemoveOldVersion(+Rule) is det. +% +% if there is a rule of the form Identifier ::: Rule then delete it. + +pfcRemoveOldVersion((Identifier::::Body)) :- + % this should never happen. + (var(Identifier) + -> + pfcWarn("variable used as an rule name in ~p :::: ~p", + [Identifier,Body]); + pfcRemoveOldVersion0(Identifier::::Body)). + + +pfcRemoveOldVersion0((Identifier::::Body)) :- + nonvar(Identifier), + clause((Identifier::::OldBody),_), + \+(Body=OldBody), + pfcWithdraw((Identifier::::OldBody)), + !. +pfcRemoveOldVersion0(_). + + +% % with_fc_mode(+Mode,:Goal) is semidet. +% +% Temporariliy changes to forward chaining propagation mode while running the Goal +% +with_fc_mode(Mode,Goal):- locally(t_l:pfcSearchTL(Mode),Goal). + + +pfcThreadFwd(S,P):- + with_only_current_why(S, + % maybe keep `thread` mode? + call_in_thread(with_fc_mode(thread, (pfcFwd(P))))). + +% in_fc_call(Goal):- with_fc_mode( thread, Goal). +%in_fc_call(Goal):- with_fc_mode( direct, Goal). +% in_fc_call(Goal):- !, pfcCallSystem(Goal). + + + + +% + +% pfcRun compute the deductive closure of the current database. +% How this is done depends on the searching mode: +% direct - fc has already done the job. +% depth or breadth - use the pfcQueue mechanism. + +pfcRun :- + (\+ pfcGetSearch(direct)), + pfcStep, + pfcRun. +pfcRun. + + +% pfcStep removes one entry from the pfcQueue and reasons from it. + + +pfcStep :- + % if pfcHaltSignal(Msg) is true, reset it and fail, thereby stopping inferencing. + pfcRetract(pfcHaltSignal(Msg)), + pfcTraceMsg(removing(pfcHaltSignal(Msg))), + !, + fail. + +pfcStep :- + % draw immediate conclusions from the next fact to be considered. + % fails iff the queue is empty. + get_next_fact(P), + pfcdo(pfcFwd(P)), + !. + +get_next_fact(P) :- + %identifies the nect fact to fc from and removes it from the queue. + select_next_fact(P), + remove_selection(P). + +remove_selection(P) :- + pfcRetract(pfcQueue(P)), + pfcRemoveSupportsQuietly(pfcQueue(P)), + !. +remove_selection(P) :- + brake(pfcPrintf("pfc:get_next_fact - selected fact not on Queue: ~p", + [P])). + + +% select_next_fact(P) identifies the next fact to reason from. +% It tries the user defined predicate first and, failing that, +% the default mechanism. + +select_next_fact(P) :- + pfcSelect(P), + !. +select_next_fact(P) :- + defaultpfcSelect(P), + !. + +% the default selection predicate takes the item at the froint of the queue. +defaultpfcSelect(P) :- pfcCallSystem(pfcQueue(P)),!. + +% pfcHalt stops the forward chaining. +pfcHalt :- pfcHalt("unknown_reason",[]). + +pfcHalt(Format) :- pfcHalt(Format,[]). + +pfcHalt(Format,Args) :- + format(string(Msg),Format,Args), + (pfcHaltSignal(Msg) -> + pfcWarn("pfcHalt finds pfcHaltSignal(~w) already set",[Msg]) + ; assert(pfcHaltSignal(Msg))). + + +% % +% % +% % predicates for manipulating triggers +% % + +pfcAddTrigger('$pt$'(Trigger,Body),Support) :- + !, + pfcTraceMsg(' Adding positive trigger(+) ~p~n', + ['$pt$'(Trigger,Body)]), + pfcAssert('$pt$'(Trigger,Body),Support), + copy_term('$pt$'(Trigger,Body),Tcopy), + pfc_call(Trigger), + with_current_why(Trigger,fcEvalLHS(Body,(Trigger,Tcopy))), + fail. + + +pfcAddTrigger('$nt$'(Trigger,Test,Body),Support) :- + !, + pfcTraceMsg(' Adding negative trigger(-): ~p~n test: ~p~n body: ~p~n', + [Trigger,Test,Body]), + copy_term(Trigger,TriggerCopy), + pfcAssert('$nt$'(TriggerCopy,Test,Body),Support), + \+ pfc_call(Test), + with_current_why(\+ pfc_call(Test), fcEvalLHS(Body,((\+Trigger),'$nt$'(TriggerCopy,Test,Body)))). + +pfcAddTrigger('$bt$'(Trigger,Body),Support) :- + !, + pfcAssert('$bt$'(Trigger,Body),Support), + pfcBtPtCombine(Trigger,Body,Support). + +pfcAddTrigger(X,_Support) :- + pfcWarn("Unrecognized trigger(?) to pfcAddtrigger: ~p",[X]). + + +pfcBtPtCombine(Head,Body,Support) :- + % % a backward trigger(?) ('$bt$') was just added with head and Body and support Support + % % find any '$pt$'(s) with unifying heads and add the instantied '$bt$' body. + pfcGetTriggerQuick('$pt$'(Head,_PtBody)), + fcEvalLHS(Body,Support), + fail. +pfcBtPtCombine(_,_,_) :- !. + +pfcGetTriggerQuick(Trigger) :- clause(Trigger,true)*->true;pfc_call(Trigger). +pfcCallSystem(Trigger) :- pfc_call(Trigger). + +% % +% % +% % predicates for manipulating action traces. +% % + +pfcAddActionTrace(Action,Support) :- + % adds an action trace and it''s support. + pfcAddSupport(pfcAction(Action),Support). + +pfcRemActionTrace(pfcAction(A)) :- + fcUndoMethod(A,UndoMethod), + pfcCallSystem(UndoMethod), + !. + + +% % +% % predicates to remove pfc facts, triggers, action traces, and queue items +% % from the database. +% % + +pfcRetract(X) :- + % % retract an arbitrary thing. + pfcType(X,Type), + pfcRetractType(Type,X), + !. + +pfcRetractType(fact(_),X) :- + % % db + pfcAddDbToHead(X,X2)-> retract(X2) ; retract(X). + +pfcRetractType(rule(_),X) :- + % % db + pfcAddDbToHead(X,X2) -> retract(X2) ; retract(X). + +pfcRetractType(trigger(Pos),X) :- + retract(X) + -> unFc(X) + ; pfcWarn("Trigger(~p) not found to retract: ~p",[Pos,X]). + +pfcRetractType(action,X) :- pfcRemActionTrace(X). + + +% % pfcAddType1(X) adds item X to some database + +pfcAddType1(X) :- + % what type of X do we have? + pfcType(X,Type), + pfcAddDbToHead(X,X2), + % call the appropriate predicate. + pfcAddType(Type,X2). + +pfcAddType(fact(Type),X) :- + pfcUnique(fact(Type),X), + assert(X),!. +pfcAddType(rule(Type),X) :- + pfcUnique(rule(Type),X), + assert(X),!. +pfcAddType(trigger(Pos),X) :- + pfcUnique(trigger(Pos),X) -> assert(X) ; + (pfcWarn(not_pfcUnique(X)),assert(X)). + +pfcAddType(action,_Action) :- !. + + + + +% pfcWithdraw/1 withdraws any "direct" support for P. +% If a list, iterates down the list +pfcWithdraw(P) :- is_list(P),!,my_maplist(pfcWithdraw,P). +pfcWithdraw(P) :- matches_why_UU(UU), pfcWithdraw(P,UU). +% % pfcWithdraw(P,S) removes support S from P and checks to see if P is still supported. +% % If it is not, then the fact is retractred from the database and any support +% % relationships it participated in removed. +pfcWithdraw(P,S) :- + % pfcDebug(pfcPrintf("removing support ~p from ~p",[S,P])), + pfcGetSupport(P,S), + matterialize_support_term(S,Sup), + pfcTraceMsg(' Withdrawing direct support: ~p \n From: ~p~n',[Sup,P]), + (pfcRemOneSupportOrQuietlyFail(P,S) + -> pfcTraceMsg(' Success removing support: ~p \n From: ~p~n',[Sup,P]) + ; pfcWarn("pfcRemOneSupport/2 Could not find support ~p thus\n Did not pfcRemOneSupport: ~p", + [Sup,P])), + removeIfUnsupported(P). + +pfcWithdraw(P,S) :- + matterialize_support_term(S,Sup), + pfcTraceMsg(' No support matching: ~p \n For: ~p~n',[Sup,P]),!, + removeIfUnsupported(P). + +% pfcRetractAll/1 withdraws any "direct" and "indirect" support for P. +% If a list, iterates down the list +pfcRetractAll(P) :- is_list(P),!,my_maplist(pfcRetractAll,P). +pfcRetractAll(P) :- matches_why_UU(UU), pfcRetractAll(P,UU). + +% % pfcRetractAll(P,S) removes support S from P and checks to see if P is still supported. +% % If it is not, then the fact is retreactred from the database and any support +% % relationships it participated in removed. + +pfcRetractAll(Fact,S) :- control_arg_types(Fact,Fixed),!,pfcRetractAll(Fixed,S). +pfcRetractAll(P,S) :- + \+ \+ pfcWithdraw(P,S), + fail. +pfcRetractAll(P,S) :- + pfcGetSupport(P,(P2,_)), + pfcType(P2,fact(_)), + pfcSupportedBy(P2,S,_How), + pfcRetractAll(P2), + \+ fcSupported(P),!, + fcUndo(P). +pfcRetractAll(P,S) :- + pfcGetSupport( P,(_,T)), + pfcGetSupport(T,(P2,_)), + pfcSupportedBy(P2,S,_How), + pfcType(P2,fact(_)), + pfcRetractAll(P2), + \+ fcSupported(P),!, + fcUndo(P). +pfcRetractAll(P,S) :- + fcSupported(P), + pfcGetSupport(P,(P2,_)), + pfcSupportedBy(P2,S,_How), + pfcType(P2,rule(_)), + pfcRetractAll(P2), + \+ fcSupported(P), + fcUndo(P),!. +pfcRetractAll(P,_S0) :- + removeIfUnsupported(P), + fail. +pfcRetractAll(_,_). + + +pfcSupportedBy(P,S,How):- + pfcGetSupport(P,(F,T)), + (pfcSupportedBy(F,S,_)->How=F; + pfcSupportedBy(T,S,How)). + +pfcSupportedBy(P,S,How):-P=S,How=S. + +pfcRetractAll_v2(P,S0) :- + \+ \+ pfcWithdraw(P,S0), + pfcGetSupport(P,(S,RemoveIfTrigger)), + % pfcDebug(pfcPrintf("removing support ~p from ~p",[S,P])), + matterialize_support_term((S,RemoveIfTrigger),Sup), + pfcTraceMsg(' Removing support: ~p \n From: ~p~n',[Sup,P]), + (pfcRemOneSupportOrQuietlyFail(P,(S,RemoveIfTrigger)) + -> pfcTraceMsg(' Success removing support: ~p \n From: ~p~n',[Sup,P]) + ; (pfcWarn("pfcRemOneSupport/2 Could not find support ~p thus\n Did not yet pfcRetractAll_v2: ~p", + [Sup,P]))), + pfcRetractAll_v2(S, S0), + fail. + +pfcRetractAll_v2(P,_):- removeIfUnsupported(P). + +% pfcRemove/1 is the user''s interface - it withdraws user support for P. +% +% pfcRemove is like pfcRetractAll, but if P is still in the DB after removing the +% user's support, it is retracted by more forceful means (e.g. pfcBlast). +% +pfcRemove(Fact) :- control_arg_types(Fact,Fixed),!,pfcRemove(Fixed). +pfcRemove(P) :- + pfcRetractAll(P), + pfc_call(P) + -> pfcBlast(P) + ; true. + + +% % pfcBlast(+F) is det +% +% retracts fact F from the DB and removes any dependent facts +% + +pfcBlast(F) :- + pfcRemoveSupports(F), + fcUndo(F). + + +% removes any remaining supports for fact F, complaining as it goes. + +pfcRemoveSupports(F) :- + pfcRemOneSupport(F,S), + pfcWarn("~p was still supported by ~p (but no longer)",[F,S]), + fail. +pfcRemoveSupports(_). + +pfcRemoveSupportsQuietly(F) :- + pfcRemOneSupport(F,_), + fail. +pfcRemoveSupportsQuietly(_). + +% fcUndo(X) undoes X. + + +fcUndo(pfcAction(A)) :- + % undo an action by finding a method and successfully executing it. + !, + pfcRemActionTrace(pfcAction(A)). + +fcUndo('$pt$'(/*Key,*/Head,Body)) :- + % undo a positive trigger(+). + % + !, + (retract('$pt$'(/*Key,*/Head,Body)) + -> unFc('$pt$'(Head,Body)) + ; pfcWarn("Trigger not found to retract: ~p",['$pt$'(Head,Body)])). + +fcUndo('$nt$'(Head,Condition,Body)) :- + % undo a negative trigger(-). + !, + (retract('$nt$'(Head,Condition,Body)) + -> unFc('$nt$'(Head,Condition,Body)) + ; pfcWarn("Trigger not found to retract: ~p",['$nt$'(Head,Condition,Body)])). + +fcUndo(Fact) :- + % undo a random fact, printing out the trace, if relevant. + retract(Fact), + pfcTraceRem(Fact), + unFc(Fact). + + +% % unFc(P) is det. +% +% unFc(P) "un-forward-chains" from fact f. That is, fact F has just +% been removed from the database, so remove all dependant relations it +% participates in and check the things that they support to see if they +% should stayu in the database or should also be removed. + + +unFc(F) :- + pfcRetractDependantRelations(F), + unFc1(F). + +unFc1(F) :- + pfcUnFcCheckTriggers(F), + % is this really the right place for pfcRun pfcRemOneSupport(P,(_,Fact)) + ; pfcRemOneSupportOrQuietlyFail(P,(Fact,_))), + removeIfUnsupported(P), + fail. +pfcRetractDependantRelations(_). + + + +% % removeIfUnsupported(+P) checks to see if P is supported and removes +% % it from the DB if it is not. + +removeIfUnsupported(P) :- + fcSupported(P) -> pfcTraceMsg(fcSupported(P)) ; fcUndo(P). + + +% % fcSupported(+P) succeeds if P is "supported". What this means +% % depends on the TMS mode selected. + +fcSupported(P) :- + must_ex(fcTmsMode(Mode)), + supported(Mode,P). + +supported(local,P) :- !, pfcGetSupport(P,_). +supported(cycles,P) :- !, wellFounded(P). +supported(_,_P) :- true. + + +% % +% % a fact is well founded if it is supported by the user +% % or by a set of facts and a rules, all of which are well founded. +% % + +wellFounded(Fact) :- wf(Fact,[]). + +wf(F,_) :- + % supported by user (axiom) or an "absent" fact (assumption). + (axiom(F) ; assumption(F)), + !. + +wf(F,Descendants) :- + % first make sure we aren't in a loop. + (\+ memberchk(F,Descendants)), + % find a justification. + supports(F,Supporters), + % all of whose members are well founded. + wflist(Supporters,[F|Descendants]), + !. + +% % wflist(L) simply maps wf over the list. + +wflist([],_). +wflist([X|Rest],L) :- + wf(X,L), + wflist(Rest,L). + + + +% supports(+F,-ListofSupporters) where ListOfSupports is a list of the +% supports for one justification for fact F -- i.e. a list of facts which, +% together allow one to deduce F. One of the facts will typically be a rule. +% The supports for a user-defined fact are: [user]. + +supports(F,[Fact|MoreFacts]) :- + pfcGetSupport(F,(Fact,Trigger)), + triggerSupports(Trigger,MoreFacts). + +triggerSupports(U,[]) :- axiomatic_supporter(U),!. + +triggerSupports(Trigger,AllSupport):- + triggerSupports1(Trigger,AllSupport)*->true;triggerSupports2(Trigger,AllSupport). + +triggerSupports1(Trigger,AllSupport) :- + pfcGetSupport(Trigger,(Fact,AnotherTrigger)), + (triggerSupports(AnotherTrigger,MoreFacts)*->true;MoreFacts=[AnotherTrigger]), + [Fact|MoreFacts] = AllSupport. + +triggerSupports2(Trigger,AllSupport) :- fail, + pfcGetSupport(Trigger,(Fact,AnotherTrigger)), + (triggerSupports(AnotherTrigger,MoreFacts)*->true;MoreFacts=[AnotherTrigger]), + [Fact|MoreFacts] = AllSupport. + +axiomatic_supporter(Var):-is_ftVar(Var),!,fail. +axiomatic_supporter(is_ftVar(_)). +axiomatic_supporter(clause_u(_)). +axiomatic_supporter(user(_)). +axiomatic_supporter(U):- is_file_ref(U),!. +axiomatic_supporter(ax):-!. + +is_file_ref(A):-compound(A),A=mfl4(_VarNameZ,_,_,_). + +triggerSupports(_,Var,[is_ftVar(Var)]):-is_ftVar(Var),!. +triggerSupports(_,U,[]):- axiomatic_supporter(U),!. +triggerSupports(FactIn,Trigger,OUT):- + pfcGetSupport(Trigger,(Fact,AnotherTrigger))*-> + (triggerSupports(Fact,AnotherTrigger,MoreFacts),OUT=[Fact|MoreFacts]); + triggerSupports1(FactIn,Trigger,OUT). + +triggerSupports1(_,X,[X]):- may_cheat. +may_cheat:- true_flag. + + + +% % +% % +% % pfcFwd(X) forward chains from a fact or a list of facts X. +% % +pfcFwd(Fact) :- control_arg_types(Fact,Fixed),!,pfcFwd(Fixed). +pfcFwd(Fact):- locally(set_prolog_flag(occurs_check,true), pfcFwd0(Fact)). +pfcFwd0(Fact) :- is_list(List)->my_maplist(pfcFwd0,List);pfcFwd1(Fact). + +% fc1(+P) forward chains for a single fact. + + +pfcFwd1(Fact) :- + (fc_rule_check(Fact)*->true;true), + copy_term(Fact,F), + % check positive triggers + ignore(fcpt(Fact,F)), + % check negative triggers + ignore(fcnt(Fact,F)). + + +% % +% % fc_rule_check(P) does some special, built in forward chaining if P is +% % a rule. +% % + +fc_rule_check((Name::::P==>Q)) :- + !, + processRule(P,Q,(Name::::P==>Q)). +fc_rule_check((Name::::P<==>Q)) :- + !, + processRule(P,Q,((Name::::P<==>Q))), + processRule(Q,P,((Name::::P<==>Q))). + + + +fc_rule_check((P==>Q)) :- + !, + processRule(P,Q,(P==>Q)). +fc_rule_check((P<==>Q)) :- + !, + processRule(P,Q,(P<==>Q)), + processRule(Q,P,(P<==>Q)). + +fc_rule_check(('<-'(P,Q))) :- + !, + pfcDefineBcRule(P,Q,('<-'(P,Q))). + +fc_rule_check(_). + + +fcpt(Fact,F) :- + pfcGetTriggerQuick('$pt$'(F,Body)), + pfcTraceMsg('\n Found positive trigger(+):\n ~p~n body: ~p~n', + [F,Body]), + pfcGetSupport('$pt$'(F,Body),Support), %fbugio(pfcGetSupport('$pt$'(F,Body),Support)), + with_current_why(Support,with_current_why(Fact,fcEvalLHS(Body,(Fact,'$pt$'(F,Body))))), + fail. + +%fcpt(Fact,F) :- +% pfcGetTriggerQuick('$pt$'(presently(F),Body)), +% fcEvalLHS(Body,(presently(Fact),'$pt$'(presently(F),Body))), +% fail. + +fcpt(_,_). + +fcnt(_Fact,F) :- + pfc_spft(X,_,'$nt$'(F,Condition,Body)), + pfcCallSystem(Condition), + pfcRem_S(X,(_,'$nt$'(F,Condition,Body))), + fail. +fcnt(_,_). + + +% % pfcRem_S(P,S) removes support S from P and checks to see if P is still supported. +% % If it is not, then the fact is retreactred from the database and any support +% % relationships it participated in removed. +pfcRem_S(P,S) :- + % pfcDebug(pfcPrintf("removing support ~p from ~p",[S,P])), + pfcTraceMsg(' Removing support: ~p from ~p~n',[S,P]), + pfcRemOneSupport(P,S) + -> removeIfUnsupported(P) + ; pfcWarn("pfcRem_S/2 Could not find support ~p to remove from fact ~p", + [S,P]). + + + +% % pfcDefineBcRule(+Head,+Body,+ParentRule) +% +% defines a backward +% chaining rule and adds the corresponding '$bt$' triggers to the database. +% + +pfcDefineBcRule(Head,_Body,ParentRule) :- + (\+ pfcLiteral(Head)), + pfcWarn("Malformed backward chaining rule. ~p not atomic literal.",[Head]), + pfcError("caused by rule: ~p",[ParentRule]), + !, + fail. + +pfcDefineBcRule(Head,Body,ParentRule) :- + copy_term(ParentRule,ParentRuleCopy), + buildRhs(Head,Rhs), + current_why_U(USER), % @TODO REVIEW _U + pfcForEach(pfc_nf(Body,Lhs), + (buildTrigger(Lhs,rhs(Rhs),Trigger), + pfcAdd('$bt$'(Head,Trigger),(ParentRuleCopy,USER)))). +get_bc_clause(Head,(HeadC:- BodyC)):- get_bc_clause(Head,HeadC,BodyC). + +get_bc_clause(HeadIn, ~HeadC, Body):- compound(HeadIn), HeadIn = ~Head,!, + Body = ( awc, + ( nonvar(HeadC)-> (HeadC = Head,!) ; (HeadC = Head)), + pfc_bc_and_with_pfc(~Head)). +get_bc_clause(Head, Head, Body):- % % :- is_ftNonvar(Head). + Body = ( awc, !, pfc_bc_and_with_pfc(Head)). + +:- thread_initialization(nb_setval('$pfc_current_choice',[])). + +push_current_choice:- current_prolog_flag(pfc_support_cut,false),!. +push_current_choice:- prolog_current_choice(CP),push_current_choice(CP),!. +push_current_choice(CP):- nb_current('$pfc_current_choice',Was)->b_setval('$pfc_current_choice',[CP|Was]);b_setval('$pfc_current_choice',[CP]). + +cut_c:- current_prolog_flag(pfc_support_cut,false),!. +cut_c:- must_ex(nb_current('$pfc_current_choice',[CP|_WAS])),prolog_cut_to(CP). + + +% % +% % +% % eval something on the LHS of a rule. +% % + + +fcEvalLHS((Test->Body),Support) :- + !, + pfcDoAll(pfcCallSystem(Test) -> (fcEvalLHS(Body,Support))), + !. + +fcEvalLHS((Test*->Body),Support) :- + !, + pfcDoAll(pfcCallSystem(Test) *-> (fcEvalLHS(Body,Support))). + +fcEvalLHS(rhs(X),Support) :- + !, + pfcDoAll(pfc_eval_rhs(X,Support)), + !. + +fcEvalLHS(X,Support) :- + pfcType(X,trigger(_Pos)), + !, + pfcAddTrigger(X,Support), + !. + +%fcEvalLHS(snip(X),Support) :- +% snip(Support), +% fcEvalLHS(X,Support). + +fcEvalLHS(X,_) :- + pfcWarn("Unrecognized item found in trigger body, namely ~p.",[X]). + + +% % +% % eval something on the RHS of a rule. +% % + +pfc_eval_rhs([],_) :- !. +pfc_eval_rhs([Head|Tail],Support) :- + pfc_eval_rhs1(Head,Support), + pfc_eval_rhs(Tail,Support). + + +pfc_eval_rhs1(Fact,S) :- control_arg_types(Fact,Fixed),!,pfc_eval_rhs1(Fixed,S). + +pfc_eval_rhs1({Action},Support) :- + % evaluable Prolog code. + !, + fcEvalAction(Action,Support). + +pfc_eval_rhs1(P,_Support) :- + % predicate to remove. + pfcNegatedLiteral(P), + !, + pfcWithdraw(P). + +pfc_eval_rhs1([X|Xrest],Support) :- + % embedded sublist. + !, + pfc_eval_rhs([X|Xrest],Support). + +pfc_eval_rhs1(Assertion,Support) :- + % an assertion to be added. + once_writeq_ln(pfcRHS(Assertion)), + (must_ex(pfcPost1(Assertion,Support))*->true ; + pfcWarn("Malformed rhs of a rule: ~p",[Assertion])). + + +% % +% % evaluate an action found on the rhs of a rule. +% % + +fcEvalAction(Action,Support) :- + pfcCallSystem(Action), + (undoable(Action) + -> pfcAddActionTrace(Action,Support) + ; true). + + +% % +% % +% % + +trigger_trigger(Trigger,Body,_Support) :- + trigger_trigger1(Trigger,Body). +trigger_trigger(_,_,_). + + +%trigger_trigger1(presently(Trigger),Body) :- +% !, +% copy_term(Trigger,TriggerCopy), +% pfc_call(Trigger), +% fcEvalLHS(Body,(presently(Trigger),'$pt$'(presently(TriggerCopy),Body))), +% fail. + +trigger_trigger1(Trigger,Body) :- + copy_term(Trigger,TriggerCopy), + pfc_call(Trigger), + with_current_why(Trigger,fcEvalLHS(Body,(Trigger,'$pt$'(TriggerCopy,Body)))), + fail. + + +% % pfc_call(F) is nondet. +% +% pfc_call(F) is true iff F is a fact available for forward chaining. +% Note that this has the side effect of catching unsupported facts and +% assigning them support from God. +% + +%pfc_call(F) :- var(F), !, pfc_call(F). +pfc_call(P) :- var(P), !, pfcFact(P). +pfc_call(P) :- \+ callable(P), throw(pfc_call(P)). +pfc_call((!)) :-!,cut_c. +pfc_call(true):-!. +pfc_call((A->B;C)) :-!, pfc_call(A)->pfc_call(B);pfc_call(C). +pfc_call((A*->B;C)) :-!, pfc_call(A)*->pfc_call(B);pfc_call(C). +pfc_call((A->B)) :-!, pfc_call(A)->pfc_call(B). +pfc_call((A*->B)) :-!, pfc_call(A)*->pfc_call(B). +pfc_call((A,B)) :-!, pfc_call(A),pfc_call(B). +pfc_call((A;B)) :-!, pfc_call(A);pfc_call(B). +pfc_call(\+ (A)) :-!, \+ pfc_call(A). +pfc_call((A is B)) :-!, A is B. +pfc_call(clause(A,B)) :-!, clause(A,B). +pfc_call(clause(A,B,Ref)) :-!, clause(A,B,Ref). +% we really need to check for system predicates as well. +% this is probably not advisable due to extreme inefficiency. +pfc_call(P) :- + % trigger(?) any bc rules. + '$bt$'(P,Trigger), + pfcGetSupport('$bt$'(P,Trigger),S), + % @TODO REVIEW _U + fcEvalLHS(Trigger,S), + fail. +%pfc_call(P) :- var(P), !, pfcFact(P). +pfc_call(P) :- predicate_property(P,imported_from(system)), !, call(P). +pfc_call(P) :- predicate_property(P,built_in), !, call(P). +pfc_call(P) :- \+ predicate_property(P,_), functor(P,F,A), dynamic(F/A), !, call(P). +pfc_call(P) :- \+ predicate_property(P,number_of_clauses(_)), !, call(P). +pfc_call(P) :- + setup_call_cleanup( + nb_current('$pfc_current_choice',Was), + (prolog_current_choice(CP), push_current_choice(CP), clause(P,Condition), pfc_call(Condition)), + nb_setval('$pfc_current_choice',Was)). + +/* +pfc_call(P) :- + clause(P,true)*-> true ; (clause(P,Condition), Condition\==true, + pfc_call(Condition)). +*/ + +% an action is undoable if there exists a method for undoing it. +undoable(A) :- fcUndoMethod(A,_). + +pfc_cache_bc(P) :- + % trigger(?) any bc rules. + forall('$bt$'(P,Trigger), + forall(pfcGetSupport('$bt$'(P,Trigger),S), + % @TODO REVIEW _U + fcEvalLHS(Trigger,S))). + + +% % +% % +% % defining fc rules +% % + +% % pfc_nf(+In,-Out) maps the LHR of a pfc rule In to one normal form +% % Out. It also does certain optimizations. Backtracking into this +% % predicate will produce additional clauses. + + +pfc_nf(LHS,List) :- + pfc_nf1(LHS,List2), + pfc_nf_negations(List2,List). + + +% % pfc_nf1(+In,-Out) maps the LHR of a pfc rule In to one normal form +% % Out. Backtracking into this predicate will produce additional clauses. + +% handle a variable. + +pfc_nf1(P,[P]) :- var(P), !. + +% these next two rules are here for upward compatibility and will go +% away eventually when the P/Condition form is no longer used anywhere. + +pfc_nf1(P/Cond,[( \+P )/Cond]) :- pfcNegatedLiteral(P), !. + +pfc_nf1(P/Cond,[P/Cond]) :- pfcLiteral(P), !. + +% % handle a negated form + +pfc_nf1(NegTerm,NF) :- + pfc_unnegate(NegTerm,Term), + !, + pfc_nf1_negation(Term,NF). + +% % disjunction. + +pfc_nf1((P;Q),NF) :- + !, + (pfc_nf1(P,NF) ; pfc_nf1(Q,NF)). + + +% % conjunction. + +pfc_nf1((P,Q),NF) :- + !, + pfc_nf1(P,NF1), + pfc_nf1(Q,NF2), + append(NF1,NF2,NF). + +% % handle a random atom. + +pfc_nf1(P,[P]) :- + pfcLiteral(P), + !. + +/*% % % shouln't we have something to catch the rest as errors?*/ +pfc_nf1(Term,[Term]) :- + pfcWarn("pfc_nf doesn''t know how to normalize ~p (accepting though)",[Term]). + + +% % pfc_nf1_negation(P,NF) is true if NF is the normal form of \+P. +pfc_nf1_negation((P/Cond),[(\+(P))/Cond]) :- !. + +pfc_nf1_negation((P;Q),NF) :- + !, + pfc_nf1_negation(P,NFp), + pfc_nf1_negation(Q,NFq), + append(NFp,NFq,NF). + +pfc_nf1_negation((P,Q),NF) :- + % this code is not correct! twf. + !, + pfc_nf1_negation(P,NF) + ; + (pfc_nf1(P,Pnf), + pfc_nf1_negation(Q,Qnf), + append(Pnf,Qnf,NF)). + +pfc_nf1_negation(P,[\+P]). + + +% % pfc_nf_negations(List2,List) sweeps through List2 to produce List, +% % changing ~{...} to {\+...} +% % % ? is this still needed? twf 3/16/90 + +pfc_nf_negations(X,X) :- !. % I think not! twf 3/27/90 + +pfc_nf_negations([],[]). + +pfc_nf_negations([H1|T1],[H2|T2]) :- + pfc_nf_negation(H1,H2), + pfc_nf_negations(T1,T2). + +% Maybe \+ tilded_negation ? + +pfc_nf_negation(Form,{\+ X}) :- + nonvar(Form), + Form=(~({X})), + !. +pfc_nf_negation(Form,{\+ X}) :- tilded_negation, + nonvar(Form), + Form=(-({X})), + !. +pfc_nf_negation(Form,{\+ X}) :- tilded_negation, + nonvar(Form), + Form=( \+ ({X})), + !. +pfc_nf_negation(X,X). + + + + % % constrain_meta(+Lhs, ?Guard) is semidet. + % + % Creates a somewhat sane Guard. + % + % To turn this feature off... + % ?- set_prolog_flag(constrain_meta,false). + % + % + constrain_meta(_,_):- current_prolog_flag(constrain_meta,false),!,fail. + % FACT + constrain_meta(P,mpred_positive_fact(P)):- is_ftVar(P),!. + % NEG chaining + constrain_meta(~ P, CP):- !, constrain_meta(P,CP). + constrain_meta(\+ P, CP):- !, constrain_meta(P,CP). + % FWD chaining + constrain_meta((_==>Q),nonvar(Q)):- !, is_ftVar(Q). + % EQV chaining + constrain_meta((P<==>Q),(nonvar(Q);nonvar(P))):- (is_ftVar(Q);is_ftVar(P)),!. + % BWD chaining + constrain_meta((Q <- _),mpred_literal(Q)):- is_ftVar(Q),!. + constrain_meta((Q <- _),CQ):- !, constrain_meta(Q,CQ). + % CWC chaining + constrain_meta((Q :- _),mpred_literal(Q)):- is_ftVar(Q),!. + constrain_meta((Q :- _),CQ):- !, constrain_meta(Q,CQ). + + + + + + is_simple_lhs(ActN):- is_ftVar(ActN),!,fail. + is_simple_lhs( \+ _ ):-!,fail. + is_simple_lhs( ~ _ ):-!,fail. + is_simple_lhs( _ / _ ):-!,fail. + is_simple_lhs((Lhs1,Lhs2)):- !,is_simple_lhs(Lhs1),is_simple_lhs(Lhs2). + is_simple_lhs((Lhs1;Lhs2)):- !,is_simple_lhs(Lhs1),is_simple_lhs(Lhs2). + is_simple_lhs(ActN):- is_active_lhs(ActN),!,fail. + is_simple_lhs((Lhs1/Lhs2)):- !,fail, is_simple_lhs(Lhs1),is_simple_lhs(Lhs2). + is_simple_lhs(_). + + + is_active_lhs(ActN):- var(ActN),!,fail. + is_active_lhs(!). + is_active_lhs(cut_c). + is_active_lhs(actn(_Act)). + is_active_lhs('{}'(_Act)). + is_active_lhs((Lhs1/Lhs2)):- !,is_active_lhs(Lhs1);is_active_lhs(Lhs2). + is_active_lhs((Lhs1,Lhs2)):- !,is_active_lhs(Lhs1);is_active_lhs(Lhs2). + is_active_lhs((Lhs1;Lhs2)):- !,is_active_lhs(Lhs1);is_active_lhs(Lhs2). + + + add_lhs_cond(Lhs1/Cond,Lhs2,Lhs1/(Cond,Lhs2)):-!. + add_lhs_cond(Lhs1,Lhs2,Lhs1/Lhs2). + + + +% % +% % buildRhs(+Conjunction,-Rhs) +% % + +buildRhs(X,[X]) :- + var(X), + !. + +buildRhs((A,B),[A2|Rest]) :- + !, + pfcCompileRhsTerm(A,A2), + buildRhs(B,Rest). + +buildRhs(X,[X2]) :- + pfcCompileRhsTerm(X,X2). + +pfcCompileRhsTerm((P/C),((P:-C))) :- !. + +pfcCompileRhsTerm(P,P). + + +% % pfc_unnegate(N,P) is true if N is a negated term and P is the term +% % with the negation operator stripped. + +pfc_unnegate(P,_):- var(P),!,fail. +pfc_unnegate((~P),P):- \+ tilded_negation. +pfc_unnegate((-P),P). +pfc_unnegate((\+(P)),P). + +pfcNegatedLiteral(P) :- + callable(P), + pfc_unnegate(P,Q), + pfcPositiveLiteral(Q). + +pfcLiteral(X) :- pfcNegatedLiteral(X). +pfcLiteral(X) :- pfcPositiveLiteral(X). + +pfcPositiveLiteral(X) :- + callable(X), + functor(X,F,_), + \+ pfcConnective(F). + +pfcConnective(';'). +pfcConnective(','). +pfcConnective('/'). +pfcConnective('|'). +pfcConnective(('==>')). +pfcConnective(('<-')). +pfcConnective('<==>'). + +pfcConnective('-'). +pfcConnective('~'):- \+ tilded_negation. +pfcConnective(( \+ )). + +is_implicitly_prolog(Callable):- \+ callable(Callable),!, fail. +is_implicitly_prolog(_ is _). + +processRule(Lhs,Rhs,ParentRule) :- + copy_term(ParentRule,ParentRuleCopy), + buildRhs(Rhs,Rhs2), + current_why_U(USER), % @TODO REVIEW _U + pfcForEach(pfc_nf(Lhs,Lhs2), + buildRule(Lhs2,rhs(Rhs2),(ParentRuleCopy,USER))). + +buildRule(Lhs,Rhs,Support) :- + buildTrigger(Lhs,Rhs,Trigger), + fcEvalLHS(Trigger,Support). + +buildTrigger([],Consequent,Consequent). + +buildTrigger([Test|Triggers],Consequent,(Test *-> X)) :- is_implicitly_prolog(Test), + !, + buildTrigger(Triggers,Consequent,X). + +buildTrigger([V|Triggers],Consequent,'$pt$'(V,X)) :- + var(V), + !, + buildTrigger(Triggers,Consequent,X). + + +buildTrigger([(T1/Test)|Triggers],Consequent,'$nt$'(T2,Test2,X)) :- + pfc_unnegate(T1,T2), + !, + buildNtTest(T2,Test,Test2), + buildTrigger(Triggers,Consequent,X). + +buildTrigger([(T1)|Triggers],Consequent,'$nt$'(T2,Test,X)) :- + pfc_unnegate(T1,T2), + !, + buildNtTest(T2,true,Test), + buildTrigger(Triggers,Consequent,X). + +buildTrigger([{Test}|Triggers],Consequent,(Test *-> X)) :- + !, + buildTrigger(Triggers,Consequent,X). + +buildTrigger([T/Test|Triggers],Consequent,'$pt$'(T,X)) :- + !, + buildTest(Test,Test2), + buildTrigger([{Test2}|Triggers],Consequent,X). + + +%buildTrigger([snip|Triggers],Consequent,snip(X)) :- +% !, +% buildTrigger(Triggers,Consequent,X). + +buildTrigger([T|Triggers],Consequent,'$pt$'(T,X)) :- + !, + buildTrigger(Triggers,Consequent,X). + +% % +% % buildNtTest(+,+,-). +% % +% % builds the test used in a negative trigger(-) ('$nt$'/3). This test is a +% % conjunction of the check than no matching facts are in the db and any +% % additional test specified in the rule attached to this ~ term. +% % + % tilded_negation. +buildNtTest(T,Testin,Testout) :- + buildTest(Testin,Testmid), + pfcConjoin((pfc_call(T)),Testmid,Testout). + + +% this just strips away any currly brackets. + +buildTest({Test},Test) :- !. +buildTest(Test,Test). + +% % + + +% % pfcType(+VALUE1, ?Type) is semidet. +% +% PFC Database Type. +% +% simple typeing for Pfc objects +% + + +pfcType(Var,Type):- var(Var),!, Type=fact(_FT). +pfcType(_:X,Type):- !, pfcType(X,Type). +pfcType(~_,Type):- !, Type=fact(_FT). +pfcType(('==>'(_,_)),Type):- !, Type=rule(fwd). +pfcType( '==>'(X),Type):- !, pfcType(X,Type), pfcWarn(pfcType( '==>'(X), Type)). +pfcType(('<==>'(_,_)),Type):- !, Type=rule(<==>). +pfcType(('<-'(_,_)),Type):- !, Type=rule(bwc). +pfcType((':-'(_,_)),Type):- !, Type=rule(cwc). +pfcType('$pt$'(_,_,_),Type):- !, Type=trigger(+). +pfcType('$pt$'(_,_),Type):- !, Type=trigger(+). +pfcType('$nt$'(_,_,_),Type):- !, Type=trigger(-). +pfcType('$bt$'(_,_),Type):- !, Type=trigger(?). +pfcType(pfcAction(_),Type):- !, Type=action. +pfcType((('::::'(_,X))),Type):- !, pfcType(X,Type). +pfcType(_,fact(_FT)):- + % if it''s not one of the above, it must_ex be a fact! + !. + +pfcAssert(P,Support) :- + (pfc_clause(P) ; assert(P)), + !, + pfcAddSupport(P,Support). + +pfcAsserta(P,Support) :- + (pfc_clause(P) ; asserta(P)), + !, + pfcAddSupport(P,Support). + +pfcAssertz(P,Support) :- + (pfc_clause(P) ; assertz(P)), + !, + pfcAddSupport(P,Support). + +pfc_clause((Head :- Body)) :- + !, + copy_term(Head,Head_copy), + copy_term(Body,Body_copy), + clause(Head,Body), + variant(Head,Head_copy), + variant(Body,Body_copy). + +pfc_clause(Head) :- + % find a unit clause identical to Head by finding one which unifies, + % and then checking to see if it is identical + copy_term(Head,Head_copy), + clause(Head_copy,true), + variant(Head,Head_copy). + +pfcForEach(Binder,Body) :- Binder,pfcdo(Body),fail. +pfcForEach(_,_). + +% pfcdo(X) executes X once and always succeeds. +pfcdo(X) :- X,!. +pfcdo(_). + + +% % pfcUnion(L1,L2,L3) - true if set L3 is the result of appending sets +% % L1 and L2 where sets are represented as simple lists. + +pfcUnion([],L,L). +pfcUnion([Head|Tail],L,Tail2) :- + memberchk(Head,L), + !, + pfcUnion(Tail,L,Tail2). +pfcUnion([Head|Tail],L,[Head|Tail2]) :- + pfcUnion(Tail,L,Tail2). + + +% % pfcConjoin(+Conjunct1,+Conjunct2,?Conjunction). +% % arg3 is a simplified expression representing the conjunction of +% % args 1 and 2. + +pfcConjoin(true,X,X) :- !. +pfcConjoin(X,true,X) :- !. +pfcConjoin(C1,C2,(C1,C2)). + + +% File : pfcdb.pl +% Author : Tim Finin, finin@prc.unisys.com +% Author : Dave Matuszek, dave@prc.unisys.com +% Author : Dan Corpron +% Updated: 10/11/87, ... +% Purpose: predicates to manipulate a pfc database (e.g. save, +% % restore, reset, etc.0 + +% pfcDatabaseTerm(P/A) is true iff P/A is something that pfc adds to +% the database and should not be present in an empty pfc database + +pfcDatabaseTerm('$spft$'/3). +pfcDatabaseTerm('$pt$'/2). +pfcDatabaseTerm('$bt$'/2). +pfcDatabaseTerm('$nt$'/3). +pfcDatabaseTerm('==>'/2). +pfcDatabaseTerm('<==>'/2). +pfcDatabaseTerm('<-'/2). +pfcDatabaseTerm(pfcQueue/1). + +% removes all forward chaining rules and justifications from db. + +pfcReset :- + pfc_spft(P,F,Trigger), + pfcRetractOrWarn(P), + pfcRetractOrWarn('$spft$'(P,F,Trigger)), + fail. +pfcReset :- + (pfcDatabaseItem(T)*-> + (pfcError("Pfc database not empty after pfcReset, e.g., ~p.~n",[T]),fail) + ; true). + + +% true if there is some pfc crud still in the database. +pfcDatabaseItem(Term:-Body) :- + pfcDatabaseTerm(P/A), + functor(Term,P,A), + clause(Term,Body). + +pfcRetractOrWarn(X) :- retract(X), !. +pfcRetractOrWarn(X) :- + pfcWarn("Couldn't retract ~p.",[X]),nop((dumpST,pfcWarn("Couldn't retract ~p.",[X]))),!. + +pfcRetractOrQuietlyFail(X) :- retract(X), !. +pfcRetractOrQuietlyFail(X) :- + nop((pfcTraceMsg("Trace: Couldn't retract ~p.",[X]),nop((dumpST,pfcWarn("Couldn't retract ~p.",[X]))))), + !,fail. + + diff --git a/.Attic/canary_docme/metta_pfc_support.pl b/.Attic/canary_docme/metta_pfc_support.pl new file mode 100644 index 00000000000..c80d81a3716 --- /dev/null +++ b/.Attic/canary_docme/metta_pfc_support.pl @@ -0,0 +1,662 @@ +/* + * Project: MeTTaLog - A MeTTa to Prolog Transpiler/Interpreter + * Description: This file is part of the source code for a transpiler designed to convert + * MeTTa language programs into Prolog, utilizing the SWI-Prolog compiler for + * optimizing and transforming function/logic programs. It handles different + * logical constructs and performs conversions between functions and predicates. + * + * Author: Douglas R. Miles + * Contact: logicmoo@gmail.com / dmiles@logicmoo.org + * License: LGPL + * Repository: https://github.com/trueagi-io/metta-wam + * https://github.com/logicmoo/hyperon-wam + * Created Date: 8/23/2023 + * Last Modified: $LastChangedDate$ # You will replace this with Git automation + * + * Usage: This file is a part of the transpiler that transforms MeTTa programs into Prolog. For details + * on how to contribute or use this project, please refer to the repository README or the project documentation. + * + * Contribution: Contributions are welcome! For contributing guidelines, please check the CONTRIBUTING.md + * file in the repository. + * + * Notes: + * - Ensure you have SWI-Prolog installed and properly configured to use this transpiler. + * - This project is under active development, and we welcome feedback and contributions. + * + * Acknowledgments: Special thanks to all contributors and the open source community for their support and contributions. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the + * distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS + * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT + * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS + * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE + * COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, + * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; + * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER + * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN + * ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + * POSSIBILITY OF SUCH DAMAGE. + */ + +/* + LogicMOO Base FOL/PFC Setup +% Dec 13, 2035 +% Douglas Miles + +*/ +% :- if( \+ current_predicate(set_fileAssertMt/1)). +% % +% % +% % predicates for manipulating support relationships +% % + +% % pfcAddSupport(+Fact,+Support) + +pfcAddSupport(P,(Fact,Trigger)) :- assert('$spft$'(P,Fact,Trigger)). + +pfcGetSupport(P,(Fact,Trigger)) :- pfc_spft(P,Fact,Trigger). + +pfc_spft(P,F,T) :- pfcCallSystem('$spft$'(P,F,T)). + +% There are three of these to try to efficiently handle the cases +% where some of the arguments are not bound but at least one is. + +pfcRemOneSupport(P,(Fact,Trigger)) :- + must_ex(callable(P);callable(Fact);callable(Trigger)), + pfcRetractOrWarn('$spft$'(P,Fact,Trigger)). + +pfcRemOneSupportOrQuietlyFail(P,(Fact,Trigger)) :- + must_ex(callable(P);callable(Fact);callable(Trigger)), + pfcRetractOrQuietlyFail('$spft$'(P,Fact,Trigger)). + + +pfc_collect_supports(Tripples) :- + bagof(Tripple, pfc_support_relation(Tripple), Tripples), + !. +pfc_collect_supports([]). + +pfc_support_relation((P,F,T)) :- + pfc_spft(P,F,T). + + + +pfc_make_supports((P,S1,S2)) :- + pfcAddSupport(P,(S1,S2)), + (pfcAddType1(P); true), + !. + +% % pfcTriggerKey(+Trigger,-Key) +% % +% % Arg1 is a trigger. Key is the best term to index it on. + +pfcTriggerKey('$pt$'(Key,_),Key). +pfcTriggerKey('$pt$'(Key,_,_),Key). +pfcTriggerKey('$nt$'(Key,_,_),Key). +pfcTriggerKey(Key,Key). + + +% % ^L +% % Get a key from the trigger that will be used as the first argument of +% % the trigger base clause that stores the trigger. +% % + +pfc_trigger_key(X,X) :- var(X), !. +pfc_trigger_key(chart(word(W),_L),W) :- !. +pfc_trigger_key(chart(stem([Char1|_Rest]),_L),Char1) :- !. +pfc_trigger_key(chart(Concept,_L),Concept) :- !. +pfc_trigger_key(X,X). + + +nb_pushval(Name,Value):-nb_current(Name,Before)->nb_setval(Name,[Value|Before]);nb_setval(Name,[Value]). +nb_peekval(Name,Value):-nb_current(Name,[Value|_Before]). +nb_hasval(Name,Value):-nb_current(Name,List),member(Value,List). +nb_popval(Name,Value):-nb_current(Name,[Value|Before])->nb_setval(Name,Before). + +reset_shown_justs:- retractall(t_l:shown_why(_)),nop(color_line(red,1)). +clear_proofs:- retractall(t_l:whybuffer(_P,_Js)),nop(color_line(cyan,1)). + + +lookup_spft_match(A,B,C):- copy_term(A,AA),lookup_spft(A,B,C),A=@=AA. + +lookup_spft_match_deeper(H,Fact,Trigger):- + copy_term(H,HH), + lookup_spft((H:- _B),Fact,Trigger), + H=@=HH. + +lookup_spft_match_first(A,B,C):- nonvar(A),!, + no_repeats(((lookup_spft_match(A,B,C);lookup_spft(A,B,C)))). + +lookup_spft_match_first(A,B,C):- lookup_spft(A,B,C). + + +% % pfc_is_info( :TermC) is semidet. +% +% PFC If Is A Info. +% +pfc_is_info((CWC,Info)):- (atom(CWC),is_a_info(CWC));pfc_is_info(Info). +pfc_is_info(pfc_bc_only(C)):-is_ftNonvar(C),!. +pfc_is_info(infoF(C)):-is_ftNonvar(C),!. +pfc_is_info(inherit_above(_,_)). + + +is_a_info(fail). +is_a_info(CWC):- is_pfc_chained(CWC). + +is_pfc_chained(cwc). +is_pfc_chained(awc). +is_pfc_chained(zwc). +is_pfc_chained(fwc). +is_pfc_chained(bwc). +is_pfc_chained(wac). + +:- forall(is_pfc_chained(Op),assert_if_new(Op)). + +reserved_body(B):-var(B),!,fail. +reserved_body(attr_bind(_)). +reserved_body(attr_bind(_,_)). +reserved_body(B):-reserved_body_helper(B). + +reserved_body_helper(B):- \+ compound(B),!,fail. +reserved_body_helper((ZAWC,_)):- atom(ZAWC),is_pfc_chained(ZAWC). + +call_only_based_mfl(H,mfl4(_VarNameZ,M,F,L)):- + ignore(predicate_property(H,imported_from(M));predicate_property(H,module(M))), + ignore(predicate_property(H,line_count(L))), + ignore(source_file(M:H,F);predicate_property(H,file(F));(predicate_property(H,foreign),F=foreign)). + +uses_call_only(H):- predicate_property(H,foreign),!. +uses_call_only(H):- predicate_property(H,_), \+ predicate_property(H,interpreted),!. + +clause_match(H,_B,uses_call_only(H)):- uses_call_only(H),!. +clause_match(H,B,Ref):- clause_asserted(H,B,Ref),!. +clause_match(H,B,Ref):- ((copy_term(H,HH),clause(H,B,Ref),H=@=HH)*->true;clause(H,B,Ref)), \+ reserved_body_helper(B). + +find_mfl(C,MFL):- lookup_spft_match(C,MFL,ax). +find_mfl(C,MFL):- unwrap_litr0(C,UC) -> C\==UC -> find_mfl(UC,MFL). +find_mfl(C,MFL):- expand_to_hb(C,H,B), + find_hb_mfl(H,B,_Ref,MFL)->true; (clause_match(H,B,Ref),find_hb_mfl(H,B,Ref,MFL)). + +find_hb_mfl(_H,_B,Ref,mfl4(_VarNameZ,M,F,L)):- atomic(Ref),clause_property(Ref,line_count(L)), + clause_property(Ref,file(F)),clause_property(Ref,module(M)). +find_hb_mfl(H,B,_,mfl4(VarNameZ,M,F,L)):- lookup_spft_match_first( (H:-B),mfl4(VarNameZ,M,F,L),_),!. +find_hb_mfl(H,B,_Ref,mfl4(VarNameZ,M,F,L)):- lookup_spft_match_first(H,mfl4(VarNameZ,M,F,L),_),ground(B). +find_hb_mfl(H,_B,uses_call_only(H),MFL):- !,call_only_based_mfl(H,MFL). + +:- fixup_exports. +%:- current_prolog_flag(pfc_shared_module,BaseKB),fixup_module_exports_into(BaseKB). +:- fixup_module_exports_into(system). + +mpred_rule_hb(C,_):- \+ compound(C),!,fail. +mpred_rule_hb((H:-B),H,B):- !. +mpred_rule_hb((H<-B),H,B):- !. +mpred_rule_hb((B==>H),H,B):- !. +mpred_rule_hb((==>H),H,true):- !. +mpred_rule_hb((HB1<==>HB2),(H1,H2),(B1,B2)):- !, (mpred_rule_hb((HB1==>HB2),H2,B2);mpred_rule_hb((HB2==>HB1),H1,B1)). + +:- module_transparent( (get_assertion_head_arg)/3). +get_assertion_head_arg(N,P,E):-get_assertion_head_unnegated(P,PP),!,arg(N,PP,E). + +get_assertion_head_unnegated(P,PP):- mpred_rule_hb(P,H,_), (pfc_unnegate(H,PP)->true;H==PP). +replace_arg(Q,N,NEW,R):- duplicate_term(Q,R),Q=R,nb_setarg(N,R,NEW). + +%% if_missing_mask( +Q, ?R, ?Test) is semidet. +% +% If Missing Mask. +% + +if_missing_mask(M:Q,M:R,M:Test):- nonvar(Q),!,if_missing_mask(Q,R,Test). +if_missing_mask(Q,~Q,\+Q):- \+ is_ftCompound(Q),!. + +%if_missing_mask(ISA, ~ ISA, \+ ISA):- functor(ISA,F,1),(F==tSwim;call_u(functorDeclares(F))),!. +if_missing_mask(HB,RO,TestO):- once(mpred_rule_hb(HB,H,B)),B\==true,HB\==H,!, + if_missing_mask(H,R,TestO),subst(HB,H,R,RO). + +if_missing_mask(ISA, ISA, \+ ISA):- functor(ISA, _F,1),!.% (F==tSwim;call_u(functorDeclares(F))),!. + +if_missing_mask(Q,R,Test):- + which_missing_argnum(Q,N), + if_missing_n_mask(Q,N,R,Test),!. + +if_missing_mask(ISA, ~ ISA, \+ ISA). + +%% if_missing_n_mask( +Q, ?N, ?R, ?Test) is semidet. +% +% If Missing Mask. +% +if_missing_n_mask(Q,N,R,Test):- + get_assertion_head_arg(N,Q,Was), + (nonvar(R)-> (which_missing_argnum(R,RN),get_assertion_head_arg(RN,R,NEW));replace_arg(Q,N,NEW,R)),!, + Test=dif:dif(Was,NEW). + +/* +Old version +if_missing_mask(Q,N,R,dif:dif(Was,NEW)):- + must_ex((is_ftNonvar(Q),acyclic_term(Q),acyclic_term(R),functor(Q,F,A),functor(R,F,A))), + (singleValuedInArg(F,N) -> + (get_assertion_head_arg(N,Q,Was),replace_arg(Q,N,NEW,R)); + ((get_assertion_head_arg(N,Q,Was),is_ftNonvar(Was)) -> replace_arg(Q,N,NEW,R); + (N=A,get_assertion_head_arg(N,Q,Was),replace_arg(Q,N,NEW,R)))). +*/ + + +%% which_missing_argnum( +VALUE1, ?VALUE2) is semidet. +% +% Which Missing Argnum. +% +which_missing_argnum(Q,N):- compound(Q),\+ compound_name_arity(Q,_,0), + must_ex((acyclic_term(Q),is_ftCompound(Q),get_functor(Q,F,A))), + F\=t, + (call_u(singleValuedInArg(F,N)) -> true; which_missing_argnum(Q,F,A,N)). + +which_missing_argnum(_,_,1,_):-!,fail. +which_missing_argnum(Q,_F,A,N):- between(A,1,N),get_assertion_head_arg(N,Q,Was),is_ftNonvar(Was). + +% File : pfcjust.pl +% Author : Tim Finin, finin@prc.unisys.com +% Author : Dave Matuszek, dave@prc.unisys.com +% Updated: +% Purpose: predicates for accessing Pfc justifications. +% Status: more or less working. +% Bugs: + +%= *** predicates for exploring supports of a fact ***** + + +:- use_module(library(lists)). + +justification(F,J) :- supports(F,J). + +justifications(F,Js) :- bagof(J,justification(F,J),Js). + + + +% % base(P,L) - is true iff L is a list of "base" facts which, taken +% % together, allows us to deduce P. A base fact is an axiom (a fact +% % added by the user or a raw Prolog fact (i.e. one w/o any support)) +% % or an assumption. + +base(F,[F]) :- (axiom(F) ; assumption(F)),!. + +base(F,L) :- + % i.e. (reduce 'append (map 'base (justification f))) + justification(F,Js), + bases(Js,L). + + +% % bases(L1,L2) is true if list L2 represents the union of all of the +% % facts on which some conclusion in list L1 is based. + +bases([],[]). +bases([X|Rest],L) :- + base(X,Bx), + bases(Rest,Br), + pfcUnion(Bx,Br,L). + +axiom(F) :- + matches_why_UU(UU), + pfcGetSupport(F,UU); + pfcGetSupport(F,(god,god)). + +% % an assumption is a failed goal, i.e. were assuming that our failure to +% % prove P is a proof of not(P) + +assumption(P) :- pfc_unnegate(P,_). + +% % assumptions(X,As) if As is a set of assumptions which underly X. + +assumptions(X,[X]) :- assumption(X). +assumptions(X,[]) :- axiom(X). +assumptions(X,L) :- + justification(X,Js), + assumptions1(Js,L). + +assumptions1([],[]). +assumptions1([X|Rest],L) :- + assumptions(X,Bx), + assumptions1(Rest,Br), + pfcUnion(Bx,Br,L). + + +% % pfcProofTree(P,T) the proof tree for P is T where a proof tree is +% % of the form +% % +% % [P , J1, J2, ;;; Jn] each Ji is an independent P justifier. +% % ^ and has the form of +% % [J11, J12,... J1n] a list of proof trees. + + +% pfcChild(P,Q) is true iff P is an immediate justifier for Q. +% mode: pfcChild(+,?) + +pfcChild(P,Q) :- + pfcGetSupport(Q,(P,_)). + +pfcChild(P,Q) :- + pfcGetSupport(Q,(_,Trig)), + pfcType(Trig,trigger(_Pos)), + pfcChild(P,Trig). + +pfcChildren(P,L) :- bagof_or_nil(C,pfcChild(P,C),L). + +% pfcDescendant(P,Q) is true iff P is a justifier for Q. + +pfcDescendant(P,Q) :- + pfcDescendant1(P,Q,[]). + +pfcDescendant1(P,Q,Seen) :- + pfcChild(X,Q), + (\+ member(X,Seen)), + (P=X ; pfcDescendant1(P,X,[X|Seen])). + +pfcDescendants(P,L) :- + bagof_or_nil(Q,pfcDescendant1(P,Q,[]),L). + + + +/* +current_why_U(U):- must_ex(current_why(Why)), U = user(Why). +current_why_UU(UU):- current_why_U(U), UU= (U,U). +matches_why_U(U):- freeze(U,U=user(_)). +matches_why_UU(UU):- matches_why_U(U1),matches_why_U(U2), freeze(UU,UU=(U1,U2)). +*/ +current_why_U(U):- get_why_uu((U,_)).% must_ex(current_why(Why)), U = user(Why). +current_why_UU(UU):- get_why_uu(UU). % current_why_U(U), UU= (U,U). +matches_why_U(U):- nop((current_why_U(Y), freeze(U,\+ \+ (U=Y;true)))). +matches_why_UU(UU):- nop(only_is_user_reason(UU)). % matches_why_U(U1),matches_why_U(U2),freeze(UU,UU=(U1,U2)). + + +matterialize_support_term(S,Sup):- term_attvars(S,Atts), Atts\==[] -> copy_term(S,_,Goals),Sup= S+Goals,!. +matterialize_support_term(SS,SS). + + + + + +:- set_prolog_flag(pfc_term_expansion,false). + +pfc_system_term_expansion(I,S0,O,S1):- %use_pfc_term_expansion, % trace, + ( \+ current_prolog_flag(pfc_term_expansion,false), + ( \+ \+ (source_location(File,_), atom_concat(_,'.pfc.pl',File)) + ; current_prolog_flag(pfc_term_expansion,true))) -> + once((prolog_load_context('term',T),nop(writeln(T)),T=@=I)) + ->(pfc_term_expansion(I,O)-> I\=@=O->S0=S1, fbugio(I-->O)). + + +:- multifile(system:term_expansion/4). +:- asserta((system:term_expansion(I,S0,O,S1):- + pfc_system_term_expansion(I,S0,O,S1))). +%:- listing(term_expansion/4). + +% :- endif. + + + +end_of_file. + + + + + + + + + + + + + + + + + + + + + +%% is_fc_body( +P) is semidet. +% +% If Is A Forward Chaining Body. +% +is_fc_body(P):- has_body_atom(fwc,P). + +%% is_bc_body( +P) is semidet. +% +% If Is A Backchaining Body. +% +is_bc_body(P):- has_body_atom(bwc,P). + +%% is_action_body( +P) is semidet. +% +% If Is A Action Body. +% +is_action_body(P):- has_body_atom(wac,P). + + + +%% has_body_atom( +WAC, ?P) is semidet. +% +% Has Body Atom. +% +has_body_atom(WAC,P):- call( + WAC==P -> true ; (is_ftCompound(P),get_assertion_head_arg(1,P,E),has_body_atom(WAC,E))),!. + +/* +has_body_atom(WAC,P,Rest):- call(WAC==P -> Rest = true ; (is_ftCompound(P),functor(P,F,A),is_atom_body_pfa(WAC,P,F,A,Rest))). +is_atom_body_pfa(WAC,P,F,2,Rest):-get_assertion_head_arg(1,P,E),E==WAC,get_assertion_head_arg(2,P,Rest),!. +is_atom_body_pfa(WAC,P,F,2,Rest):-get_assertion_head_arg(2,P,E),E==WAC,get_assertion_head_arg(1,P,Rest),!. +*/ + + +same_functors(Head1,Head2):-must_det(get_unnegated_functor(Head1,F1,A1)),must_det(get_unnegated_functor(Head2,F2,A2)),!,F1=F2,A1=A2. + +%% mpred_update_literal( +P, ?N, ?Q, ?R) is semidet. +% +% PFC Update Literal. +% +mpred_update_literal(P,N,Q,R):- + get_assertion_head_arg(N,P,UPDATE),call(replace_arg(P,N,Q_SLOT,Q)), + must_ex(call_u(Q)),update_value(Q_SLOT,UPDATE,NEW), + replace_arg(Q,N,NEW,R). + + +% '$spft'(MZ,5,5,5). + +%% update_single_valued_arg(+Module, +P, ?N) is semidet. +% +% Update Single Valued Argument. +% +:- module_transparent( (update_single_valued_arg)/3). + +update_single_valued_arg(M,M:Pred,N):-!,update_single_valued_arg(M,Pred,N). +update_single_valued_arg(_,M:Pred,N):-!,update_single_valued_arg(M,Pred,N). + +update_single_valued_arg(world,P,N):- !, current_prolog_flag(pfc_shared_module,BaseKB), update_single_valued_arg(BaseKB,P,N). +update_single_valued_arg(M,P,N):- ibreak, \+ clause_b(mtHybrid(M)), trace, clause_b(mtHybrid(M2)),!, + update_single_valued_arg(M2,P,N). + +update_single_valued_arg(M,P,N):- + get_assertion_head_arg(N,P,UPDATE), + is_relative(UPDATE),!, + dtrace, + ibreak, + replace_arg(P,N,OLD,Q), + must_det_l((clause_u(Q),update_value(OLD,UPDATE,NEW),\+ is_relative(NEW), replace_arg(Q,N,NEW,R))),!, + update_single_valued_arg(M,R,N). + + +update_single_valued_arg(M,P,N):- + call_u((must_det_l(( + + call_u(mtHybrid(M)), + mpred_type_args \= M, + mpred_kb_ops \= M, + get_assertion_head_arg(N,P,UPDATE), + replace_arg(P,N,Q_SLOT,Q), + var(Q_SLOT), + same_functors(P,Q), + % current_why(U), + must_det_l(( + % rtrace(attvar_op(assert_if_new,M:'$spft'(MZ,P,U,ax))), + % (call_u(P)->true;(assertz_mu(P))), + assertz(M:P), + doall(( + lookup_u(M:Q,E), + UPDATE \== Q_SLOT, + erase(E), + mpred_unfwc1(M:Q))))))))). + +% ======================= +% utils +% ======================= + +%% map_literals( +P, ?G) is semidet. +% +% Map Literals. +% +map_literals(P,G):-map_literals(P,G,[]). + + +%% map_literals( +VALUE1, :TermH, ?VALUE3) is semidet. +% +% Map Literals. +% +map_literals(_,H,_):-is_ftVar(H),!. % skip over it +map_literals(_,[],_) :- !. +map_literals(Pred,(H,T),S):-!, apply(Pred,[H|S]), map_literals(Pred,T,S). +map_literals(Pred,[H|T],S):-!, apply(Pred,[H|S]), map_literals(Pred,T,S). +map_literals(Pred,H,S):- mpred_literal(H),must_ex(apply(Pred,[H|S])),!. +map_literals(_Pred,H,_S):- \+ is_ftCompound(H),!. % skip over it +map_literals(Pred,H,S):-H=..List,!,map_literals(Pred,List,S),!. + + + +%% map_unless( :PRED1Test, ?Pred, ?H, ?S) is semidet. +% +% Map Unless. +% +map_unless(Test,Pred,H,S):- call(Test,H),ignore(apply(Pred,[H|S])),!. +map_unless(_Test,_,[],_) :- !. +map_unless(_Test,_Pred,H,_S):- \+ is_ftCompound(H),!. % skip over it +map_unless(Test,Pred,(H,T),S):-!, apply(Pred,[H|S]), map_unless(Test,Pred,T,S). +map_unless(Test,Pred,[H|T],S):-!, apply(Pred,[H|S]), map_unless(Test,Pred,T,S). +map_unless(Test,Pred,H,S):-H=..List,!,map_unless(Test,Pred,List,S),!. + + +:- meta_predicate(map_first_arg(*,+)). +%% map_first_arg( +Pred, ?List) is semidet. +% +% PFC Maptree. +% +map_first_arg(CMPred,List):- strip_module(CMPred,CM,Pred), map_first_arg(CM,Pred,List,[]). + +:- meta_predicate(map_first_arg(+,*,+,+)). +%% map_first_arg( +Pred, :TermH, ?S) is semidet. +% +% PFC Maptree. +% +map_first_arg(CM,Pred,H,S):-is_ftVar(H),!,CM:apply(Pred,[H|S]). +map_first_arg(_,_,[],_) :- !. +map_first_arg(CM,Pred,(H,T),S):-!, map_first_arg(CM,Pred,H,S), map_first_arg(CM,Pred,T,S). +map_first_arg(CM,Pred,(H;T),S):-!, map_first_arg(CM,Pred,H,S) ; map_first_arg(CM,Pred,T,S). +map_first_arg(CM,Pred,[H|T],S):-!, CM:apply(Pred,[H|S]), map_first_arg(CM,Pred,T,S). +map_first_arg(CM,Pred,H,S):- CM:apply(Pred,[H|S]). + +%:- fixup_exports. + +% % :- ensure_loaded(logicmoo(util/rec_lambda)). + +%example pfcVerifyMissing(mpred_isa(I,D), mpred_isa(I,C), ((mpred_isa(I,C), {D==C});-mpred_isa(I,C))). +%example pfcVerifyMissing(mudColor(I,D), mudColor(I,C), ((mudColor(I,C), {D==C});-mudColor(I,C))). + + +%% pfcVerifyMissing( +GC, ?GO, ?GO) is semidet. +% +% Prolog Forward Chaining Verify Missing. +% +pfcVerifyMissing(GC, GO, ((GO, {D==C});\+ GO) ):- GC=..[F,A|Args],append(Left,[D],Args),append(Left,[C],NewArgs),GO=..[F,A|NewArgs],!. + +%example mpred_freeLastArg(mpred_isa(I,C),~(mpred_isa(I,C))):-is_ftNonvar(C),!. +%example mpred_freeLastArg(mpred_isa(I,C),(mpred_isa(I,F),C\=F)):-!. + +%% mpred_freeLastArg( +G, ?GG) is semidet. +% +% PFC Free Last Argument. +% +mpred_freeLastArg(G,GG):- G=..[F,A|Args],append(Left,[_],Args),append(Left,[_],NewArgs),GG=..[F,A|NewArgs],!. +mpred_freeLastArg(_G,false). + + +%% mpred_current_op_support( +VALUE1) is semidet. +% +% PFC Current Oper. Support. +% +mpred_current_op_support((p,p)):-!. + + +%% pfcVersion( +VALUE1) is semidet. +% +% Prolog Forward Chaining Version. +% +%pfcVersion(6.6). + + +% % :- '$set_source_module'(mpred_kb_ops). + +%% correctify_support( +S, ?S) is semidet. +% +% Correctify Support. +% +correctify_support(U,(U,ax)):-var(U),!. +correctify_support((U,U),(U,ax)):-!. +correctify_support((S,T),(S,T)):-!. +correctify_support((U,_UU),(U,ax)):-!. +correctify_support([U],S):-correctify_support(U,S). +correctify_support(U,(U,ax)). + + +%% clause_asserted_local( :TermABOX) is semidet. +% +% Clause Asserted Local. +% +clause_asserted_local(MCL):- + must_ex(strip_mz(MCL,MZ,CL)), + must_ex(CL='$spft'(MZ,P,Fact,Trigger )),!, + clause_u('$spft'(MZ,P,Fact,Trigger),true,Ref), + clause_u('$spft'(MZ,UP,UFact,UTrigger),true,Ref), + (((UP=@=P,UFact=@=Fact,UTrigger=@=Trigger))). + + + +%% is_already_supported( +P, ?S, ?UU) is semidet. +% +% If Is A Already Supported. +% +is_already_supported(P,(S,T),(S,T)):- clause_asserted_local('$spft'(_MZ,P,S,T)),!. +is_already_supported(P,_S,UU):- clause_asserted_local('$spft'(_MZ,P,US,UT)),must_ex(get_source_uu(UU)),UU=(US,UT). + +% TOO UNSAFE +% is_already_supported(P,_S):- copy_term_and_varnames(P,PC),sp ftY(PC,_,_),P=@=PC,!. + + +if_missing1(Q):- mpred_literal_nv(Q), call_u( \+ ~ Q), if_missing_mask(Q,R,Test),!, lookup_u(R), Test. + + +mpred_run_pause:- asserta(t_l:mpred_run_paused). +mpred_run_resume:- retractall(t_l:mpred_run_paused). + +fwithout_running(G):- (t_l:mpred_run_paused->G;locally_tl(mpred_run_pause,G)). + + diff --git a/.Attic/canary_docme/metta_printer.pl b/.Attic/canary_docme/metta_printer.pl new file mode 100644 index 00000000000..74979ba1e02 --- /dev/null +++ b/.Attic/canary_docme/metta_printer.pl @@ -0,0 +1,392 @@ +:- encoding(iso_latin_1). +:- flush_output. +:- setenv('RUST_BACKTRACE',full). + +% =============================== +% PRINTERS +% =============================== +% 'ppc' and 'ppc1' rules pretty-print original terms and convert them to metta if different, +% printing the converted forms as well. +ppc(Msg,Term):- ppc1(Msg,Term), p2m(Term,MeTTa),!, (MeTTa\==Term -> ppc1(p2m(Msg),MeTTa) ; true). + +ppc1(Msg,Term):- \+ \+ ( ppct(Msg,Term) ),!. + +ppc1(Msg,Term):- \+ \+ ( ignore(guess_pretty(Term)), + writeln('---------------------'), + write(p(Msg)),write(':'),nl, + portray_clause(Term), + writeln('---------------------'), + \+ \+ (print_tree(?-show_cvts(Term))),nl, + writeln('---------------------'), + write(s(Msg)),write(':'),nl, + write_src(Term),nl). + +ppct(Msg,Term):- is_list(Term),!, + writeln('---------------------'), + numbervars(Term,666,_,[attvar(bind)]), + write((Msg)),write(':'),nl, + write_src(Term),nl. +ppct(Msg,Term):- Term=(_ :- _),!, + writeln('---------------------'), + write((Msg)),write(':'),nl, + portray_clause(Term),nl. +ppct(Msg,Term):- Term=(_=_),!, + writeln('---------------------'), + write((Msg)),write(':'),nl, + numbervars(Term,444,_,[attvar(bind)]), + write_src(Term),nl. +ppct(Msg,Term):- Term=(_ :- _),!, + writeln('---------------------'), + write((Msg)),write(':'),nl, + numbervars(Term,222,_,[attvar(bind)]), + print_tree(Term),nl. + +% 'pp_metta' rule is responsible for pretty-printing metta terms. +pp_metta(P):- pretty_numbervars(P,PP),with_option(concepts=false,pp_fb(PP)). + +string_height(Pt1,H1):- split_string(Pt1,"\r\n", "\s\t\n\n", L),length(L,H1). + +:- dynamic(just_printed/1). +% 'print_pl_source' rule is responsible for printing the source of a Prolog term. + + +print_pl_source(P):- run_pl_source(print_pl_source0(P)). + +run_pl_source(G):- catch(G,E,(fail,write_src_uo(G=E),rtrace(G))). +print_pl_source0(_):- notrace(is_compatio),!. +print_pl_source0(_):- notrace(silent_loading),!. +print_pl_source0(P):- notrace((just_printed(PP), PP=@=P)),!. + print_pl_source0((A:-B)):-!, portray_clause((A:-B)). + print_pl_source0((:-B)):-!, portray_clause((:-B)). +print_pl_source0(P):- format('~N'), print_tree(P),format('~N'),!. +print_pl_source0(P):- + Actions = [print_tree, portray_clause, pp_fb1_e], % List of actions to apply + findall(H-Pt, + (member(Action, Actions), + must_det_ll(( + run_pl_source(with_output_to(string(Pt), call(Action, P))), + catch(string_height(Pt, H),_,H=0)))), HeightsAndOutputs), + sort(HeightsAndOutputs, Lst), last(Lst, _-Pt), writeln(Pt), + retractall(just_printed(_)), + assert(just_printed(P)), + !. + + +pp_fb1_a(P):- format("~N "), \+ \+ (numbervars_w_singles(P), pp_fb1_e(P)), format("~N "),flush_output. + +pp_fb1_e(P):- pp_fb2(print_tree,P). +pp_fb1_e(P):- pp_fb2(pp_ilp,P). +pp_fb1_e(P):- pp_fb2(pp_as,P). +pp_fb1_e(P):- pp_fb2(portray_clause,P). +pp_fb1_e(P):- pp_fb2(print,P). +pp_fb1_e(P):- pp_fb2(fbdebug1,P). +pp_fb1_e(P):- pp_fb2(fmt0(P)). +pp_fb2(F,P):- atom(F),current_predicate(F/1), call(F,P). + + + +pp_sax(V) :- is_final_write(V),!. +pp_sax(S) :- \+ allow_concepts,!, write_src(S). +pp_sax(S) :- is_englishy(S),!,print_concept("StringValue",S). +pp_sax(S) :- symbol_length(S,1),symbol_string(S,SS),!,print_concept("StringValue",SS). +pp_sax(S) :- is_an_arg_type(S,T),!,print_concept("TypeNode",T). +pp_sax(S) :- has_type(S,T),!,format('(~wValueNode "~w")',[T,S]). +pp_sax(S) :- sub_atom(S,0,4,Aft,FB),flybase_identifier(FB,Type),!, + (Aft>0->format('(~wValueNode "~w")',[Type,S]);'format'('(TypeNode "~w")',[Type])). +pp_sax(S) :- print_concept("ConceptNode",S). + +%print_concept( CType,V):- allow_concepts, !, write("("),write(CType),write(" "),ignore(with_concepts(false,write_src(V))),write(")"). +print_concept(_CType,V):- ignore(write_src(V)). +write_val(V):- is_final_write(V),!. +write_val(V):- number(V),!, write_src(V). +write_val(V):- compound(V),!, write_src(V). +write_val(V):- write('"'),write(V),write('"'). + + +% Handling the final write when the value is a variable or a '$VAR' structure. +is_final_write(V):- var(V), !, write_dvar(V),!. +is_final_write('$VAR'(S)):- !, write_dvar(S),!. +is_final_write('#\\'(S)):- !, format("'~w'",[S]). +is_final_write(V):- py_is_enabled,py_is_py(V),!,py_ppp(V),!. + +is_final_write([VAR,V|T]):- '$VAR'==VAR, T==[], !, write_dvar(V). +is_final_write('[|]'):- write('Cons'),!. +is_final_write([]):- !, write('()'). +%is_final_write([]):- write('Nil'),!. + + +write_dvar(S):- S=='_', !, write_dname(S). +write_dvar(S):- S=='__', !, write('$'). +write_dvar(S):- var(S), get_var_name(S,N),write_dname(N),!. +write_dvar(S):- var(S), !, format('$~p',[S]). +write_dvar(S):- atom(S), symbol_concat('_',N,S),write_dname(N). +write_dvar(S):- string(S), symbol_concat('_',N,S),write_dname(N). +%write_dvar(S):- number(S), write_dname(S). +write_dvar(S):- write_dname(S). +write_dname(S):- write('$'),write(S). + +pp_as(V) :- \+ \+ pp_sex(V),flush_output. +pp_sex_nc(V):- with_no_quoting_symbols(true,pp_sex(V)),!. + +unlooped_fbug(Mesg):- + fbug_message_hook(fbug_message_hook,fbug(Mesg)). + +into_hyphens(D,U):- atom(D),!,always_dash_functor(D,U). +into_hyphens(D,U):- descend_and_transform(into_hyphens,D,U),!. + + +unlooped_fbug(W,Mesg):- nb_current(W,true),!, + print(Mesg),nl,bt,break. +unlooped_fbug(W,Mesg):- + setup_call_cleanup(nb_setval(W,true), + once(Mesg),nb_setval(W,false)),nb_setval(W,false). + +:- dynamic(py_is_enabled/0). +py_is_enabled:- predicate_property(py_ppp(_),defined), asserta((py_is_enabled:-!)). + +%write_src(V):- !, \+ \+ quietly(pp_sex(V)),!. +write_src(V):- \+ \+ notrace(pp_sex(V)),!. +write_src_woi_ln(X):- + format('~N'),write_src_woi(X),format('~N'). + + +pp_sex(V):- pp_sexi(V),!. +% Various 'write_src' and 'pp_sex' rules are handling the writing of the source, +% dealing with different types of values, whether they are lists, atoms, numbers, strings, compounds, or symbols. +pp_sexi(V):- is_final_write(V),!. +pp_sexi(V):- is_dict(V),!,print(V). +pp_sexi((USER:Body)) :- USER==user,!, pp_sex(Body). +pp_sexi(V):- allow_concepts,!,with_concepts('False',pp_sex(V)),flush_output. +pp_sexi('Empty') :- !. +pp_sexi('') :- !, writeq(''). +% Handling more cases for 'pp_sex', when the value is a number, a string, a symbol, or a compound. +%pp_sex('') :- format('(EmptyNode null)',[]). +pp_sexi(V):- number(V),!, writeq(V). +pp_sexi(V):- string(V),!, writeq(V). +pp_sexi(S):- string(S),!, print_concept('StringValue',S). +pp_sexi(V):- symbol(V), should_quote(V),!, symbol_string(V,S), write("'"),write(S),write("'"). +% Base case: atoms are printed as-is. +%pp_sexi(S):- symbol(S), always_dash_functor(S,D), D \=@= S, pp_sax(D),!. +pp_sexi(V):- symbol(V),!,write(V). +pp_sexi(V) :- (number(V) ; is_dict(V)), !, print_concept('ValueAtom',V). +%pp_sex((Head:-Body)) :- !, print_metta_clause0(Head,Body). +%pp_sex(''):- !, write('()'). + +% Continuing with 'pp_sex', 'write_mobj', and related rules, +% handling different cases based on the value�s type and structure, and performing the appropriate writing action. +% Lists are printed with parentheses. +pp_sexi(V) :- \+ compound(V), !, format('~p',[V]). + +%pp_sexi(V):- is_list(V),!, pp_sex_l(V). +%pp_sex(V) :- (symbol(V),symbol_number(V,N)), !, print_concept('ValueAtom',N). +%pp_sex(V) :- V = '$VAR'(_), !, format('$~p',[V]). +pp_sexi(V) :- no_src_indents,!,pp_sex_c(V). +pp_sexi(V) :- w_proper_indent(2,w_in_p(pp_sex_c(V))). + +write_mobj(H,_):- \+ symbol(H),!,fail. +write_mobj('$VAR',[S]):- write_dvar(S). +write_mobj(exec,[V]):- !, write('!'),write_src(V). +write_mobj('$OBJ',[_,S]):- write('['),write_src(S),write(' ]'). +write_mobj('{}',[S]):- write('{'),write_src(S),write(' }'). +write_mobj('{...}',[S]):- write('{'),write_src(S),write(' }'). +write_mobj('[...]',[S]):- write('['),write_src(S),write(' ]'). +write_mobj('$STRING',[S]):- !, writeq(S). +write_mobj(F,Args):- fail, mlog_sym(K),!,pp_sex_c([K,F|Args]). +%write_mobj(F,Args):- pp_sex_c([F|Args]). + +print_items_list(X):- is_list(X),!,print_list_as_sexpression(X). +print_items_list(X):- write_src(X). + +pp_sex_l(V):- pp_sexi_l(V),!. +pp_sexi_l(V) :- is_final_write(V),!. +%pp_sexi_l([F|V]):- integer(F), is_codelist([F|V]),!,format("|~s|",[[F|V]]). +pp_sexi_l([F|V]):- symbol(F), is_list(V),write_mobj(F,V),!. +pp_sexi_l([H|T]):-T ==[],!,write('('), pp_sex_nc(H),write(')'). +pp_sexi_l([H,H2]):- write('('), pp_sex_nc(H), write(' '), with_indents(false,print_list_as_sexpression([H2])), write(')'),!. +pp_sexi_l([H|T]):- write('('), + pp_sex_nc(H), write(' '), print_list_as_sexpression(T), write(')'),!. + +pp_sexi_l([H,S]):-H=='[...]', write('['),print_items_list(S),write(' ]'). +pp_sexi_l([H,S]):-H=='{...}', write('{'),print_items_list(S),write(' }'). +%pp_sex_l(X):- \+ compound(X),!,write_src(X). +%pp_sex_l('$VAR'(S))):- +pp_sexi_l([=,H,B]):- pp_sexi_hb(H,B),!. + +pp_sexi_l([H|T]) :- \+ no_src_indents, symbol(H),member(H,['If','cond','let','let*']),!, + with_indents(true,w_proper_indent(2,w_in_p(pp_sex([H|T])))). + +pp_sexi_l([H|T]) :- is_list(T), length(T,Args),Args =< 2, fail, + wots(SS,((with_indents(false,(write('('), pp_sex_nc(H), write(' '), print_list_as_sexpression(T), write(')')))))), + ((symbol_length(SS,Len),Len < 20) ->write(SS); + with_indents(true,w_proper_indent(2,w_in_p(pp_sex_c([H|T]))))),!. +/* + +pp_sexi_l([H|T]) :- is_list(T),symbol(H),upcase_atom(H,U),downcase_atom(H,U),!, + with_indents(false,(write('('), pp_sex_nc(H), write(' '), print_list_as_sexpression(T), write(')'))). + +%pp_sex([H,B,C|T]) :- T==[],!, +% with_indents(false,(write('('), pp_sex(H), print_list_as_sexpression([B,C]), write(')'))). +*/ + +pp_sexi_hb(H,B):- + write('(= '), with_indents(false,pp_sex(H)), write(' '), + ((is_list(B),maplist(is_list,B)) + ->with_indents(true,maplist(write_src_inl,B)) + ;with_indents(true,pp_sex(B))), + write(')'). + +write_src_inl(B):- nl, write(' '),pp_sex(B). + +pp_sex_c(V):- pp_sexi_c(V),!. +pp_sexi_c(V) :- is_final_write(V),!. +pp_sexi_c((USER:Body)) :- USER==user,!, pp_sex(Body). +pp_sexi_c(exec([H|T])) :- is_list(T),!,write('!'),pp_sex_l([H|T]). +pp_sexi_c(!([H|T])) :- is_list(T),!,write('!'),pp_sex_l([H|T]). +%pp_sexi_c([H|T]) :- is_list(T),!,unlooped_fbug(pp_sexi_c,pp_sex_l([H|T])). +pp_sexi_c([H|T]) :- is_list(T),!,pp_sex_l([H|T]). +%pp_sexi_c(V) :- print(V),!. + +pp_sexi_c(=(H,B)):- !, pp_sexi_hb(H,B),!. +pp_sexi_c(V):- compound_name_list(V,F,Args),write_mobj(F,Args),!. +% Compound terms. +%pp_sex(Term) :- compound(Term), Term =.. [Functor|Args], write('('),format('(~w ',[Functor]), write_args_as_sexpression(Args), write(')'). +%pp_sex(Term) :- Term =.. ['=',H|Args], length(Args,L),L>2, write('(= '), pp_sex(H), write('\n\t\t'), maplist(pp_sex(2),Args). +pp_sexi_c(V):- ( \+ compound(V) ; is_list(V)),!, pp_sex(V). +pp_sexi_c(listOf(S,_)) :- !,write_mobj(listOf(S)). +pp_sexi_c(listOf(S)) :- !,format('(ListValue ~@)',[pp_sex(S)]). +pp_sexi_c('!'(V)) :- write('!'),!,pp_sex(V). +%pp_sex_c('exec'(V)) :- write('!'),!,pp_sex(V). +pp_sexi_c('='(N,V)):- allow_concepts, !, format("~N;; ~w == ~n",[N]),!,pp_sex(V). +%pp_sex_c(V):- writeq(V). + +pp_sexi_c(Term) :- compound_name_arity(Term,F,0),!,pp_sex_c([F]). +pp_sexi_c(Term) :- Term =.. [Functor|Args], always_dash_functor(Functor,DFunctor), format('(~w ',[DFunctor]), write_args_as_sexpression(Args), write(')'),!. +pp_sexi_c(Term) :- allow_concepts, Term =.. [Functor|Args], format('(EvaluationLink (PredicateNode "~w") (ListLink ',[Functor]), write_args_as_sexpression(Args), write('))'),!. +pp_sexi_c(Term) :- + Term =.. [Functor|Args], + always_dash_functor(Functor,DFunctor), format('(~w ',[DFunctor]), + write_args_as_sexpression(Args), write(')'),!. + +pp_sexi(2,Result):- write('\t\t'),pp_sex(Result). + + +current_column(Column) :- current_output(Stream), line_position(Stream, Column),!. +current_column(Column) :- stream_property(current_output, position(Position)), stream_position_data(column, Position, Column). +min_indent(Sz):- current_column(Col),Col>Sz,nl,indent_len(Sz). +min_indent(Sz):- current_column(Col),Need is Sz-Col,indent_len(Need),!. +min_indent(Sz):- nl, indent_len(Sz). +indent_len(Need):- forall(between(1,Need,_),write(' ')). + +w_proper_indent(N,G):- + flag(w_in_p,X,X), %(X==0->nl;true), + XX is (X*2)+N,setup_call_cleanup(min_indent(XX),G,true). +w_in_p(G):- setup_call_cleanup(flag(w_in_p,X,X+1),G,flag(w_in_p,_,X)). + + +always_dash_functor(A,B):- once(dash_functor(A,B)),A\=@=B,!. +always_dash_functor(A,A). + + +dash_functor(A,C):- \+ symbol(A),!,C=A. +% dash_functor(A,C):- p2m(A,B),A\==B,!,always_dash_functor(B,C). +dash_functor(ASymbolProc,O):- fail, symbol_contains(ASymbolProc,'_'), + symbol_contains(ASymbolProc,'atom'), + current_predicate(system:ASymbolProc/_), + symbolic_list_concat(LS,'atom',ASymbolProc), + symbolic_list_concat(LS,'symbol',SymbolProc), + always_dash_functor(SymbolProc,O),!. +dash_functor(ASymbolProc,O):- symbol_concat('$',LS,ASymbolProc),!, + symbol_concat('%',LS,SymbolProc), + always_dash_functor(SymbolProc,O). + +dash_functor(Functor,DFunctor):- fail, + symbolic_list_concat(L,'_',Functor), L\=[_], + symbolic_list_concat(L,'-',DFunctor). + +% Print arguments of a compound term. +write_args_as_sexpression([]). +write_args_as_sexpression([H|T]) :- write(' '), pp_sex(H), write_args_as_sexpression(T). + +% Print the rest of the list. +print_list_as_sexpression([]). +print_list_as_sexpression([H]):- pp_sex(H). +%print_list_as_sexpression([H]):- w_proper_indent(pp_sex(H)),!. +print_list_as_sexpression([H|T]):- pp_sex(H), write(' '), print_list_as_sexpression(T). + + + +% The predicate with_indents/2 modifies the src_indents option value during the execution of a goal. +% The first argument is the desired value for src_indents, +% and the second argument is the Goal to be executed with the given src_indents setting. +with_indents(TF, Goal) :- + % Set the value of the `src_indents` option to TF and then execute the Goal + as_tf(TF,Value), + with_option(src_indents, Value, Goal). + +no_src_indents:- option_else(src_indents,TF,true),!,TF=='False'. + +no_quoting_symbols:- option_else(no_quoting_symbols,TF,true),!,TF=='True'. + +with_no_quoting_symbols(TF, Goal) :- + % Set the value of the `no_src_indents` option to TF and then execute the Goal + with_option(no_quoting_symbols, TF, Goal). + +% The predicate allow_concepts/0 checks whether the use of concepts is allowed. +% It does this by checking the value of the concepts option and ensuring it is not false. +allow_concepts :- !, fail, + % Check if the option `concepts` is not set to false + option_else(concepts, TF, 'False'), + \+ TF == 'False'. + +% The predicate with_concepts/2 enables or disables the use of concepts during the execution of a given goal. +% The first argument is a Boolean indicating whether to enable (true) or disable (false) concepts. +% The second argument is the Goal to be executed with the given concepts setting. +with_concepts(TF, Goal) :- + % Set the value of the `concepts` option to TF and then execute the Goal + with_option(concepts, TF, Goal). + +% Rules for determining when a symbol needs to be quoted in metta. +dont_quote(Atom):- symbol_length(Atom,1), !, char_type(Atom,punct). +dont_quote(Atom):- symbol(Atom),upcase_atom(Atom,Atom),downcase_atom(Atom,Atom). + +should_quote(Atom) :- \+ symbol(Atom), \+ string(Atom),!,fail. +should_quote(Atom) :- + \+ dont_quote(Atom), + % symbol(Atom), % Ensure that the input is an symbol + symbol_chars(Atom, Chars), + once(should_quote_chars(Chars);should_quote_symbol_chars(Atom,Chars)). + +contains_unescaped_quote(['"']):- !, fail. % End with a quote +contains_unescaped_quote(['"'|_]) :- !. +contains_unescaped_quote(['\\', '"'|T]) :- !, contains_unescaped_quote(T). +contains_unescaped_quote([_|T]) :- contains_unescaped_quote(T). + +% Check if the list of characters should be quoted based on various conditions +should_quote_chars([]). +should_quote_chars(['"'|Chars]):- !, contains_unescaped_quote(Chars). +should_quote_chars(Chars) :- + member('"', Chars); % Contains quote not captured with above clause + member(' ', Chars); % Contains space + member('''', Chars); % Contains single quote + % member('/', Chars); % Contains slash + member(',', Chars); % Contains comma + (fail,member('|', Chars)). % Contains pipe +%should_quote_symbol_chars(Atom,_) :- symbol_number(Atom,_),!. +should_quote_symbol_chars(Atom,[Digit|_]) :- fail, char_type(Digit, digit), \+ symbol_number(Atom,_). + +% Example usage: +% ?- should_quote('123abc'). +% true. +% ?- should_quote('123.456'). +% false. + + +:- ensure_loaded(metta_interp). +:- ensure_loaded(metta_compiler). +:- ensure_loaded(metta_convert). +:- ensure_loaded(metta_types). +:- ensure_loaded(metta_space). +:- ensure_loaded(metta_testing). +:- ensure_loaded(metta_utils). +:- ensure_loaded(metta_printer). +:- ensure_loaded(metta_eval). diff --git a/.Attic/canary_docme/metta_python.pl b/.Attic/canary_docme/metta_python.pl new file mode 100644 index 00000000000..fb3d70563f7 --- /dev/null +++ b/.Attic/canary_docme/metta_python.pl @@ -0,0 +1,1039 @@ +/* + * Project: MeTTaLog - A MeTTa to Prolog Transpiler/Interpreter + * Description: This file is part of the source code for a transpiler designed to convert + * MeTTa language programs into Prolog, utilizing the SWI-Prolog compiler for + * optimizing and transforming function/logic programs. It handles different + * logical constructs and performs conversions between functions and predicates. + * + * Author: Douglas R. Miles + * Contact: logicmoo@gmail.com / dmiles@logicmoo.org + * License: LGPL + * Repository: https://github.com/trueagi-io/metta-wam + * https://github.com/logicmoo/hyperon-wam + * Created Date: 8/23/2023 + * Last Modified: $LastChangedDate$ # You will replace this with Git automation + * + * Usage: This file is a part of the transpiler that transforms MeTTa programs into Prolog. For details + * on how to contribute or use this project, please refer to the repository README or the project documentation. + * + * Contribution: Contributions are welcome! For contributing guidelines, please check the CONTRIBUTING.md + * file in the repository. + * + * Notes: + * - Ensure you have SWI-Prolog installed and properly configured to use this transpiler. + * - This project is under active development, and we welcome feedback and contributions. + * + * Acknowledgments: Special thanks to all contributors and the open source community for their support and contributions. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the + * distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS + * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT + * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS + * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE + * COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, + * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; + * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER + * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN + * ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + * POSSIBILITY OF SUCH DAMAGE. + */ + +:- encoding(iso_latin_1). +:- flush_output. +:- setenv('RUST_BACKTRACE',full). +%:- '$set_source_module'('user'). +:- set_prolog_flag(py_backtrace_depth,10). +:- set_prolog_flag(py_backtrace, true). +:- set_prolog_flag(py_argv,[]). +%:- set_prolog_flag(argv,[]). +/* +# Core in Rust +In the original version, the core logic and functionalities of the MeTTa system are implemented in Rust. Rust is known for its performance and safety features, making it a suitable choice for building robust, high-performance systems. + +# Python Extensions +Python is used to extend or customize MeTTa. Typically, Python interacts with the Rust core through a Foreign Function Interface (FFI) or similar bridging mechanisms. This allows Python programmers to write code that can interact with the lower-level Rust code, while taking advantage of Python's ease of use and rich ecosystem. + +# Prolog Allows Python Extensions +Just like the Rust core allowed for Python extensions, the Prolog code also permits Python and Rust developers (thru python right now) to extend or customize parts of MeTTa. This maintains the system?s extensibility and allows users who are more comfortable with Python to continue working with the system effectively. + +*/ +:- use_module(library(filesex)). + +:- + (module_property(janus,file(File))-> + janus:ensure_loaded(File); + (exists_file('/usr/local/lib/swipl/library/ext/swipy/janus.pl') + -> janus:ensure_loaded('/usr/local/lib/swipl/library/ext/swipy/janus.pl') + ; janus:ensure_loaded(library(janus)))). + +:- multifile(is_python_space/1). +:- dynamic(is_python_space/1). +:- volatile(is_python_space/1). + +is_rust_space(GSpace):- is_python_space(GSpace). + +is_not_prolog_space(GSpace):- is_rust_space(GSpace), !. +is_not_prolog_space(GSpace):- \+ is_asserted_space(GSpace), \+ is_nb_space(GSpace), !. + +with_safe_argv(Goal):- + current_prolog_flag(argv,Was), + setup_call_cleanup(set_prolog_flag(argv,[]), + py_catch(Goal), + set_prolog_flag(argv,Was)). +with_safe_argv(G1,G2):- with_safe_argv((G1,G2)). +py_catch((G1,G2)):-!,py_catch(G1),py_catch(G2). +py_catch(Goal):- catch(Goal,E,(pybug(E=py_catch(Goal)),py_dump,trace,Goal)). +%py_catch(Goal):- trace,catch(Goal,E,(pybug(E),py_dump)),!. +py_dump:- py_call(traceback:print_exc()). + +py_call_c(G):- py_catch(py_call(G)). +py_call_c(G,R):- py_catch(py_call(G,R)). + +py_is_module(M):-notrace((with_safe_argv(py_is_module_unsafe(M)))). + +py_is_module_unsafe(M):- py_is_object(M),!,py_type(M,module). +py_is_module_unsafe(M):- catch((py_call(M,X),py_type(X,module)),_,fail). + +%py_is_py(_):- \+ py_is_enabled, !, fail. +py_is_py(V):- var(V),!, get_attr(V,pyobj,_),!. +py_is_py(V):- compound(V),!,fail. +py_is_py(V):- is_list(V),!,fail. +py_is_py(V):- atomic(V), !, \+ atom(V), py_is_object(V),!. +py_is_py(V):- \+ callable(V),!,fail. +py_is_py(V):- py_is_tuple(V),!. +py_is_py(V):- py_is_py_dict(V),!. +py_is_py(V):- py_is_list(V),!. + +py_resolve(V,Py):- var(V),!, get_attr(V,pyobj,Py),!. +py_resolve(V,Py):- \+ compound(V),!,py_is_object(V),Py=V. +py_resolve(V,Py):- is_list(V),!,fail,maplist(py_resolve,V,Py). +py_resolve(V,Py):- V=Py. + +py_is_tuple(X):- py_resolve(X,V), py_tuple(V,T),py_tuple(T,TT),T==TT, \+ py_type(V,str). +py_is_py_dict(X):- atomic(X),py_is_object(X),py_type(X,dict). +%py_is_py_dict(X):- py_resolve(X,V), py_dict(V,T), py_dict(T,TT), T==TT. +py_is_list(X):- py_resolve(X,V), py_type(V,list). +%py_is_list(V):- py_is_tuple(V). + +% Evaluations and Iterations +:- thread_local(did_load_builtin_module/0). +:- volatile(did_load_builtin_module/0). +:- dynamic(did_load_builtin_module/0). +load_builtin_module:- did_load_builtin_module,!. +load_builtin_module:- assert(did_load_builtin_module), +py_module(builtin_module, +' +import sys +#import numpy + +the_modules_and_globals=None + +def eval_string(s): + global the_modules_and_globals + global_vars = the_modules_and_globals + local_vars = locals() + return eval(s,global_vars,local_vars) + +def exec_string(s): + global the_modules_and_globals + global_vars = the_modules_and_globals + local_vars = locals() + return exec(s,global_vars,local_vars) + +def py_nth(s,nth): + return s[nth] + +def identity(s): + return s + +def get_globals(): + return globals() + +def merge_modules_and_globals(): + # Get all currently loaded modules + loaded_modules = sys.modules + + # Get all global variables + global_vars = globals() + + # Prepare a combined dictionary + global the_modules_and_globals + combined_dict = the_modules_and_globals + if combined_dict is None: + combined_dict = {} + + # Add modules with a prefix or special key to distinguish them + for mod_name, mod_obj in loaded_modules.items(): + combined_dict[f"module_{mod_name}"] = mod_obj + combined_dict[f"{mod_name}"] = mod_obj + + # Add global variables with a prefix or special key + for var_name, var_value in global_vars.items(): + combined_dict[f"global_{var_name}"] = var_value + combined_dict[f"{var_name}"] = var_value + + the_modules_and_globals = combined_dict + return combined_dict + +def get_locals(): + return locals() + +def iter_collection(s): + return iter(s) + +def string_conversion(s): + return str(s) + +def string_representation(s): + return repr(s) + +def py_len(s): + return len(s) + +def py_list(s): + return list(s) + +def py_dict(s): + return dict(s) + +def py_dict0(): + return dict() + +def py_map(s): + return map(s) + +def py_tuple(s): + return tuple(s) + +def py_set(s): + return set(s) + +def absolute_value(num): + return abs(num) + +def all_true(iterable): + return all(iterable) + +def any_true(iterable): + return any(iterable) + +def as_ascii(s): + return ascii(s) + +def binary_conversion(num): + return bin(num) + +def boolean_conversion(val): + return bool(val) + +def chr_conversion(num): + return chr(num) + +def hexadecimal_conversion(num): + return hex(num) + +def octal_conversion(num): + return oct(num) + +# Arithmetic and Conversion +def int_conversion(s): + return int(s) + +def float_conversion(s): + return float(s) + +def complex_conversion(real, imag=0): + return complex(real, imag) + +def divmod_func(a, b): + return divmod(a, b) + +def pow_func(base, exp): + return pow(base, exp) + +# Collection Handling +def sorted_iterable(iterable, key=None, reverse=False): + return sorted(iterable, key=key, reverse=reverse) + +def sum_iterable(iterable, start=0): + return sum(iterable, start) + +def min_value(*args, key=None): + return min(*args, key=key) + +def max_value(*args, key=None): + return max(*args, key=key) + +# Type and Attribute Handling +def type_of(obj): + return type(obj) + +def isinstance_of(obj, classinfo): + return isinstance(obj, classinfo) + +def print_nonl(sub): + return print(sub, end="") + +def issubclass_of(sub, superclass): + return issubclass(sub, superclass) + +def getattr_func(obj, name, default=None): + return getattr(obj, name, default) + +def setattr_func(obj, name, value): + setattr(obj, name, value) + +def hasattr_func(obj, name): + return hasattr(obj, name) + +# File and I/O +def open_file(filename, mode="r", buffering=-1): + return open(filename, mode, buffering) + +# Exception Handling +def raise_exception(exctype, msg=None): + if msg: + raise exctype(msg) + else: + raise exctype() + +# Miscellaneous +def callable_check(obj): + return callable(obj) + +def id_func(obj): + return id(obj) + +def help_func(obj): + help(obj) # This will print the help to the standard output + +import inspect + +def get_str_rep(func): + if not inspect.isfunction(func): + return func + if func.__module__ == "__main__": + return func.__name__ + return f"{func.__module__}.{func.__name__}" + +the_modules_and_globals = merge_modules_and_globals() + +'). + +pych_chars(Chars,P):- \+ is_list(Chars), !, P = Chars. +pych_chars(Chars,P):- append(O,`\r@(none)`,Chars),!,pych_chars(O,P). +pych_chars(Chars,P):- append(O,`\n@(none)`,Chars),!,pych_chars(O,P). +pych_chars(Chars,P):- append(O,`@(none)`,Chars),!,pych_chars(O,P). +pych_chars(Chars,P):- append(O,[WS],Chars),code_type(WS,new_line),!,pych_chars(O,P). +pych_chars(Chars,P):- append(O,[WS],Chars),code_type(WS,end_of_line),!,pych_chars(O,P). +pych_chars(P,P). + + +py_ppp(V):-flush_output, with_output_to(codes(Chars), once(py_pp(V))), + pych_chars(Chars,P),!,format('~s',[P]),!,flush_output. + +%atom_codes(Codes,P),writeq(Codes), +%py_ppp(V):- !, flush_output, py_mbi(print_nonl(V),_),!,flush_output. +%py_ppp(V):- writeq(py(V)),!. +%py_ppp(V):-once((py_is_object(V),py_to_pl(V,PL))),V\=@=PL,!,print(PL). +%py_ppp(V):-metta_py_pp(V). + +% Evaluations and Iterations +:- thread_local(did_load_hyperon_module/0). +:- volatile(did_load_hyperon_module/0). +:- dynamic(did_load_hyperon_module/0). +load_hyperon_module:- did_load_hyperon_module,!. +load_hyperon_module:- assert(did_load_hyperon_module), + py_module(hyperon_module,' + +from hyperon.base import Atom +from hyperon.atoms import OperationAtom, E, GroundedAtom, GroundedObject +from hyperon.ext import register_tokens +from hyperon.ext import register_atoms +from hyperon.atoms import G, AtomType +from hyperon.runner import MeTTa +from hyperon.atoms import * +import hyperonpy as hp + +import sys +import readline +import os +import atexit + +class MeTTaVS(MeTTa): + def copy(self): + return self + +runner = MeTTaVS() + +def rust_metta_run(obj): + return runner.run(obj) + +def rust_unwrap(obj): + if isinstance(obj,SymbolAtom): + return obj.get_name() + if isinstance(obj,ExpressionAtom): + return obj.get_children() + if isinstance(obj,GroundedAtom): + return obj.get_object() + if isinstance(obj,GroundedObject): + return obj.content + return obj + +def rust_deref(obj): + while True: + undone = rust_unwrap(obj) + if undone is obj: return obj + if undone is None: return obj + obj = undone + +'). + + +py_mcall(I,O):- catch(py_call(I,M,[py_object(false),py_string_as(string),py_dict_as({})]),error(_,_),fail),!,O=M. +py_scall(I,O):- catch(py_call(I,M,[py_string_as(string)]),error(_,_),fail),!,O=M. +py_acall(I,O):- catch(py_call(I,M,[py_string_as(atom)]),error(_,_),fail),!,O=M. +py_ocall(I,O):- catch(py_call(I,M,[py_object(true),py_string_as(string)]),error(_,_),fail),!,O=M. + + +py_bi(I,O,Opts):- load_builtin_module,catch(py_call(builtin_module:I,M,Opts),error(_,_),fail),!,O=M. +py_obi(I,O):- load_builtin_module,py_ocall(builtin_module:I,O). +py_mbi(I,O):- load_builtin_module,py_mcall(builtin_module:I,O). +%?- py_call(type(hi-there), P),py_pp(P). +get_str_rep(I,O):- py_mbi(get_str_rep(I),O),!. + +py_atom(I,O):- var(I),!,O=I. +py_atom([I|Is],O):-!, py_dot(I,II),py_dot_from(II,Is,O),!. +py_atom(I,O):- atomic(I),!,py_atomic(I,O). +py_atom(I,O):- py_ocall(I,O),!. +py_atom(I,O):- I=O. + +py_atom_type(I,_Type,O):- var(I),!,O=I. +py_atom_type([I|Is],_Type,O):-!, py_dot(I,II),py_dot_from(II,Is,O). +py_atom_type(I,_Type,O):- atomic(I),!,py_atomic(I,O). +py_atom_type(I,_Type,O):- py_ocall(I,O),!. +py_atom_type(I,_Type,O):- I=O. + +py_atomic([],O):-py_ocall("[]",O),!. +py_atomic(I,O):- py_is_object(I),!,O=I. +py_atomic(I,O):- string(I),py_eval(I,O),!. +py_atomic(I,O):- py_ocall(I,O),!. +py_atomic(I,O):- py_eval(I,O),!. +py_atomic(I,O):- \+ symbol_contains(I,'('),atomic_list_concat([A,B|C],'.',I),py_dot([A,B|C],O),!. +py_atomic(I,O):- string(I), py_dot(I,O),!. +py_atomic(I,O):- I=O. + +get_globals(O):- py_mbi(get_globals(),O). +get_locals(O):- py_mbi(get_locals(),O). +merge_modules_and_globals(O):- py_mbi(merge_modules_and_globals(),O). +py_eval(I,O):- py_obi(eval_string(I),O). +py_eval(I):- py_eval(I,O),pybug(O). +py_exec(I,O):- py_mbi(exec_string(I),O). +py_exec(I):- py_exec(I,O),pybug(O). + +py_dot(I,O):- string(I),atom_string(A,I),py_atom(A,O),A\==O,!. +py_dot(I,O):- py_atom(I,O). + +py_dot_from(From,I,O):- I==[],!,O=From. +py_dot_from(From,[I|Is],O):- !, py_dot_from(From,I,M),py_dot_from(M,Is,O). +py_dot_from(From,I,O):- atomic_list_concat([A,B|C],'.',I),!,py_dot_from(From,[A,B|C],O). +py_dot_from(From,I,O):- py_dot(From,I,O). + +py_eval_object(Var,VO):- var(Var),!,VO=Var. +py_eval_object([V|VI],VO):- py_is_function(V),!,py_eval_from(V,VI,VO). +py_eval_object([V|VI],VO):- maplist(py_eval_object,[V|VI],VO). +py_eval_object(VO,VO). + +py_is_function(O):- \+ py_is_object(O),!,fail. +py_is_function(O):- py_type(O, function),!. +%py_is_function(O):- py_type(O, method),!. + +py_eval_from(From,I,O):- I==[],!,py_dot(From,O). +py_eval_from(From,[I],O):- !, py_fcall(From,I,O). +py_eval_from(From,[I|Is],O):- !, py_dot_from(From,I,M),py_eval_from(M,Is,O). +py_eval_from(From,I,O):- atomic_list_concat([A,B|C],'.',I),!,py_eval_from(From,[A,B|C],O). +py_eval_from(From,I,O):- py_fcall(From,I,O). + +py_fcall(From,I,O):- py_ocall(From:I,O). + +ensure_space_py(Space,GSpace):- py_is_object(Space),!,GSpace=Space. +ensure_space_py(Space,GSpace):- var(Space),ensure_primary_metta_space(GSpace), Space=GSpace. +ensure_space_py(metta_self,GSpace):- ensure_primary_metta_space(GSpace),!. + +:- dynamic(is_metta/1). +:- volatile(is_metta/1). +ensure_rust_metta(MeTTa):- is_metta(MeTTa),py_is_object(MeTTa),!. +ensure_rust_metta(MeTTa):- with_safe_argv(ensure_rust_metta0(MeTTa)),asserta(is_metta(MeTTa)). + +ensure_rust_metta0(MeTTa):- ensure_mettalog_py(MettaLearner), py_call(MettaLearner:'get_metta'(),MeTTa), + py_is_object(MeTTa). +ensure_rust_metta0(MeTTa):- py_call('mettalog':'MeTTaLog'(),MeTTa). +ensure_rust_metta0(MeTTa):- py_call(hyperon:runner:'MeTTa'(),MeTTa),!. + +ensure_rust_metta:- ensure_rust_metta(_). + +:- dynamic(is_mettalog/1). +:- volatile(is_mettalog/1). +ensure_mettalog_py(MettaLearner):- is_mettalog(MettaLearner),!. +ensure_mettalog_py(MettaLearner):- + with_safe_argv( + (want_py_lib_dir, + %py_call('mettalog',MettaLearner), + %py_call('motto',_), + %py_call('motto.sparql_gate':'sql_space_atoms'(),Res1),pybug(Res1), + %py_call('motto.llm_gate':'llmgate_atoms'(MeTTa),Res2),pybug(Res2), + + pybug(is_mettalog(MettaLearner)), + asserta(is_mettalog(MettaLearner)))). + +ensure_mettalog_py:- + %load_builtin_module, + %load_hyperon_module, + setenv('VSPACE_VERBOSE',0), + with_safe_argv(ensure_mettalog_py(_)),!. + + + +:- multifile(space_type_method/3). +:- dynamic(space_type_method/3). +space_type_method(is_not_prolog_space,new_space,new_rust_space). +space_type_method(is_not_prolog_space,add_atom,add_to_space). +space_type_method(is_not_prolog_space,remove_atom,remove_from_space). +space_type_method(is_not_prolog_space,replace_atom,replace_in_space). +space_type_method(is_not_prolog_space,atom_count,atom_count_from_space). +space_type_method(is_not_prolog_space,get_atoms,query_from_space). +space_type_method(is_not_prolog_space,atom_iter,atoms_iter_from_space). +space_type_method(is_not_prolog_space,query,query_from_space). + +:- dynamic(is_primary_metta_space/1). +:- volatile(is_primary_metta_space/1). +% Initialize a new hyperon.base.GroundingSpace and get a reference +ensure_primary_metta_space(GSpace) :- is_primary_metta_space(GSpace),!. +ensure_primary_metta_space(GSpace) :- ensure_rust_metta(MeTTa), + with_safe_argv(py_call(MeTTa:space(),GSpace)), + asserta(is_primary_metta_space(GSpace)). +ensure_primary_metta_space(GSpace) :- new_rust_space(GSpace). +ensure_primary_metta_space:- ensure_primary_metta_space(_). + +:- if( \+ current_predicate(new_rust_space/1 )). +% Initialize a new hyperon.base.GroundingSpace and get a reference +new_rust_space(GSpace) :- + with_safe_argv(py_call(hyperon:base:'GroundingSpace'(), GSpace)), + asserta(is_python_space(GSpace)). +:- endif. + +:- if( \+ current_predicate(query_from_space/3 )). +% Query from hyperon.base.GroundingSpace +query_from_space(Space, QueryAtom, Result) :- + ensure_space(Space,GSpace), + py_call(GSpace:'query'(QueryAtom), Result). + + +% Replace an atom in hyperon.base.GroundingSpace +replace_in_space(Space, FromAtom, ToAtom) :- + ensure_space(Space,GSpace), + py_call(GSpace:'replace'(FromAtom, ToAtom), _). + +% Get the atom count from hyperon.base.GroundingSpace +atom_count_from_space(Space, Count) :- + ensure_space(Space,GSpace), + py_call(GSpace:'atom_count'(), Count). + +% Get the atoms from hyperon.base.GroundingSpace +atoms_from_space(Space, Atoms) :- + ensure_space(Space,GSpace), + py_call(GSpace:'get_atoms'(), Atoms). + +atom_from_space(Space, Sym):- + atoms_iter_from_space(Space, Atoms),elements(Atoms,Sym). + +% Get the atom iterator from hyperon.base.GroundingSpace +atoms_iter_from_space(Space, Atoms) :- + ensure_space(Space,GSpace), + with_safe_argv(py_call(src:'mettalog':get_atoms_iter_from_space(GSpace),Atoms)), + %py_call(GSpace:'atoms_iter'(), Atoms). + true. +:- endif. + +metta_py_pp(V):- py_is_enabled,once((py_is_object(V),py_to_pl(V,PL))),V\=@=PL,!,metta_py_pp(PL). +metta_py_pp(V):- atomic(V),py_is_enabled,py_is_object(V),py_pp(V),!. +metta_py_pp(V):- format('~p',[V]),!. + +% py_to_pl/2 - Converts a Python object to a Prolog term. +py_to_pl(I,O):- py_to_pl(_,I,O). + +% py_to_pl/3 - Calls py_to_pl/6 with initial parameters. +py_to_pl(VL,I,O):- ignore(VL=[vars]), py_to_pl(VL,[],[],_,I,O),!. + +% is_var_or_nil/1 - Checks if the input is a variable or an empty list. +is_var_or_nil(I):- var(I),!. +is_var_or_nil([]). + +% py_to_pl/6 - Main conversion predicate. +% print what we are doing +%py_to_pl(VL,Par,_Cir,_,L,_):- pybug(py_to_pl(VL,Par,L)),fail. +% If L is a variable, E is unified with L. +py_to_pl(_VL,_Par,Cir,Cir,L,E):- var(L),!,E=L. +% If L is an empty list, unify E with L. +py_to_pl(_VL,_Par,Cir,Cir,L,E):- L ==[],!,E=L. + +% If O is an object, convert it to Prolog. +py_to_pl(VL, Par, Cir, CirO, O, E) :- py_is_object(O), py_class(O, Cl), !, + pyo_to_pl(VL, Par, [O = E | Cir], CirO, Cl, O, E). +% If L is in the Cir list, unify E with L. + +%py_to_pl(_VL,_Par,Cir,Cir,L,E):- py_is_dict(L),!,py_mbi(identity(L),E). +py_to_pl(_VL,_Par,Cir,Cir,L,E):- member(N-NE,Cir), N==L, !, (E=L;NE=E), !. +% If LORV is a variable or nil, unify it directly. +py_to_pl(_VL,_Par,Cir,Cir, LORV:B,LORV:B):- is_var_or_nil(LORV), !. +py_to_pl(_VL,_Par,Cir,Cir, LORV:_B:_C,LORV):- is_var_or_nil(LORV), !. +% If L is not callable, unify E with L. +py_to_pl(_VL,_Par,Cir,Cir,L,E):- \+ callable(L),!,E=L. +% Convert lists with annotations. +py_to_pl(VL, Par, Cir, CirO, [H|T]:B:C, [HH|TT]) :- + py_to_pl(VL, Par, Cir, CirM, H:B:C, HH), + py_to_pl(VL, Par, CirM, CirO, T:B:C, TT),!. +py_to_pl(VL, Par, Cir, CirO, [H|T]:B, [HH|TT]) :- + py_to_pl(VL, Par, Cir, CirM, H:B, HH), + py_to_pl(VL, Par, CirM, CirO, T:B, TT). +% Handle objects with callable methods. +py_to_pl(VL, Par, Cir, CirO, A:B:C, AB) :- + py_is_object(A), + callable(B), + py_call(A:B, R), + py_to_pl(VL, Par, Cir, CirO, R:C, AB). +py_to_pl(VL, Par, Cir, CirO, A:B, AB) :- + py_is_object(A), + callable(B), + py_call(A:B, R), + py_to_pl(VL, Par, Cir, CirO, R, AB). + +% Convert compound terms. +py_to_pl(VL, Par, Cir, CirO, A:B, AA:BB) :- !, + py_to_pl(VL, Par, Cir, CirM, A, AA), + py_to_pl(VL, Par, CirM, CirO, B, BB). +py_to_pl(VL, Par, Cir, CirO, A-B, AA-BB) :- !, + py_to_pl(VL, Par, Cir, CirM, A, AA), + py_to_pl(VL, Par, CirM, CirO, B, BB). + +py_to_pl(_VL,_Par,Cir,Cir,L,E):- \+ callable(L),!,E=L. + +% If L is an atom, unify E with L. +py_to_pl(_VL,_Par,Cir,Cir,L,E):- atom(L),!,E=L. + +% Convert lists. +py_to_pl(VL, Par, Cir, CirO, [H|T], [HH|TT]) :- !, + py_to_pl(VL, Par, Cir, CirM, H, HH), + py_to_pl(VL, Par, CirM, CirO, T, TT). + +% Handle dictionaries. +py_to_pl(VL, Par, Cir, CirO, L, E) :- is_dict(L, F), !, + dict_pairs(L, F, NV), !, + py_to_pl(VL, Par, Cir, CirO, NV, NVL), + dict_pairs(E, F, NVL). + +% If L is not callable, unify E with L. +py_to_pl(_VL,_Par,Cir,Cir,L,E):- \+ callable(L),!,E=L. +%py_to_pl(VL,Par,Cir,CirO,A:B:C,AB):- py_is_object(A),callable(B),py_call(A:B,R),!, py_to_pl(VL,Par,[A:B-AB|Cir],CirO,R:C,AB). +%py_to_pl(VL,Par,Cir,CirO,A:B,AB):- py_is_object(A),callable(B),py_call(A:B,R),!, py_to_pl(VL,Par,[A:B-AB|Cir],CirO,R,AB). + +% Convert compound terms using compound_name_arguments/3. +py_to_pl(VL, Par, Cir, CirO, A, AA) :- compound(A), !, + compound_name_arguments(A, F, L), + py_to_pl(VL, Par, Cir, CirO, L, LL), + compound_name_arguments(AA, F, LL). + +% Default case: unify E with E. +py_to_pl(_VL,_Par,Cir,Cir,E,E). +/* +varname_to_real_var(RL,E):- upcase_atom(RL,R),varname_to_real_var0(R,E). +varname_to_real_var0(R,E):- nb_current('cvariable_names',VL),!,varname_to_real_var0(R,VL,E). +varname_to_real_var0(R,E):- nb_setval('cvariable_names',[R=v(_)]),!,varname_to_real_var0(R,E). +varname_to_real_var0(R,[],E):- nb_setval('cvariable_names',[R=v(_)]),!,varname_to_real_var0(R,E). +varname_to_real_var0(R,VL,E):- member(N=V,VL), N==R,!,arg(1,V,E). +varname_to_real_var0(R,VL,E):- extend_container(VL,R=v(_)),varname_to_real_var0(R,E).*/ +% Predicate to extend the list inside the container +extend_container(Container, Element) :- + arg(2, Container, List), + nb_setarg(2, Container, [Element|List]). + +rinto_varname(R,RN):- atom_number(R,N),atom_concat('Num',N,RN). +rinto_varname(R,RN):- upcase_atom(R,RN). +real_VL_var(RL,VL,E):- nonvar(RL), !, rinto_varname(RL,R),!,real_VL_var0(R,VL,E). +real_VL_var(RL,VL,E):- member(N=V,VL), V==E,!,RL=N. +real_VL_var(RL,VL,E):- compound(E),E='$VAR'(RL),ignore(real_VL_var0(RL,VL,E)),!. +real_VL_var(RL,VL,E):- format(atom(RL),'~p',[E]), member(N=V,VL), N==RL,!,V=E. +real_VL_var(RL,VL,E):- format(atom(RL),'~p',[E]), real_VL_var0(RL,VL,E). +real_VL_var0(R,VL,E):- member(N=V,VL), N==R,!,V=E. +real_VL_var0(R,VL,E):- extend_container(VL,R=E),!. % ,E='$VAR'(R). + +pyo_to_pl(VL,_Par,Cir,Cir,Cl,O,E):- Cl=='VariableAtom', !, py_call(O:get_name(),R), real_VL_var(R,VL,E),!. +pyo_to_pl(VL,Par,Cir,CirO,Cl,O,E):- class_to_pl1(Par,Cl,M),py_member_values(O,M,R), !, py_to_pl(VL,[Cl|Par],Cir,CirO,R,E). +pyo_to_pl(VL,Par,Cir,CirO,Cl,O,E):- class_to_pl(Par,Cl,M), % pybug(class_to_pl(Par,Cl,M)), + py_member_values(O,M,R), !, py_to_pl(VL,[Cl|Par],Cir,CirO,R,E). +pyo_to_pl(VL,Par,Cir,CirO,Cl,O,E):- catch(py_obj_dir(O,L),_,fail),pybug(py_obj_dir(O,L)),py_decomp(M),meets_dir(L,M),pybug(py_decomp(M)), + py_member_values(O,M,R), member(N-_,Cir), R\==N, !, py_to_pl(VL,[Cl|Par],Cir,CirO,R,E),!. + % If L is not callable, unify E with L. +%pyo_to_pl(_VL,_Par,Cir,Cir,Cl,O,E):- get_str_rep(O,Str), E=..[Cl,Str]. +pyo_to_pl(_VL,_Par,Cir,Cir,_Cl,O,E):- O = E,!. + +pl_to_rust(Var,Py):- pl_to_rust(_VL,Var,Py). +pl_to_rust(VL,Var,Py):- var(VL),!,ignore(VL=[vars]),pl_to_rust(VL,Var,Py). + +pl_to_rust(_VL,Sym,Py):- is_list(Sym),!, maplist(pl_to_rust,Sym,PyL), py_call(src:'mettalog':'MkExpr'(PyL),Py),!. +pl_to_rust(VL,Var,Py):- var(Var), !, real_VL_var(Sym,VL,Var), py_call('hyperon.atoms':'V'(Sym),Py),!. +pl_to_rust(VL,'$VAR'(Sym),Py):- !, real_VL_var(Sym,VL,_),py_call('hyperon.atoms':'V'(Sym),Py),!. +pl_to_rust(VL,DSym,Py):- atom(DSym),atom_concat('$',VName,DSym), rinto_varname(VName,Sym),!, pl_to_rust(VL,'$VAR'(Sym),Py). +pl_to_rust(_VL,Sym,Py):- atom(Sym),!, py_call('hyperon.atoms':'S'(Sym),Py),!. +%pl_to_rust(VL,Sym,Py):- is_list(Sym), maplist(pl_to_rust,Sym,PyL), py_call('hyperon.atoms':'E'(PyL),Py),!. +pl_to_rust(_VL,Sym,Py):- string(Sym),!, py_call('hyperon.atoms':'ValueAtom'(Sym),Py),!. +pl_to_rust(_VL,Sym,Py):- py_is_object(Sym),py_call('hyperon.atoms':'ValueAtom'(Sym),Py),!. +pl_to_rust(_VL,Sym,Py):- py_call('hyperon.atoms':'ValueAtom'(Sym),Py),!. + +py_list(MeTTa,PyList):- pl_to_py(MeTTa,PyList). + +py_tuple(O,Py):- py_ocall(tuple(O),Py),!. +py_tuple(O,Py):- py_obi(py_tuple(O),Py),!. + +py_dict(O,Py):- catch(py_is_py_dict(O),_,fail),!,O=Py. +py_dict(O,Py):- py_ocall(dict(O),Py),!. + +% ?- py_list([1, 2.0, "string"], X),py_type(X,Y). +% ?- py_list_index([1, 2.0, "string"], X),py_type(X,Y). +py_nth(L,Nth,E):- py_obi(py_nth(L,Nth),E). +py_len(L,E):- py_mbi(py_len(L),E). +py_o(O,Py):- py_obi(identity(O),Py),!. +py_m(O,Py):- py_mbi(identity(O),Py),!. +pl_to_py(Var,Py):- pl_to_py(_VL,Var,Py). +pl_to_py(VL,Var,Py):- var(VL),!,ignore(VL=[vars]),pl_to_py(VL,Var,Py). +pl_to_py(_VL,Sym,Py):- py_is_object(Sym),!,Sym=Py. +%pl_to_py(_VL,O,Py):- py_is_dict(O),!,py_obi(identity(O),Py). +pl_to_py(_VL,MeTTa,Python):- float(MeTTa), !, py_obi(float_conversion(MeTTa),Python). +pl_to_py(_VL,MeTTa,Python):- string(MeTTa), !, py_obi(string_conversion(MeTTa),Python). +pl_to_py(_VL,MeTTa,Python):- integer(MeTTa), !, py_obi(int_conversion(MeTTa),Python). +pl_to_py(VL,Sym,Py):- is_list(Sym),!, maplist(pl_to_py(VL),Sym,PyL), py_obi(py_list(PyL),Py). +pl_to_py(VL,Var,Py):- var(Var), !, real_VL_var(Sym,VL,Var), py_call('hyperon.atoms':'V'(Sym),Py),!. +pl_to_py(VL,'$VAR'(Sym),Py):- !, real_VL_var(Sym,VL,_),py_call('hyperon.atoms':'V'(Sym),Py),!. +pl_to_py(_VL,O,Py):- py_type(O,_),!,O=Py. +% % %pl_to_py(_VL,O,Py):- py_is_dict(O),!,O=Py. +%pl_to_py(VL,DSym,Py):- atom(DSym),atom_concat('$',VName,DSym), rinto_varname(VName,Sym),!, pl_to_py(VL,'$VAR'(Sym),Py). +%pl_to_py(_VL,Sym,Py):- atom(Sym),!, py_call('hyperon.atoms':'S'(Sym),Py),!. +%pl_to_py(_VL,Sym,Py):- string(Sym),!, py_call('hyperon.atoms':'S'(Sym),Py),!. +%pl_to_py(VL,Sym,Py):- is_list(Sym), maplist(pl_to_py,Sym,PyL), py_call('hyperon.atoms':'E'(PyL),Py),!. +%pl_to_py(_VL,Sym,Py):- py_is_object(Sym),py_call('hyperon.atoms':'ValueAtom'(Sym),Py),!. +pl_to_py(_VL,MeTTa,MeTTa). +%pl_to_py(_VL,Sym,Py):- py_call('hyperon.atoms':'ValueAtom'(Sym),Py),!. + +py_key(O,I):- py_m(O,M),key(M,I). +py_items(O,I):- py_m(O,M),items(M,I). +%py_values(O,K,V):- py_m(O,M),values(M,K,V). +py_values(O,K,V):- py_items(O,L),member(K:V,L). + +%elements(Atoms,E):- is_list(Atoms),!, +meets_dir(L,M):- atom(M),!,member(M,L),!. +meets_dir(L,M):- is_list(M),!,maplist(meets_dir(L),M). +meets_dir(L,M):- compound_name_arity(M,N,0),!,member(N,L),!. +meets_dir(L,M):- compound(M),!,compound_name_arguments(M,F,[A|AL]),!,maplist(meets_dir(L),[F,A|AL]). + +py_member_values(O,C,R):- is_list(O),!,maplist(py_member_values,O,C,R). +py_member_values(O,C,R):- is_list(C),!,maplist(py_member_values(O),C,R). +%py_member_values(O,C,R):- atom(C),!,compound_name_arity(CC,C,0),!,py_call(O:CC,R). +py_member_values(O,f(F,AL),R):- !,py_member_values(O,[F|AL],[RF|RAL]), compound_name_arguments(R,RF,RAL). +py_member_values(O,C,R):- py_call(O:C,R,[py_string_as(atom),py_object(false)]). + +py_to_str(PyObj,Str):- + with_output_to(string(Str),py_pp(PyObj,[nl(false)])). + + tafs:- + atoms_from_space(Space, _),py_to_pl(VL,Space,AA), print_tree(aa(Pl,aa)),pl_to_rust(VL,AA,Py), print_tree(py(Pl,py)),pl_to_rust(VL,Py,Pl),print_tree(pl(Pl,pl)) + , + atoms_from_space(Space, [A]),py_to_pl(VL,A,AA), + atoms_from_space(Space, [A]),py_obj_dir(A,D),writeq(D),!,py_to_pl(VL,D:get_object(),AA),writeq(AA),!,fail. + +py_class(A,AA):- py_call(A:'__class__',C), py_call(C:'__name__',AA,[py_string_as(atom)]),!. +py_decomp(M,C):- py_decomp(M), compound_name_arity(C,M,0). + + +class_to_pl1(_Par,'GroundingSpaceRef',get_atoms()). +class_to_pl1(_Par,'ExpressionAtom',get_children()). +class_to_pl1(_Par,'SpaceRef',get_atoms()). +class_to_pl1(_Par,'VariableAtom','__repr__'()). +class_to_pl1(_Par,'SymbolAtom',get_name()). +class_to_pl1(_Par,'bool','__repr__'()). +class_to_pl(_Par,'ValueAtom','__repr__'()). +class_to_pl(_Par,'ValueObject','value'). +class_to_pl(Par,'GroundedAtom','__repr__'()):- length(Par,Len),Len>=5,!. +class_to_pl(Par,_,'__str__'()):- length(Par,Len),Len>15,!. +class_to_pl(_Par,'GroundedAtom',get_object()). + +/* + + +class_to_pl(Par,'bool','__repr__'()). + +*/ +py_decomp('__repr__'()). +py_decomp('__str__'()). +py_decomp(get_atoms()). +py_decomp(get_children()). +py_decomp(get_object()). +py_decomp(get_name()). +py_decomp(value()). + +py_decomp('__class__':'__name__'). +%py_decomp(f(get_grounded_type(),['__str__'()])). +py_decomp(f('__class__',['__str__'()])). +%__class__ +%get_type() + +%atoms_from_space(Space, [Atoms]),py_pp(Atoms),py_call(Atoms:get_object(),A),atoms_from_space(A,Dir),member(E,Dir),py_obj_dir(E,C),py_call(E:get_children(),CH),py_pp(CH). + + +% Remove an atom from hyperon.base.GroundingSpace +:- if( \+ current_predicate(remove_from_space/2 )). +remove_from_space(Space, Sym) :- + ensure_space(Space,GSpace), + py_call(GSpace:'remove'(Sym), _). +:- endif. + +% Add an atom to hyperon.base.GroundingSpace +:- if( \+ current_predicate(add_to_space/2 )). +add_to_space(Space, Sym) :- + ensure_space(Space,GSpace), + py_call(GSpace:'add'(Sym), _). +:- endif. + +must_det_llp((A,B)):-!, must_det_llp(A), must_det_llp(B). +must_det_llp(B):- pybug(B),!,once(ignore(must_det_ll(B))). + +:- dynamic(is_pymod_in_space/2). +:- dynamic(is_pymod_loaded/2). + +py_ready:- nb_current('$py_ready','true'),!. +py_ready:- \+ is_mettalog(_),!,fail. +%py_ready:- is_metta(_),!. +py_ready. + +%pybug(P):- py_pp(P),!. +pybug(P):- \+ py_ready,!, fbug(P). +pybug(P):- fbug(P). +pypp(P):- py_to_pl(P,PL),!,fbug(PL),!. +pypp(P):- fbug(P),!. + +'extend-py!'(Module,R):- (notrace((extend_py(Module,R)))). +extend_py(Module,R):- + current_self(Self), + self_extend_py(Self,Module,_Base,R). +self_extend_py(Self,Module):- + self_extend_py(Self,Module,_Base,_). + +self_extend_py(Self,Module,File,R):- + with_safe_argv(( + assert_new(is_pymod_in_space(Module,Self)), + (nonvar(File)-> Use=File ; Use=Module), + pybug('extend-py!'(Use)), + %py_call(mettalog:use_mettalog()), + (Use==mettalog->true;py_load_modfile(Use)), + %listing(ensure_rust_metta/1), + %ensure_mettalog_py, + nb_setval('$py_ready','true'), + %working_directory(PWD,PWD), py_add_lib_dir(PWD), + %replace_in_string(["/"="."],Module,ToPython), + %py_mcall(mettalog:import_module_to_rust(ToPython)), + %sformat(S,'!(import! &self ~w)',[Use]),rust_metta_run(S,R), + R = [], + %py_module_exists(Module), + %py_call(MeTTa:load_py_module(ToPython),Result), + true)),!. + +py_load_modfile(Use):- py_ocall(mettalog:load_functions(Use),R),!,pybug(R). +py_load_modfile(Use):- exists_directory(Use),!,directory_file_path(Use,'_init_.py',File),py_load_modfile(File). +py_load_modfile(Use):- file_to_modname(Use,Mod),read_file_to_string(Use,Src,[]),!,py_module(Mod,Src). + +file_to_modname(Filename,ModName):- symbol_concat('../',Name,Filename),!,file_to_modname(Name,ModName). +file_to_modname(Filename,ModName):- symbol_concat('./',Name,Filename),!,file_to_modname(Name,ModName). +file_to_modname(Filename,ModName):- symbol_concat(Name,'/_init_.py',Filename),!,file_to_modname(Name,ModName). +file_to_modname(Filename,ModName):- symbol_concat(Name,'.py',Filename),!,file_to_modname(Name,ModName). +file_to_modname(Filename,ModName):- replace_in_string(["/"="."],Filename,ModName). + +%import_module_to_rust(ToPython):- sformat(S,'!(import! &self ~w)',[ToPython]),rust_metta_run(S). +rust_metta_run(S,Run):- var(S),!,freeze(S,rust_metta_run(S,Run)). +%rust_metta_run(exec(S),Run):- \+ callable(S), string_concat('!',S,SS),!,rust_metta_run(SS,Run). +rust_metta_run(S,Run):- coerce_string(S,R),!,rust_metta_run1(R,Run). +%rust_metta_run(I,O):- +rust_metta_run1(I,O):- load_hyperon_module, !, py_ocall(hyperon_module:rust_metta_run(I),M),!,rust_return(M,O). +rust_metta_run1(R,Run):- % run + with_safe_argv(((( + %ensure_rust_metta(MeTTa), + py_call(mettalog:rust_metta_run(R),Run))))). + +rust_return(M,O):- (py_iter(M,R,[py_object(true)]),py_iter(R,R1,[py_object(true)]))*->rust_to_pl(R1,O);(fail,rust_to_pl(M,O)). +%rust_return(M,O):- rust_to_pl(M,O). +%rust_return(M,O):- py_iter(M,R,[py_object(true)]),rust_to_pl(R,O). +%rust_return(M,O):- py_iter(M,O). %,delist1(R,O). +delist1([R],R):-!. +delist1(R,R). % Maybe warn here? + +rust_to_pl(L,P):- var(L),!,L=P. +%rust_to_pl([],P):- !, P=[]. +rust_to_pl(L,P):- is_list(L),!,maplist(rust_to_pl,L,P). +rust_to_pl(R,P):- compound(R),!,compound_name_arguments(R,F,RR),maplist(rust_to_pl,RR,PP),compound_name_arguments(P,F,PP). +rust_to_pl(R,P):- \+ py_is_object(R),!,P=R. +rust_to_pl(R,P):- py_type(R,'ExpressionAtom'),py_mcall(R:get_children(),L),!,maplist(rust_to_pl,L,P). +rust_to_pl(R,P):- py_type(R,'SymbolAtom'),py_acall(R:get_name(),P),!. +rust_to_pl(R,P):- py_type(R,'VariableAtom'),py_scall(R:get_name(),N),!,as_var(N,P),!. +%rust_to_pl(R,P):- py_type(R,'VariableAtom'),py_acall(R:get_name(),N),!,atom_concat('$',N,P). +rust_to_pl(R,N):- py_type(R,'OperationObject'),py_acall(R:name(),N),!,cache_op(N,R). +rust_to_pl(R,P):- py_type(R,'SpaceRef'),!,P=R. % py_scall(R:'__str__'(),P),!. +rust_to_pl(R,P):- py_type(R,'ValueObject'),py_ocall(R:'value'(),L),!,rust_to_pl(L,P). +rust_to_pl(R,PT):- py_type(R,'GroundedAtom'),py_ocall(R:get_grounded_type(),T),rust_to_pl(T,TT),py_ocall(R:get_object(),L),!,rust_to_pl(L,P),combine_term_l(TT,P,PT). +rust_to_pl(R,P):- py_is_list(R),py_m(R,L),R\==L,!,rust_to_pl(L,P). +rust_to_pl(R,PT):- py_type(R,T),combine_term_l(T,R,PT),!. +%rust_to_pl(R,P):- py_acall(R:'__repr__'(),P),!. +rust_to_pl(R,P):- + load_hyperon_module, !, py_ocall(hyperon_module:rust_deref(R),M),!, + (R\==M -> rust_to_pl(M,P) ; M=P). + +as_var('_',_):-!. +as_var(N,'$VAR'(S)):-sformat(S,'_~w',[N]),!. + +rust_metta_run(S):- + rust_metta_run(S,Py), + print_py(Py). + +:- volatile(cached_py_op/2). +cache_op(N,R):- asserta_if_new(cached_py_op(N,R)),fbug(cached_py_op(N,R)). +:- volatile(cached_py_type/2). +cache_type(N,R):- asserta_if_new(cached_py_type(N,R)),fbug(cached_py_type(N,R)). + +print_py(Py):- + py_to_pl(Py,R), print(R),nl. + +combine_term_l('OperationObject',P,P):-!. +combine_term_l('Number',P,P):-!. +combine_term_l('Bool',P,P):-!. +combine_term_l('ValueObject',R,P):-R=P,!. %rust_to_pl(R,P),!. +combine_term_l('%Undefined%',R,P):-rust_to_pl(R,P),!. +combine_term_l('hyperon::space::DynSpace',P,P):-!. +combine_term_l([Ar|Stuff],Op,Op):- Ar == (->), !, cache_type(Op,[Ar|Stuff]). +combine_term_l(T,P,ga(P,T)). + +%coerce_string(S,R):- atom(S), sformat(R,'~w',[S]),!. +coerce_string(S,R):- string(S),!,S=R. +coerce_string(S,R):- with_output_to(string(R),write_src(S)),!. + +load_functions_motto:- load_functions_motto(Def),pypp(Def). +load_functions_motto(Def):- + load_functions_ext, + with_safe_argv(py_call(mettalog:load_functions_motto(),Def)). + +load_functions_ext:- load_functions_ext(Def),pypp(Def). +load_functions_ext(Def):- + with_safe_argv(py_call(mettalog:load_functions_ext(),Def)). + +% Example usage +example_usage :- + with_safe_argv(ensure_primary_metta_space(GSpace)), + %some_query(Query), + Query = [], + with_safe_argv(query_from_space(GSpace, Query , Result)), + writeln(Result). + +%atoms_from_space(Sym):- atoms_iter_from_space(metta_self, Atoms),py_iter(Atoms,Sym). +atom_count_from_space(Count):- atom_count_from_space(metta_self, Count). + + +%:- . +%:- ensure_rust_metta. +%:- with_safe_argv(ensure_primary_metta_space(_GSpace)). +/* +Rust: The core of MeTTa is implemented in Rust, which provides performance and safety features. + +Python Extensions: Python is used for extending the core functionalities. Python communicates with Rust via a Foreign Function Interface (FFI) or similar mechanisms. + +Prolog: The Prolog code is an additional layer that allows you to extend or customize parts of MeTTa using Python and Rust. It maintains the system's extensibility. + + +VSpace is a space with its backend in Prolog, it implies that you're using Prolog's logic programming capabilities to manage and manipulate a particular domain, which in this context is referred to as a "space" (possibly akin to the GroundingSpace in Python, but implemented in Prolog). + +To integrate VSpace with the existing Python and Rust components, similar interfacing techniques could be used. You could expose Prolog predicates as functions that can be called from Python or Rust, and likewise, call Python or Rust functions from within Prolog. + + +*/ + +%:- ensure_loaded(metta_interp). + +:- dynamic(want_py_lib_dir/1). +:- prolog_load_context(directory, ChildDir), + file_directory_name(ChildDir, ParentDir), + file_directory_name(ParentDir, GParentDir), + pfcAdd_Now(want_py_lib_dir(GParentDir)). + +want_py_lib_dir:- + with_safe_argv((forall(want_py_lib_dir(GParentDir), + py_add_lib_dir(GParentDir)), + sync_python_path)). + +sync_python_path:- + working_directory(PWD,PWD), py_add_lib_dir(PWD), + ignore(( getenv('PYTHONPATH', CurrentPythonPath), + symbolic_list_concat(List, ':', CurrentPythonPath), + list_to_set(List,Set), + py_lib_dirs(DirsA), + forall(member(E,Set),if_t( \+member(E,DirsA), if_t( \+ atom_length(E,0), py_add_lib_dir(E)))))), + py_lib_dirs(DirsL), + list_to_set(DirsL,Dirs), + fbug(py_lib_dirs(Dirs)), + symbolic_list_concat(Dirs, ':',NewPythonPath), + setenv('PYTHONPATH', NewPythonPath). + +is_rust_operation([Fun|Args]):- + get_list_arity(Args,Arity), + py_call(mettalog:get_operation_definition_with_arity(Fun,Arity),O),O\=='@'('none'). + +get_list_arity(Args,Arity):- is_list(Args),!,length(Args,Arity). +get_list_arity(_Args,-1). + +:- set_prolog_flag(debugger_write_options,[quoted(true), portray(true), max_depth(60), attributes(portray), spacing(next_argument)] ). +:- set_prolog_flag(answer_write_options,[quoted(true), portray(true), max_depth(60), attributes(portray), spacing(next_argument)] ). +:- set_prolog_flag(py_backtrace_depth,50). +:- set_prolog_flag(py_backtrace, true). +:- set_prolog_flag(py_argv , []). +:- initialization(on_restore1,restore). +:- initialization(on_restore2,restore). + + + +% py_initialize(, +Argv, +Options) +on_restore1:- ensure_mettalog_py. +on_restore2:- !. +%on_restore2:- load_builtin_module. +%:- load_hyperon_module. + + + +% grab the 1st variable Var +subst_each_var([Var|RestOfVars],Term,Output):- !, + % replace all occurences of Var with _ (Which is a new anonymous variable) + subst(Term, Var, _ ,Mid), + % Do the RestOfVars + subst_each_var(RestOfVars,Mid,Output). +% no more vars left to replace +subst_each_var(_, TermIO, TermIO). + + + + diff --git a/.Attic/metta_lang/metta_reader.new b/.Attic/canary_docme/metta_reader.pl old mode 100755 new mode 100644 similarity index 90% rename from .Attic/metta_lang/metta_reader.new rename to .Attic/canary_docme/metta_reader.pl index a232a417a83..62fe47c60e9 --- a/.Attic/metta_lang/metta_reader.new +++ b/.Attic/canary_docme/metta_reader.pl @@ -1,3 +1,57 @@ +/* + * Project: MeTTaLog - A MeTTa to Prolog Transpiler/Interpreter + * Description: This file is part of the source code for a transpiler designed to convert + * MeTTa language programs into Prolog, utilizing the SWI-Prolog compiler for + * optimizing and transforming function/logic programs. It handles different + * logical constructs and performs conversions between functions and predicates. + * + * Author: Douglas R. Miles + * Contact: logicmoo@gmail.com / dmiles@logicmoo.org + * License: LGPL + * Repository: https://github.com/trueagi-io/metta-wam + * https://github.com/logicmoo/hyperon-wam + * Created Date: 8/23/2023 + * Last Modified: $LastChangedDate$ # You will replace this with Git automation + * + * Usage: This file is a part of the transpiler that transforms MeTTa programs into Prolog. For details + * on how to contribute or use this project, please refer to the repository README or the project documentation. + * + * Contribution: Contributions are welcome! For contributing guidelines, please check the CONTRIBUTING.md + * file in the repository. + * + * Notes: + * - Ensure you have SWI-Prolog installed and properly configured to use this transpiler. + * - This project is under active development, and we welcome feedback and contributions. + * + * Acknowledgments: Special thanks to all contributors and the open source community for their support and contributions. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the + * distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS + * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT + * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS + * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE + * COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, + * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; + * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER + * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN + * ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + * POSSIBILITY OF SUCH DAMAGE. + */ + + /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Parsing - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ @@ -80,7 +134,7 @@ def_compile_all(I,O):- current_predicate(compile_all/2),!,call(call,compile_all,I,O). -def_compile_all(I,O):- wdmsg(undefined_compile_all(I)),I=O. +def_compile_all(I,O):- fbug(undefined_compile_all(I)),I=O. zalwayzz(G):- call(G)*->true;throw(fail_zalwayzz(G)). @@ -133,10 +187,10 @@ escape_char_metta(C,S):- sformat(S,'~s',[[C]]). symbol_metta(S, Until) --> metta_wspace,!,symbol_metta(S, Until). -symbol_metta(S, Until) --> string_until_metta(SChars,(dcg_peek(metta_white); Until)), { atomic_list_concat(SChars, S) }. +symbol_metta(S, Until) --> string_until_metta(SChars,(dcg_peek(metta_white); Until)), { symbolic_list_concat(SChars, S) }. %comment --> `;`,!,comment_chars_metta(S). -comment_chars_metta(S) --> string_until_metta(SChars,`\n`), { atomic_list_concat(SChars, S) }. +comment_chars_metta(S) --> string_until_metta(SChars,`\n`), { symbolic_list_concat(SChars, S) }. %e_o_s --> file_eof,!. e_o_s --> \+ [_|_]. @@ -176,8 +230,8 @@ ?,?). -:- dynamic user:file_search_path/2. -:- multifile user:file_search_path/2. + :- dynamic user:file_search_path/2. + :- multifile user:file_search_path/2. :- thread_local(t_l:s_reader_info/1). @@ -217,9 +271,9 @@ make_tmpfile_name(Name,Temp):- - atomic_list_concat(List1,'/',Name),atomic_list_concat(List1,'_',Temp1), - atomic_list_concat(List2,'.',Temp1),atomic_list_concat(List2,'_',Temp2), - atomic_list_concat(List3,'\\',Temp2),atomic_list_concat(List3,'_',Temp3), + symbolic_list_concat(List1,'/',Name),symbolic_list_concat(List1,'_',Temp1), + symbolic_list_concat(List2,'.',Temp1),symbolic_list_concat(List2,'_',Temp2), + symbolic_list_concat(List3,'\\',Temp2),symbolic_list_concat(List3,'_',Temp3), atom_concat_or_rtrace(Temp3,'.tmp',Temp),!. @@ -290,7 +344,9 @@ % parse_sexpr(S, Expr) :- quietly_sreader(parse_meta_term( - file_sexpr_with_comments, S, Expr)). + file_sexpr_with_comments, S, Expr)), + nb_setval('$parser_last_read',Expr). + %% parse_sexpr_ascii( +Codes, -Expr) is det. % @@ -315,7 +371,9 @@ % % Parse S-expression from a Stream % -parse_sexpr_stream(S,Expr):- quietly_sreader(parse_meta_stream(file_sexpr_with_comments,S,Expr)),!. +parse_sexpr_stream(S,Expr):- + quietly_sreader(parse_meta_stream(file_sexpr_with_comments,S,Expr)),!, + nb_setval('$parser_last_read',Expr). :- export('//'(file_sexpr,1)). :- export('//'(sexpr,1)). @@ -327,16 +385,15 @@ % Use DCG for parser. -%file_sexpr_with_comments(O) --> [], {clause(t_l:s_reader_info(O),_,Ref),erase(Ref)},!. - +%file_sexpr_with_comments(O) --> [], {clause(t_l:s_reader_info(O),_,Ref),erase(Ref)},!. file_sexpr_with_comments(end_of_file) --> file_eof,!. +file_sexpr_with_comments('+') --> `+`, swhite,!. + file_sexpr_with_comments(O) --> one_blank,!,file_sexpr_with_comments(O),!. % WANT? file_sexpr_with_comments(end_of_file) --> `:EOF`,!. file_sexpr_with_comments(C) --> dcg_peek(`#|`),!,zalwayzz(comment_expr(C)),swhite,!. file_sexpr_with_comments(C) --> dcg_peek(`;`),!, zalwayzz(comment_expr(C)),swhite,!. - - file_sexpr_with_comments(Out) --> {kif_ok}, prolog_expr_next, prolog_readable_term(Out), !. file_sexpr_with_comments(Out,S,E):- \+ t_l:sreader_options(with_text,true),!,phrase(file_sexpr(Out),S,E),!. file_sexpr_with_comments(Out,S,E):- expr_with_text(Out,file_sexpr(O),O,S,E),!. @@ -373,10 +430,8 @@ % WANT? file_sexpr(O) --> sblank,!,file_sexpr(O),!. % file_sexpr(planStepLPG(Name,Expr,Value)) --> swhite,sym_or_num(Name),`:`,swhite, sexpr(Expr),swhite, `[`,sym_or_num(Value),`]`,swhite. % 0.0003: (PICK-UP ANDY IBM-R30 CS-LOUNGE) [0.1000] -% file_sexpr(Term,Left,Right):- eoln(EOL),append(LLeft,[46,EOL|Right],Left),read_term_from_codes(LLeft,Term,[double_quotes(string)]),!. -% file_sexpr(Term,Left,Right):- append(LLeft,[46|Right],Left), ( \+ member(46,Right)),read_term_from_codes(LLeft,Term,[double_quotes(string)]),!. - -%file_sexpr(C) --> !, s_line_metta(C), !. +% file_sexpr(Term,Left,Right):- eoln(EOL),append(LLeft,[46,EOL|Right],Left),read_term_from_codes(LLeft,Term,[double_quotes(string),syntax_errors(fail)]),!. +% file_sexpr(Term,Left,Right):- append(LLeft,[46|Right],Left), ( \+ member(46,Right)),read_term_from_codes(LLeft,Term,[double_quotes(string),syntax_errors(fail)]),!. file_sexpr(Expr) --> sexpr(Expr),!. % file_sexpr(Expr,H,T):- lisp_dump_break,rtrace(phrase(file_sexpr(Expr), H,T)). /* @@ -483,9 +538,13 @@ %sexpr(L) --> sblank,!,sexpr(L),!. %sexpr(_) --> `)`,!,{trace,break,throw_reader_error(": an object cannot start with #\\)")}. -sexpr(X,H,T):- zalwayzz(sexpr0(X),H,M),zalwayzz(swhite,M,T), nop(if_debugging(sreader,(wdmsg(sexpr(X))))),!. +sexpr(X,H,T):- zalwayzz(sexpr0(X),H,M),zalwayzz(swhite,M,T), nop(if_debugging(sreader,(fbug(sexpr(X))))),!. %sexpr(X,H,T):- zalwayzz(sexpr0(X,H,T)),!,swhite. is_common_lisp:- fail. +is_scm:- fail. +is_metta:- true. + +:- discontiguous(sexpr0/3). sexpr0(L) --> sblank,!,sexpr(L),!. sexpr0(L) --> `(`, !, swhite, zalwayzz(sexpr_list(L)),!, swhite. @@ -493,12 +552,25 @@ {prolog_readable_term(Expr,S,_)}. -sexpr0(['#'(quote),E]) --> `'`, !, sexpr(E). +sexpr0(['#'(quote),E]) --> {\+ is_metta}, `'`, !, sexpr(E). % ' sexpr0(['#'(hbackquote),E]) --> {is_scm}, `#```, !, sexpr(E). -sexpr0(['#'(backquote),E]) --> ````, !, sexpr(E). -sexpr0(['#BQ-COMMA-ELIPSE',E]) --> `,@`, !, sexpr(E). +sexpr0(['#'(backquote),E]) --> {\+ is_metta}, ````, !, sexpr(E). +sexpr0(['#BQ-COMMA-ELIPSE',E]) --> {\+ is_metta}, `,@`, !, sexpr(E). sexpr0(['#COMMA',E]) --> { is_common_lisp }, `,`, !, sexpr(E). sexpr0(['#HCOMMA',E]) --> {is_scm}, `#,`, !, sexpr(E). + +sexpr0('#\\'(A))--> { is_metta}, `'`,[C],`'`,{C>=32},!, {atom_codes(A,[C])}. + +% sexpr_metta('$STRING'(S)) --> s_string(S),!. + + + +sexpr_metta(O) --> dcg_peek(dcg_not( ( `(` ; `)` ; ` ` ; + sblank_ch) )), + (read_string_until(Text, dcg_peek( ( `(` ; `)` ; ` ` ; + sblank_ch) ))),!,{atom_string(O,Text)}. + + sexpr0('$OBJ'(claz_bracket_vector,V)) --> `[`, sexpr_vector(V,`]`),!, swhite. % MeTTA/NARS % sexpr0('#'(A)) --> `|`, !, read_string_until(S,`|`), swhite,{quietly_sreader(((atom_string(A,S))))}. @@ -535,7 +607,7 @@ sexpr0('$COMPLEX'(R,I)) --> (`#`, ci(`c`),`(`),!,zalwayzz(sexpr_list([R,I])),swhite,!. sexpr0('$OBJ'(claz_bitvector,C)) --> `#*`,radix_digits(2,C),swhite,!. -sexpr0(function(E)) --> `#\'`, sexpr(E), !. %, swhite. +sexpr0(function(E)) --> `#\'`, sexpr(E), !. %, swhite. % ' sexpr0('$OBJ'(claz_vector,V)) --> `#(`, !, zalwayzz(sexpr_vector(V,`)`)),!, swhite,!. sexpr0(Number) --> `#`,integer(Radix),ci(`r`),!,zalwayzz((signed_radix_2(Radix,Number0),extend_radix(Radix,Number0,Number))),!. @@ -553,17 +625,19 @@ /*********END HASH ***********/ +sexpr0(L)--> { is_metta }, sexpr_metta(L),!. + sexpr0(E) --> sym_or_num(E), swhite,!. sexpr0(Sym) --> `#`,integer(N123), swhite,!, {atom_concat('#',N123,Sym)}. -sexpr0(C) --> s_line_metta(C) , !. %s_line_metta(C), !. -sexpr0(C) --> s_item_metta(C, e_o_s). %s_line_metta(C), !. +sexpr0(C) --> s_line_metta(C) ,swhite, !. %s_line_metta(C), !. +sexpr0(C) --> s_item_metta(C, e_o_s), swhite. %s_line_metta(C), !. sexpr0(E) --> !,zalwayzz(sym_or_num(E)), swhite,!. -is_scm:- fail. % c:/opt/logicmoo_workspace/packs_sys/logicmoo_opencog/guile/module/ice-9/and-let-star.scm priority_symbol((`|-`)). +/* priority_symbol((`#=`)). priority_symbol((`#+`)). priority_symbol((`#-`)). @@ -581,19 +655,18 @@ priority_symbol((`-1-`)). priority_symbol((`1+`)). priority_symbol((`1-`)). +*/ sym_or_num('$COMPLEX'(L)) --> `#C(`,!, swhite, sexpr_list(L), swhite. %sym_or_num((E)) --> unsigned_number(S),{number_string(E,S)}. %sym_or_num((E)) --> unsigned_number(S),{number_string(E,S)}. -sym_or_num((E)) --> lnumber(E),swhite,!. +%sym_or_num((E)) --> lnumber(E),swhite,!. sym_or_num(E) --> rsymbol_maybe(``,E),!. %sym_or_num('#'(E)) --> [C],{atom_codes(E,[C])}. sym_or_num(E) --> dcg_xor(rsymbol(``,E),lnumber(E)),!. - - -sym_or_num(E) --> dcg_xor(rsymbol(``,E),lnumber(E)),!. +%sym_or_num(E) --> dcg_xor(rsymbol(``,E),lnumber(E)),!. % sym_or_num('#'(E)) --> [C],{atom_codes(E,[C])}. @@ -603,8 +676,11 @@ %sblank --> [C], {var(C)},!. % sblank --> comment_expr(S,I,CP),!,{assert(t_l:s_reader_info('$COMMENT'(S,I,CP)))},!,swhite. -sblank --> comment_expr(CMT),!,{assert(t_l:s_reader_info(CMT))},!,swhite. -sblank --> [C], {nonvar(C),charvar(C),!,bx(C =< 32)},!,swhite. +sblank --> sblank_char, comment_expr(CMT),!,{assert(t_l:s_reader_info(CMT))},!,swhite. +sblank --> sblank_ch. +sblank_ch --> sblank_char,!,swhite. + +sblank_char --> [C], {nonvar(C),charvar(C),!,bx(C =< 32)}. sblank_line --> eoln,!. sblank_line --> [C],{bx(C =< 32)},!, sblank_line. @@ -612,26 +688,26 @@ s_string(Text) --> sexpr_string(Text). s_string(Text) --> {kif_ok},`'`, !, zalwayzz(read_string_until(Text,`'`)),!. - +:- export(sblank_ch/2). swhite --> sblank,!. swhite --> []. sexpr_lazy_list_character_count(Location, Stream, Here, Here) :- - sexpr_lazy_list_character_count(Here, Location, Stream). + sexpr_lazy_list_character_count(Here, Location, Stream). sexpr_lazy_list_character_count(Here, CharNo, Stream) :- - '$skip_list'(Skipped, Here, Tail), - ( attvar(Tail) - -> frozen(Tail, - pure_input:read_to_input_stream(Stream, _PrevPos, Pos, _List)), - stream_position_data(char_count, Pos, EndRecordCharNo), - CharNo is EndRecordCharNo - Skipped - ; Tail == [] - -> CharNo = end_of_file-Skipped - ; type_error(lazy_list, Here) - ). + '$skip_list'(Skipped, Here, Tail), + ( attvar(Tail) + -> frozen(Tail, + pure_input:read_to_input_stream(Stream, _PrevPos, Pos, _List)), + stream_position_data(char_count, Pos, EndRecordCharNo), + CharNo is EndRecordCharNo - Skipped + ; Tail == [] + -> CharNo = end_of_file-Skipped + ; type_error(lazy_list, Here) + ). @@ -665,9 +741,23 @@ sexpr_list([Car|Cdr]) --> sexpr(Car), !, sexpr_rest(Cdr),!. sexpr_rest([]) --> `)`, !. -sexpr_rest(E) --> `.`, [C], {\+ sym_char(C)}, !, sexpr(E,C), !, `)`. +% allow dotcons/improper lists.. but also allow dot in the middle of the list (non-CL) +sexpr_rest(E) --> `.`, [C], {\+ sym_char(C)}, sexpr(E,C), `)` , ! . sexpr_rest(E) --> {kif_ok}, `@`, rsymbol(`?`,E), `)`. -sexpr_rest([Car|Cdr]) --> sexpr(Car), !, sexpr_rest(Cdr),!. +sexpr_rest([Car|Cdr]) --> sexpr(Car), !, {Car\==''}, + %maybe_throw_reader_error(Car), + sexpr_rest(Cdr),!. + +maybe_throw_reader_error(Car,I,O):- Car=='',lazy_list_location(Info,I,O),!, + write_src(Info), + if_t(nb_current('$parser_last_read',V),write_src('$parser_last_read'=V)), + throw(ll_read_error(Info)). +maybe_throw_reader_error(Car,I,I):- Car=='', !, + ignore(sexpr_lazy_list_character_count(I,CharPos,Stream)),!, + Info= ics(I,CharPos,Stream), + write_src(Info), + throw(ll_read_error(Info)). +maybe_throw_reader_error(_,I,I). sexpr_vector(O,End) --> zalwayzz(sexpr_vector0(IO,End)),!,{zalwayzz(O=IO)}. @@ -699,7 +789,7 @@ maybe_string(E,E). sym_continue([H|T]) --> [H], {sym_char(H)},!, sym_continue(T). -sym_continue([39]) --> `'`, peek_symbol_breaker,!. +sym_continue([39]) --> `'`, peek_symbol_breaker,!. % ' sym_continue([]) --> peek_symbol_breaker,!. sym_continue([]) --> []. @@ -793,7 +883,8 @@ sym_char(C):- bx(C =< 32),!,fail. %sym_char(44). % allow comma in middle of symbol -sym_char(C):- memberchk(C,`"()```),!,fail. % maybe 44 ? comma maybe not # or ; ? ' +sym_char(C):- memberchk(C,`"()```),!,fail. +% maybe 44 ? comma maybe not # or ; ? ' `'`'````'" %sym_char(C):- nb_current('$maybe_string',t),memberchk(C,`,.:;!%`),!,fail. sym_char(_):- !. @@ -806,6 +897,8 @@ :- thread_local(t_l:s2p/1). :- thread_local(t_l:each_file_term/1). +string_to_syms:- !, false. +string_to_syms:- option_value('string-are-atoms',true). %= @@ -902,8 +995,8 @@ char_code_int(Char,Code):- notrace_catch_fail(char_code(Char,Code)),!. char_code_int(Char,Code):- notrace_catch_fail(atom_codes(Char,[Code])),!. char_code_int(Char,Code):- atom(Char),name_to_charcode(Char,Code),!. -char_code_int(Char,Code):- var(Char),!,wdmsg(char_code_int(Char,Code)), only_debug(break). -char_code_int(Char,Code):- wdmsg(char_code_int(Char,Code)),only_debug(break). +char_code_int(Char,Code):- var(Char),!,fbug(char_code_int(Char,Code)), only_debug(break). +char_code_int(Char,Code):- fbug(char_code_int(Char,Code)),only_debug(break). char_code_to_char(N,S):- atom(N),atom_codes(N,[_]),!,S=N. char_code_to_char(N,S):- atom(N),!,S=N. diff --git a/.Attic/canary_docme/metta_repl.pl b/.Attic/canary_docme/metta_repl.pl new file mode 100644 index 00000000000..20a48794b39 --- /dev/null +++ b/.Attic/canary_docme/metta_repl.pl @@ -0,0 +1,695 @@ +:- at_halt(save_history). + +history_file_location(Filename) :- expand_file_name('~/.config/metta/repl_history.txt',[Filename]). % for Linux, Windows might be different + +check_directory_exists(''). % Check all the terminating cases for the base of a directory tree. Might need more for Windows. +check_directory_exists('/'). +check_directory_exists('.'). +check_directory_exists('~'). +check_directory_exists('..'). +check_directory_exists(Dir) :- + file_directory_name(Dir,Parent), + check_directory_exists(Parent), + (exists_directory(Dir) -> true ; make_directory(Dir)). + +check_file_exists_for_append(HistoryFile) :- exists_file(HistoryFile),access_file(HistoryFile,append), !. +check_file_exists_for_append(HistoryFile) :- + file_directory_name(HistoryFile,Dir), + check_directory_exists(Dir), + open(HistoryFile,write,Stream,[create([read,write])]), !, + close(Stream). +check_file_exists_for_append(HistoryFile) :- write("Error opening history file: "),writeln(HistoryFile),halt(1). + +save_history :- + current_input(Input), + (((stream_property(Input, tty(true)))) -> ((history_file_location(HistoryFile),el_write_history(Input,HistoryFile))) ; true). + +load_and_trim_history:- + notrace(( + current_input(In), %catch(load_history,_,true), + ignore(install_readline(In)) )). + +%repl:- option_value('repl',prolog),!,prolog. +%:- ensure_loaded(metta_toplevel). + +%:- discontiguous do_metta_exec/3. + +%repl:- setup_call_cleanup(flag(repl_level,Was,Was+1),repl0, + % (flag(repl_level,_,Was),(Was==0 -> maybe_halt(7) ; true))). + +repl:- catch(repl2,end_of_input,true). + +repl1:- + with_option('doing_repl',true, + with_option(repl,true,repl2)). %catch((repeat, repl2, fail)'$aborted',true). +repl2:- + load_and_trim_history, + repeat, + %set_prolog_flag(gc,true), + reset_caches, + garbage_collect, + %set_prolog_flag(gc,false), + %with_option(not_a_reload,true,make), + ignore(catch((ignore(catch(once(repl3),restart_reading,true))), + give_up(Why),pp_m(red,gave_up(Why)))), + %set_prolog_flag(gc,true), + fail. + +write_metta_prompt:- + flush_output(current_output), + format('~Nmetta',[]), + current_read_mode(repl,Mode),write(Mode), + current_self(Self),(Self=='&self' -> true ; write(Self)), + write('>'),flush_output(current_output). + +repl3:- + with_output_to(atom(P),write_metta_prompt), + setup_call_cleanup( + notrace(prompt(Was,P)), + ((ttyflush,repl4,ttyflush)), + notrace(prompt(_,Was))). + +repl4:- + (( reset_eval_num, + write_answer_output, + %ignore(shell('stty sane ; stty echo')), + %current_input(In), + %if_trace(repl,fbug(repl_read(Mode,Expr))), + repl_read(Expr), + notrace(if_t((Expr==end_of_file;(is_win64,Expr=='')),throw(end_of_input))), + %ignore(shell('stty sane ; stty echo')), + ttyflush, + notrace(ignore(check_has_directive(Expr))), + current_self(Self), current_read_mode(repl,Mode), + nop(writeqln(repl_read(Expr))),!, + ignore(once((do_metta(repl_true,Mode,Self,Expr,O)))),!, + nop((write_src(O),nl)), + notrace(throw(restart_reading)))). + + + +check_has_directive(V):- var(V),!,fail. +check_has_directive('log.'):- switch_to_mettalog,!. +check_has_directive('rust.'):- switch_to_mettarust,!. +check_has_directive(Atom):- symbol(Atom),symbol_concat(_,'.',Atom),!. +check_has_directive(call(N=V)):- nonvar(N),!, set_directive(N,V). +check_has_directive(call(Rtrace)):- rtrace == Rtrace,!, rtrace,notrace(throw(restart_reading)). +check_has_directive(NEV):- symbol(NEV), symbolic_list_concat([N,V],'=',NEV), set_directive(N,V). +check_has_directive([AtEq,Value]):-symbol(AtEq),symbol_concat('@',Name,AtEq), set_directive(Name,Value). +check_has_directive(ModeChar):- symbol(ModeChar),metta_interp_mode(ModeChar,_Mode),!,set_directive(repl_mode,ModeChar). +check_has_directive('@'):- do_show_options_values,!,notrace(throw(restart_reading)). +check_has_directive(AtEq):-symbol(AtEq),symbol_concat('@',NEV,AtEq),option_value(NEV,Foo),fbug(NEV=Foo),!,notrace(throw(restart_reading)). +check_has_directive(_). + +set_directive(N,V):- symbol_concat('@',NN,N),!,set_directive(NN,V). +set_directive(N,V):- N=='mode',!,set_directive((repl_mode),V). +set_directive(N,V):- show_call(set_option_value_interp(N,V)),!,notrace(throw(restart_reading)). + +read_pending_white_codes(In):- + read_pending_codes(In,[10],[]),!. +read_pending_white_codes(_). + +call_for_term_variables4v(Term,[] ,as_tf(Term,TF),NamedVarsList,TF):- get_global_varnames(NamedVarsList),!. +call_for_term_variables4v(Term,[X] , Term, NamedVarsList,X):- get_global_varnames(NamedVarsList). + + + +% Check if parentheses are balanced in a list of characters +balanced_parentheses(Str):- string(Str), string_chars(Str,Chars),!,balanced_parentheses(Chars, 0). +balanced_parentheses(Chars) :- balanced_parentheses(Chars, 0). +balanced_parentheses([], 0). +balanced_parentheses(['('|T], N) :- N1 is N + 1, !, balanced_parentheses(T, N1). +balanced_parentheses([')'|T], N) :- N > 0, N1 is N - 1, !, balanced_parentheses(T, N1). +balanced_parentheses([H|T], N) :- H \= '(', H \= ')', !, balanced_parentheses(T, N). +% Recursive function to read lines until parentheses are balanced. + +repl_read(NewAccumulated, Expr):- + symbol_concat(Atom, '.', NewAccumulated), + catch_err((read_term_from_atom(Atom, Term, []), Expr=call(Term)), E, + (write('Syntax error: '), writeq(E), nl, repl_read(Expr))),!. + + +%repl_read(Str, Expr):- ((clause(t_l:s_reader_info(Expr),_,Ref),erase(Ref))). +repl_read("!", '!'):-!. +repl_read("+", '+'):-!. +repl_read(Str,Atom):- atom_string(Atom,Str),metta_interp_mode(Atom,_),!. + +repl_read(Str, Expr):- symbol_concat('@',_,Str),!,atom_string(Expr,Str). +repl_read(Str, _Expr):- symbol_concat(')',_,Str),!,fbug(repl_read_syntax(Str)),throw(restart_reading). +repl_read(NewAccumulated, Expr):- + normalize_space(string(Renew),NewAccumulated), + Renew \== NewAccumulated, !, + repl_read(Renew, Expr). +%repl_read(Str, 'add-atom'('&self',Expr)):- symbol_concat('+',W,Str),!,repl_read(W,Expr). +%repl_read(NewAccumulated,exec(Expr)):- string_concat("!",Renew,NewAccumulated), !, repl_read(Renew, Expr). +repl_read(NewAccumulated, Expr):- string_chars(NewAccumulated, Chars), + balanced_parentheses(Chars), length(Chars, Len), Len > 0, + read_metta(NewAccumulated,Expr), + normalize_space(string(Renew),NewAccumulated), + add_history_string(Renew). +repl_read(Accumulated, Expr) :- read_line_to_string(current_input, Line), repl_read(Accumulated, Line, Expr). + +repl_read(_, end_of_file, end_of_file):- writeln(""),throw(end_of_input). + +repl_read(Accumulated, "", Expr):- !, repl_read(Accumulated, Expr). +repl_read(_Accumulated, Line, Expr):- Line == end_of_file, !, Expr = Line. +repl_read(Accumulated, Line, Expr) :- symbolics_to_string([Accumulated," ",Line], NewAccumulated), !, + repl_read(NewAccumulated, Expr). + +repl_read(O2):- clause(t_l:s_reader_info(O2),_,Ref),erase(Ref). +repl_read(Expr) :- repeat, + remove_pending_buffer_codes(_,Was),text_to_string(Was,Str), + repl_read(Str, Expr), + % once(((symbol(Expr1),symbol_concat('@',_,Expr1), \+ atom_contains(Expr1,"="), repl_read(Expr2)) -> Expr=[Expr1,Expr2] ; Expr1 = Expr)), + % this cutrs the repeat/0 + ((peek_pending_codes(_,Peek),Peek==[])->!;true). + +add_history_string(Str):- current_input(Input),(((stream_property(Input, tty(true)))) -> ((notrace(ignore(el_add_history(Input,Str))))) ; true),!. + +add_history_src(Exec):- notrace(ignore((Exec\=[],with_output_to(string(H),with_indents(false,write_src(Exec))),add_history_string(H)))). + +add_history_pl(Exec):- var(Exec), !. +add_history_pl(eval(_,catch_red(PL),_)):- !,add_history_pl(PL). +add_history_pl(show_failure(PL)):-!,add_history_pl(PL). +add_history_pl(as_tf(PL,_OUT)):-!,add_history_pl(PL). +add_history_pl(Exec):- notrace(ignore((Exec\=[],with_output_to(string(H),with_indents(false,(writeq(Exec),writeln('.')))),add_history_string(H)))). + + +:- nb_setval(variable_names,[]). + + + + + %call_for_term_variables5(Term,[],as_tf(Term,TF),[],TF):- symbol(Term),!. +call_for_term_variables5(Term,[],[],[],as_tf(Term,TF),[],TF):- ground(Term),!. +call_for_term_variables5(Term,DC,[],[],call_nth(Term,TF),DC,TF):- ground(Term),!. +call_for_term_variables5(Term,_,[],[_=Var],call_nth(Term,Count),['Count'=Count],Var). +call_for_term_variables5(Term,_,[_=Var],[],call_nth(Term,Count),['Count'=Count],Var). +call_for_term_variables5(Term,_,Vars,[_=Var],Term,Vars,Var). +call_for_term_variables5(Term,_,[_=Var],Vars,Term,Vars,Var). +call_for_term_variables5(Term,_,SVars,Vars,call_nth(Term,Count),[Vars,SVars],Count). + + + +is_interactive(From):- notrace(is_interactive0(From)). +is_interactive0(From):- From==repl_true,!. +is_interactive0(From):- From==false,!,fail. +is_interactive0(From):- symbolic(From),is_stream(From),!, \+ stream_property(From,filename(_)). +is_interactive0(From):- From = true,!. + + +inside_assert(Var,Var):- \+ compound(Var),!. +inside_assert([H,IA,_],IA):- symbol(H),symbol_concat('assert',_,H),!. +inside_assert(Conz,Conz):- is_conz(Conz),!. +inside_assert(exec(I),O):- !, inside_assert(I,O). +inside_assert(Eval,O):- functor(Eval,eval_H,A), A1 is A-1, arg(A1,Eval,I),!, inside_assert(I,O). +%inside_assert(eval_H(I,C),eval_H(O,C)):- !, inside_assert(I,O). +%inside_assert(eval_H(A,B,I,C),eval_H(A,B,O,C)):- !, inside_assert(I,O). +inside_assert(call(I),O):- !, inside_assert(I,O). +inside_assert( ?-(I), O):- !, inside_assert(I,O). +inside_assert( :-(I), O):- !, inside_assert(I,O). +inside_assert(Var,Var). + +current_read_mode(repl,Mode):- ((option_value(repl_mode,Mode),Mode\==[])->true;Mode='+'),!. +current_read_mode(file,Mode):- ((nb_current(file_mode,Mode),Mode\==[])->true;Mode='+'). + + + +eval(all(Form)):- nonvar(Form), !, forall(eval(Form),true). +eval(Form):- current_self(Self), do_metta(true,exec,Self,Form,Out),write_src(Out). + +eval(Form,Out):- current_self(Self),eval(Self,Form,Out). +eval(Self,Form,Out):- eval_H(500,Self,Form,Out). + +eval_I(Self,Form,OOut):- + eval_H(500,Self,Form,Out), + trace, + xform_out(Out,OOut). + +xform_out(Out,OOut):- is_returned(Out),!,OOut=Out. +xform_out(_Out,'Empty'). + + +name_vars(P):- ignore(name_vars0(P)). +name_vars0(X=Y):- X==Y,!. +name_vars0(X='$VAR'(X)). + +reset_cache. +reset_caches:- forall(clause(reset_cache,Body),forall(rtrace_on_error(Body),true)). + +interactively_do_metta_exec(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut):- + reset_caches, + catch(interactively_do_metta_exec00(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut), + Error,write_src(error(Error,From,TermV))). + + +interactively_do_metta_exec00(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut):- + catch(interactively_do_metta_exec01(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut), + '$aborted',fbug(aborted(From,TermV))). + +% Interactively executes a mettalog command if certain conditions are met and hides results based on file settings. +interactively_do_metta_exec01(file(_), Self, _TermV, Term, X, _NamedVarsList, _Was, _Output, _FOut) :- + file_hides_results(Term), !, + eval_args(Self, Term, X). + +interactively_do_metta_exec01(From,Self,_TermV,Term,X,NamedVarsList,Was,VOutput,FOut):- + notrace(( + reset_eval_num, + Result = res(FOut), + Prev = prev_result('Empty'), + inside_assert(Term,BaseEval), + (is_compatio + -> option_else(answer,Leap,leap) + ; option_else(answer,Leap,each)), + option_else('maximum-result-count',MaxResults,inf), % infinate answers + option_else('initial-result-count',LeashResults,10), % if print the first 10 answers without stopping + Control = contrl(MaxResults,Leap), + Skipping = _, + % Initialize Control as a compound term with 'each' as its argument. + %GG = interact(['Result'=X|NamedVarsList],Term,trace_off), + (((From = file(_Filename), option_value('exec',skip), \+ always_exec(BaseEval))) + -> (GG = (skip(Term),deterministic(Complete)), + %Output = + %FOut = "Skipped", + Skipping = 1,!, + %color_g_mesg('#da70d6', (write('% SKIPPING: '), writeq(eval_H(500,Self,BaseEval,X)),writeln('.'))), + % color_g_mesg('#fa90f6', (writeln('; SKIPPING'), with_indents(true,write_src(exec(BaseEval))))), + % if_t(is_list(BaseEval),add_history_src(exec(TermV))), + true + ) + ; GG = %$ locally(set_prolog_flag(gc,false), + ( + (( (Term),deterministic(Complete), + xform_out(VOutput,Output), nb_setarg(1,Result,Output)))), + !, % metta_toplevel + flag(result_num,_,0), + PL=eval(Self,BaseEval,X), + ( % with_indents(true, + \+ \+ ( + user:maplist(name_vars,NamedVarsList), + user:name_vars('OUT'=X), + % add_history_src(exec(BaseEval)), + if_t(Skipping==1,writeln(' ; SKIPPING')), + %if_t(TermV\=BaseEval,color_g_mesg('#fa90f6', (write('; '), with_indents(false,write_src(exec(BaseEval)))))), + if_t((is_interactive(From);Skipping==1), + ( + if_t( \+ option_value(doing_repl,true), + if_t( \+ option_value(repl,true), + if_t( option_value(prolog,true), add_history_pl(PL)))), + if_t(option_value(repl,true), add_history_src(exec(BaseEval))))), + + prolog_only((color_g_mesg('#da70d6', (write('% DEBUG: '), writeq(PL),writeln('.'))))), + true))))), + + in_answer_io(format('~N[')),!, + + (forall_interactive( + From, WasInteractive,Complete, %may_rtrace + (timed_call(GG,Seconds)), + ((Complete==true->!;true), + %repeat, + set_option_value(interactive,WasInteractive), + Control = contrl(Max,DoLeap), + nb_setarg(1,Result,Output), + current_input(CI), + read_pending_codes(CI,_,[]), + flag(result_num,R,R+1), + flag(result_num,ResNum,ResNum), + reset_eval_num, + if_t(ResNum=(not_compatio(format('~NDeterministic: ', [])), !); %or Nondet + ( Complete==true -> (not_compatio(format('~NLast Result(~w): ',[ResNum])),! ); + not_compatio(format('~NNDet Result(~w): ',[ResNum]))))), + ignore((( + not_compatio(if_t( \+ symbolic(Output), nop(nl))), + %if_t(ResNum==1,in_answer_io(format('~N['))), + in_answer_io(if_t((Prev\=@=prev_result('Empty')),write(', '))), + nb_setarg(1,Prev,Output), + user_io(with_indents(is_mettalog, + color_g_mesg_ok(yellow, + \+ \+ + (maplist(maybe_assign,NamedVarsList), + not_compatio(write_asrc(Output)), + in_answer_io(write_asrc(Output)))))) ))), + + not_compatio(with_output_to(user_error,give_time('Execution',Seconds))), + %not_compatio(give_time('Execution',Seconds), + color_g_mesg(green, + ignore((NamedVarsList \=@= Was ->(not_compatio(( + reverse(NamedVarsList,NamedVarsListR), + maplist(print_var,NamedVarsListR), nop(nl)))) ; true))))), + ( + (Complete \== true, WasInteractive, DoLeap \== leap, + LeashResults > ResNum, ResNum < Max) -> + (write("~npress ';' for more solutions "),get_single_char_key(C), + not_compatio((writeq(key=C),nl)), + (C=='b' -> (once(repl),fail) ; + (C=='m' -> make ; + (C=='t' -> (nop(set_debug(eval,true)),rtrace) ; + (C=='T' -> (set_debug(eval,true)); + (C==';' -> true ; + (C==esc('[A',[27,91,65]) -> nb_setarg(2, Control, leap) ; + (C=='L' -> nb_setarg(1, Control, ResNum) ; + (C=='l' -> nb_setarg(2, Control, leap) ; + (((C=='\n');(C=='\r')) -> (!,fail); + (!,fail)))))))))))); + (Complete\==true, \+ WasInteractive, Control = contrl(Max,leap)) -> true ; + (((Complete==true ->! ; true))))) + *-> (ignore(Result = res(FOut)),ignore(Output = (FOut))) + ; (flag(result_num,ResNum,ResNum),(ResNum==0-> + (in_answer_io(nop(write('['))),not_compatio(format('~N~n~n')),!,true);true))), + in_answer_io(write(']\n')), + ignore(Result = res(FOut)). + +maybe_assign(N=V):- ignore(V='$VAR'(N)). + +mqd:- + forall(metta_atom(_KB,['query-info',E,T,Q]), + (writeln(E), + term_variables(T,TVs), + term_variables(Q,QVs), + intersection(TVs,QVs,_,_,SVs), + notrace(eval(['match','&flybase',Q,T],SVs)))). + + +get_single_char_key(O):- get_single_char(C),get_single_char_key(C,O). +get_single_char_key(27,esc(A,[27|O])):- !,current_input(Input),read_pending_codes(Input,O,[]),name(A,O). +get_single_char_key(C,A):- name(A,[C]). + +forall_interactive(file(_),false,Complete,Goal,After):- !, Goal, (Complete==true -> ( After,!) ; ( \+ After )). +forall_interactive(prolog,false,Complete,Goal,After):- !, Goal, (Complete == true -> ! ; true), quietly(After). +forall_interactive(From,WasInteractive,Complete,Goal,After):- + (is_interactive(From) -> WasInteractive = true ; WasInteractive = false),!, + Goal, (Complete==true -> ( quietly(After),!) ; ( quietly( \+ After) )). + + + +print_var(Name=Var) :- print_var(Name,Var). +write_var(V):- var(V), !, write_dvar(V),!. +write_var('$VAR'(S)):- !, write_dvar(S),!. +write_var(V):- write_dvar(V),!. +%print_var(Name,_Var) :- symbol_concat('Num',Rest,Name),atom_number(Rest,_),!. +print_var(Name,Var):- write_var(Name), write(' = '), write_bsrc(Var), nl. + +write_asrc(Var):- Var=='Empty',is_compatio,!. +write_asrc(Var):- write_bsrc(Var),!. + +write_bsrc(Var):- Var=='Empty',!,write(Var). +write_bsrc(Var):- ground(Var),!,write_src(Var). +write_bsrc(Var):- copy_term(Var,Copy,Goals),Var=Copy,write_bsrc(Var,Goals). +write_bsrc(Var,[]):- write_src(Var). +write_bsrc(Var,[G|Goals]):- write_src(Var), write(' { '),write_src(G),maplist(write_src_space,Goals),writeln(' } '). + +write_src_space(Goal):- write(' '),write_src(Goal). + + +get_term_variables(Term, DontCaresN, CSingletonsN, CNonSingletonsN) :- + term_variables(Term, AllVars), + get_global_varnames(VNs), + writeqln(term_variables(Term, AllVars)=VNs), + term_singletons(Term, Singletons), + term_dont_cares(Term, DontCares), + include(not_in_eq(Singletons), AllVars, NonSingletons), + include(not_in_eq(DontCares), NonSingletons, CNonSingletons), + include(not_in_eq(DontCares), Singletons, CSingletons), + maplist(into_named_vars,[DontCares, CSingletons, CNonSingletons], + [DontCaresN, CSingletonsN, CNonSingletonsN]), + writeqln([DontCaresN, CSingletonsN, CNonSingletonsN]). + +term_dont_cares(Term, DontCares):- + term_variables(Term, AllVars), + get_global_varnames(VNs), + include(has_sub_var(AllVars),VNs,HVNs), + include(underscore_vars,HVNs,DontCareNs), + maplist(arg(2),DontCareNs,DontCares). + +into_named_vars(Vars,L):- is_list(Vars), !, maplist(name_for_var_vn,Vars,L). +into_named_vars(Vars,L):- term_variables(Vars,VVs),!,into_named_vars(VVs,L). + +has_sub_var(AllVars,_=V):- sub_var(V,AllVars). +underscore_vars(V):- var(V),!,name_for_var(V,N),!,underscore_vars(N). +underscore_vars(N=_):- !, symbolic(N),!,underscore_vars(N). +underscore_vars(N):- symbolic(N),!,symbol_concat('_',_,N). + +get_global_varnames(VNs):- nb_current('variable_names',VNs),VNs\==[],!. +get_global_varnames(VNs):- prolog_load_context(variable_names,VNs),!. +maybe_set_var_names(List):- List==[],!. +maybe_set_var_names(List):- % fbug(maybe_set_var_names(List)), + is_list(List),!,nb_linkval(variable_names,List). +maybe_set_var_names(_). + +name_for_var_vn(V,N=V):- name_for_var(V,N). + +name_for_var(V,N):- var(V),!,get_global_varnames(VNs),member(N=VV,VNs),VV==V,!. +name_for_var(N=_,N):- !. +name_for_var(V,N):- term_to_atom(V,N),!. + + +really_trace:- once(option_value('exec',rtrace);option_value('eval',rtrace);is_debugging((exec)); + is_debugging((eval))). +% !(pragma! exec rtrace) +may_rtrace(Goal):- really_trace,!, really_rtrace(Goal). +may_rtrace(Goal):- Goal*->true;( \+ tracing, trace,really_rtrace(Goal)). +really_rtrace(Goal):- is_transpiling,!,rtrace(call(Goal)). +really_rtrace(Goal):- with_debug((e),with_debug((exec),Goal)). + +rtrace_on_existence_error(G):- !, catch_err(G,E, (fbug(E=G), \+ tracing, trace, rtrace(G))). +%rtrace_on_existence_error(G):- catch(G,error(existence_error(procedure,W),Where),rtrace(G)). + +%prolog_only(Goal):- !,Goal. +prolog_only(Goal):- if_trace(prolog,Goal). + +write_compiled_exec(Exec,Goal):- +% ignore(Res = '$VAR'('ExecRes')), + compile_for_exec(Res,Exec,Goal), + notrace((color_g_mesg('#114411',print_pl_source(answer2(Res):-Goal)))). + +verbose_unify(Term):- verbose_unify(trace,Term). +verbose_unify(What,Term):- term_variables(Term,Vars),maplist(verbose_unify0(What),Vars),!. +verbose_unify0(What,Var):- put_attr(Var,verbose_unify,What). +verbose_unify:attr_unify_hook(Attr, Value) :- + format('~N~q~n',[verbose_unify:attr_unify_hook(Attr, Value)]), + vu(Attr,Value). +vu(_Attr,Value):- is_ftVar(Value),!. +vu(fail,_Value):- !, fail. +vu(true,_Value):- !. +vu(trace,_Value):- trace. + + +% Entry point for the user to call with tracing enabled +toplevel_goal(Goal) :- + term_variables(Goal,Vars), + interact(Vars, Goal, trace_off). + +% Entry point for the user to call with tracing enabled +trace_goal(Goal) :- + trace_goal(Goal, trace_on). + +% Handle tracing +trace_goal(Goal, Tracing) :- + (Tracing == trace_on -> writeln('Entering goal:'), writeln(Goal) ; true), + term_variables(Goal, Variables), + ( call(Goal) -> + (Tracing == trace_on -> writeln('Goal succeeded with:'), writeln(Variables) ; true), + interact(Variables, Goal, Tracing) + ; (Tracing == trace_on -> writeln('Goal failed.') ; true), + false + ). + +% Interaction with the user +interact(Variables, Goal, Tracing) :- + call(Goal),write('Solution: '), write_src(Variables), + write(' [;next]?'), + get_single_char(Code), + (command(Code, Command) -> + handle_command(Command, Variables, Goal, Tracing) + ; writeln('Unknown command.'), interact(Variables, Goal, Tracing) % handle unknown commands + ). + + +:- dynamic(is_installed_readline_editline/1). +:- volatile(is_installed_readline_editline/1). +install_readline_editline:- current_input(Input), install_readline(Input),!. + +% Write our own el_wrap rather than using the default one as do not want all the prolog completions. +% Can add mettalog completions later using add_prolog_commands/1 of swi_prolog:packages/libedit/editline.pl as template +el_wrap_metta(Input) :- + el_wrapped(Input), + !. +el_wrap_metta(Input) :- + stream_property(Input, tty(true)), !, + editline:el_wrap(swipl, Input, user_output, user_error), + add_metta_commands(Input), + forall(editline:el_setup(Input), true). +el_wrap_metta(_NoTTY). % For non-tty(true) clients over SWISH/Http/Rest server + +add_metta_commands(Input) :- + % TODO: It be nice for completion on file names but not prolog atoms + %editline:el_addfn(Input,complete,'Complete atoms and files',editline:complete), + %editline:el_addfn(Input,show_completions,'List completions',editline:show_completions), + editline:el_addfn(Input, electric, 'Indicate matching bracket', editline:electric), + editline:el_addfn(Input, isearch_history, 'Incremental search in history', editline:isearch_history), + %editline:el_bind(Input,["^I",complete]), + %editline:el_bind(Input,["^[?",show_completions]), + editline:el_bind(Input, ["^R", isearch_history]), + editline:bind_electric(Input), + editline:el_source(Input, _). + +install_readline(Input):- is_installed_readline_editline(Input),!. +%install_readline(_):- is_compatio,!. +install_readline(Input):- stream_property(Input,tty(true)), + assert(is_installed_readline_editline(Input)), + install_readline_editline1, + %use_module(library(readline)), + use_module(library(editline)), + %nop(catch(load_history,_,true)), + ignore(el_unwrap(Input)), % unwrap the prolog wrapper so we can use our own. + ignore(el_wrap_metta(Input)), + history_file_location(HistoryFile), + check_file_exists_for_append(HistoryFile), + el_read_history(Input,HistoryFile), + %add_history_string("!(load-flybase-full)"), + %add_history_string("!(pfb3)"), + %add_history_string("!(obo-alt-id $X BS:00063)"), + %add_history_string("!(and (total-rows $T TR$) (unique-values $T2 $Col $TR))"), + !. +install_readline(_NoTTY). % For non-tty(true) clients over SWISH/Http/Rest server + +:- dynamic setup_done/0. +:- volatile setup_done/0. + +install_readline_editline1 :- + setup_done, + !. +install_readline_editline1 :- + asserta(setup_done). +% Most all of these were overkill +% '$toplevel':( +% '$clean_history', +% apple_setup_app, +% '$run_initialization', +% '$load_system_init_file', +% set_toplevel, +% '$set_file_search_paths', +% init_debug_flags, +% start_pldoc, +% opt_attach_packs, +% load_init_file, +% catch(setup_backtrace, E1, print_message(warning, E1)), +% %catch(setup_readline, E2, print_message(warning, E2)), +% %catch(setup_history, E3, print_message(warning, E3)), +% catch(setup_colors, E4, print_message(warning, E4))), +% install_readline(Input). + + +% Command descriptions +command(59, retry). % ';' to retry +command(115, skip). % 's' to skip to the next solution +command(108, leap). % 'l' to leap (end the debugging session) +command(103, goals). % 'g' to show current goals +command(102, fail). % 'f' to force fail +command(116, trace). % 't' to toggle tracing +command(117, up). % 'u' to continue without interruption +command(101, exit). % 'e' to exit the debugger +command(97, abort). % 'a' to abort +command(98, break). % 'b' to set a breakpoint +command(99, creep). % 'c' to proceed step by step +command(104, help). % 'h' for help +command(65, alternatives). % 'A' for alternatives +command(109, make). % 'm' for make (recompile) +command(67, compile). % 'C' for Compile (compile new executable) + +:- style_check(-singleton). + +% Command implementations +handle_command(make, Variables, Goal, Tracing) :- + writeln('Recompiling...'), + % Insert the logic to recompile the code. + % This might involve calling `make/0` or similar. + make, % This is assuming your Prolog environment has a `make` predicate. + fail. % interact(Variables, Goal, Tracing). + +handle_command(compile, Variables, Goal, Tracing) :- + writeln('Compiling new executable...'), + % Insert the logic to compile a new executable. + % This will depend on how you compile Prolog programs in your environment. + % For example, you might use `qsave_program/2` to create an executable. + % Pseudocode: compile_executable(ExecutableName) + fail. % interact(Variables, Goal, Tracing). +handle_command(alternatives, Variables, Goal, Tracing) :- + writeln('Showing alternatives...'), + % Here you would include the logic for displaying the alternatives. + % For example, showing other clauses that could be tried for the current goal. + writeln('Alternatives for current goal:'), + writeln(Goal), + % Pseudocode: find_alternatives(Goal, Alternatives) + % Pseudocode: print_alternatives(Alternatives) + fail. % interact(Variables, Goal, Tracing). +% Extend the command handling with the 'help' command implementation +handle_command(help, Variables, Goal, Tracing) :- + print_help, + fail. % interact(Variables, Goal, Tracing). +handle_command(abort, _, _, _) :- + writeln('Aborting...'), abort. +handle_command(break, Variables, Goal, Tracing) :- + writeln('Breakpoint set.'), % Here you should define what 'setting a breakpoint' means in your context + fail. % interact(Variables, Goal, Tracing). +handle_command(creep, Variables, Goal, Tracing) :- + writeln('Creeping...'), % Here you should define how to 'creep' (step by step execution) through the code + trace. % interact(Variables, Goal, Tracing). +handle_command(retry, Variables, Goal, Tracing) :- + writeln('Continuing...'),!. + %trace_goal(Goal, Tracing). +handle_command(skip, Variables, Goal, Tracing) :- + writeln('Skipping...'). +handle_command(leap, _, _, _) :- + writeln('Leaping...'), nontrace. % Cut to ensure we stop the debugger +handle_command(goals, Variables, Goal, Tracing) :- + writeln('Current goal:'), writeln(Goal), + writeln('Current variables:'), writeln(Variables), + bt,fail. % interact(Variables, Goal, Tracing). +handle_command(fail, _, _, _) :- + writeln('Forcing failure...'), fail. +handle_command(trace, Variables, Goal, Tracing) :- + (Tracing == trace_on -> + NewTracing = trace_off, writeln('Tracing disabled.') + ; NewTracing = trace_on, writeln('Tracing enabled.') + ), + interact(Variables, Goal, NewTracing). +handle_command(up, Variables, Goal, Tracing) :- + writeln('Continuing up...'), + repeat, + ( trace_goal(Goal, Tracing) -> true ; !, fail ). +handle_command(exit, _, _, _) :- + writeln('Exiting debugger...'), !. % Cut to ensure we exit the debugger + +:- style_check(+singleton). + + +% Help description +print_help :- + writeln('Debugger commands:'), + writeln('(;) next - Retry with next solution.'), + writeln('(g) goal - Show the current goal.'), + writeln('(u) up - Finish this goal without interruption.'), + writeln('(s) skip - Skip to the next solution.'), + writeln('(c) creep or - Proceed step by step.'), + writeln('(l) leap - Leap over (the debugging).'), + writeln('(f) fail - Force the current goal to fail.'), + writeln('(B) back - Go back to the previous step.'), + writeln('(t) trace - Toggle tracing on or off.'), + writeln('(e) exit - Exit the debugger.'), + writeln('(a) abort - Abort the current operation.'), + writeln('(b) break - Break to a new sub-REPL.'), + writeln('(h) help - Display this help message.'), + writeln('(A) alternatives - Show alternative solutions.'), + writeln('(m) make - Recompile/Update the current running code.'), + writeln('(C) compile - Compile a fresh executable (based on the running state).'), + writeln('(E) error msg - Show the latest error messages.'), + writeln('(r) retry - Retry the previous command.'), + writeln('(I) info - Show information about the current state.'), + !. + + + + diff --git a/.Attic/canary_docme/metta_server.pl b/.Attic/canary_docme/metta_server.pl new file mode 100644 index 00000000000..9dc100ae641 --- /dev/null +++ b/.Attic/canary_docme/metta_server.pl @@ -0,0 +1,540 @@ +/* + * Project: MeTTaLog - A MeTTa to Prolog Transpiler/Interpreter + * Description: This file is part of the source code for a transpiler designed to convert + * MeTTa language programs into Prolog, utilizing the SWI-Prolog compiler for + * optimizing and transforming function/logic programs. It handles different + * logical constructs and performs conversions between functions and predicates. + * + * Author: Douglas R. Miles + * Contact: logicmoo@gmail.com / dmiles@logicmoo.org + * License: LGPL + * Repository: https://github.com/trueagi-io/metta-wam + * https://github.com/logicmoo/hyperon-wam + * Created Date: 8/23/2023 + * Last Modified: $LastChangedDate$ # You will replace this with Git automation + * + * Usage: This file is a part of the transpiler that transforms MeTTa programs into Prolog. For details + * on how to contribute or use this project, please refer to the repository README or the project documentation. + * + * Contribution: Contributions are welcome! For contributing guidelines, please check the CONTRIBUTING.md + * file in the repository. + * + * Notes: + * - Ensure you have SWI-Prolog installed and properly configured to use this transpiler. + * - This project is under active development, and we welcome feedback and contributions. + * + * Acknowledgments: Special thanks to all contributors and the open source community for their support and contributions. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the + * distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS + * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT + * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS + * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE + * COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, + * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; + * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER + * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN + * ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + * POSSIBILITY OF SUCH DAMAGE. + */ +% Load the socket and thread libraries for networking and concurrency +:- use_module(library(socket)). % Provides predicates for socket operations +:- use_module(library(thread)). % Provides predicates for multi-threading + +% Predicate to execute a goal and determine if it was deterministic +%! call_wdet(+Goal, -WasDet) is nondet. +% +% Calls the given Goal and checks if it was deterministic. +% +% @arg Goal is the goal to execute. +% @arg WasDet is true if the Goal was deterministic, false otherwise. +call_wdet(Goal,WasDet):- + % Execute the provided Goal + call(Goal), + % Check if the goal was deterministic and unify the result with WasDet + deterministic(WasDet). + +% Helper to parse Server and Port from Peer, using a DefaultPort if needed +%! parse_service_port(+Peer, +DefaultPort, -Server, -Port) is det. +% +% Parses the service and port from Peer input. Defaults to localhost +% and DefaultPort if not specified. +% +% @arg Peer is the input that could be in the form of Server:Port or just a Port. +% @arg DefaultPort is the port to use if Peer does not specify it. +% @arg Server is the output server address. +% @arg Port is the output port number. +parse_service_port(Peer,DefaultPort, Server, Port) :- + % Check if Peer is in the form Server:Port + ( Peer = Server:Port -> true + ; % If Peer is an integer, assume it's a port with localhost as the server + integer(Peer) -> Server = localhost, Port = Peer + ; % Otherwise, use Peer as the server and DefaultPort as the port + Server = Peer, Port = DefaultPort + ). + +% Predicate to check if a service is running under a specific alias +%! service_running(+Alias) is semidet. +% +% Checks if a thread with the given Alias is currently running. +% +% @arg Alias is the alias of the thread to check. +service_running(Alias):- + % Get the properties of the thread VSS and check if its status is running + thread_property(VSS,TS), + VSS = Alias, + TS = status(running), + !. + +% Start the interpreter service using the current self (MSpace) +%! start_vspace_service(+Port) is det. +% +% Starts the VSpace service on the specified Port, using the current self as MSpace. +% +% @arg Port is the port number on which the service will be started. +start_vspace_service(Port):- +%Getthecurrentself(MSpace) + current_self(MSpace), + % Start the VSpace service with the current MSpace and specified Port + start_vspace_service(MSpace,Port). + +% Start the VSpace service with a specific alias, MSpace, and Port +%! start_vspace_service(+Alias, +MSpace, +Port) is det. +% +% Starts the VSpace service with a specified Alias, MSpace, and Port. +% +% @arg Alias is the alias to assign to the service thread. +% @arg MSpace is the memory space in which the service will operate. +% @arg Port is the port number on which the service will be started. +start_vspace_service(MSpace,Port):- + % Concatenate 'vspace_service', MSpace, and Port into an Alias string + symbolic_list_concat([vspace_service,MSpace,Port],'_',Alias), + % Start the VSpace service with the generated Alias, MSpace, and Port + start_vspace_service(Alias,MSpace,Port). + +%! start_vspace_service(+Alias, +Space, +Port) is det. +% +% Starts the VSpace service only if it is not already running under the given Alias. +% +% @arg Alias is the alias to check for an existing service. + + +% Skip starting the service if it is already running +start_vspace_service(Alias,_Space,_Port):- + % If the service is already running under Alias, do nothing + service_running(Alias), + !. + +% Create a new thread to run the VSpace service if not already running +start_vspace_service(Alias,MSpace,Port):- + % Create a new thread to run the VSpace service with the given MSpace and Port + thread_create(run_vspace_service(MSpace,Port),_,[detached(true),alias(Alias)]). + +% Predicate to handle the situation when a port is already in use +%! handle_port_in_use(+MSpace, +Port) is det. +% +% Handles the error when the specified Port is already in use by trying another port. +% +% @arg MSpace is the memory space in which the service operates. +% @arg Port is the port number that is in use. +handle_port_in_use(MSpace,Port):- + % Record that the port was in use for MSpace + assert(was_vspace_port_in_use(MSpace,Port)), + % Try starting the service on Port + 100 + Port100 is Port +100, + run_vspace_service(MSpace,Port100). + + +% Run the VSpace service, handling the case where the port is already in use +%! run_vspace_service(+MSpace, +Port) is det. +% +% Runs the VSpace service on the specified Port, retrying on a different port if necessary. +% +% @arg MSpace is the memory space in which the service operates. +% @arg Port is the port number on which the service will be started. +run_vspace_service(MSpace,Port):- + % Attempt to run the service, catching the error if the port is in use + catch( + run_vspace_service_unsafe(MSpace,Port), + error(socket_error(eaddrinuse,_),_), + % If the port is in use, handle the situation + handle_port_in_use(MSpace, Port) + ). + +% Unsafe version of running the VSpace service that doesn't handle errors +%! run_vspace_service_unsafe(+MSpace, +Port) is det. +% +% Unsafe version of running the VSpace service on the specified Port. +% This version does not handle errors related to the port being in use. +% +% @arg MSpace is the memory space in which the service operates. +% @arg Port is the port number on which the service will be started. +run_vspace_service_unsafe(MSpace,Port) :- + % Create a TCP socket + tcp_socket(Socket), + % Bind the socket to the specified port + tcp_bind(Socket, Port), + % Listen on the socket with a backlog of 5 connections + tcp_listen(Socket, 5), + % Open the socket for listening + tcp_open_socket(Socket, ListenFd), + % Perform any compatibility checks (not_compatio is assumed to be a custom predicate) + not_compatio(fbugio(run_vspace_service(MSpace,Port))), + % Remove any existing vspace_port facts + retractall(vspace_port(_)), + % Assert the current port as the vspace_port + assert(vspace_port(Port)), + % Start accepting connections on the listening socket + accept_vspace_connections(MSpace,ListenFd). + +% Accept connections to the VSpace service and create a thread for each connection +%! accept_vspace_connections(+MSpace, +ListenFd) is det. +% +% Accepts incoming connections to the VSpace service and creates a thread for each connection. +% +% @arg MSpace is the memory space in which the service operates. +% @arg ListenFd is the file descriptor for the listening socket. +accept_vspace_connections(MSpace,ListenFd) :- + % Accept an incoming connection, returning a file descriptor and remote address + tcp_accept(ListenFd, RemoteFd, RemoteAddr), + % Set the current memory space for the thread + nb_setval(self_space,MSpace), + % Create a unique thread alias based on the remote address and file descriptor + format(atom(ThreadAlias0), 'peer_~w_~w_~w_', [RemoteAddr,RemoteFd,MSpace]), + % Generate a unique symbol for the thread alias + gensym(ThreadAlias0,ThreadAlias), + % Create a new thread to handle the connection + thread_create( + setup_call_cleanup( + % Open the socket as a stream + tcp_open_socket(RemoteFd, Stream), + % Generate a unique symbol for the thread alias + nb_setval(self_space,MSpace), + % Handle the connection by processing incoming goals + ignore(handle_vspace_peer(Stream)), + % Ensure the stream is closed when done + catch(close(Stream),_,true) + ), + _, + [detached(true), alias(ThreadAlias)] + ), + % Continue accepting more connections + accept_vspace_connections(MSpace,ListenFd). + +% Handle a peer connection by receiving and processing goals +%! handle_vspace_peer(+Stream) is det. +% +% Handles a peer connection by receiving and executing goals sent over the Stream. +% +% @arg Stream is the input/output stream connected to the peer. +handle_vspace_peer(Stream) :- + % Receive a Prolog term (goal) from the stream + recv_term(Stream, Goal), + % If the received term is not the end of file + ( Goal \= end_of_file + -> ( catch(call_wdet(Goal,WasDet), Error, true) + *-> ( var(Error) -> send_term(Stream, success(Goal,WasDet)) ; send_term(Stream,error(Error))) + ;send_term(Stream, 'failed'))), + handle_vspace_peer(Stream). + +any_to_i(A,I):- integer(A),I=A. +any_to_i(A,I):- format(atom(Ay),'~w',[A]),atom_number(Ay,I). +% Start the service automatically on a default port or a specified port +:- dynamic vspace_port/1. +get_vspace_port(Port):- current_prolog_flag('argv',L),member(AA,L),atom_concat('--service=',P,AA),atom_number(P,Port),!,set_prolog_flag('port',Port). +get_vspace_port(Port):- current_prolog_flag('port',P),any_to_i(P,Port),!. +get_vspace_port(Port):- vspace_port(Port),!. +get_vspace_port(Port):- Port = 3023. +start_vspace_service:- is_compiling,!. +start_vspace_service:- get_vspace_port(Port), start_vspace_service(Port),!. + + + + + + +% Helper to establish a connection to the VSpace service +%! connect_to_service(+HostPort, -Stream) is det. +% +% Connects to the VSpace service on the specified Host and Port and returns the Stream. +% +% @arg HostPort is the Host:Port combination or just a port number. +% @arg Stream is the output stream connected to the service. +connect_to_service(HostPort, Stream) :- + % Parse the Host and Port from the input HostPort + parse_service_port(HostPort, 3023, Host, Port), + % Create a TCP socket + tcp_socket(Socket), + % Connect the socket to the specified Host and Port + tcp_connect(Socket, Host:Port), + % Open the socket as a stream for communication + tcp_open_socket(Socket, Stream). + +% Helper to send a Prolog term and receive a response +%! send_term(+Stream, +MeTTa) is det. +% +% Sends a Prolog term (MeTTa) over the Stream. +% +% @arg Stream is the output stream to send the term through. +% @arg MeTTa is the Prolog term to send. +send_term(Stream, MeTTa) :- + % Write the term in canonical form to the stream + write_canonical(Stream, MeTTa), + % Write a period to indicate the end of the term + writeln(Stream, '.'), + % Flush the output to ensure the term is sent immediately + flush_output(Stream). + +recv_term(Stream, MeTTa) :- read_term(Stream, MeTTa, []). + + +% Read and process the service's response +read_response(Stream,Goal) :- + flush_output(Stream), + repeat, recv_term(Stream,Response), + (Response == failed -> (!,fail) ; + (Response = error(Throw) -> throw(Throw) ; + ((Response = success(Goal,WasDet)), + (WasDet==true-> (!, true) ; true)))). + +% Connects to the service and sends the goal +% ?- remote_call('localhost', member(X, [1,2,3])). +remote_call(Peer, Goal) :- + setup_call_cleanup( + (connect_to_service(Peer, Stream),send_term(Stream, Goal)), + read_response(Stream,Goal), + close(Stream)). + +remote_eval(Peer, MeTTa, Result) :- + remote_call(Peer, eval(MeTTa,Result)). + +/* +;; Example usage (from MeTTa) + +metta> !(remote-eval! localhost (add-atom &self (A b b))) +metta> !(remote-eval! localhost (add-atom &self (A b c))) +metta> !(remote-eval! localhost (match &self $Code $Code)) + +*/ + +% Declare remote_code/4 as a dynamic predicate to allow runtime modification +:- dynamic remote_code/4. % Maps MeTTa-Space and function to Service address + +% Get the current address of the service (Host:Port) +%! our_address(-HostPort) is det. +% +% Retrieves the current Host and Port of this service instance. +% +% @arg HostPort is the output in the form Host:Port. +our_address(Host:Port):- + % Get the hostname of the current machine + gethostname(Host), + % Retrieve the port number currently in use by this service + vspace_port(Port). + +% Check if this service instance exists at a given address +%! we_exist(+Addr) is det. +% +% Determines if the current service instance exists at the specified Addr. +% +% @arg Addr is the address to check (Host:Port). +we_exist(Addr):- + % Get the current address and unify it with Addr + our_address(Addr). + +% Check if another service exists at the specified address +%! they_exist(+Addr) is det. +% +% Determines if another service exists at the specified Addr. +% +% @arg Addr is the address to check (Host:Port). +they_exist(Addr):- + % Get the current service address + our_address(Ours), + % Ensure Addr is different from the current service address + diff(Addr,Ours), + execute_goal(we_exist(Addr)), \+ our_address(Addr). + +% tell the services that took our place about us. +register_ready:- + our_address(Ours), + forall(was_vspace_port_in_use(MSpace,Port), + remote_call(Port,register_remote_code(MSpace,we_exist(_),true,Ours))). + +% before we terminate we should call this +:- at_halt(register_gone). +register_gone:- \+ service_running(_),!. +register_gone:- + ignore(( + fail, + our_address(Ours), + forall(they_exist(Addr), + remote_call(Addr,unregister_peer(Ours))))). + +unregister_peer(Who):- + forall(remote_code(MSpace,EntryPoint, _, Who), + unregister_remote_code(MSpace,EntryPoint,Who)). + +% Registers a predicate to a service +register_remote_code(MSpace,EntryPoint, NonDet, Server) :- + unregister_remote_code(MSpace,EntryPoint, Server), + assertz(remote_code(MSpace,EntryPoint, NonDet, Server)). +unregister_remote_code(MSpace,EntryPoint, Server) :- + retractall(remote_code(MSpace,EntryPoint, _, Server)). + +% Execute a goal in the current memory space +%! execute_goal(+Goal) is det. +% +% Executes the specified goal in the current memory space. +% +% @arg Goal is the goal to execute. +execute_goal(Goal):- + % Get the current memory space (MSpace) + current_self(MSpace), + % Execute the goal in the current memory space and determine if it was deterministic + execute_goal(MSpace,Goal, IsDet), + % If the goal was deterministic, cut to prevent backtracking + (was_t(IsDet) -> ! ; true). + +% Always succeed if the goal is 'true' +execute_goal(_Self,true, _) :- !. +% Meta-interpreter with cut handling +%! execute_goal(+MSpace, +Goal, -IsDet) is det. +% +% Executes the specified goal within the given memory space, handling cuts and determinism. +% +% @arg MSpace is the memory space in which the goal will be executed. +% @arg Goal is the goal to execute. +% @arg IsDet is true if the goal was deterministic. +execute_goal(MSpace,Goal, IsDet) :- + remote_code(MSpace,Goal, NonDet, Peer), + % If the goal is registered for a service, call remotely + (was_t(NonDet) -> true ; !), + remote_call(Peer, execute_goal(MSpace,Goal,IsDet)). + +execute_goal(_Self,!, IsDet) :- !, IsDet = true. % Handle cuts +execute_goal(_Self,fail, IsDet) :- !, + (was_t(IsDet)->throw(cut_fail); fail). +execute_goal(MSpace,Goal, _) :- + predicate_property(Goal,number_of_clauses(_)),!, + clause(Goal, Body), % Retrieve the clause body for the goal + catch(execute_goal(MSpace,Body, IsDet),cut_fail,(!,fail)), + (was_t(IsDet)-> !; true). +execute_goal(MSpace,call(Cond), _ ) :- !, execute_goal(MSpace,Cond, IsDet), (was_t(IsDet)->!;true). +execute_goal(MSpace,(Cond, Then), IsDet) :- !, execute_goal(MSpace,Cond, IsDet), execute_goal(MSpace,Then, IsDet). +execute_goal(MSpace,(Cond; Else), IsDet) :- !, (execute_goal(MSpace,Cond, IsDet); execute_goal(MSpace,Else, IsDet)). +execute_goal(MSpace,(Cond *-> Then; Else), IsDet) :- !, (execute_goal(MSpace,Cond, IsDet) *-> execute_goal(MSpace,Then, IsDet) ; execute_goal(MSpace,Else, IsDet)). +execute_goal(MSpace,(Cond *-> Then), IsDet) :- !, (execute_goal(MSpace,Cond, IsDet) *-> execute_goal(MSpace,Then, IsDet)). +execute_goal(MSpace,(Cond -> Then; Else), IsDet) :- !, (execute_goal(MSpace,Cond, IsDet) -> execute_goal(MSpace,Then, IsDet) ; execute_goal(MSpace,Else, IsDet)). +execute_goal(MSpace,(Cond -> Then), IsDet) :- !, (execute_goal(MSpace,Cond, IsDet) -> execute_goal(MSpace,Then, IsDet)). +execute_goal(MSpace,catch(X, E, Z), IsDet) :- !, catch(execute_goal(MSpace,X, IsDet) , E, execute_goal(MSpace,Z, _)). +execute_goal(MSpace,findall(X, Y, Z), _) :- !, findall(X, execute_goal(MSpace,Y, _), Z). +execute_goal(MSpace,forall(X, Y), _) :- !, forall(execute_goal(MSpace,X, _), execute_goal(MSpace,Y, _)). +execute_goal(_Self,SubGoal, _IsCut) :- call_wdet(SubGoal, WasDet), (was_t(WasDet)->!;true). + +was_t(T):- T == true. + + +ccml_nth:attr_unify_hook(_Nth,_Var). + +metta_hyperpose_v0(P2, InList, OutList) :- + current_prolog_flag(cpu_count,Count), + length(InList,Len), length(OutList,Len), + max_min(Count,Len,_,Procs), + findall(thread(Goal, OutputVar), + (nth1(N, InList, InputVar), Goal = call(P2, InputVar, OutputVar), put_attr(OutputVar,ccml_nth,N)), + GoalsWithOutputs), + separate_goals_and_outputs(GoalsWithOutputs, Goals, OutList), + concurrent(Procs, Goals, []). + +separate_goals_and_outputs([], [], []). +separate_goals_and_outputs([thread(Goal, OutputVar)|GoalsWithOutputs], [Goal|Goals], [OutputVar|Outputs]) :- + separate_goals_and_outputs(GoalsWithOutputs, Goals, Outputs). + + + + + +%:- use_module(library(concurrent)). + +% Meta predicate that combines concurrent processing and result gathering +metta_concurrent_maplist(P2, InList, OutList) :- InList=[_,_|_],!, % only use extra threads iof 2 or more + setup_call_cleanup( + concurrent_assert_result(P2, InList, Tag), + gather_results_in_order(Tag, InList, OutList), + cleanup_results(Tag)). +metta_concurrent_maplist(P2, InList, OutList):- maplist(P2, InList, OutList). + +% Meta predicate that combines concurrent processing and result gathering +metta_hyperpose(Eq,RetType,Depth,MSpace,InList,Res) :- fail, InList=[_,_|_],!, % only use extra threads iof 2 or more + setup_call_cleanup( + concurrent_assert_result(eval_20(Eq,RetType,Depth,MSpace), InList, Tag), + each_result_in_order(Tag, InList, Res), + cleanup_results(Tag)). +metta_hyperpose(Eq,RetType,Depth,MSpace,ArgL,Res):- eval_20(Eq,RetType,Depth,MSpace,['superpose',ArgL],Res). + + +% Concurrently applies P2 to each element of InList, results are tagged with a unique identifier +concurrent_assert_result(P2, InList, Tag) :- + current_prolog_flag(cpu_count,Count), + length(InList,Len), max_min(Count,Len,_,Procs), + gensym(counter, Tag), % Generate a unique identifier + concurrent_forall( nth1(Index, InList, InputVar),assert_result_after_computation(P2, Tag, Index, InputVar), [threads(Procs)]). + %findall(assert_result_after_computation(P2, Tag, Index, InputVar), nth1(Index, InList, InputVar), Goals), + %concurrent(Procs, Goals, []). + +% Asserts the output of applying P2 to Input +assert_result_after_computation(P2, Tag, Index, Input) :- + catch( + (call(P2, Input, Output)*-> assert(result(Tag, Index, Input, Output)) ; assert(result(Tag, Index, Input, failed(Tag)))), + E, (assert(result(Tag, Index, Input, error(E))))). + + +% Gathers results in order, matching them with the corresponding inputs +gather_results_in_order(Tag, InList, OrderedResults) :- + gather_results_in_order(Tag, InList, 0, OrderedResults). + +use_result( IInput, RResult, Input, Result):- var(RResult),!,IInput=Input,Result=RResult. +use_result( IInput, error(E), Input, _Result):- ignore(IInput=Input),!, throw(E). +use_result( IInput, failed(_), Input, _Result):- ignore(IInput=Input),!,fail. +use_result( IInput, RResult, Input, Result):- IInput=Input,Result=RResult. + +gather_results_in_order(_, [], _, []). +gather_results_in_order(Tag, [Input|RestInputs], Index, [Result|OrderedResults]) :- + ( result(Tag, Index, IInput, RResult) + *-> (use_result( IInput, RResult, Input, Result),NextIndex is Index + 1,gather_results_in_order(Tag, RestInputs, NextIndex, OrderedResults)) + ; % Wait for 75 milliseconds before retrying + ( sleep(0.075), gather_results_in_order(Tag, [Input|RestInputs], Index, [Result|OrderedResults]))). + + +each_result_in_order(Tag, InList, OrderedResults) :- + each_result_in_order(Tag, InList, 0, OrderedResults). +each_result_in_order(_, [], _,_):-!,fail. +each_result_in_order(Tag, [Input|RestInputs], Index,Result) :- + ( result(Tag, Index, IInput, RResult) + *-> (use_result( IInput, RResult, Input, Result); + (NextIndex is Index + 1,each_result_in_order(Tag, RestInputs, NextIndex, Result))) + ; % Wait for 75 milliseconds before retrying + ( sleep(0.075), each_result_in_order(Tag, [Input|RestInputs], Index,Result))). + + +% Cleanup predicate to remove asserted results from the database +cleanup_results(Tag) :- + retractall(result(Tag, _, _, _)). + + +% :- initialization(start_vspace_service). + diff --git a/.Attic/canary_docme/metta_space.pl b/.Attic/canary_docme/metta_space.pl new file mode 100644 index 00000000000..fc96c1a295b --- /dev/null +++ b/.Attic/canary_docme/metta_space.pl @@ -0,0 +1,669 @@ +/* + * Project: MeTTaLog - A MeTTa to Prolog Transpiler/Interpreter + * Description: This file is part of the source code for a transpiler designed to convert + * MeTTa language programs into Prolog, utilizing the SWI-Prolog compiler for + * optimizing and transforming function/logic programs. It handles different + * logical constructs and performs conversions between functions and predicates. + * + * Author: Douglas R. Miles + * Contact: logicmoo@gmail.com / dmiles@logicmoo.org + * License: LGPL + * Repository: https://github.com/trueagi-io/metta-wam + * https://github.com/logicmoo/hyperon-wam + * Created Date: 8/23/2023 + * Last Modified: $LastChangedDate$ # You will replace this with Git automation + * + * Usage: This file is a part of the transpiler that transforms MeTTa programs into Prolog. For details + * on how to contribute or use this project, please refer to the repository README or the project documentation. + * + * Contribution: Contributions are welcome! For contributing guidelines, please check the CONTRIBUTING.md + * file in the repository. + * + * Notes: + * - Ensure you have SWI-Prolog installed and properly configured to use this transpiler. + * - This project is under active development, and we welcome feedback and contributions. + * + * Acknowledgments: Special thanks to all contributors and the open source community for their support and contributions. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the + * distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS + * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT + * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS + * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE + * COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, + * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; + * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER + * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN + * ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + * POSSIBILITY OF SUCH DAMAGE. + */ + + + +:- encoding(iso_latin_1). +:- flush_output. +:- setenv('RUST_BACKTRACE',full). +:- ensure_loaded(metta_compiler). +%:- ensure_loaded(metta_compiler). +% TODO move non flybase specific code between here and the compiler +%:- ensure_loaded(flybase_main). + +:- multifile(is_pre_statistic/2). +:- dynamic(is_pre_statistic/2). +save_pre_statistic(Name):- is_pre_statistic(Name,_)-> true; (statistics(Name,AS),term_number(AS,FN), + pfcAdd_Now(is_pre_statistic(Name,FN))). +pre_statistic(N,V):- is_pre_statistic(N,V)-> true ; V = 0. +post_statistic(N,V):- statistics(N,VV),term_number(VV,FV),pre_statistic(N,WV), V0 is FV-WV, (V0<0 -> V = 0 ; V0=V). +term_number(T,N):- sub_term(N,T),number(N). + + +call_match([G]):-!, call(G). +call_match([G|GG]):- !, call(G), call_match(GG). +call_match(G):- call(G). + +'save-space!'(Space,File):- + setup_call_cleanup( + open(File,write,Out,[]), + with_output_to(Out, + forall(get_atoms(Space,Atom), + write_src(Atom))), + close(Out)). + + +:- dynamic(repeats/1). +:- dynamic(not_repeats/1). +assert_new(P):- notrace(catch(call(P),_,fail)),!, + assert_new1(repeats(P)). +assert_new(P):- pfcAdd_Now(P), flag(assert_new,TA,TA+1),assert_new1(not_repeats(P)),!. + +retract1(P):- \+ call(P),!. +retract1(P):- ignore(\+ retract(P)). + +assert_new1(P):- \+ \+ call(P),!. +assert_new1(P):- pfcAdd_Now(P). + + +:- dynamic(fb_pred/3). +:- dynamic(mod_f_a/3). +decl_m_fb_pred(Mod,Fn,A):- var(Mod),!,mod_f_a(Mod,Fn,A). +decl_m_fb_pred(Mod,Fn,A):- mod_f_a(Mod,Fn,A)->true; + (dynamic(Mod:Fn/A), + pfcAdd_Now(mod_f_a(Mod,Fn,A))). +:- dynamic(fb_pred_file/3). +decl_fb_pred(Fn,A):- + (fb_pred(Fn,A)-> true; (dynamic(Fn/A),pfcAdd_Now(fb_pred(Fn,A)))), + ignore((nb_current(loading_file,File), + (fb_pred_file(Fn,A,File)-> true; pfcAdd_Now(fb_pred_file(Fn,A,File))))). +% Import necessary libraries +:- use_module(library(readutil)). + + +skip(_). + +% =============================== +% MeTTa Python incoming interface +% =============================== + +% ============================ +% %%%% Atom Manipulations +% ============================ + +% Clear all atoms from a space +'clear-atoms'(SpaceNameOrInstance) :- + dout(space,['clear-atoms',SpaceNameOrInstance]), + space_type_method(Type,clear_space,Method), call(Type,SpaceNameOrInstance),!, + dout(space,['type-method',Type,Method]), + call(Method,SpaceNameOrInstance). + +% Add an atom to the space +'add-atom'(SpaceNameOrInstance, Atom) :- % dout(space,['add-atom',SpaceNameOrInstance, Atom]), + (( space_type_method(Type,add_atom,Method), call(Type,SpaceNameOrInstance),!, + if_t((SpaceNameOrInstance\=='&self' ; Type\=='is_asserted_space'), + dout(space,['type-method',Type,Method,SpaceNameOrInstance,Atom])), + call(Method,SpaceNameOrInstance,Atom))). +% Add Atom +'add-atom'(Environment, AtomDeclaration, Result):- + eval_args(['add-atom', Environment, AtomDeclaration], Result). + +% remove an atom from the space +'remove-atom'(SpaceNameOrInstance, Atom) :- + dout(space,['remove-atom',SpaceNameOrInstance, Atom]), + space_type_method(Type,remove_atom,Method), call(Type,SpaceNameOrInstance),!, + dout(space,['type-method',Type,Method]), + call(Method,SpaceNameOrInstance,Atom). +% Remove Atom +'remove-atom'(Environment, AtomDeclaration, Result):- eval_args(['remove-atom', Environment, AtomDeclaration], Result). + +% Add an atom to the space +'replace-atom'(SpaceNameOrInstance, Atom, New) :- + dout(space,['replace-atom',SpaceNameOrInstance, Atom, New]), + space_type_method(Type,replace_atom,Method), call(Type,SpaceNameOrInstance),!, + dout(space,['type-method',Type,Method]), + call(Method,SpaceNameOrInstance,Atom, New). +% Replace Atom +'atom-replace'(Environment, OldAtom, NewAtom, Result):- eval_args(['atom-replace', Environment, OldAtom, NewAtom], Result). + +% Count atoms in a space +'atom-count'(SpaceNameOrInstance, Count) :- + dout(space,['atom-count',SpaceNameOrInstance]), + space_type_method(Type,atom_count,Method), call(Type,SpaceNameOrInstance),!, + call(Method,SpaceNameOrInstance,Count), + dout(space,['type-method-result',Type,Method,Count]). +% Count Atoms +'atom-count'(Environment, Count):- eval_args(['atom-count', Environment], Count). + +% Fetch all atoms from a space +'get-atoms'(SpaceNameOrInstance, AtomsL) :- + dout(space,['get-atoms',SpaceNameOrInstance]), + space_type_method(Type,get_atoms,Method), call(Type,SpaceNameOrInstance),!, + call(Method,SpaceNameOrInstance, AtomsL), + %dout(space,['type-method-result',Type,Method,Count]). + %length(AtomsL,Count), + true. +% Get Atoms +'get-atoms'(Environment, Atoms):- eval_args(['get-atoms', Environment], Atoms). + +% Iterate all atoms from a space +'atoms_iter'(SpaceNameOrInstance, Iter) :- + dout(space,['atoms_iter',SpaceNameOrInstance]), + space_type_method(Type,atoms_iter,Method), call(Type,SpaceNameOrInstance),!, + call(Method,SpaceNameOrInstance, Iter), + dout(space,['type-method-result',Type,Method,Iter]). + +% Match all atoms from a space +'atoms_match'(SpaceNameOrInstance, Atoms, Template, Else) :- + space_type_method(Type,atoms_match,Method), call(Type,SpaceNameOrInstance),!, + call(Method,SpaceNameOrInstance, Atoms, Template, Else), + dout(space,['type-method-result',Type,Method,Atoms, Template, Else]). + + +% Query all atoms from a space +'space_query'(SpaceNameOrInstance, QueryAtom, Result) :- + space_type_method(Type,query,Method), call(Type,SpaceNameOrInstance),!, + call(Method,SpaceNameOrInstance, QueryAtom, Result), + dout(space,['type-method-result',Type,Method,Result]). + + +subst_pattern_template(SpaceNameOrInstance, Pattern, Template) :- + dout(space,[subst_pattern_template,SpaceNameOrInstance, Pattern, Template]), + 'atoms_match'(SpaceNameOrInstance, Pattern, Template, []). + +/* +space_query_vars(SpaceNameOrInstance, Query, Vars) :- is_as_nb_space(SpaceNameOrInstance),!, + fetch_or_create_space(SpaceNameOrInstance, Space), + call_metta(Space,Query,Vars). +*/ :- dynamic(was_asserted_space/1). + +was_asserted_space('&self'). +was_asserted_space('&stdlib'). +was_asserted_space('&corelib'). +was_asserted_space('&flybase'). +/* +was_asserted_space('&attentional_focus'). +was_asserted_space('&belief_events'). +was_asserted_space('&goal_events'). +was_asserted_space('&tempset'). +was_asserted_space('&concepts'). +was_asserted_space('&belief_events'). +*/ +is_asserted_space(X):- was_asserted_space(X). +is_asserted_space(X):- \+ is_as_nb_space(X), \+ py_named_space(X),!. + +is_python_space_not_prolog(X):- \+ is_as_nb_space(X), \+ is_asserted_space(X). + +:- dynamic(is_python_space/1). + +:- dynamic(py_named_space/1). + +%py_named_space('&self'). +%py_named_space('&vspace'). +% Function to check if an atom is registered as a space name +:- dynamic is_registered_space_name/1. +is_as_nb_space('&nb'). +is_as_nb_space(G):- is_valid_nb_space(G) -> true ; + is_registered_space_name(G),nb_current(G,S),is_valid_nb_space(S). + +is_nb_space(G):- nonvar(G), is_as_nb_space(G). +% ============================ +% %%%% Pattern Matching +% ============================ +% Pattern Matching with an else branch +%'match'(Environment, Pattern, Template, ElseBranch, Result):- +% eval_args(['match', Environment, Pattern, Template, ElseBranch], Result). +% Pattern Matching without an else branch +'match'(Environment, Pattern, Template, Result):- + eval_args(['match', Environment, Pattern, Template], Result). +%'match'(_Environment, Pattern, Template, Result):- callable(Pattern),!, call(Pattern),Result=Template. +%'match'(_Environment, Pattern, Template, Result):- !, is_True(Pattern),Result=Template. + + +'new-space'(Space):- gensym('hyperon::space::DynSpace@_',Name), + fetch_or_create_space(Name, Space). + +:- dynamic(is_python_space/1). +% =============================== +% MeTTa Python incoming interface +% =============================== + +:- multifile(space_type_method/3). +:- dynamic(space_type_method/3). +space_type_method(is_as_nb_space,new_space,init_space). +space_type_method(is_as_nb_space,clear_space,clear_nb_atoms). +space_type_method(is_as_nb_space,add_atom,add_nb_atom). +space_type_method(is_as_nb_space,remove_atom,remove_nb_atom). +space_type_method(is_as_nb_space,replace_atom,replace_nb_atom). +space_type_method(is_as_nb_space,atom_count,atom_nb_count). +space_type_method(is_as_nb_space,get_atoms,get_nb_atoms). +%space_type_method(is_as_nb_space,get_atoms,arg(1)). +space_type_method(is_as_nb_space,atom_iter,atom_nb_iter). +%space_type_method(is_as_nb_space,query,space_nb_query). + +% Clear all atoms from a space +clear_nb_atoms(SpaceNameOrInstance) :- + fetch_or_create_space(SpaceNameOrInstance, Space), + nb_setarg(1, Space, []). + +% Add an atom to the space +add_nb_atom(SpaceNameOrInstance, Atom) :- + fetch_or_create_space(SpaceNameOrInstance, Space), + arg(1, Space, Atoms), + NewAtoms = [Atom | Atoms], + nb_setarg(1, Space, NewAtoms). + +% Count atoms in a space +atom_nb_count(SpaceNameOrInstance, Count) :- + fetch_or_create_space(SpaceNameOrInstance, Space), + arg(1, Space, Atoms), + length(Atoms, Count). + +% Remove an atom from a space +remove_nb_atom(SpaceNameOrInstance, Atom) :- + fetch_or_create_space(SpaceNameOrInstance, Space), + arg(1, Space, Atoms), + select(Atom, Atoms, UpdatedAtoms), + nb_setarg(1, Space, UpdatedAtoms). + +% Fetch all atoms from a space +get_nb_atoms(SpaceNameOrInstance, Atoms) :- + fetch_or_create_space(SpaceNameOrInstance, Space), + arg(1, Space, Atoms). + +% Replace an atom in the space +replace_nb_atom(SpaceNameOrInstance, OldAtom, NewAtom) :- + fetch_or_create_space(SpaceNameOrInstance, Space), + arg(1, Space, Atoms), + ( (select(Found, Atoms, TempAtoms),OldAtom=@=Found) + -> NewAtoms = [NewAtom | TempAtoms], + nb_setarg(1, Space, NewAtoms) + ; false + ). + + + +% Function to confirm if a term represents a space +is_valid_nb_space(Space):- compound(Space),functor(Space,'Space',_). + +% Find the original name of a given space +space_original_name(Space, Name) :- + is_registered_space_name(Name), + nb_current(Name, Space). + +% Register and initialize a new space +init_space(Name) :- + Space = 'Space'([]), + asserta(is_registered_space_name(Name)), + nb_setval(Name, Space). + +fetch_or_create_space(Name):- fetch_or_create_space(Name,_). +% Fetch an existing space or create a new one +fetch_or_create_space(NameOrInstance, Space) :- + ( atom(NameOrInstance) + -> (is_registered_space_name(NameOrInstance) + -> nb_current(NameOrInstance, Space) + ; init_space(NameOrInstance), + nb_current(NameOrInstance, Space)) + ; is_valid_nb_space(NameOrInstance) + -> Space = NameOrInstance + ; writeln('Error: Invalid input.') + ), + is_valid_nb_space(Space). + + +% Match Pattern in Space and produce Template +'match'(Space, Pattern, Template) :- + 'get-atoms'(Space, Atoms), + 'match-pattern'(Atoms, Pattern, Template). + +% Simple pattern match +'match-pattern'([], _, []). +'match-pattern'([H |_T], H, H) :- !. +'match-pattern'([_H| T], Pattern, Template) :- 'match-pattern'(T, Pattern, Template). + +%is_python_space(X):- python_object(X). + +ensure_space(X,Y):- catch(ensure_space_py(X,Y),_,fail),!. +ensure_space(_N,_V):- fail. + +% =============================== +% Clause Database interface +% =============================== +%dout(space,Call):- skip(Call). +if_metta_debug(Goal):- getenv('VSPACE_VERBOSE','2'),!,ignore(call(Goal)). +if_metta_debug(_):-!. +if_metta_debug(Goal):- !,ignore(call(Goal)). +dout(_,_):-!. +dout(W,Term):- notrace(if_metta_debug((format('~N; ~w ~@~n',[W,write_src(Term)])))). + +:- multifile(space_type_method/3). +:- dynamic(space_type_method/3). +space_type_method(is_asserted_space,new_space,init_space). +space_type_method(is_asserted_space,clear_space,clear_nb_atoms). +space_type_method(is_asserted_space,add_atom,metta_assertdb_add). +space_type_method(is_asserted_space,remove_atom,metta_assertdb_rem). +space_type_method(is_asserted_space,replace_atom,metta_assertdb_replace). +space_type_method(is_asserted_space,atom_count,metta_assertdb_count). +space_type_method(is_asserted_space,get_atoms,metta_assertdb_get_atoms). +space_type_method(is_asserted_space,atom_iter,metta_assertdb_iter). +%space_type_method(is_asserted_space,query,space_nb_query). + +%:- dynamic(for_metta/2). +%for_metta(_,T):- fb_pred(F,A),functor(T,F,A),call(T). +metta_assertdb_ls(KB):- + AMA = metta_atom_asserted, + decl_m_fb_pred(user,AMA,2), + MP =.. [AMA,KB,_], + listing(MP). + +metta_assertdb_add(KB,AtomIn):- + must_det_ll((subst_vars(AtomIn,Atom), + AMA = metta_atom_asserted, + decl_m_fb_pred(user,AMA,2), + MP =.. [AMA,KB,Atom], + assert_new(MP))). +metta_assertdb_rem(KB,Old):- metta_assertdb_del(KB,Old). +metta_assertdb_del(KB,Atom):- subst_vars(Atom,Old), + decl_m_fb_pred(user,metta_atom_asserted,2), + MP = metta_atom(KB,Old), + copy_term(MP,Copy), clause(MP,true,Ref), MP=@= Copy, !, erase(Ref). % ,metta_assertdb('DEL',Old). +metta_assertdb_replace(KB,Old,New):- metta_assertdb_del(KB,Old), metta_assertdb_add(KB,New). + + + +atom_count_provider(Self,Count):- + user:loaded_into_kb(Self,Filename), + once(user:asserted_metta_pred(Mangle,Filename)), + mangle_iz(Mangle,Iz), + member(P,[Mangle,Iz]), + between(2,8,Arity), + functor(Data,P,Arity), + predicate_property(Data,number_of_clauses(CC)), + predicate_property(Data,number_of_rules(RC)), + Count is CC - RC. + +atom_count_provider(KB,Count):- + must_det_ll(( + AMA = metta_atom_asserted, + decl_m_fb_pred(user,AMA,2), + MP =.. [AMA,KB,_], + predicate_property(MP,number_of_clauses(SL2)), + predicate_property(MP,number_of_rules(SL3)), + %metta_assertdb_ls(KB), + full_atom_count(SL1), + Count is SL1 + SL2 - SL3)),!. + +metta_assertdb_count(KB,Count):- + findall(C,atom_count_provider(KB,C),CL), + sumlist(CL,Count). + + + +%metta_assertdb_count(KB,Count):- writeln(metta_assertdb_count_in(KB,Count)), findall(Atom,for_metta(KB,Atom),AtomsL),length(AtomsL,Count),writeln(metta_assertdb_count_out(KB,Count)). +metta_assertdb_iter(KB,Atoms):- + MP =.. [metta_atom,KB,Atoms], + call(MP). + + + +metta_iter_bind(KB,Query,Vars,VarNames):- + term_variables(Query,QVars), + align_varnames(VarNames,Vars), + TV = dout(space,['match',KB,Query,QVars,Vars,VarNames]), +% \+ \+ (numbervars(TV,0,_,[]),print(tv=TV),nl), + ignore(QVars=Vars), +% \+ \+ (numbervars(TV,0,_,[]),print(qv=TV),nl), + \+ \+ (%numbervars(TV,0,_,[]), + writeq(av=TV),nl), + space_query_vars(KB,Query,TF),TF\=='False'. + + +% Query from hyperon.base.GroundingSpace +space_query_vars(KB,Query,Vars):- is_asserted_space(KB),!, + decl_m_fb_pred(user,metta_atom_asserted,2), + call_metta(KB,Query,Vars), + dout('RES',space_query_vars(KB,Query,Vars)). + + +metta_assertdb_get_atoms(KB,Atom):- metta_atom(KB,Atom). +/* + +%metta_assertdb_iter_bind(KB,Query,Template,AtomsL):- +decl_m_fb_pred(user,metta_atom_asserted,2), findall(Template,metta_atom(KB,Query),AtomsL). +metta_assertdb_iter_bind(KB,Query,Vars):- + ignore(term_variables(Query,Vars)), + print(metta_assertdb(['match',KB,Query,Vars])),nl, + AMA = metta_atom_asserted, + decl_m_fb_pred(user,AMA,2), + MP =.. [AMA,KB,Query], + + (MP*->true;call_metta_assertdb(KB,Query,Vars)), + metta_assertdb('RES',metta_assertdb_iter_bind(KB,Query,Vars)). +%metta_assertdb_iter_bind(KB,Atom,Template):- metta_assertdb_stats, findall(Template,metta_assertdb_iter(KB,Atom),VarList). + +metta_assertdb_iter_bind(KB,Atoms,Vars):- + metta_assertdb_stats, + term_variables(Atoms,AVars), + metta_assertdb_iter(KB,Atoms), ignore(AVars = Vars). +*/ + + +align_varnames(VarNames,Vars):- + list_to_set(VarNames,NameSet), + merge_named_vars(NameSet,VarNames,Vars). + +merge_named_vars([],_VarNames,_Vars):-!. +merge_named_vars([N|NameSet],VarNames,Vars):- + merge_named(N,_V,VarNames,Vars), + merge_named_vars(NameSet,VarNames,Vars). +%merge_named_vars(_,_,_). + +merge_named(_,_,[],[]):-!. +merge_named(N,V,[N|VarNames],[V|Vars]):- + merge_named(N,V,VarNames,Vars). + + +call_metta( KB,Query,_Vars):- metta_atom(KB,Query). +call_metta(_KB,Query,_Vars):- metta_to_pyswip([],Query,Call),!, + %print(user:Call),nl, + user:call(Call). + +metta_to_pyswip(_PS,Query,Call):- var(Query),!,Call=Query. +metta_to_pyswip(_PS,Query,Call):- \+ compound(Query),!,Call=Query,!. +metta_to_pyswip(PS,Query,Call):- is_list(Query),Query=[Q|Uery],!,cmpd_to_pyswip(PS,Q,Uery,Call). +metta_to_pyswip(PS,Query,Call):- Query=..[Q|Uery], cmpd_to_pyswip(PS,Q,Uery,Call). + +cmpd_to_pyswip(PS,Q,Uery,Call):- atom(Q),maplist(metta_to_pyswip([Q|PS]),Uery,Cery),Call=..[Q|Cery]. +cmpd_to_pyswip(PS,"and",Uery,Call):- maplist(metta_to_pyswip(PS),Uery,Args),list_to_conjuncts(Args,Call). + + +'show-metta-def'(Pred, []):- + 'get-metta-src'(Pred,[_|SrcL]), + maplist(write_src_nl,SrcL). + +write_src_nl(Src):- format('~N'),write_src(Src),format('~N'). + +%'get-metta-src'(Pred,[Len|SrcL]):- findall(['AtomDef',Src],'get-metta-src1'(Pred,Src),SrcL), length(SrcL,Len). +'get-metta-src'(Pred,[Len|SrcL]):- findall(Src,'get-metta-src1'(Pred,Src),SrcL), length(SrcL,Len). +'get-metta-src1'(Pred,Src):- + current_self(Space), + metta_atom(Space,F,A,List), + once((sub_var(Pred,A)->Src = [F,A,List];sub_var(Pred,F)->Src = [F,A|List])). + +% is a quine +'AtomDef'(X,['AtomDef',X]). + + +sort_on(C,R,A,B):- (A==B-> R= (=) ; must_det_ll((call(C,A,AA),call(C,B,BB),!,compare(R,AA+A,BB+B)))),!. +tokens(X,VL):- unaccent_atom(X,A),!, findall(E,(is_tokenizer(T),call(T,A,E)),L),predsort(sort_on(length_fw_len),L,S),last(S,VL). + +length_fw_len([W|List],L+WL):- length(List,L),atom_length(W,WL). + +print_token_args:- make, + fb_arg(X),tokens(X,A0), + exclude(is_dash,A0,A),tterm(A,AT),writeq(X),write(' '),writeq(AT),write(' '),write_src(A),nl,fail. +is_dash('_'). +is_dash('-'). +tterm([A],A):-!. +tterm([A,':',B|M],BA):- atom(A),!,BA=..[A,B|M]. +tterm([A,B|M],BA):- atom(B),!,BA=..[B,A|M]. +tterm([A|B],BA):- atom(A),!,BA=..[B|A]. +tterm(A,A). + +is_tokenizer(into_list). +is_tokenizer(to_case_break_atoms). +is_tokenizer(atom_to_stem_list). +is_tokenizer(tokenize_atom). +%is_tokenizer(double_metaphone). + + + +is_an_arg_type(S,T):- flybase_identifier(S,T),!. +has_type(S,Type):- sub_atom(S,0,4,Aft,FB),flybase_identifier(FB,Type),!,Aft>0. + + +call_sexpr(S):- once_writeq_ln(call_sexpr(S)). +%call_sexpr(Space,Expr,Result):- + +:- dynamic(fb_pred/2). + +full_atom_count(SL):- flag(total_loaded_atoms,SL,SL),SL>1,!. +full_atom_count(SL):- findall(NC,(fb_pred(F,A),metta_stats(F,A,NC)),Each), sumlist(Each,SL). + +heartbeat :- + % Get the current time and the last printed time + get_time(CurrentTime), + % Check if the global variable is set + ( nb_current(last_printed_time, _) + -> true + ; nb_setval(last_printed_time, CurrentTime) + ), + + nb_getval(last_printed_time, LastPrintedTime), + + % Calculate the difference + Diff is CurrentTime - LastPrintedTime, + + % If the difference is greater than or equal to 60 seconds (1 minute) + ( Diff >= 60 + -> % Print the heartbeat message and update the last printed time + metta_stats + ; % Otherwise, do nothing + true + ). + +metta_stats:- gc_now, + writeln('\n\n\n\n\n\n;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'), + writeln(';~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'), + full_atom_count(SL), + format("~N~n; Total\t\tAtoms (Atomspace size): ~`.t ~D~108|~n",[SL]), + get_time(CurrentTime), nb_setval(last_printed_time, CurrentTime), + post_statistic(memory,Mem), + post_statistic(atom_space,AS), + post_statistic(cputime,TotalSeconds), + post_statistic(atoms,Concepts), + flag(assert_new,CTs,CTs), + post_statistic(stack,StackMem), + + + PM is Mem + StackMem, + RM is Mem-AS, + PA is RM//(SL+1), + APS is 60*floor(SL/(TotalSeconds+1)), + ACS is AS//(Concepts+1), + + pl_stats('SymbolAtoms',Concepts), + pl_stats('Random samples',CTs), + skip((pl_stats('Bytes Per Atom (Average)',PA), pl_stats('Bytes Per ConceptNode (Average)',ACS))), + skip((pl_stats('Relational Memory',RM), pl_stats('ConceptNode Memory',AS))), + %pl_stats('Queryspace Memory',StackMem), + %CPU is CPUTime-57600, + format_time(TotalSeconds, Formatted), + skip((pl_stats('Atoms per minute',APS))), + pl_stats('Total Memory Used',PM), + pl_stats('Runtime (days:hh:mm:ss)',Formatted), + nl,nl,!. +metta_stats(F):- for_all(fb_pred(F,A),metta_stats(F,A)). +metta_stats(F,A):- metta_stats(F,A,NC), pl_stats(F/A,NC). +metta_stats(F,A,NC):- functor(P,F,A),predicate_property(P,number_of_clauses(NC)). +pl_stats(Stat):- statistics(Stat,Value),pl_stats(Stat,Value). +pl_stats(Stat,[Value|_]):- nonvar(Value),!, pl_stats(Stat,Value). +pl_stats(Stat,Value):- format("~N;\t\t~@: ~`.t ~@~100|",[format_value(Stat),format_value(Value)]),!. + + +% AsPred to print the formatted result. +format_value(Value) :- float(Value),!,format("~2f",[Value]),!. +format_value(Bytes) :- integer(Bytes),format_bytes(Bytes, Formatted), write(Formatted). +format_value(Term) :- format("~w",[Term]). +% Base case: If the number is 1G or more, show it in gigabytes (G). +format_bytes(Bytes, Formatted) :- Bytes >= 1073741824, GB is Bytes / 1073741824, format(string(Formatted), '~2fG', [GB]). +% If the number is less than 1G, show it in megabytes (M). +format_bytes(Bytes, Formatted) :- Bytes >= 104857600, Bytes < 1073741824, !, MB is Bytes / 1048576, D is floor(MB), format(string(Formatted), '~DM', [D]). +% If the number is less than 1K, show it in bytes (B). +format_bytes(Bytes, Formatted) :- format(string(Formatted), '~D', [Bytes]). +% % If the number is less than 1M, show it in kilobytes (K). +%format_bytes(Bytes, Formatted) :- Bytes >= 1024, Bytes < 1048576, !, KB is Bytes / 1024, format(string(Formatted), '~0fK', [KB]). + +% Convert total seconds to days, hours, minutes, seconds, and milliseconds. +format_time(TotalSeconds, Formatted) :- + Seconds is floor(TotalSeconds), + % Get days, remaining seconds + Days is div(Seconds, 86400), + Remain1 is mod(Seconds, 86400)-57600, + format_time(string(Out),'%T',Remain1), + % Format the result + format(string(Formatted), '~w:~w', [Days, Out]). + +% AsPred to print the formatted time. +print_formatted_time(TotalSeconds) :- + format_time(TotalSeconds, Formatted), + writeln(Formatted). + + +metta_final:- + save_pre_statistic(memory), + save_pre_statistic(atoms), + save_pre_statistic(atom_space). +/* +symbol(X):- atom(X). +symbol_number(S,N):- atom_number(S,N). +symbol_string(S,N):- atom_string(S,N). +symbol_chars(S,N):- atom_chars(S,N). +symbol_length(S,N):- atom_length(S,N). +symbol_concat(A,B,C):- atom_concat(A,B,C). +symbolic_list_concat(A,B,C):- atomic_list_concat(A,B,C). +symbolic_list_concat(A,B):- atomic_list_concat(A,B). +symbol_contains(T,TT):- atom_contains(T,TT). +*/ + diff --git a/.Attic/canary_docme/metta_subst.pl b/.Attic/canary_docme/metta_subst.pl new file mode 100644 index 00000000000..64c6cfc504f --- /dev/null +++ b/.Attic/canary_docme/metta_subst.pl @@ -0,0 +1,932 @@ +/* + * Project: MeTTaLog - A MeTTa to Prolog Transpiler/Interpreter + * Description: This file is part of the source code for a transpiler designed to convert + * MeTTa language programs into Prolog, utilizing the SWI-Prolog compiler for + * optimizing and transforming function/logic programs. It handles different + * logical constructs and performs conversions between functions and predicates. + * + * Author: Douglas R. Miles + * Contact: logicmoo@gmail.com / dmiles@logicmoo.org + * License: LGPL + * Repository: https://github.com/trueagi-io/metta-wam + * https://github.com/logicmoo/hyperon-wam + * Created Date: 8/23/2023 + * Last Modified: $LastChangedDate$ # You will replace this with Git automation + * + * Usage: This file is a part of the transpiler that transforms MeTTa programs into Prolog. For details + * on how to contribute or use this project, please refer to the repository README or the project documentation. + * + * Contribution: Contributions are welcome! For contributing guidelines, please check the CONTRIBUTING.md + * file in the repository. + * + * Notes: + * - Ensure you have SWI-Prolog installed and properly configured to use this transpiler. + * - This project is under active development, and we welcome feedback and contributions. + * + * Acknowledgments: Special thanks to all contributors and the open source community for their support and contributions. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the + * distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS + * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT + * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS + * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE + * COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, + * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; + * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER + * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN + * ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + * POSSIBILITY OF SUCH DAMAGE. + */ + +%self_subst(X):- var(X),!. +%self_subst(X):- string(X),!. +%self_subst(X):- number(X),!. +%self_subst([]). +self_subst(X):- \+ callable(X),!. +self_subst(X):- !, self_eval(X),!. +self_subst(X):- is_valid_nb_state(X),!. +self_subst(X):- is_list(X),!,fail. +%self_subst(X):- compound(X),!. +%self_subst(X):- is_ref(X),!,fail. +self_subst(X):- atom(X),!, \+ nb_bound(X,_),!. +self_subst('True'). self_subst('False'). self_subst('F'). %' + + +:- nb_setval(self_space, '&self'). % ' +substs_to(XX,Y):- Y==XX,!. +substs_to(XX,Y):- Y=='True',!, is_True(XX),!. %' + +%current_self(Space):- nb_bound(self_space,Space). +/* +subst_args(Eq,RetType,A,AA):- + current_self(Space), + subst_args(Eq,RetType,11,Space,A,AA). + +%subst_args(Eq,RetType,Depth,_Self,X,_Y):- forall(between(6,Depth,_),write(' ')),writeqln(subst_args(Eq,RetType,X)),fail. +*/ + +subst_args(Eq,RetType,Depth,Self,X,Y):- atom(Eq), ( Eq \== ('=')), ( Eq \== ('match')) ,!, + call(Eq,'=',RetType,Depth,Self,X,Y). % ' + + :- style_check(-singleton). + + + +%subst_args(Eq,RetType,_Dpth,_Slf,X,Y):- nonvar(Y),X=Y,!. +%subst_args(Eq,RetType,Depth,Self,X,Y):- nonvar(Y),!,subst_args(Eq,RetType,Depth,Self,X,XX),substs_to(XX,Y). +subst_args(Eq,RetType,_Dpth,_Slf,X,Y):- self_subst(X),!,Y=X. +subst_args(Eq,RetType,_Dpth,_Slf,[X|T],Y):- + % !, fail, + T==[], \+ callable(X),!,Y=[X]. + +subst_args(Eq,RetType,Depth,Self,[F|X],Y):- + % (F=='superpose' ; ( option_value(no_repeats,false))), %' + notrace((D1 is Depth-1)),!, + subst_args0(Eq,RetType,D1,Self,[F|X],Y). + +subst_args(Eq,RetType,Depth,Self,X,Y):- subst_args0(Eq,RetType,Depth,Self,X,Y). +/* +subst_args(Eq,RetType,Depth,Self,X,Y):- + mnotrace((no_repeats_var(YY), + D1 is Depth-1)), + subst_args0(Eq,RetType,D1,Self,X,Y), + mnotrace(( \+ (Y\=YY))). +*/ + +subst_args(X,Y):- subst_args('&self',X,Y). %' +subst_args(Space,X,Y):- subst_args(100,Space,X,Y). + +subst_args(Depth,Space,X,Y):-subst_args('=',_RetType, + Depth,Space,X,Y). + +:- nodebug(metta(eval)). + + +%subst_args0(Eq,RetType,Depth,_Slf,X,Y):- Depth<1,!,X=Y, (\+ trace_on_overflow-> true; reset_eval_num,debug(metta(eval))). +subst_args0(Eq,RetType,_Dpth,_Slf,X,Y):- self_subst(X),!,Y=X. +subst_args0(Eq,RetType,Depth,Self,X,Y):- + Depth2 is Depth-1, + trace_eval(subst_args1(Eq,RetType),(false,(e2;e)),Depth,Self,X,M), + (M\=@=X ->subst_args0(Eq,RetType,Depth2,Self,M,Y);Y=X). + +:- discontiguous subst_args1/6. +:- discontiguous subst_args2/6. + +subst_args1(Eq,RetType,Depth,Self,X,Y):- + var(Eq) -> (!,subst_args1('=',RetType,Depth,Self,X,Y)); + (atom(Eq), ( Eq \== ('='), Eq \== ('match')) ,!, call(Eq,'=',RetType,Depth,Self,X,Y)). + +subst_args1(Eq,RetType,_Dpth,_Slf,Name,Value):- atom(Name), nb_bound(Name,Value),!. + +subst_args1(Eq,RetType,Depth,Self,[V|VI],VVO):- \+ is_list(VI),!, + subst_args(Eq,RetType,Depth,Self,VI,VM), + ( VM\==VI -> subst_args(Eq,RetType,Depth,Self,[V|VM],VVO) ; + (subst_args(Eq,RetType,Depth,Self,V,VV), (V\==VV -> subst_args(Eq,RetType,Depth,Self,[VV|VI],VVO) ; VVO = [V|VI]))). + +subst_args1(Eq,RetType,_Dpth,_Slf,X,Y):- \+ is_list(X),!,Y=X. + +subst_args1(Eq,RetType,Depth,Self,[V|VI],[V|VO]):- var(V),is_list(VI),!,maplist(subst_args(Eq,RetType,Depth,Self),VI,VO). + +subst_args1(Eq,RetType,Depth,Self,['let',A,A5,AA],OO):- !, + %(var(A)->true;trace), + ((subst_args(Eq,RetType,Depth,Self,A5,AE), AE=A)), + subst_args(Eq,RetType,Depth,Self,AA,OO). +%subst_args1(Eq,RetType,Depth,Self,['let',A,A5,AA],AAO):- !,subst_args(Eq,RetType,Depth,Self,A5,A),subst_args(Eq,RetType,Depth,Self,AA,AAO). +subst_args1(Eq,RetType,Depth,Self,['let*',[],Body],RetVal):- !, subst_args(Eq,RetType,Depth,Self,Body,RetVal). +subst_args1(Eq,RetType,Depth,Self,['let*',[[Var,Val]|LetRest],Body],RetVal):- !, + subst_args1(Eq,RetType,Depth,Self,['let',Var,Val,['let*',LetRest,Body]],RetVal). + + is_sl_op('>'). is_sl_op('<'). % is_sl_op('>'). + is_sl_op('\\=@='). + +subst_args1(Eq,RetType,Depth,Self,[OP,N1,N2],TF):- + fail, + is_sl_op(OP), !, + ((subst_args(Eq,RetType,Depth,Self,N1,N1Res),subst_args(Eq,RetType,Depth,Self,N2,N2Res), + ((N1,N2)\=@=(N1Res,N2Res)),subst_args1(Eq,RetType,Depth,Self,[OP,N1Res,N2Res],TF)) + *->true; + subst_selfless([OP,N1,N2],TF)). + +%subst_args1(Eq,RetType,Depth,Self,O,O):-!. + +subst_args1(Eq,RetType,_Dpth,_Slf,['repl!'],'True'):- !, repl. +subst_args1(Eq,RetType,Depth,Self,['!',Cond],Res):- !, call(subst_args(Eq,RetType,Depth,Self,Cond,Res)). +subst_args1(Eq,RetType,Depth,Self,['rtrace',Cond],Res):- !, rtrace(subst_args(Eq,RetType,Depth,Self,Cond,Res)). +subst_args1(Eq,RetType,Depth,Self,['time',Cond],Res):- !, time(subst_args(Eq,RetType,Depth,Self,Cond,Res)). +%subst_args1(Eq,RetType,Depth,Self,['print',Cond],Res):- !, subst_args(Eq,RetType,Depth,Self,Cond,Res),format('~N'),print(Res),format('~N'). +% !(println! $1) +subst_args1(Eq,RetType,Depth,Self,['println!',Cond],[]):- !, subst_args(Eq,RetType,Depth,Self,Cond,Res),format('~N'),print(Res),format('~N'). + +subst_args1(Eq,RetType,_Dpth,_Slf,List,Y):- is_list(List),maplist(self_subst,List),List=[H|_], \+ atom(H), !,Y=List. + +subst_args1(Eq,RetType,Depth,Self,['assertTrue', X],TF):- !, subst_args(Eq,RetType,Depth,Self,['assertEqual',X,'True'],TF). +subst_args1(Eq,RetType,Depth,Self,['assertFalse',X],TF):- !, subst_args(Eq,RetType,Depth,Self,['assertEqual',X,'False'],TF). + +subst_args1(Eq,RetType,Depth,Self,['assertEqual',X0,Y0],RetVal):- !, + subst_vars(X0,X),subst_vars(Y0,Y), + l1t_loonit_assert_source_tf( + ['assertEqual',X0,Y0], + (bagof_subst(Depth,Self,X,XX), + bagof_subst(Depth,Self,Y,YY)), + equal_enough_for_test(XX,YY), TF), + (TF=='True'->make_nop(RetVal);RetVal=[got,XX,expected,YY]). + +subst_args1(Eq,RetType,Depth,Self,['assertNotEqual',X0,Y0],RetVal):- !, + subst_vars(X0,X),subst_vars(Y0,Y), + l1t_loonit_assert_source_tf( + ['assertNotEqual',X0,Y0], + (setof_subst(Depth,Self,X,XX), setof_subst(Depth,Self,Y,YY)), + \+ equal_enough(XX,YY), TF), + (TF=='True'->make_nop(RetVal);RetVal=[got,XX,expected,not,YY]). + +subst_args1(Eq,RetType,Depth,Self,['assertEqualToResult',X0,Y0],RetVal):- !, + subst_vars(X0,X),subst_vars(Y0,Y), + l1t_loonit_assert_source_tf( + ['assertEqualToResult',X0,Y0], + (bagof_subst(Depth,Self,X,XX), =(Y,YY)), + equal_enough_for_test(XX,YY), TF), + (TF=='True'->make_nop(RetVal);RetVal=[got,XX,expected,YY]),!. + + +l1t_loonit_assert_source_tf(Src,Goal,Check,TF):- + copy_term(Goal,OrigGoal), + l1t_loonit_asserts(Src, time_eval('\n; EVAL TEST\n;',Goal), Check), + as_tf(Check,TF),!, + ignore(( + once((TF='True', is_debugging(pass));(TF='False', is_debugging(fail))), + with_debug((eval),time_eval('Trace',OrigGoal)))). + +l1t_loonit_asserts(Src,Goal,Check):- + loonit_asserts(Src,Goal,Check). + + +/* +sort_result(Res,Res):- \+ compound(Res),!. +sort_result([And|Res1],Res):- is_and(And),!,sort_result(Res1,Res). +sort_result([T,And|Res1],Res):- is_and(And),!,sort_result([T|Res1],Res). +sort_result([H|T],[HH|TT]):- !, sort_result(H,HH),sort_result(T,TT). +sort_result(Res,Res). + +unify_enough(L,L):-!. +unify_enough(L,C):- is_list(L),into_list_args(C,CC),!,unify_lists(CC,L). +unify_enough(C,L):- is_list(L),into_list_args(C,CC),!,unify_lists(CC,L). +unify_enough(C,L):- \+ compound(C),!,L=C. +unify_enough(L,C):- \+ compound(C),!,L=C. +unify_enough(L,C):- into_list_args(L,LL),into_list_args(C,CC),!,unify_lists(CC,LL). + +unify_lists(C,L):- \+ compound(C),!,L=C. +unify_lists(L,C):- \+ compound(C),!,L=C. +unify_lists([C|CC],[L|LL]):- unify_enough(L,C),!,unify_lists(CC,LL). + +equal_enough(R,V):- is_list(R),is_list(V),sort(R,RR),sort(V,VV),!,equal_enouf(RR,VV),!. +equal_enough(R,V):- copy_term(R,RR),copy_term(V,VV),equal_enouf(R,V),!,R=@=RR,V=@=VV. + +equal_enough_for_test(X,Y):- must_det_ll((subst_vars(X,XX),subst_vars(Y,YY))),!,equal_enough(XX,YY),!. + +equal_enouf(R,V):- R=@=V, !. +equal_enouf(_,V):- V=@='...',!. +equal_enouf(L,C):- is_list(L),into_list_args(C,CC),!,equal_enouf_l(CC,L). +equal_enouf(C,L):- is_list(L),into_list_args(C,CC),!,equal_enouf_l(CC,L). +%equal_enouf(R,V):- (var(R),var(V)),!, R=V. +equal_enouf(R,V):- (var(R);var(V)),!, R==V. +equal_enouf(R,V):- number(R),number(V),!, RV is abs(R-V), RV < 0.03 . +equal_enouf(R,V):- atom(R),!,atom(V), has_unicode(R),has_unicode(V). +equal_enouf(R,V):- (\+ compound(R) ; \+ compound(V)),!, R==V. +equal_enouf(L,C):- into_list_args(L,LL),into_list_args(C,CC),!,equal_enouf_l(CC,LL). + +equal_enouf_l(C,L):- \+ compound(C),!,L=@=C. +equal_enouf_l(L,C):- \+ compound(C),!,L=@=C. +equal_enouf_l([C|CC],[L|LL]):- !, equal_enouf(L,C),!,equal_enouf_l(CC,LL). + + +has_unicode(A):- atom_codes(A,Cs),member(N,Cs),N>127,!. +set_last_error(_). + +*/ +subst_args1(Eq,RetType,Depth, Self, [OP|ARGS], Template):- + is_space_op(OP), !, + subst_args_as(Depth, Self, [OP|ARGS], Template). + +% Definition of uses_op to validate operations +is_space_op('match'). +is_space_op('get-atoms'). +is_space_op('add-atom'). +is_space_op('remove-atom'). +%is_space_op('replace-atom'). +is_space_op('atom-count'). +is_space_op('atom-replace'). + +subst_args_as(Depth, Self, [OP|ARGS], Template):- !, eval_20('=',_,Depth, Self, [OP|ARGS], Template). + +subst_args_as(Depth,Self,['match',Other,Goal,Template],Template):- into_space(Self,Other,Space),!, metta_atom_iter_l1t(Eq,Depth,Space,Goal). +subst_args_as(Depth,Self,['match',Other,Goal,Template,Else],Template):- + (subst_args_as(Depth,Self,['match',Other,Goal,Template],Template)*->true;Template=Else). +subst_args_as(Depth,Self,['get-atoms',Other],PredDecl):- !,into_space(Self,Other,Space), metta_atom_iter_l1t(Eq,Depth,Space,PredDecl). +subst_args_as(_Dpth,Self,['add-atom',Other,PredDecl],TF):- !, into_space(Self,Other,Space), as_tf(do_metta(Space,load,PredDecl),TF). +subst_args_as(_Dpth,Self,['remove-atom',Other,PredDecl],TF):- !, into_space(Self,Other,Space), as_tf(do_metta(Space,unload,PredDecl),TF). +subst_args_as(_Dpth,Self,['atom-count',Other],Count):- !, into_space(Self,Other,Space), findall(_,metta_eq_def(Eq,Other,_,_),L_as),length(L_as,C_as),findall(_,get_metta_atom(Eq,Space,_),L2),length(L2,C2),Count is C_as+C2. +subst_args_as(_Dpth,Self,['atom-replace',Other,Rem,Add],TF):- !, into_space(Self,Other,Space), copy_term(Rem,RCopy), + as_tf((metta_atom_iter_l1t_ref(Space,RCopy,Ref), RCopy=@=Rem,erase(Ref), do_metta(Other,load,Add)),TF). + +subst_args1(Eq,RetType,Depth,Self,X,Res):- + X= [CaseSym|_],CaseSym == 'case', !, eval_20('=',_,Depth, Self, X,Res). + +% Macro: case +subst_args1_hide(Depth,Self,X,Res):- + X= [CaseSym,A,CL],CaseSym == 'case', !, + into_case_l1t_list(CL,CASES), + findall(Key-Value, + (nth0(Nth,CASES,Case0), + (is_case_l1t(Key,Case0,Value), + if_trace((case),(format('~N'), + writeqln(c(Nth,Key)=Value))))),KVs),!, + ((subst_args(Eq,RetType,Depth,Self,A,AA), if_trace((case),writeqln(switch=AA)), + (select_case_l1t(Depth,Self,AA,KVs,Value)->true;(member(Void -Value,KVs),Void=='%void%'))) + *->true;(member(Void -Value,KVs),Void=='%void%')), + subst_args(Eq,RetType,Depth,Self,Value,Res). + + select_case_l1t(Depth,Self,AA,Cases,Value):- + (best_key_l1t(AA,Cases,Value) -> true ; + (maybe_special_key_l1ts(Depth,Self,Cases,CasES), + (best_key_l1t(AA,CasES,Value) -> true ; + (member(Void -Value,CasES),Void=='%void%')))). + + best_key_l1t(AA,Cases,Value):- + ((member(Match-Value,Cases),unify_enough(AA,Match))->true; + ((member(Match-Value,Cases),AA ==Match)->true; + ((member(Match-Value,Cases),AA=@=Match)->true; + (member(Match-Value,Cases),AA = Match)))). + + %into_case_l1t_list([[C|ASES0]],CASES):- is_list(C),!, into_case_l1t_list([C|ASES0],CASES),!. + into_case_l1t_list(CASES,CASES):- is_list(CASES),!. + is_case_l1t(AA,[AA,Value],Value):-!. + is_case_l1t(AA,[AA|Value],Value). + + maybe_special_key_l1ts(Depth,Self,[K-V|KVI],[AK-V|KVO]):- + subst_args(Eq,RetType,Depth,Self,K,AK), K\=@=AK,!, + maybe_special_key_l1ts(Depth,Self,KVI,KVO). + maybe_special_key_l1ts(Depth,Self,[_|KVI],KVO):- + maybe_special_key_l1ts(Depth,Self,KVI,KVO). + maybe_special_key_l1ts(_Depth,_Self,[],[]). + + +%[collapse,[1,2,3]] +subst_args1(Eq,RetType,Depth,Self,['collapse',List],Res):-!, bagof_subst(Depth,Self,List,Res). +%[superpose,[1,2,3]] +subst_args1(Eq,RetType,Depth,Self,['superpose',List],Res):- !, member(E,List),subst_args(Eq,RetType,Depth,Self,E,Res). + +get_l1t_sa_p1(P3,E,Cmpd,SA):- compound(Cmpd), get_l1t_sa_p2(P3,E,Cmpd,SA). +get_l1t_sa_p2(P3,E,Cmpd,call(P3,N1,Cmpd)):- arg(N1,Cmpd,E). +get_l1t_sa_p2(P3,E,Cmpd,SA):- arg(_,Cmpd,Arg),get_l1t_sa_p1(P3,E,Arg,SA). +subst_args1(Eq,RetType,Depth,Self, Term, Res):- fail, + mnotrace(( get_l1t_sa_p1(setarg,ST,Term,P1), % ST\==Term, + compound(ST), ST = [F,List],F=='superpose',nonvar(List), %maplist(atomic,List), + call(P1,Var))), !, + %max_counting(F,20), + member(Var,List), + subst_args(Eq,RetType,Depth,Self, Term, Res). + +/* + +sub_sterm(Sub,Sub). +sub_sterm(Sub,Term):- sub_sterm1(Sub,Term). +sub_sterm1(_ ,List):- \+ compound(List),!,fail. +sub_sterm1(Sub,List):- is_list(List),!,member(SL,List),sub_sterm(Sub,SL). +sub_sterm1(_ ,[_|_]):-!,fail. +sub_sterm1(Sub,Term):- arg(_,Term,SL),sub_sterm(Sub,SL). +*/ +% ================================================================= +% ================================================================= +% ================================================================= +% NOP/EQUALITU/DO +% ================================================================= +% ================================================================= +% ================================================================ +subst_args1(Eq,RetType,_Depth,_Self,['nop'], _ ):- !, fail. +subst_args1(Eq,RetType,Depth,Self,['nop',Expr], Empty):- !, + ignore(subst_args(Eq,RetType,Depth,Self,Expr,_)), + make_nop([], Empty). + +subst_args1(Eq,RetType,Depth,Self,['do',Expr], Empty):- !, + forall(subst_args(Eq,RetType,Depth,Self,Expr,_),true), + make_nop([],Empty). + +subst_args1(Eq,RetType,_Depth,_Self,['call',S], TF):- !, eval_call(S,TF). + +% ================================================================= +% ================================================================= +% ================================================================= +% if/If +% ================================================================= +% ================================================================= +% ================================================================= + + +subst_args1(Eq,RetType,Depth,Self,PredDecl,Res):- + Do_more_defs = do_more_defs(true), + clause(eval_21(subst_args,RetType,Depth,Self,PredDecl,Res),Body), + Do_more_defs == do_more_defs(true), + (call(Body), nb_setarg(1,Do_more_defs,false), + deterministic(TF), (TF==true -> ! ; true)). + + +subst_args1(Eq,RetType,Depth,Self,['if',Cond,Then,Else],Res):- !, + subst_args(Eq,'Bool',Depth,Self,Cond,TF), + (is_True(TF) + -> subst_args(Eq,RetType,Depth,Self,Then,Res) + ; subst_args(Eq,RetType,Depth,Self,Else,Res)). + +subst_args1(Eq,RetType,Depth,Self,['If',Cond,Then,Else],Res):- !, + subst_args(Eq,'Bool',Depth,Self,Cond,TF), + (is_True(TF) + -> subst_args(Eq,RetType,Depth,Self,Then,Res) + ; subst_args(Eq,RetType,Depth,Self,Else,Res)). + +subst_args1(Eq,RetType,Depth,Self,['If',Cond,Then],Res):- !, + subst_args(Eq,'Bool',Depth,Self,Cond,TF), + (is_True(TF) -> subst_args(Eq,RetType,Depth,Self,Then,Res) ; + (!, fail,Res = [],!)). + +subst_args1(Eq,RetType,Depth,Self,['if',Cond,Then],Res):- !, + subst_args(Eq,'Bool',Depth,Self,Cond,TF), + (is_True(TF) -> subst_args(Eq,RetType,Depth,Self,Then,Res) ; + (!, fail,Res = [],!)). + + +subst_args1(Eq,RetType,_Dpth,_Slf,[_,Nothing],NothingO):- + 'Nothing'==Nothing,!,do_expander(Eq,RetType,Nothing,NothingO). + + + +subst_args1(Eq,RetType,Depth,Self, Term, Res):- fail, + mnotrace(( get_l1t_sa_p1(setarg,ST,Term,P1), + compound(ST), ST = [F,List],F=='collapse',nonvar(List), %maplist(atomic,List), + call(P1,Var))), !, setof_subst(Depth,Self,List,Var), + subst_args(Eq,RetType,Depth,Self, Term, Res). + + +%max_counting(F,Max):- flag(F,X,X+1), X true; (flag(F,_,10),!,fail). + + +subst_args1(Eq,RetType,_Dpth,_Slf,[_,Nothing],Nothing):- 'Nothing'==Nothing,!. + + + +subst_args1(Eq,RetType,Depth,Self,['colapse'|List], Flat):- !, maplist(subst_args(Eq,RetType,Depth,Self),List,Res),flatten(Res,Flat). +subst_args1(Eq,RetType,_Dpth,_Slf,['car-atom',Atom],CAR):- !, Atom=[CAR|_],!. +subst_args1(Eq,RetType,_Dpth,_Slf,['cdr-atom',Atom],CDR):- !, Atom=[_|CDR],!. + +subst_args1(Eq,RetType,Depth,Self,['Cons', A, B ],['Cons', AA, BB]):- no_cons_reduce, !, + subst_args(Eq,RetType,Depth,Self,A,AA), subst_args(Eq,RetType,Depth,Self,B,BB). + +subst_args1(Eq,RetType,Depth,Self,['Cons', A, B ],[AA|BB]):- \+ no_cons_reduce, !, + subst_args(Eq,RetType,Depth,Self,A,AA), subst_args(Eq,RetType,Depth,Self,B,BB). + + +subst_args1(Eq,RetType,Depth,Self,['change-state!',StateExpr, UpdatedValue], Ret):- !, subst_args(Eq,RetType,Depth,Self,StateExpr,StateMonad), + subst_args(Eq,RetType,Depth,Self,UpdatedValue,Value), 'change-state!'(Depth,Self,StateMonad, Value, Ret). +subst_args1(Eq,RetType,Depth,Self,['new-state',UpdatedValue],StateMonad):- !, + subst_args(Eq,RetType,Depth,Self,UpdatedValue,Value), 'new-state'(Depth,Self,Value,StateMonad). +subst_args1(Eq,RetType,Depth,Self,['get-state',StateExpr],Value):- !, + subst_args(Eq,RetType,Depth,Self,StateExpr,StateMonad), 'get-state'(StateMonad,Value). + + + +% subst_args1(Eq,RetType,Depth,Self,['get-state',Expr],Value):- !, subst_args(Eq,RetType,Depth,Self,Expr,State), arg(1,State,Value). + + + +% check_type:- option_else(typecheck,TF,'False'), TF=='True'. + +:- dynamic is_registered_state/1. +:- flush_output. +:- setenv('RUST_BACKTRACE',full). + +/* +% Function to check if an value is registered as a state name +:- dynamic(is_registered_state/1). + +is_nb_state(G):- is_valid_nb_state(G) -> true ; + is_registered_state(G),nb_bound(G,S),is_valid_nb_state(S). + + +:- multifile(state_type_method/3). +:- dynamic(state_type_method/3). +space_type_method(is_nb_state,new_space,init_state). +space_type_method(is_nb_state,clear_space,clear_nb_values). +space_type_method(is_nb_state,add_atom,add_nb_value). +space_type_method(is_nb_state,remove_atom,'change-state!'). +space_type_method(is_nb_state,replace_atom,replace_nb_value). +space_type_method(is_nb_state,atom_count,value_nb_count). +space_type_method(is_nb_state,get_atoms,'get-state'). +space_type_method(is_nb_state,atom_iter,value_nb_iter). + +state_type_method(is_nb_state,new_state,init_state). +state_type_method(is_nb_state,clear_state,clear_nb_values). +state_type_method(is_nb_state,add_value,add_nb_value). +state_type_method(is_nb_state,remove_value,'change-state!'). +state_type_method(is_nb_state,replace_value,replace_nb_value). +state_type_method(is_nb_state,value_count,value_nb_count). +state_type_method(is_nb_state,'get-state','get-state'). +state_type_method(is_nb_state,value_iter,value_nb_iter). +%state_type_method(is_nb_state,query,state_nb_query). + +% Clear all values from a state +clear_nb_values(StateNameOrInstance) :- + fetch_or_create_state(StateNameOrInstance, State), + nb_setarg(1, State, []). + + + +% Function to confirm if a term represents a state +is_valid_nb_state(State):- compound(State),functor(State,'State',_). + +% Find the original name of a given state +state_original_name(State, Name) :- + is_registered_state(Name), + nb_bound(Name, State). + +% Register and initialize a new state +init_state(Name) :- + State = 'State'(_,_), + asserta(is_registered_state(Name)), + nb_setval(Name, State). + +% Change a value in a state +'change-state!'(Depth,Self,StateNameOrInstance, UpdatedValue, Out) :- + fetch_or_create_state(StateNameOrInstance, State), + arg(2, State, Type), + ( (check_type,\+ get_type_l1t(Depth,Self,UpdatedValue,Type)) + -> (Out = ['Error', UpdatedValue, 'BadType']) + ; (nb_setarg(1, State, UpdatedValue), Out = State) ). + +% Fetch all values from a state +'get-state'(StateNameOrInstance, Values) :- + fetch_or_create_state(StateNameOrInstance, State), + arg(1, State, Values). + +'new-state'(Depth,Self,Init,'State'(Init, Type)):- check_type->get_type_l1t(Depth,Self,Init,Type);true. + +'new-state'(Init,'State'(Init, Type)):- check_type->get_type_l1t(10,'&self',Init,Type);true. + +fetch_or_create_state(Name):- fetch_or_create_state(Name,_). +% Fetch an existing state or create a new one + +fetch_or_create_state(State, State) :- is_valid_nb_state(State),!. +fetch_or_create_state(NameOrInstance, State) :- + ( atom(NameOrInstance) + -> (is_registered_state(NameOrInstance) + -> nb_bound(NameOrInstance, State) + ; init_state(NameOrInstance), + nb_bound(NameOrInstance, State)) + ; is_valid_nb_state(NameOrInstance) + -> State = NameOrInstance + ; writeln('Error: Invalid input.') + ), + is_valid_nb_state(State). + +*/ + +subst_args1(Eq,RetType,Depth,Self,['get-type',Val],Type):- !, get_type_l1t(Depth,Self,Val,Type),ground(Type),Type\==[], Type\==Val,!. + +% mnotrace(G):- once(G). +/* +is_decl_type(ST):- metta_type(_,_,Type),sub_term(T,Type),T=@=ST, \+ nontype(ST). +is_type(Type):- nontype(Type),!,fail. +is_type(Type):- is_decl_type(Type). +is_type(Type):- atom(Type). + +nontype(Type):- var(Type),!. +nontype('->'). +nontype(N):- number(N). + +*/ + +needs_subst(EvalMe):- is_list(EvalMe),!. + + +get_type_l1t(_Dpth,_Slf,Var,'%Undefined%'):- var(Var),!. +get_type_l1t(_Dpth,_Slf,Val,'Number'):- number(Val),!. +get_type_l1t(_Dpth,_Slf,Val,'String'):- string(Val),!. +get_type_l1t(Depth,Self,Expr,['StateMonad',Type]):- is_valid_nb_state(Expr),'get-state'(Expr,Val),!, + get_type_l1t(Depth,Self,Val,Type). + + +get_type_l1t(Depth,Self,EvalMe,Type):- needs_subst(EvalMe),subst_args(Eq,RetType,Depth,Self,EvalMe,Val), \+ needs_subst(Val),!, + get_type_l1t(Depth,Self,Val,Type). + +get_type_l1t(_Dpth,Self,[Fn|_],Type):- symbol(Fn),metta_type(Self,Fn,List),last_element(List,Type), nonvar(Type), + is_type(Type). +get_type_l1t(_Dpth,Self,List,Type):- is_list(List),metta_type(Self,List,LType),last_element(LType,Type), nonvar(Type), + is_type(Type). + +get_type_l1t(Depth,_Slf,Type,Type):- Depth<1,!. +get_type_l1t(_Dpth,Self,List,Type):- is_list(List),metta_type(Self,Type,['->'|List]). +get_type_l1t(Depth,Self,List,Types):- List\==[], is_list(List),Depth2 is Depth-1,maplist(get_type_l1t(Depth2,Self),List,Types). +get_type_l1t(_Dpth,Self,Fn,Type):- symbol(Fn),metta_type(Self,Fn,Type),!. +%get_type_l1t(Depth,Self,Fn,Type):- nonvar(Fn),metta_type(Self,Fn,Type2),Depth2 is Depth-1,get_type_l1t(Depth2,Self,Type2,Type). +%get_type_l1t(Depth,Self,Fn,Type):- Depth>0,nonvar(Fn),metta_type(Self,Type,Fn),!. %,!,last_element(List,Type). + +get_type_l1t(Depth,Self,Expr,Type):-Depth2 is Depth-1, subst_args(Eq,RetType,Depth2,Self,Expr,Val),Expr\=@=Val,get_type_l1t(Depth2,Self,Val,Type). + + +get_type_l1t(_Dpth,_Slf,Val,'String'):- string(Val),!. +get_type_l1t(_Dpth,_Slf,Val,Type):- is_decl_type(Val),Type=Val. +get_type_l1t(_Dpth,_Slf,Val,'Bool'):- (Val=='False';Val=='True'),!. +get_type_l1t(_Dpth,_Slf,Val,'Symbol'):- symbol(Val). +%get_type_l1t(Depth,Self,[T|List],['List',Type]):- Depth2 is Depth-1, is_list(List),get_type_l1t(Depth2,Self,T,Type),!, +% forall((member(Ele,List),nonvar(Ele)),get_type_l1t(Depth2,Self,Ele,Type)),!. +%get_type_l1t(Depth,_Slf,Cmpd,Type):- compound(Cmpd), functor(Cmpd,Type,1),!. +get_type_l1t(_Dpth,_Slf,Cmpd,Type):- \+ ground(Cmpd),!,Type=[]. +get_type_l1t(_Dpth,_Slf,_,'%Undefined%'):- fail. + + +subst_args1(Eq,RetType,Depth,Self,['length',L],Res):- !, subst_args(Eq,RetType,Depth,Self,L,LL), !, (is_list(LL)->length(LL,Res);Res=1). +subst_args1(Eq,RetType,Depth,Self,['CountElement',L],Res):- !, subst_args(Eq,RetType,Depth,Self,L,LL), !, (is_list(LL)->length(LL,Res);Res=1). + +/* + +is_feo_f('Cons'). + +is_seo_f('{...}'). +is_seo_f('[...]'). +is_seo_f('{}'). +is_seo_f('[]'). +is_seo_f('StateMonad'). +is_seo_f('State'). +is_seo_f('Event'). +is_seo_f('Concept'). +is_seo_f(N):- number(N),!. + +*/ + +/* +subst_args1(Eq,RetType,Depth,Self,[F,A|Args],Res):- + \+ self_subst(A), + subst_args(Eq,RetType,Depth,Self,A,AA),AA\==A, + subst_args(Eq,RetType,Depth,Self,[F,AA|Args],Res). + + +subst_args1(Eq,RetType,Depth,Self,[F,A1|AArgs],Res):- fail, member(F,['+']), + cwdl(40,(( + append(L,[A|R],AArgs), + \+ self_subst(A), + subst_args(Eq,RetType,Depth,Self,A,AA),AA\==A,!, + append(L,[AA|R],NewArgs), subst_args(Eq,RetType,Depth,Self,[F,A1|NewArgs],Res)))). +*/ + +/* %% + +% !(assertEqualToResult ((inc) 2) (3)) +subst_args1(Eq,RetType,Depth,Self,[F|Args],Res):- is_list(F), + metta_atom_iter_l1t(Eq,Depth,Self,['=',F,R]), subst_args(Eq,RetType,Depth,Self,[R|Args],Res). + +subst_args1(Eq,RetType,Depth,Self,[F|Args],Res):- is_list(F), Args\==[], + append(F,Args,FArgs),!,subst_args(Eq,RetType,Depth,Self,FArgs,Res). +*/ +subst_args1(Eq,RetType,_Dpth,Self,['import!',Other,File],RetVal):- into_space(Self,Other,Space),!, include_metta(Space,File),!,make_nop(Space,RetVal). %RetVal=[]. +subst_args1(Eq,RetType,Depth,Self,['bind!',Other,Expr],RetVal):- + into_name(Self,Other,Name),!,subst_args(Eq,RetType,Depth,Self,Expr,Value),nb_setval(Name,Value), make_nop(Value,RetVal). +subst_args1(Eq,RetType,Depth,Self,['pragma!',Other,Expr],RetVal):- + into_name(Self,Other,Name),!,subst_args(Eq,RetType,Depth,Self,Expr,Value),set_option_value(Name,Value), make_nop(Value,RetVal). +subst_args1(Eq,RetType,_Dpth,Self,['transfer!',File],RetVal):- !, include_metta(Self,File), make_nop(Self,RetVal). + + + +%l_l1t_args1(Depth,Self,['nop',Expr],Empty):- !, subst_args(Eq,RetType,Depth,Self,Expr,_), make_nop([],Empty). + +/* +is_True(T):- T\=='False',T\=='F',T\==[]. + +is_and(S):- \+ atom(S),!,fail. +is_and('#COMMA'). is_and(','). is_and('and'). is_and('And'). +*/ +subst_args1(Eq,RetType,_Dpth,_Slf,[And],'True'):- is_and(And),!. +subst_args1(Eq,RetType,Depth,Self,['and',X,Y],TF):- !, as_tf((subst_args(Eq,RetType,Depth,Self,X,'True'),subst_args(Eq,RetType,Depth,Self,Y,'True')),TF). +subst_args1(Eq,RetType,Depth,Self,[And,X|Y],TF):- is_and(And),!,subst_args(Eq,RetType,Depth,Self,X,TF1), + is_True(TF1),subst_args1(Eq,RetType,Depth,Self,[And|Y],TF). +%subst_args2(Eq,Depth,Self,[H|T],_):- \+ is_list(T),!,fail. +subst_args1(Eq,RetType,Depth,Self,['or',X,Y],TF):- !, as_tf((subst_args(Eq,RetType,Depth,Self,X,'True');subst_args(Eq,RetType,Depth,Self,Y,'True')),TF). + + + + +subst_args1(Eq,RetType,Depth,Self,['+',N1,N2],N):- number(N1),!, + subst_args(Eq,RetType,Depth,Self,N2,N2Res), catch_err(N is N1+N2Res,_E,(set_last_error(['Error',N2Res,'Number']),fail)). +subst_args1(Eq,RetType,Depth,Self,['-',N1,N2],N):- number(N1),!, + subst_args(Eq,RetType,Depth,Self,N2,N2Res), catch_err(N is N1-N2Res,_E,(set_last_error(['Error',N2Res,'Number']),fail)). + +subst_args1(Eq,RetType,Depth,Self,[V|VI],[V|VO]):- nonvar(V), fail, is_metta_data_functor(Eq,V),is_list(VI),!,maplist(subst_args(Eq,RetType,Depth,Self),VI,VO). + +subst_args1(Eq,RetType,Depth,Self,X,Y):- + (subst_args2(Eq,Depth,Self,X,Y)*->true; + (subst_args2_failed(Depth,Self,X,Y)*->true;X=Y)). + + +subst_args2_failed(_Dpth,_Slf,T,TT):- T==[],!,TT=[]. +subst_args2_failed(_Dpth,_Slf,T,TT):- var(T),!,TT=T. +subst_args2_failed(_Dpth,_Slf,[F|LESS],Res):- once(subst_selfless([F|LESS],Res)),mnotrace([F|LESS]\==Res),!. +%subst_args2_failed(Depth,Self,[V|Nil],[O]):- Nil==[], once(subst_args(Eq,RetType,Depth,Self,V,O)),V\=@=O,!. +subst_args2_failed(Depth,Self,[H|T],[HH|TT]):- !, + subst_args(Eq,RetType,Depth,Self,H,HH), + subst_args2_failed(Depth,Self,T,TT). +subst_args2_failed(Depth,Self,T,T):-!. +%subst_args2_failed(Depth,Self,T,TT):- subst_args(Eq,RetType,Depth,Self,T,TT). + + %subst_args(Eq,RetType,Depth,Self,X,Y):- subst_args1(Eq,RetType,Depth,Self,X,Y)*->true;Y=[]. + +%subst_args1(Eq,RetType,Depth,_,_,_):- Depth<1,!,fail. +%subst_args1(Eq,RetType,Depth,_,X,Y):- Depth<3, !, ground(X), (Y=X). +%subst_args1(Eq,RetType,_Dpth,_Slf,X,Y):- self_subst(X),!,Y=X. + +% Kills zero arity functions subst_args1(Eq,RetType,Depth,Self,[X|Nil],[Y]):- Nil ==[],!,subst_args(Eq,RetType,Depth,Self,X,Y). + + +/* +into_values(List,Many):- List==[],!,Many=[]. +into_values([X|List],Many):- List==[],is_list(X),!,Many=X. +into_values(Many,Many). +subst_args2(Eq,_Dpth,_Slf,Name,Value):- atom(Name), nb_bound(Name,Value),!. +*/ +% Macro Functions +%subst_args1(Eq,RetType,Depth,_,_,_):- Depth<1,!,fail. +subst_args2(Eq,Depth,_,X,Y):- Depth<3, !, fail, ground(X), (Y=X). +subst_args2(Eq,Depth,Self,[F|PredDecl],Res):- fail, + Depth>1, + mnotrace((sub_sterm1(SSub,PredDecl), ground(SSub),SSub=[_|Sub], is_list(Sub), maplist(atomic,SSub))), + subst_args(Eq,RetType,Depth,Self,SSub,Repl), + mnotrace((SSub\=Repl, subst(PredDecl,SSub,Repl,Temp))), + subst_args(Eq,RetType,Depth,Self,[F|Temp],Res). + + + +% user defined function +subst_args2(Eq,Depth,Self,[H|PredDecl],Res):- mnotrace(is_user_defined_head(Eq,Self,H)),!, + subst_args30(Eq,Depth,Self,[H|PredDecl],Res). + +% function inherited by system +subst_args2(Eq,Depth,Self,PredDecl,Res):- subst_args40(Eq,Depth,Self,PredDecl,Res). + +/* +last_element(T,E):- \+ compound(T),!,E=T. +last_element(T,E):- is_list(T),last(T,L),last_element(L,E),!. +last_element(T,E):- compound_name_arguments(T,_,List),last_element(List,E),!. + + + + +%catch_warn(G):- notrace(catch_err(G,E,(wdmsg(catch_warn(G)-->E),fail))). +%catch_nowarn(G):- notrace(catch_err(G,error(_,_),fail)). + +%as_tf(G,TF):- catch_nowarn((call(G)*->TF='True';TF='False')). +*/ +subst_selfless([O|_],_):- var(O),!,fail. +subst_selfless(['==',X,Y],TF):- as_tf(X=:=Y,TF),!. +subst_selfless(['==',X,Y],TF):- as_tf(X=Y,TF),!. +subst_selfless(X,Y):- !,eval_selfless(_,_,_,_,X,Y). +/*subst_selfless(['=',X,Y],TF):-!,as_tf(X=Y,TF). +subst_selfless(['>',X,Y],TF):-!,as_tf(X>Y,TF). +subst_selfless(['<',X,Y],TF):-!,as_tf(X',X,Y],TF):-!,as_tf(X>=Y,TF). +subst_selfless(['<=',X,Y],TF):-!,as_tf(X= Bool Atom Atom)) +(= (ift True $then) $then) + +; For anything that is green, assert it is Green in &kb22 +!(ift (green $x) + (add-atom &kb22 (Green $x))) + +; Retrieve the inferred Green things: Fritz and Sam. +!(assertEqualToResult + (match &kb22 (Green $x) $x) + (Fritz Sam)) +*/ +:- discontiguous subst_args3/4. +%subst_args2(Eq,Depth,Self,PredDecl,Res):- subst_args3(Depth,Self,PredDecl,Res). + +%subst_args2(Eq,_Dpth,_Slf,L1,Res):- is_list(L1),maplist(self_subst,L1),!,Res=L1. +%subst_args2(Eq,_Depth,_Self,X,X). + +/* +is_user_defined_head(Eq,Other,H):- mnotrace(is_user_defined_head0(Eq,Other,H)). +is_user_defined_head0(Eq,Other,[H|_]):- !, nonvar(H),!, is_user_defined_head_f(Eq,Other,H). +is_user_defined_head0(Eq,Other,H):- callable(H),!,functor(H,F,_), is_user_defined_head_f(Eq,Other,F). +is_user_defined_head0(Eq,Other,H):- is_user_defined_head_f(Eq,Other,H). + +is_user_defined_head_f(Eq,Other,H):- is_user_defined_head_f1(Eq,Other,H). +is_user_defined_head_f(Eq,Other,H):- is_user_defined_head_f1(Eq,Other,[H|_]). + +%is_user_defined_head_f1(Eq,Other,H):- metta_type(Other,H,_). +is_user_defined_head_f1(Eq,Other,H):- get_metta_atom(Eq,Other,[H|_]). +is_user_defined_head_f1(Eq,Other,H):- metta_eq_def(Eq,Other,[H|_],_). +%is_user_defined_head_f(Eq,_,H):- is_metta_builtin(H). + + +is_special_op(F):- \+ atom(F), \+ var(F), !, fail. +is_special_op('case'). +is_special_op(':'). +is_special_op('='). +is_special_op('->'). +is_special_op('let'). +is_special_op('let*'). +is_special_op('if'). +is_special_op('rtrace'). +is_special_op('or'). +is_special_op('and'). +is_special_op('not'). +is_special_op('match'). +is_special_op('call'). +is_special_op('let'). +is_special_op('let*'). +is_special_op('nop'). +is_special_op('assertEqual'). +is_special_op('assertEqualToResult'). + +is_metta_builtin(Special):- is_special_op(Special). +is_metta_builtin('=='). +is_metta_builtin(F):- once(atom(F);var(F)), current_op(_,yfx,F). +is_metta_builtin('println!'). +is_metta_builtin('transfer!'). +is_metta_builtin('collapse'). +is_metta_builtin('superpose'). +is_metta_builtin('+'). +is_metta_builtin('-'). +is_metta_builtin('*'). +is_metta_builtin('/'). +is_metta_builtin('%'). +is_metta_builtin('=='). +is_metta_builtin('<'). +is_metta_builtin('>'). +is_metta_builtin('all'). +is_metta_builtin('import!'). +is_metta_builtin('pragma!'). +*/ + + +subst_args30(Eq,Depth,Self,H,B):- (subst_args34(Depth,Self,H,B)*->true;subst_args37(Eq,Depth,Self,H,B)). + +subst_args34(_Dpth,Self,H,B):- (metta_eq_def(Eq,Self,H,B);(get_metta_atom(Eq,Self,H),B=H)). + +% Has argument that is headed by the same function +subst_args37(Eq,Depth,Self,[H1|Args],Res):- + mnotrace((append(Left,[[H2|H2Args]|Rest],Args), H2==H1)),!, + subst_args(Eq,RetType,Depth,Self,[H2|H2Args],ArgRes), + mnotrace((ArgRes\==[H2|H2Args], append(Left,[ArgRes|Rest],NewArgs))), + subst_args30(Eq,Depth,Self,[H1|NewArgs],Res). + +subst_args37(Eq,Depth,Self,[[H|Start]|T1],Y):- + mnotrace((is_user_defined_head_f(Eq,Self,H),is_list(Start))), + metta_eq_def(Eq,Self,[H|Start],Left), + subst_args(Eq,RetType,Depth,Self,[Left|T1],Y). + +% Has subterm to subst +subst_args37(Eq,Depth,Self,[F|PredDecl],Res):- + Depth>1, fail, + quietly(sub_sterm1(SSub,PredDecl)), + mnotrace((ground(SSub),SSub=[_|Sub], is_list(Sub),maplist(atomic,SSub))), + subst_args(Eq,RetType,Depth,Self,SSub,Repl), + mnotrace((SSub\=Repl,subst(PredDecl,SSub,Repl,Temp))), + subst_args30(Eq,Depth,Self,[F|Temp],Res). + +%subst_args37(Eq,Depth,Self,X,Y):- (subst_args38(Eq,Depth,Self,X,Y)*->true;metta_atom_iter_l1t(Eq,Depth,Self,[=,X,Y])). + +subst_args37(Eq,Depth,Self,PredDecl,Res):- fail, + ((term_variables(PredDecl,Vars), + (get_metta_atom(Eq,Self,PredDecl) *-> (Vars ==[]->Res='True';Vars=Res); + (subst_args(Eq,RetType,Depth,Self,PredDecl,Res),ignore(Vars ==[]->Res='True';Vars=Res))))), + PredDecl\=@=Res. + +subst_args38(Eq,_Dpth,Self,[H|_],_):- mnotrace( \+ is_user_defined_head_f(Eq,Self,H) ), !,fail. +subst_args38(Eq,_Dpth,Self,[H|T1],Y):- metta_eq_def(Eq,Self,[H|T1],Y). +subst_args38(Eq,_Dpth,Self,[H|T1],'True'):- get_metta_atom(Eq,Self,[H|T1]). +subst_args38(Eq,_Dpth,Self,CALL,Y):- fail,append(Left,[Y],CALL),metta_eq_def(Eq,Self,Left,Y). + + +%subst_args3(Depth,Self,['ift',CR,Then],RO):- fail, !, %fail, % trace, +% metta_eq_def(Eq,Self,['ift',R,Then],Become),subst_args(Eq,RetType,Depth,Self,CR,R),subst_args(Eq,RetType,Depth,Self,Then,_True),subst_args(Eq,RetType,Depth,Self,Become,RO). + +metta_atom_iter_l1t(Eq,_Dpth,Other,[Equal,H,B]):- Eq == Equal,!, + (metta_eq_def(Eq,Other,H,B)*->true;(get_metta_atom(Eq,Other,H),B=H)). + +metta_atom_iter_l1t(Eq,Depth,_,_):- Depth<3,!,fail. +metta_atom_iter_l1t(Eq,_Dpth,_Slf,[]):-!. +metta_atom_iter_l1t(Eq,_Dpth,Other,H):- get_metta_atom(Eq,Other,H). +metta_atom_iter_l1t(Eq,Depth,Other,H):- D2 is Depth -1, metta_eq_def(Eq,Other,H,B),metta_atom_iter_l1t(Eq,D2,Other,B). +metta_atom_iter_l1t(Eq,_Dpth,_Slf,[And]):- is_and(And),!. +metta_atom_iter_l1t(Eq,Depth,Self,[And,X|Y]):- is_and(And),!,D2 is Depth -1, metta_atom_iter_l1t(Eq,D2,Self,X),metta_atom_iter_l1t(Eq,D2,Self,[And|Y]). +/* +metta_atom_iter_l1t2(_,Self,[=,X,Y]):- metta_eq_def(Eq,Self,X,Y). +metta_atom_iter_l1t2(_Dpth,Other,[Equal,H,B]):- '=' == Equal,!, metta_eq_def(Eq,Other,H,B). +metta_atom_iter_l1t2(_Dpth,Self,X,Y):- metta_eq_def(Eq,Self,X,Y). %, Y\=='True'. +metta_atom_iter_l1t2(_Dpth,Self,X,Y):- get_metta_atom(Eq,Self,[=,X,Y]). %, Y\=='True'. + +*/ +metta_atom_iter_l1t_ref(Other,['=',H,B],Ref):-clause(metta_eq_def(Eq,Other,H,B),true,Ref). +metta_atom_iter_l1t_ref(Other,H,Ref):-clause(get_metta_atom(Eq,Other,H),true,Ref). + +%not_compound(Term):- \+ is_list(Term),!. +%subst_args2(Eq,Depth,Self,Term,Res):- maplist(not_compound,Term),!,subst_args345(Depth,Self,Term,Res). + + +% function inherited by system +subst_args40(Eq,Depth,Self,[F|X],FY):- is_function(F), \+ is_special_op(F), is_list(X), + maplist(subst_args(Eq,RetType,Depth,Self),X,Y),!,subst_args5(Depth,Self,[F|Y],FY). +subst_args40(Eq,Depth,Self,FX,FY):- subst_args5(Depth,Self,FX,FY). + +%subst_args5(_Dpth,_Slf,[F|LESS],Res):- once(subst_selfless([F|LESS],Res)),mnotrace(([F|LESS]\==Res)),!. +subst_args5(Depth,Self,[AE|More],TF):- eval_selfless(_,_,Depth,Self,[AE|More],TF),!. +subst_args5(Depth,Self,[AE|More],TF):- is_system_pred(AE), length(More,Len), + (is_syspred(AE,Len,Pred),catch_warn(as_tf(apply(Pred,More),TF)))*->true; + subst_args6(Depth,Self,[AE|More],TF). +subst_args6(_Dpth,_Slf,[AE|More],TF):- is_system_pred(AE),length([AE|More],Len), + is_syspred(AE,Len,Pred),append(More,[TF],Args),!,catch_warn(apply(Pred,Args)). + +%subst_args40(Eq,Depth,Self,[X1|[F2|X2]],[Y1|Y2]):- is_function(F2),!,subst_args(Eq,RetType,Depth,Self,[F2|X2],Y2),subst_args(Eq,RetType,Depth,Self,X1,Y1). + + +%cwdl(DL,Goal):- call_with_depth_limit(Goal,DL,R), (R==depth_limit_exceeded->(!,fail);true). +bagof_subst(Depth,Self,X,L):- !,findall(E,subst_args(Eq,RetType,Depth,Self,X,E),L). +setof_subst(Depth,Self,X,S):- !,findall(E,subst_args(Eq,RetType,Depth,Self,X,E),L),sort(L,S). +%setof_subst(Depth,Self,X,S):- setof(E,subst_args(Eq,RetType,Depth,Self,X,E),S)*->true;S=[]. + + diff --git a/.Attic/canary_docme/metta_testing.pl b/.Attic/canary_docme/metta_testing.pl new file mode 100644 index 00000000000..ea78063dda2 --- /dev/null +++ b/.Attic/canary_docme/metta_testing.pl @@ -0,0 +1,1244 @@ +/* + this is part of (H)MUARC https://logicmoo.org/xwiki/bin/view/Main/ARC/ + + This work may not be copied and used by anyone other than the author Douglas Miles + unless permission or license is granted (contact at business@logicmoo.org) +*/ +%:- encoding(iso_latin_1). + +:- ensure_loaded(library(occurs)). +:- ensure_loaded(metta_utils). + +% Reset loonit counters +loonit_reset :- + flush_output, + loonit_report, + flush_output, + flag(loonit_failure, _, 0), + flag(loonit_success, _, 0). + +has_loonit_results :- loonit_number(FS),FS>1. + +loonit_number(FS) :- flag(loonit_test_number,FS,FS),FS>0,!. +loonit_number(FS) :- + flag(loonit_success, Successes, Successes), + flag(loonit_failure, Failures, Failures), + FS is Successes+Failures+1. + + +string_replace(Original, Search, Replace, Replaced) :- + symbolic_list_concat(Split, Search, Original), + symbolic_list_concat(Split, Replace, Replaced),!. + +get_test_name(Number,TestName) :- + ((nb_current(loading_file,FilePath),FilePath\==[])->true; FilePath='SOME/UNIT-TEST'), + make_test_name(FilePath, Number, TestName). + +ensure_basename(FilePath,FilePath):- \+ directory_file_path(('.'), _, FilePath),!. +ensure_basename(FilePath0,FilePath):- + absolute_file_name(FilePath0,FilePath),!. +ensure_basename(FilePath,FilePath). + +make_test_name(FilePath0, Number, TestName) :- + % Extract the file name and its parent directory from the file path + ensure_basename(FilePath0,FilePath), + file_base_name(FilePath, FileName), + directory_file_path(ParentDir, FileName, FilePath), + file_base_name(ParentDir, ParentDirBase), + % Remove file extension + file_name_extension(Base, _, FileName), + % Convert to uppercase + string_upper(ParentDirBase, UpperParentDirBase), + string_upper(Base, UpperBase), + % Replace "_" with "-" + string_replace(UpperBase, "_", "-", NoUnderscore), + string_replace(UpperParentDirBase, "_", "-", NoUnderscoreParent), + % Format the test name + wots(NS,format('~`0t~d~2|',[Number])), + format(string(TestName), "~w.~w.~w", [NoUnderscoreParent, NoUnderscore, NS]). + + +%color_g_mesg(_,_):- is_compatio,!. +%color_g_mesg(_,_):- silent_loading,!. +color_g_mesg(C,G):- + notrace((nop(check_silent_loading), + color_g_mesg_ok(C,G))). +color_g_mesg_ok(_,G):- is_compatio,!,call(G). +color_g_mesg_ok(C,G):- + quietly(( + wots(S,must_det_ll(user:G)), + (S == "" -> true ; our_ansi_format(C, '~w~n', [S])))),!. + +our_ansi_format(C, Fmt,Args):- \+ atom(C), % set_stream(current_output,encoding(utf8)), + ansi_format(C, Fmt,Args). +our_ansi_format(C, Fmt,Args):- our_ansi_format([fg(C)], Fmt,Args). + +print_current_test:- + loonit_number(Number), + get_test_name(Number,TestName),format('~N~n;

;; ~w

~n',[TestName,TestName]). + +% Increment loonit counters based on goal evaluation + +ensure_increments(Goal):- + setup_call_cleanup( + get_pass_fail(_,_,TotalStart), + Goal, + ((get_pass_fail(_,_,TotalEnd), + if_t(TotalEnd==TotalStart, + flag(loonit_failure,Failures,Failures+1))))). + +get_pass_fail(Successes,Failures,Total):- + flag(loonit_success,Successes,Successes), + flag(loonit_failure,Failures,Failures),!, + Total is Successes+Failures. + + +loonit_asserts(S,Pre,G):- + ensure_increments(loonit_asserts0(S,Pre,G)). + +loonit_asserts0(S,Pre,G):- + flag(loonit_test_number,X,X+1), + copy_term(Pre,Pro), + print_current_test, + once(Pre),!, + ((nb_current(exec_src,Exec),Exec\==[])->true;S=Exec), + write_src(exec(Exec)),nl,nl, + % wots(S,((((nb_current(exec_src,WS),WS\==[])->writeln(WS);write_src(exec(TestSrc)))))), + once(loonit_asserts1(Exec,Pro,G)). + +give_pass_credit(TestSrc,_Pre,_G):- fail, + inside_assert(TestSrc,BaseEval), + always_exec(BaseEval),!. +give_pass_credit(TestSrc,_Pre,G):- + write_pass_fail(TestSrc,'PASS',G), + flag(loonit_success, X, X+1),!, + color_g_mesg(cyan,write_src(loonit_success(G))),!. + +write_pass_fail([P,C,_],PASS_FAIL,G):- + must_det_ll(( + loonit_number(Number), + get_test_name(Number,TestName), + arg(1,G,G1),arg(2,G,G2), write_pass_fail(TestName,P,C,PASS_FAIL,G1,G2))). + +write_pass_fail(TestName,P,C,PASS_FAIL,G1,G2):- + ignore((( + (nb_current(loading_file,FilePath),FilePath\==[])->true; FilePath='SOME/UNIT-TEST.metta'), + symbolic_list_concat([_,R],'tests/',FilePath), + file_name_extension(Base, _, R))), + nop(format('

;; ~w

',[TestName,TestName])), + must_det_ll(( + (tee_file(TEE_FILE)->true;'TEE.ansi'=TEE_FILE), + (( %atom_concat(TEE_FILE,'.UNITS',UNITS), + shared_units(UNITS), + open(UNITS, append, Stream,[encoding(utf8)]), + once(getenv('HTML_FILE',HTML_OUT);sformat(HTML_OUT,'~w.metta.html',[Base])), + compute_html_out_per_test(HTML_OUT,TEE_FILE,TestName,HTML_OUT_PerTest), + get_last_call_duration(Duration), + format(Stream,'| ~w | ~w |[~w](https://logicmoo.org/public/metta/~w#~w) | ~@ | ~@ | ~@ | ~w | ~w |~n', + [TestName,PASS_FAIL,TestName,HTML_OUT,TestName, + trim_gstring_bar_I(write_src_woi([P,C]),400), + trim_gstring_bar_I(write_src_woi(G1),200), + trim_gstring_bar_I(write_src_woi(G2),200), + Duration, + HTML_OUT_PerTest]),!, + close(Stream))))). + +% Needs not to be absolute and not relative to CWD (since tests like all .metta files change their local CWD at least while "loading") +output_directory(OUTPUT_DIR):- getenv('METTALOG_OUTPUT',OUTPUT_DIR),!. +output_directory(OUTPUT_DIR):- getenv('OUTPUT_DIR',OUTPUT_DIR),!. + +shared_units(UNITS):- getenv('SHARED_UNITS',UNITS),!. % Needs not to be relative to CWD +shared_units(UNITS):- output_directory(OUTPUT_DIR),!,directory_file_path(OUTPUT_DIR,'SHARED.UNITS',UNITS). +shared_units(UNITS):- UNITS = '/tmp/SHARED.UNITS'. + +% currently in a shared file per TestCase class.. +% but we might make each test dump its stuffg to its own html file for easier spotting why test failed +compute_html_out_per_test(HTML_OUT,_TEE_FILE,_TestName,HTML_OUT_PerTest):- + HTML_OUT=HTML_OUT_PerTest. + +% Executes Goal and records the execution duration in '$last_call_duration'. +% The duration is recorded regardless of whether Goal succeeds or fails. +record_call_duration(Goal) :- + nb_setval('$last_call_duration', 120), + statistics(cputime, Start), % Get the start CPU time + ( call(Goal) % Call the Goal + *-> EndResult = true % If Goal succeeds, proceed + ; EndResult = false % If Goal fails, record it but proceed + ), + statistics(cputime, End), % Get the end CPU time + Duration is End - Start, % Calculate the CPU duration + nb_setval('$last_call_duration', Duration), % Set the global variable non-backtrackably + EndResult. % Preserve the result of the Goal + +% Helper to retrieve the last call duration stored in the global variable. +get_last_call_duration(Duration) :- + nb_getval('$last_call_duration', Duration),!. + + +trim_gstring_bar_I(Goal, MaxLen) :- + wots(String0,Goal), + string_replace(String0,'|','I',String1), + string_replace(String1,'\n','\\n',String), + atom_length(String, Len), + ( Len =< MaxLen + -> Trimmed = String + ; SubLen is MaxLen, + sub_atom(String, 0, SubLen, _, SubStr), + string_concat(SubStr, "...", Trimmed) + ), + write(Trimmed). + +loonit_asserts1(TestSrc,Pre,G) :- _=nop(Pre),record_call_duration(call(G)), + give_pass_credit(TestSrc,Pre,G),!. + +/* +loonit_asserts1(TestSrc,Pre,G) :- fail, + sub_var('BadType',TestSrc), \+ check_type,!, + write('\n!check_type (not considering this a failure)\n'), + color_g_mesg('#D8BFD8',write_src(loonit_failureR(G))),!, + ignore((( + option_value('on-fail','trace'), + setup_call_cleanup(debug(metta(eval)),call((Pre,G)),nodebug(metta(eval)))))). +*/ + +loonit_asserts1(TestSrc,Pre,G) :- + must_det_ll(( + color_g_mesg(red,write_src(loonit_failureR(G))), + write_pass_fail(TestSrc,'FAIL',G), + flag(loonit_failure, X, X+1), + %itrace, G. + if_t(option_value('on-fail','repl'),repl), + if_t(option_value('on-fail','trace'), + setup_call_cleanup(debug(metta(eval)),call((Pre,G)),nodebug(metta(eval)))))). + %(thread_self(main)->trace;sleep(0.3)) + +% Generate loonit report with colorized output +:- dynamic(gave_loonit_report/0). +loonit_report:- gave_loonit_report,!. +loonit_report :- + assert(gave_loonit_report), + flag(loonit_success, Successes, Successes), + flag(loonit_failure, Failures, Failures), + loonit_report(Successes,Failures), + if_t((Successes==0;Failures>0), + if_t(option_value(repl,failures);option_value(frepl,true),repl)). + +:- at_halt(loonit_report). + + +loonit_report(0,0):-!. % ansi_format([fg(yellow)], 'Nothing to report~n', []). +loonit_report(Successes,Failures):- + ansi_format([bold], 'LoonIt Report~n',[]), + format('------------~n'), + ansi_format([fg(green)], 'Successes: ~w~n', [Successes]), + ((integer(Failures),Failures>0) -> ansi_format([fg(red)], 'Failures: ~w~n', [Failures]);ansi_format([fg(green)], 'Failures: ~w~n', [Failures])). + +% Resets loonit counters, consults the given file, and prints the status report. +loon_metta(File) :- + flag(loonit_success, WasSuccesses, 0), + flag(loonit_failure, WasFailures, 0), + load_metta(File), + loonit_report, + flag(loonit_success, _, WasSuccesses), + flag(loonit_failure, _, WasFailures),!. + + +:- dynamic(file_answers/3). +:- dynamic(file_exec_num/2). + +% set_exec_num/2 +% Update or assert the execution number for the given file. + +set_exec_num(SFileName, Val) :- + absolute_file_name(SFileName,FileName), + ( retract(file_exec_num(FileName, _)) % If an entry exists, retract it + -> true + ; true % Otherwise, do nothing + ), + asserta(file_exec_num(FileName, Val)). % Assert the new value + +% get_exec_num/2 +% Retrieve the execution number for the given file. If none exists, it returns 0. +get_exec_num(Val):- + current_exec_file_abs(FileName), + file_exec_num(FileName, Val),!. +get_exec_num(FileName, Val) :- + ( file_exec_num(FileName, CurrentVal) + -> Val = CurrentVal + ; Val = 0 + ). + + current_exec_file_abs(FileName):- + current_exec_file(SFileName), + absolute_file_name(SFileName,FileName),!. + + +get_expected_result(Ans):- + ignore(( + current_exec_file_abs(FileName), + file_exec_num(FileName, Nth), + file_answers(FileName, Nth, Ans))),!. + + + +got_exec_result(Val):- + ignore(( + current_exec_file_abs(FileName), + file_exec_num(FileName, Nth), + file_answers(FileName, Nth, Ans), + got_exec_result(Val,Ans))). + + +got_exec_result(Val,Ans):- + must_det_ll(( + current_exec_file_abs(FileName), + file_exec_num(FileName, Nth), + Nth100 is Nth+100, + get_test_name(Nth100,TestName), + nb_current(exec_src,Exec), + (equal_enough_for_test(Val,Ans) + -> write_pass_fail_result(TestName,exec,Exec,'PASS',Ans,Val) + ; write_pass_fail_result(TestName,exec,Exec,'FAIL',Ans,Val)))). + +write_pass_fail_result(TestName,exec,Exec,PASS_FAIL,Ans,Val):- + nl,writeq(write_pass_fail_result(TestName,exec,Exec,PASS_FAIL,Ans,Val)),nl, + write_pass_fail(TestName,exec,Exec,PASS_FAIL,Ans,Val). + + +current_exec_file(FileName):- nb_current(loading_file,FileName). + +% inc_exec_num/1 +% Increment the execution number for the given file. If no entry exists, initialize it to 1. +inc_exec_num :- current_exec_file_abs(FileName),!,inc_exec_num(FileName). +inc_exec_num(FileName) :- + ( retract(file_exec_num(FileName, CurrentVal)) + -> NewVal is CurrentVal + 1 + ; NewVal = 1 + ), + asserta(file_exec_num(FileName, NewVal)). + + +load_answer_file(File):- ( \+ atom(File); \+ is_absolute_file_name(File); \+ exists_file(File)), + absolute_file_name(File,AbsFile), File\=@=AbsFile, load_answer_file_now(AbsFile),!. +load_answer_file(File):- load_answer_file_now(File),!. +load_answer_file_now(File) :- + ignore(( + ensure_extension(File, answers, AnsFile), + remove_specific_extension(AnsFile, answers, StoredAs), + set_exec_num(StoredAs,1), + fbug(load_answer_file(AnsFile,StoredAs)), + load_answer_file(AnsFile,StoredAs))). + +load_answer_file(AnsFile,StoredAs):- + ( file_answers(StoredAs,_, _) -> true + ; ( \+ exists_file(AnsFile) -> true + ; (setup_call_cleanup( + open(AnsFile, read, Stream, [encoding(utf8)]), + (load_answer_stream(1,StoredAs, Stream)), + close(Stream))))), + set_exec_num(StoredAs,1),!. + +:- debug(metta(answers)). +load_answer_stream(_Nth, StoredAs, Stream):- at_end_of_stream(Stream),!, + if_trace((answers), + prolog_only(listing(file_answers(StoredAs,_,_)))). +load_answer_stream(Nth, StoredAs, Stream):- + read_line_to_string(Stream, String), + load_answer_stream(Nth, StoredAs, String, Stream). +/* +load_answer_stream(Nth, StoredAs, String, Stream) :- fail, + atom_chars(String,Chars), + count_brackets(Chars, 0, 0, Balance), + ( Balance =< 0 + -> StoredAs = String + ; read_line_to_string(Stream, NextString), + string_concat(String, "\n", StringWithNewLine), + string_concat(StringWithNewLine, NextString, CombinedString), + load_answer_stream(Nth, StoredAs, CombinedString, Stream) + ). +*/ +load_answer_stream(Nth, StoredAs, String, Stream):- % string_concat("[",_,String),!, + fbug(Nth = String), + parse_answer_string(String,Metta),!, + %if_t(sub_var(',',Metta),rtrace(parse_answer_string(String,_Metta2))), + pfcAdd_Now(file_answers(StoredAs,Nth,Metta)), + skip(must_det_ll(\+ sub_var(',',Metta))), + Nth2 is Nth+1,load_answer_stream(Nth2, StoredAs, Stream). + +load_answer_stream(Nth, StoredAs, _, Stream):- load_answer_stream(Nth, StoredAs, Stream). +/* +count_brackets([], Open, Close, Balance) :- !, + Balance is Open - Close. +count_brackets([Char|Rest], Open, Close, Balance) :- + (((( Char == '[' + -> NewOpen is Open + 1 + ; (Char == ']' + -> NewClose is Close + 1 + ; (NewOpen = Open, + NewClose = Close)))))), + count_brackets(Rest, NewOpen, NewClose, Balance). +*/ +parse_answer_string("[]",[]):- !. +%parse_answer_string(String,Metta):- string_concat("(",_,String),!,parse_sexpr_metta(String,Metta),!. +parse_answer_string(String,_Metta):- string_concat("[(Error (assert",_,String),!,fail. +parse_answer_string(String,_Metta):- string_concat("Expected: [",Mid,String),string_concat(_Expected_Inner,"]",Mid),!,fail. +parse_answer_string(String,Metta):- string_concat("Got: [",Mid,String),string_concat(Got_Inner,"]",Mid),!,parse_answer_inner(Got_Inner,Metta). +parse_answer_string(String,Metta):- string_concat("[",Mid,String),string_concat(Inner0,"]",Mid),!,parse_answer_inner(Inner0,Metta). + + +parse_answer_inner(Inner0,Metta):- must_det_ll(( replace_in_string([', '=' , '],Inner0,Inner), parse_answer_str(Inner,Metta), + skip((\+ sub_var(',',rc(Metta)))))). + +parse_answer_str(Inner,[C|Metta]):- + atomics_to_string(["(",Inner,")"],Str), + parse_sexpr_metta(Str,CMettaC), CMettaC=[C|MettaC], + ((remove_m_commas(MettaC,Metta), + \+ sub_var(',',rc(Metta)))). +parse_answer_str(Inner0,Metta):- symbolic_list_concat(InnerL,' , ',Inner0), maplist(atom_string,InnerL,Inner), maplist(parse_sexpr_metta,Inner,Metta),skip((must_det_ll(( \+ sub_var(',',rc2(Metta)))))),!. +parse_answer_str(Inner0,Metta):- + (( replace_in_string([' , '=' '],Inner0,Inner), + atomics_to_string(["(",Inner,")"],Str),!, + parse_sexpr_metta(Str,Metta),!, + skip((must_det_ll(\+ sub_var(',',rc3(Metta))))), + skip((\+ sub_var(',',rc(Metta)))))). + +%parse_answer_string(String,Metta):- String=Metta,!,fail. + +remove_m_commas(Metta,Metta):- \+ sub_var(',',Metta),!. +remove_m_commas([C,H|T],[H|TT]):- C=='and', !, remove_m_commas(T,TT). +remove_m_commas([C,H|T],[H|TT]):- C==',', !, remove_m_commas(T,TT). +remove_m_commas([H|T],[H|TT]):- !, remove_m_commas(T,TT). + + +% Example usage: +% ?- change_extension('path/to/myfile.txt', 'pdf', NewFileName). +% NewFileName = 'path/to/myfile.pdf'. +change_extension(OriginalFileName, NewExtension, NewBaseName) :- + %file_base_name(OriginalFileName, BaseName), % Extract base name + file_name_extension(BaseWithoutExt, _, OriginalFileName), % Split extension + file_name_extension(BaseWithoutExt, NewExtension, NewBaseName),!. % Create new base name with new extension + %directory_file_path(Directory, NewBaseName, NewFileName). % Join with directory path +% Example usage: +% ?- ensure_extension('path/to/myfile.txt', 'txt', NewFileName). +% NewFileName = 'path/to/myfile.txt'. +ensure_extension(OriginalFileName, Extension, NewFileName) :- + file_name_extension(_, CurrentExt, OriginalFileName), + ( CurrentExt = Extension + -> NewFileName = OriginalFileName + ; atom_concat(OriginalFileName, '.', TempFileName), + atom_concat(TempFileName, Extension, NewFileName) + ). +% Example usage: +% ?- remove_specific_extension('path/to/myfile.txt', 'txt', NewFileName). +% NewFileName = 'path/to/myfile'. + +% ?- remove_specific_extension('path/to/myfile.txt', 'pdf', NewFileName). +% NewFileName = 'path/to/myfile.txt'. +remove_specific_extension(OriginalFileName, Extension, FileNameWithoutExtension) :- + file_name_extension(FileNameWithoutExtension, Ext, OriginalFileName), + ( Ext = Extension -> true ; FileNameWithoutExtension = OriginalFileName ). + + +quick_test:- + %set_prolog_flag(encoding,iso_latin_1), + forall(quick_test(Test), + forall(open_string(Test,Stream), + load_metta_stream('&self',Stream))). + +/* + tests for term expander + + +*/ +% :- debug(term_expansion). +:- if(( false, debugging(term_expansion))). +:- enable_arc_expansion. +:- style_check(-singleton). +dte:- set(_X.local) = val. +dte:- gset(_X.global) = gval. +dte:- must_det_ll((set(_X.a) = b)). +dte:- must_det_ll(locally(nb_setval(e,X.locally),dte([foo|set(X.tail)]))). +dte:- member(set(V.element),set(V.list)). +dte(set(E.v)):- set(E.that)=v. +:- style_check(+singleton). +:- disable_arc_expansion. +:- listing(dte). +:- endif. + + + +% 1. Recursive Approach +factorial_recursive(0, 1). +factorial_recursive(N, Result) :- + N > 0, + N1 is N - 1, + factorial_recursive(N1, Result1), + Result is N * Result1. + +% 2. Tail Recursive Approach +factorial_tail_recursive(N, Result) :- factorial_tail_helper(N, 1, Result). + +factorial_tail_helper(0, Acc, Acc). +factorial_tail_helper(N, Acc, Result) :- + N > 0, + NewAcc is Acc * N, + N1 is N - 1, + factorial_tail_helper(N1, NewAcc, Result). + +% 3. Accumulator Approach +factorial_accumulator(N, Result) :- factorial_acc(N, 1, Result). + +factorial_acc(0, Result, Result). +factorial_acc(N, Acc, Result) :- + N > 0, + NewAcc is Acc * N, + N1 is N - 1, + factorial_acc(N1, NewAcc, Result). + +% You can test each one by querying, for example: +% ?- factorial_recursive(5, X + + + + + + +% Example-usage +example_usages :- + fetch_or_create_space(newSpace,Space), % Assuming fetch_or_create_space/1 is defined to initialize a space + 'add-atom'(Space, a), + 'add-atom'(Space, b), + 'add-atom'(Space, c), + 'match'(Space, a, Template), + write('Matched template: '), writeln(Template), + + + write('Initial space: '), writeln(Space), + + 'add-atom'(Space, a), + write('Space after adding "a": '), writeln(Space), + + 'add-atom'(Space, b), + write('Space after adding "b": '), writeln(Space), + + 'replace-atom'(Space, a, c), + write('Space after replacing "a" with "c": '), writeln(Space), + + 'get-atoms'(Space, Atoms), + write('Atoms in space: '), writeln(Atoms), + + 'atom-count'(Space, Count), + write('Number of atoms in space: '), writeln(Count). + +% Test case for clearing a space +test_clear_space :- + writeln('Test: Clearing a space'), + init_space('&kb1'), + 'add-atom'('&kb1', a), + 'add-atom'('&kb1', b), + writeln('Expected Count Before Clearing: 2'), + 'atom-count'('&kb1', CountBefore), writeln('Actual Count:'), writeln(CountBefore), + writeln('Expected Atoms Before Clearing: [b, a]'), + 'get-atoms'('&kb1', AtomsBefore), writeln('Actual Atoms:'), writeln(AtomsBefore), + 'clear-atoms'('&kb1'), + writeln('Expected Count After Clearing: 0'), + 'atom-count'('&kb1', CountAfter), writeln('Actual Count:'), writeln(CountAfter), + writeln('Expected Atoms After Clearing: []'), + 'get-atoms'('&kb1', AtomsAfter), writeln('Actual Atoms:'), writeln(AtomsAfter). + +% Test case for various operations on a space +test_operations :- + writeln('Test: Various Operations on a Space'), + init_space('&kb2'), + 'add-atom'('&kb2', a), + 'add-atom'('&kb2', b), + writeln('Expected Count After Adding: 2'), + 'atom-count'('&kb2', Count1), writeln('Actual Count:'), writeln(Count1), + writeln('Expected Atoms After Adding: [b, a]'), + 'get-atoms'('&kb2', Atoms1), writeln('Actual Atoms:'), writeln(Atoms1), + 'remove-atom'('&kb2', a), + writeln('Expected Atoms After Removing a: [b]'), + 'get-atoms'('&kb2', Atoms2), writeln('Actual Atoms:'), writeln(Atoms2), + 'replace-atom'('&kb2', b, c), + writeln('Expected Atoms After Replacing b with c: [c]'), + 'get-atoms'('&kb2', Atoms3), writeln('Actual Atoms:'), writeln(Atoms3). + +% Run the test cases +run_tests :- + writeln('Running test_clear_space:'), + test_clear_space, + writeln('---'), + writeln('Running test_operations:'), + test_operations. + + +% Test case for various operations on a space +test_my_space :- + fetch_or_create_space('&KB', InstanceOfKB), + 'clear-atoms'('&KB'), + 'add-atom'(InstanceOfKB, a), + 'add-atom'(InstanceOfKB, b), + 'atom-count'(InstanceOfKB, Count1), + writeln('Should print 2: ' : Count1), + + 'get-atoms'(InstanceOfKB, Atoms1), + writeln('Should print [b, a]: ' : Atoms1), + + 'remove-atom'(InstanceOfKB, a), + 'get-atoms'(InstanceOfKB, Atoms2), + writeln('Should print [b]: ' : Atoms2), + + 'replace-atom'(InstanceOfKB, b, c), + 'get-atoms'(InstanceOfKB, Atoms3), + writeln('Should print [c]: ' : Atoms3), + + space_original_name(InstanceOfKB, OriginalName), + writeln('Should print &KB':OriginalName), + + fetch_or_create_space('&KB'), + 'add-atom'('&KB', x), + 'add-atom'('&KB', y), + 'atom-count'('&KB', Count2), + writeln('Should print 3: ' : Count2), + + 'get-atoms'('&KB', Atoms4), + writeln('Should print [c, y, x]: ' : Atoms4), + + 'remove-atom'('&KB', x), + 'get-atoms'('&KB', Atoms5), + writeln('Should print [c,y]: ' : Atoms5), + + 'replace-atom'('&KB', y, z), + 'get-atoms'(InstanceOfKB, Atoms6), + writeln('Should print [c,z]: ' : Atoms6). + + +% Test the code +test_clr_my_kb22 :- + fetch_or_create_space('&kb22'), + 'add-atom'('&kb22', a), + 'add-atom'('&kb22', b), + 'atom-count'('&kb22', Count1), writeln(Count1), + 'get-atoms'('&kb22', Atoms1), writeln(Atoms1), + 'clear-atoms'('&kb22'), + 'atom-count'('&kb22', Count2), writeln(Count2), + 'get-atoms'('&kb22', Atoms2), writeln(Atoms2). + + %a:- !, be(B), (iF(A,B) -> tHEN(A) ). + %a:- !, be(B), (iF(A,B) *-> tHEN(A) ; eLSE(B) ). + + +% Test the code +test_my_kb2:- + fetch_or_create_space('&kb1', InstanceOfKB), + \+ \+ ('add-atom'('&kb1', a, Out), writeln(Out)), + \+ \+ ('add-atom'('&kb1', b, Out), writeln(Out)), + \+ \+ ('atom-count'('&kb1', Count), writeln(Count)), + \+ \+ ('get-atoms'('&kb1', Atoms), writeln(Atoms)), + \+ \+ ('remove-atom'(InstanceOfKB, a, Out), writeln(Out)), + \+ \+ ('get-atoms'('&kb1', NewAtoms), writeln(NewAtoms)), + \+ \+ ('replace-atom'('&kb1', b, c, Out), writeln(Out)), + \+ \+ ('get-atoms'('&kb1', FinalAtoms), writeln(FinalAtoms)), + \+ \+ (space_original_name(InstanceOfKB, OriginalName), writeln(OriginalName)), + \+ \+ (fetch_or_create_space('&kb2',_)), % Creating a new space with a different name + \+ \+ ('add-atom'('&kb2', a, Out), writeln(Out)), + \+ \+ ('add-atom'('&kb2', b, Out), writeln(Out)), + \+ \+ ('atom-count'('&kb2', Count), writeln(Count)), + \+ \+ ('get-atoms'('&kb2', Atoms), writeln(Atoms)), + \+ \+ ('remove-atom'('&kb2', a, Out), writeln(Out)), + \+ \+ ('get-atoms'('&kb2', NewAtoms), writeln(NewAtoms)), + \+ \+ ('replace-atom'('&kb2', b, c, Out), writeln(Out)), + \+ \+ ('get-atoms'('&kb2', FinalAtoms), writeln(FinalAtoms)). + + + + +end_of_file. % comment this out once to get these files in your readline history +mf('./1-VSpaceTest.metta'). +mf('./2-VSpaceTest.metta'). +mf('./3-Learn-Rules.metta'). +mf('./4-VSpaceTest.metta'). +mf('./5-Learn-Flybase.metta'). +mf('./6-Learn-Flybase-Full.metta'). +mf('./8-VSpaceTest.metta'). +mf('./autoexec.metta'). +mf('./data/OBO-Metta/export/Alliance_of_Genome_Resources.metta'). +mf('./data/OBO-Metta/export/biosapiens.metta'). +mf('./data/OBO-Metta/export/chebi_fb_2023_04.metta'). +mf('./data/OBO-Metta/export/DBVAR.metta'). +mf('./data/OBO-Metta/export/doid.metta'). +mf('./data/OBO-Metta/export/flybase_controlled_vocabulary.metta'). +mf('./data/OBO-Metta/export/flybase_stock_vocabulary.metta'). +mf('./data/OBO-Metta/export/fly_anatomy.metta'). +mf('./data/OBO-Metta/export/fly_development.metta'). +mf('./data/OBO-Metta/export/gene_group_FB2023_04.metta'). +mf('./data/OBO-Metta/export/go-basic.metta'). +mf('./data/OBO-Metta/export/image.metta'). +mf('./data/OBO-Metta/export/psi-mi.metta'). +mf('./data/OBO-Metta/export/slice.chebi.metta'). +mf('./data/OBO-Metta/export/so-simple.metta'). +mf('./data/OBO-Metta/export/so.metta'). +mf('./data/OBO-Metta/export/SOFA.metta'). +mf('./examples/compat/common/BelieveMe.metta'). +mf('./examples/compat/common/EqualityType.metta'). +mf('./examples/compat/common/EqualityTypeTest.metta'). +mf('./examples/compat/common/formula/DeductionFormula.metta'). +mf('./examples/compat/common/formula/DeductionFormulaTest.metta'). +mf('./examples/compat/common/formula/ImplicationDirectIntroductionFormula.metta'). +mf('./examples/compat/common/formula/ModusPonensFormula.metta'). +mf('./examples/compat/common/In.metta'). +mf('./examples/compat/common/InTest.metta'). +mf('./examples/compat/common/List.metta'). +mf('./examples/compat/common/ListTest.metta'). +mf('./examples/compat/common/Maybe.metta'). +mf('./examples/compat/common/MaybeTest.metta'). +mf('./examples/compat/common/Num.metta'). +mf('./examples/compat/common/NumTest.metta'). +mf('./examples/compat/common/OrderedSet.metta'). +mf('./examples/compat/common/OrderedSetTest.metta'). +mf('./examples/compat/common/Record.metta'). +mf('./examples/compat/common/truthvalue/EvidentialTruthValue.metta'). +mf('./examples/compat/common/truthvalue/EvidentialTruthValueTest.metta'). +mf('./examples/compat/common/truthvalue/MeasEq.metta'). +mf('./examples/compat/common/truthvalue/TemporalTruthValue.metta'). +mf('./examples/compat/common/truthvalue/TruthValue.metta'). +mf('./examples/compat/common/truthvalue/TruthValueTest.metta'). +mf('./examples/compat/dependent-types/DeductionDTL.metta'). +mf('./examples/compat/dependent-types/DeductionDTLTest.metta'). +mf('./examples/compat/dependent-types/DeductionImplicationDirectIntroductionDTLTest.metta'). +mf('./examples/compat/dependent-types/ImplicationDirectIntroductionDTL.metta'). +mf('./examples/compat/dependent-types/ImplicationDirectIntroductionDTLTest.metta'). +mf('./examples/compat/dependent-types/ModusPonensDTL.metta'). +mf('./examples/compat/dependent-types/ModusPonensDTLTest.metta'). +mf('./examples/compat/entail/DeductionEntail.metta'). +mf('./examples/compat/entail/DeductionEntailTest.metta'). +mf('./examples/compat/entail/ImplicationDirectIntroductionEntail.metta'). +mf('./examples/compat/entail/ImplicationDirectIntroductionEntailTest.metta'). +mf('./examples/compat/equal/DeductionEqual.metta'). +mf('./examples/compat/equal/DeductionEqualTest.metta'). +mf('./examples/compat/equal/ImplicationDirectIntroductionEqual.metta'). +mf('./examples/compat/equal/ImplicationDirectIntroductionEqualTest.metta'). +mf('./examples/compat/match/DeductionImplicationDirectIntroductionMatchTest.metta'). +mf('./examples/compat/match/DeductionMatch.metta'). +mf('./examples/compat/match/DeductionMatchTest.metta'). +mf('./examples/compat/match/ImplicationDirectIntroductionMatch.metta'). +mf('./examples/compat/match/ImplicationDirectIntroductionMatchTest.metta'). +mf('./examples/compat/prob-dep-types/inf_order_probs.metta'). +mf('./examples/compat/prob-dep-types/prob_dep_types.metta'). +mf('./examples/compat/recursion-schemes/src/base.metta'). +mf('./examples/compat/recursion-schemes/src/examples/benchmark.metta'). +mf('./examples/compat/recursion-schemes/src/examples/expression.metta'). +mf('./examples/compat/recursion-schemes/src/schemes.metta'). +mf('./examples/compat/synthesis/experiments/non-determinism.metta'). +mf('./examples/compat/synthesis/experiments/self-contained-synthesize.metta'). +mf('./examples/compat/synthesis/experiments/synthesize-via-case-test.metta'). +mf('./examples/compat/synthesis/experiments/synthesize-via-case.metta'). +mf('./examples/compat/synthesis/experiments/synthesize-via-let-test.metta'). +mf('./examples/compat/synthesis/experiments/synthesize-via-let.metta'). +mf('./examples/compat/synthesis/experiments/synthesize-via-superpose.metta'). +mf('./examples/compat/synthesis/experiments/synthesize-via-type-checking.metta'). +mf('./examples/compat/synthesis/experiments/synthesize-via-unify-test.metta'). +mf('./examples/compat/synthesis/experiments/synthesize-via-unify.metta'). +mf('./examples/compat/synthesis/experiments/unify-via-case.metta'). +mf('./examples/compat/synthesis/experiments/unify-via-let.metta'). +mf('./examples/compat/synthesis/Synthesize.metta'). +mf('./examples/compat/synthesis/SynthesizeTest.metta'). +mf('./examples/compat/synthesis/Unify.metta'). +mf('./examples/compat/synthesis/UnifyTest.metta'). +mf('./examples/compat/test_scripts/a1_symbols.metta'). +mf('./examples/compat/test_scripts/a2_opencoggy.metta'). +mf('./examples/compat/test_scripts/a3_twoside.metta'). +mf('./examples/compat/test_scripts/b0_chaining_prelim.metta'). +mf('./examples/compat/test_scripts/b1_equal_chain.metta'). +mf('./examples/compat/test_scripts/b2_backchain.metta'). +mf('./examples/compat/test_scripts/b3_direct.metta'). +mf('./examples/compat/test_scripts/b4_nondeterm.metta'). +mf('./examples/compat/test_scripts/b5_types_prelim.metta'). +mf('./examples/compat/test_scripts/c1_grounded_basic.metta'). +mf('./examples/compat/test_scripts/c2_spaces.metta'). +mf('./examples/compat/test_scripts/c2_spaces_kb.metta'). +mf('./examples/compat/test_scripts/c3_pln_stv.metta'). +mf('./examples/compat/test_scripts/d1_gadt.metta'). +mf('./examples/compat/test_scripts/d2_higherfunc.metta'). +mf('./examples/compat/test_scripts/d3_deptypes.metta'). +mf('./examples/compat/test_scripts/d4_type_prop.metta'). +mf('./examples/compat/test_scripts/d5_auto_types.metta'). +mf('./examples/compat/test_scripts/e1_kb_write.metta'). +mf('./examples/compat/test_scripts/e2_states.metta'). +mf('./examples/compat/test_scripts/e3_match_states.metta'). +mf('./examples/compat/test_scripts/f1_imports.metta'). +mf('./examples/compat/test_scripts/f1_moduleA.metta'). +mf('./examples/compat/test_scripts/f1_moduleB.metta'). +mf('./examples/compat/test_scripts/f1_moduleC.metta'). +mf('./examples/compat/test_scripts/_e2_states_dia.metta'). +mf('./examples/fibo.metta'). +mf('./examples/fwgc.metta'). +mf('./examples/httpclient.metta'). +mf('./examples/NARS.metta'). +mf('./examples/NARS_listing.metta'). +mf('./examples/RUN_minnars.metta'). +mf('./examples/RUN_tests0.metta'). +mf('./examples/RUN_tests1.metta'). +mf('./examples/RUN_tests2.metta'). +mf('./examples/RUN_tests3.metta'). +mf('./examples/send-more.metta'). +mf('./examples/talk80.metta'). +mf('./examples/VRUN_tests0.metta'). +mf('./examples/VRUN_tests1.metta'). +mf('./examples/VRUN_tests2.metta'). +mf('./examples/VRUN_tests3.metta'). +mf('./src/nm_test.metta'). +mf('./src/r.metta'). +mf('./src/test_nspace.metta'). +:- forall(mf(H),add_history1(load_metta(H))). +%:- load_metta + + + + + +end_of_file. + + + +parsing(String, Expr) :- string(String),!,string_codes(String,Codes),phrase(expressions(Expr), Codes). +parsing(String, Expr) :- phrase(expressions(Expr), String). + +expressions([E|Es]) --> + ws, expression(E), ws, + !, % single solution: longest input match + expressions(Es). +expressions([]) --> []. + +% ws --> ";",until_eol, +ws --> [W], { code_type(W, space) }, ws. +ws --> []. + +% A number N is represented as n(N), a symbol S as s(S). + +expression(s(A)) --> symbol(Cs), { atom_codes(A, Cs) }. +expression(n(N)) --> number(Cs), { number_codes(N, Cs) }. +expression(List) --> [L],{is_bracket_lr(L,R)},expressions(List), [R]. +expression([s(quote),Q]) --> "'", expression(Q). + +number([D|Ds]) --> digit(D), number(Ds). +number([D]) --> digit(D). + +digit(D) --> [D], { code_type(D, digit) }. + +symbol([A|As]) --> + [A], + { is_ok_symbolchar(A) }, + symbolr(As). + +symbolr([A|As]) --> + [A], + { is_ok_symbolchar(A) ; code_type(A, alnum) }, + symbolr(As). +symbolr([]) --> []. + +is_bracket_lr(L,R):- member(LR,["()","{}","[]","\"\""]), nth0(0,LR,L),nth0(1,LR,R). +is_ok_symbolchar(A):- \+ code_type(A, space), \+ code_type(A, white), \+ is_bracket_lr(A,_), \+ is_bracket_lr(_,A). + +/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + Interpretation + -------------- + + Declaratively, execution of a Lisp form is a relation between the + (function and variable) binding environment before its execution + and the environment after its execution. A Lisp program is a + sequence of Lisp forms, and its result is the sequence of their + results. The environment is represented as a pair of association + lists Fs-Vs, associating function names with argument names and + bodies, and variables with values. DCGs are used to implicitly + thread the environment state through. +- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ + +codelist_to_forms_i(AsciiCodesList,FormsOut):- + parsing(AsciiCodesList, Forms0), + compile_all(Forms0, FormsOut),!. + +run(Program, Values) :- + parsing(Program, Forms0), + empty_assoc(E), + compile_all(Forms0, Forms), + writeq(seeingFormas(Forms)),nl, + phrase(eval_all(Forms, Values0), [E-E], _), + maplist(unfunc, Values0, Values). + +unfunc(s(S), S). +unfunc(t, t). +unfunc(n(N), N). +unfunc([], []). +unfunc([Q0|Qs0], [Q|Qs]) :- unfunc(Q0, Q), unfunc(Qs0, Qs). + +fold([], _, V, n(V)). +fold([n(F)|Fs], Op, V0, V) :- E =.. [Op,V0,F], V1 is E, fold(Fs, Op, V1, V). + +compile_all(Fs0, Fs) :- maplist(compile, Fs0, Fs). + +/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + compile/2 marks (with 'user/1') calls of user-defined functions. + This eliminates an otherwise defaulty representation of function + calls and thus allows for first argument indexing in eval//3. +- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ + +compile(F0, F) :- + ( F0 = n(_) -> F = F0 + ; F0 = s(t) -> F = t + ; F0 = s(nil) -> F = [] + ; F0 = s(_) -> F = F0 + ; F0 = [] -> F = [] + ; F0 = [s(quote),Arg] -> F = [quote,Arg] + ; F0 = [s(setq),s(Var),Val0] -> compile(Val0, Val), F = [setq,Var,Val] + ; F0 = [s(Op)|Args0], + memberchk(Op, [+,-,*,equal,if,>,<,=,progn,eval,list,car,cons, + cdr,while,not]) -> + compile_all(Args0, Args), + F = [Op|Args] + ; F0 = [s(defun),s(Name),Args0|Body0] -> + compile_all(Body0, Body), + maplist(arg(1), Args0, Args), + F = [defun,Name,Args|Body] + ; F0 = [s(Op)|Args0] -> compile_all(Args0, Args), F = [user(Op)|Args] + ). + +eval_all([], []) --> []. +eval_all([A|As], [B|Bs]) --> eval(A, B), eval_all(As, Bs). + +eval(n(N), n(N)) --> []. +eval(t, t) --> []. +eval([], []) --> []. +eval(s(A), V), [Fs-Vs] --> [Fs-Vs], { get_assoc(A, Vs, V) }. +eval([L|Ls], Value) --> eval(L, Ls, Value). + +eval(quote, [Q], Q) --> []. +eval(+, As0, V) --> eval_all(As0, As), { fold(As, +, 0, V) }. +eval(-, As0, V) --> eval_all(As0, [n(V0)|Vs0]), { fold(Vs0, -, V0, V) }. +eval(*, As0, V) --> eval_all(As0, Vs), { fold(Vs, *, 1, V) }. +eval(car, [A], C) --> eval(A, V), { V == [] -> C = [] ; V = [C|_] }. +eval(cdr, [A], C) --> eval(A, V), { V == [] -> C = [] ; V = [_|C] }. +eval(list, Ls0, Ls) --> eval_all(Ls0, Ls). +eval(not, [A], V) --> eval(A, V0), goal_truth(V0=[], V). +eval(>, [A,B], V) --> eval(A, n(V1)), eval(B, n(V2)), goal_truth(V1>V2, V). +eval(<, [A,B], V) --> eval(>, [B,A], V). +eval(=, [A,B], V) --> eval(A, n(V1)), eval(B, n(V2)), goal_truth(V1=:=V2, V). +eval(progn, Ps, V) --> eval_all(Ps, Vs), { last(Vs, V) }. +eval(eval, [A], V) --> eval(A, F0), { compile(F0, F1) }, eval(F1, V). +eval(equal, [A,B], V) --> eval(A, V1), eval(B, V2), goal_truth(V1=V2, V). +eval(cons, [A,B], [V0|V1]) --> eval(A, V0), eval(B, V1). +eval(while, [Cond|Bs], []) --> + ( eval(Cond, []) -> [] + ; eval_all(Bs, _), + eval(while, [Cond|Bs], _) + ). +eval(defun, [F,As|Body], s(F)), [Fs-Vs0] --> + [Fs0-Vs0], + { put_assoc(F, Fs0, As-Body, Fs) }. +eval(user(F), As0, V), [Fs-Vs] --> + eval_all(As0, As1), + [Fs-Vs], + { empty_assoc(E), + get_assoc(F, Fs, As-Body), + bind_arguments(As, As1, E, Bindings), + phrase(eval_all(Body, Results), [Fs-Bindings], _), + last(Results, V) }. +eval('bind!', [Var,V0], V), [Fs0-Vs] --> + eval(V0, V), + [Fs0-Vs0], + { put_assoc(Var, Vs0, V, Vs) }. +eval(setq, [Var,V0], V), [Fs0-Vs] --> + eval(V0, V), + [Fs0-Vs0], + { put_assoc(Var, Vs0, V, Vs) }. +eval(if, [Cond,Then|Else], Value) --> + ( eval(Cond, []) -> eval_all(Else, Values), { last(Values, Value) } + ; eval(Then, Value) + ). + +:- meta_predicate goal_truth(0,*,//,//). +goal_truth(Goal, T) --> { Goal -> T = t ; T = [] }. + +bind_arguments([], [], Bs, Bs). +bind_arguments([A|As], [V|Vs], Bs0, Bs) :- + put_assoc(A, Bs0, V, Bs1), + bind_arguments(As, Vs, Bs1, Bs). + +run(S):-'format'('~n~s~n',[S]),run(S,V),writeq(V). + +%if_script_file_time(X):-if_startup_script(time(X)). +if_script_file_time(_):-!. +%if_script_file_time(X):- nop(time(X)). + +% Append: + :- if_script_file_time(run(" + (defun append (x y) + (if x + (cons (car x) (append (cdr x) y)) + y)) + + (append '(a b) '(3 4 5))")). + + %@ V = [append, [a, b, 3, 4, 5]]. + + +% Fibonacci, naive version: + :- if_script_file_time(run(" + (defun fib (n) + (if (= 0 n) + 0 + (if (= 1 n) + 1 + (+ (fib (- n 1)) (fib (- n 2)))))) + (fib 24)")). + + %@ % 14,255,802 inferences, 3.71 CPU in 3.87 seconds (96% CPU, 3842534 Lips) + %@ V = [fib, 46368]. + + +% Fibonacci, accumulating version: + :- if_script_file_time(run(" + (defun fib (n) + (if (= 0 n) 0 (fib1 0 1 1 n))) + + (defun fib1 (f1 f2 i to) + (if (= i to) + f2 + (fib1 f2 (+ f1 f2) (+ i 1) to))) + + (fib 250)")). + + %@ % 39,882 inferences, 0.010 CPU in 0.013 seconds (80% CPU, 3988200 Lips) + %@ V = [fib, fib1, 7896325826131730509282738943634332893686268675876375]. + + +% Fibonacci, iterative version: + :- if_script_file_time(run(" + (defun fib (n) + (setq f (cons 0 1)) + (setq i 0) + (while (< i n) + (setq f (cons (cdr f) (+ (car f) (cdr f)))) + (setq i (+ i 1))) + (car f)) + + (fib 350)")). + + %@ % 30,794 inferences, 0.002 CPU in 0.002 seconds (100% CPU, 12831368 Lips) + %@ V = [fib, 6254449428820551641549772190170184190608177514674331726439961915653414425]. + + + +% Fibonacci, accumulating version: + :- if_script_file_time(run(" + (defun fib (n) + (if (= 0 n) 0 (fib1 0 1 1 n))) + + (defun fib1 (f1 f2 i to) + (if (= i to) + f2 + (fib1 f2 (+ f1 f2) (+ i 1) to))) + + (fib 350)")). + + %@ % 44,595 inferences, 0.003 CPU in 0.003 seconds (100% CPU, 14526532 Lips) + %@ V = [fib, fib1, 6254449428820551641549772190170184190608177514674331726439961915653414425]. + + +% Higher-order programming and eval: + :- if_script_file_time(run(" + (defun map (f xs) + (if xs + (cons (eval (list f (car xs))) (map f (cdr xs))) + ())) + + (defun plus1 (x) (+ 1 x)) + + (map 'plus1 '(1 2 3)) + " + )). + + %@ V = [map, plus1, [2, 3, 4]]. + +%:- ensure_loaded(metta_reader). + + + +#[test] +fn test_case_operation() { + let metta = new_metta_rust(); + let result = metta.run(&mut SExprParser::new(" + ")); + + let expected = metta.run(&mut SExprParser::new(" + ! OK + ! 7 + ! (superpose (OK-3 OK-4)) + ! (superpose (3 4 5)) + ! (superpose ()) + ")); + assert_eq!(result, expected); + + let metta = new_metta_rust(); + let result = metta.run(&mut SExprParser::new(" + (Rel-P A B) + (Rel-Q A C) + + ; cases can be used for deconstruction + !(case (match &self ($rel A $x) ($rel $x)) + (((Rel-P $y) (P $y)) + ((Rel-Q $y) (Q $y)))) + + ; %void% can be used to capture empty results + !(case (match &self ($rel B $x) ($rel $x)) + (((Rel-P $y) (P $y)) + ((Rel-Q $y) (Q $y)) + (%void% no-match))) + + ; a functional example + (= (maybe-inc $x) + (case $x + (((Just $v) (Just (+ 1 $v))) + (Nothing Nothing))) + ) + !(maybe-inc Nothing) + !(maybe-inc (Just 2)) + ")); + let expected = metta.run(&mut SExprParser::new(" + ! (superpose ((Q C) (P B))) + ! no-match + ! Nothing + ! (Just 3) + ")); + assert_eq_metta_results!(result, expected); +} + + + +use hyperon::metta::text::*; +use hyperon::metta::runner::new_metta_rust; + +#[test] +fn test_reduce_higher_order() { + let program = " + ; Curried plus + (: plus (-> Number (-> Number Number))) + (= ((plus $x) $y) (+ $x $y)) + ; Define inc as partial evaluation of plus + (: inc (-> (-> Number Number))) + (= (inc) (plus 1)) + + !(assertEqualToResult ((inc) 2) (3)) + "; + let metta = new_metta_rust(); + + let result = metta.run(&mut SExprParser::new(program)); + + assert_eq!(result, Ok(vec![vec![]])); +} + + + +use hyperon::*; +use hyperon::space::grounding::GroundingSpace; + +#[test] +fn test_custom_match_with_space() { + let mut main_space = GroundingSpace::new(); + let mut inserted_space = GroundingSpace::new(); + inserted_space.add(expr!("implies" ("B" x) ("C" x))); + inserted_space.add(expr!("implies" ("A" x) ("B" x))); + inserted_space.add(expr!("A" "Sam")); + main_space.add(Atom::gnd(inserted_space)); + let result = main_space.query(&expr!("," ("implies" ("B" x) z) ("implies" ("A" x) y) ("A" x))); + assert_eq!(result.len(), 1); + assert_eq!(result[0].resolve(&VariableAtom::new("y")), Some(expr!("B" "Sam"))); + assert_eq!(result[0].resolve(&VariableAtom::new("z")), Some(expr!("C" "Sam"))); +} + + + +use hyperon::*; +use hyperon::common::*; +use hyperon::metta::interpreter::*; +use hyperon::space::grounding::GroundingSpace; + +#[test] +fn test_types_in_metta() { + let mut space = GroundingSpace::new(); + space.add(expr!("=" ("check" (":" n "Int")) ({IS_INT} n))); + space.add(expr!("=" ("check" (":" n "Nat")) ({AND} ("check" (":" n "Int")) ({GT} n {0})))); + space.add(expr!("=" ("if" {true} then else) then)); + space.add(expr!("=" ("if" {false} then else) else)); + space.add(expr!(":" "if" ("->" "bool" "Atom" "Atom" "Atom"))); + space.add(expr!("=" ("fac" n) ("if" ("check" (":" n "Nat")) ("if" ({EQ} n {1}) {1} ({MUL} n ("fac" ({SUB} n {1})))) ({ERR})))); + + assert_eq!(interpret(&space, &expr!("check" (":" {3} "Int"))), Ok(vec![expr!({true})])); + assert_eq!(interpret(&space, &expr!("check" (":" {(-3)} "Int"))), Ok(vec![expr!({true})])); + assert_eq!(interpret(&space, &expr!("check" (":" {3} "Nat"))), Ok(vec![expr!({true})])); + assert_eq!(interpret(&space, &expr!("check" (":" {(-3)} "Nat"))), Ok(vec![expr!({false})])); + assert_eq!(interpret(&space, &expr!("if" ("check" (":" {(3)} "Nat")) "ok" "nok")), Ok(vec![expr!("ok")])); + assert_eq!(interpret(&space, &expr!("if" ("check" (":" {(-3)} "Nat")) "ok" "nok")), Ok(vec![expr!("nok")])); + assert_eq!(interpret(&space, &expr!("fac" {1})), Ok(vec![expr!({1})])); + assert_eq!(interpret(&space, &expr!("fac" {3})), Ok(vec![expr!({6})])); +} + + + + + + + + + #[test] + fn test_match_expression_with_variables() { + let mut space = GroundingSpace::new(); + space.add(expr!("+" "A" ("*" "B" "C"))); + assert_eq!(space.query(&expr!("+" a ("*" b c))), + bind_set![{a: expr!("A"), b: expr!("B"), c: expr!("C") }]); + } + + #[test] + fn test_match_different_value_for_variable() { + let mut space = GroundingSpace::new(); + space.add(expr!("+" "A" ("*" "B" "C"))); + assert_eq!(space.query(&expr!("+" a ("*" a c))), BindingsSet::empty()); + } + + #[test] + fn test_match_query_variable_has_priority() { + let mut space = GroundingSpace::new(); + space.add(expr!("equals" x x)); + + let result = space.query(&expr!("equals" y z)); + assert_eq!(result, bind_set![{ y: expr!(z) }]); + } + + #[test] + fn test_match_query_variable_via_data_variable() { + let mut space = GroundingSpace::new(); + space.add(expr!(x x)); + assert_eq!(space.query(&expr!(y (z))), bind_set![{y: expr!((z))}]); + } + + #[test] + fn test_match_if_then_with_x() { + let mut space = GroundingSpace::new(); + space.add(expr!("=" ("if" "True" then) then)); + assert_eq!(space.query(&expr!("=" ("if" "True" "42") X)), + bind_set![{X: expr!("42")}]); + } + + #[test] + fn test_match_combined_query() { + let mut space = GroundingSpace::new(); + space.add(expr!("posesses" "Sam" "baloon")); + space.add(expr!("likes" "Sam" ("blue" "stuff"))); + space.add(expr!("has-color" "baloon" "blue")); + + let result = space.query(&expr!("," ("posesses" "Sam" object) + ("likes" "Sam" (color "stuff")) + ("has-color" object color))); + assert_eq!(result, bind_set![{object: expr!("baloon"), color: expr!("blue")}]); + } + diff --git a/.Attic/canary_docme/metta_threads.pl b/.Attic/canary_docme/metta_threads.pl new file mode 100644 index 00000000000..7d028e7ea7c --- /dev/null +++ b/.Attic/canary_docme/metta_threads.pl @@ -0,0 +1,187 @@ +:- use_module(library(predicate_options)). +:- use_module(library(record)). + +% convenience for async/3 options +:- record opts( policy:oneof([ephemeral,lazy])=ephemeral + ). +:- predicate_options(spawn/2,2,[pass_to(async/3,3)]). +:- predicate_options(async/3,3, [ policy(+oneof([ephemeral,lazy])) + ]). + +:- meta_predicate + spawn(0), + async(0,-), + async(0,-,+), + async_policy(+,0,-,+). + +:- thread_local + spawn_token_needs_await/1. + +%% spawn(:Goal) is det. +% +% Like spawn/2 with default options. +spawn(Goal) :- + spawn(Goal, []). + + +%% spawn(:Goal,+Options) is det. +% +% Seek solutions to Goal in a background thread. Solutions are +% communicated to the calling thread by unifying free variables in +% Goal. If Goal has no free variables, you must use async/3 instead. +% Options are passed through to async/3. +% +% For example, the following code runs in about 1 second because both +% sleep/1 calls happen in parallel. When foo/0 unifies L, it blocks +% until silly/1 has finished. +% +% silly(L) :- +% sleep(1), +% L = [a,b]. +% foo :- +% spawn(silly(L)), +% sleep(1), +% L=[A,B], % blocks, if necessary +% writeln(A-B). +% +% If Goal produces multiple solutions, they're iterated when +% backtracking over the unification (=|L=[A,B]|= above). If Goal fails +% or throws an exception, the calling thread sees it at the unification +% point. +spawn(Goal,Options) :- + term_variables(Goal, Vars), + async(Goal, Token, Options), + Id is random(1<<63), + assert(spawn_token_needs_await(Id)), + make_opts(Options,Opts), + maplist(spawn_freeze(Id,Token,Opts), Vars). + +spawn_freeze(Id,Token,Opts,Var) :- + freeze(Var,spawn_thaw(Id,Token,Opts)). + +spawn_thaw(Id,Token,Opts) :- + ( retract(spawn_token_needs_await(Id)) -> + debug(spawn,"Await on ~d",[Id]), + await(Token) + ; opts_policy(Opts,lazy) -> + debug(spawn,"Awaiting again on ~d",[Id]), + await(Token) + ; % already called await/1 -> + debug(spawn,"Already did await on ~d",[Id]), + true + ). + + +%% lazy(Goal) is det. +% +% Postpone execution of goal until needed. This is just spawn/1 +% using the =lazy= thread policy. +% +% lazy/1 can be helpful when complicated or expensive goals are only +% needed in some code paths but duplicating those goals is too verbose. +% It can be an alternative to creating a new, named predicate. For +% example, +% +% foo(Xs) :- +% lazy(i_am_slow(a,B,[c(C),d(d),e(etc)])), % complicated +% +% ( day_of_week(tuesday) -> +% append(B,C,Xs) +% ; phase_of_moon(full) -> +% append(C,B,Xs) +% ; true -> +% % i_am_slow/3 not executed in this code path +% Xs = [hi] +% ). +lazy(Goal) :- + spawn(Goal,[policy(lazy)]). + + +%% async(:Goal,-Token) is det. +% +% Like async/3 with default options. +async(Goal,Token) :- + async(Goal,Token,[]). + + +%% async(:Goal,-Token,+Options) is det. +% +% Seek solutions to Goal in a background thread. Use await/1 with Token +% to block until the computation is done. Solutions are communicated to +% the calling thread by unifying free variables in Goal. Both Goal and +% its corresponding solutions are copied between threads. Be aware if +% any of those terms are very large. +% +% Options are as follows: +% +% * policy(Policy) +% If =ephemeral= (default), create a new thread in which to call +% goal. If =lazy=, only execute Goal when await/1 is called; no +% background threads are used. +async(Goal,Token,Options) :- + make_opts(Options,Opts), + opts_policy(Opts, Policy), + async_policy(Policy, Goal, Token, Opts). + + +async_policy(ephemeral, Goal, Token, _Opts) :- + % what does the caller need to track this computation? + term_variables(Goal, Vars), + message_queue_create(SolutionsQ, [max_size(1)]), + Token = ephemeral_token(Vars,SolutionsQ), + + % start the worker thread + Work = work(Goal,Vars,SolutionsQ), + thread_create(ephemeral_worker(Work), _, [detached(true)]). +async_policy(lazy,Goal,Token,_Opts) :- + Token = lazy_thunk(Goal). + + +ephemeral_worker(work(Goal,Vars,SolutionsQ)) :- + debug(spawn,"Seeking solutions to: ~q", [Goal]), + ( catch(call_cleanup(Goal,Done=true),E,true) *-> + ( nonvar(E) -> + debug(spawn,"Caught exception: ~q", [E]), + thread_send_message(SolutionsQ,exception(E)) + ; var(Done) -> + debug(spawn,"Sending solution: ~q", [Vars]), + thread_send_message(SolutionsQ,solution(Vars)), + fail % look for another solution + ; Done=true -> + debug(spawn,"Final solution: ~q", [Vars]), + thread_send_message(SolutionsQ,final(Vars)) + ) + ; % no solutions -> + debug(spawn, "Found no solutions", []), + thread_send_message(SolutionsQ,none) + ). + + +%% await(+Token) +% +% Wait for solutions from an async/3 call. Token is an opaque value +% provided by async/3 which identifies a background computation. +% +% await/1 strives to have the same determinism as the original Goal +% passed to async/3. If that goal fails, await/1 fails. If that goal +% throws an exception, so does await/1. If that goal produces many +% solutions, so does await/1 on backtracking. +await(ephemeral_token(Vars,SolutionsQ)) :- + repeat, + thread_get_message(SolutionsQ,Solution), + ( Solution = solution(Vars) -> + true + ; Solution = final(Vars) -> + !, + true + ; Solution = none -> + !, + fail + ; Solution = exception(E) -> + throw(E) + ; % what? -> + throw(unexpected_await_solution(Solution)) + ). +await(lazy_thunk(Goal)) :- + call(Goal). + diff --git a/.Attic/metta_lang/metta_types.pl.broken b/.Attic/canary_docme/metta_types.pl old mode 100755 new mode 100644 similarity index 82% rename from .Attic/metta_lang/metta_types.pl.broken rename to .Attic/canary_docme/metta_types.pl index 36ef3b0917e..a94a7f93da8 --- a/.Attic/metta_lang/metta_types.pl.broken +++ b/.Attic/canary_docme/metta_types.pl @@ -65,7 +65,7 @@ is_metta_data_functor(Eq,Other,H):- H\=='Right', H\=='Something', % metta_type(Other,H,_), % fail, \+ get_metta_atom(Eq,Other,[H|_]), - \+ metta_defn(Eq,Other,[H|_],_), + \+ metta_eq_def(Eq,Other,[H|_],_), \+ is_metta_builtin(H), \+ is_comp_op(H,_), \+ is_math_op(H,_,_). @@ -135,31 +135,6 @@ \+ arg_violation(Depth,Self,Arg,Type). -ignored_args_conform(Depth,Self,A,L):- ( \+ iz_conz(Args); \+ iz_conz(List)), !. -ignored_args_conform(Depth,Self,A,L):- maplist(ignored_arg_conform(Depth,Self),A,L). -ignored_arg_conform(Depth,Self,A,L):- nonvar(L), is_nonspecific_type(L),!. -ignored_arg_conform(Depth,Self,A,L):- get_type(Depth,Self,A,T), type_conform(T,L),!. -ignored_arg_conform(Depth,Self,_,_):- !. - -args_conform(_Dpth,_Slf,Args,List):- ( \+ iz_conz(Args); \+ iz_conz(List)), !. -args_conform(Depth,Self,[A|Args],[L|List]):- - arg_conform(Depth,Self,A,L), args_conform(Depth,Self,Args,List). - -arg_conform(_Dpth,_Slf,_A,L):- nonvar(L), is_nonspecific_type(L),!. - arg_conform(Depth,Self,A,L):- get_type(Depth,Self,A,T), type_conform(T,L),!. -%arg_conform(_Dpth,_Slf,_,_). -%arg_conform(Depth,Self,A,_):- get_type(Depth,Self,A,_),!. - -type_conform(T,L):- T=L,!. -type_conform(T,L):- \+ \+ (is_nonspecific_type(T);is_nonspecific_type(L)),!. -type_conform(T,L):- can_assign(T,L). - -is_nonspecific_type(Var):- var(Var),!. -is_nonspecific_type('%Undefined%'). -is_nonspecific_type([]). -is_nonspecific_type('Atom'). -is_nonspecific_type('Any'). - get_types(Depth,Self,Var,TypeSet):- setof(Type,get_type_each(Depth,Self,Var,Type),TypeSet). @@ -187,11 +162,10 @@ is_dynaspace(S):- was_asserted_space(S). is_dynaspace(S):- py_named_space(S). is_dynaspace(S):- typed_list(S,'hyperon::space::DynSpace',_). -% notrace( is_space_type(Expr,_)),!. - +% fake_notrace( is_space_type(Expr,_)),!. -get_type_each(_Dpth,_Slf,Expr,'hyperon::space::DynSpace'):- is_dynaspace(Expr),!. +get_type_each(_, _, Nil, UD):- Nil==[],!,UD='%Undefined%'. get_type_each(Depth,Self,Val,Type):- \+ integer(Depth),!,get_type_each(10,Self,Val,Type). get_type_each(Depth,_Slf,_Type,_):- Depth<1,!, fail. %get_type(Depth,Self,Val,Type):- is_debugging(eval), @@ -206,14 +180,18 @@ get_type_each(_Dpth,Self,Var,Type):- var(Var),!, get_attr(Var,metta_type,Self=TypeList),member(Type,TypeList). +get_type_each(_Dpth,_Slf,Expr,'hyperon::space::DynSpace'):- is_dynaspace(Expr),!. get_type_each(Depth,Self,Val,Type):- \+ compound(Val),!, get_type_nc(Depth,Self,Val,Type). get_type_each(Depth,Self,Val,Type):- - ignore(check_bad_type(Depth,Self,Val)), - if_or_else((get_type_cmpd(Depth,Self,Val,Type,How),trace_get_type(How,Type,gt(Val))), + if_t(option_value('type-check',auto),check_bad_type(Depth,Self,Val)), + if_or_else((get_type_cmpd_2nd_non_nil(Depth,Self,Val,Type,How),trace_get_type(How,Type,gt(Val))), (trace_get_type('FAILED','',gt(Val)),fail)). - +get_type_cmpd_2nd_non_nil(Depth,Self,Val,Type,How):- + call_nth(get_type_cmpd(Depth,Self,Val,Type,How),Nth), + (Nth>1 -> Type\==[] ; true). +/* have_some_defs(Depth,Self,Val):- \+ \+ ([H|Args] = Val, @@ -234,11 +212,11 @@ check_bad_type2(Depth,Self,Val):- Val= [Op|Args], typed_expression(Depth,Self,[Op|Args],ArgTypes,RType), trace_get_type(type_sig(Op),ArgTypes,RType), - ignored_args_conform(Depth,Self,Args,ArgTypes), + args_conform(Depth,Self,Args,ArgTypes), (args_violation(Depth,Self,Args,ArgTypes) -> (trace_get_type(bad_type,args_violation(Args,ArgTypes),check),fail); (trace_get_type(conformed,no_args_violation(Args,ArgTypes),check),true)). - +*/ typed_expression(Depth,Self,[Op|Args],ArgTypes,RType):- len_or_unbound(Args,Len), get_operator_typedef1(Self,Op,Len,ArgTypes,RType). @@ -249,9 +227,12 @@ args_violation(Depth,Self,Args,ArgTypes), !. +:- nodebug(metta(types)). +:- nodebug(types). trace_get_type(How,Type,Val):- + if_trace(types, color_g_mesg('#7f2f2f', - w_indent(3,format('<-- ~@ <- ~@ < ~@',[wsf(How),wsf(Type),wsf(Val)]))),!. + w_indent(3,format('<-- ~@ <- ~@ < ~@',[wsf(How),wsf(Type),wsf(Val)])))),!. wsf(T):- with_indents(false,write_src(T)). get_type_nc(_Dpth,Self,Op,Type):- metta_type(Self,Op,Type). @@ -282,16 +263,15 @@ %get_type_cmpd(_Dpth,Self,Op,Type):- copy_term(Op,Copy), % metta_type(Self,Op,Type), Op=@=Copy. -get_type_cmpd(Depth,Self,NC,Type,nc):- \+ compound(NC),!, get_type(Depth,Self,NC,Type). -get_type_cmpd(_Dpth,_Slf,Val,Type,char):- Val='#\\'(_),Type='Char'. -get_type_cmpd(_Dpth,_Slf,Val,Type,dict):- is_dict(Val,Type), + +get_type_cmpd(_Dpth,_Slf,Val,Type,dict):- is_dict(Val,Type),!, get_dict_type(Val,Type,TypeO). % Curried Op -get_type_cmpd(Depth,Self,[[Op|Args]|Arg],Type,curried):- +get_type_cmpd(Depth,Self,[[Op|Args]|Arg],Type,curried(W)):- symbol(Op), Depth2 is Depth-1, - get_type_cmpd(Depth2,Self,[Op|Args],Type1), + get_type_cmpd(Depth2,Self,[Op|Args],Type1,W), get_type(Depth2,Self,Arg,ArgType), ignore(sub_var(ArgType,Type1)->true; (sub_term(ST,Type1),var(ST),ST=ArgType)), @@ -303,23 +283,35 @@ len_or_unbound(Args,Len), get_operator_typedef1(Self,Op,Len,[P|Arams],RetType), % Fills in type variables when possible - ignored_args_conform(Depth,Self,Args,[P|Arams]), + args_conform(Depth,Self,Args,[P|Arams]), % \+ maplist(var,Arams), % unitests: arg violations should return () (\+ args_violation(Depth,Self,Args,[P|Arams])), Type=RetType. + get_type_cmpd(_Dpth,_Slf,Cmpd,Type,typed_list):- typed_list(Cmpd,Type,_List). - /* - get_type_cmpd(Depth,Self,[Op|Expr],Type,not_bat):- - symbol(Op), - maplist(get_type(Depth,Self),Expr,Types), - [Op|Types]\=@=[Op|Expr], - \+ badly_typed_expression(Depth,Self,[Op|Expr]), - metta_type(Self,[Op|Types],Type). - */ +get_type_cmpd(_Dpth,_Slf,_Cmpd,[],unknown). + +/* +get_type_cmpd(Depth,Self,[Op|Expr],Type,not_bat):- + symbol(Op), + maplist(get_type(Depth,Self),Expr,Types), + [Op|Types]\=@=[Op|Expr], + \+ badly_typed_expression(Depth,Self,[Op|Expr]), + metta_type(Self,[Op|Types],Type). + +get_type_cmpd(Depth,Self,List,Types,maplist(get_type)):- + List\==[], + \+ badly_typed_expression(Depth,Self,List), + is_list(List), + Depth2 is Depth-1, + maplist(get_type(Depth2,Self),List,Types), + \+ badly_typed_expression(Depth,Self,Types). + +*/ get_type_cmpd(Depth,Self,EvalMe,Type,eval_first):- needs_eval(EvalMe), Depth2 is Depth-1, @@ -327,25 +319,6 @@ \+ needs_eval(Val), get_type(Depth2,Self,Val,Type). -get_type_cmpd(Depth,Self,List,Types,maplist(get_type)):- fail, - List\==[], - is_list(List), - Depth2 is Depth-1, - maplist(get_type_no_fn_or_self(Depth2,Self),List,Types), - List \=@= Types. - -get_type_cmpd(_Dpth,_Slf,_Cmpd,[],unknown). - -non_param_spec(Type):- var(Type), attvar(Type), !. -non_param_spec(Type):- var(Type), !, freeze(Type,non_param_spec(Type)). -non_param_spec([H|_]):- !, H \== '->'. -non_param_spec(_). - -get_type_no_fn_or_self(Depth2,Self,Val,Type):- - non_param_spec(Type),get_type(Depth2,Self,Val,Type),!. -get_type_no_fn_or_self(_Dpth,_Slf,Val,Val). - - state_decltype(Expr,Type):- functor(Expr,_,A), arg(A,Expr,Type),once(var(Type);is_decl_type(Type)). @@ -353,8 +326,9 @@ get_value_type(_Dpth,_Slf,Var,'%Undefined%'):- var(Var),!. get_value_type(_Dpth,_Slf,Val,'Number'):- number(Val),!. -get_value_type(_Dpth,_Slf,Val,T):- get_type(_Dpth,_Slf,Val,T), T\==[], T\=='%Undefined%',!. -get_value_type(_Dpth,_Slf,Val,T):- get_metatype(Val,T). +get_value_type(_Dpth,_Slf,Val,'String'):- string(Val),!. +get_value_type(Depth,Self,Val,T):- get_type(Depth,Self,Val,T), T\==[], T\=='%Undefined%',!. +get_value_type(_Dpth,_Slf,Val,T):- 'get-metatype'(Val,T). /* @@ -404,19 +378,19 @@ args_conform(Depth,Self,M,Params),!, set_type(Depth,Self,Y,RetType), into_typed_args(Depth,Self,Params,M,Y). -%adjust_args(Eq,RetType,Depth,Self,_,X,Y):- is_list(X), !, maplist(eval_args(Depth,Self),X,Y). -%adjust_args(Eq,RetType,Depth,Self,_,X,Y):- is_list(X), !, maplist(as_prolog(Depth,Self),X,Y),!. +%adjust_args(Else,Eq,RetType,Depth,Self,_,X,Y):- is_list(X), !, maplist(eval_args(Depth,Self),X,Y). +%adjust_args(Else,Eq,RetType,Depth,Self,_,X,Y):- is_list(X), !, maplist(as_prolog(Depth,Self),X,Y),!. -adjust_args_9(Eq,RetType,Res,NewRes,Depth,Self,Op,X,Y):- - adjust_args(Eq,RetType,Res,NewRes,Depth,Self,Op,X,Y). +adjust_args_9(Eq,RetType,ResIn,ResOut,Depth,Self,AE,More,Adjusted):- + adjust_args(eval,Eq,RetType,ResIn,ResOut,Depth,Self,AE,More,Adjusted). -adjust_args(_Eq,_RetType,Res,Res,_Dpth,Self,F,X,Y):- (X==[] ; +adjust_args(Else,_Eq,_RetType,Res,Res,_Dpth,Self,F,X,Y):- (X==[] ; is_special_op(Self,F); \+ iz_conz(X)),!,Y=X. -adjust_args(Eq,RetType,Res,NewRes,Depth,Self,Op,X,Y):- - if_or_else(adjust_argsA(Eq,RetType,Res,NewRes,Depth,Self,Op,X,Y), - adjust_argsB(Eq,RetType,Res,NewRes,Depth,Self,Op,X,Y)). +adjust_args(Else,Eq,RetType,Res,NewRes,Depth,Self,Op,X,Y):- + if_or_else(adjust_argsA(Else,Eq,RetType,Res,NewRes,Depth,Self,Op,X,Y), + adjust_argsB(Else,Eq,RetType,Res,NewRes,Depth,Self,Op,X,Y)). -adjust_argsA(Eq,RetType,Res,NewRes,Depth,Self,Op,X,Y):- +adjust_argsA(Else,Eq,RetType,Res,NewRes,Depth,Self,Op,X,Y):- len_or_unbound(X,Len), get_operator_typedef(Self,Op,Len,ParamTypes,RRetType), (nonvar(NewRes)->CRes=NewRes;CRes=Res), @@ -424,12 +398,65 @@ args_conform(Depth,Self,[CRes|X],[RRetType|ParamTypes]), into_typed_args(Depth,Self,[RRetType|ParamTypes],[Res|X],[NewRes|Y]). -adjust_argsB(Eq,_RetType,Res,Res,Depth,Self,_,Args,Adjusted):- is_list(Args),!, - maplist(eval_1_arg(Eq,_,Depth,Self),Args,Adjusted). -adjust_argsB(_Eq,_RetType,Res,Res,Depth,Self,_,X,Y):- as_prolog(Depth,Self,X,Y),!. +adjust_argsB(Else,Eq,_RetType,Res,Res,Depth,Self,_,Args,Adjusted):- is_list(Args),!, + maplist(eval_1_arg(Else,Eq,_,Depth,Self),Args,Adjusted). +adjust_argsB(Else,_Eq,_RetType,Res,Res,Depth,Self,_,X,Y):- call(Else,X,Y). % as_prolog(Depth,Self,X,Y),!. + +eval_1_arg(Else,Eq,ReturnType,Depth,Self,Arg,Adjusted):- + must_det_ll(if_or_else(eval(Eq,ReturnType,Depth,Self,Arg,Adjusted),call(Else,Arg,Adjusted))). + + +get_operator_typedef(Self,Op,ParamTypes,RetType):- + len_or_unbound(ParamTypes,Len), + get_operator_typedef(Self,Op,Len,ParamTypes,RetType). + +reset_cache:- retractall(get_operator_typedef0(_,_,_,_,_)). + +:- dynamic(get_operator_typedef0/5). +get_operator_typedef(Self,Op,Len,ParamTypes,RetType):- + len_or_unbound(ParamTypes,Len), + if_or_else(get_operator_typedef0(Self,Op,Len,ParamTypes,RetType), + if_or_else(get_operator_typedef1(Self,Op,Len,ParamTypes,RetType), + get_operator_typedef2(Self,Op,Len,ParamTypes,RetType))). + +get_operator_typedef1(Self,Op,Len,ParamTypes,RetType):- + len_or_unbound(ParamTypes,Len), + if_t(nonvar(ParamTypes),append(ParamTypes,[RetType],List)), + metta_type(Self,Op,['->'|List]), + if_t(var(ParamTypes),append(ParamTypes,[RetType],List)), + assert(get_operator_typedef0(Self,Op,Len,ParamTypes,RetType)). +get_operator_typedef2(Self,Op,Len,ParamTypes,RetType):- + ignore('AnyRet'=RetType), + maplist(is_eval_kind,ParamTypes), + assert(get_operator_typedef0(Self,Op,Len,ParamTypes,RetType)). + %nop(wdmsg(missing(get_operator_typedef2(Self,Op,ParamTypes,RetType)))),!,fail. + + +ignored_args_conform(Depth,Self,A,L):- ( \+ iz_conz(Args); \+ iz_conz(List)), !. +ignored_args_conform(Depth,Self,A,L):- maplist(ignored_arg_conform(Depth,Self),A,L). +ignored_arg_conform(Depth,Self,A,L):- nonvar(L), is_nonspecific_type(L),!. +ignored_arg_conform(Depth,Self,A,L):- get_type(Depth,Self,A,T), type_conform(T,L),!. +ignored_arg_conform(Depth,Self,_,_):- !. + +args_conform(_Dpth,_Slf,Args,List):- ( \+ iz_conz(Args); \+ iz_conz(List)), !. +args_conform(Depth,Self,[A|Args],[L|List]):- + arg_conform(Depth,Self,A,L), args_conform(Depth,Self,Args,List). + +arg_conform(_Dpth,_Slf,_A,L):- nonvar(L), is_nonspecific_type(L),!. + arg_conform(Depth,Self,A,L):- get_type(Depth,Self,A,T), type_conform(T,L),!. +%arg_conform(_Dpth,_Slf,_,_). +%arg_conform(Depth,Self,A,_):- get_type(Depth,Self,A,_),!. + +type_conform(T,L):- T=L,!. +type_conform(T,L):- \+ \+ (is_nonspecific_type(T);is_nonspecific_type(L)),!. +type_conform(T,L):- can_assign(T,L). + + +:- dynamic(thrown_metta_return/1). +throw_metta_return(L):- + asserta(thrown_metta_return(L)), + (throw(metta_return(L))). -eval_1_arg(Eq,ReturnType,Depth,Self,Arg,Adjusted):- - if_or_else(eval(Eq,ReturnType,Depth,Self,Arg,Adjusted),Arg=Adjusted). into_typed_args(_Dpth,_Slf,T,M,Y):- (\+ iz_conz(T); \+ iz_conz(M)),!, M=Y. into_typed_args(Depth,Self,[T|TT],[M|MM],[Y|YY]):- @@ -445,13 +472,14 @@ into_typed_arg0(Depth,Self,T,M,Y):- is_pro_eval_kind(T),!,eval_args(Depth,Self,M,Y). into_typed_arg0(Depth,Self,T,M,Y):- ground(M),!, \+ arg_violation(Depth,Self,M,T),Y=M. -into_typed_arg0(_Dpth,_Slf,T,M,Y):- is_non_eval_kind(T),!,M=Y. +into_typed_arg0(_Dpth,_Slf,T,M,Y):- nonvar(T), is_non_eval_kind(T),!,M=Y. into_typed_arg0(Depth,Self,_,M,Y):- eval_args(Depth,Self,M,Y). wants_eval_kind(T):- nonvar(T), is_pro_eval_kind(T),!. wants_eval_kind(_):- true. -metta_type:attr_unify_hook(Self=TypeList,NewValue):- attvar(NewValue),!,put_attr(NewValue,metta_type,Self=TypeList). +metta_type:attr_unify_hook(Self=TypeList,NewValue):- + attvar(NewValue),!,put_attr(NewValue,metta_type,Self=TypeList). metta_type:attr_unify_hook(Self=TypeList,NewValue):- get_type(20,Self,NewValue,Was), can_assign(Was,Type). @@ -471,20 +499,32 @@ put_attr(Var,metta_type,Self=TypeList). -can_assign(Was,Type):- Was=Type,!. + + can_assign(Was,Type):- (is_nonspecific_type(Was);is_nonspecific_type(Type)),!. -can_assign(Was,Type):- \+ cant_assign_to(Was,Type). +can_assign(Was,Type):- Was=Type,!. +%can_assign(Was,Type):- (Was=='Nat';Type=='Nat'),!,fail. +%can_assign(Was,Type):- \+ cant_assign_to(Was,Type). %can_assign(_Ws,_Typ). - +/* cant_assign_to(Was,Type):- cant_assign(Was,Type),!. cant_assign_to(Type,Was):- cant_assign(Was,Type),!. cant_assign(A,B):- \+ A \= B, !, fail. cant_assign(Number,String):- formated_data_type(Number),formated_data_type(String), Number\==String. cant_assign(Number,Other):- formated_data_type(Number), symbol(Other), Number\==Other. - -is_non_eval_kind(Type):- is_nonspecific_type(Type),!. +*/ +is_non_eval_kind(Var):- var(Var),!. +is_non_eval_kind(Type):- nonvar(Type),Type\=='Any', is_nonspecific_type(Type),!. is_non_eval_kind('Atom'). +is_nonspecific_type(Any):- notrace(is_nonspecific_type0(Any)),!. +is_nonspecific_type0(Var):- var(Var),!,fail. +is_nonspecific_type0('%Undefined%'). +is_nonspecific_type0('ErrorType'). +%is_nonspecific_type([]). +is_nonspecific_type0('Atom'). +is_nonspecific_type0(Any):- is_nonspecific_any(Any). + formated_data_type('Number'). formated_data_type('Symbol'). formated_data_type('Bool'). @@ -492,7 +532,44 @@ formated_data_type('String'). formated_data_type([List|_]):- List=='List'. +is_nonspecific_any(Any):- notrace(is_nonspecific_any0(Any)),!. + +is_nonspecific_any0(Any):- Any=='Any'. +is_nonspecific_any0(Any):- Any=='%Undefined%'. +%is_nonspecific_any0(Any):- Any=='Type'. +is_nonspecific_any0(Any):- Any=='AnyRet'. + + +is_nonspecific_type_na(NotAtom):- NotAtom\=='Atom', is_nonspecific_type(NotAtom). +narrow_types(RetType,RetType,RetType):- !. +narrow_types(Any,RetType,RetType):- nonvar(Any),is_nonspecific_any(Any),!. +narrow_types(Any,RetType,RetType):- nonvar(Any),is_nonspecific_any(Any),!. +narrow_types(Any,RetType,RetType):- nonvar(Any),is_nonspecific_type_na(Any),!. +narrow_types(RetType,Any,RetType):- nonvar(Any),is_nonspecific_type_na(Any),!. +narrow_types(RetType,Any,RetType):- is_type_list(Any,List),!,narrow_types([RetType|List],Out). +narrow_types(Any,RetType,RetType):- is_type_list(Any,List),!,narrow_types([RetType|List],Out). +narrow_types(Fmt,Fmt1,Fmt):- formated_data_type(Fmt),formated_data_type(Fmt1). +narrow_types(Fmt,Fmt1,Fmt):- formated_data_type(Fmt),!. +narrow_types(Fmt1,Fmt,Fmt):- formated_data_type(Fmt),!. +narrow_types(Fmt1,Fmt2,'NarrowTypeFn'(Fmt1,Fmt2)). + +is_type_list('NarrowTypeFn'(Fmt1,Fmt2),List):- get_type_list('NarrowTypeFn'(Fmt1,Fmt2),List). + +get_type_list('NarrowTypeFn'(Fmt1,Fmt2),List):- !, + get_type_list(Fmt1,List1),get_type_list(Fmt2,List2), + append(List1,List2,List). +get_type_list(A,[A]). + +narrow_types(NL,Out):- \+ is_list(NL),!, Out=[NL]. +narrow_types([A|List],Out):- var(A),!,narrow_types(List,LT),Out='NarrowTypeFn'(A,LT). +narrow_types([A,B|List],Out):- narrow_types([B|List],BL),narrow_types(A,BL,Out). +narrow_types([A],A). + +is_pro_eval_kind(Var):- var(Var),!. is_pro_eval_kind(SDT):- formated_data_type(SDT). +is_pro_eval_kind(A):- A=='Atom',!,fail. +is_pro_eval_kind(A):- A=='%Undefined%',!,fail. +is_pro_eval_kind(A):- is_nonspecific_any(A),!. is_feo_f('Cons'). @@ -506,6 +583,19 @@ is_seo_f('Concept'). is_seo_f(N):- number(N),!. +is_absorbed_return_type(Params,Var):- var(Var),!, \+ sub_var(Var,Params). +is_absorbed_return_type(_,'Bool'). +is_absorbed_return_type(_,[Ar]):- !, Ar == (->). +is_absorbed_return_type(_,'EmptyType'). +is_absorbed_return_type(_,'ReturnType'). +is_absorbed_return_type(_,X):- is_self_return(X). + +is_self_return('ErrorType'). + +is_non_absorbed_return_type(Params,Var):- + \+ is_absorbed_return_type(Params,Var). + + %is_user_defined_goal(Self,[H|_]):- is_user_defined_head(Eq,Self,H). is_user_defined_head(Other,H):- is_user_defined_head(=,Other,H). @@ -521,7 +611,7 @@ %is_user_defined_head_f1(Eq,Other,H):- metta_type(Other,H,_). %s_user_defined_head_f1(Other,H):- get_metta_atom(Eq,Other,[H|_]). is_user_defined_head_f1(Other,H):- is_user_defined_head_f1(=,Other,H). -is_user_defined_head_f1(Eq,Other,H):- metta_defn(Eq,Other,[H|_],_). +is_user_defined_head_f1(Eq,Other,H):- metta_eq_def(Eq,Other,[H|_],_). %is_user_defined_head_f(Eq,_,H):- is_metta_builtin(H). @@ -531,34 +621,9 @@ is_special_op(_Slf,F):- \+ atom(F), \+ var(F), !, fail. %is_special_op(Self,Op):- get_operator_typedef(Self,Op,Params,_RetType), % maplist(is_non_eval_kind,Params). -is_special_op(_Slf,Op):- is_special_builtin(Op). - - - -get_operator_typedef(Self,Op,ParamTypes,RetType):- - len_or_unbound(ParamTypes,Len), - get_operator_typedef(Self,Op,Len,ParamTypes,RetType). - -:- dynamic(get_operator_typedef0/5). -get_operator_typedef(Self,Op,Len,ParamTypes,RetType):- - len_or_unbound(ParamTypes,Len), - if_or_else(get_operator_typedef0(Self,Op,Len,ParamTypes,RetType), - if_or_else(get_operator_typedef1(Self,Op,Len,ParamTypes,RetType), - get_operator_typedef2(Self,Op,Len,ParamTypes,RetType))). - -get_operator_typedef1(Self,Op,Len,ParamTypes,RetType):- - len_or_unbound(ParamTypes,Len), - if_t(nonvar(ParamTypes),append(ParamTypes,[RetType],List)), - metta_type(Self,Op,['->'|List]), - if_t(var(ParamTypes),append(ParamTypes,[RetType],List)), - assert(get_operator_typedef0(Self,Op,Len,ParamTypes,RetType)). -get_operator_typedef2(Self,Op,Len,ParamTypes,RetType):- - ignore('Any'=RetType), - maplist(is_eval_kind,ParamTypes), - assert(get_operator_typedef0(Self,Op,Len,ParamTypes,'Any2')). - %nop(wdmsg(missing(get_operator_typedef2(Self,Op,ParamTypes,RetType)))),!,fail. +%is_special_op(_Slf,Op):- is_special_builtin(Op). -is_eval_kind(ParamType):- ignore(ParamType='Any3'). +is_eval_kind(ParamType):- ignore(ParamType='Any'). is_metta_data_functor(Eq,F):- current_self(Self),is_metta_data_functor(Eq,Self,F). @@ -580,10 +645,10 @@ is_special_builtin('case'). -is_special_builtin(':'). +%is_special_builtin(':'). %is_special_builtin('='). -is_special_builtin('->'). +%is_special_builtin('->'). is_special_builtin('bind!'). %is_special_builtin('new-space'). is_special_builtin('let'). diff --git a/.Attic/canary_docme/metta_utils.pl b/.Attic/canary_docme/metta_utils.pl new file mode 100644 index 00000000000..550c60f3e58 --- /dev/null +++ b/.Attic/canary_docme/metta_utils.pl @@ -0,0 +1,2561 @@ + +:- set_prolog_flag(verbose_autoload, false). +:- set_prolog_flag(verbose, silent). +:- set_prolog_flag(verbose_load, silent). +:- ensure_loaded(library(logicmoo_utils)). +:- assert((user:'$exported_op'(_,_,_):- fail)). +:- abolish((system:'$exported_op'/3)). +:- assert((system:'$exported_op'(_,_,_):- fail)). + +:- if(exists_source(library(logicmoo_utils))). +:- ensure_loaded(library(logicmoo_utils)). +:- endif. +:- if(exists_source(library(dictoo))). +%:- ensure_loaded(library(dictoo)). +:- endif. + + + +:- dynamic(done_once/1). +do_once(G):- + ((done_once(GG),GG=@=G) -> true + ;(assert(done_once(G)),(once(@(G,user))->true;retract(done_once(G))))). + +cleanup_debug:- + forall( + (clause(prolog_debug:debugging(A1,B,C),Body,Cl1), + clause(prolog_debug:debugging(A2,B,C),Body,Cl2), + A1=@=A2,Cl1\==Cl2), + erase(Cl2)). + +:- export(plain_var/1). +plain_var(V):- notrace((var(V), \+ attvar(V), \+ get_attr(V,ci,_))). +catch_nolog(G):- ignore(catch(notrace(G),E,once(true;nop(u_dmsg(E=G))))). +catch_log(G):- ignore(catch((G),E,((u_dmsg(E=G),ugtrace(G))))). +% catch_log(G):- ignore(catch(notrace(G),E,((writeln(E=G),catch_nolog(ds))))). + +get_user_error(UE):- stream_property(UE,file_no(2)),!. +get_user_error(UE):- stream_property(UE,alias(user_error)),!. + +ufmt(G):- notrace((fbug(G)->true;ufmt0(G))). +ufmt0(G):- fmt(G)->true;writeln(G). +u_dmsg(G):- is_list(G),!,my_maplist(u_dmsg,G). +u_dmsg(M):- get_user_error(UE), \+ current_predicate(with_toplevel_pp/2),!, with_output_to(UE,ufmt(M)). +u_dmsg(M):- get_user_error(UE),!, with_toplevel_pp(ansi, with_output_to(UE,ufmt(M))). +u_dmsg(M):- get_user_error(UE), stream_property(UO,file_no(1)), current_output(CO),!, + (UO==CO -> fbug(M) ; + (with_toplevel_pp(ansi, with_output_to(UE,ufmt(M))), with_output_to(CO,pp(M)))). +u_dmsg(G):-ufmt(G),!. + + +:- multifile(is_cgi/0). +:- dynamic(is_cgi/0). +:- multifile(arc_html/0). +:- dynamic(arc_html/0). + + +logicmoo_use_swish:- + set_prolog_flag(use_arc_swish,true), + ld_logicmoo_webui,call(call,webui_start_swish_and_clio), + http_handler('/swish', http_redirect(moved, '/swish/'), []). + +arc_user(Nonvar):- nonvar(Nonvar),!,arc_user(Var),!,Nonvar=Var. +arc_user(main):- main_thread, !. %\+ if_thread_main(fail),!. +arc_user(ID):- catch((pengine:pengine_user(ID)),_,fail),!. +arc_user(ID):- catch((xlisting_web:is_cgi_stream,xlisting_web:find_http_session(User),http_session:session_data(User,username(ID))),_,fail),!. +arc_user(ID):- catch((is_cgi, (xlisting_web:find_http_session(ID))),_,fail),!. +arc_user(ID):- is_cgi,!,ID=web_user. +arc_user(ID):- thread_self(ID). + +:- dynamic(arc_user_prop/3). + +%luser_setval(N,V):- nb_setval(N,V),!. +luser_setval(N,V):- arc_user(ID),luser_setval(ID,N,V),!. +luser_setval(ID,N,V):- \+ (arc_sensical_term(N),arc_sensical_term(V)), + warn_skip(not_arc_sensical_term(luser_setval(ID,N,V))). +luser_setval(ID,N,V):- + (atom(N)->nb_setval(N,V);true), + retractall(arc_user_prop(ID,N,_)),asserta(arc_user_prop(ID,N,V)). + + +luser_unsetval(N):- ignore(nb_delete(N)), arc_user(ID),luser_unsetval(ID,N),!. +luser_unsetval(ID,N):- retractall(arc_user_prop(ID,N,_)). + +set_luser_default(N,V):- luser_setval(global,N,V). +luser_default(N,V):- var(V),!,luser_getval(N,V). +luser_default(N,V):- set_luser_default(N,V). + +luser_linkval(N,V):- arc_user(ID),luser_linkval(ID,N,V),!. +luser_linkval(ID,N,V):- \+ var(V), \+ (arc_sensical_term(N),arc_sensical_term(V)), + trace, + warn_skip(not_arc_sensical_term(luser_linkval(ID,N,V))). +luser_linkval(ID,N,V):- + (atom(N)->nb_linkval(N,V);true), + retractall(arc_user_prop(ID,N,_)),asserta(arc_user_prop(ID,N,V)). + +arc_sensical_term(O):- nonvar(O), O\==[], O\=='', O \= (_ - _), O\==end_of_file. +arc_sensical_term(V,O):- arc_sensical_term(V), !, O=V. + +%arc_option(grid_size_only):- !,fail. +arc_option(O):- luser_getval(O,t). +if_arc_option(O,G):- (arc_option(O)->must_det_ll(G); true). + +with_luser(N,V,Goal):- + (luser_getval(N,OV);OV=[]), + setup_call_cleanup( + luser_setval(N,V), + once(Goal), + luser_setval(N,OV)). + +%luser_getval(N,V):- nb_current(N,VVV),arc_sensical_term(VVV,VV),!,V=VV. +% caches the valuetemp on this thread +luser_getval(N,V):- luser_getval_0(N,VV),VV=V,arc_sensical_term(V),!. + +luser_getval_0(arc_user,V):- arc_user(V). +luser_getval_0(N,V):- luser_getval_1(N,V). + +luser_getval_1(N,V):- luser_getval_2(N,V). +luser_getval_1(N,V):- luser_getval_3(N,V), \+ (luser_getval_2(N,VV), nop(VV\=V)). +luser_getval_1(N,V):- get_luser_default(N,V), \+ (luser_getval_3(N,VV), nop(VV\=V)), \+ (luser_getval_2(N,VV), nop(VV\=V)). + +%luser_getval_0(N,V):- luser_getval_2(N,V), \+ luser_getval_1(N,_). +%luser_getval_0(N,V):- luser_getval_3(N,V), \+ luser_getval_2(N,_), \+ luser_getval_1(N,_). +%luser_getval_3(N,V):- is_cgi, current_predicate(get_param_req/2),get_param_req(N,M),url_decode_term(M,V). +luser_getval_2(N,V):- \+ main_thread, atom(N), httpd_wrapper:http_current_request(Request), member(search(List),Request),member(N=VV,List),url_decode_term(VV,V),arc_sensical_term(V),!. +luser_getval_2(N,V):- atom(N), nb_current(N,ValV),arc_sensical_term(ValV,Val),Val=V. + +luser_getval_3(N,V):- arc_user(ID), arc_user_prop(ID,N,V). +luser_getval_3(_,_):- \+ is_cgi, !, fail. +luser_getval_3(N,V):- \+ main_thread, atom(N), current_predicate(get_param_sess/2),get_param_sess(N,M),url_decode_term(M,V),arc_sensical_term(V). +%luser_getval_3(N,V):- atom(N), nb_current(N,ValV),arc_sensical_term(ValV,Val),Val=V. + + +get_luser_default(N,V):- arc_user_prop(global,N,VV),VV=V,arc_sensical_term(V),!. +get_luser_default(N,V):- atom(N), current_prolog_flag(N,VV),VV=V,arc_sensical_term(V),!. +%luser_getval(ID,N,V):- thread_self(ID),nb_current(N,V),!. +%luser_getval(ID,N,V):- !, ((arc_user_prop(ID,N,V);nb_current(N,V))*->true;arc_user_prop(global,N,V)). + + +ansi_main:- thread_self(main),nop(is_cgi),!. + +main_thread:- thread_self(main),!. +if_thread_main(G):- main_thread->call(G);true. + + + + +:- if(\+ current_predicate(fbug/1)). +%fbug(P):- format(user_error,'~N~p~n',[P]). +:- endif. + + + +substM(T, F, R, R):- T==F,!. +substM(T, _, _, R):- \+ compound(T),!,R=T. +substM([H1|T1], F, R, [H2|T2]) :- !, substM(H1, F, R, H2), substM(T1, F, R, T2). +substM(C1, F, R, C2) :- C1 =.. [Fn|A1], substM_l(A1,F,R,A2),!, C2 =.. [Fn|A2]. +substM_l([], _, _, []). substM_l([H1|T1], F, R, [H2|T2]) :- substM(H1, F, R, H2), substM_l(T1, F, R, T2). + + +pp_m(Cl):- write_src(Cl),!. +pp_m(C,Cl):- color_g_mesg(C,write_src(Cl)),!. +% notrace((format('~N'), ignore(( \+ ((numbervars(Cl,0,_,[singletons(true)]), print_tree_with_final(Cl,"."))))))). +pp_q(Cl):- + notrace((format('~N'), ignore(( \+ ((numbervars(Cl,0,_,[singletons(true)]), print_tree_with_final(Cl,"."))))))). + + +ncatch(G,E,F):- catch(G,E,F). +mcatch(G,E,F):- catch(G,E,F). +%mcatch(G,E,F):- catch(G,E,(fbug(G=E),catch(bt,_,fail),fbug(G=E),ignore(call(F)),throw(E))). +%ncatch(G,E,F):- catch(G,E,(fbug(G=E),catch(bt,_,fail),fbug(G=E),call(G))). +%ncatch(G,E,(F)). + + +:- if( \+ current_predicate(if_t/2)). +:- meta_predicate(if_t(0,0)). +if_t(IF, THEN) :- call(call,ignore((((IF,THEN))))). +:- endif. + +:- if( \+ current_predicate(must_ll/1)). +:- meta_predicate(must_ll(0)). +must_ll(G):- md(call,G)*->true;throw(not_at_least_once(G)). +:- endif. + +:- if( \+ current_predicate(at_least_once/1)). +:- meta_predicate(at_least_once(0)). +at_least_once(G):- call(G)*->true;throw(not_at_least_once(G)). +:- endif. + +%wraps_each(must_ll,call). +wraps_each(must_det_ll,once). +md_like(MD):- wraps_each(MD,_). + +remove_must_det(_):- !,fail. +%remove_must_det(MD):- !. +%remove_must_det(MD):- nb_current(remove_must_det(MD),TF),!,TF==true. +%remove_must_det(MD):- \+ false. + +%remove_mds(MD,G,GGG):- compound(G), G = must_det_ll(GG),!,expand_goal(GG,GGG),!. +%remove_mds(MD,G,GGG):- compound(G), G = must_det_l(GG),!,expand_goal(GG,GGG),!. +remove_mds(MD,GG,GO):- sub_term(G,GG),compound(G),compound_name_arg(G,MD,GGGG),subst001(GG,G,GGGG,GGG),remove_mds(MD,GGG,GO). +remove_mds(_,GG,GG). +%remove_mds(MD,G,GG):- compound(G), G = ..[MD,AA], compound(G),removed_term(G,GO),expand_goal(GO,GG). + +%never_rrtrace:-!. +never_rrtrace:- nb_current(cant_rrtrace,t),!,notrace. +never_rrtrace:- is_cgi,notrace. + + +%itrace:- !. +%itrace:- \+ current_prolog_flag(debug,true),!. +itrace:- if_thread_main(trace),!. +ibreak:- if_thread_main(((trace,break))). +%recolor(_,_):- ibreak. + +%tc_arg(N,C,E):- compound(C),!,arg(N,C,E). +tc_arg(N,C,E):- catch(arg(N,C,E),Err, + /*unrepress_output*/((bt,fbug(tc_arg(N,C,E)=Err),((tracing->true;trace),break,arg(N,C,E))))). + + + + + + +compound_name_arg(G,MD,Goal):- var(G),!,atom(MD),G=..[MD,Goal]. +compound_name_arg(G,MD,Goal):- compound(G),!, compound_name_arguments(G,MD,[Goal]). + + +:- multifile(user:message_hook/3). +:- dynamic(user:message_hook/3). +%user:message_hook(Term, Kind, Lines):- error==Kind, itrace,fbug(user:message_hook(Term, Kind, Lines)),trace,fail. +user:message_hook(Term, Kind, Lines):- + fail, error==Kind, + fbug(message_hook(Term, Kind, Lines)),fail. + +:- meta_predicate(must_det_ll(0)). +:- meta_predicate(must_det_ll1(1,0)). +:- meta_predicate(md_failed(1,0)). +:- meta_predicate(must_not_error(0)). +%:- meta_predicate(must_det_l(0)). + +%:- no_xdbg_flags. +:- meta_predicate(wno_must(0)). + +wno_must(G):- locally(nb_setval(no_must_det_ll,t),locally(nb_setval(cant_rrtrace,t),call(G))). + +md_maplist(_MD,_,[]):-!. +md_maplist(MD,P1,[H|T]):- call(MD,call(P1,H)), md_maplist(MD,P1,T). + +md_maplist(_MD,_,[],[]):-!. +md_maplist(MD,P2,[HA|TA],[HB|TB]):- call(MD,call(P2,HA,HB)), md_maplist(MD,P2,TA,TB). + +md_maplist(_MD,_,[],[],[]):-!. +md_maplist(MD,P3,[HA|TA],[HB|TB],[HC|TC]):- call(MD,call(P3,HA,HB,HC)), md_maplist(MD,P3,TA,TB,TC). + +%must_det_ll(G):- !, once((/*notrace*/(G)*->true;md_failed(P1,G))). + +%:- if( \+ current_predicate(must_det_ll/1)). +must_det_ll(X):- tracing,!,once(X). +must_det_ll(X):- md(once,X). +%:- endif. + +md(P1,G):- tracing,!, call(P1,G). % once((call(G)*->true;md_failed(P1,G))). +md(P1,G):- remove_must_det(MD), wraps_each(MD,P1),!,call(G). +md(P1,G):- never_rrtrace,!, call(P1,G). +md(P1,G):- /*notrace*/(arc_html),!, ignore(/*notrace*/(call(P1,G))),!. +%md(P1,X):- !,must_not_error(X). +md(P1,(X,Goal)):- is_trace_call(X),!,call((itrace,call(P1,Goal))). +md(_, X):- is_trace_call(X),!,itrace. +md(P1, X):- nb_current(no_must_det_ll,t),!,call(P1,X). +md(P1,X):- \+ callable(X), !, throw(md_not_callable(P1,X)). +md(P1,(A*->X;Y)):- !,(must_not_error(A)*->md(P1,X);md(P1,Y)). +md(P1,(A->X;Y)):- !,(must_not_error(A)->md(P1,X);md(P1,Y)). +md(P1,(X,Cut)):- (Cut==(!)),md(P1,X),!. +md(MD,maplist(P1,List)):- !, call(MD,md_maplist(MD,P1,List)). +md(MD,maplist(P2,ListA,ListB)):- !, call(MD,md_maplist(MD,P2,ListA,ListB)). +md(MD,maplist(P3,ListA,ListB,ListC)):- !, call(MD,md_maplist(MD,P3,ListA,ListB,ListC)). +md(P1,(X,Cut,Y)):- (Cut==(!)), !, (md(P1,X),!,md(P1,Y)). +md(P1,(X,Y)):- !, (md(P1,X),md(P1,Y)). +%md(P1,X):- /*notrace*/(ncatch(X,_,fail)),!. +%md(P1,X):- conjuncts_to_list(X,List),List\=[_],!,maplist(must_det_ll,List). +md(_,must_det_ll(X)):- !, must_det_ll(X). +md(_,grid_call(P2,I,O)):- !, must_grid_call(P2,I,O). +%md(P1,call(P2,I,O)):- !, must_grid_call(P2,I,O). +%md(P1,(X,Y,Z)):- !, (md(P1,X)->md(P1,Y)->md(P1,Z)). +%md(P1,(X,Y)):- !, (md(P1,X)->md(P1,Y)). +%md(P1,if_t(X,Y)):- !, if_t(must_not_error(X),md(P1,Y)). +md(P1,forall(X,Y)):- !, md(P1,forall(must_not_error(X),must_not_error(Y))). +md(P1,\+ (X, \+ Y)):- !, md(P1,forall(must_not_error(X),must_not_error(Y))). + +md(P1,(X;Y)):- !, ((must_not_error(X);must_not_error(Y))->true;md_failed(P1,X;Y)). +md(P1,\+ (X)):- !, (\+ must_not_error(X) -> true ; md_failed(P1,\+ X)). +%md(P1,(M:Y)):- nonvar(M), !, M:md(P1,Y). +md(P1,X):- + ncatch(must_det_ll1(P1,X), + md_failed(P1,G,N), % <- ExceptionTerm + % bubble up and start running + ((M is N -1, M>0)->throw(md_failed(P1,G,M));(ugtrace(md_failed(P1,G,M),X),throw('$aborted')))),!. +%must_det_ll(X):- must_det_ll1(P1,X),!. + +must_det_ll1(P1,X):- tracing,!,must_not_error(call(P1,X)),!. +must_det_ll1(P1,once(A)):- !, once(md(P1,A)). +must_det_ll1(P1,X):- + strip_module(X,M,P),functor(P,F,A), + setup_call_cleanup(nop(trace(M:F/A,+fail)),(must_not_error(call(P1,X))*->true;md_failed(P1,X)), + nop(trace(M:F/A,-fail))),!. + + +%must_not_error(G):- must(once(G)). + +must_not_error(G):- (tracing;never_rrtrace),!,call(G). +must_not_error(G):- notrace(is_cgi),!, ncatch((G),E,((u_dmsg(E=G)))). +%must_not_error(X):- is_guitracer,!, call(X). +%must_not_error(G):- !, call(G). +must_not_error(X):- !,ncatch(X,E,(fbug(E=X),ugtrace(error(E),X))). +must_not_error(X):- ncatch(X,E,(rethrow_abort(E);(/*arcST,*/writeq(E=X),pp(etrace=X), + trace, + rrtrace(visible_rtrace([-all,+exception]),X)))). + + +always_rethrow('$aborted'). +always_rethrow(md_failed(_,_,_)). +always_rethrow(return(_)). +always_rethrow(metta_return(_)). +always_rethrow(give_up(_)). +always_rethrow(time_limit_exceeded(_)). +always_rethrow(depth_limit_exceeded). +always_rethrow(restart_reading). +always_rethrow(E):- never_rrtrace,!,throw(E). + +%catch_non_abort(Goal):- cant_rrtrace(Goal). +catch_non_abort(Goal):- catch(cant_rrtrace(Goal),E,rethrow_abort(E)),!. +rethrow_abort(E):- format(user_error,'~N~q~n',[catch_non_abort_or_abort(E)]),fail. +%rethrow_abort(time_limit_exceeded):-!. +rethrow_abort('$aborted'):- !, throw('$aborted'),!,forall(between(1,700,_),sleep(0.01)),writeln(timeout),!,fail. +rethrow_abort(E):- ds,!,format(user_error,'~N~q~n',[catch_non_abort(E)]),!. + +cant_rrtrace(Goal):- never_rrtrace,!,call(Goal). +cant_rrtrace(Goal):- setup_call_cleanup(cant_rrtrace,Goal,can_rrtrace). + +main_debug:- main_thread,current_prolog_flag(debug,true). +cant_rrtrace:- nb_setval(cant_rrtrace,t). +can_rrtrace:- nb_setval(cant_rrtrace,f). +%md_failed(P1,X):- predicate_property(X,number_of_clauses(1)),clause(X,(A,B,C,Body)), (B\==!),!,must_det_ll(A),must_det_ll((B,C,Body)). + +md_failed(P1,X):- notrace((write_src_uo(failed(P1,X)),fail)). +md_failed(P1,X):- tracing,visible_rtrace([-all,+fail,+call,+exception],call(P1,X)). +md_failed(P1,X):- \+ tracing, !, visible_rtrace([-all,+fail,+exit,+call,+exception],call(P1,X)). +md_failed(P1,G):- is_cgi, \+ main_debug, !, u_dmsg(arc_html(md_failed(P1,G))),fail. +md_failed(_P1,G):- option_value(testing,true),!, + T='FAILEDDDDDDDDDDDDDDDDDDDDDDDDDD!!!!!!!!!!!!!'(G), + write_src_uo(T), give_up(T,G). +md_failed(P1,G):- never_rrtrace,!,notrace,/*notrace*/(u_dmsg(md_failed(P1,G))),!,throw(md_failed(P1,G,2)). +%md_failed(P1,G):- tracing,call(P1,G). +md_failed(_,_):- never_rrtrace,!,fail. +md_failed(P1,X):- notrace,is_guitracer,u_dmsg(failed(X))/*,arcST*/,nortrace,atrace,call(P1,X). +md_failed(P1,G):- main_debug,/*notrace*/(write_src_uo(md_failed(P1,G))),!,throw(md_failed(P1,G,2)). +% must_det_ll(X):- must_det_ll(X),!. + +write_src_uo(G):- + stream_property(S,file_no(1)), + with_output_to(S, + (format('~N~n~n',[]), + write_src(G), + format('~N~n~n'))),!, + %stack_dump, + stream_property(S2,file_no(2)), + with_output_to(S2, + (format('~N~n~n',[]), + write_src(G), + format('~N~n~n'))),!. + +:- meta_predicate(rrtrace(0)). +rrtrace(X):- rrtrace(etrace,X). + +stack_dump:- ignore(catch(bt,_,true)). %,ignore(catch(dumpST,_,true)),ignore(catch(bts,_,true)). +ugtrace(error(Why),G):- !, notrace,write_src_uo(Why),stack_dump,write_src_uo(Why),rtrace(G). +ugtrace(Why,G):- tracing,!,notrace,write_src(Why),rtrace(G). +ugtrace(Why,_):- is_testing, !, ignore(give_up(Why,5)),throw('$aborted'). +ugtrace(_Why,G):- ggtrace(G),throw('$aborted'). +%ugtrace(Why,G):- ggtrace(G). + +give_up(Why,_):- is_testing,!,write_src_uo(Why),!, throw(give_up(Why)). +give_up(Why,N):- is_testing,!,write_src_uo(Why),!, halt(N). +give_up(Why,_):- write_src_uo(Why),throw('$aborted'). + +is_guitracer:- getenv('DISPLAY',_), current_prolog_flag(gui_tracer,true). +:- meta_predicate(rrtrace(1,0)). +rrtrace(P1,X):- never_rrtrace,!,nop((u_dmsg(cant_rrtrace(P1,X)))),!,fail. +rrtrace(P1,G):- is_cgi,!, u_dmsg(arc_html(rrtrace(P1,G))),call(P1,G). +rrtrace(P1,X):- notrace, \+ is_guitracer,!,nortrace, /*arcST, sleep(0.5), trace,*/ + (notrace(\+ current_prolog_flag(gui_tracer,true)) -> call(P1,X); (itrace,call(P1,X))). +%rrtrace(_,X):- is_guitracer,!,notrace,nortrace,ncatch(call(call,ugtrace),_,true),atrace,call(X). +rrtrace(P1,X):- itrace,!, call(P1,X). + +:- meta_predicate(arc_wote(0)). +arc_wote(G):- with_pp(ansi,wote(G)). +arcST:- itrace,arc_wote(bts),itrace. +atrace:- arc_wote(bts). +%atrace:- ignore((stream_property(X,file_no(2)), with_output_to(X,dumpST))),!. + +:- meta_predicate(odd_failure(0)). +odd_failure(G):- never_rrtrace,!,call(G). +odd_failure(G):- wno_must(G)*->true;fail_odd_failure(G). + +:- meta_predicate(fail_odd_failure(0)). +fail_odd_failure(G):- u_dmsg(odd_failure(G)),rtrace(G), fail. +%fail_odd_failure(G):- call(G)*->true;(u_dmsg(odd_failure(G)),fail,rrtrace(G)). + + +bts:- + ensure_loaded(library(prolog_stack)), + prolog_stack:export(prolog_stack:get_prolog_backtrace_lc/3), + use_module(library(prolog_stack),[print_prolog_backtrace/2,get_prolog_backtrace_lc/3]), + /*notrace*/(prolog_stack:call(call,get_prolog_backtrace_lc,8000, Stack, [goal_depth(600)])), + stream_property(S,file_no(1)), prolog_stack:print_prolog_backtrace(S, Stack), + ignore((fail, current_output(Out), \+ stream_property(Out,file_no(1)), print_prolog_backtrace(Out, Stack))),!. + +my_assertion(G):- my_assertion(call(G),G). + +my_assertion(_,G):- call(G),!. +my_assertion(Why,G):- u_dmsg(my_assertion(Why,G)),writeq(Why=goal(G)),nl,!,ibreak. + +must_be_free(Free):- plain_var(Free),!. +must_be_free(Free):- \+ nonvar_or_ci(Free),!. +must_be_free(Nonfree):- arcST,u_dmsg(must_be_free(Nonfree)), + ignore((attvar(Nonfree),get_attrs(Nonfree,ATTS),pp(ATTS))),ibreak,fail. + +must_be_nonvar(Nonvar):- nonvar_or_ci(Nonvar),!. +must_be_nonvar(IsVar):- arcST,u_dmsg(must_be_nonvar(IsVar)),ibreak,fail. + + +% goal_expansion(must_det_l(G),I,must_det_ll(G),O):- nonvar(I),source_location(_,_), nonvar(G),I=O. + +%goal_expansion(G,I,GG,O):- nonvar(I),source_location(_,_), compound(G), remove_mds(MD,G,GG),I=O. + +%:- system:ensure_loaded(library(pfc_lib)). +%:- expects_dialect(pfc). +/* +goal_expansion(Goal,Out):- compound(Goal), tc_arg(N1,Goal,E), + compound(E), E = set(Obj,Member), setarg(N1,Goal,Var), + expand_goal((Goal,b_set_dict(Member,Obj,Var)),Out). +*/ +get_setarg_p1(P3,E,Cmpd,SA):- compound(Cmpd), get_setarg_p2(P3,E,Cmpd,SA). +get_setarg_p2(P3,E,Cmpd,SA):- arg(N1,Cmpd,E), SA=call(P3,N1,Cmpd). +get_setarg_p2(P3,E,Cmpd,SA):- arg(_,Cmpd,Arg),get_setarg_p1(P3,E,Arg,SA). + +my_b_set_dict(Member,Obj,Var):- set_omemberh(b,Member,Obj,Var). +%nb_set_dict(Member,Obj,Var), +set_omemberh(_,Member,Obj,Var):- !, arc_setval(Obj,Member,Var). +%nb_link_dict(Member,Obj,Var), +%set_omemberh(nb,Member,Obj,Var):- !, nb_set_dict(Member,Obj,Var). +%set_omemberh(link,Member,Obj,Var):- !, nb_link_dict(Member,Obj,Var). +%set_omemberh(How,Member,Obj,Var):- call(call,How,Member,Obj,Var),!. + +set_omember(Member,Obj,Var):- set_omember(b,Member,Obj,Var). + +set_omember(How,Member,Obj,Var):- + must_be_nonvar(Member), must_be_nonvar(Obj), must_be_nonvar(How), !, + set_omemberh(How,Member,Obj,Var),!. + + + +get_kov(K,O,V):- dictoo:is_dot_hook(user,O,K,V),!,o_m_v(O,K,V). +get_kov(K,O,V):- ((get_kov1(K,O,V)*->true;(get_kov1(props,O,VV),get_kov1(K,VV,V)))). + +get_kov1(K,O,V):- (is_hooked_obj(O),o_m_v(O,K,V))*->true;get_kov2(K,O,V). +% (get_kov(Prop,VM,Value) -> true ; (get_kov(props,VM,Hashmap),nonvar(Hashmap),must_not_error(nb_get_value(Hashmap,Prop,ValueOOV)),get_oov_value(ValueOOV,Value))). +get_kov2(K,O,V):- is_dict(O),!,get_dict(K,O,OOV),get_oov_value(OOV,V). +get_kov2(K,O,V):- nonvar(K),is_rbtree(O),!,rb_lookup(K,V,O). +get_kov2(K,O,V):- is_rbtree(O),!,rb_in(K,V,OOV),get_oov_value(OOV,V). +%get_kov(K,O,V):- is_rbtree(O),!,nb_rb_get_node(K,O,Node),nb_rb_node_value(Node,V). + +get_oov_value(ValueOOV,Value):- compound(ValueOOV),ValueOOV=oov(Value),!. +get_oov_value(Value,Value). + + +term_expansion_setter(I,O):- maybe_expand_md(must_det_ll,I,O),I\=@=O,!. +term_expansion_setter(I,O):- maybe_expand_md(must_det_ll,I,M),I\=@=M,!,term_expansion_setter(M,O). +term_expansion_setter(Goal,get_kov(Func,Self,Value)):- compound(Goal), + compound_name_arguments(Goal,'.',[ Self, Func, Value]),var(Value). + +term_expansion_setter((Head:-Body),Out):- + get_setarg_p1(setarg,I,Head,P1), is_setter_syntax(I,Obj,Member,Var,How), + call(P1,Var), + BodyCode = (Body, set_omember(How,Member,Obj,Var)), + % goal_expansion_setter(BodyCode,Goal), + expand_term((Head:- BodyCode),Out),!. + +%term_expansion_setter((Head:-Body),(Head:-GBody)):- goal_expansion_setter(Body,GBody),!. + +:- export(term_expansion_setter/2). +:- system:import(term_expansion_setter/2). + +%goal_expansion(Goal,'.'(Training, Objs, Obj)):- Goal = ('.'(Training, Objs, A), Obj = V), var(Obj). + +is_setter_syntax(I,_Obj,_Member,_Var,_):- \+ compound(I),!,fail. +is_setter_syntax(set(Obj,Member),Obj,Member,_Var,b). +is_setter_syntax(gset(Obj,Member),Obj,Member,_Var,nb). +is_setter_syntax(hset(How,Obj,Member),Obj,Member,_Var,How). +is_setter_syntax(set(ObjMember),Obj,Member,_Var,b):- obj_member_syntax(ObjMember,Obj,Member). +is_setter_syntax(gset(ObjMember),Obj,Member,_Var,nb):- obj_member_syntax(ObjMember,Obj,Member). +is_setter_syntax(hset(How,ObjMember),Obj,Member,_Var,How):- obj_member_syntax(ObjMember,Obj,Member). + +obj_member_syntax(ObjMember,Obj,Member):-compound(ObjMember), compound_name_arguments(ObjMember,'.',[Obj,Member]),!. + +maybe_expand_md(_MD,I,_):- \+ compound(I),!,fail. +%maybe_expand_md(MD,I,_):- compound(I),!,fail. % THIS DISABLES +% THIS DISABLES +%maybe_expand_md(MD,must_det_ll(GoalL),GoalL):-!. +maybe_expand_md(MD,MDGoal,GoalLO):- compound_name_arg(MDGoal,MD,Goal),!, expand_md(MD,Goal,GoalLO). +maybe_expand_md(MD,maplist(P1,GoalL),GoalLO):- P1 ==MD,!, + expand_md(MD,GoalL,GoalLO). +maybe_expand_md(MD,maplist(P1,GoalL),GoalLO):- P1 ==MD,!, + expand_md(MD,GoalL,GoalLO). +maybe_expand_md(MD,I,O):- sub_term(C,I),compound(C), compound_name_arg(C,MD,Goal), + compound(Goal),Goal=(_,_), + once((expand_md(MD,Goal,GoalO),substM(I,C,GoalO,O))),I\=@=O. + + +%maybe_expand_md(MD,I,O):- sub_term(S,I),compound(S),S=must_det_ll(G), +% once(expand_md(MD,S,M)),M\=S, + + + +expand_md(_MD,Nil,true):- Nil==[],!. +expand_md(_MD,Var,Var):- \+ callable(Var),!. +expand_md(MD,[A|B],(AA,BB)):- assertion(callable(A)), assertion(is_list(B)), !, + expand_md1(MD,A,AA), expand_md(MD,B,BB). +expand_md(MD,A,AA):- !, expand_md1(MD,A,AA). + +prevents_expansion(A):- is_trace_call(A). +is_trace_call(A):- A == trace. +is_trace_call(A):- A == itrace. + +skip_expansion(A):- var(A),!,fail. +skip_expansion(!). +skip_expansion(false). +skip_expansion(true). +skip_expansion(C):- compound(C),functor(C,F,A),skip_fa_expansion(F,A). +skip_fa_expansion(once,1). +skip_fa_expansion(call,_). +skip_fa_expansion(if_t,2). + +expand_md1(_MD,Var,Var):- \+ callable(Var),!. +expand_md1(_MD,Cut,Cut):- skip_expansion(Cut),!. +expand_md1(MD,MDAB, AABB):- compound(MDAB), compound_name_arg(MDAB,MD,AB),!, expand_md(MD,AB,AABB). +expand_md1(MD,maplist(P1,A),md_maplist(MD,P1,A)):-!. +expand_md1(MD,maplist(P2,A,B),md_maplist(MD,P2,A,B)):-!. +expand_md1(MD,maplist(P3,A,B,C),md_maplist(MD,P3,A,B,C)):-!. +expand_md1(MD,my_maplist(P1,A),md_maplist(MD,P1,A)):-!. +expand_md1(MD,my_maplist(P2,A,B),md_maplist(MD,P2,A,B)):-!. +expand_md1(MD,my_maplist(P3,A,B,C),md_maplist(MD,P3,A,B,C)):-!. +%expand_md1(MD,Goal,O):- \+ compound(Goal), !,O = must_det_ll(Goal). +%expand_md1(MD,(A,B),((A,B))):- remove_must_det(MD), prevents_expansion(A),!. +%expand_md1(MD,(A,B),must_det_ll((A,B))):- prevents_expansion(A),!. +expand_md1(MD,(A,B),(AA,BB)):- !, expand_md(MD,A,AA), expand_md(MD,B,BB). +expand_md1(MD,(C*->A;B),(CC*->AA;BB)):- !, expand_md(MD,A,AA), expand_md(MD,B,BB), expand_must_not_error(C,CC). +expand_md1(MD,(C->A;B),(CC->AA;BB)):- !, expand_md(MD,A,AA), expand_md(MD,B,BB), expand_must_not_error(C,CC). +expand_md1(MD,(C;B),(CC;BB)):- !, expand_md(MD,B,BB), expand_must_not_error(C,CC). + +expand_md1(MD,locally(C,A),locally(C,AA)):- !, expand_md(MD,A,AA). + +expand_md1(MD,call_cleanup(A,B),call_cleanup(AA,BB)):- !, expand_md(MD,A,AA), expand_md(MD,B,BB). +expand_md1(MD,setup_call_cleanup(C,A,B),setup_call_cleanup(CC,AA,BB)):- !, + expand_md(MD,C,CC),expand_md(MD,A,AA), expand_md(MD,B,BB). + +expand_md1(MD,M:P, M:AABB):-!,expand_md(MD,P, AABB). + +expand_md1(MD,P, AABB) :- predicate_property(P,(meta_predicate( MP ))), + strip_module(P,_,SP),strip_module(MP,_,SMP), kaggle_arc_1_pred(_,SP), + \+ skippable_built_in(P), + SP=..[F|Args],SMP=..[F|Margs],!, + maplist(expand_meta_predicate_arg(MD),Margs,Args,EArgs), + AABB=..[F|EArgs]. + +expand_md1(MD, A, MDAA):- \+ remove_must_det(MD), !, expand_goal(A,AA),!,compound_name_arg(MDAA,MD,AA). +expand_md1(_MD, A, AA):- expand_goal(A,AA),!. + +expand_must_not_error(C,C):- remove_must_det(must_not_error),!. +expand_must_not_error(C,CC):- \+ predicate_property(C,meta_predicate(_)),!, CC = must_not_error(C),!. +expand_must_not_error(C,CC):- expand_md(must_not_error, C, CC). + +kaggle_arc_1_pred(M,P):- + predicate_property(M:P,file(F)), + \+ predicate_property(M:P,imported_from(_)), + \+ \+ atom_contains(F,'arc_'), + \+ atom_contains(F,'_pfc'), + \+ atom_contains(F,'_afc'), + % \+ atom_contains(F,'_ui_'), + true. + +%meta_builtin(P):- var(P),meta_builtin(P). +%meta_builtin(P):- predicate_property(P,interpreted),predicate_property(P,static). +skippable_built_in(MP):- strip_module(MP,_,P), predicate_property(system:P,built_in), + once(predicate_property(system:P,iso);predicate_property(system:P,notrace)). +%meta_builtin(P):- predicate_property(P,/*notrace*/), \+ predicate_property(P,nodebug). + +expand_meta_predicate_arg(_MD,'?',A,A):-!. +expand_meta_predicate_arg(_MD,'+',A,A):-!. +expand_meta_predicate_arg(_MD,'-',A,A):-!. +expand_meta_predicate_arg(MD, ':',A,AA):- !,expand_md1(MD,A,AA). +expand_meta_predicate_arg(MD, 0,A,AA):- !,expand_md1(MD,A,AA). +%expand_meta_predicate_arg(MD,*,A,AA):- !,expand_md1(MD,A,AA). +expand_meta_predicate_arg(_MD,_,A,A). + +goal_expansion_getter(Goal,O):- \+ compound(Goal), !,O = Goal. +goal_expansion_getter(I,O):- md_like(MD),maybe_expand_md(MD,I,O),I\=@=O,!. +goal_expansion_getter(I,O):- md_like(MD),maybe_expand_md(MD,I,M),I\=@=M,!,goal_expansion_getter(M,O). +goal_expansion_getter(Goal,get_kov(Func,Self,Value)):- compound(Goal), + compound_name_arguments(Goal,'.',[ Self, Func, Value]),var(Value). +goal_expansion_getter(Goal,Out):- + compound_name_arguments(Goal,F,Args), + maplist(goal_expansion_getter,Args,ArgsOut), + compound_name_arguments(Out,F,ArgsOut). + +:- export(goal_expansion_getter/2). +:- system:import(goal_expansion_getter/2). + + +goal_expansion_setter(Goal,_):- \+ compound(Goal), !, fail. + + +goal_expansion_setter(I,O):- md_like(MD),maybe_expand_md(MD,I,O),I\=@=O,!. +goal_expansion_setter(G,GO):- remove_must_det(MD), !,remove_mds(MD,G,GG),goal_expansion_setter(GG,GO). +%goal_expansion_setter(GG,GO):- remove_must_det(MD), sub_term(G,GG),compound(G),G = must_det_ll(GGGG),subst001(GG,G,GGGG,GGG),!,goal_expansion_setter(GGG,GO). +%goal_expansion_setter((G1,G2),(O1,O2)):- !, expand_goal(G1,O1), expand_goal(G2,O2),!. +goal_expansion_setter(set_omember(A,B,C,D),set_omember(A,B,C,D)):-!. +goal_expansion_setter(set_omember(A,B,C),set_omember(b,A,B,C)):-!. +goal_expansion_setter(Goal,get_kov(Func,Self,Value)):- compound(Goal), + compound_name_arguments(Goal,'.',[ Self, Func, Value]),var(Value). +goal_expansion_setter(I,O):- md_like(MD),maybe_expand_md(MD,I,M),I\=@=M,!,goal_expansion_setter(M,O). + + +goal_expansion_setter(Goal,Out):- + predicate_property(Goal,meta_predicate(_)),!,fail, + tc_arg(N1,Goal,P), goal_expansion_setter(P,MOut), + setarg(N1,Goal,MOut), !, expand_goal(Goal, Out). + +goal_expansion_setter(Goal,Out):- + tc_arg(N1,Goal,P), is_setter_syntax(P,Obj,Member,Var,How), + setarg(N1,Goal,Var), !, expand_goal((Goal,set_omember(How,Member,Obj,Var)), Out). + +goal_expansion_setter(Goal,Out):- + get_setarg_p1(setarg,I,Goal,P1), compound(I), compound_name_arguments(I,'.',[ Self, Func, Value]), + call(P1,get_kov(Func,Self,Value)),!, + expand_goal(Goal,Out). + +goal_expansion_setter(Goal,Out):- + get_setarg_p1(setarg,I,Goal,P1), is_setter_syntax(I,Obj,Member,Var,How), + call(P1,Var),!, + expand_goal((Goal,set_omember(How,Member,Obj,Var)),Out). + +:- export(goal_expansion_setter/2). +:- system:import(goal_expansion_setter/2). + + +/* +system:term_expansion((Head:-Goal),I,(Head:-Out),O):- nonvar(I), compound(Goal), + goal_expansion_setter(Goal,Out),Goal\=@=Out,I=O,!, + nop((print(goal_expansion_getter(Goal-->Out)),nl)). +*/ +arc_term_expansion1((system:term_expansion((Head:-Body),I,Out,O):- + nonvar(I), compound(Head), + term_expansion_setter((Head:-Body),Out),(Head:-Body)=In,In\==Out,I=O,!, + nop((print(term_expansion_setter(In-->Out)),nl)))). + + +%system:goal_expansion(Goal,I,Out,O):- compound(Goal),goal_expansion_getter(Goal,Out),Goal\==Out,I=O,!, +% ((print(goal_expansion_getter(Goal-->Out)),nl)). + +%user:goal_expansion(Goal,I,Out,O):- compound(Goal),goal_expansion_getter(Goal,Out),Goal\==Out,I=O,!, +% ((print(goal_expansion_getter(Goal-->Out)),nl)). + +arc_term_expansion1((goal_expansion(Goal,I,Out,O):- + goal_expansion_setter(Goal,Out),Goal\==Out,I=O,!, + nop((print(goal_expansion_setter(Goal-->Out)),nl)))). + +:- export(arc_term_expansions/1). +arc_term_expansions(H:- (current_prolog_flag(arc_term_expansion, true), B)):- + arc_term_expansion1(H:-B). + +:- export(enable_arc_expansion/0). +enable_arc_expansion:- + forall(arc_term_expansions(Rule), + (strip_module(Rule,M,Rule0), + nop(u_dmsg(asserta_if_new(Rule,M,Rule0))), + asserta_if_new(Rule))), + set_prolog_flag(arc_term_expansion, true). + +:- export(disable_arc_expansion/0). +disable_arc_expansion:- + forall(arc_term_expansions(Rule),forall(retract(Rule),true)), + set_prolog_flag(arc_term_expansion, false). + +:- multifile(goal_expansion/4). +:- dynamic(goal_expansion/4). + +goal_expansion(G,I,GG,O):- nonvar(I),source_location(_,_), + compound(G), + (remove_must_det(MD)->remove_mds(MD,G,GG);(md_like(MD),maybe_expand_md(MD,G,GG))),I=O. + + + + + + + + + + + +/* +:- export(plain_var/1). +plain_var(V):- notrace((var(V), \+ attvar(V), \+ get_attr(V,ci,_))). + +my_assertion(G):- call(G),!. +my_assertion(G):- fbug(my_assertion(G)),writeq(goal(G)),nl,!,break. +must_be_free(AllNew):- plain_var(AllNew),!. +must_be_free(AllNew):- arcST,fbug(must_be_free(AllNew)),break,fail. +must_be_nonvar(AllNew):- nonvar_or_ci(AllNew),!. +must_be_nonvar(AllNew):- arcST,fbug(must_be_nonvar(AllNew)),break,fail. + +my_len(X,Y):- var(X),!,length(X,Y). +my_len(X,Y):- is_list(X),!,length(X,Y). +my_len(X,Y):- functor([_|_],F,A),functor(X,F,A),!,length(X,Y). +my_len(X,Y):- arcST,!,ibreak. +*/ +is_map(G):- is_vm_map(G),!. +%arc_webui:- false. +sort_safe(I,O):- catch(sort(I,O),_,I=O). +my_append(A,B):- append(A,B). +my_append(A,B,C):- append(A,B,C). +with_tty_false(Goal):- with_set_stream(current_output,tty(false),Goal). +with_tty_true(Goal):- with_set_stream(current_output,tty(true),Goal). + +% Count occurrences of G and store the result in N +count_of(G,N):- findall_vset(G,G,S),length(S,N). +findall_vset(T,G,S):- findall(T,G,L),variant_list_to_set(L,S). +flatten_objects(Objs,ObjsO):- flatten([Objs],ObjsO),!. + + +var_e(E,S):- E==S,!. +var_e(E,S):- (nonvar(E);attvar(E)),!,E=@=S. + +variant_list_to_set([E|List],Out):- select(S,List,Rest),var_e(E,S),!, variant_list_to_set([E|Rest],Out). +variant_list_to_set([E|List],[E|Out]):- !, variant_list_to_set(List,Out). +variant_list_to_set(H,H). + +nb_subst(Obj,New,Old):- + get_setarg_p1(nb_setarg,Found,Obj,P1),Found=@=Old, + p1_call(P1,New),!,nb_subst(Obj,New,Old). +nb_subst(_Obj,_New,_Old). + +system:any_arc_files(Some):- is_list(Some),!, Some\==[],maplist(any_arc_files,Some). +system:any_arc_files(Some):- atom_contains(Some,'arc'). + +:- thread_local(in_memo_cached/5). +:- multifile(prolog:make_hook/2). +:- dynamic(prolog:make_hook/2). +prolog:make_hook(before, Some):- any_arc_files(Some), forall(muarc:clear_all_caches,true). + +:- multifile(muarc:clear_all_caches/0). +:- dynamic(muarc:clear_all_caches/0). +muarc:clear_all_caches:- \+ luser_getval(extreme_caching,true), retractall(in_memo_cached(_,_,_,_,_)), fail. +%arc_memoized(G):- !, call(G). + +arc_memoized(G):- compound(G),ground(G),functor(G,F,1),functor(C,F,1),!,arc_memoized(C),G=C,!. +arc_memoized(G):- + copy_term(G,C,GT), + (Key = (C+GT)), + (in_memo_cached(Key,C,track,started,Info)->throw(already_memoizing(in_memo_cached(Key,C,track,started,Info))) ; true), + numbervars(Key,0,_,[attvar(bind),singletons(true)]),!, + setup_call_cleanup((asserta(in_memo_cached(Key,C,track,started,_),Started)), + catch( + (in_memo_cached(Key,C,GT,Found,AttGoals)*->(G=Found,maplist(call,AttGoals)) + ; ((call(G),copy_term(G,CG,GG)) *->asserta(in_memo_cached(Key,C,GT,CG,GG)) + ;asserta(in_memo_cached(Key,C,GT,failed,_)))), + E, (retractall(in_memo_cached(Key,C,GT,_,_)),throw(E))),erase(Started)). + +set_nth1(1,[_|Row],E,[E|Row]):-!. +set_nth1(N,[W|Row],E,[W|RowMod]):- Nm1 is N-1, set_nth1(Nm1,Row,E,RowMod). + +findall_count(T,G,N):- findall_set(T,G,S),length(S,N). + +findall_set(T,G,S):- findall(T,G,L),list_to_set(L,S). + +make_list_inited(0,_,[]):-!. +make_list_inited(1,E,[E]):-!. +make_list_inited(N,E,[E|List]):- Nm1 is N -1,make_list_inited(Nm1,E,List). + +nth_fact(P,I):- clause(P,true,Ref),nth_clause(P,I,Ref). + +nonvar_or_ci(C):- (nonvar(C);attvar(C)),!. + +add_i(Info):- + quietly((tersify(Info,InfoT), + luser_getval(test_rules,TRules), + luser_getval(pair_rules,PRules), + nb_set_add(TRules,InfoT), + nb_set_add(PRules,InfoT), + nop(pp(cyan,+InfoT)))). + +add_i(F,Info):- + append_term(i(F),Info,FInfo), + add_i(FInfo). + +add_rule(Info):- add_i(rule,Info). +add_cond(Info):- add_i(cond,Info). +%do_action(Info):- guess_pretty(Info),add_i(action,Info),call(Info). +do_action(Call):- !, copy_term(Call,Info),call(Call),add_i(action,Info). +add_action(Info):- add_i(action,Info). +add_note(Info):- add_i(note,Info). +add_indiv(W,Info):- add_i(indiv(W),Info). +add_comparitor(Info):- add_i(comparitor,Info). +show_rules:- + luser_getval(pair_rules,PRules), maplist(pp(cyan),PRules), + luser_getval(test_rules,TRules), maplist(pp(blue),TRules), + !. + + +sub_atom_value(TestID,A):- sub_term(A,TestID),(atom(A);string(A)). + +my_list_to_set(List, Set):- my_list_to_set(List, (=) ,Set). +my_list_to_set_variant(List, Set):- my_list_to_set(List, (=@=) ,Set). +my_list_to_set_cmp(List, Set):- my_list_to_set(List, (=@=) ,Set). + +my_list_to_set([E|List],P2, Set):- select(C,List,Rest), p2_call(P2, E,C), !, my_list_to_set([E|Rest],P2, Set). +my_list_to_set([E|List],P2, [E|Set]):-!, my_list_to_set(List,P2, Set). +my_list_to_set([],_,[]). + +my_list_to_set_cmp([E|List],C3, Set):- select(C,List,Rest), call(C3,R,E,C), + R== (=), my_list_to_set_cmp([C|Rest],C3, Set),!. + my_list_to_set_cmp([E|List],C3, [E|Set]):-!, my_list_to_set_cmp(List,C3, Set). +my_list_to_set_cmp([],_,[]). + + +contains_nonvar(N,Info):- sub_term(E,Info),nonvar_or_ci(E),E=N,!. + +max_min(A,B,C,D):- must_be_free(C),must_be_free(D),max_min0(A,B,C,D). +max_min0(A,B,B,B):- plain_var(A). +max_min0(A,B,A,A):- plain_var(B),!. +max_min0(A,B,C,D):- number(A),number(B), !, ((A > B) -> (C=A, D=B) ; (C=B, D=A)). +max_min0(_,A,A,A):- number(A),!. +max_min0(A,_,A,A):- number(A),!. +max_min0(_,_,_,_). + +as_debug(L,G):- as_debug(L,true,G). +as_debug(9,_,_):- !. +as_debug(_,C,G):- ignore(catch((call(C)->wots(S,G),format('~NDEBUG: ~w~N',[S]);true),_,true)). + +shall_count_as_same(A,B):- same_term(A,B),!. % unify ok_ok cmatch +shall_count_as_same(A,B):- plain_var(A),!,A==B. +shall_count_as_same(A,B):- atomic(A),!, A=@=B. +shall_count_as_same(A,B):- var(B),!,A=@=B. +shall_count_as_same(A,B):- A=@=B,!. +shall_count_as_same(A,B):- copy_term(B,CB),copy_term(A,CA),\+ \+ ( A=B, B=@=CB, A=@=CA),!. +%shall_count_as_same(A,B):- \+ A \= B, !. + +count_each([C|L],GC,[Len-C|LL]):- include(shall_count_as_same(C),GC,Lst),length(Lst,Len),!,count_each(L,GC,LL). +count_each([],_,[]). + +count_each_inv([C|L],GC,[C-Len|LL]):- include(shall_count_as_same(C),GC,Lst),length(Lst,Len),count_each_inv(L,GC,LL). +count_each_inv([],_,[]). + +maplist_n(N,P,[H1|T1]):- + p2_call(P,N,H1), N1 is N+1, + maplist_n(N1,P,T1). +maplist_n(_N,_P,[]). + +maplist_n(N,P,[H1|T1],[H2|T2]):- + call(P,N,H1,H2), N1 is N+1, + maplist_n(N1,P,T1,T2). +maplist_n(_N,_P,[],[]). + +/* +print_points_grid(Points):- + points_range(Points, LoH, LoV, HiH, HiV, H, V), writeqln(size_range(LoH, LoV, HiH, HiV, H, V)), points_to_grid(Points, Grid), print_grid(Grid). + +print_points_grid(Grid):- + points_range(Grid, LoH, LoV, HiH, HiV, _H, _V), print_grid(Grid, LoH, LoV, HiH, HiV, Grid). +*/ + + +%print_trainer:- kaggle_arc_train(Name, Stuff), atom_json_term(Stuff, JSON, []), print_arc(Name, JSON). +%print_evaler:- kaggle_arc_eval(Name, Stuff), atom_json_term(Stuff, JSON, []), print_arc(Name, JSON). + + /* +% data looks like + +kaggle_arc_train('007bbfb7', trn, [[0, 7, 7], [7, 7, 7], [0, 7, 7]], [[0,0,0,0, 7, 7,0, 7, 7], [0,0,0, 7, 7, 7, 7, 7, 7], [0,0,0,0, 7, 7,0, 7, 7], [0, 7, 7,0, 7, 7,0, 7, 7], [7, 7, 7, 7, 7, 7, 7, 7, 7], [0, 7, 7,0, 7, 7,0, 7, 7], [0,0,0,0, 7, 7,0, 7, 7], [0,0,0, 7, 7, 7, 7, 7, 7], [0,0,0,0, 7, 7,0, 7, 7]]). +kaggle_arc_train('007bbfb7', trn, [[4,0, 4], [0,0,0], [0, 4,0]], [[4,0, 4,0,0,0, 4,0, 4], [0,0,0,0,0,0,0,0,0], [0, 4,0,0,0,0,0, 4,0], [0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0], [0,0,0, 4,0, 4,0,0,0], [0,0,0,0,0,0,0,0,0], [0,0,0,0, 4,0,0,0,0]]). +kaggle_arc_train('007bbfb7', trn, [[0,0,0], [0,0, 2], [2,0, 2]], [[0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0, 2], [0,0,0,0,0,0, 2,0, 2], [0,0,0,0,0,0,0,0,0], [0,0, 2,0,0,0,0,0, 2], [2,0, 2,0,0,0, 2,0, 2]]). +kaggle_arc_train('007bbfb7', trn, [[6, 6,0], [6,0,0], [0, 6, 6]], [[6, 6,0, 6, 6,0,0,0,0], [6,0,0, 6,0,0,0,0,0], [0, 6, 6,0, 6, 6,0,0,0], [6, 6,0,0,0,0,0,0,0], [6,0,0,0,0,0,0,0,0], [0, 6, 6,0,0,0,0,0,0], [0,0,0, 6, 6,0, 6, 6,0], [0,0,0, 6,0,0, 6,0,0], [0,0,0,0, 6, 6,0, 6, 6]]). +kaggle_arc_train('007bbfb7', trn, [[2, 2, 2], [0,0,0], [0, 2, 2]], [[2, 2, 2, 2, 2, 2, 2, 2, 2], [0,0,0,0,0,0,0,0,0], [0, 2, 2,0, 2, 2,0, 2, 2], [0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0], [0,0,0, 2, 2, 2, 2, 2, 2], [0,0,0,0,0,0,0,0,0], [0,0,0,0, 2, 2,0, 2, 2]]). +kaggle_arc_train('007bbfb7', tst, [[7,0, 7], [7,0, 7], [7, 7,0]], [[7,0, 7,0,0,0, 7,0, 7], [7,0, 7,0,0,0, 7,0, 7], [7, 7,0,0,0,0, 7, 7,0], [7,0, 7,0,0,0, 7,0, 7], [7,0, 7,0,0,0, 7,0, 7], [7, 7,0,0,0,0, 7, 7,0], [7,0, 7, 7,0, 7,0,0,0], [7,0, 7, 7,0, 7,0,0,0], [7, 7,0, 7, 7,0,0,0,0]]). + +kaggle_arc_train('00d62c1b', trn, [[0,0,0,0,0,0], [0,0, 3,0,0,0], [0, 3,0, 3,0,0], [0,0, 3,0, 3,0], [0,0,0, 3,0,0], [0,0,0,0,0,0]], [[0,0,0,0,0,0], [0,0, 3,0,0,0], [0, 3, 4, 3,0,0], [0,0, 3, 4, 3,0], [0,0,0, 3,0,0], [0,0,0,0,0,0]]). +kaggle_arc_train('00d62c1b', trn, [[0,0,0,0,0,0,0,0,0,0], [0,0, 3,0, 3,0,0,0,0,0], [0,0,0, 3,0, 3,0,0,0,0], [0,0, 3,0,0,0, 3,0,0,0], [0,0,0,0,0, 3,0, 3,0,0], [0,0,0, 3,0, 3, 3,0,0,0], [0,0, 3, 3, 3,0,0,0,0,0], [0,0,0, 3,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0]], [[0,0,0,0,0,0,0,0,0,0], [0,0, 3,0, 3,0,0,0,0,0], [0,0,0, 3,0, 3,0,0,0,0], [0,0, 3,0,0,0, 3,0,0,0], [0,0,0,0,0, 3, 4, 3,0,0], [0,0,0, 3,0, 3, 3,0,0,0], [0,0, 3, 3, 3,0,0,0,0,0], [0,0,0, 3,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0]]). +kaggle_arc_train('00d62c1b', trn, [[0,0,0,0,0, 3,0,0,0,0], [0,0,0,0, 3,0,0,0,0,0], [0, 3, 3,0, 3, 3,0, 3,0,0], [3,0,0, 3,0,0, 3,0, 3,0], [0,0,0, 3,0,0, 3, 3,0,0], [0,0,0, 3,0,0, 3,0,0,0], [0,0,0, 3,0,0, 3,0,0,0], [0,0,0,0, 3, 3,0, 3,0,0], [0,0,0,0,0,0,0,0, 3,0], [0,0,0,0,0,0,0,0,0,0]], [[0,0,0,0,0, 3,0,0,0,0], [0,0,0,0, 3,0,0,0,0,0], [0, 3, 3,0, 3, 3,0, 3,0,0], [3,0,0, 3, 4, 4, 3, 4, 3,0], [0,0,0, 3, 4, 4, 3, 3,0,0], [0,0,0, 3, 4, 4, 3,0,0,0], [0,0,0, 3, 4, 4, 3,0,0,0], [0,0,0,0, 3, 3,0, 3,0,0], [0,0,0,0,0,0,0,0, 3,0], [0,0,0,0,0,0,0,0,0,0]]). +kaggle_arc_train('00d62c1b', trn, [[0,0,0,0,0,0,0,0,0,0], [0,0, 3, 3, 3, 3,0,0,0,0], [0,0, 3,0,0, 3,0,0,0,0], [0,0, 3,0,0, 3,0, 3,0,0], [0,0, 3, 3, 3, 3, 3, 3, 3,0], [0,0,0, 3,0,0,0,0, 3,0], [0,0,0, 3,0,0,0, 3, 3,0], [0,0,0, 3, 3,0,0, 3,0, 3], [0,0,0, 3,0, 3,0,0, 3,0], [0,0,0,0, 3,0,0,0,0,0]], [[0,0,0,0,0,0,0,0,0,0], [0,0, 3, 3, 3, 3,0,0,0,0], [0,0, 3, 4, 4, 3,0,0,0,0], [0,0, 3, 4, 4, 3,0, 3,0,0], [0,0, 3, 3, 3, 3, 3, 3, 3,0], [0,0,0, 3,0,0,0,0, 3,0], [0,0,0, 3,0,0,0, 3, 3,0], [0,0,0, 3, 3,0,0, 3, 4, 3], [0,0,0, 3, 4, 3,0,0, 3,0], [0,0,0,0, 3,0,0,0,0,0]]). +kaggle_arc_train('00d62c1b', trn, [[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0, 3,0,0,0,0,0,0,0,0,0,0,0], [0,0,0,0, 3, 3, 3, 3,0, 3, 3,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0, 3,0, 3,0,0,0,0,0,0,0, 3,0], [0,0,0,0,0,0,0,0, 3, 3, 3, 3, 3, 3, 3, 3,0,0,0,0], [0,0,0,0,0,0,0,0, 3,0,0,0,0,0,0, 3,0,0,0,0], [0,0,0,0, 3,0,0,0, 3,0,0,0,0,0,0, 3,0,0,0,0], [0,0,0,0,0,0,0,0, 3,0,0,0,0,0,0, 3,0,0,0,0], [0,0,0,0,0,0,0,0, 3,0,0,0,0,0,0, 3,0,0,0,0], [0,0, 3,0,0,0,0,0, 3, 3, 3, 3, 3, 3, 3, 3,0,0,0,0], [0,0,0,0,0,0,0,0, 3,0,0,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0, 3, 3, 3,0,0,0,0, 3,0, 3,0,0], [0,0,0,0,0,0, 3, 3,0,0, 3,0,0, 3,0,0,0,0,0,0], [0,0,0,0,0,0,0, 3,0,0, 3, 3,0,0, 3,0,0, 3,0,0], [0,0,0,0,0,0,0, 3, 3, 3, 3,0, 3,0,0, 3, 3, 3,0,0], [0,0,0,0,0,0,0,0,0,0, 3,0,0,0,0, 3,0, 3,0,0], [0,0,0,0,0,0,0,0,0,0,0,0, 3,0,0, 3, 3, 3,0,0], [0,0,0,0,0,0,0,0,0,0,0,0,0, 3,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]], [[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0, 3,0,0,0,0,0,0,0,0,0,0,0], [0,0,0,0, 3, 3, 3, 3, 4, 3, 3,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0, 3, 4, 3,0,0,0,0,0,0,0, 3,0], [0,0,0,0,0,0,0,0, 3, 3, 3, 3, 3, 3, 3, 3,0,0,0,0], [0,0,0,0,0,0,0,0, 3, 4, 4, 4, 4, 4, 4, 3,0,0,0,0], [0,0,0,0, 3,0,0,0, 3, 4, 4, 4, 4, 4, 4, 3,0,0,0,0], [0,0,0,0,0,0,0,0, 3, 4, 4, 4, 4, 4, 4, 3,0,0,0,0], [0,0,0,0,0,0,0,0, 3, 4, 4, 4, 4, 4, 4, 3,0,0,0,0], [0,0, 3,0,0,0,0,0, 3, 3, 3, 3, 3, 3, 3, 3,0,0,0,0], [0,0,0,0,0,0,0,0, 3,0,0,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0, 3, 3, 3,0,0,0,0, 3,0, 3,0,0], [0,0,0,0,0,0, 3, 3, 4, 4, 3,0,0, 3,0,0,0,0,0,0], [0,0,0,0,0,0,0, 3, 4, 4, 3, 3,0,0, 3,0,0, 3,0,0], [0,0,0,0,0,0,0, 3, 3, 3, 3,0, 3,0,0, 3, 3, 3,0,0], [0,0,0,0,0,0,0,0,0,0, 3,0,0,0,0, 3, 4, 3,0,0], [0,0,0,0,0,0,0,0,0,0,0,0, 3,0,0, 3, 3, 3,0,0], [0,0,0,0,0,0,0,0,0,0,0,0,0, 3,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]]). +kaggle_arc_train('00d62c1b', tst, [[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0], [0,0, 3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0], [0, 3,0, 3, 3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0], [0,0, 3,0, 3, 3, 3, 3, 3,0, 3, 3,0,0,0,0,0,0,0,0], [0,0,0,0, 3,0,0,0,0, 3,0,0, 3,0,0,0,0,0,0,0], [0,0,0,0, 3, 3, 3, 3, 3,0, 3, 3, 3,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0,0,0,0, 3, 3, 3, 3, 3,0,0], [0,0,0,0,0,0,0,0,0,0,0,0,0, 3,0,0,0, 3,0,0], [0,0,0,0,0,0,0,0,0,0,0,0,0, 3,0,0,0, 3,0,0], [0,0,0,0,0,0,0,0,0, 3, 3, 3, 3, 3,0,0,0, 3,0,0], [0,0,0,0,0,0,0,0,0, 3,0,0,0, 3,0,0,0, 3,0,0], [0,0,0,0,0,0,0,0, 3, 3, 3, 3, 3, 3,0,0,0, 3,0,0], [0,0,0,0,0,0, 3, 3,0, 3,0,0,0, 3, 3, 3, 3, 3,0,0], [0,0, 3,0,0,0,0,0, 3, 3,0,0,0,0,0,0,0,0,0,0], [0, 3,0, 3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0], [0,0, 3,0, 3,0, 3, 3, 3, 3, 3, 3,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0, 3,0,0,0, 3,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0, 3,0,0,0, 3,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0, 3, 3, 3, 3, 3,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]], [[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0], [0,0, 3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0], [0, 3, 4, 3, 3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0], [0,0, 3,0, 3, 3, 3, 3, 3,0, 3, 3,0,0,0,0,0,0,0,0], [0,0,0,0, 3, 4, 4, 4, 4, 3, 4, 4, 3,0,0,0,0,0,0,0], [0,0,0,0, 3, 3, 3, 3, 3,0, 3, 3, 3,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0,0,0,0, 3, 3, 3, 3, 3,0,0], [0,0,0,0,0,0,0,0,0,0,0,0,0, 3, 4, 4, 4, 3,0,0], [0,0,0,0,0,0,0,0,0,0,0,0,0, 3, 4, 4, 4, 3,0,0], [0,0,0,0,0,0,0,0,0, 3, 3, 3, 3, 3, 4, 4, 4, 3,0,0], [0,0,0,0,0,0,0,0,0, 3, 4, 4, 4, 3, 4, 4, 4, 3,0,0], [0,0,0,0,0,0,0,0, 3, 3, 3, 3, 3, 3, 4, 4, 4, 3,0,0], [0,0,0,0,0,0, 3, 3, 4, 3,0,0,0, 3, 3, 3, 3, 3,0,0], [0,0, 3,0,0,0,0,0, 3, 3,0,0,0,0,0,0,0,0,0,0], [0, 3, 4, 3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0], [0,0, 3,0, 3,0, 3, 3, 3, 3, 3, 3,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0, 3, 4, 4, 4, 3,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0, 3, 4, 4, 4, 3,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0, 3, 3, 3, 3, 3,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]]). +*/ +%tell(s), ignore((nl, nl, task_pairs(Name, ExampleNum, In, Out), format('~N~q.~n', [test_pairs_cache(Name, ExampleNum, In, Out)]), fail)), told. +map_pred(Pred, P, X) :- map_pred([],Pred, P, X). +%map_pred(NoCycles,_Pred, P, X) :- member(E,NoCycles), E==P,!, X = P. +map_pred(NoCycles,Pred, P, X) :- p2_call(Pred, P, X)*->true;map_pred0(NoCycles,Pred, P, X). + +map_pred1(Pred, P, P1) :- map_pred1(P, Pred, P, P1). + +map_pred0(_NoCycles,_Pred, Args, ArgSO) :- must_be_free(ArgSO), Args==[],!, ArgSO=[]. +map_pred0(_NoCycles, Pred, P, P1) :- p2_call(Pred, P, P1),!. % *->true;fail. +map_pred0(NoCycles,Pred, P, X) :- fail, attvar(P), !, %duplicate_term(P,X),P=X, + get_attrs(P,VS), map_pred([P|NoCycles],Pred, VS, VSX), P=X, put_attrs(X,VSX),!. +map_pred0(NoCycles,Pred, P, X):- map_pred1(NoCycles,Pred, P, X). + +map_pred1(_NoCycles,_Pred, P, P1) :- ( \+ compound(P) ; is_ftVar(P)), !, must_det_ll(P1=P), !. +% map_pred0(NoCycles,Pred, Args, ArgSO) :- is_list(Args), !, maplist(map_pred([Args|NoCycles],Pred), Args, ArgS), ArgS=ArgSO. +map_pred1(NoCycles,Pred, IO, OO) :- is_list(IO),!, maplist(map_pred(NoCycles,Pred), IO, OO). +map_pred1(NoCycles,Pred, IO, [O|ArgS]) :- IO= [I|Args], !, + map_pred([IO,ArgS|NoCycles],Pred, I, O), map_pred0([IO,I|NoCycles],Pred, Args, ArgS). +map_pred1(NoCycles,Pred, P, P1) :- + compound_name_arguments(P, F, Args), maplist(map_pred([P|NoCycles],Pred),Args,ArgS), compound_name_arguments(P1, F, ArgS). +%map_pred(_Pred, P, P). +/* +:- meta_predicate map_pred(2, ?, ?, ?, ?). +map_pred(Pred, P, X, Sk, P1) :- must_be_free(X), p2_call(Pred, P, X), !, must(Sk=P1), !. +map_pred(_Pred, P, _, _, P1) :- is_ftVar(P), !, must(P1=P), !. +map_pred(Pred, [P|Args], X, Sk, [P1|ArgS]) :- !, map_pred(Pred, P, X, Sk, P1), !, must(map_pred(Pred, Args, X, Sk, ArgS)), !. +map_pred(Pred, P, X, Sk, P1) :- compound(P), !, compound_name_arguments(P, F, Args), map_pred(Pred, [F|Args], X, Sk, [Fs|ArgS]), !, compound_name_arguments(P1, Fs, ArgS), !. +map_pred(_Pred, P, _, _, P). +*/ +is_cons(A):- compound(A),A=[_|_]. + +into_grid_or_var(G,G):- is_cons(G),!. +into_grid_or_var(G,G):- var(G),!. +into_grid_or_var(O,G):- cast_to_grid(O,G,_Uncast),!. + +maybe_mapgrid(P2,I,O):- is_grid(I),!,mapgrid(P2,I,O). +maybe_mapgrid(P3,I,O,M):- is_grid(I),!,mapgrid(P3,I,O,M). +maybe_mapgrid(P4,I,O,M,N):- is_grid(I),!,mapgrid(P4,I,O,M,N). + +mapgrid(P4,Grid,GridM,GridN,GridO):- into_grid_or_var(Grid,G1),into_grid_or_var(GridM,G2),into_grid_or_var(GridN,G3),into_grid_or_var(GridO,G4),mapg_list(P4,G1,G2,G3,G4). +mapg_list(P4,Grid,GridM,GridN,GridO):- is_list(Grid),!,maplist(mapg_list(P4),Grid,GridM,GridN,GridO). +mapg_list(P4,Grid,GridM,GridN,GridO):- call(P4,Grid,GridM,GridN,GridO),!. + +mapgrid(P3,Grid,GridN,GridO):- into_grid_or_var(Grid,G1),into_grid_or_var(GridN,G2),into_grid_or_var(GridO,G3),mapg_list(P3,G1,G2,G3). +mapg_list(P3,Grid,GridN,GridO):- is_list(Grid),!,maplist(mapg_list(P3),Grid,GridN,GridO). +mapg_list(P3,Grid,GridN,GridO):- call(P3,Grid,GridN,GridO),!. + +mapgrid(P2, Grid,GridN):- into_grid_or_var(Grid,G1),into_grid_or_var(GridN,G2),!,mapg_list(P2, G1,G2). +mapg_list(P2, Grid,GridN):- is_list(Grid),!,maplist(mapg_list(P2),Grid,GridN). +mapg_list(P2, Grid,GridN):- p2_call(P2, Grid,GridN),!. + +mapgrid(P1,Grid):- into_grid_or_var(Grid,G1),mapg_list(P1,G1). +mapg_list(P1,Grid):- is_list(Grid),!,maplist(mapg_list(P1),Grid). +mapg_list(P1,Grid):- p1_call(P1,Grid),!. + + +maplist_ignore(_3,H,I,J):- (H==[];I==[],J==[]),!,(ignore(H=[]),ignore(I=[]),ignore(J=[])). +maplist_ignore(P3,H,I,J):- \+ is_list(H),!, ignore(p2_call(call(P3,H),I,J)). +maplist_ignore(P3,[H|Grid],[I|GridN],[J|GridO]):- maplist_ignore(P3,H,I,J), !,maplist_ignore(P3,Grid,GridN,GridO). + +maplist_ignore(_2,H,I):- (H==[];I==[]),!,(ignore(H=[]),ignore(I=[])). +maplist_ignore(P2, H,I):- \+ is_list(H),!, ignore(p2_call(P2, H,I)). +maplist_ignore(P2, [H|Grid],[I|GridN]):- maplist_ignore(P2, H,I), !,maplist_ignore(P2, Grid,GridN). + +%p1_or(P1,Q1,E):- must_be(callable,P1),!, (p1_call(P1,E);p1_call(Q1,E)). + +p1_call((P1;Q1),E):- must_be(callable,P1),!, (p1_call(P1,E);p1_call(Q1,E)). +p1_call((P1,Q1),E):- must_be(callable,P1),!, (p1_call(P1,E),p1_call(Q1,E)). +p1_call(or(P1,Q1),E):- must_be(callable,P1),!, (p1_call(P1,E);p1_call(Q1,E)). +p1_call(and(P1,Q1),E):- must_be(callable,P1),!, (p1_call(P1,E),p1_call(Q1,E)). +p1_call(not(not(P1)),E):- !, \+ \+ p1_call(P1,E). +p1_call(not(P1),E):- !, not(p1_call(P1,E)). +p1_call(once(P1),E):- !, once(p1_call(P1,E)). +p1_call(ignore(P1),E):- !, ignore(p1_call(P1,E)). +p1_call(chk(P1),E):- !, \+ \+ (p1_call(P1,E)). +p1_call( \+ (P1),E):- !, \+ p1_call(P1,E). +p1_call(P1,E):- !, call(P1,E). + +chk(X,E):- \+ \+ call(X,E). + +p2_call_p2(P2a,P2b,A,B):- p2_call(P2a,A,M),p2_call(P2b,M,B). + +p2_call(P2,A,B):- P2==[],!,A=B. +p2_call(p1_call(P1),E,O):- !, p1_call(P1,E), E=O. +p2_call([P2],Grid,GridN):- !, p2_call(P2, Grid,GridN). +p2_call([P2|P2L],Grid,GridN):- !, p2_call(P2, Grid,GridM),p2_call(P2L,GridM,GridN). +p2_call(ignore(P2),A,B):- p2_call(P2,A,B)*->true;A=B. +p2_call(type(Type,P2),A,B):- into_type(Type,A,AA),p2_call(P2,AA,B). +p2_call(or(P2,Q2),A,B):- nop(must_be(callable,P2)),!, (p2_call(P2,A,B);p2_call(Q2,A,B)). +p2_call(and(P2,Q2),A,B):- nop(must_be(callable,P2)),!, (p2_call(P2,A,AB),p2_call(Q2,AB,B)). +p2_call(P2,A,B):- must_be(callable,P2), call(P2,A,B). + + +p1_or(P1A,P1B,X):- p1_call(P1A,X)->true;p1_call(P1B,X). +p1_and(P1A,P1B,X):- p1_call(P1A,X),p1_call(P1B,X). +p1_not(P1,E):- \+ p1_call(P1,E). +p1_ignore(P1,E):- ignore(p1_call(P1,E)). +p1_arg(N,P1,E):- tc_arg(N,E,Arg),p1_call(P1,Arg). +p1_subterm(P1,E):- sub_term(Arg,E),p1_call(P1,Arg). + +:- meta_predicate my_partition(-, ?, ?, ?). +my_partition(_,[],[],[]):-!. +my_partition(P1,[H|L],[H|I],E):- \+ \+ p1_call(P1,H),!, + my_partition(P1,L,I,E). +my_partition(P1,[H|L],I,[H|E]):- + my_partition(P1,L,I,E),!. +my_partition(P1,H,I,HE):- arcST,ibreak, + my_partition(P1,[H],I,HE). + + +mapgroup(P2,G1,L2):- into_list(G1,L1),!, with_my_group(L1,maplist(P2,L1,L2)). +mapgroup(P1,G1):- into_list(G1,L1), !, with_my_group(L1,maplist(P1,L1)). + +selected_group(Grp):- nb_current('$outer_group',Grp),!. +selected_group([]). + +sub_cmpd(_, LF) :- \+ compound(LF), !, fail. +sub_cmpd(X, X). +sub_cmpd(X, Term) :- + ( is_list(Term) + -> member(E, Term), + sub_cmpd(X, E) + ; tc_arg(_, Term, Arg), + sub_cmpd(X, Arg) + ). + + + +%with_my_group([O|Grp],Goal):- compound(O),O=obj(_),!, locally(nb_setval('$outer_group',[O|Grp]),Goal). +with_my_group(_,Goal):- call(Goal). + +into_mlist(L,L). +my_maplist(P4,G1,L2,L3,L4):- into_mlist(G1,L1),!, with_my_group(L1,maplist(P4,L1,L2,L3,L4)). +my_maplist(P3,G1,L2,L3):- into_mlist(G1,L1),!, with_my_group(L1,maplist(P3,L1,L2,L3)). +my_maplist(P2,G1,L2):- into_mlist(G1,L1),!, with_my_group(L1,maplist(P2,L1,L2)). +my_maplist(P1,G1):- into_mlist(G1,L1), !, with_my_group(L1,maplist(P1,L1)). + + +my_include(P1,L,I):- include(p1_call(P1),L,I). +%my_include(P1,[H|L],O):- (p2_call(p1_call(P1),H,HH)*->(my_include(P1,L,I),O=[HH|I]);my_include(P1,L,O)). +my_include(_,_,[]). + +%my_exclude(P1,I,O):- my_include(not(P1),I,O). +my_exclude(P1,I,O):- my_partition(P1,I,_,O). + + +subst_1L([],Term,Term):-!. +subst_1L([X-Y|List], Term, NewTerm ) :- + subst0011(X, Y, Term, MTerm ), + subst_1L(List, MTerm, NewTerm ). + +subst_2L([],_,I,I). +subst_2L([F|FF],[R|RR],I,O):- subst0011(F,R,I,M),subst_2L(FF,RR,M,O). + + +subst001(I,F,R,O):- subst0011(F,R,I,O),!. + + +subst0011(X, Y, Term, NewTerm ) :- + copy_term((X,Y,Term),(CX,CY,Copy),Goals), + (Goals==[] + ->subst0011a( X, Y, Term, NewTerm ) + ;(subst0011a(CX, CY, Goals, NewGoals), + (NewGoals==Goals -> + subst0011a( X, Y, Term, NewTerm ) + ; (subst0011a(CX, CY, Copy, NewCopy), + NewTerm = NewCopy, maplist(call,NewGoals))))). + + + +subst0011a(X, Y, Term, NewTerm ) :- + ((X==Term)-> Y=NewTerm ; + (is_list(Term)-> maplist(subst0011a(X, Y), Term, NewTerm ); + (( \+ compound(Term); Term='$VAR'(_))->Term=NewTerm; + ((compound_name_arguments(Term, F, Args), + maplist(subst0011a(X, Y), Args, ArgsNew), + compound_name_arguments( NewTerm, F, ArgsNew )))))),!. + +subst001C(I,F,R,O):- subst001_p2(same_term,I,F,R,O),!. +subst0011C(F,R,I,O):- subst0011_p2(same_term,F,R,I,O),!. +subst_2LC(F,R,I,O):- subst_2L_p2(same_term,F,R,I,O). + +subst_2L_p2(_P2, [],_,I,I):-!. +subst_2L_p2(_P2, _,[],I,I):-!. +subst_2L_p2(P2, [F|FF],[R|RR],I,O):- subst0011_p2(P2, F,R,I,M),subst_2L_p2(P2, FF,RR,M,O). + +subst001_p2(P2, I,F,R,O):- subst0011_p2(P2, F,R,I,O),!. + +subst_1L_p2(_, [],Term,Term):-!. +subst_1L_p2(P2, [X-Y|List], Term, NewTerm ) :- + subst0011_p2(P2, X, Y, Term, MTerm ), + subst_1L_p2(P2, List, MTerm, NewTerm ). + +subst0011_p2(P2, X, Y, Term, NewTerm ) :- + copy_term((X,Y,Term),(CX,CY,Copy),Goals), + (Goals==[] + ->subst0011a_p2(P2, X, Y, Term, NewTerm ) + ;(subst0011a_p2(P2, CX, CY, Goals, NewGoals), + (NewGoals==Goals -> + subst0011a_p2(P2, X, Y, Term, NewTerm ) + ; (subst0011a_p2(P2, CX, CY, Copy, NewCopy), + NewTerm = NewCopy, maplist(call,NewGoals))))). + +subst0011a_p2(P2, X, Y, Term, NewTerm ) :- + (p2_call(P2,X,Term)-> Y=NewTerm ; + (is_list(Term)-> maplist(subst0011a_p2(P2, X, Y), Term, NewTerm ); + (( \+ compound(Term); Term='$VAR'(_))->Term=NewTerm; + ((compound_name_arguments(Term, F, Args), + maplist(subst0011a_p2(P2, X, Y), Args, ArgsNew), + compound_name_arguments( NewTerm, F, ArgsNew )))))),!. + + + +ppa(FF):- + copy_term(FF,FA,GF), + numbervars(FA+GF,0,_,[attvar(bind),singletons(true)]), + sort_safe(GF,GS),write(' '), + locally(b_setval(arc_can_portray,nil), + ppawt(FA)),format('~N'), + ignore((GS\==[], format('\t'),ppawt(attvars=GS),nl)),nl,!. + +ppawt(FA):- + write_term(FA,[numbervars(false), quoted(true), + character_escapes(true),cycles(true),dotlists(false),no_lists(false), + blobs(portray),attributes(dots), + portray(true), partial(false), fullstop(true), + %portray(false), partial(true), fullstop(true), + ignore_ops(false), quoted(true), quote_non_ascii(true), brace_terms(false)]). + +intersection(APoints,BPoints,Intersected,LeftOverA,LeftOverB):- + intersection_univ(APoints,BPoints,Intersected,LeftOverA,LeftOverB),!. + +same_univ(A,B):- (plain_var(A)->A==B;(B=@=A->true; (fail, \+ (A \=B )))). + +intersection_univ(APoints,BPoints,Intersected):- + intersection_univ(APoints,BPoints,Intersected,_,_),!. +intersection_univ(APoints,BPoints,Intersected,LeftOverA,LeftOverB):- + pred_intersection(same_univ,APoints,BPoints,Intersected,_,LeftOverA,LeftOverB). + +intersection_eq(APoints,BPoints,Intersected):- + intersection_eq(APoints,BPoints,Intersected,_,_),!. +intersection_eq(APoints,BPoints,Intersected,LeftOverA,LeftOverB):- + pred_intersection(same_univ,APoints,BPoints,Intersected,_,LeftOverA,LeftOverB). + +/* +intersection_u([],LeftOverB,[],[],LeftOverB):-!. +intersection_u(LeftOverA,[],[],LeftOverA,[]):-!. +intersection_u([A|APoints],BPoints,[A|Intersected],LeftOverA,LeftOverB):- + select(A,BPoints,BPointsMinusA),!, + intersection_u(APoints,BPointsMinusA,Intersected,LeftOverA,LeftOverB). +intersection_u([A|APoints],BPoints,Intersected,[A|LeftOverA],LeftOverB):- + intersection_u(APoints,BPoints,Intersected,LeftOverA,LeftOverB). +*/ + +:- meta_predicate(each_obj(?,?,0)). +each_obj([],_,_):-!. +each_obj([Obj|List],Obj,Goal):- ignore(Goal), each_obj(List,Obj,Goal). + +pred_intersection(_P2, [],LeftOverB, [],[], [],LeftOverB):-!. +pred_intersection(_P2, LeftOverA,[], [],[], LeftOverA,[]):-!. +pred_intersection(P2, [A|APoints],BPoints,[A|IntersectedA],[B|IntersectedB],LeftOverA,LeftOverB):- + select(B,BPoints,BPointsMinusA), + \+ \+ p2_call(P2, A,B),!, + pred_intersection(P2, APoints,BPointsMinusA,IntersectedA,IntersectedB,LeftOverA,LeftOverB). +pred_intersection(P2, [A|APoints],BPoints,IntersectedA,IntersectedB,[A|LeftOverA],LeftOverB):- + pred_intersection(P2, APoints,BPoints,IntersectedA,IntersectedB,LeftOverA,LeftOverB). + + + + + + + + + + + + + + + + + + + +pp(PP):-pp_m(PP). +pp(Color,PP):- ansi_format([fg(Color)],'~@',[pp(PP)]). + + +warn_skip(P):- pp(warn_skip(P)). + +with_set_stream(_,_,G):- call(G). + +fake_impl(M:F/A):- functor(P,F,A), asserta((M:P :- !, fail)). +fake_impl(F/A):- functor(P,F,A), asserta((P :- !, fail)). + + +:- fake_impl(arc_setval/3). +:- fake_impl(cast_to_grid/3). +:- fake_impl(dot_cfg:dictoo_decl/8). +:- fake_impl(get_param_sess/2). +:- fake_impl(into_list/2). +:- fake_impl(into_type/3). +:- fake_impl(is_grid/1). +:- fake_impl(is_hooked_obj/1). +:- fake_impl(is_vm_map/1). +:- fake_impl(ld_logicmoo_webui/0). +:- fake_impl(must_grid_call/3). +:- fake_impl(o_m_v/3). +:- fake_impl(quick_test/1). +:- fake_impl(url_decode_term/2). +:- fake_impl(xlisting_web:find_http_session/1). +:- fake_impl(xlisting_web:is_cgi_stream/0). + + +end_of_file. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +:- encoding(iso_latin_1). +/* + this is part of (H)MUARC https://logicmoo.org/xwiki/bin/view/Main/ARC/ + + This work may not be copied and used by anyone other than the author Douglas Miles + unless permission or license is granted (contact at business@logicmoo.org) +*/ + + +:- meta_predicate(print_grid(+,+,+,+)). +:- meta_predicate(print_grid(+,+,+)). + + +%:- autoload(library(http/html_write),[html/3,print_html/1]). + + +is_debugging(M):- \+ \+ debugging(M),!. +is_debugging(_):- is_testing,!. +%is_debugging(_):- menu_or_upper('B'). + +debug_m(_,Tiny):- display_length(Tiny,Len),Len<30,!,pp(Tiny). +debug_m(M,_):- \+ is_debugging(M),!. +%debug_m(_,List):- is_list(List),!,print_ss(List). +debug_m(_,Term):- pp(Term). +debug_c(M,_):- \+ is_debugging(M),!. +debug_c(_,C):- call(C),!. +debug_c(M,C):- wots_hs(S,C),debug_m(M,S),!. + +:- meta_predicate(wno(0)). +wno(G):- + locally(b_setval(print_collapsed,10), G). + +:- meta_predicate(print_collapsed(0)). +print_collapsed(Size,G):- + locally(b_setval(print_collapsed,Size), print_collapsed0(Size,G)). + +:- meta_predicate(print_collapsed0(0)). +print_collapsed0(Size,G):- Size<10, !, call(G). +% print_collapsed(Size,G):- call(G). +print_collapsed0(Size,G):- Size>=10, !, wots_hs(_S,G). +print_collapsed0(_,G):- wots_vs(S,G),write(S). + +tersify(I,O):- tracing,!,I=O. +%tersify(I,O):- term_variables(I,Vs), \+ ( member(V,Vs), attvar(V)),!,I=O. +tersify(I,O):- tersify23(I,O),!. +tersify(X,X):-!. + +tersify23(I,O):- quietly((tersify2(I,M),tersify3(M,O))),!. + +%srw_arc(I,O):- is_grid(I),!, wots_hs(O,(write('"'),print_grid(I),write('"'))). +%srw_arc(I,O):- compound(I),!, wots_hs(O,(write(ppt(I)))). +/* +srw_arc(I,O):- is_grid(I),!, wots_hs(O,(write('"'),print_grid(I),write('"'))). +*/ +srw_arc(I,O):- is_vm_map(I),!, O='..vvmm..'. +srw_arc(I,O):- is_grid(I),!, O='..grid..'. +/* +srw_arc(List,O):- current_prolog_flag(dmsg_len,Three), + is_list(List),length(List,L),L>Three, + append([A,B,C],[F|_],List),F \='...'(_), !, + simplify_goal_printed([A,B,C,'....'(L>Three)],O). +*/ +%srw_arc(gridFn(_),gridFn):-!. +%srw_arc(I,O):- is_points_list(I), length(I,N),N>10,!,O='..lo_points..'(N),!. +%srw_arc(I,O):- is_list(I), length(I,N),N>10,!,O='..lo_points..'(N),!. +srw_arc(I,O):- tersify(I,O),!,I\==O,!. + +:- multifile(dumpst_hook:simple_rewrite/2). +:- dynamic(dumpst_hook:simple_rewrite/2). + +dumpst_hook:simple_rewrite(I,O):- fail, notrace(catch(arc_simple_rewrite(I,O),_,fail)). + +arc_simple_rewrite(I,O):- + \+ current_prolog_flag(never_pp_hook, true), nb_current(arc_can_portray,t), + current_predicate(bfly_startup/0), + current_predicate(is_group/1), + b_setval(arc_can_portray,nil), + locally(b_setval(arc_can_portray,nil),once((compound(I), lock_doing(srw_arc,I,srw_arc(I,O))))), I\==O, I\=@=O, !, \+ I=O, + b_setval(arc_can_portray,t). + + +%:- set_prolog_flag(never_pp_hook, true). + + +portray_terse:- true,!. + +:- discontiguous arc_portray/2. + + +arc_portray(S,_):- term_is_ansi(S), !, write_keeping_ansi_mb(S). +arc_portray(_,_):- \+ \+ current_prolog_flag(never_pp_hook, true), nb_current(arc_can_portray,t), !, fail. +arc_portray(Map,TF):- get_map_pairs(Map,Type,Pairs),!, arc_portray_pairs(Type,TF,Pairs). + +arc_portray_t(G, _):- is_vm_map(G), !, write_map(G,'arc_portray_t'). +arc_portray_t(G, _):- is_grid(G), !, data_type(G,W),writeq(grid(W)). +arc_portray_t(G, _):- print(G),!. + +arc_portray(G, _):- is_vm_map(G), !, write_map(G,'arc_portray'). +arc_portray(G, TF):- TF == true, portray_terse, arc_portray_t(G, TF),!. +arc_portray(G, TF):- catch(arc_portray_nt(G, TF),E,(writeln(E),never_let_arc_portray_again,fail)),!. +%arc_portray(G, _TF):- writeq(G),!. + +% Portray In Debugger + +arc_portray_nt(G, false):- is_grid(G), print_grid(G),!. +%arc_portray_nt([G|L],_False):- is_object(G), !, pp([G|L]). +%arc_portray_nt(G0, true):- is_group(G0), ppt(G0),!. +%arc_portray_nt(G0, false):- is_group(G0), ppt(G0),!. +arc_portray_nt(G0, Tracing):- is_group(G0), into_list(G0,G), length(G,L),% L>1, !, + maplist(tersify,G0,GG), write(GG), + if_t(Tracing==false, + in_cmt(( + dash_chars, + once(((why_grouped(_TestID,Why,WG),WG=@=G,fail);(Why = (size2D=L)))),!, + print_grid(Why,G),nl_now, + + %underline_print(writeln(Why)), + %print_info_l(G), + dash_chars))). + + +arc_portray_nt(G,_False):- is_object(G), wots(S,writeg(G)), + global_grid(G,GG),!, + print_grid(GG), + write(S),!. % show_indiv(S,G). + %object_grid(G,OG), + %neighbor_map(OG,NG), !, + %print_grid(object_grid,NG),nl_now, + %underline_print(print_info(G)), + +arc_portray_nt(G,false):- via_print_grid(G),!, grid_size(G,H,V),!,H>0,V>0, print_grid(H,V,G). + +% Portray In tracer +arc_portray_nt(G,true):- is_object(G),underline_print((ppt(G))). +arc_portray_nt(G,true):- via_print_grid(G),write_nbsp,underline_print((ppt(G))),write_nbsp. +arc_portray_nt(G,true):- tersify(G,O),write_nbsp,writeq(O),write_nbsp. +arc_portray_nt(G0, _):- \+ is_gridoid(G0),!,print(G0). + + +arc_portray_pairs(Type,TF,Pairs):- + length(Pairs,N), + writeln(arc_portray_pairs(Type,TF,len(N))), + swap_kv(Pairs,VKPairs), + keysort(VKPairs,SVKPairs), + my_maplist(tc_arg(2),SVKPairs,SVKPairs2), + arc_portray_type_pairs(TF,SVKPairs2). + +arc_portray_type_pairs(TF,Pairs):- append(Left,[K1-V1,K2-V2|Right],Pairs),is_grid(V1),is_grid(V2),!, + append(Left,[call-print_side_by_side(yellow,V1,K1,_,V2,K2)|Right],PairsM), + arc_portray_type_pairs(TF,PairsM). +arc_portray_type_pairs(TF,Pairs):- + forall(member(K-V,Pairs),arc_portray_pair(Pairs,K,V,TF)). + +swap_kv([_-V|Pairs],VKPairs):- plain_var(V),!, swap_kv(Pairs,VKPairs). +swap_kv([K-V|Pairs],['-'(Type,K-V)|VKPairs]):- + data_type(V,Type), + swap_kv(Pairs,VKPairs). +swap_kv([],[]). + + +arc_portray_pair(Ps,K,Val,TF):- + nl_if_needed, + arc_portray_1_pair(Ps,K,Val,TF), + nl_if_needed_ansi. + +arc_portray_1_pair(_Ps,call,Val,_TF):- !, call(Val). +arc_portray_1_pair(Ps,K,Val,TF):- + (via_print_grid(Val) -> print_grid(K,Val) + ; (print(K),write('= '),once(arc_portray(Val,TF);print(Val)))), + ignore(arc_portray_pair_optional(Ps,K,Val,TF)),!. + +arc_portray_pair_optional(Ps,K,Val,TF):- + once(( Val\==[], is_list(Val),my_maplist(is_object,Val), + print_info(Val), + Val \= [_], + compare_objects(Val,Diffs), + color_print(cyan,call(arc_portray_pair(Ps,diffs(K),Diffs,TF))))). + + +% arc_portray(G):- \+ \+ catch((wots_hs(S,( tracing->arc_portray(G,true);arc_portray(G,false))),write(S),ttyflush),_,fail). +arc_portray(G):- \+ compound(G),fail. +arc_portray(G):- is_vm(G), !, write('..VM..'). +arc_portray(G):- \+ nb_current(arc_portray,t),\+ nb_current(arc_portray,f),is_print_collapsed,!, + locally(nb_setval(arc_portray,t),arc_portray1(G)). +arc_portray(G):- \+ nb_current(arc_portray,f),!, locally(nb_setval(arc_portray,t),arc_portray1(G)). +arc_portray(G):- locally(nb_setval(arc_portray,f),arc_portray1(G)). + +arc_portray1(G):- + flag(arc_portray_current_depth,X,X), X < 3, + \+ \+ + setup_call_cleanup(flag(arc_portray_current_depth,X,X+1),catch(((tracing->arc_portray(G,true); + arc_portray(G,false)),ttyflush),E,(fail,format(user_error,"~N~q~n",[E]),fail)),flag(arc_portray_current_depth,_,X)). + + +%via_print_grid(G):- tracing,!,fail. +via_print_grid(G):- is_points_list(G). %,!,fail,grid_size(G,H,V),number(H),number(V),H>1,V>1. +via_print_grid(G):- is_grid(G). +via_print_grid(G):- is_obj_props(G),!,fail. +via_print_grid(G):- is_object(G). +via_print_grid(G):- is_group(G). +via_print_grid(G):- is_gridoid(G). + + + +terseA(_,[],[]):- !. +terseA(_,L,'... attrs ...'(N)):- is_list(L),length(L,N),N>10,!. +terseA(I,[A|L],[B|LL]):-terseA(I,A,B),terseA(I,L,LL),!. +terseA(I,dif(A,B),B):-A==I,!. +terseA(I,dif(B,A),B):-A==I,!. +terseA(_,put_attr(_,B,A),A):- B==ci,!. +terseA(_,put_attr(_,B,A),B=A):-!. +terseA(_,A,A):-!. + + +simple_enough(I):- plain_var(I). +simple_enough(I):- atomic(I). +simple_enough(I):- \+ compound(I),!. +simple_enough(_*_):-!. +simple_enough(_+_):-!. +simple_enough(A):- functor(A,_,1),tc_arg(1,A,E),!,simple_enough(E). +%simple_enough(I):- number(I). +%simple_enough(I):- atom(I). + +tersify0(I,O):- simple_enough(I),!,I=O. +tersify0(I,av(C,Others)):- attvar(I),copy_term(I,C,Attrs),terseA(C,Attrs,Others),!. +tersify0(I,I):- var(I),!. + + +%tersifyC(D):- is_vm_map(D),!. +tersifyC(av(_,_)). +tersifyC(objFn(_,_)). +tersifyC(groupFn(_,_)). +tersifyC(objFn(_)). +tersifyC(groupFn(_)). + +tersify1(I,O):- simple_enough(I),!,I=O. +tersify1(av(_,Blue), -(Blue)):-!. +tersify1(I,O):- compound(I), tersifyC(I),!,I=O. +tersify1(gridFn(I),gridFn(I)):-!. % tersifyG(I,O). +%tersify1(gridFn(I),gridFn(O)):-tersifyG(I,O). +tersify1(Nil,[]):- Nil == [],!. +tersify1(I,gridFn(S)):- is_grid(I), into_gridnameA(I,O),!,sformat(S,'~w',[O]). +tersify1(I,gridFn(O)):- is_grid(I),tersifyG(I,O),!. +tersify1(I,groupFn(O,List)):- is_group(I), mapgroup(tersify1,I,List),mapgroup(obj_to_oid,I,OIDs),length(List,N), !,ignore((get_current_test(TestID),is_why_grouped(TestID,N,Why,OIDs),!,O=Why)). + +tersify1(I,Q):- is_object(I),object_ref_desc(I,Q),!. +tersify1(I,O):- is_vm_map(I), get_kov(objs,I,_),!, O='$VAR'('VM'). +tersify1(I,O):- is_vm_map(I), get_kov(pairs,I,_),!, O='$VAR'('Training'). + + +tersifyG(I,O):- tersifyL(I,O),numbervars(O,1,_,[attvar(bind),singletons(false)]),!. + +%tersifyL(I,I):- is_ftVar(I),!. +%tersifyL(I,I):- \+ compound(I),!. +tersifyL(I,O):- \+ is_cons(I),!,O=I. +tersifyL([H|I],[HH|I]):- \+ is_list(I),!,tersify(H,HH). +tersifyL([H|I],O):- nonvar(H), \+ is_group(I), display_length(I,N) , N>170, + length(I,LL),tersify(H,HH),(('...'(HH,LL,'...'(N)))=O),!. +tersifyL(I,O):- tersify0(I,O),!. +tersifyL([H|TT],[HH|TT]):- tersify(H,HH),!,tersifyL(TT,TT),!. +tersifyL(I,O):- tersify1(I,O),!. +tersifyL(I,I). + +tersify2(I,O):- compound(I),(I=(N=V)),tersify2(N,NN),tersify2(V,VV),!,O=(NN=VV). +tersify2(I,O):- simple_enough(I),!,I=O. +tersify2(I,O):- compound(I),tersify1(I,O),!. +tersify2(I,O):- tersify0(I,O),!. +tersify2(I,O):- is_list(I), !, my_maplist(tersify2,I,O). +tersify2(I,O):- compound(I), !, compound_name_arguments(I,F,IA), my_maplist(tersify,IA,OA), compound_name_arguments(O,F,OA). +tersify2(I,I). + +tersify3(I,O):- compound(I),(I=(N=V)),tersify3(N,NN),tersify3(V,VV),!,O=(NN=VV). +tersify3(I,O):- simple_enough(I),!,I=O. +tersify3(I,O):- compound(I),tersify1(I,O),!. +tersify3(I,O):- tersify0(I,O),!. +tersify3([H|I],O):- is_list(I), ((display_length(I,N), N>170) -> + (length(I,LL),tersify(H,HH),(('...'(HH,LL,'...'(N)))=O)); I=O),!. +tersify3(I,O):- is_list(I), !, my_maplist(tersify3,I,O). +tersify3(I,O):- compound(I), !, compound_name_arguments(I,F,IA), my_maplist(tersify,IA,OA), compound_name_arguments(O,F,OA). +tersify3(I,I). + +write_map(G,Where):- is_vm(G), !, write('...VM_'),write(Where),write('...'). +write_map(G,Where):- is_vm_map(G), !, write('...Map_'),write(Where),write('...'). +write_map(G,Where):- is_dict(G), !, write('...Dict_'),write(Where),write('...'). +write_map(_G,Where):- write('...'),write(Where),write('...'). + + + +non_empty_wqs_c(V):- \+ empty_wqs_c(V). +empty_wqs_c(V):- var(V),!,fail. +empty_wqs_c(A):- atom(A),atom_string(A,S),!,empty_wqs_c(S). +empty_wqs_c([]). +empty_wqs_c(""). +empty_wqs_c(" "). +empty_wqs_c(" "). +empty_wqs_c("\n"). + +is_writer_goal(H):- \+ callable(H),!,fail. +is_writer_goal(H):- is_list(H),!,fail. +is_writer_goal(A):- atom(A),!,is_writer_goal_f(A). +is_writer_goal(H):- \+ compound(H),!,fail. +%is_writer_goal((C1,C2)):- !, (is_writer_goal(C1);is_writer_goal(C2)). +is_writer_goal(C):- compound_name_arity(C,F,_),once(is_writer_goal_f(F);(tc_arg(_,C,E),is_writer_goal(E))). + + +is_writer_goal_f(wqs_c). +is_writer_goal_f(F):- is_writer_goal_l(F),!. +is_writer_goal_f(F):- \+ atom(F),!, term_to_atom(F,A),is_writer_goal_f(A). +is_writer_goal_f(F):- not_writer_goal_r(R),atom_concat(_,R,F),!,fail. +is_writer_goal_f(F):- is_writer_goal_l(L),atom_concat(L,_,F),!. +is_writer_goal_f(F):- is_writer_goal_l(R),atom_concat(_,R,F),!. +not_writer_goal_r(test). is_writer_goal_l(msg). is_writer_goal_l(call). +is_writer_goal_l(nl). is_writer_goal_l(format). is_writer_goal_l(with_). +is_writer_goal_l(locally). + +is_writer_goal_l(html). is_writer_goal_l(ptcol). is_writer_goal_l(wots). +is_writer_goal_l(print). is_writer_goal_l(flush_output). is_writer_goal_l(wqs). +is_writer_goal_l(pp). is_writer_goal_l(write). is_writer_goal_l(dash_). + + +maybe_color(SS,_):- term_contains_ansi(SS),!, write_nbsp, write(SS). +maybe_color(SS,P):- term_contains_ansi(P),!, write_nbsp, write(SS). +maybe_color(SS,P):- pp_msg_color(P,C), ansicall(C,is_maybe_bold(P,write(SS))),!. + +write_atom(S):- \+ atom(S),!,wqs(S). +write_atom(S):- atom_contains(S,'~'),!,notrace(catch(format(S,[]),_,maybe_write_atom_link(S))). +write_atom(S):- maybe_write_atom_link(S),!. +write_atom(S):- into_title_str(S,TS),write(TS),!. + +:- meta_predicate(into_title_str(+,-)). +into_title_str(Term,Str):- string(Term),!,Str=Term. +into_title_str(Term,Str):- plain_var(Term),sformat(Str,'~p',[Term]),!. +into_title_str(Term,Str):- var(Term),tersify0(Term,Terse), sformat(Str,'~p',[Terse]),!. +into_title_str(Term,Str):- term_is_ansi(Term), wots(Str,write_keeping_ansi_mb(Term)),!. +into_title_str(Term,Str):- (is_codelist(Term);is_charlist(Term)),catch(sformat(Str,'~s',[Term]),_,sformat(Str,'~p',[Term])),!. +into_title_str(Term,Str):- is_list(Term),my_maplist(into_title_str,Term,O3),atomics_to_string(O3," ",Str),!. +into_title_str([H|T],Str):- into_title_str(H,A),into_title_str(T,B),atomics_to_string([A,B]," ",Str),!. +into_title_str(Term,Str):- \+ callable(Term),sformat(Str,'~p',[Term]),!. +into_title_str(format(Fmt,Args),Str):- sformat(Str,Fmt,Args),!. +into_title_str(Term,""):- empty_wqs_c(Term),!. +into_title_str(out,"Output"). +into_title_str(in,"Input"). +into_title_str(i,"IN"). +into_title_str(o,"OUT"). +into_title_str(Term,Str):- atom(Term),is_valid_linkid(Term,Kind,_),Term\=@=Kind,into_title_str(Kind,KS),sformat(Str,'~w (~w)',[Term,KS]),!. +into_title_str(Term,Str):- atom(Term), atom_contains(Term,'_'), \+ atom_contains(Term,' '), to_case_breaks(Term,T), + include(\=(xti(_,punct)),T,O),my_maplist(tc_arg(1),O,O1),my_maplist(toProperCamelAtom,O1,O2), + atomics_to_string(O2," ",Str),!. +into_title_str(Term,Str):- has_short_id(Term,Kind,ID),Term\=@=Kind,into_title_str(Kind,KS),sformat(Str,'~w (~w)',[ID,KS]),!. + +into_title_str(T-U,Str):- into_title_str([some(T),"..to..",some(U)],Str). +into_title_str(T*U,Str):- into_title_str([some(T),"(",some(U),")"],Str). +into_title_str(T+U,Str):- into_title_str(T,S1), number(U), N is U+1, sformat(Str,'~w #~w',[S1,N]). +into_title_str(T+U,Str):- var(U), into_title_str(T,S1), sformat(Str,'~w(s)',[S1]). +into_title_str(title(Term),Str):- !, into_title_str(Term,Str),!. +into_title_str(some(Var),"Some"):- var(Var),!. +into_title_str(some(Var),Str):- !, into_title_str(Var,Str). +into_title_str(User:Term,Str):- User == user, !, into_title_str(Term,Str). +into_title_str(trn,"Training Pair"). +into_title_str(tst,"EVALUATION TEST"). +%into_title_str(Term,Str):- tersify23(Term,Terse),Term\=@=Terse,!,into_title_str(Terse,Str). +into_title_str(Term,Str):- callable_arity(Term,0),is_writer_goal(Term),catch(notrace(wots(Str,call_e_dmsg(Term))),_,fail),!. +into_title_str(Term,Str):- catch(sformat(Str,'~p',[Term]),_,term_string(Term,Str)),nonvar(Str),atom_length(Str,E50),E50<180,!. +into_title_str(Term,Str):- compound(Term), compound_name_arguments(Term,Name,Args), + %include(not_p1(plain_var),Args,Nonvars), + Args=Nonvars, + my_maplist(tersify,Nonvars,ArgsT), into_title_str([Name,"(",ArgsT,")"],Str),!. +into_title_str(Term,Str):- catch(sformat(Str,'~p',[Term]),_,term_string(Term,Str)). + +has_short_id(TestID,testid,UUID):- is_valid_testname(TestID),test_id_atom(TestID,UUID). +has_short_id(Obj,object,OID):- is_object(Obj),obj_to_oid(Obj,OID). +has_short_id(Grid,grid,GID):- is_grid(Grid),grid_to_gid(Grid,GID). + + +is_valid_linkid(ID,testid,TestID):- atom_id(ID,TestID),is_valid_testname(TestID),!. +is_valid_linkid(ID,object,Obj):- known_object(ID,Obj),!. +is_valid_linkid(ID,grid,Grid):- known_grid(ID,Grid),!. +% individuate_3(complete, two(v_1d398264_trn_0_in, v_1d398264_trn_0_out)) +is_valid_linkid(ID,group,Grp):- get_current_test(TestID),is_why_grouped_g(TestID,_Count,ID,Grp). + + +wqs_c(S):- term_is_ansi(S), !, write_keeping_ansi_mb(S). +wqs_c(S):- (string(S);is_codelist(S);is_charlist(S)),catch(format('~s',[S]),_,writeq(S)). +wqs_c(S):- empty_wqs_c(S),!. +wqs_c(S):- var(S),!,write(var(S)). +wqs_c(S):- atom(S),into_title_str(S,TS),write(TS),!. +wqs_c(S):- atom(S),write_atom(S),!. +%wqs_c(S):- atom(S),write(S),!. +wqs_c(S):- \+compound(S),!,notrace(catch(format('~p',[S]),_,write(S))). +wqs_c(title(S)):- !, wqs_c(S). +wqs_c(H+T):- !, wqs_c(H),write_nbsp,wqs_c(T). +wqs_c(S):- is_grid(S), print_grid(S),!. +wqs_c(S):- is_vm(S), pp(S) ,!. +wqs_c(L):- is_list(L), include(non_empty_wqs_c,L,LL),!,wqs_c_l(LL). +wqs_c([H|T]):- pp([H|T]),!. +wqs_c(H):- callable_arity(H,0),is_writer_goal(H),catch(call_e_dmsg(H),_,fail),!. +%wqs_c(H):- callable_arity(H,0),call(H),!. +wqs_c(H):- locally(t_l:wqs_fb(pp_no_nl),wqs(H)),!. + +wqs_c_l([]):-!. +wqs_c_l([H]):- wqs_c(H),!. +wqs_c_l([H|T]):- wqs_c(H),write_nbsp,wqs_c_l(T),!. + + + + + +ppt(_):- is_print_collapsed,!. +ppt(G):- stack_check_or_call(4000,writeq(G)),!. +ppt(G):- is_vm_map(G), !, write_map(G,'ppt'). +ppt(S):- term_is_ansi(S), !, write_keeping_ansi_mb(S). +%ppt(P):- compound(P),wqs1(P),!. + +ppt(P):- \+ ansi_main, wants_html,!,ptcol_html(P),write_br. +ppt(P):- \+ \+ ((tersify(P,Q),!,pp(Q))),!. +ppt(Color,P):- \+ ansi_main, wants_html,!,with_color_span(Color,ptcol_html(P)),write_br. +ppt(Color,P):- \+ \+ ((tersify(P,Q),!,pp(Color,Q))),!. + + +write_br:- ansi_main,!,nl. +write_br:- write('
'). + +ptc(Color,Call):- pp(Color,call(Call)). + +:- meta_predicate(ppnl(+)). +ppnl(Term):- is_list(Term),!,g_out(wqs(Term)). +ppnl(Term):- nl_if_needed,format('~q',[Term]),nl_if_needed_ansi. + +:- meta_predicate(pp(+)). +pp(Color,P):- \+ ansi_main, wants_html,!,with_color_span(Color,pp(P)),write_br. +pp(Color,P):- ignore((quietlyd((wots_hs(S,pp(P)),!,color_print(Color,S))))). + +pp(_):- is_print_collapsed,!. +%pp(Term):- is_toplevel_printing(Term), !, nl_if_needed, pp_no_nl(Term),!,nl_if_needed_ansi. +pp(_Term):- nl_if_needed, fail. +pp(Term):- \+ ansi_main, wants_html,!, wots_vs(SS,ptcol_html_scrollable(Term)),write(SS),write_br. +pp(Term):- \+ nb_current(arc_can_portray,_),!,locally(nb_setval(arc_can_portray,t),print(Term)). +pp(Term):- az_ansi(pp_no_nl(Term)),!,nl_if_needed_ansi. + +/* +ptcol(P):- wants_html,!,ptcol_html(P). +ptcol(call(P)):- callable(P),!,call(P). +ptcol(P):- pp(P). +*/ + +%ptcol_html(P):- ptcol_html_0(P). +ptcol_html(P):- ptcol_html_scrollable_0(P). +ptcol_html_scrollable(P):- with_tag_ats(div,scrollable,ptcol_html_scrollable_0(P)). + + +ptcol_html_0(P):- with_tag(pre,ptcol_html_wo_pre(P)). +ptcol_html_wo_pre(call(P)):- callable(P),!, in_pp_html(call(P)). +ptcol_html_wo_pre(P):- in_pp_html(print_tree_no_nl(P)). +ptcol_html_scrollable_0(P):- ptcol_html_wo_pre(P). + + +pp_wcg(G):- wants_html,!,ptcol_html_scrollable(G). +pp_wcg(G):- pp_safe(call((locally(nb_setval(arc_can_portray,t),print(G))))),!. + +wqln(Term):- ppnl(Term). +wqnl(G):- pp_safe(call((locally(nb_setval(arc_can_portray,nil),print(G))))),!. + +pp_safe(_):- nb_current(pp_hide,t),!. +pp_safe(call(W)):- !, nl_if_needed,nl_now,call(W),nl_now. +pp_safe(W):- nl_if_needed,nl_now,writeq(W),nl_now. +pp_safe(C,W):- color_print(C,call(pp_safe(W))). + + +%p_p_t_no_nl(Term):- is_toplevel_printing(Term), !, print_tree_no_nl(Term). + +p_p_t_no_nl(P):- \+ ansi_main, wants_html,!,ptcol_html(P). +p_p_t_no_nl(Term):- az_ansi(print_tree_no_nl(Term)). + +ppt_no_nl(P):- \+ ansi_main, wants_html,!,ptcol_html(P). +ppt_no_nl(P):- tersify(P,Q),!,pp_no_nl(Q). + +is_toplevel_printing(_):- \+ is_string_output, line_position(current_output,N), N<2, fail. + +pp_no_nl(P):- var(P),!,pp(var_pt(P)),nop((dumpST,ibreak)). +pp_no_nl(S):- term_is_ansi(S), !, write_keeping_ansi_mb(S). +pp_no_nl(P):- atom(P),atom_contains(P,'~'),!,format(P). +pp_no_nl(G):- is_vm_map(G), !, write_map(G,'pp'). +%pp_no_nl(S):- term_is_ansi(S), !, write_keeping_ansi_mb(S). +pp_no_nl(P):- \+ \+ (( pt_guess_pretty(P,GP),ptw(GP))). +%pp(P):-!,writeq(P). +%ptw(P):- quietlyd(p_p_t_nl(P)),!. +%ptw(_):- nl_if_needed,fail. +ptw(P):- var(P),!,ptw(var_ptw(P)),nop((dumpST,ibreak)). +ptw(G):- is_vm_map(G), !, write_map(G,'ptw'). +ptw(S):- term_is_ansi(S), !, write_keeping_ansi_mb(S). +ptw(P):- p_p_t_no_nl(P),!. + +%ptw(P):- quietlyd(write_term(P,[blobs(portray),quoted(true),quote_non_ascii(false), portray_goal(print_ansi_tree),portray(true)])),!. +print_ansi_tree(S,_):- term_is_ansi(S), !, write_keeping_ansi_mb(S). +print_ansi_tree(P,_):- catch(arc_portray(P),_,(never_let_arc_portray_again,fail)),!. +print_ansi_tree(P,_OL):- catch(p_p_t_no_nl(P),_,(never_let_arc_portray_again,fail)),!. + +%p_p_t_nl(T):- az_ansi(print_tree_nl(T)). +%p_p_t(T):- az_ansi(print_tree(T)). + +pt_guess_pretty(P,O):- \+ nb_current(in_pt_guess_pretty,t), locally(nb_setval(in_pt_guess_pretty,t),pt_guess_pretty_1(P,O)). +pt_guess_pretty(O,O). + +upcase_atom_var_l(IntL,NameL):- upcase_atom_var(IntL,NameL). +upcase_atom_var_l(IntL,NameL):- is_list(IntL),!,my_maplist(upcase_atom_var_l,IntL,NameL). + +pt_guess_pretty_1(P,O):- copy_term(P,O,_), + ignore((sub_term(Body,O), compound(Body), Body=was_once(InSet,InVars),upcase_atom_var_l(InSet,InVars))), + ignore(pretty1(O)),ignore(pretty_two(O)),ignore(pretty_three(O)),ignore(pretty_final(O)),!, + ((term_singletons(O,SS),numbervars(SS,999999999999,_,[attvar(skip),singletons(true)]))). + +:- dynamic(pretty_clauses:pp_hook/3). +:- multifile(pretty_clauses:pp_hook/3). +:- module_transparent(pretty_clauses:pp_hook/3). +pretty_clauses:pp_hook(FS,Tab,S):- \+ current_prolog_flag(never_pp_hook, true), nb_current(arc_can_portray,t), notrace(catch(arc_pp_hook(FS,Tab,S),_,fail)). + +arc_pp_hook(_,Tab,S):- term_is_ansi(S), !,prefix_spaces(Tab), write_keeping_ansi_mb(S). +%arc_pp_hook(_,Tab,S):- is_vm(S),!,prefix_spaces(Tab),!,write('..VM..'). +%arc_pp_hook(_, _,_):- \+ \+ current_prolog_flag(never_pp_hook, true), nb_current(arc_can_portray,t),!,fail. +arc_pp_hook(FS,_ ,G):- \+ current_prolog_flag(never_pp_hook, true), nb_current(arc_can_portray,t), + current_predicate(is_group/1), + locally(b_setval(pp_parent,FS), + print_with_pad(pp_hook_g(G))),!. + +pp_parent(PP):- nb_current(pp_parent,PP),!. +pp_parent([]):-!. + +%:- meta_predicate(lock_doing(+,+,0)). +:- meta_predicate(lock_doing(+,+,:)). +lock_doing(Lock,G,Goal):- + (nb_current(Lock,Was);Was=[]), !, + \+ ((member(E,Was),E==G)), + locally(nb_setval(Lock,[G|Was]),Goal). + +never_let_arc_portray_again:- set_prolog_flag(never_pp_hook, true),!. +arc_can_portray:- \+ current_prolog_flag(never_pp_hook, true), nb_current(arc_can_portray,t). + +arcp:will_arc_portray:- + \+ current_prolog_flag(never_pp_hook, true), + \+ nb_current(arc_can_portray,f), + %nb_current(arc_can_portray,t), + current_prolog_flag(debug,false), + \+ tracing, + flag(arc_portray_current_depth,X,X),X<3, + current_predicate(bfly_startup/0). + +user:portray(Grid):- + arcp:will_arc_portray, \+ \+ catch(quietly(arc_portray(Grid)),_,fail),!, flush_output. + + +pp_hook_g(S):- term_is_ansi(S), !, write_keeping_ansi_mb(S). +pp_hook_g(_):- \+ \+ current_prolog_flag(never_pp_hook, true), nb_current(arc_can_portray,t),!,fail. +pp_hook_g(S):- term_contains_ansi(S), !, write_nbsp, pp_hook_g0(S). +pp_hook_g(G):- \+ plain_var(G), lock_doing(in_pp_hook_g,G,pp_hook_g0(G)). + +pp_hook_g0(S):- term_is_ansi(S), !, write_nbsp, write_keeping_ansi_mb(S). +pp_hook_g0(_):- \+ \+ current_prolog_flag(never_pp_hook, true), nb_current(arc_can_portray,t),!,fail. +pp_hook_g0(_):- in_pp(bfly),!,fail. +pp_hook_g0(G):- wots_hs(S,in_bfly(f,pp_hook_g10(G))),write(S). + +mass_gt1(O1):- into_obj(O1,O2),mass(O2,M),!,M>1. + +% Pretty printing +pp_hook_g10(G):- \+ plain_var(G), current_predicate(pp_hook_g1/1), lock_doing(in_pp_hook_g10,G,pp_hook_g1(G)). + +%as_grid_string(O,SSS):- is_grid(O),wots_vs(S,print_grid(O)), sformat(SSS,'{ ~w}',[S]). +as_grid_string(O,SSS):- wots_vs(S,show_indiv(O)), sformat(SSS,'{ ~w}',[S]). +as_pre_string(O,SS):- wots_hs(S,show_indiv(O)), strip_vspace(S,SS). + + +pretty_grid(O):- + catch( + (wots_hs(S,print_grid(O)),strip_vspace(S,SS), + ptc(orange,(format('" ~w "',[SS])))), + _,fail),!. +/* +pretty_grid(O):- + catch( + (wots_hs(S,print_grid(O)),strip_vspace(S,SS), + ptc(orange,(format('" ~w "',[SS])))), + _,(never_let_arc_portray_again,fail)). +*/ +pp_hook_g1(O):- plain_var(O), !, fail. + +pp_hook_g1(O):- attvar(O), !, is_colorish(O), data_type(O,DT), writeq('...'(DT)),!. +pp_hook_g1(S):- term_is_ansi(S), !, write_nbsp, write_keeping_ansi_mb(S). +%pp_hook_g1(S):- term_contains_ansi(S), !, fail, write_nbsp, write_keeping_ansi_mb(S). +pp_hook_g1(rhs(O)):- write_nbsp,nl,bold_print(print(r_h_s(O))),!. + +pp_hook_g1(iz(O)):- compound(O), O = info(_),underline_print(print(izz(O))),!. +pp_hook_g1(O):- is_grid(O), /* \+ (sub_term(E,O),compound(E),E='$VAR'(_)), */ pretty_grid(O). + + +pp_hook_g1(O):- is_object(O), into_solid_grid(O,G), wots(SS,pretty_grid(G)),write(og(SS)),!. + +pp_hook_g1(shape_rep(grav,O)):- is_points_list(O), as_grid_string(O,S), wotsq(O,Q), print(shape_rep(grav,S,Q)),!. +pp_hook_g1(vals(O)):- !, writeq(vals(O)),!. +%pp_hook_g1(l2r(O)):- into_solid_grid_strings(l2r(O),Str),Str\=@=l2r(O),print_term_no_nl(Str),!. +pp_hook_g1(localpoints(O)):- is_points_list(O), as_grid_string(O,S), wotsq(O,Q), print(localpoints(S,Q)),!. +pp_hook_g1(C):- compound(C), compound_name_arguments(C,F,[O]),is_points_list(O), length(O,N),N>2, as_grid_string(O,S), compound_name_arguments(CO,F,[S]), print(CO),!. + +pp_hook_g1(O):- is_points_list(O),as_grid_string(O,S),write(S),!. +pp_hook_g1(O):- is_real_color(O), color_print(O,call(writeq(O))),!. +pp_hook_g1(O):- is_colorish(O), data_type(O,DT), writeq('...'(DT)),!. + +pp_hook_g1(_):- \+ in_pp(ansi),!, fail. + + +pp_hook_g1(Grp):- current_predicate(pp_ilp/1),is_rule_mapping(Grp),pp_ilp(Grp),!. + +pp_hook_g1(O):- atom(O), atom_contains(O,'o_'), pp_parent([LF|_]), \+ (LF==lf;LF==objFn), + resolve_reference(O,Var), O\==Var, \+ plain_var(Var),!, + write_nbsp, writeq(O), write(' /* '), show_indiv(Var), write(' */ '). + +pp_hook_g1(O):- is_object(O),pp_no_nl(O), !. +pp_hook_g1(O):- is_group(O),pp_no_nl(O), !. + +%pp_hook_g1(change_obj(N,O1,O2,Sames,Diffs)):- showdiff_objects5(N,O1,O2,Sames,Diffs),!. + +pp_hook_g1(O):- is_vm_map(O),data_type(O,DT), writeq('..map.'(DT)),!. +pp_hook_g1(O):- is_gridoid(O),show_indiv(O), !. +%pp_hook_g1(O):- O = change_obj( O1, O2, _Same, _Diff), with_tagged('h5',w_section(object,[O1, O2],pp(O))). +%pp_hook_g1(O):- O = change_obj( O1, O2, _Same, _Diff), w_section(showdiff_objects(O1,O2)),!. +%pp_hook_g1(O):- O = change_obj( O1, O2, _Same, _Diff), w_section(object,[O1, O2],with_tagged('h5',pp(O))). +%pp_hook_g1(O):- O = diff(A -> B), (is_gridoid(A);is_gridoid(B)),!, p_c_o('diff', [A, '-->', B]),!. +pp_hook_g1(O):- O = showdiff( O1, O2), !, showdiff(O1, O2). +%pp_hook_g1(O):- compound(O),wqs1(O), !. +pp_hook_g1(O):- \+ compound(O),fail. +pp_hook_g1(G):- '@'(pp_hook_g1a(G),user). + +pp_hook_g1a(G):- \+ current_prolog_flag(debug,true), + current_predicate(pp_hook_g2/1), lock_doing(in_pp_hook_g3,any,pp_hook_g2(G)),!. +pp_hook_g1a(G):- fch(G),!. + +%pp_hook_g2(O):- current_predicate(colorize_oterms/2),colorize_oterms(O,C), notrace(catch(fch(C),_,fail)),! . + +fch(O):- wqs1(O). +%fch(O):- pp_no_nl(O). +%fch(O):- print(O). +%fch(O):- p_p_t_no_nl(O). + +wotsq(O,Q):- wots_hs(Q,wqnl(O)). +has_goals(G):- term_attvars(G,AV),AV\==[]. +has_goals(G):- term_variables(G,TV),term_singletons(G,SV),TV\==SV. + +maybe_term_goals(Term,TermC,Goals):- + term_attvars(Term,Attvars), Attvars\==[],!, + term_variables(Term,Vars), + include(not_in(Attvars),Vars,PlainVars), + copy_term((Attvars+PlainVars+Term),(AttvarsC+PlainVarsC+TermC),Goals), + numbervars(PlainVarsC,10,Ten1,[singletons(true),attvar(skip)]), + numbervars(AttvarsC+Goals,Ten1,_Ten,[attvar(bind),singletons(false)]). + +maybe_replace_vars([],SGoals,TermC,SGoals,TermC):-!. +maybe_replace_vars([V|VarsC],SGoals,TermC,RSGoals,RTermC):- + my_partition(sub_var(V),SGoals,Withvar,WithoutVar), + Withvar=[OneGoal], + freeze(OneGoal,(OneGoal\==null,OneGoal \== @(null))), + findall(_,sub_var(V,TermC),LL),LL=[_],!, + subst([WithoutVar,TermC],V,{OneGoal},[SGoalsM,TermCM]), + maybe_replace_vars(VarsC,SGoalsM,TermCM,RSGoals,RTermC). +maybe_replace_vars([_|VarsC],SGoals,TermC,RSGoals,RTermC):- + maybe_replace_vars(VarsC,SGoals,TermC,RSGoals,RTermC). + + +src_sameish(Orig,Find):- copy_term(Orig,COrig),Find=Orig,Orig=@=COrig. + +number_vars_calc_goals(Term,SSRTermC,[1|SRSGoals]):- + term_singletons(Term,Singles), + term_attvars(Term,Vars), + copy_term(Term+Vars+Singles,TermC+VarsC+SinglesC,Goals), + notrace(catch(numbervars(TermC+Goals,0,_Ten1,[singletons(false),attvar(skip)]),_,fail)), + sort_goals(Goals,VarsC,SGoals), + maybe_replace_vars(VarsC,SGoals,TermC,RSGoals,RTermC), + include(not_sub_var(RSGoals),SinglesC,KSingles), + length(KSingles,SL),length(VSingles,SL),my_maplist(=('$VAR'('__')),VSingles), + subst_2L(KSingles,VSingles,[RTermC,RSGoals],[SRTermC,SRSGoals]), + subst_1L_p2(src_sameish,[ + {dif('$VAR'('__'),RED)}=dif(RED), + {cbg('$VAR'('__'))}=cbg], + SRTermC,SSRTermC),!. + +number_vars_calc_goals(Term,SRTermC,[2|RSGoals]):- + term_attvars(Term,AVars), + copy_term(Term+AVars,TermC+VarsC,GoalsI), + term_attvars(GoalsI,GAttvars), copy_term(GoalsI+GAttvars,_+GAttvarsC,GoalsGoals), + append(GoalsI,GoalsGoals,Goals), + append([VarsC,GAttvarsC,AVars,GAttvars],SortVars), + numbervars(TermC+Goals,0,_Ten1,[singletons(false),attvar(bind)]), + sort_goals(Goals,SortVars,SGoals), + maybe_replace_vars(SortVars,SGoals,TermC,RSGoals,RTermC), + subst_1L_p2(src_sameish,[ + {dif('$VAR'('___'),RED)}=dif(RED), + {cbg('$VAR'('___'))}=cbg], + RTermC,SRTermC),!. + +number_vars_calc_goals(Term,SSRTermC,[3|SRSGoals]):- + term_singletons(Term,Singles), + term_attvars(Term,Vars), + copy_term(Term+Vars+Singles,TermC+VarsC+SinglesC,Goals), + numbervars(TermC+Goals,0,_Ten1,[singletons(false),attvar(bind)]), + sort_goals(Goals,VarsC,SGoals), + maybe_replace_vars(VarsC,SGoals,TermC,RSGoals,RTermC), + include(not_sub_var(RSGoals),SinglesC,KSingles), + length(KSingles,SL),length(VSingles,SL),my_maplist(=('$VAR'('__')),VSingles), + subst_2L(KSingles,VSingles,[RTermC,RSGoals],[SRTermC,SRSGoals]), + subst(SRTermC,{cbg('_')},cbg,SSRTermC),!. + +number_vars_calc_goals(Term,TermC,[4|SGoals]):- + term_variables(Term,Vars), + term_attvars(Term,Attvars), + copy_term(Term+Vars+Attvars,TermC+VarsC+AttvarsC,Goals), + notrace(catch(numbervars(TermC+Goals,0,_Ten1,[singletons(true)]),_,fail)), + append([AttvarsC,VarsC,AttvarsC,Vars],Sorted), + sort_goals(Goals,Sorted,SGoals),!. + +number_vars_calc_goals(Term,TermC,[5|SGoals]):- + term_variables(Term,Vars), + term_attvars(Term,Attvars), + copy_term(Term+Vars+Attvars,TermC+VarsC+AttvarsC,Goals), + numbervars(TermC+Goals,0,_Ten1,[singletons(false),attvar(skip)]), + append([AttvarsC,VarsC,Attvars,Vars],Sorted), + sort_goals(Goals,Sorted,SGoals),!. + + + +writeg(Term):- ignore( \+ notrace(catch(once(writeg0(Term);ppa(Term)),E,(pp(E),ppa(Term))))),!. + +writeg0(Term):- term_attvars(Term,Attvars),Attvars\==[],!, + must_det_ll(((number_vars_calc_goals(Term,TermC,Goals), + writeg5(TermC)),!, + if_t(Goals\==[],(nl_if_needed, + write(' goals='), call_w_pad_prev(3,az_ansi(print_tree_no_nl(Goals))))))),!. + +writeg0(Term):- \+ ground(Term), + \+ \+ must_det_ll(( + numbervars(Term,0,_Ten1,[singletons(true),attvar(skip)]), writeg5(Term))). +writeg0(Term):- writeg5(Term),!. + +writeg5(X):- is_ftVar(X),!,write_nbsp,write_nbsp,print(X),write_nbsp. +writeg5(N=V):- is_simple_2x2(V),!,print_grid(N,V),writeln(' = '),call_w_pad_prev(2,writeg9(V)). +writeg5(N=V):- is_gridoid(V),!,print_grid(N,V),writeln(' = '),call_w_pad_prev(2,writeg9(V)). +writeg5(N=V):- nl_if_needed,nonvar(N), pp_no_nl(N),writeln(' = '), !, call_w_pad_prev(2,writeg5(V)). +writeg5(_):- write_nbsp, fail. +writeg5(V):- writeg9(V). + +writeg8(X):- is_ftVar(X),!,print(X). +writeg8(X):- var(X),!,print(X). +writeg8(X):- writeq(X). + +writeg9(V):- is_simple_2x2(V),!,print_simple_2x2(writeg8,V). +writeg9(V):- is_list(V),nl_if_needed,write('['),!,my_maplist(writeg5,V),write(']'). +writeg9(_):- write_nbsp,write(' \t '),fail. +writeg9(X):- is_ftVar(X),!,write_nbsp,write_nbsp,print(X). +writeg9(V):- pp_no_nl(V). + + +/* +writeg5(V):- is_simple_2x2(V),!,print_simple_2x2(writeg8,V). +writeg5(V):- is_gridoid(V),!,call_w_pad_prev(2,writeg9(V)). +writeg5(V):- is_list(V),nl_if_needed,write('['),my_maplist(writeg5,V),write(']'). +*/ +arg1_near(Vars,Goal,Nth):- tc_arg(1,Goal,PreSort),nth1(Nth,Vars,E),E==PreSort,!. +arg1_near(_VarsC,Goal,PreSort):- tc_arg(1,Goal,PreSort),!. +arg1_near(_VarsC,Goal,Goal). + +sort_goals(Goals,VarsC,SGoals):- predsort(sort_on(arg1_near(VarsC)),Goals,SGoals). + +/* + +writeg0(Obj):- is_object(Obj),pp(Obj),!. +writeg0(O):- writeg00(O). + +writeg00(Term):- + maybe_term_goals(Term,TermC,Goals), + writeg00(TermC), call_w_pad(2,writeg00(Goals)),!. +writeg00(N=V):- nl_if_needed,nonvar(N), pp_no_nl(N),writeln(' = '), !, call_w_pad(2,writeg00(V)). +writeg00(O):- compound(O),compound_name_arguments(O,F,[A]),!,call_w_pad(2,((writeq(F),write('('),writeg3(A),write(')')))). +writeg00(S):- term_contains_ansi(S), !, write_keeping_ansi_mb(S). +writeg00([H|T]):- compound(H),H=(_=_), my_maplist(writeg0,[H|T]). +writeg00([H|T]):- is_list(T),call_w_pad(2,((nl,write('['),writeg2(H),my_maplist(writeg0,T),write(']'),nl))). +%writeg0(Term):- \+ ground(Term),!, \+ \+ (numbervars(Term,99799,_,[singletons(true)]), +% subst(Term,'$VAR'('_'),'$VAR'('_____'),TermO), writeg0(TermO)). +%writeg0(V):- \+ is_list(V),!,writeq(V),nl_now. +writeg00(V):- \+ is_list(V),!,pp(V). +writeg00(X):- call_w_pad(2,pp(X)). + +writeg1(N=V):- is_gridoid(V),!,print_grid(N,V),call_w_pad(2,(my_maplist(writeg1,V))). +writeg1(X):- nl_if_needed,writeg2(X),!,write_nbsp,!. +writeg2(S):- term_contains_ansi(S), !, write_keeping_ansi_mb(S). +writeg2(X):- is_ftVar(X),!,print(X). +writeg2(X):- write_term(X,[quoted(true),quote_non_ascii(true),portrayed(false),nl(false),numbervars(true)]),!. +%writeg2(X):- write_term(X,[quoted(true),quote_non_ascii(true),portrayed(false),nl(false),numbervars(false)]),!. +%writeg1(X):- nl_if_needed,writeg(X). +writeg2(S):- term_is_ansi(S), !, write_keeping_ansi_mb(S). +writeg2(X):- writeq(X),!. +writeg3(X):- is_list(X),X\==[],X=[_,_|_],!,writeg(X). +writeg3(X):- writeg2(X). +*/ + +% Nov 9th, 1989 +/* +pp_hook_g1(T):- + nb_current('$portraying',Was) + -> ((member(E,Was), T==E) -> ptv2(T) ; locally(b_setval('$portraying',[T|Was]),ptv0(T))) + ; locally(b_setval('$portraying',[T]),ptv0(T)). +*/ + +%pp_hook_g(G):- compound(G),ppt(G),!. +%pp_hook_g(G):- ppt(G),!. + + +strip_vspace(S,Stripped):- string_concat(' ',SS,S),!,strip_vspace(SS,Stripped). +strip_vspace(S,Stripped):- string_concat(SS,' ',S),!,strip_vspace(SS,Stripped). +strip_vspace(S,Stripped):- string_concat('\n',SS,S),!,strip_vspace(SS,Stripped). +strip_vspace(S,Stripped):- string_concat(SS,'\n',S),!,strip_vspace(SS,Stripped). +strip_vspace(S,Stripped):- string_concat('\t',SS,S),!,strip_vspace(SS,Stripped). +strip_vspace(S,Stripped):- string_concat(SS,'\t',S),!,strip_vspace(SS,Stripped). + +strip_vspace(S,Stripped):- replace_in_string([" \n"="\n","( "="( ","(\n"="( "],S,S2),S2\==S,!,strip_vspace(S2,Stripped). +%strip_vspace(S,Stripped):- split_string(S, "", "\t\r\n", [Stripped]). +strip_vspace(S,S). + + +print_nl(P):- nl_if_needed, wots_hs(SS,pp_no_nl(P)), maybe_color(SS,P),nl_if_needed. + +color_write(S):- term_is_ansi(S), !, write_keeping_ansi_mb(S). +color_write(P):- wots_hs(SS,write(P)), maybe_color(SS,P). + +write_keeping_ansi_mb(P):- is_maybe_bold(P,write_keeping_ansi(P)). + +is_maybe_bold(P):- sformat(S,'~w',[P]),atom_contains(S,'stOF'). + +is_maybe_bold(P,G):- is_maybe_bold(P),!, underline_print(bold_print(G)). +is_maybe_bold(_P,G):- call(G). + +pp_msg_color(P,C):- compound(P),pc_msg_color(P,C),!. +pp_msg_color(P,C):- must_det_ll(mesg_color(P,C)). +pc_msg_color(iz(P),C):- pp_msg_color(P,C). +pc_msg_color(link(P,_,_),C):- pp_msg_color(P,C). +pc_msg_color(link(P,_),C):- pp_msg_color(P,C). +pc_msg_color((_->P),C):- pp_msg_color(P,C). +pc_msg_color([P|_],C):- pp_msg_color(P,C). +pc_msg_color(diff(P),C):- pp_msg_color(P,C). + +%:- meta_predicate(wots_hs(0)). +%wots_hs(G):- wots_hs(S,G),write(S). + +:- meta_predicate(wots_ansi(-,0)). +wots_ansi(S,Goal):- wots(S,woto_ansi(Goal)). +:- meta_predicate(wots_ansi(-,0)). +wots_html(S,Goal):- wots(S,woto_html(Goal)). + +:- meta_predicate(woto_ansi(0)). +woto_ansi(Goal):- with_toplevel_pp(ansi,Goal). +:- meta_predicate(woto_html(0)). +woto_html(Goal):- with_toplevel_pp(http,Goal). + +:- meta_predicate(wots_hs(-,0)). +%wots_hs(S,G):- \+ wants_html,!,wots(S,G). +%wots_hs(S,G):- wots(S,G),!. +wots_hs(S,G):- wots(SS,G),notrace(remove_huge_spaces(SS,S)). +:- meta_predicate(wots_vs(-,0)). +wots_vs(OOO,G):- wots(S,G),notrace(fix_vspace(S,OOO)). + +fix_vspace(S,OOO):- + strip_vspace(S,SS), (atom_contains(SS,'\n') -> + wots_hs(SSS,(nl_now,write(' '),write(SS),nl_now));SSS=SS), + remove_huge_spaces(SSS,OOO). + + +write_tall(L):- is_list(L),!,my_maplist(write_tall,L). +write_tall(E):- wots_vs(S,wqs_c(E)),writeln(S). +write_wide(L):- is_list(L),!,my_maplist(write_wide,L). +write_wide(E):- wots_vs(S,wqs_c(E)),write(S),write_nbsp. + +p_to_br(S,SS):- fix_br_nls(S,S0), + cr_to_br(S0,SSS), + replace_in_string(['

'='
','
'='
','

'=' ','

'='
','

'='
'],SSS,SSSS), + cr_to_br(SSSS,SS). + +cr_to_br(S,SSS):- wants_html,!,cr_to_br_html(S,SSS). +cr_to_br(S,SSS):- cr_to_br_ansi(S,SSS). + +cr_to_br_html(S,SSS):- replace_in_string(['\r\n'='
','\r'='
','\n'='
'],S,SSS). +cr_to_br_ansi(S,SSS):- replace_in_string(['
'='\n',' '=' '],S,SSS). + +fix_br_nls(S,O):- replace_in_string( + ['
\n'='
','
\n'='
','

\n'='

','

\n'='

','

\n'='

', + '\n
'='
','\n
'='
','\n

'='

','\n

'='

','\n

'='

'],S,O). + +remove_huge_spaces(S,O):- notrace((fix_br_nls(S,SS),!,p_to_br(SS,O))),!. +/* +remove_huge_spaces(S,O):- fix_br_nls(S,S0), + replace_in_string([' '=' ', + ' '=' ', + ' '=' ', + ' '=' ', + ' '=' ', + ' '=' ', + ' '=' ', + '\t'=' ', + ' '=' '],S0,SS),p_to_br(SS,O). +*/ + + +wqs_l(H):- \+ is_list(H),!, wqs(H). +wqs_l(H):- wqs(H). + +wqs(P):- wots_hs(SS,wqs0(P)), maybe_color(SS,P). +wqs(C,P):- ansicall(C,wqs0(P)),!. + +wqs0(X):- plain_var(X), wqs(plain_var(X)),!. +wqs0(X):- plain_var(X), !, wqs(plain_var(X)), ibreak. +wqs0(S):- term_is_ansi(S), !, write_keeping_ansi_mb(S). +wqs0(C):- is_colorish(C),color_print(C,C),!. +wqs0(G):- is_vm_map(G), !, write_map(G,'wqs'). +wqs0(X):- var(X), !, get_attrs(X,AVs),!,writeq(X),write('/*{'),print(AVs),write('}*/'). +wqs0(X):- attvar(X), !, wqs(attvar(X)). +wqs0(nl_now):- !, nl_now. wqs0(X):- X=='', !. wqs0(X):- X==[], !. +wqs0(X):- is_grid(X), !, print_grid(X). +wqs0(G):- compound(G), G = call(C),callable(C),!,call(C). +wqs0([T]):- !, wqs(T). +wqs0([H|T]):- string(H), !, write(H), write_nbsp, wqs(T). +wqs0([H|T]):- compound(H),skip(_)=H, !,wqs(T). +wqs0([H|T]):- wqs(H), need_nl(H,T), wqs(T), !. +wqs0(X):- is_object(X), tersify1(X,Q), X\==Q,!, wqs(Q). +wqs0(X):- is_object(X), show_shape(X),!. +wqs0(X):- string(X), atom_contains(X,'~'), catch((sformat(S,X,[]),color_write(S)),_,fail),!. +wqs0(X):- string(X), !, color_write(X). +%wqs([H1,H2|T]):- string(H1),string(H2),!, write(H1),write_nbsp, wqs([H2|T]). +%wqs([H1|T]):- string(H1),!, write(H1), wqs(T). +%wqs([H|T]):- compound(H),!, writeq(H), wqs(T). + +wqs0(call(C)):- !, call(C). +wqs0(X):- \+ compound(X),!, write_nbsp, write(X). +wqs0(C):- compound(C),wqs1(C),!. +wqs0(C):- wqs2(C). +%wqs(S):- term_contains_ansi(S), !, write_nbsp, write_keeping_ansi_mb(S). + +wqs2(S):- term_contains_ansi(S), !, write_nbsp, write_keeping_ansi_mb(S). +%wqs2(P):- wants_html,!,pp(P). + +:- thread_local(t_l:wqs_fb/1). +wqs2(X):- t_l:wqs_fb(P1),call(P1,X),!. +%wqs2(X):- with_wqs_fb(writeq,X). +wqs2(X):- with_wqs_fb(writeq,print(X)),!. +%wqs2(X):- with_wqs_fb(writeq,((write_nbsp,write_term(X,[quoted(true)])))). + +with_wqs_fb(FB,Goal):- + locally(t_l:wqs_fb(FB),Goal). + + +as_arg_str(C,S):- wots_vs(S,print(C)). + +arg_string(S):- string(S),!. +arg_string(S):- term_contains_ansi(S),!. + +wqs1(C):- \+ compound(C),!,wqs0(C). +wqs1(S):- term_is_ansi(S), !, write_keeping_ansi_mb(S). + +wqs1(format(C,N)):- catch((sformat(S,C,N),color_write(S)),_,fail),!. +wqs1(writef(C,N)):- !, writef(C,N). +wqs1(q(C)):- \+ arg_string(C),wots_hs(S,writeq(C)),color_write(S),!. +wqs1(g(C)):- \+ arg_string(C),wots_vs(S,bold_print(wqs1(C))),print(g(S)),!. +wqs1(print_ss(C)):- \+ arg_string(C), wots_vs(S,print_ss(C)),wqs1(print_ss(S)),!. +wqs1(b(C)):- \+ arg_string(C), wots_vs(S,bold_print(wqs1(C))),color_write(S). +wqs1(T):- \+ is_list(T), term_contains_ansi(T),!,write_keeping_ansi_mb(T). +wqs1(norm(C)):- writeq(norm(C)),!. +wqs1(grid_rep(norm,C)):- writeq(grid_rep(norm,C)),!. +wqs1(grid(C)):- writeq(grid(C)),!. +wqs1(rhs(RHS)):- nl_now,wqnl(rhs(RHS)),nl_now. +%wqs1(grid_ops(norm,C)):- writeq(norm(C)),!. +%norm_grid + +wqs1(pp(P)):- wots_vs(S,pp_no_nl(P)),write((S)). +wqs1(ppt(P)):- wots_vs(S,ppt_no_nl(P)),write((S)). +wqs1(wqs(P)):- wots_vs(S,wqs(P)),write((S)). +wqs1(wqs(C,P)):- wots_vs(S,wqs(P)),color_print(C,S). + +wqs1(vals(C)):- writeq(vals(C)),!. +%wqs1(colors_cc(C)):- \+ arg_string(C), as_arg_str(C,S),wqs(colorsz(S)). +wqs1(io(C)):- \+ arg_string(C),wots_vs(S,bold_print(wqs(C))),write(io(S)). + +wqs1(uc(C,W)):- !, write_nbsp, color_print(C,call(underline_print(format("\t~@",[wqs(W)])))). +wqs1(cc(C,N)):- is_color(C),!,color_print(C,call(writeq(cc(C,N)))). +wqs1(write_nav_cmd(C,N)):- !, write_nav_cmd(C,N). + +wqs1(-(C,N)):- is_color(C),!,color_print(C,call(writeq(C))), write('-'), wqs(N). +wqs1(cc(C,N)):- N\==0,attvar(C), get_attrs(C,PC), !, wqs(ccc(PC,N)). +wqs1(cc(C,N)):- N\==0,var(C), sformat(PC,"~p",[C]), !, wqs(ccc(PC,N)). +wqs1(cc(C,N)):- \+ arg_string(C), wots_hs(S,color_print(C,C)), wqs(cc(S,N)). +wqs1(color_print(C,X)):- is_color(C), !, write_nbsp, color_print(C,X). +wqs1(color_print(C,X)):- \+ plain_var(C), !, write_nbsp, color_print(C,X). +wqs1(X):- into_f_arg1(X,_,Arg),is_gridoid(Arg),area_or_len(Arg,Area),Area<5,writeq(X),!. +% wqs1(C):- callable(C), is_wqs(C),wots_vs(S,catch(C,_,fail)),write((S)). +wqs1(X):- is_gridoid_arg1(X), print_gridoid_arg1(X). + +into_f_arg1(X,F,Arg):- compound(X), compound_name_arguments(X,F,[Arg]), compound(Arg). + +is_gridoid_arg1(X):- into_f_arg1(X,_F,Arg),is_gridoid(Arg). +print_gridoid_arg1(X):- into_f_arg1(X,F,Arg),print_gridoid_arg1(F,Arg). + +print_gridoid_arg1(F,Arg):- \+ wants_html,!, wots_vs(VS,wqs(Arg)), writeq(F),write('(`'),!, print_with_pad(write(VS)),write('`)'). +print_gridoid_arg1(F,Arg):- wots_vs(VS,wqs(Arg)), + with_tag_style(span,"display: inline; white-space: nowrap",(writeq(F),write('({'),!,write(VS),write('})'))). + + +nl_needed(N):- line_position(current_output,L1),L1>=N. + +nl_now :- wants_html,!,nl_if_needed_ansi. +nl_now :- nl. + +ansi_in_pre:- current_predicate(in_pre/0),in_pre. +nl_if_needed :- ansi_main,!, format('~N'). +nl_if_needed :- ansi_in_pre,ignore((nl_needed(11),write('
'))),!. +nl_if_needed :- wants_html,!,ignore((nl_needed(11),write('
\n'))). +nl_if_needed :- format('~N'). +nl_if_needed_ansi :- \+ ansi_main, wants_html,!. +nl_if_needed_ansi :- nl_if_needed. + +write_nbsp:- ansi_main,!,write(' '). +write_nbsp:- wants_html,!,write(' '). +write_nbsp:- write(' '). + +is_breaker(P):- compound(P),functor(P,_,A), A>=3. + +last_f(H,F):- \+ compound(H),data_type(H,F). +last_f(H,F/A):- compound(H),!,functor(H,F,A). + +need_nl(_,_):- line_position(current_output,L1),L1<40,!. +need_nl(_,_):- line_position(current_output,L1),L1>160,!,nl_if_needed. +need_nl(H0,[H1,H2|_]):- H1\=cc(_,_), last_f(H0,F0),last_f(H1,F1),last_f(H2,F2), F0\==F1, F1==F2,!,format('~N '). +%need_nl(H0,[H1|_]):- last_f(H0,F0),last_f(H1,F1), F0==F1, !, write_nbsp. +need_nl(_,_). +/* +need_nl(_Last,[H|_]):- last_f(H,F), + once(nb_current(last_h,cc(LF,C));(LF=F,C=0)), + (LF==F-> (write_nbsp, plus(C,1,CC), nb_setval(last_h,cc(F,CC))) ; ((C>2 -> nl_now ; write_nbsp), nb_setval(last_h,cc(F,0)))). + +need_nl(_,_):- wants_html,!,write_nbsp. +%need_nl(_,_):- !,write_nbsp. +need_nl(H,[P|_]):- \+ is_breaker(H),is_breaker(P),line_position(user_output,L1),L1>80,nl_now,bformatc1('\t\t'). +need_nl(_,_):- line_position(user_output,L1),L1>160,nl_now,bformatc1('\t\t'). +need_nl(_,_). +*/ + +dash_chars:- wants_html,!,section_break. +dash_chars:- dash_chars(40),!. + +dash_chars(_):- wants_html,!,section_break. +dash_chars(H):- integer(H), dash_border(H). +dash_chars(S):- nl_if_needed,dash_chars(60,S),nl_if_needed_ansi. +dash_chars(_,_):- wants_html,!,section_break. +dash_chars(H,_):- H < 1,!. +dash_chars(H,C):- forall(between(0,H,_),bformatc1(C)). + +%section_break:- wants_html,!,write('

'). +section_break. +%dash_uborder_no_nl_1:- line_position(current_output,0),!, bformatc1('\u00AF\u00AF\u00AF '). +%dash_uborder_no_nl_1:- line_position(current_output,W),W==1,!, bformatc1('\u00AF\u00AF\u00AF '). +dash_uborder_no_nl_1:- bformatc1('\u00AF\u00AF\u00AF '). +dash_uborder_no_nl_1:- uborder(Short,Long),!, bformatc1(Short),bformatc1(Long),write_nbsp. +dash_uborder_no_nl(1):- !, dash_uborder_no_nl_1. +dash_uborder_no_nl(Width):- WidthM1 is Width-1, uborder(Short,Long),write_nbsp, write(Short),dash_chars(WidthM1,Long),!. +dash_uborder_no_nl(Width):- WidthM1 is Width-1, write_nbsp, bformat('\u00AF'),dash_chars(WidthM1,'\u00AF\u00AF'),!. +dash_uborder_no_nl(Width):- nl_if_needed, WidthM1 is Width-1, bformatc1(' \u00AF'),dash_chars(WidthM1,'\u00AF\u00AF'). + +dash_uborder(Width):- nl_if_needed,dash_uborder_no_nl(Width),nl_now. + +uborder('-','--'):- stream_property(current_output,encoding(utf8)),!. +uborder('\u00AF','\u00AF\u00AF'):- !. %stream_property(current_output,encoding(text)). +%uborder('-','--'). + +dash_border_no_nl_1:- line_position(current_output,0),!, bformatc1(' ___ '). +dash_border_no_nl_1:- line_position(current_output,W),W==1,!, bformatc1('___ '). +dash_border_no_nl_1:- bformatc1(' ___ '). + +%dash_border_no_nl(Width):- write(''),dash_chars(Width,'_'),write_nbsp,!. + +dash_border_no_nl(Width):- nl_if_needed, WidthM1 is Width-1, bformatc1(' _'),dash_chars(WidthM1,'__'). + +dash_border(Width):- !, dash_border_no_nl(Width),nl_now,!. + +functor_test_color(pass,green). +functor_test_color(fail,red). +functor_test_color(warn,yellow). + +arcdbg(G):- is_vm_map(G), !, write_map(G,'arcdbg'). +arcdbg(G):- compound(G), compound_name_arity(G,F,_),functor_test_color(F,C), + wots_hs(S,print(G)),color_print(C,S),!,nl_if_needed_ansi. +arcdbg(G):- u_dmsg(G). + + +%user:portray(Grid):- ((\+ tracing, is_group(Grid),print_grid(Grid))). +%user:portray(Grid):- quietlyd((is_object(Grid),print_grid(Grid))). +n_times(N,Goal):- forall(between(1,N,_),ignore(Goal)). +banner_lines(Color):- banner_lines(Color,1). +banner_lines(Color,N):- wants_html,!,format('\n
\n',[N,Color]),!. +banner_lines(Color,N):- + must_det_ll((nl_if_needed, + n_times(N,color_print(Color,'-------------------------------------------------')),nl_now, + n_times(N,color_print(Color,'=================================================')),nl_now, + n_times(N,color_print(Color,'-------------------------------------------------')),nl_now, + n_times(N,color_print(Color,'=================================================')),nl_now, + n_times(N,color_print(Color,'-------------------------------------------------')),nl_now)),!. + +print_sso(A):- ( \+ compound(A) ; \+ (sub_term(E,A), is_gridoid(E))),!, u_dmsg(print_sso(A)),!. +print_sso(A):- grid_footer(A,G,W),writeln(print_sso(W)), print_grid(W,G),!. +print_sso(A):- must_det_ll(( nl_if_needed, into_ss_string(A,SS),!, + SS = ss(L,Lst), + writeln(print_sso(l(L))), + forall(member(S,Lst),writeln(S)),nl_if_needed)),!. + +var_or_number(V):- var(V),!. +var_or_number(V):- integer(V),!. + + +find_longest_len(SL,L):- find_longest_len(SL,10,L),!. +find_longest_len([],L,L). +find_longest_len([S|SS],N,L):- print_length(S,N2),max_min(N,N2,NM,_), + find_longest_len(SS,NM,L). + +:- meta_predicate( print_with_pad(0)). +:- export( print_with_pad/1). +/*print_with_pad(Goal):- + + (line_position(current_output,O);O=0),!, + O1 is O+1, + call_w_pad(O1,Goal). +*/ +print_with_pad(Goal):-(line_position(current_output,O);O=0),!, O1 is O+1,wots(S,Goal),print_w_pad(O1,S). + + +into_s(Text,S):- notrace(catch(text_to_string(Text,S),_,fail)),!. +into_s(Obj,S):- wots_hs(S,pp(Obj)),!. + +print_w_pad(Pad,Text):- into_s(Text,S), atomics_to_string(L,'\n',S)-> my_maplist(print_w_pad0(Pad),L). +print_w_pad0(Pad,S):- nl_if_needed,dash_chars(Pad,' '), write(S). + + +:- meta_predicate(call_w_pad_prev(+,0)). +call_w_pad_prev(Pad,Goal):- wots_hs(S,Goal), print_w_pad(Pad,S). + +%call_w_pad(N,Goal):- wants_html,!,format('',[N]),call_cleanup(call(Goal),write('')). +:- meta_predicate(call_w_pad(+,0)). +call_w_pad(_N,Goal):- wants_html,!,format('',[]),call_cleanup(call(Goal),write('')). +call_w_pad(N,Goal):- nl_if_needed,wots_hs(S,dash_chars(N,' ')),!,pre_pend_each_line(S,Goal). +maybe_print_pre_pended(Out,Pre,S):- atomics_to_string(L,'\n',S), maybe_print_pre_pended_L(Out,Pre,L). +maybe_print_pre_pended_L(Out,_,[L]):- write(Out,L),!,flush_output(Out). +maybe_print_pre_pended_L(Out,Pre,[H|L]):- write(Out,H),nl(Out),!,write(Out,Pre),maybe_print_pre_pended_L(Out,Pre,L). + +%pre_pend_each_line(_,Goal):- !,ignore(Goal). +:- meta_predicate(pre_pend_each_line(+,0)). +pre_pend_each_line(Pre,Goal):- write(Pre),pre_pend_each_line0(Pre,Goal). +pre_pend_each_line0(Pre,Goal):- + current_output(Out), + current_predicate(predicate_streams:new_predicate_output_stream/2),!, + call(call,predicate_streams:new_predicate_output_stream([Data]>>maybe_print_pre_pended(Out,Pre,Data),Stream)), + arc_set_stream(Stream,tty(true)), + %arc_set_stream(Stream,buffer(false)), + %undo(ignore(catch(close(Stream),_,true))),!, + setup_call_cleanup(true, + (with_output_to_each(Stream,once(Goal)),flush_output(Stream)), + ignore(catch(close(Stream),_,true))),!. +pre_pend_each_line0(Pre,Goal):- + with_output_to_each(string(Str),Goal)*->once((maybe_print_pre_pended(current_output,Pre,Str),nl_if_needed)). + + + +end_of_file. + + + +run_source_code(ShareVars, SourceCode, Vs, QQ):- + QQ = source_buffer(SourceCode,Vs),!, + %print(term=Sourcecode -> vs=Vs), + maplist(share_vars(Vs),ShareVars), + (\+ is_list(SourceCode) + -> mort(SourceCode) + ; maplist(mort,SourceCode)). + +run_source_code(ShareVars, Vs, QQ):- + QQ = source_buffer(SourceCode,Vs),!, + %print(term=Sourcecode -> vs=Vs), + maplist(share_vars(Vs),ShareVars), + (\+ is_list(SourceCode) + -> mort(SourceCode) + ; maplist(mort,SourceCode)). + + +%vars_to_dictation([_=Value|Gotten],TIn,TOut):- is_vm_map(Value),!, vars_to_dictation(Gotten,TIn,TOut). + +vars_to_dictation([Name=Value|Gotten],TIn,TOut):- !, + my_assertion(atom(Name)), + vars_to_dictation(Gotten,TIn,TMid), + to_prop_name(Name,UName), + tio_tersify(Value,ValueT),!, + put_dict(UName,TMid,ValueT,TOut). + +vars_to_dictation([NameValue|Gotten],TIn,TOut):- !, + vars_to_dictation(Gotten,TIn,TMid), + to_prop_name(NameValue,UName), + tio_tersify(NameValue,ValueT),!, + put_dict(UName,TMid,ValueT,TOut). + +vars_to_dictation([NameValue|Gotten],TIn,TOut):- compound(NameValue),compound_name_arguments(NameValue,Name,Value),!, + vars_to_dictation([Name=Value|Gotten],TIn,TOut). + +vars_to_dictation([],T,T). + +tio_tersify(Value,ValueT):- is_grid(Value),!,ValueT=_. +tio_tersify(Value,Value). +:- export(copy_qq_//1). + +copy_qq_([]) --> []. +copy_qq_([C|Cs]) --> [C], copy_qq_(Cs). + +:- export(copy_qq//1). +muarc:copy_qq(A) --> copy_qq_(Cs), {atom_codes(A, Cs)}. + +to_prop_name(Name=_,UName):- nonvar(Name),!,to_prop_name(Name,UName). +to_prop_name(Name,UName):- compound(Name),compound_name_arity(Name,F,_),!,to_prop_name(F,UName). +to_prop_name(Name,UName):- to_case_breaks(Name,Breaks),xtis_to_atomic(Breaks,UName). + +xtis_to_atomic([xti(Str,upper),xti(StrL,lower)|Breaks],StrO):- string_upper(Str,Str), + symbol_chars(Str,CharsList),append(Left,[U],CharsList), + name(S1,Left),symbolic_list_concat([S1,'_',U,StrL],'',StrUL),!, + xtis_to_atomic([xti(StrUL,lower)|Breaks],StrO). +xtis_to_atomic([],''). +xtis_to_atomic([xti(Str,_)],Lower):- downcase_atom(Str,Lower). +xtis_to_atomic([XTI|Breaks],Atomic):- + xtis_to_atomic([XTI],S1),xtis_to_atomic(Breaks,S2),!,symbolic_list_concat([S1,S2],'_',Atomic). + +share_vars(Vs,Name=Value):- member(VName=VValue,Vs),VName==Name,!,(Value=VValue->true;trace_or_throw(cant(share_vars(Vs,Name=Value)))). +share_vars(_,Name=_):- string_concat('_',_,Name),!. % Hide some vars +share_vars(V,Name=Value):- fbug(missing(share_vars(V,Name=Value))),!. + + + +parse_expansions(_,Vs,Vs,Src,Src):- \+ compound(Src),!. +parse_expansions(_,Vs0,Vs,dont_include(Var),nop(dont_include(Var))):- + dont_include_var(Vs0,Vs,Var),!. +parse_expansions(F, Vs0,Vs,[Src0|Sourcecode0],[Src|Sourcecode]):- !, + parse_expansions(F, Vs0, Vs1, Src0, Src), + parse_expansions(F, Vs1, Vs, Sourcecode0, Sourcecode). +parse_expansions(FF, Vs0, Vs, Cmpd0, Cmpd):- + compound_name_arguments(Cmpd0,F,Args0), + parse_expansions([F|FF], Vs0, Vs, Args0,Args), + compound_name_arguments(Cmpd,F,Args). + +dont_include_var(Vs0,Vs,Var):- select(_=VV,Vs0,Vs),VV==Var,!. +dont_include_var(Vs,Vs,_). + +append_sets(Sets,Set):- append(Sets,List),list_to_set(List,Set). +append_sets(Set1,Set2,Set):- append(Set1,Set2,List),list_to_set(List,Set). +flatten_sets(Sets,Set):- flatten(Sets,List),list_to_set(List,Set). + +print_prop_val(N=V):- to_prop_name(N,P),format('~N\t\t'),print(P=V),nl. + + +ignore_numvars(Name='$VAR'(Name)). + + diff --git a/.Attic/canary_docme/swi_support.pl b/.Attic/canary_docme/swi_support.pl new file mode 100644 index 00000000000..2fdf60dc0e1 --- /dev/null +++ b/.Attic/canary_docme/swi_support.pl @@ -0,0 +1,190 @@ + +:- set_prolog_flag(verbose_autoload, false). +:- set_prolog_flag(verbose, silent). +:- set_prolog_flag(verbose_load, silent). +:- assert((user:'$exported_op'(_,_,_):- fail)). +:- abolish((system:'$exported_op'/3)). +:- assert((system:'$exported_op'(_,_,_):- fail)). + +fbug(_):- is_compatio,!. +fbug(P) :- format("~N"), current_predicate(write_src/1), + with_output_to(user_error,in_cmt(write_src(P))),!. +fbug(N=V) :- nonvar(N), !, fbdebug1(N:-V). +fbug(V) :- compound(V),functor(V,F,_A),!,fbdebug1(F:-V). +fbug(V) :- fbdebug1(debug:-V). +fbdebug1(Message) :- + % ISO Standard: flush_output/1 + flush_output(user_output), + flush_output(user_error), + catch(portray_clause(user_error,Message,[]),_,catch_ignore(format(user_error, "~n/* ~q. */~n", [Message]))), + %format(user_error, "~n/* ~p. */~n", [Message]), + flush_output(user_error). + + +swi_only(_):- is_scryer,!,fail. +swi_only(G):- call(G). +is_scryer:- \+ current_prolog_flag(libswipl,_). + + +:- create_prolog_flag(max_per_file,inf,[keep(true),access(read_write),type(term)]). +:- create_prolog_flag(max_disk_cache,inf,[keep(true),access(read_write),type(term)]). +:- create_prolog_flag(samples_per_million,inf,[keep(true),access(read_write),type(term)]). + +with_cwd(Dir,Goal):- Dir == '.',!,setup_call_cleanup(working_directory(X, X), Goal, + working_directory(_,X)). +with_cwd(Dir,Goal):- var(Dir),X=Dir,!,setup_call_cleanup(working_directory(X, X), Goal, + working_directory(_,X)). + +with_cwd(Dir,Goal):- \+ exists_directory(Dir),!,throw(with_cwd(Dir,Goal)),!. +with_cwd(Dir,Goal):- setup_call_cleanup(working_directory(X, Dir), Goal, working_directory(_,X)). + +with_option([],G):-!,call(G). +with_option([H|T],G):- !, with_option(H,with_option(T,G)). +with_option(N=V,G):-!, with_option(N,V,G). +with_option(NV,G):- compound(NV), NV =..[N,V],!,with_option(N,V,G). +with_option(N,G):- with_option(N,true,G). + +with_option(N,V,G):- (was_option_value(N,W)->true;W=[]), + setup_call_cleanup(set_option_value(N,V),G, set_option_value(N,W)). + + +was_option_value(N,V):- current_prolog_flag(N,VV),!,V=VV. +was_option_value(N,V):- prolog_load_context(N,VV),!,V=VV. +was_option_value(N,V):- nb_current(N,VV), VV\==[],!,V=VV. + +option_else(N,V,Else):- notrace((option_else0(N,VV,Else),p2mE(VV,V))). +option_else0( N,V,_Else):- was_option_value(N,VV),!,VV=V. +option_else0(_N,V, Else):- !,V=Else. + +%option_value( N,V):- var(V), !, notrace(once(((option_value0(N,V))))). +option_value(N,V):- var(V), !, was_option_value( N,VV), once((p2mE(VV,V2),p2mE(V,V1))), V1=V2. +option_value(N,V):- V==true,option_value0(N,'True'),!. +option_value(N,V):- V==false,option_value0(N,'False'),!. +option_value(N,V):- notrace(option_value0(N,V)). + + +option_value0( N,V):- was_option_value( N,VV), once((p2mE(VV,V2),p2mE(V,V1))), V1=V2. +option_value0(_N,[]). + +p2mE(NA,NA):- \+ atom(NA),!. +p2mE(false,'False'). +p2mE(true,'True'). +p2mE(E,E). +set_option_value(N,V):- + set_option_value0(N,V). +set_option_value0(N,V):- + p2mE(V,VV),!, + catch(nb_setval(N,VV),E,fbug(E)), + p2mE(PV,VV),!, + catch(create_prolog_flag(N,PV,[keep(false),access(read_write), type(term)]),E2,fbug(E2)), + catch(set_prolog_flag(N,PV),E3,fbug(E3)),!. + +kaggle_arc:- \+ exists_directory('/opt/logicmoo_workspace/packs_sys/logicmoo_agi/prolog/kaggle_arc/'), + !. +%kaggle_arc:- !. +kaggle_arc:- + with_option(argv,['--libonly'], + with_cwd('/opt/logicmoo_workspace/packs_sys/logicmoo_agi/prolog/kaggle_arc/', + ensure_loaded(kaggle_arc))). + +%:- ensure_loaded((read_obo2)). + +%:- kaggle_arc. + + +all_upper_symbol(A):-all_upper_atom(A). +any_to_symbol(A,B):-any_to_atom(A,B). +concat_symbol(A,B,C):-concat_atom(A,B,C). +downcase_symbol(A,B):-downcase_atom(A,B). +non_empty_symbol(A):-non_empty_atom(A). +string_to_symbol(A,B):-string_to_atom(A,B). +sub_string_or_symbol(A,B,C,D,E):-sub_string_or_atom(A,B,C,D,E). +sub_symbol(A,B,C,D,E):-sub_atom(A,B,C,D,E). + +symbol(A):- atom(A). +symbol_chars(A,B):- atom_chars(A,B). +symbol_codes(A,B):-atom_codes(A,B). +symbol_concat(A,B,C):- atom_concat(A,B,C). +symbol_contains(A,B):- atom_contains(A,B). +symbol_length(A,B):- atom_length(A,B). +symbol_number(A,B):- atom_number(A,B). +symbol_string(A,B):- atom_string(A,B). +symbol_upper(A,B):- upcase_atom(A,B). +symbolic(A):-atomic(A). +symbolic_concat(A,B,C):-atomic_concat(A,B,C). +symbolic_concat(A,B,C,D):-atomic_concat(A,B,C,D). +symbolic_list_concat(A,B):-atomic_list_concat(A,B). +symbolic_list_concat(A,B,C):- atomic_list_concat(A,B,C). +symbolic_to_string(A,B):-atomic_to_string(A,B). +symbolics_to_string(A,B):-atomics_to_string(A,B). +symbolics_to_string(A,B,C):-atomics_to_string(A,B,C). +upcase_symbol(A,B):-upcase_atom(A,B). +:- prolog_load_context(directory, File), + ignore(( + absolute_file_name('../../data/ftp.flybase.org/releases/current/',Dir,[relative_to(File), + file_type(directory), file_errors(fail)]), + asserta(ftp_data(Dir)))). + +:- prolog_load_context(file, File), + absolute_file_name('./',Dir,[relative_to(File),file_type(directory)]), + asserta(pyswip_dir(Dir)). + + +:- prolog_load_context(directory, Dir), + asserta(user:library_directory(Dir)), + asserta(pyswip_metta_dir(Dir)). + +metta_python:- ensure_loaded(library(metta_python)). +:- if( (fail, \+ current_predicate(must_det_ll/1))). +% Calls the given Goal and throws an exception if Goal fails. +% Usage: must_det_ll(+Goal). +must_det_ll(M:Goal) :- !, must_det_ll(M,Goal). +must_det_ll(Goal) :- must_det_ll(user,Goal). + +must_det_ll(_M,Goal) :- var(Goal),!,throw(var_must_det_ll(Goal)),!. +must_det_ll(M,Goal) :- var(M),!,strip_module(Goal,M,NewGoal),!,must_det_ll(M,NewGoal). +must_det_ll(M,(GoalA,GoalB)) :- !, must_det_ll(M,GoalA), must_det_ll(M,GoalB). +must_det_ll(M,(GoalA->GoalB;GoalC)) :- !, (call_ll(M,GoalA)-> must_det_ll(M,GoalB) ; must_det_ll(M,GoalC)). +must_det_ll(M,(GoalA*->GoalB;GoalC)) :- !, (call_ll(M,GoalA)*-> must_det_ll(M,GoalB) ; must_det_ll(M,GoalC)). +must_det_ll(M,(GoalA->GoalB)) :- !, (call_ll(M,GoalA)-> must_det_ll(M,GoalB)). +must_det_ll(_,M:Goal) :- !, must_det_ll(M,Goal). +must_det_ll(M,Goal) :- + % Call Goal, succeed with true if Goal succeeds. + M:call(Goal) -> true ; % If Goal fails, throw an exception indicating that Goal failed. + throw(failed(Goal)). + +call_ll(_M,Goal):- var(Goal),!,throw(var_call_ll(Goal)),!. +call_ll(M,Goal):- var(M),!,strip_module(Goal,M,NewGoal),!,call_ll(M,NewGoal). +call_ll(M,Goal):- M:call(Goal). + +:- endif. + + +:- if( \+ current_predicate(if_t/2)). +if_t(If,Then):- call(If)->call(Then);true. +:-endif. + +:- if( \+ current_predicate(atom_contains/2)). +atom_contains(Atom1, SubAtom) :- sub_atom(Atom1, _Before, _, _After, SubAtom). +:- endif. + +:- if( \+ current_predicate(nop/1)). +nop(_). +:- endif. + +:- if( \+ current_predicate(catch_ignore/1)). +catch_ignore(G):- ignore(catch(G,E,catch_i((nl,writeq(causes(G,E)),nl)))). +:- endif. + +:- if( \+ current_predicate(catch_i/1)). +catch_i(G):- ignore(catch(G,_,true)). +:- endif. + +:- if( \+ current_predicate(add_history1/1)). +add_history1(_). +:- endif. + +:- if( \+ current_predicate(add_history/1)). +add_history(_). +:- endif. + diff --git a/.Attic/metta_lang/metta_compiler.pl b/.Attic/metta_lang/metta_compiler.pl index 6abf1abb17a..7dbc7fbe31d 100755 --- a/.Attic/metta_lang/metta_compiler.pl +++ b/.Attic/metta_lang/metta_compiler.pl @@ -794,7 +794,6 @@ % % Example: % funct_with_result_is_nth_of_pred(HeadIs,+(1, 2), Result, 3, +(1, 2, Result)). - into_callable(Pred,AsPred):- is_ftVar(Pred),!,AsPred=holds(Pred). into_callable(Pred,AsPred):- Pred=AsPred,!. into_callable(Pred,AsPred):- iz_conz(Pred), !,AsPred=holds(Pred). diff --git a/.Attic/metta_lang/metta_corelib.pl b/.Attic/metta_lang/metta_corelib.pl deleted file mode 100755 index ed84feb9108..00000000000 --- a/.Attic/metta_lang/metta_corelib.pl +++ /dev/null @@ -1,299 +0,0 @@ -/* - * Project: MeTTaLog - A MeTTa to Prolog Transpiler/Interpreter - * Description: This file is part of the source code for a transpiler designed to convert - * MeTTa language programs into Prolog, utilizing the SWI-Prolog compiler for - * optimizing and transforming function/logic programs. It handles different - * logical constructs and performs conversions between functions and predicates. - * - * Author: Douglas R. Miles - * Contact: logicmoo@gmail.com / dmiles@logicmoo.org - * License: LGPL - * Repository: https://github.com/trueagi-io/metta-wam - * https://github.com/logicmoo/hyperon-wam - * Created Date: 8/23/2023 - * Last Modified: $LastChangedDate$ # You will replace this with Git automation - * - * Usage: This file is a part of the transpiler that transforms MeTTa programs into Prolog. For details - * on how to contribute or use this project, please refer to the repository README or the project documentation. - * - * Contribution: Contributions are welcome! For contributing guidelines, please check the CONTRIBUTING.md - * file in the repository. - */ - -:- discontiguous metta_atom_corelib_types/1. - -:- dynamic(using_corelib_file/0). - - -metta_atom_corelib_defn( [=, ['car-atom', A], [eval, ['if-decons', A, B, _, B, ['Error', ['car-atom', A], "car-atom expects a non-empty expression as an argument"]]]]). -metta_atom_corelib_defn( [=, ['cdr-atom', A], [eval, ['if-decons', A, _, B, B, ['Error', ['cdr-atom', A], "cdr-atom expects a non-empty expression as an argument"]]]]). -metta_atom_corelib_defn( [=, ['filter-atom', A, B, C], [function, [eval, ['if-decons', A, D, E, [chain, [eval, ['filter-atom', E, B, C]], F, [chain, [eval, [apply, D, B, C]], G, [chain, G, H, [eval, [if, H, [chain, [cons, D, F], I, [return, I]], [return, F]]]]]], [return, []]]]]]). -metta_atom_corelib_defn( [=, ['foldl-atom', A, B, C, D, E], [function, [eval, ['if-decons', A, F, G, [chain, [eval, [apply, B, C, E]], H, [chain, [eval, [apply, F, D, H]], I, [chain, I, J, [chain, [eval, ['foldl-atom', G, J, C, D, E]], K, [return, K]]]]], [return, B]]]]]). -metta_atom_corelib_defn( [=, ['if-decons', A, B, C, D, E], [eval, ['if-non-empty-expression', A, [chain, [decons, A], F, [match, F, [B, C], D, E]], E]]]). -metta_atom_corelib_defn( [=, ['if-decons', A, B, C, D, E], [function, [eval, ['if-non-empty-expression', A, [chain, [decons, A], F, [unify, F, [B, C], [return, D], [return, E]]], [return, E]]]]]). -metta_atom_corelib_defn( [=, ['if-empty', A, B, C], [eval, ['if-equal', A, 'Empty', B, C]]]). -metta_atom_corelib_defn( [=, ['if-empty', A, B, C], [function, [eval, ['if-equal', A, 'Empty', [return, B], [return, C]]]]]). -metta_atom_corelib_defn( [=, ['if-error', A, B, C], [eval, ['if-decons', A, D, _, [eval, ['if-equal', D, 'Error', B, C]], C]]]). -metta_atom_corelib_defn( [=, ['if-error', A, B, C], [function, [eval, ['if-decons', A, D, _, [eval, ['if-equal', D, 'Error', [return, B], [return, C]]], [return, C]]]]]). -metta_atom_corelib_defn( [=, ['if-non-empty-expression', A, B, C], [chain, [eval, ['get-metatype', A]], D, [eval, ['if-equal', D, 'Expression', [eval, ['if-equal', A, [], C, B]], C]]]]). -metta_atom_corelib_defn( [=, ['if-non-empty-expression', A, B, C], [function, [chain, [eval, ['get-metatype', A]], D, [eval, ['if-equal', D, 'Expression', [eval, ['if-equal', A, [], [return, C], [return, B]]], [return, C]]]]]]). -metta_atom_corelib_defn( [=, ['if-not-reducible', A, B, C], [function, [eval, ['if-equal', A, 'NotReducible', [return, B], [return, C]]]]]). -metta_atom_corelib_defn( [=, ['interpret-args', A, B, C, D, E], [function, [unify, B, [], [eval, ['if-decons', C, F, _, [eval, ['match-types', F, D, [return, []], [return, ['Error', A, 'BadType']]]], [return, ['Error', ['interpret-args', A, B, C, D, E], "interpret-args expects a non-empty value for $arg-types argument"]]]], [eval, ['if-decons', B, G, H, [eval, ['if-decons', C, I, J, [chain, [eval, [interpret, G, I, E]], K, [eval, ['if-equal', K, G, [chain, [eval, ['interpret-args-tail', A, K, H, J, D, E]], L, [return, L]], [eval, ['return-on-error', K, [chain, [eval, ['interpret-args-tail', A, K, H, J, D, E]], L, [return, L]]]]]]], [return, ['Error', A, 'BadType']]]], [return, ['Error', ['interpret-atom', A, B, C, E], "Non-empty expression atom is expected"]]]]]]]). -metta_atom_corelib_defn( [=, ['interpret-args', A, B, C, D], [match, B, [], [match, C, [_], [], ['Error', A, 'BadType']], [eval, ['if-decons', B, E, F, [eval, ['if-decons', C, G, H, [chain, [eval, [interpret, E, G, D]], I, [eval, ['if-equal', I, E, [eval, ['interpret-args-tail', A, I, F, H, D]], [eval, ['return-on-error', I, [eval, ['interpret-args-tail', A, I, F, H, D]]]]]]], ['Error', A, 'BadType']]], ['Error', ['interpret-atom', A, B, C, D], "Non-empty expression atom is expected"]]]]]). -metta_atom_corelib_defn( [=, ['interpret-args-tail', A, B, C, D, E, F], [function, [chain, [eval, ['interpret-args', A, C, D, E, F]], G, [eval, ['return-on-error', G, [chain, [cons, B, G], H, [return, H]]]]]]]). -metta_atom_corelib_defn( [=, ['interpret-args-tail', A, B, C, D, E], [chain, [eval, ['interpret-args', A, C, D, E]], F, [eval, ['return-on-error', F, [cons, B, F]]]]]). -metta_atom_corelib_defn( [=, ['interpret-expression', A, B, C], [eval, ['if-decons', A, D, _, [chain, [eval, ['get-type', D, C]], E, [chain, [eval, ['is-function', E]], F, [match, F, 'True', [chain, [eval, ['interpret-func', A, E, C]], G, [eval, [call, G, B, C]]], [chain, [eval, ['interpret-tuple', A, C]], G, [eval, [call, G, B, C]]]]]], [eval, ['type-cast', A, B, C]]]]]). -metta_atom_corelib_defn( [=, ['interpret-expression', A, B, C], [function, [eval, ['if-decons', A, D, _, [chain, [eval, ['get-type', D, C]], E, [chain, [eval, ['is-function', E]], F, [unify, F, 'True', [chain, [eval, ['interpret-func', A, E, B, C]], G, [chain, [eval, ['metta-call', G, B, C]], H, [return, H]]], [chain, [eval, ['interpret-tuple', A, C]], G, [chain, [eval, ['metta-call', G, B, C]], H, [return, H]]]]]], [chain, [eval, ['type-cast', A, B, C]], H, [return, H]]]]]]). -metta_atom_corelib_defn( [=, ['interpret-func', A, B, C, D], [function, [eval, ['if-decons', A, E, F, [chain, [eval, [interpret, E, B, D]], G, [eval, ['return-on-error', G, [eval, ['if-decons', B, _, H, [chain, [eval, ['interpret-args', A, F, H, C, D]], I, [eval, ['return-on-error', I, [chain, [cons, G, I], J, [return, J]]]]], [return, ['Error', B, "Function type expected"]]]]]]], [return, ['Error', A, "Non-empty expression atom is expected"]]]]]]). -metta_atom_corelib_defn( [=, ['interpret-func', A, B, C], [eval, ['if-decons', A, D, E, [chain, [eval, [interpret, D, B, C]], F, [eval, ['return-on-error', F, [eval, ['if-decons', B, _, G, [chain, [eval, ['interpret-args', A, E, G, C]], H, [eval, ['return-on-error', H, [cons, F, H]]]], ['Error', B, "Function type expected"]]]]]], ['Error', A, "Non-empty expression atom is expected"]]]]). -metta_atom_corelib_defn( [=, ['interpret-tuple', A, B], [function, [unify, A, [], [return, A], [eval, ['if-decons', A, C, D, [chain, [eval, [interpret, C, '%Undefined%', B]], E, [eval, ['if-empty', E, [return, 'Empty'], [chain, [eval, ['interpret-tuple', D, B]], F, [eval, ['if-empty', F, [return, 'Empty'], [chain, [cons, E, F], G, [return, G]]]]]]]], [return, ['Error', ['interpret-tuple', A, B], "Non-empty expression atom is expected as an argument"]]]]]]]). -metta_atom_corelib_defn( [=, ['interpret-tuple', A, B], [match, A, [], A, [eval, ['if-decons', A, C, D, [chain, [eval, [interpret, C, '%Undefined%', B]], E, [chain, [eval, ['interpret-tuple', D, B]], F, [cons, E, F]]], ['Error', ['interpret-tuple', A, B], "Non-empty expression atom is expected as an argument"]]]]]). -metta_atom_corelib_defn( [=, ['is-function', A], [chain, [eval, ['get-metatype', A]], B, [eval, [switch, [A, B], [[[_, 'Expression'], [chain, [eval, [car, A]], C, [match, C, ->, 'True', 'False']]], [_, 'False']]]]]]). -metta_atom_corelib_defn( [=, ['is-function', A], [function, [chain, [eval, ['get-metatype', A]], B, [eval, [switch, [A, B], [[[_, 'Expression'], [eval, ['if-decons', A, C, _, [unify, C, ->, [return, 'True'], [return, 'False']], [return, ['Error', ['is-function', A], "is-function non-empty expression as an argument"]]]]], [_, [return, 'False']]]]]]]]). -metta_atom_corelib_defn( [=, ['let*', A, B], [eval, ['if-decons', A, [C, D], E, [let, C, D, ['let*', E, B]], B]]]). -metta_atom_corelib_defn( [=, ['map-atom', A, B, C], [function, [eval, ['if-decons', A, D, E, [chain, [eval, ['map-atom', E, B, C]], F, [chain, [eval, [apply, D, B, C]], G, [chain, G, H, [chain, [cons, H, F], I, [return, I]]]]], [return, []]]]]]). -metta_atom_corelib_defn( [=, ['match-types', A, B, C, D], [function, [eval, ['if-equal', A, '%Undefined%', [return, C], [eval, ['if-equal', B, '%Undefined%', [return, C], [eval, ['if-equal', A, 'Atom', [return, C], [eval, ['if-equal', B, 'Atom', [return, C], [unify, A, B, [return, C], [return, D]]]]]]]]]]]]). -metta_atom_corelib_defn( [=, ['metta-call', A, B, C], [function, [eval, ['if-error', A, [return, A], [chain, [eval, A], D, [eval, ['if-not-reducible', D, [return, A], [eval, ['if-empty', D, [return, 'Empty'], [eval, ['if-error', D, [return, D], [chain, [eval, [interpret, D, B, C]], E, [return, E]]]]]]]]]]]]]). -metta_atom_corelib_defn( [=, ['return-on-error', A, B], [eval, ['if-empty', A, 'Empty', [eval, ['if-error', A, A, B]]]]]). -metta_atom_corelib_defn( [=, ['return-on-error', A, B], [function, [eval, ['if-empty', A, [return, [return, 'Empty']], [eval, ['if-error', A, [return, [return, A]], [return, B]]]]]]]). -metta_atom_corelib_defn( [=, ['switch-internal', A, [[B, C], D]], [function, [unify, A, B, [return, C], [chain, [eval, [switch, A, D]], E, [return, E]]]]]). -metta_atom_corelib_defn( [=, ['switch-internal', A, [[B, C], D]], [match, A, B, C, [eval, [switch, A, D]]]]). -metta_atom_corelib_defn( [=, ['type-cast', A, B, C], [chain, [eval, ['get-type', A, C]], D, [eval, [switch, [D, B], [[['%Undefined%', _], A], [[_, '%Undefined%'], A], [[B, _], A], [_, ['Error', A, 'BadType']]]]]]]). -metta_atom_corelib_defn( [=, ['type-cast', A, B, C], [function, [chain, [eval, ['get-metatype', A]], D, [eval, ['if-equal', B, D, [return, A], [chain, [eval, ['collapse-get-type', A, C]], E, [chain, [eval, ['foldl-atom', E, 'False', F, G, [chain, [eval, ['match-types', G, B, 'True', 'False']], H, [chain, [eval, [or, F, H]], I, I]]]], J, [eval, [if, J, [return, A], [return, ['Error', A, 'BadType']]]]]]]]]]]). -metta_atom_corelib_defn( [=, [and, 'False', 'False'], 'False']). -metta_atom_corelib_defn( [=, [and, 'False', 'True'], 'False']). -metta_atom_corelib_defn( [=, [and, 'True', 'False'], 'False']). -metta_atom_corelib_defn( [=, [and, 'True', 'True'], 'True']). -metta_atom_corelib_defn( [=, [apply, A, B, C], [function, [chain, [eval, [id, A]], B, [return, C]]]]). -metta_atom_corelib_defn( [=, [call, A, B, C], [chain, [eval, A], D, [eval, ['if-empty', D, A, [eval, ['if-error', D, D, [eval, [interpret, D, B, C]]]]]]]]). -metta_atom_corelib_defn( [=, [car, A], [eval, ['if-decons', A, B, _, B, ['Error', [car, A], "car expects a non-empty expression as an argument"]]]]). -metta_atom_corelib_defn( [=, [id, A], A]). -metta_atom_corelib_defn( [=, [if, 'False', _, A], A]). -metta_atom_corelib_defn( [=, [if, 'True', A, _], A]). -metta_atom_corelib_defn( [=, [interpret, A, B, C], [chain, [eval, ['get-metatype', A]], D, [eval, [switch, [B, D], [[['Atom', _], A], [[D, D], A], [[E, 'Variable'], A], [[E, 'Symbol'], [eval, ['type-cast', A, B, C]]], [[E, 'Grounded'], [eval, ['type-cast', A, B, C]]], [[E, 'Expression'], [eval, ['interpret-expression', A, B, C]]]]]]]]). -metta_atom_corelib_defn( [=, [interpret, A, B, C], [function, [chain, [eval, ['get-metatype', A]], D, [eval, ['if-equal', B, 'Atom', [return, A], [eval, ['if-equal', B, D, [return, A], [eval, [switch, [B, D], [[[E, 'Variable'], [return, A]], [[E, 'Symbol'], [chain, [eval, ['type-cast', A, B, C]], F, [return, F]]], [[E, 'Grounded'], [chain, [eval, ['type-cast', A, B, C]], F, [return, F]]], [[E, 'Expression'], [chain, [eval, ['interpret-expression', A, B, C]], F, [return, F]]]]]]]]]]]]]). -metta_atom_corelib_defn( [=, [let, A, B, C], [unify, B, A, C, 'Empty']]). -metta_atom_corelib_defn( [=, [match, A, B, C], [unify, B, A, C, 'Empty']]). -metta_atom_corelib_defn( [=, [nop, _], []]). -metta_atom_corelib_defn( [=, [nop], []]). -metta_atom_corelib_defn( [=, [or, 'False', 'False'], 'False']). -metta_atom_corelib_defn( [=, [or, 'False', 'True'], 'True']). -metta_atom_corelib_defn( [=, [or, 'True', 'False'], 'True']). -metta_atom_corelib_defn( [=, [or, 'True', 'True'], 'True']). -metta_atom_corelib_defn( [=, [xor, 'False', 'False'], 'False']). -metta_atom_corelib_defn( [=, [xor, 'False', 'True'], 'True']). -metta_atom_corelib_defn( [=, [xor, 'True', 'False'], 'True']). -metta_atom_corelib_defn( [=, [xor, 'True', 'True'], 'False']). -metta_atom_corelib_defn( [=, [quote, _], 'NotReducible']). -metta_atom_corelib_defn( [=, [reduce, A, B, C], [chain, [eval, A], D, [eval, ['if-error', D, D, [eval, ['if-empty', D, [eval, [subst, A, B, C]], [eval, [reduce, D, B, C]]]]]]]]). -metta_atom_corelib_defn( [=, [subst, A, B, C], [match, A, B, C, ['Error', [subst, A, B, C], "subst expects a variable as a second argument"]]]). -metta_atom_corelib_defn( [=, [switch, A, B], [chain, [decons, B], C, [eval, ['switch-internal', A, C]]]]). -metta_atom_corelib_defn( [=, [switch, A, B], [function, [chain, [decons, B], C, [chain, [eval, ['switch-internal', A, C]], D, [chain, [eval, ['if-not-reducible', D, 'Empty', D]], E, [return, E]]]]]]). -metta_atom_corelib_defn( [=, [unquote, [quote, A]], A]). - -is_absorbed_return_type(Params,Var):- var(Var),!, \+ sub_var(Var,Params). -is_absorbed_return_type(_,'Bool'). -is_absorbed_return_type(_,[Ar]):- !, Ar == (->). -is_absorbed_return_type(_,'EmptyType'). -is_absorbed_return_type(_,'ReturnType'). -is_absorbed_return_type(_,X):- is_self_return(X). - -is_self_return('ErrorType'). - -is_non_absorbed_return_type(Params,Var):- - \+ is_absorbed_return_type(Params,Var). - -metta_atom_corelib_types( [:, 'ErrorType', 'Type']). -metta_atom_corelib_types( [:, 'ReturnType', 'Type']). - -metta_atom_corelib_types( [:, 'Error', [->, 'Atom', 'Atom', 'ErrorType']]). - -metta_atom_corelib_types( [:, 'add-atom', [->, 'hyperon::space::DynSpace', 'Atom', [->]]]). -metta_atom_corelib_types( [:, 'car-atom', [->, 'Expression', 'Atom']]). -metta_atom_corelib_types( [:, 'cdr-atom', [->, 'Expression', 'Expression']]). -metta_atom_corelib_types( [:, 'filter-atom', [->, 'Expression', 'Variable', 'Atom', 'Expression']]). -metta_atom_corelib_types( [:, 'foldl-atom', [->, 'Expression', 'Atom', 'Variable', 'Variable', 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, 'get-atoms', [->, 'hyperon::space::DynSpace', 'Atom']]). -metta_atom_corelib_types( [:, 'if-decons', [->, 'Atom', 'Variable', 'Variable', 'Atom', 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, 'if-empty', [->, 'Atom', 'Atom', 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, 'if-error', [->, 'Atom', 'Atom', 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, 'if-non-empty-expression', [->, 'Atom', 'Atom', 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, 'if-not-reducible', [->, 'Atom', 'Atom', 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, 'let*', [->, 'Expression', 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, 'map-atom', [->, 'Expression', 'Variable', 'Atom', 'Expression']]). -metta_atom_corelib_types( [:, 'remove-atom', [->, 'hyperon::space::DynSpace', 'Atom', [->]]]). -metta_atom_corelib_types( [:, 'return-on-error', [->, 'Atom', 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, and, [->, 'Bool', 'Bool', 'Bool']]). -metta_atom_corelib_types( [:, apply, [->, 'Atom', 'Variable', 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, chain, [->, 'Atom', 'Variable', 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, cons, [->, 'Atom', 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, decons, [->, 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, empty, [->, '%Undefined%']]). -metta_atom_corelib_types( [:, eval, [->, 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, function, [->, 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, id, [->, 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, if, [->, 'Bool', 'Atom', 'Atom', _]]). -metta_atom_corelib_types( [:, let, [->, 'Atom', '%Undefined%', 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, match, [->, 'Atom', 'Atom', 'Atom', '%Undefined%']]). -metta_atom_corelib_types( [:, or, [->, 'Bool', 'Bool', 'Bool']]). -metta_atom_corelib_types( [:, xor, [->, 'Bool', 'Bool', 'Bool']]). -metta_atom_corelib_types( [:, quote, [->, 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, return, [->, 'Atom', 'ReturnType']]). -metta_atom_corelib_types( [:, switch, [->, '%Undefined%', 'Expression', 'Atom']]). -metta_atom_corelib_types( [:, unify, [->, 'Atom', 'Atom', 'Atom', 'Atom', '%Undefined%']]). -metta_atom_corelib_types( [:, unify, [->, 'Atom', 'Atom', 'Atom', 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, unquote, [->, '%Undefined%', '%Undefined%']]). -% metta_atom_corelib_types( [:, stringToChars [-> 'Atom' 'Expression']]). -% metta_atom_corelib_types( [:, charsToString [-> 'Expression' 'Atom']]). -% metta_atom_corelib_types( [:, format-args [-> 'Atom' 'Expression' 'Atom']]). - -metta_atom_corelib_types( [:, 'unique', [->, 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, 'subtraction', [->, 'Atom', 'Atom', 'Atom']]). - -metta_atom_corelib_types( [:, 'get-metatype', [->, 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, 'get-type0', [->, 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, 'get-ftype', [->, 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, 'get-type', [->, 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, 'get-type', [->, 'Atom', 'Atom', 'Atom']]). -metta_atom_corelib_types( [:, '==', [->, T, T, 'Bool']]). -metta_atom_corelib_types( [:, ':', '%Undefined%']). - -metta_atom_corelib_types( [:, 'function-arity', [->, 'Symbol', 'Number']]). -metta_atom_corelib_types( [:, 'predicate-arity', [->, 'Symbol', 'Number']]). - - -metta_atom_corelib(X):- metta_atom_corelib_types(X). -metta_atom_corelib(X):- metta_atom_corelib1(X), \+ clause_asserted(metta_atom_corelib_types(X)). -metta_atom_corelib(X):- - metta_atom_corelib2(X), \+ clause_asserted(metta_atom_corelib_types(X)), - \+ clause_asserted(metta_atom_corelib1(X)). - - -op_decl('pragma!', [ 'Atom', 'Atom'], [->]). -op_decl('=', [ 'Atom', 'Atom'], '%Undefined%'). - -op_decl('match', [ 'hyperon::space::DynSpace', 'Atom', 'Atom'], '%Undefined%'). -op_decl('remove-atom', [ 'hyperon::space::DynSpace', 'Atom'], [->]). -op_decl('add-atom', [ 'hyperon::space::DynSpace', 'Atom'], [->]). -op_decl('get-atoms', [ 'hyperon::space::DynSpace' ], 'Atom'). - -op_decl('get-state', [[ 'StateMonad', Type]],Type). -op_decl('change-state!', [[ 'StateMonad',Type],Type],[ 'StateMonad',Type]). -op_decl('new-state', [Type], ['StateMonad',Type ]). - -op_decl('car-atom', [ 'Expression' ], 'Atom'). -op_decl('cdr-atom', [ 'Expression' ], 'Expression'). - -op_decl(let, [ 'Atom', '%Undefined%', 'Atom' ], 'Atom'). -op_decl('let*', [ 'Expression', 'Atom' ], 'Atom'). - -op_decl(and, [ 'Bool', 'Bool' ], 'Bool'). -op_decl(or, [ 'Bool', 'Bool' ], 'Bool'). -op_decl(xor, [ 'Bool', 'Bool' ], 'Bool'). -op_decl(case, [ 'Expression', 'Atom' ], 'Atom'). - -op_decl(apply, [ 'Atom', 'Variable', 'Atom' ], 'Atom'). -op_decl(chain, [ 'Atom', 'Variable', 'Atom' ], 'Atom'). -op_decl('filter-atom', [ 'Expression', 'Variable', 'Atom' ], 'Expression'). -op_decl('foldl-atom', [ 'Expression', 'Atom', 'Variable', 'Variable', 'Atom' ], 'Atom'). -op_decl('map-atom', [ 'Expression', 'Variable', 'Atom' ], 'Expression'). -op_decl(quote, [ 'Atom' ], 'Atom'). -op_decl('if-decons', [ 'Atom', 'Variable', 'Variable', 'Atom', 'Atom' ], 'Atom'). -op_decl('if-empty', [ 'Atom', 'Atom', 'Atom' ], 'Atom'). -op_decl('if-error', [ 'Atom', 'Atom', 'Atom' ], 'Atom'). -op_decl('if-non-empty-expression', [ 'Atom', 'Atom', 'Atom' ], 'Atom'). -op_decl('if-not-reducible', [ 'Atom', 'Atom', 'Atom' ], 'Atom'). -op_decl(return, [ 'Atom' ], 'ReturnType'). -op_decl('return-on-error', [ 'Atom', 'Atom'], 'Atom'). -op_decl(unquote, [ '%Undefined%'], '%Undefined%'). -op_decl(cons, [ 'Atom', 'Atom' ], 'Atom'). -op_decl(decons, [ 'Atom' ], 'Atom'). -op_decl(empty, [], '%Undefined%'). -op_decl('Error', [ 'Atom', 'Atom' ], 'ErrorType'). -op_decl(function, [ 'Atom' ], 'Atom'). -op_decl(id, [ 'Atom' ], 'Atom'). -op_decl(unify, [ 'Atom', 'Atom', 'Atom', 'Atom' ], 'Atom'). - -op_decl(eval, [ 'Atom' ], 'Atom'). -op_decl(unify, [ 'Atom', 'Atom', 'Atom', 'Atom'], '%Undefined%'). -op_decl(if, [ 'Bool', 'Atom', 'Atom'], _T). -op_decl('%', [ 'Number', 'Number' ], 'Number'). -op_decl('*', [ 'Number', 'Number' ], 'Number'). -op_decl('-', [ 'Number', 'Number' ], 'Number'). -op_decl('+', [ 'Number', 'Number' ], 'Number'). -op_decl('<', [ 'Number', 'Number' ], 'Bool'). -op_decl('>', [ 'Number', 'Number' ], 'Bool'). -op_decl('<=', [ 'Number', 'Number' ], 'Bool'). -op_decl('>=', [ 'Number', 'Number' ], 'Bool'). - -op_decl(combine, [ X, X], X). - -op_decl('bind!', ['Symbol','%Undefined%'], [->]). -op_decl('import!', ['hyperon::space::DynSpace','Atom'], [->]). -op_decl('get-type', ['Atom'], 'Type'). - -op_decl(Op,Params,ReturnType):- - (metta_atom_corelib_types([':', Op, [->|List]]); - metta_atom_corelib2([':', Op, [->|List]])), - append(Params,[ReturnType],List), - \+ clause(op_decl(Op,Params,ReturnType),true). - -type_decl('Any'). -type_decl('Atom'). -type_decl('Bool'). -type_decl('ErrorType'). -type_decl('Expression'). -type_decl('Number'). -type_decl('ReturnType'). -type_decl('hyperon::space::DynSpace'). -type_decl('Symbol'). -type_decl('StateMonad'). -type_decl('Type'). -type_decl('%Undefined%'). -type_decl('Variable'). - - -%:- dynamic(get_metta_atom/2). -%:- multifile(asserted_metta/4). -%:- dynamic(asserted_metta/4). -% metta_atom_corelib_types(_):-!,fail. - -metta_atom_corelib1([':', Type, 'Type']):- type_decl(Type). - -metta_atom_corelib1([':', Op, [->|List]]):- - op_decl(Op,Params,ReturnType), append(Params,[ReturnType],List). - -metta_atom_corelib2([=,['If','True',_then],_then]). -metta_atom_corelib2([=,['If','False',_Then],[let,X,0,[let,X,1,X]]]). -metta_atom_corelib2([=,['If',_cond,_then,_else],[if,_cond,_then,_else]]). -metta_atom_corelib2(['PredicateArity','PredicateArity',2]). -metta_atom_corelib2(['PredicateArity',':',2]). -metta_atom_corelib2([=,[':',R,'P1'],['PredicateArity',R,1]]). -metta_atom_corelib2([':',':','SrcPredicate']). -metta_atom_corelib2([':','PredicateArity',[->,'Symbol','Number']]). -metta_atom_corelib2([':','If','SrcFunction']). -metta_atom_corelib2([':','If',[->,'Bool','Atom','Atom','Atom']]). -metta_atom_corelib2([':','If',[->,'Bool','Atom','Atom']]). -% 'If'(_cond, _then, _else, A) ':'- eval_true(_cond) *-> eval(_then, A); eval(_else, A). -% 'If'(_cond, _then, A) ':'- eval_true(_cond), eval(_then, A). - - - -:- dynamic(metta_atom_asserted_deduced/2). -:- multifile(metta_atom_asserted_deduced/2). -metta_atom_asserted_deduced('&corelib', Term):- metta_atom_corelib_types(Term). - -use_corelib_file:- using_corelib_file,!. -use_corelib_file:- asserta(using_corelib_file), fail. -use_corelib_file:- load_corelib_file. -load_corelib_file:- is_metta_src_dir(Dir), really_use_corelib_file(Dir,'corelib.metta'),!. -load_corelib_file:- is_metta_src_dir(Dir), really_use_corelib_file(Dir,'stdlib_mettalog.metta'),!. -% !(import! &corelib "src/canary/stdlib_mettalog.metta") -really_use_corelib_file(Dir,File):- absolute_file_name(File,Filename,[relative_to(Dir)]), - locally(nb_setval(may_use_fast_buffer,t), - locally(nb_setval(suspend_answers,true), - with_output_to(string(_),include_metta_directory_file('&corelib',Dir,Filename)))). - -%:- initialization(use_corelib_file). - - diff --git a/.Attic/metta_lang/metta_data.pl b/.Attic/metta_lang/metta_data.pl deleted file mode 100755 index de0ac7e0ad3..00000000000 --- a/.Attic/metta_lang/metta_data.pl +++ /dev/null @@ -1,55 +0,0 @@ -/* - * Project: MeTTaLog - A MeTTa to Prolog Transpiler/Interpreter - * Description: This file is part of the source code for a transpiler designed to convert - * MeTTa language programs into Prolog, utilizing the SWI-Prolog compiler for - * optimizing and transforming function/logic programs. It handles different - * logical constructs and performs conversions between functions and predicates. - * - * Author: Douglas R. Miles - * Contact: logicmoo@gmail.com / dmiles@logicmoo.org - * License: LGPL - * Repository: https://github.com/trueagi-io/metta-wam - * https://github.com/logicmoo/hyperon-wam - * Created Date: 8/23/2023 - * Last Modified: $LastChangedDate$ # You will replace this with Git automation - * - * Usage: This file is a part of the transpiler that transforms MeTTa programs into Prolog. For details - * on how to contribute or use this project, please refer to the repository README or the project documentation. - * - * Contribution: Contributions are welcome! For contributing guidelines, please check the CONTRIBUTING.md - * file in the repository. - * - * Notes: - * - Ensure you have SWI-Prolog installed and properly configured to use this transpiler. - * - This project is under active development, and we welcome feedback and contributions. - * - * Acknowledgments: Special thanks to all contributors and the open source community for their support and contributions. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions - * are met: - * - * 1. Redistributions of source code must retain the above copyright - * notice, this list of conditions and the following disclaimer. - * - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the - * distribution. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS - * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT - * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS - * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE - * COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, - * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, - * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; - * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER - * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT - * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN - * ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE - * POSSIBILITY OF SUCH DAMAGE. - */ - -:- ensure_loaded(metta_pfc_base). -:- ensure_loaded(metta_pfc_support). diff --git a/.Attic/metta_lang/metta_eval.new b/.Attic/metta_lang/metta_eval.new deleted file mode 100755 index 0f26e199d66..00000000000 --- a/.Attic/metta_lang/metta_eval.new +++ /dev/null @@ -1,854 +0,0 @@ - - - -%self_eval(X):- var(X),!. -%self_eval(X):- string(X),!. -%self_eval(X):- number(X),!. -%self_eval([]). -self_eval(X):- \+ callable(X),!. -self_eval(X):- is_valid_nb_state(X),!. -self_eval(X):- is_list(X),!,fail. -%self_eval(X):- compound(X),!. -%self_eval(X):- is_ref(X),!,fail. -self_eval(X):- atom(X),!, \+ nb_current(X,_),!. -self_eval('True'). self_eval('False'). self_eval('F'). - - -:- nb_setval(self_space, '&self'). -evals_to(XX,Y):- Y==XX,!. -evals_to(XX,Y):- Y=='True',!, is_True(XX),!. - -current_self(Space):- nb_current(self_space,Space). -eval_args(A,AA):- - current_self(Space), - eval_args(11,Space,A,AA). - -%eval_args(Depth,_Self,X,_Y):- forall(between(6,Depth,_),write(' ')),writeqln(eval_args(X)),fail. - -eval_args(_Dpth,_Slf,X,Y):- nonvar(Y),X=Y,!. -eval_args(Depth,Self,X,Y):- nonvar(Y),!,eval_args(Depth,Self,X,XX),evals_to(XX,Y). -eval_args(_Dpth,_Slf,X,Y):- self_eval(X),!,Y=X. -eval_args(_Dpth,_Slf,[X|T],Y):- T==[], \+ callable(X),!,Y=[X]. -%eval_args(_Dpth,_Slf,[X|T],Y):- T==[], \+ atom(X), self_eval(X), !,Y=[X]. - -%eval_args(Depth,Self,X,Y):- !, eval_args00(Depth,Self,X,Y). -eval_args(Depth,Self,X,Y):- - call_nth(eval_args00(Depth,Self,X,Y),Nth), - % if `True` is not commented, we fail two tests in examples/compat/test_scripts/b4_nondeterm.metta - ((X=@=Y;/*Y=='True';*/Y=='False') -> (!, (Nth=1->true;fail) ) ; true). - - -eval_args00(Depth,Self,[F|X],Y):- - (F=='superpose' ; ( option_value(no_repeats,false))), - mnotrace((D1 is Depth-1)),!, - eval_args0(D1,Self,[F|X],Y). - -eval_args00(Depth,Self,X,Y):- - mnotrace((no_repeats_var(YY), - D1 is Depth-1)), - eval_args0(D1,Self,X,Y), - mnotrace(( \+ (Y\=YY))). - - -%debugging_metta(G):-debugging(metta(eval))->ignore(G);true. - - -:- nodebug(metta(eval)). - - -w_indent(Depth,Goal):- - \+ \+ mnotrace(ignore((( - format('~N'), - setup_call_cleanup(forall(between(Depth,101,_),write(' ')),Goal, format('~N')))))). -indentq(Depth,Term):- - \+ \+ mnotrace(ignore((( - format('~N'), - setup_call_cleanup(forall(between(Depth,101,_),write(' ')),format('~q',[Term]), - format('~N')))))). - - -with_debug(Flag,Goal):- is_debugging(Flag),!, call(Goal). -with_debug(Flag,Goal):- flag(eval_num,_,0), - setup_call_cleanup(set_debug(Flag,true),call(Goal),set_debug(Flag,flase)). - -flag_to_var(Flag,Var):- atom(Flag), \+ atom_concat('trace-on-',_,Flag),!,atom_concat('trace-on-',Flag,Var). -flag_to_var(metta(Flag),Var):- !, nonvar(Flag), flag_to_var(Flag,Var). -flag_to_var(Flag,Var):- Flag=Var. - -set_debug(Flag,Val):- \+ atom(Flag), flag_to_var(Flag,Var), atom(Var),!,set_debug(Var,Val). -set_debug(Flag,true):- !, debug(metta(Flag)),flag_to_var(Flag,Var),set_option_value(Var,true). -set_debug(Flag,false):- nodebug(metta(Flag)),flag_to_var(Flag,Var),set_option_value(Var,false). -if_trace(Flag,Goal):- catch(ignore((is_debugging(Flag),Goal)),_,true). - -is_debugging(Flag):- var(Flag),!,fail. -is_debugging(Flag):- \+ atom(Flag), flag_to_var(Flag,Var), atom(Var),!,is_debugging(Var). -is_debugging(Flag):- debugging(Flag),!. -is_debugging(Flag):- debugging(metta(Flag)),!. -is_debugging(Flag):- flag_to_var(Flag,Var),!,option_value(Var,true). - - -eval_args0(Depth,_Slf,X,Y):- Depth<1,!,X=Y, (\+ is_debugging(overflow)-> true; flag(eval_num,_,0),set_debug((eval),true)). -eval_args0(_Dpth,_Slf,X,Y):- self_eval(X),!,Y=X. -eval_args0(Depth,Self,X,Y):- - Depth2 is Depth-1, - eval_args301(Depth,Self,X,M), - (M\=@=X ->eval_args0(Depth2,Self,M,Y);Y=X). - - - -eval_args301(Depth,Self,X,Y):- \+ debugging(metta(eval)),!, eval_args3011(Depth,Self,X,Y). -eval_args301(Depth,Self,X,Y):- flag(eval_num,EX,EX+1), - option_else(traclen,Max,100), - (EX>Max->(nodebug(metta(eval)),write('Switched off tracing. For a longer trace !(pragma! tracelen 101))'));true), - mnotrace((no_repeats_var(YY), D1 is Depth-1)), - DR is 99-D1, - if_trace((eval),indentq(Depth,'-->'(EX,Self,X,depth(DR)))), - Ret=retval(fail), - call_cleanup(( - eval_args3011(D1,Self,X,Y), - mnotrace(( \+ (Y\=YY), nb_setarg(1,Ret,Y)))), - mnotrace(ignore(((if_trace((eval),indentq(Depth,'<--'(EX,Ret)))))))), - (Ret\=@=retval(fail)->true;(rtrace(eval_args0(D1,Self,X,Y)),fail)). - -eval_args3011(Depth,Self,X,Y):- - call_nth(eval_args30(Depth,Self,X,Y),Nth), - % if `True` is not commented, we fail two tests in examples/compat/test_scripts/b4_nondeterm.metta - ((X=@=Y;/*Y=='True';*/Y=='False') -> (!, (Nth=1->true;fail) ) ; true). - -:- discontiguous eval_args30/4. -:- discontiguous eval_args2/4. - -eval_args30(_Dpth,_Slf,Name,Value):- atom(Name), nb_current(Name,Value),!. -eval_args30(_Dpth,_Slf,X,Y):- self_eval(X),!,Y=X. - -eval_args30(Depth,Self,[V|VI],VVO):- \+ is_list(VI),!, - eval_args(Depth,Self,VI,VM), - ( VM\==VI -> eval_args(Depth,Self,[V|VM],VVO) ; - (eval_args(Depth,Self,V,VV), (V\==VV -> eval_args(Depth,Self,[VV|VI],VVO) ; VVO = [V|VI]))). - -eval_args30(_Dpth,_Slf,X,Y):- \+ is_list(X),!,Y=X. - -eval_args30(Depth,Self,[V|VI],[V|VO]):- var(V),is_list(VI),!,maplist(eval_args(Depth,Self),VI,VO). - -eval_args30(_Dpth,_Slf,['repl!'],'True'):- !, repl. -eval_args30(Depth,Self,['!',Cond],Res):- !, call(eval_args(Depth,Self,Cond,Res)). -eval_args30(Depth,Self,['rtrace',Cond],Res):- !, rtrace(eval_args(Depth,Self,Cond,Res)). -eval_args30(Depth,Self,['time',Cond],Res):- !, time(eval_args(Depth,Self,Cond,Res)). -eval_args30(Depth,Self,['print',Cond],Res):- !, eval_args(Depth,Self,Cond,Res),format('~N'),print(Res),format('~N'). -% !(println! $1) -eval_args30(Depth,Self,['println!'|Cond],Res):- !, maplist(eval_args(Depth,Self),Cond,[Res|Out]), - format('~N'),maplist(write_src,[Res|Out]),format('~N'). -eval_args30(Depth,Self,['trace!',A|Cond],Res):- !, maplist(eval_args(Depth,Self),[A|Cond],[AA|Result]), - last(Result,Res), format('~N'),maplist(write_src,[AA]),format('~N'). - -%eval_args30(Depth,Self,['trace!',A,B],C):- !,eval_args(Depth,Self,B,C),format('~N'),wdmsg(['trace!',A,B]=C),format('~N'). -%eval_args30(_Dpth,_Slf,['trace!',A],A):- !, format('~N'),wdmsg(A),format('~N'). - -eval_args30(_Dpth,_Slf,List,Y):- is_list(List),maplist(self_eval,List),List=[H|_], \+ atom(H), !,Y=List. - -eval_args30(Depth,Self,['assertTrue', X],TF):- !, eval_args(Depth,Self,['assertEqual',X,'True'],TF). -eval_args30(Depth,Self,['assertFalse',X],TF):- !, eval_args(Depth,Self,['assertEqual',X,'False'],TF). - -eval_args30(Depth,Self,['assertEqual',X0,Y0],RetVal):- !, - subst_vars(X0,X),subst_vars(Y0,Y), - loonit_assert_source_tf( - ['assertEqual',X0,Y0], - (bagof_eval(Depth,Self,X,XX), bagof_eval(Depth,Self,Y,YY)), - equal_enough_for_test(XX,YY), TF), - (TF=='True'->return_empty(RetVal);RetVal=[got,XX,expected,YY]). - -eval_args30(Depth,Self,['assertNotEqual',X0,Y0],RetVal):- !, - subst_vars(X0,X),subst_vars(Y0,Y), - loonit_assert_source_tf( - ['assertNotEqual',X0,Y0], - (setof_eval(Depth,Self,X,XX), setof_eval(Depth,Self,Y,YY)), - \+ equal_enough(XX,YY), TF), - (TF=='True'->return_empty(RetVal);RetVal=[got,XX,expected,YY]). - -eval_args30(Depth,Self,['assertEqualToResult',X0,Y0],RetVal):- !, - subst_vars(X0,X),subst_vars(Y0,Y), - loonit_assert_source_tf( - ['assertEqualToResult',X0,Y0], - (bagof_eval(Depth,Self,X,XX), =(Y,YY)), - equal_enough_for_test(XX,YY), TF), - (TF=='True'->return_empty(RetVal);RetVal=[got,XX,expected,YY]),!. - - -loonit_assert_source_tf(Src,Goal,Check,TF):- - copy_term(Goal,OrigGoal), - loonit_asserts(Src, time_eval('\n; EVAL TEST\n;',Goal), Check), - as_tf(Check,TF),!, - ignore(( - once((TF='True', is_debugging(pass));(TF='False', is_debugging(fail))), - with_debug((eval),time_eval('Trace',OrigGoal)))). - -sort_result(Res,Res):- \+ compound(Res),!. -sort_result([And|Res1],Res):- is_and(And),!,sort_result(Res1,Res). -sort_result([T,And|Res1],Res):- is_and(And),!,sort_result([T|Res1],Res). -sort_result([H|T],[HH|TT]):- !, sort_result(H,HH),sort_result(T,TT). -sort_result(Res,Res). - -unify_enough(L,L):-!. -unify_enough(L,C):- is_list(L),into_list_args(C,CC),!,unify_lists(CC,L). -unify_enough(C,L):- is_list(L),into_list_args(C,CC),!,unify_lists(CC,L). -unify_enough(C,L):- \+ compound(C),!,L=C. -unify_enough(L,C):- \+ compound(C),!,L=C. -unify_enough(L,C):- into_list_args(L,LL),into_list_args(C,CC),!,unify_lists(CC,LL). - -unify_lists(C,L):- \+ compound(C),!,L=C. -unify_lists(L,C):- \+ compound(C),!,L=C. -unify_lists([C|CC],[L|LL]):- unify_enough(L,C),!,unify_lists(CC,LL). - -equal_enough(R,V):- is_list(R),is_list(V),sort(R,RR),sort(V,VV),!,equal_enouf(RR,VV),!. -equal_enough(R,V):- copy_term(R,RR),copy_term(V,VV),equal_enouf(R,V),!,R=@=RR,V=@=VV. - -equal_enough_for_answer(XX,YY):- equal_enough(XX,YY),!. -equal_enough_for_answer(XX,Y):- sub_sterm1(YY,Y), equal_enough(YY,XX),!. - -equal_enough_for_test(X,Y):- must_det_ll((subst_vars(X,XX),subst_vars(Y,YY))),!,equal_enough_for_answer(XX,YY),!. - -equal_enouf(R,V):- R=@=V, !. -equal_enouf(_,V):- V=@='...',!. -equal_enouf(L,C):- is_list(L),into_list_args(C,CC),!,equal_enouf_l(CC,L). -equal_enouf(C,L):- is_list(L),into_list_args(C,CC),!,equal_enouf_l(CC,L). -%equal_enouf(R,V):- (var(R),var(V)),!, R=V. -equal_enouf(R,V):- (var(R);var(V)),!, R==V. -equal_enouf(R,V):- number(R),number(V),!, RV is abs(R-V), RV < 0.03 . -equal_enouf(R,V):- atom(R),!,atom(V), has_unicode(R),has_unicode(V). -equal_enouf(R,V):- (\+ compound(R) ; \+ compound(V)),!, R==V. -equal_enouf(L,C):- into_list_args(L,LL),into_list_args(C,CC),!,equal_enouf_l(CC,LL). - -equal_enouf_l(C,L):- \+ compound(C),!,L=@=C. -equal_enouf_l(L,C):- \+ compound(C),!,L=@=C. -equal_enouf_l([C|CC],[L|LL]):- !, equal_enouf(L,C),!,equal_enouf_l(CC,LL). - - -has_unicode(A):- atom_codes(A,Cs),member(N,Cs),N>127,!. -set_last_error(_). - - -eval_args30(Depth,Self,['match',Other,Goal,Template],Template):- into_space(Self,Other,Space),!, metta_atom_iter(Depth,Space,Goal). -eval_args30(Depth,Self,['match',Other,Goal,Template,Else],Template):- - (eval_args30(Depth,Self,['match',Other,Goal,Template],Template)*->true;Template=Else). - -% Macro: case -eval_args30(Depth,Self,X,Res):- - X= [CaseSym,A,CL],CaseSym == 'case', !, - into_case_list(CL,CASES), - findall(Key-Value, - (nth0(Nth,CASES,Case0), - (is_case(Key,Case0,Value), - if_trace((case),(format('~N'), - writeqln(c(Nth,Key)=Value))))),KVs),!, - ((eval_args(Depth,Self,A,AA), if_trace((case),writeqln(switch=AA)), - (select_case(Depth,Self,AA,KVs,Value)->true;(member(Void -Value,KVs),Void=='%void%'))) - *->true;(member(Void -Value,KVs),Void=='%void%')), - eval_args(Depth,Self,Value,Res). - - select_case(Depth,Self,AA,Cases,Value):- - (best_key(AA,Cases,Value) -> true ; - (maybe_special_keys(Depth,Self,Cases,CasES), - (best_key(AA,CasES,Value) -> true ; - (member(Void -Value,CasES),Void=='%void%')))). - - best_key(AA,Cases,Value):- - ((member(Match-Value,Cases),unify_enough(AA,Match))->true; - ((member(Match-Value,Cases),AA ==Match)->true; - ((member(Match-Value,Cases),AA=@=Match)->true; - (member(Match-Value,Cases),AA = Match)))). - - %into_case_list([[C|ASES0]],CASES):- is_list(C),!, into_case_list([C|ASES0],CASES),!. - into_case_list(CASES,CASES):- is_list(CASES),!. - is_case(AA,[AA,Value],Value):-!. - is_case(AA,[AA|Value],Value). - - maybe_special_keys(Depth,Self,[K-V|KVI],[AK-V|KVO]):- - eval_args(Depth,Self,K,AK), K\=@=AK,!, - maybe_special_keys(Depth,Self,KVI,KVO). - maybe_special_keys(Depth,Self,[_|KVI],KVO):- - maybe_special_keys(Depth,Self,KVI,KVO). - maybe_special_keys(_Depth,_Self,[],[]). - - -%[collapse,[1,2,3]] -eval_args30(Depth,Self,['collapse',List],Res):-!, bagof_eval(Depth,Self,List,Res). -%[superpose,[1,2,3]] -eval_args30(Depth,Self,['superpose',List],Res):- !, member(E,List),eval_args(Depth,Self,E,Res). - -get_set_sterm_p1(E,Cmpd,SA):- is_list(Cmpd), !, get_sa_p3(E,Cmpd,SA). -get_set_sterm_p1(E,Cmpd,SA):- compound(Cmpd), get_sa_p2(E,Cmpd,SA). - -get_sa_p2(E,Cmpd,setarg(N1,Cmpd)):- arg(N1,Cmpd,E). -get_sa_p2(E,Cmpd,SA):- arg(_,Cmpd,Arg),get_set_sterm_p1(E,Arg,SA). - -get_sa_p3(E,Cmpd, b_set_nth1(N1,Cmpd)):- nth1(N1,Cmpd,E). -get_sa_p3(E,Cmpd,SA):- member(Arg,Cmpd),get_set_sterm_p1(E,Arg,SA). - - -nb_set_nth1(N, [_|List], Ele) :- N > 1, !, Nm1 is N - 1, nb_set_nth1(Nm1, List, Ele). -nb_set_nth1(N, List, Ele) :- nb_setarg(N, List, Ele). - -b_set_nth1(N, [_|List], Ele) :- N > 1, !, Nm1 is N - 1, b_set_nth1(Nm1, List, Ele). -b_set_nth1(N, List, Ele) :- setarg(N, List, Ele). - -sub_sterm(Sub,Sub). -sub_sterm(Sub,Term):- sub_sterm1(Sub,Term). -sub_sterm1(_ ,List):- \+ compound(List),!,fail. -sub_sterm1(Sub,List):- is_list(List),!,member(SL,List),sub_sterm(Sub,SL). -sub_sterm1(_ ,[_|_]):-!,fail. -sub_sterm1(Sub,Term):- arg(_,Term,SL),sub_sterm(Sub,SL). - - -eval_args30(_Dpth,_Slf, ['new-space'], Res):- !, 'new-space'(Res). - -eval_args30(Depth,Self, Term, Res):- fail, - mnotrace(( get_set_sterm_p1(ST,Term,P1), % ST\==Term, - is_list(ST), ST = [F|List], atom(F), - handle_inner(F),maplist(nonvar,List), %maplist(atomic,List), - call(P1,Var))), !, - eval_args(Depth,Self,ST,Var), eval_args(Depth,Self, Term, Res). -/* -eval_args30(Depth,Self, Term, Res):- - mnotrace(( get_set_sterm_p1(ST,Term,P1), - compound(ST), ST = [F,List],F=='collapse',nonvar(List), %maplist(atomic,List), - call(P1,Var))), !, - bagof_eval(Depth,Self,List,Var), eval_args(Depth,Self, Term, Res). - -*/ -%handle_inner('superpose'). -%handle_inner('collapse'). -handle_inner('+'). - -max_counting(F,Max):- flag(F,X,X+1), X true; (flag(F,_,10),!,fail). - - -eval_args30(Depth,Self,['if',Cond,Then],Res):- !, - eval_args(Depth,Self,Cond,TF), - (is_True(TF) -> eval_args(Depth,Self,Then,Res) ; (fail, Res = [])). - -eval_args30(Depth,Self,['If',Cond,Then],Res):- !, - eval_args(Depth,Self,Cond,TF), - (is_True(TF) -> eval_args(Depth,Self,Then,Res) ; (fail, Res = [])). - -eval_args30(Depth,Self,['if',Cond,Then,Else],Res):- !, - eval_args(Depth,Self,Cond,TF), - (is_True(TF) -> eval_args(Depth,Self,Then,Res);eval_args(Depth,Self,Else,Res)). - -eval_args30(Depth,Self,['If',Cond,Then,Else],Res):- !, - eval_args(Depth,Self,Cond,TF), - (is_True(TF) -> eval_args(Depth,Self,Then,Res);eval_args(Depth,Self,Else,Res)). - -eval_args30(_Dpth,_Slf,[_,Nothing],Nothing):- 'Nothing'==Nothing,!. - -eval_args30(Depth,Self,['let',A,A5,AA],OO):- !, - %(var(A)->true;trace), - ((eval_args(Depth,Self,A5,AE), AE=A)), - eval_args(Depth,Self,AA,OO). -%eval_args30(Depth,Self,['let',A,A5,AA],AAO):- !,eval_args(Depth,Self,A5,A),eval_args(Depth,Self,AA,AAO). -eval_args30(Depth,Self,['let*',[],Body],RetVal):- !, eval_args(Depth,Self,Body,RetVal). -eval_args30(Depth,Self,['let*',[[Var,Val]|LetRest],Body],RetVal):- !, - eval_args30(Depth,Self,['let',Var,Val,['let*',LetRest,Body]],RetVal). - -eval_args30(Depth,Self,['colapse'|List], Flat):- !, maplist(eval_args(Depth,Self),List,Res),flatten(Res,Flat). -eval_args30(Depth,Self,['get-atoms',Other],PredDecl):- !,into_space(Self,Other,Space), metta_atom_iter(Depth,Space,PredDecl). -eval_args30(_Dpth,_Slf,['car-atom',Atom],CAR):- !, Atom=[CAR|_],!. -eval_args30(_Dpth,_Slf,['cdr-atom',Atom],CDR):- !, Atom=[_|CDR],!. - -eval_args30(Depth,Self,['Cons', A, B ],['Cons', AA, BB]):- no_cons_reduce, !, - eval_args(Depth,Self,A,AA), eval_args(Depth,Self,B,BB). - -eval_args30(Depth,Self,['Cons', A, B ],[AA|BB]):- \+ no_cons_reduce, !, - eval_args(Depth,Self,A,AA), eval_args(Depth,Self,B,BB). - - -eval_args30(Depth,Self,['change-state!',StateExpr, UpdatedValue], Ret):- !, eval_args(Depth,Self,StateExpr,StateMonad), - eval_args(Depth,Self,UpdatedValue,Value), 'change-state!'(Depth,Self,StateMonad, Value, Ret). -eval_args30(Depth,Self,['new-state',UpdatedValue],StateMonad):- !, - eval_args(Depth,Self,UpdatedValue,Value), 'new-state'(Depth,Self,Value,StateMonad). -eval_args30(Depth,Self,['get-state',StateExpr],Value):- !, - eval_args(Depth,Self,StateExpr,StateMonad), 'get-state'(StateMonad,Value). - - - -% eval_args30(Depth,Self,['get-state',Expr],Value):- !, eval_args(Depth,Self,Expr,State), arg(1,State,Value). - - - -check_type:- option_else(typecheck,TF,'False'), TF=='True'. - -:- dynamic is_registered_state/1. -:- flush_output. -:- setenv('RUST_BACKTRACE',full). - -% Function to check if an value is registered as a state name -:- dynamic(is_registered_state/1). -is_nb_state(G):- is_valid_nb_state(G) -> true ; - is_registered_state(G),nb_current(G,S),is_valid_nb_state(S). - - -:- multifile(state_type_method/3). -:- dynamic(state_type_method/3). -space_type_method(is_nb_state,new_space,init_state). -space_type_method(is_nb_state,clear_space,clear_nb_values). -space_type_method(is_nb_state,add_atom,add_nb_value). -space_type_method(is_nb_state,remove_atom,'change-state!'). -space_type_method(is_nb_state,replace_atom,replace_nb_value). -space_type_method(is_nb_state,atom_count,value_nb_count). -space_type_method(is_nb_state,get_atoms,'get-state'). -space_type_method(is_nb_state,atom_iter,value_nb_iter). - -state_type_method(is_nb_state,new_state,init_state). -state_type_method(is_nb_state,clear_state,clear_nb_values). -state_type_method(is_nb_state,add_value,add_nb_value). -state_type_method(is_nb_state,remove_value,'change-state!'). -state_type_method(is_nb_state,replace_value,replace_nb_value). -state_type_method(is_nb_state,value_count,value_nb_count). -state_type_method(is_nb_state,'get-state','get-state'). -state_type_method(is_nb_state,value_iter,value_nb_iter). -%state_type_method(is_nb_state,query,state_nb_query). - -% Clear all values from a state -clear_nb_values(StateNameOrInstance) :- - fetch_or_create_state(StateNameOrInstance, State), - nb_setarg(1, State, []). - - - -% Function to confirm if a term represents a state -is_valid_nb_state(State):- compound(State),functor(State,'State',_). - -% Find the original name of a given state -state_original_name(State, Name) :- - is_registered_state(Name), - nb_current(Name, State). - -% Register and initialize a new state -init_state(Name) :- - State = 'State'(_,_), - asserta(is_registered_state(Name)), - nb_setval(Name, State). - -% Change a value in a state -'change-state!'(Depth,Self,StateNameOrInstance, UpdatedValue, Out) :- - fetch_or_create_state(StateNameOrInstance, State), - arg(2, State, Type), - ( (check_type,\+ get_type(Depth,Self,UpdatedValue,Type)) - -> (Out = ['Error', UpdatedValue, 'BadType']) - ; (nb_setarg(1, State, UpdatedValue), Out = State) ). - -% Fetch all values from a state -'get-state'(StateNameOrInstance, Values) :- - fetch_or_create_state(StateNameOrInstance, State), - arg(1, State, Values). - -'new-state'(Depth,Self,Init,'State'(Init, Type)):- check_type->get_type(Depth,Self,Init,Type);true. - -'new-state'(Init,'State'(Init, Type)):- check_type->get_type(10,'&self',Init,Type);true. - -fetch_or_create_state(Name):- fetch_or_create_state(Name,_). -% Fetch an existing state or create a new one - -fetch_or_create_state(State, State) :- is_valid_nb_state(State),!. -fetch_or_create_state(NameOrInstance, State) :- - ( atom(NameOrInstance) - -> (is_registered_state(NameOrInstance) - -> nb_current(NameOrInstance, State) - ; init_state(NameOrInstance), - nb_current(NameOrInstance, State)) - ; is_valid_nb_state(NameOrInstance) - -> State = NameOrInstance - ; writeln('Error: Invalid input.') - ), - is_valid_nb_state(State). - - -eval_args30(Depth,Self,['get-type',Val],Type):- %if_repl(trace), - !, get_type(Depth,Self,Val,Type),Type\==[],!. %, ground(Type), Type\==Val,!. - - -mnotrace(G):- once(G). - - - -is_decl_type(ST):- metta_type(_,_,Type),sub_term(T,Type),T=@=ST, \+ nontype(ST). -is_type(Type):- nontype(Type),!,fail. -is_type(Type):- is_decl_type(Type). -is_type(Type):- atom(Type). - -nontype(Type):- var(Type),!. -nontype('->'). -nontype(N):- number(N). - -needs_eval(EvalMe):- is_list(EvalMe),!. - -get_type(_Dpth,_Slf,Var,'%Undefined%'):- var(Var),!. -get_type(_Dpth,_Slf,Val,'Number'):- number(Val),!. -get_type(Depth,Self,Expr,['StateMonad',Type]):- is_valid_nb_state(Expr),'get-state'(Expr,Val),!, - get_type(Depth,Self,Val,Type). - - -get_type(Depth,_Slf,Type,Type):- Depth<1,!. -get_type(Depth,Self,EvalMe,Type):- needs_eval(EvalMe),eval_args(Depth,Self,EvalMe,Val), \+ needs_eval(Val),!, - get_type(Depth,Self,Val,Type). - -get_type(_Dpth,Self,Fn,Type):- metta_type(Self,FnM,Type),FnM=@=Fn, nonvar(Type). -%get_type(_Dpth,Self,Fn,Type):- symbol(Fn),metta_type(Self,Fn,Type),!. -%reverse -%get_type(_Dpth,Self,List,Type):- is_list(List),metta_type(Self,Type,['->'|List]). -get_type(_Dpth,Self,[Fn|_],Type):- symbol(Fn),metta_type(Self,Fn,List),last_element(List,Type), nonvar(Type), - is_type(Type). -get_type(_Dpth,Self,List,Type):- is_list(List),metta_type(Self,List,LType),last_element(LType,Type), nonvar(Type), - is_type(Type). - -get_type(Depth,Self,List,Types):- List\==[], is_list(List),Depth2 is Depth-1,maplist(get_type(Depth2,Self),List,Types). -%get_type(Depth,Self,Fn,Type):- nonvar(Fn),metta_type(Self,Fn,Type2),Depth2 is Depth-1,get_type(Depth2,Self,Type2,Type). -%get_type(Depth,Self,Fn,Type):- Depth>0,nonvar(Fn),metta_type(Self,Type,Fn),!. %,!,last_element(List,Type). - -get_type(Depth,Self,Expr,Type):-Depth2 is Depth-1, eval_args30(Depth2,Self,Expr,Val),Expr\=@=Val,get_type(Depth2,Self,Val,Type). - -get_type(_Dpth,_Slf,Val,'String'):- string(Val),!. -get_type(_Dpth,_Slf,Val,Type):- is_decl_type(Val),Type=Val. -get_type(_Dpth,_Slf,Val,'Bool'):- (Val=='False';Val=='True'),!. -get_type(_Dpth,_Slf,Val,'Symbol'):- symbol(Val). -%get_type(Depth,Self,[T|List],['List',Type]):- Depth2 is Depth-1, is_list(List),get_type(Depth2,Self,T,Type),!, -% forall((member(Ele,List),nonvar(Ele)),get_type(Depth2,Self,Ele,Type)),!. -%get_type(Depth,_Slf,Cmpd,Type):- compound(Cmpd), functor(Cmpd,Type,1),!. -get_type(_Dpth,_Slf,Cmpd,Type):- \+ ground(Cmpd),!,Type=[]. -get_type(_Dpth,_Slf,_,'%Undefined%'):- fail. -eval_args30(Depth,Self,['length',L],Res):- !, eval_args(Depth,Self,L,LL), !, (is_list(LL)->length(LL,Res);Res=1). -eval_args30(Depth,Self,['CountElement',L],Res):- !, eval_args(Depth,Self,L,LL), !, (is_list(LL)->length(LL,Res);Res=1). - - -is_feo_f('Cons'). - -is_seo_f('{}'). -is_seo_f('[]'). -is_seo_f('StateMonad'). -is_seo_f('State'). -is_seo_f('Event'). -is_seo_f(N):- number(N),!. - - - -/* -eval_args30(Depth,Self,[F,A|Args],Res):- - \+ self_eval(A), - eval_args(Depth,Self,A,AA),AA\==A, - eval_args(Depth,Self,[F,AA|Args],Res). - - -eval_args30(Depth,Self,[F,A1|AArgs],Res):- fail, member(F,['+']), - cwdl(40,(( - append(L,[A|R],AArgs), - \+ self_eval(A), - eval_args(Depth,Self,A,AA),AA\==A,!, - append(L,[AA|R],NewArgs), eval_args(Depth,Self,[F,A1|NewArgs],Res)))). -*/ - -/* %% - -% !(assertEqualToResult ((inc) 2) (3)) -eval_args30(Depth,Self,[F|Args],Res):- is_list(F), - metta_atom_iter(Depth,Self,['=',F,R]), eval_args(Depth,Self,[R|Args],Res). - -eval_args30(Depth,Self,[F|Args],Res):- is_list(F), Args\==[], - append(F,Args,FArgs),!,eval_args(Depth,Self,FArgs,Res). -*/ -eval_args30(_Dpth,Self,['import!',Other,File],RetVal):- into_space(Self,Other,Space),!, include_metta(Space,File),!,return_empty(Space,RetVal). %RetVal=[]. -eval_args30(Depth,Self,['bind!',Other,Expr],RetVal):- - into_name(Self,Other,Name),!,eval_args(Depth,Self,Expr,Value),nb_setval(Name,Value), return_empty(Value,RetVal). -eval_args30(Depth,Self,['pragma!',Other,Expr],RetVal):- - into_name(Self,Other,Name),!,nd_ignore((eval_args(Depth,Self,Expr,Value),set_option_value(Name,Value))), return_empty(Value,RetVal). -eval_args30(_Dpth,Self,['transfer!',File],RetVal):- !, include_metta(Self,File), return_empty(Self,RetVal). - -nd_ignore(Goal):- call(Goal)*->true;true. - -eval_args30(Depth,Self,['nop',Expr],Empty):- !, eval_args(Depth,Self,Expr,_), return_empty([],Empty). -eval_args30(Depth,Self,['do',Expr],Empty):- !, eval_args(Depth,Self,Expr,_), return_empty([],Empty). - -is_True(T):- T\=='False',T\=='F',T\==[]. - -is_and(S):- \+ atom(S),!,fail. -is_and('#COMMA'). is_and(','). is_and('and'). is_and('And'). - -eval_args30(_Dpth,_Slf,[And],'True'):- is_and(And),!. -eval_args30(Depth,Self,['and',X,Y],TF):- !, as_tf((eval_args(Depth,Self,X,'True'),eval_args(Depth,Self,Y,'True')),TF). -eval_args30(Depth,Self,[And,X|Y],TF):- is_and(And),!,eval_args(Depth,Self,X,TF1), - is_True(TF1),eval_args30(Depth,Self,[And|Y],TF). -%eval_args2(Depth,Self,[H|T],_):- \+ is_list(T),!,fail. -eval_args30(Depth,Self,['or',X,Y],TF):- !, as_tf((eval_args(Depth,Self,X,'True');eval_args(Depth,Self,Y,'True')),TF). - - - -eval_args30(_Dpth,Self,['add-atom',Other,PredDecl],TF):- !, into_space(Self,Other,Space), as_tf('add-atom'(Space,PredDecl),TF). -eval_args30(_Dpth,Self,['remove-atom',Other,PredDecl],TF):- !, into_space(Self,Other,Space), as_tf(do_metta(Space,unload,PredDecl),TF). -eval_args30(_Dpth,Self,['atom-count',Other],Count):- !, into_space(Self,Other,Space), findall(_,metta_defn(Other,_,_),L1),length(L1,C1),findall(_,metta_atom(Space,_),L2),length(L2,C2),Count is C1+C2. -eval_args30(_Dpth,Self,['atom-replace',Other,Rem,Add],TF):- !, into_space(Self,Other,Space), copy_term(Rem,RCopy), - as_tf((metta_atom_iter_ref(Space,RCopy,Ref), RCopy=@=Rem,erase(Ref), do_metta(Other,load,Add)),TF). - - -eval_args30(Depth,Self,['+',N1,N2],N):- number(N1),!, - eval_args(Depth,Self,N2,N2Res), catch(N is N1+N2Res,_E,(set_last_error(['Error',N2Res,'Number']),fail)). -eval_args30(Depth,Self,['-',N1,N2],N):- number(N1),!, - eval_args(Depth,Self,N2,N2Res), catch(N is N1-N2Res,_E,(set_last_error(['Error',N2Res,'Number']),fail)). - -eval_args30(Depth,Self,[V|VI],[V|VO]):- nonvar(V),is_metta_data_functor(V),is_list(VI),!,maplist(eval_args(Depth,Self),VI,VO). - -eval_args30(Depth,Self,X,Y):- - (eval_args2(Depth,Self,X,Y)*->true; - (eval_args2_failed(Depth,Self,X,Y)*->true;X=Y)). - - -eval_args2_failed(_Dpth,_Slf,T,TT):- T==[],!,TT=[]. -eval_args2_failed(_Dpth,_Slf,T,TT):- var(T),!,TT=T. -eval_args2_failed(_Dpth,_Slf,[F|LESS],Res):- once(eval_selfless([F|LESS],Res)),mnotrace([F|LESS]\==Res),!. -%eval_args2_failed(Depth,Self,[V|Nil],[O]):- Nil==[], once(eval_args(Depth,Self,V,O)),V\=@=O,!. -eval_args2_failed(Depth,Self,[H|T],[HH|TT]):- !, - eval_args(Depth,Self,H,HH), - eval_args2_failed(Depth,Self,T,TT). - -eval_args2_failed(Depth,Self,T,TT):- eval_args(Depth,Self,T,TT). - - %eval_args(Depth,Self,X,Y):- eval_args30(Depth,Self,X,Y)*->true;Y=[]. - -%eval_args30(Depth,_,_,_):- Depth<1,!,fail. -%eval_args30(Depth,_,X,Y):- Depth<3, !, ground(X), (Y=X). -%eval_args30(_Dpth,_Slf,X,Y):- self_eval(X),!,Y=X. - -% Kills zero arity functions eval_args30(Depth,Self,[X|Nil],[Y]):- Nil ==[],!,eval_args(Depth,Self,X,Y). - - -/* -into_values(List,Many):- List==[],!,Many=[]. -into_values([X|List],Many):- List==[],is_list(X),!,Many=X. -into_values(Many,Many). -eval_args2(_Dpth,_Slf,Name,Value):- atom(Name), nb_current(Name,Value),!. -*/ -% Macro Functions -%eval_args30(Depth,_,_,_):- Depth<1,!,fail. -eval_args2(Depth,_,X,Y):- Depth<3, !, fail, ground(X), (Y=X). -eval_args2(Depth,Self,[F|PredDecl],Res):- - Depth>6, fail, - mnotrace((sub_sterm1(SSub,PredDecl), ground(SSub),SSub=[_|Sub], is_list(Sub), maplist(atomic,SSub))), - eval_args(Depth,Self,SSub,Repl), - mnotrace((SSub\=Repl, subst(PredDecl,SSub,Repl,Temp))), - eval_args(Depth,Self,[F|Temp],Res). - - - -% user defined function -eval_args2(Depth,Self,[H|PredDecl],Res):- mnotrace(is_user_defined_head(Self,H)),!, - eval_args60(Depth,Self,[H|PredDecl],Res). - -% function inherited by system -eval_args2(Depth,Self,PredDecl,Res):- eval_args80(Depth,Self,PredDecl,Res). - - -last_element(T,E):- \+ compound(T),!,E=T. -last_element(T,E):- is_list(T),last(T,L),last_element(L,E),!. -last_element(T,E):- compound_name_arguments(T,_,List),last_element(List,E),!. - - - - -catch_warn(G):- notrace(catch(G,E,(wdmsg(catch_warn(G)-->E),fail))). -catch_nowarn(G):- notrace(catch(G,error(_,_),fail)). - -as_tf(G,TF):- catch_nowarn((call(G)*->TF='True';TF='False')). -eval_selfless(['==',X,Y],TF):- as_tf(X=:=Y,TF),!. -eval_selfless(['==',X,Y],TF):- as_tf(X=@=Y,TF),!. -eval_selfless(['=',X,Y],TF):-!,as_tf(X=Y,TF). -eval_selfless(['>',X,Y],TF):-!,as_tf(X>Y,TF). -eval_selfless(['<',X,Y],TF):-!,as_tf(X',X,Y],TF):-!,as_tf(X>=Y,TF). -eval_selfless(['<=',X,Y],TF):-!,as_tf(X= Bool Atom Atom)) -(= (ift True $then) $then) - -; For anything that is green, assert it is Green in &kb22 -!(ift (green $x) - (add-atom &kb22 (Green $x))) - -; Retrieve the inferred Green things: Fritz and Sam. -!(assertEqualToResult - (match &kb22 (Green $x) $x) - (Fritz Sam)) -*/ -:- discontiguous eval_args6/4. -%eval_args2(Depth,Self,PredDecl,Res):- eval_args6(Depth,Self,PredDecl,Res). - -%eval_args2(_Dpth,_Slf,L1,Res):- is_list(L1),maplist(self_eval,L1),!,Res=L1. -%eval_args2(_Depth,_Self,X,X). - - -is_user_defined_head(Other,H):- mnotrace(is_user_defined_head0(Other,H)). -is_user_defined_head0(Other,[H|_]):- !, nonvar(H),!, is_user_defined_head_f(Other,H). -is_user_defined_head0(Other,H):- callable(H),!,functor(H,F,_), is_user_defined_head_f(Other,F). -is_user_defined_head0(Other,H):- is_user_defined_head_f(Other,H). - -is_user_defined_head_f(Other,H):- is_user_defined_head_f1(Other,H). -is_user_defined_head_f(Other,H):- is_user_defined_head_f1(Other,[H|_]). - -%is_user_defined_head_f1(Other,H):- metta_type(Other,H,_). -is_user_defined_head_f1(Other,H):- metta_atom(Other,[H|_]). -is_user_defined_head_f1(Other,H):- metta_defn(Other,[H|_],_). -%is_user_defined_head_f(_,H):- is_metta_builtin(H). - - -is_special_op(F):- \+ atom(F), \+ var(F), !, fail. -is_special_op('case'). -is_special_op(':'). -is_special_op('='). -is_special_op('->'). -is_special_op('let'). -is_special_op('let*'). -is_special_op('if'). -is_special_op('rtrace'). -is_special_op('or'). -is_special_op('and'). -is_special_op('not'). -is_special_op('match'). -is_special_op('call'). -is_special_op('let'). -is_special_op('let*'). -is_special_op('nop'). -is_special_op('assertEqual'). -is_special_op('assertEqualToResult'). - -is_metta_builtin(Special):- is_special_op(Special). -is_metta_builtin('=='). -is_metta_builtin(F):- once(atom(F);var(F)), current_op(_,yfx,F). -is_metta_builtin('println!'). -is_metta_builtin('transfer!'). -is_metta_builtin('collapse'). -is_metta_builtin('superpose'). -is_metta_builtin('+'). -is_metta_builtin('-'). -is_metta_builtin('*'). -is_metta_builtin('/'). -is_metta_builtin('%'). -is_metta_builtin('=='). -is_metta_builtin('<'). -is_metta_builtin('>'). -is_metta_builtin('all'). -is_metta_builtin('import!'). -is_metta_builtin('pragma!'). - - - -eval_args60(Depth,Self,H,B):- (eval_args64(Depth,Self,H,B)*->true;eval_args67(Depth,Self,H,B)). - -eval_args64(_Dpth,Self,H,B):- (metta_defn(Self,H,B);(metta_atom(Self,H),B='True')). - -% Has argument that is headed by the same function -eval_args67(Depth,Self,[H1|Args],Res):- - mnotrace((append(Left,[[H2|H2Args]|Rest],Args), H2==H1)),!, - eval_args(Depth,Self,[H2|H2Args],ArgRes), - mnotrace((ArgRes\==[H2|H2Args], append(Left,[ArgRes|Rest],NewArgs))), - eval_args60(Depth,Self,[H1|NewArgs],Res). - -eval_args67(Depth,Self,[[H|Start]|T1],Y):- - mnotrace((is_user_defined_head_f(Self,H),is_list(Start))), - metta_defn(Self,[H|Start],Left), - eval_args(Depth,Self,[Left|T1],Y). - -% Has subterm to eval -eval_args67(Depth,Self,[F|PredDecl],Res):- - Depth>1, - quietly(sub_sterm1(SSub,PredDecl)), - mnotrace((ground(SSub),SSub=[_|Sub], is_list(Sub),maplist(atomic,SSub))), - eval_args(Depth,Self,SSub,Repl), - mnotrace((SSub\=Repl,subst(PredDecl,SSub,Repl,Temp))), - eval_args60(Depth,Self,[F|Temp],Res). - -%eval_args67(Depth,Self,X,Y):- (eval_args68(Depth,Self,X,Y)*->true;metta_atom_iter(Depth,Self,[=,X,Y])). - -eval_args67(Depth,Self,PredDecl,Res):- fail, - ((term_variables(PredDecl,Vars), - (metta_atom(Self,PredDecl) *-> (Vars ==[]->Res='True';Vars=Res); - (eval_args(Depth,Self,PredDecl,Res),ignore(Vars ==[]->Res='True';Vars=Res))))), - PredDecl\=@=Res. - -eval_args68(_Dpth,Self,[H|_],_):- mnotrace( \+ is_user_defined_head_f(Self,H) ), !,fail. -eval_args68(_Dpth,Self,[H|T1],Y):- metta_defn(Self,[H|T1],Y). -eval_args68(_Dpth,Self,[H|T1],'True'):- metta_atom(Self,[H|T1]). -eval_args68(_Dpth,Self,CALL,Y):- fail,append(Left,[Y],CALL),metta_defn(Self,Left,Y). - - -%eval_args6(Depth,Self,['ift',CR,Then],RO):- fail, !, %fail, % trace, -% metta_defn(Self,['ift',R,Then],Become),eval_args(Depth,Self,CR,R),eval_args(Depth,Self,Then,_True),eval_args(Depth,Self,Become,RO). - -%metta_atom_iter(_Dpth,Other,[Equal,H,B]):- '=' == Equal,!, -% (metta_defn(Other,H,B)*->true;(metta_atom(Other,H),B='True')). -metta_atom_iter(_Dpth,Other,[Equal,H,B]):- '=' == Equal,!, - (metta_defn(Other,H,B);((B='True';B=H),metta_atom(Other,H))). - -metta_atom_iter(Depth,_,_):- Depth<3,!,fail. -metta_atom_iter(_Dpth,_Slf,[]):-!. -metta_atom_iter(_Dpth,Other,H):- metta_atom(Other,H). -metta_atom_iter(Depth,Other,H):- D2 is Depth -1, metta_defn(Other,H,B),metta_atom_iter(D2,Other,B). -metta_atom_iter(Depth,Other,H):- nonvar(H),D2 is Depth -1, eval_args(D2,Other,H,B),B\==[],!. -/* -metta_atom_iter(Depth,Other,H):- D2 is Depth -1, metta_defn(Other,H,B),metta_atom_iter(D2,Other,B). -metta_atom_iter(_Dpth,_Slf,[And]):- is_and(And),!. -metta_atom_iter(Depth,Self,[And,X|Y]):- is_and(And),!,D2 is Depth -1, -metta_atom_iter(D2,Self,X),metta_atom_iter(D2,Self,[And|Y]).*/ -/* -metta_atom_iter2(_,Self,[=,X,Y]):- metta_defn(Self,X,Y). -metta_atom_iter2(_Dpth,Other,[Equal,H,B]):- '=' == Equal,!, metta_defn(Other,H,B). -metta_atom_iter2(_Dpth,Self,X,Y):- metta_defn(Self,X,Y). %, Y\=='True'. -metta_atom_iter2(_Dpth,Self,X,Y):- metta_atom(Self,[=,X,Y]). %, Y\=='True'. - -*/ -metta_atom_iter_ref(Other,['=',H,B],Ref):-clause(metta_defn(Other,H,B),true,Ref). -metta_atom_iter_ref(Other,H,Ref):-clause(metta_atom(Other,H),true,Ref). - -%not_compound(Term):- \+ is_list(Term),!. -%eval_args2(Depth,Self,Term,Res):- maplist(not_compound,Term),!,eval_args645(Depth,Self,Term,Res). - - -% function inherited by system -eval_args80(Depth,Self,[F|X],FY):- is_function(F), \+ is_special_op(F), is_list(X), - maplist(eval_args(Depth,Self),X,Y),!,eval_args5(Depth,Self,[F|Y],FY). -eval_args80(Depth,Self,FX,FY):- eval_args5(Depth,Self,FX,FY). - -eval_args5(_Dpth,_Slf,[F|LESS],Res):- once(eval_selfless([F|LESS],Res)),mnotrace(([F|LESS]\==Res)),!. -eval_args5(Depth,Self,[AE|More],TF):- length(More,Len), - (is_syspred(AE,Len,Pred),catch_warn(as_tf(apply(Pred,More),TF)))*->true;eval_args6(Depth,Self,[AE|More],TF). -eval_args6(_Dpth,_Slf,[AE|More],TF):- length([AE|More],Len), is_syspred(AE,Len,Pred),append(More,[TF],Args),!,catch_warn(apply(Pred,Args)). - -%eval_args80(Depth,Self,[X1|[F2|X2]],[Y1|Y2]):- is_function(F2),!,eval_args(Depth,Self,[F2|X2],Y2),eval_args(Depth,Self,X1,Y1). - - -cwdl(DL,Goal):- call_with_depth_limit(Goal,DL,R), (R==depth_limit_exceeded->(!,fail);true). -bagof_eval(Depth,Self,X,L):- !,bagof_or_nil(E,eval_args(Depth,Self,X,E),L). -setof_eval(Depth,Self,X,S):- !,bagof_or_nil(E,eval_args(Depth,Self,X,E),L),sort(L,S). -%setof_eval(Depth,Self,X,S):- setof(E,eval_args(Depth,Self,X,E),S)*->true;S=[]. -bagof_or_nil(T,G,L):- bagof(T,G,L)*->true;L=[]. diff --git a/.Attic/metta_lang/metta_eval.old b/.Attic/metta_lang/metta_eval.old deleted file mode 100755 index c5ee60ad183..00000000000 --- a/.Attic/metta_lang/metta_eval.old +++ /dev/null @@ -1,1633 +0,0 @@ -% -% post match modew -%:- style_check(-singleton). -:- multifile(nop/1). -:- meta_predicate(nop(0)). -:- multifile(fake_notrace/1). -:- meta_predicate(fake_notrace(0)). -:- meta_predicate(color_g_mesg(+,0)). -:- multifile(color_g_mesg/2). - -self_eval0(X):- \+ callable(X),!. -self_eval0(X):- is_valid_nb_state(X),!. -%self_eval0(X):- string(X),!. -%self_eval0(X):- number(X),!. -%self_eval0([]). -self_eval0(X):- is_metta_declaration(X),!. -self_eval0([F|X]):- !, is_list(X),length(X,Len),!,nonvar(F), is_self_eval_l_fa(F,Len),!. -self_eval0(X):- typed_list(X,_,_),!. -%self_eval0(X):- compound(X),!. -%self_eval0(X):- is_ref(X),!,fail. -self_eval0('True'). self_eval0('False'). % self_eval0('F'). -self_eval0('Empty'). -self_eval0(X):- atom(X),!, \+ nb_current(X,_),!. - -coerce(Type,Value,Result):- nonvar(Value),Value=[Echo|EValue], Echo == echo, EValue = [RValue],!,coerce(Type,RValue,Result). -coerce(Type,Value,Result):- var(Type), !, Value=Result, freeze(Type,coerce(Type,Value,Result)). -coerce('Atom',Value,Result):- !, Value=Result. -coerce('Bool',Value,Result):- var(Value), !, Value=Result, freeze(Value,coerce('Bool',Value,Result)). -coerce('Bool',Value,Result):- is_list(Value),!,as_tf(call_true(Value),Result), -set_list_value(Value,Result). - -set_list_value(Value,Result):- nb_setarg(1,Value,echo),nb_setarg(1,Value,[Result]). - -is_self_eval_l_fa('S',1). -% eval_20(Eq,RetType,Depth,Self,['quote',Eval],RetVal):- !, Eval = RetVal, check_returnval(Eq,RetType,RetVal). -is_self_eval_l_fa('quote',_). -is_self_eval_l_fa('{...}',_). -is_self_eval_l_fa('[...]',_). - -self_eval(X):- notrace(self_eval0(X)). - -:- set_prolog_flag(access_level,system). -hyde(F/A):- functor(P,F,A), redefine_system_predicate(P),'$hide'(F/A), '$iso'(F/A). -:- 'hyde'(option_else/2). -:- 'hyde'(atom/1). -:- 'hyde'(quietly/1). -%:- 'hyde'(fake_notrace/1). -:- 'hyde'(var/1). -:- 'hyde'(is_list/1). -:- 'hyde'(copy_term/2). -:- 'hyde'(nonvar/1). -:- 'hyde'(quietly/1). -%:- 'hyde'(option_value/2). - - -is_metta_declaration([F|_]):- F == '->',!. -is_metta_declaration([F,H,_|T]):- T ==[], is_metta_declaration_f(F,H). - -is_metta_declaration_f(F,H):- F == ':<', !, nonvar(H). -is_metta_declaration_f(F,H):- F == ':>', !, nonvar(H). -is_metta_declaration_f(F,H):- F == '=', !, is_list(H), \+ (current_self(Space), is_user_defined_head_f(Space,F)). - -% is_metta_declaration([F|T]):- is_list(T), is_user_defined_head([F]),!. - -:- nb_setval(self_space, '&self'). -evals_to(XX,Y):- Y=@=XX,!. -evals_to(XX,Y):- Y=='True',!, is_True(XX),!. - -%current_self(Space):- nb_current(self_space,Space). - -do_expander('=',_,X,X):-!. -do_expander(':',_,X,Y):- !, get_type(X,Y)*->X=Y. - -'get_type'(Arg,Type):- 'get-type'(Arg,Type). - - -eval_true(X):- \+ iz_conz(X), callable(X), call(X). -eval_true(X):- eval_args(X,Y), once(var(Y) ; \+ is_False(Y)). - -eval_args(X,Y):- current_self(Self), eval_args(100,Self,X,Y). -eval_args(Depth,Self,X,Y):- eval_args('=',_,Depth,Self,X,Y). -eval_args(Eq,RetType,Depth,Self,X,Y):- eval(Eq,RetType,Depth,Self,X,Y). - -/* -eval_args(Eq,RetTyp e,Depth,Self,X,Y):- - locally(set_prolog_flag(gc,true), - rtrace_on_existence_error( - eval(Eq,RetType,Depth,Self,X,Y))). -*/ - - -%eval(Eq,RetType,Depth,_Self,X,_Y):- forall(between(6,Depth,_),write(' ')),writeqln(eval(Eq,RetType,X)),fail. -eval(Depth,Self,X,Y):- eval('=',_RetType,Depth,Self,X,Y). - -eval(_Eq,_RetType,_Dpth,_Slf,X,Y):- var(X),nonvar(Y),!,X=Y. -eval(_Eq,_RetType,_Dpth,_Slf,X,Y):- notrace(self_eval(X)),!,Y=X. -eval(Eq,RetType,Depth,Self,X,Y):- notrace(nonvar(Y)), var(RetType), - get_type(Depth,Self,Y,RetType), !, - eval(Eq,RetType,Depth,Self,X,Y). -eval(Eq,RetType,Depth,Self,X,Y):- notrace(nonvar(Y)),!, - eval(Eq,RetType,Depth,Self,X,XX),evals_to(XX,Y). - - -eval(Eq,RetType,_Dpth,_Slf,[X|T],Y):- T==[], number(X),!, do_expander(Eq,RetType,X,YY),Y=[YY]. - -/* -eval(Eq,RetType,Depth,Self,[F|X],Y):- - (F=='superpose' ; ( option_value(no_repeats,false))), - fake_notrace((D1 is Depth-1)),!, - eval(Eq,RetType,D1,Self,[F|X],Y). -*/ - -eval(Eq,RetType,Depth,Self,X,Y):- atom(Eq), ( Eq \== ('='), Eq \== ('match')) ,!, - call(call,Eq,'=',RetType,Depth,Self,X,Y). - -eval(_Eq,_RetType,_Dpth,_Slf,X,Y):- self_eval(X),!,Y=X. -eval(Eq,RetType,Depth,Self,X,Y):- eval_00(Eq,RetType,Depth,Self,X,Y). - -eval_00(_Eq,_RetType,Depth,_Slf,X,Y):- Depth<1,!,X=Y, (\+ trace_on_overflow-> true; flag(eval_num,_,0), - debug(metta(eval))). -eval_00(Eq,RetType,Depth,Self,X,YO):- - notrace((Depth2 is Depth-1, - copy_term(X, XX))), - trace_eval(eval_20(Eq,RetType),eval_20,Depth2,Self,X,M), - ((M=@=XX ; self_eval(M))-> Y=M - ;eval_00(Eq,RetType,Depth2,Self,M,Y)), - once(if_or_else((subst_args(Eq,RetType,Depth2,Self,Y,YO)), - if_or_else(finish_eval(Depth2,Self,Y,YO), - Y=YO))). - - -allow_repeats_eval_(_):- !. -allow_repeats_eval_(_):- option_value(no_repeats,false),!. -allow_repeats_eval_(X):- \+ is_list(X),!,fail. -allow_repeats_eval_([F|_]):- atom(F),allow_repeats_eval_f(F). -allow_repeats_eval_f('superpose'). -allow_repeats_eval_f('collapse'). - -debugging_metta(G):- fake_notrace((is_debugging((eval))->ignore(G);true)). - - -:- nodebug(metta(eval)). - -w_indent(Depth,Goal):- - \+ \+ fake_notrace(ignore((( - 'format'('~N'), - setup_call_cleanup(forall(between(Depth,101,_),write(' ')),Goal, 'format'('~N')))))). -indentq(Depth,Term):- - \+ \+ fake_notrace(ignore((( - 'format'('~N'), - setup_call_cleanup(forall(between(Depth,101,_),write(' ')),'format'('~q',[Term]), - 'format'('~N')))))). - - -indentq_d(Depth,Prefix4, Message):- - fake_notrace((flag(eval_num,EX0,EX0), - EX is EX0 mod 500, - DR is 99 - (Depth mod 100), - indentq(DR,EX,Prefix4,Message))). - -indentq(DR,EX,AR,retval(Term)):-nonvar(Term),!,indentq(DR,EX,AR,Term). -indentq(DR,EX,AR,Term):- - \+ \+ - color_g_mesg('#2f2f2f', - fake_notrace(ignore((( 'format'('~N;'), - 'format'('~` t~d~5|:', [EX]), - 'format'('~` t~d~8|', [DR]), - forall(between(1,DR,_),write(' |')),write('-'),write(AR),with_indents(false,write_src(Term)), - 'format'('~N')))))). - - -with_debug(Flag,Goal):- is_debugging(Flag),!, call(Goal). -with_debug(Flag,Goal):- flag(eval_num,_,0), - setup_call_cleanup(set_debug(Flag,true),call(Goal),set_debug(Flag,false)). - -flag_to_var(Flag,Var):- atom(Flag), \+ atom_concat('trace-on-',_,Flag),!,atom_concat('trace-on-',Flag,Var). -flag_to_var(metta(Flag),Var):- !, nonvar(Flag), flag_to_var(Flag,Var). -flag_to_var(Flag,Var):- Flag=Var. - -set_debug(Flag,Val):- \+ atom(Flag), flag_to_var(Flag,Var), atom(Var),!,set_debug(Var,Val). -set_debug(Flag,true):- !, debug(metta(Flag)),flag_to_var(Flag,Var),set_option_value(Var,true). -set_debug(Flag,false):- nodebug(metta(Flag)),flag_to_var(Flag,Var),set_option_value(Var,false). -if_trace((Flag;true),Goal):- !, real_notrace(( catch_err(ignore((Goal)),E,fbug(E-->if_trace((Flag;true),Goal))))). -if_trace(Flag,Goal):- real_notrace((catch_err(ignore((is_debugging(Flag),Goal)),E,fbug(E-->if_trace(Flag,Goal))))). - - -%maybe_efbug(SS,G):- efbug(SS,G)*-> if_trace(eval,fbug(SS=G)) ; fail. -maybe_efbug(_,G):- call(G). -%efbug(P1,G):- call(P1,G). -efbug(_,G):- call(G). - - - -is_debugging(Flag):- var(Flag),!,fail. -is_debugging((A;B)):- !, (is_debugging(A) ; is_debugging(B) ). -is_debugging((A,B)):- !, (is_debugging(A) , is_debugging(B) ). -is_debugging(not(Flag)):- !, \+ is_debugging(Flag). -is_debugging(Flag):- Flag== false,!,fail. -is_debugging(Flag):- Flag== true,!. -is_debugging(Flag):- debugging(metta(Flag),TF),!,TF==true. -is_debugging(Flag):- debugging(Flag,TF),!,TF==true. -is_debugging(Flag):- flag_to_var(Flag,Var), - (option_value(Var,true)->true;(Flag\==Var -> is_debugging(Var))). - -:- nodebug(metta(overflow)). - - -trace_eval(P4,TN,D1,Self,X,Y):- \+ is_debugging(TN), \+ is_debugging(eval),!, call(P4,D1,Self,X,Y). -trace_eval(P4,TN,D1,Self,X,Y):- - must_det_ll(( - notrace(( - flag(eval_num,EX0,EX0+1), - EX is EX0 mod 500, - DR is 99 - (D1 mod 100), - PrintRet = _, - option_else('trace-length',Max,500), - option_else('trace-depth',DMax,30))), - quietly((if_t((nop(stop_rtrace),EX>Max), (set_debug(eval,false),MaxP1 is Max+1, - %set_debug(overflow,false), - nop('format'('; Switched off tracing. For a longer trace: !(pragma! trace-length ~w)',[MaxP1])), - nop((start_rtrace,rtrace)))))), - nop(notrace(no_repeats_var(YY))))), - - if_t(DR',[TN,X])))), - - Ret=retval(fail),!, - - (Display= ((Ret\=@=retval(fail),nonvar(Y)) -> indentq(DR,EX,'<--',[TN,Y]); indentq(DR,EX,'<--',[TN,Ret]))), - - call_cleanup(( - (call(P4,D1,Self,X,Y)*->true; - (fail,trace,(call(P4,D1,Self,X,Y)))), - ignore((fake_notrace(( \+ (Y\=YY), nb_setarg(1,Ret,Y)))))), - % cleanup - (PrintRet==1 -> call(Display) ; - (fake_notrace(ignore((( % Y\=@=X, - if_t(DRtrue;(fail,trace,(call(P4,D1,Self,X,Y)),fail)). - - - -% eval_15(Eq,RetType,Depth,Self,X,Y):- !, eval_20(Eq,RetType,Depth,Self,X,Y). - -eval_15(Eq,RetType,Depth,Self,X,Y):- ((eval_20(Eq,RetType,Depth,Self,X,Y), - if_t(var(Y),fbug((eval_20(Eq,RetType,Depth,Self,X,Y),var(Y)))), - nonvar(Y))*->true;(eval_failed(Depth,Self,X,Y),fail)). - - - - - - - - -:- discontiguous eval_20/6. -:- discontiguous eval_40/6. -%:- discontiguous eval_30fz/5. -%:- discontiguous eval_31/5. -%:- discontiguous eval_defn/5. - -eval_20(Eq,RetType,_Dpth,_Slf,Name,Y):- - atom(Name), !, - (nb_current(Name,X)->do_expander(Eq,RetType,X,Y); - Y = Name). - - -eval_20(Eq,RetType,_Dpth,_Slf,X,Y):- self_eval(X),!,do_expander(Eq,RetType,X,Y). - -% ================================================================= -% ================================================================= -% ================================================================= -% VAR HEADS/ NON-LISTS -% ================================================================= -% ================================================================= -% ================================================================= - -eval_20(Eq,RetType,_Dpth,_Slf,[X|T],Y):- T==[], \+ callable(X),!, do_expander(Eq,RetType,X,YY),Y=[YY]. -%eval_20(Eq,RetType,_Dpth,Self,[X|T],Y):- T==[], atom(X), -% \+ is_user_defined_head_f(Self,X), -% do_expander(Eq,RetType,X,YY),!,Y=[YY]. - -eval_20(Eq,RetType,Depth,Self,X,Y):- atom(Eq), ( Eq \== ('=')) ,!, - call(Eq,'=',RetType,Depth,Self,X,Y). - - -eval_20(Eq,RetType,Depth,Self,[V|VI],VVO):- \+ is_list(VI),!, - eval(Eq,RetType,Depth,Self,VI,VM), - ( VM\==VI -> eval(Eq,RetType,Depth,Self,[V|VM],VVO) ; - (eval(Eq,RetType,Depth,Self,V,VV), (V\==VV -> eval(Eq,RetType,Depth,Self,[VV|VI],VVO) ; VVO = [V|VI]))). - -eval_20(Eq,RetType,_Dpth,_Slf,X,Y):- \+ is_list(X),!,do_expander(Eq,RetType,X,Y). - -eval_20(Eq,_RetType,Depth,Self,[V|VI],[V|VO]):- var(V),is_list(VI),!,maplist(eval(Eq,_ArgRetType,Depth,Self),VI,VO). - -eval_20(_,_,_,_,['echo',Value],Value):- !. -eval_20(=,Type,_,_,['coerce',Type,Value],Result):- !, coerce(Type,Value,Result). - -% ================================================================= -% ================================================================= -% ================================================================= -% TRACE/PRINT -% ================================================================= -% ================================================================= -% ================================================================= - -eval_20(Eq,RetType,_Dpth,_Slf,['repl!'],Y):- !, repl,check_returnval(Eq,RetType,Y). -%eval_20(Eq,RetType,Depth,Self,['enforce',Cond],Res):- !, enforce_true(Eq,RetType,Depth,Self,Cond,Res). -eval_20(Eq,RetType,Depth,Self,['!',Cond],Res):- !, call(eval(Eq,RetType,Depth,Self,Cond,Res)). -eval_20(Eq,RetType,Depth,Self,['rtrace!',Cond],Res):- !, rtrace(eval(Eq,RetType,Depth,Self,Cond,Res)). -eval_20(Eq,RetType,Depth,Self,['trace',Cond],Res):- !, with_debug(eval,eval(Eq,RetType,Depth,Self,Cond,Res)). -eval_20(Eq,RetType,Depth,Self,['time',Cond],Res):- !, time_eval(eval(Cond),eval(Eq,RetType,Depth,Self,Cond,Res)). -eval_20(Eq,RetType,Depth,Self,['print',Cond],Res):- !, eval(Eq,RetType,Depth,Self,Cond,Res),'format'('~N'),print(Res),'format'('~N'). -% !(println! $1) -eval_20(Eq,RetType,Depth,Self,['println!'|Cond],Res):- !, - maplist(eval(Eq,RetType,Depth,Self),Cond,[Res|Out]), - 'format'('~N'),maplist(write_src,[Res|Out]),'format'('~N'). -eval_20(Eq,RetType,Depth,Self,['trace!',A|Cond],Res):- !, maplist(eval(Eq,RetType,Depth,Self),[A|Cond],[AA|Result]), - last(Result,Res), 'format'('~N'),maplist(write_src,[AA]),'format'('~N'). - -%eval_20(Eq,RetType,Depth,Self,['trace!',A,B],C):- !,eval(Eq,RetType,Depth,Self,B,C),'format'('~N'),fbug(['trace!',A,B]=C),'format'('~N'). -%eval_20(Eq,RetType,_Dpth,_Slf,['trace!',A],A):- !, 'format'('~N'),fbug(A),'format'('~N'). - -eval_20(Eq,RetType,_Dpth,_Slf,List,YY):- is_list(List),maplist(self_eval,List),List=[H|_], \+ atom(H), !,Y=List,do_expander(Eq,RetType,Y,YY). - -eval_20(Eq,_ListOfRetType,Depth,Self,['TupleConcat',A,B],OO):- fail, !, - eval(Eq,RetType,Depth,Self,A,AA), - eval(Eq,RetType,Depth,Self,B,BB), - append(AA,BB,OO). -eval_20(Eq,OuterRetType,Depth,Self,['range',A,B],OO):- (is_list(A);is_list(B)), - ((eval(Eq,RetType,Depth,Self,A,AA), - eval(Eq,RetType,Depth,Self,B,BB))), - ((AA+BB)\=@=(A+B)), - eval_20(Eq,OuterRetType,Depth,Self,['range',AA,BB],OO),!. - - -%eval_20(Eq,RetType,Depth,Self,['colapse'|List], Flat):- !, maplist(eval(Eq,RetType,Depth,Self),List,Res),flatten(Res,Flat). - -eval_20(_Eq,_OuterRetType,_Depth,_Self,[P,_,B],_):-P=='/',B==0,!,fail. - - -% ================================================================= -% ================================================================= -% ================================================================= -% UNIT TESTING/assert -% ================================================================= -% ================================================================= -% ================================================================= - - -eval_20(Eq,RetType,Depth,Self,['assertTrue', X],TF):- !, eval(Eq,RetType,Depth,Self,['assertEqual',X,'True'],TF). -eval_20(Eq,RetType,Depth,Self,['assertFalse',X],TF):- !, eval(Eq,RetType,Depth,Self,['assertEqual',X,'False'],TF). - -eval_20(Eq,RetType,Depth,Self,['assertEqual',X,Y],RetVal):- !, - loonit_assert_source_tf( - ['assertEqual',X,Y], - (bagof_eval(Eq,RetType,Depth,Self,X,XX), bagof_eval(Eq,RetType,Depth,Self,Y,YY)), - equal_enough_for_test(XX,YY), TF), - (TF=='True'->return_empty(RetVal);RetVal=[got(XX,[expected,YY])]). - -eval_20(Eq,RetType,Depth,Self,['assertNotEqual',X,Y],RetVal):- !, - loonit_assert_source_tf( - ['assertEqual',X,Y], - (bagof_eval(Eq,RetType,Depth,Self,X,XX), bagof_eval(Eq,RetType,Depth,Self,Y,YY)), - \+ equal_enough(XX,YY), TF), - (TF=='True'->return_empty(RetVal);RetVal=[got(XX,[expected,YY])]). - -eval_20(Eq,RetType,Depth,Self,['assertEqualToResult',X,Y],RetVal):- !, - loonit_assert_source_tf( - ['assertEqualToResult',X,Y], - (bagof_eval(Eq,RetType,Depth,Self,X,XX), sort(Y,YY)), - equal_enough_for_test(XX,YY), TF), - (TF=='True'->return_empty(RetVal);RetVal=[got(XX,[expected,YY])]). - - -loonit_assert_source_tf(Src,Goal,Check,TF):- - copy_term(Goal,OrigGoal), - flag(eval_num,_,0), - loonit_asserts(Src, time_eval('\n; EVAL TEST\n;',Goal), Check), - as_tf(Check,TF),!, - ignore(( - once((TF='True', trace_on_pass);(TF='False', trace_on_fail)), - with_debug(metta(eval),time_eval('Trace',OrigGoal)))). - -sort_result(Res,Res):- \+ compound(Res),!. -sort_result([And|Res1],Res):- is_and(And),!,sort_result(Res1,Res). -sort_result([T,And|Res1],Res):- is_and(And),!,sort_result([T|Res1],Res). -sort_result([H|T],[HH|TT]):- !, sort_result(H,HH),sort_result(T,TT). -sort_result(Res,Res). - -unify_enough(L,L). -unify_enough(L,C):- into_list_args(L,LL),into_list_args(C,CC),unify_lists(CC,LL). - -%unify_lists(C,L):- \+ compound(C),!,L=C. -%unify_lists(L,C):- \+ compound(C),!,L=C. -unify_lists(L,L):-!. -unify_lists([C|CC],[L|LL]):- unify_enough(L,C),!,unify_lists(CC,LL). - -equal_enough(R,V):- is_list(R),is_list(V),sort(R,RR),sort(V,VV),!,equal_enouf(RR,VV),!. -equal_enough(R,V):- copy_term(R,RR),copy_term(V,VV),equal_enouf(R,V),!,R=@=RR,V=@=VV. - -%s_empty(X):- var(X),!. -s_empty(X):- var(X),!,fail. -is_empty('Empty'). -is_empty([]). -is_empty([X]):-!,is_empty(X). -has_let_star(Y):- sub_var('let*',Y). - -equal_enough_for_test(X,Y):- is_empty(X),!,is_empty(Y). -equal_enough_for_test(X,Y):- has_let_star(Y),!,\+ is_empty(X). -equal_enough_for_test(X,Y):- must_det_ll((subst_vars(X,XX),subst_vars(Y,YY))),!,equal_enough_for_test2(XX,YY),!. -equal_enough_for_test2(X,Y):- equal_enough(X,Y). - -equal_enouf(R,V):- is_ftVar(R), is_ftVar(V), R=V,!. -equal_enouf(X,Y):- is_empty(X),!,is_empty(Y). -equal_enouf(X,Y):- symbol(X),symbol(Y),atom_concat('&',_,X),atom_concat('Grounding',_,Y). -equal_enouf(R,V):- R=@=V, R=V, !. -equal_enouf(_,V):- V=@='...',!. -equal_enouf(L,C):- is_list(L),into_list_args(C,CC),!,equal_enouf_l(CC,L). -equal_enouf(C,L):- is_list(L),into_list_args(C,CC),!,equal_enouf_l(CC,L). -%equal_enouf(R,V):- (var(R),var(V)),!, R=V. -equal_enouf(R,V):- (var(R);var(V)),!, R==V. -equal_enouf(R,V):- number(R),number(V),!, RV is abs(R-V), RV < 0.03 . -equal_enouf(R,V):- atom(R),!,atom(V), has_unicode(R),has_unicode(V). -equal_enouf(R,V):- (\+ compound(R) ; \+ compound(V)),!, R==V. -equal_enouf(L,C):- into_list_args(L,LL),into_list_args(C,CC),!,equal_enouf_l(CC,LL). - -equal_enouf_l([S1,V1|_],[S2,V2|_]):- S1 == 'State',S2 == 'State',!, equal_enouf(V1,V2). -equal_enouf_l(C,L):- \+ compound(C),!,L=@=C. -equal_enouf_l(L,C):- \+ compound(C),!,L=@=C. -equal_enouf_l([C|CC],[L|LL]):- !, equal_enouf(L,C),!,equal_enouf_l(CC,LL). - - -has_unicode(A):- atom_codes(A,Cs),member(N,Cs),N>127,!. - -set_last_error(_). - -% ================================================================= -% ================================================================= -% ================================================================= -% SPACE EDITING -% ================================================================= -% ================================================================= -% ================================================================= - -eval_20(Eq,RetType,_Dpth,_Slf,['new-space'],Space):- !, 'new-space'(Space),check_returnval(Eq,RetType,Space). - -eval_20(Eq,RetType,Depth,Self,[Op,Space|Args],Res):- is_space_op(Op),!, - eval_space_start(Eq,RetType,Depth,Self,[Op,Space|Args],Res). - - -eval_space_start(Eq,RetType,_Depth,_Self,[_Op,_Other,Atom],Res):- - (Atom == [] ; Atom =='Empty'; Atom =='Nil'),!,return_empty('False',Res),check_returnval(Eq,RetType,Res). - -eval_space_start(Eq,RetType,Depth,Self,[Op,Other|Args],Res):- - into_space(Depth,Self,Other,Space), - eval_space(Eq,RetType,Depth,Self,[Op,Space|Args],Res). - - -eval_space(Eq,RetType,_Dpth,_Slf,['add-atom',Space,PredDecl],Res):- !, - do_metta(python,load,Space,PredDecl,TF),return_empty(TF,Res),check_returnval(Eq,RetType,Res). - -eval_space(Eq,RetType,_Dpth,_Slf,['remove-atom',Space,PredDecl],Res):- !, - do_metta(python,unload,Space,PredDecl,TF),return_empty(TF,Res),check_returnval(Eq,RetType,Res). - -eval_space(Eq,RetType,_Dpth,_Slf,['atom-count',Space],Count):- !, - ignore(RetType='Number'),ignore(Eq='='), - findall(Atom, get_metta_atom_from(Space, Atom),Atoms), - length(Atoms,Count). - -eval_space(Eq,RetType,_Dpth,_Slf,['atom-replace',Space,Rem,Add],TF):- !, - copy_term(Rem,RCopy), as_tf((metta_atom_iter_ref(Space,RCopy,Ref), RCopy=@=Rem,erase(Ref), do_metta(Space,load,Add)),TF), - check_returnval(Eq,RetType,TF). - -eval_space(Eq,RetType,_Dpth,_Slf,['get-atoms',Space],Atom):- !, - ignore(RetType='Atom'), get_metta_atom_from(Space, Atom), check_returnval(Eq,RetType,Atom). - -% Match-ELSE -eval_space(Eq,RetType,Depth,Self,['match',Other,Goal,Template,Else],Template):- !, - ((eval_space(Eq,RetType,Depth,Self,['match',Other,Goal,Template],Template), - \+ return_empty([],Template))*->true;Template=Else). -% Match-TEMPLATE - -eval_space(Eq,_RetType,Depth,Self,['match',Other,Goal,Template],Res):- !, - metta_atom_iter(Eq,Depth,Self,Other,Goal), - Template=Res. - -metta_atom_iter(Eq,_Depth,_Slf,Other,[Equal,[F|H],B]):- Eq == Equal,!, % trace, - metta_defn(Eq,Other,[F|H],B). - -/* -metta_atom_iter(Eq,Depth,Self,Other,[Equal,[F|H],B]):- Eq == Equal,!, % trace, - metta_defn(Eq,Other,[F|H],BB), - eval_sometimes(Eq,_RetType,Depth,Self,B,BB). -*/ - -metta_atom_iter(_Eq,Depth,_,_,_):- Depth<3,!,fail. -metta_atom_iter(Eq,Depth,Self,Other,[And|Y]):- atom(And), is_and(And),!, - (Y==[] -> true ; - ( D2 is Depth -1, Y = [H|T], - metta_atom_iter(Eq,D2,Self,Other,H),metta_atom_iter(Eq,D2,Self,Other,[And|T]))). - -%metta_atom_iter(Eq,Depth,_Slf,Other,X):- dcall0000000000(eval_args_true(Eq,_RetType,Depth,Other,X)). -metta_atom_iter(Eq,Depth,_Slf,Other,X):- - %copy_term(X,XX), - dcall0000000000(eval_args_true(Eq,_RetType,Depth,Other,XX)), X=XX. - - -eval_args_true_r(Eq,RetType,Depth,Self,X,TF1):- - ((eval_ne(Eq,RetType,Depth,Self,X,TF1), \+ is_False(TF1)); - ( \+ is_False(TF1),metta_atom_true(Eq,Depth,Self,Self,X))). - -eval_args_true(Eq,RetType,Depth,Self,X):- - metta_atom_true(Eq,Depth,Self,Self,X); - (nonvar(X),eval_ne(Eq,RetType,Depth,Self,X,TF1), \+ is_False(TF1)). - -metta_atom_true(Eq,_Dpth,_Slf,Other,H):- get_metta_atom(Eq,Other,H). -% is this OK? -metta_atom_true(Eq,Depth,Self,Other,H):- nonvar(H), metta_defn(Eq,Other,H,B), D2 is Depth -1, eval_args_true(Eq,_,D2,Self,B). -% is this OK? -metta_atom_true(Eq,Depth,Self,Other,H):- Other\==Self, nonvar(H), metta_defn(Eq,Other,H,B), D2 is Depth -1, eval_args_true(Eq,_,D2,Other,B). - - - -metta_atom_iter_ref(Other,H,Ref):-clause(metta_atom_asserted(Other,H),true,Ref). - - -% ================================================================= -% ================================================================= -% ================================================================= -% CASE/SWITCH -% ================================================================= -% ================================================================= -% ================================================================= -% Macro: case -:- nodebug(metta(case)). - -eval_20(Eq,RetType,Depth,Self,[P,X|More],YY):- is_list(X),X=[_,_,_],simple_math(X), - eval_selfless_2(X,XX),X\=@=XX,!, eval_20(Eq,RetType,Depth,Self,[P,XX|More],YY). -% if there is only a void then always return nothing for each Case -eval_20(Eq,_RetType,Depth,Self,['case',A,[[Void,_]]],Res):- - '%void%' == Void, - eval(Eq,_UnkRetType,Depth,Self,A,_),!,Res =[]. - -% if there is nothing for case just treat like a collapse -eval_20(Eq,_RetType,Depth,Self,['case',A,[]],Empty):- !, - %forall(eval(Eq,_RetType2,Depth,Self,Expr,_),true), - once(eval(Eq,_RetType2,Depth,Self,A,_)), - return_empty([],Empty). - -% Macro: case -eval_20(Eq,RetType,Depth,Self,['case',A,CL|T],Res):- !, - must_det_ll(T==[]), - into_case_list(CL,CASES), - findall(Key-Value, - (nth0(Nth,CASES,Case0), - (is_case(Key,Case0,Value), - if_trace(metta(case),('format'('~N'),writeqln(c(Nth,Key)=Value))))),KVs),!, - eval_case(Eq,RetType,Depth,Self,A,KVs,Res). - -eval_case(Eq,CaseRetType,Depth,Self,A,KVs,Res):- - ((eval(Eq,_UnkRetType,Depth,Self,A,AA), - if_trace((case),(writeqln('case'=A))), - if_trace(metta(case),writeqln('switch'=AA)), - (select_case(Depth,Self,AA,KVs,Value)->true;(member(Void -Value,KVs),Void=='%void%'))) - *->true;(member(Void -Value,KVs),Void=='%void%')), - eval(Eq,CaseRetType,Depth,Self,Value,Res). - - select_case(Depth,Self,AA,Cases,Value):- - (best_key(AA,Cases,Value) -> true ; - (maybe_special_keys(Depth,Self,Cases,CasES), - (best_key(AA,CasES,Value) -> true ; - (member(Void -Value,CasES),Void=='%void%')))). - - best_key(AA,Cases,Value):- - ((member(Match-Value,Cases),AA ==Match)->true; - ((member(Match-Value,Cases),AA=@=Match)->true; - (member(Match-Value,Cases),AA = Match))). - - into_case_list(CASES,CASES):- is_list(CASES),!. - is_case(AA,[AA,Value],Value):-!. - is_case(AA,[AA|Value],Value). - - maybe_special_keys(Depth,Self,[K-V|KVI],[AK-V|KVO]):- - eval(Depth,Self,K,AK), K\=@=AK,!, - maybe_special_keys(Depth,Self,KVI,KVO). - maybe_special_keys(Depth,Self,[_|KVI],KVO):- - maybe_special_keys(Depth,Self,KVI,KVO). - maybe_special_keys(_Depth,_Self,[],[]). - - -% ================================================================= -% ================================================================= -% ================================================================= -% COLLAPSE/SUPERPOSE -% ================================================================= -% ================================================================= -% ================================================================= - - - -%[collapse,[1,2,3]] -eval_20(Eq,RetType,Depth,Self,['collapse',List],Res):-!, - bagof_eval(Eq,RetType,Depth,Self,List,Res). - -eval_20(Eq,RetType,Depth,Self,PredDecl,Res):- - Do_more_defs = do_more_defs(true), - clause(eval_21(Eq,RetType,Depth,Self,PredDecl,Res),Body), - Do_more_defs == do_more_defs(true), - call_ndet(Body,DET), - nb_setarg(1,Do_more_defs,false), - (DET==true -> ! ; true). - -eval_21(_Eq,_RetType,_Depth,_Self,['fb-member',Res,List],TF):-!, as_tf(fb_member(Res,List),TF). -eval_21(_Eq,_RetType,_Depth,_Self,['fb-member',List],Res):-!, fb_member(Res,List). - - -eval_21(Eq,RetType,Depth,Self,['CollapseCardinality',List],Len):-!, - bagof_eval(Eq,RetType,Depth,Self,List,Res), - length(Res,Len). -/* -eval_21(_Eq,_RetType,_Depth,_Self,['TupleCount', [N]],N):- number(N),!. - - -*/ -eval_21(Eq,RetType,Depth,Self,['TupleCount',List],Len):-!, - bagof_eval(Eq,RetType,Depth,Self,List,Res), - length(Res,Len). -eval_21(_Eq,_RetType,_Depth,_Self,['tuple-count',List],Len):-!, - length(List,Len). - -%[superpose,[1,2,3]] -eval_20(Eq,RetType,Depth,Self,['superpose',List],Res):- !, - (((is_user_defined_head(Eq,Self,List) ,eval(Eq,RetType,Depth,Self,List,UList), List\=@=UList) - *-> eval_20(Eq,RetType,Depth,Self,['superpose',UList],Res) - ; ((member(E,List),eval(Eq,RetType,Depth,Self,E,Res))*->true;return_empty([],Res)))), - \+ Res = 'Empty'. - -%[sequential,[1,2,3]] -eval_20(Eq,RetType,Depth,Self,['sequential',List],Res):- !, - (((fail,is_user_defined_head(Eq,Self,List) ,eval(Eq,RetType,Depth,Self,List,UList), List\=@=UList) - *-> eval_20(Eq,RetType,Depth,Self,['sequential',UList],Res) - ; ((member(E,List),eval_ne(Eq,RetType,Depth,Self,E,Res))*->true;return_empty([],Res)))). - - -get_sa_p1(P3,E,Cmpd,SA):- compound(Cmpd), get_sa_p2(P3,E,Cmpd,SA). -get_sa_p2(P3,E,Cmpd,call(P3,N1,Cmpd)):- arg(N1,Cmpd,E). -get_sa_p2(P3,E,Cmpd,SA):- arg(_,Cmpd,Arg),get_sa_p1(P3,E,Arg,SA). -eval20_failed(Eq,RetType,Depth,Self, Term, Res):- - fake_notrace(( get_sa_p1(setarg,ST,Term,P1), % ST\==Term, - compound(ST), ST = [F,List],F=='superpose',nonvar(List), %maplist(atomic,List), - call(P1,Var))), !, - %max_counting(F,20), - member(Var,List), - eval(Eq,RetType,Depth,Self, Term, Res). - - -sub_sterm(Sub,Sub). -sub_sterm(Sub,Term):- sub_sterm1(Sub,Term). -sub_sterm1(_ ,List):- \+ compound(List),!,fail. -sub_sterm1(Sub,List):- is_list(List),!,member(SL,List),sub_sterm(Sub,SL). -sub_sterm1(_ ,[_|_]):-!,fail. -sub_sterm1(Sub,Term):- arg(_,Term,SL),sub_sterm(Sub,SL). -eval20_failed_2(Eq,RetType,Depth,Self, Term, Res):- - fake_notrace(( get_sa_p1(setarg,ST,Term,P1), - compound(ST), ST = [F,List],F=='collapse',nonvar(List), %maplist(atomic,List), - call(P1,Var))), !, bagof_eval(Eq,RetType,Depth,Self,List,Var), - eval(Eq,RetType,Depth,Self, Term, Res). - - -% ================================================================= -% ================================================================= -% ================================================================= -% NOP/EQUALITU/DO -% ================================================================= -% ================================================================= -% ================================================================ -eval_20(_Eq,_RetType,_Depth,_Self,['nop'], _ ):- !, fail. -eval_20(_Eq,_RetType,_Depth,_Self,['empty'], _ ):- !, fail. -eval_20(_Eq,_RetType1,Depth,Self,['nop',Expr], Empty):- !, - ignore(eval('=',_RetType2,Depth,Self,Expr,_)), - return_empty([], Empty). - -eval_20(Eq,_RetType1,Depth,Self,['do',Expr], Empty):- !, - forall(eval(Eq,_RetType2,Depth,Self,Expr,_),true), - %eval_ne(Eq,_RetType2,Depth,Self,Expr,_),!, - return_empty([],Empty). - -eval_20(_Eq,_RetType1,_Depth,_Self,['call',S], TF):- !, eval_call(S,TF). - -max_counting(F,Max):- flag(F,X,X+1), X true; (flag(F,_,10),!,fail). -% ================================================================= -% ================================================================= -% ================================================================= -% if/If -% ================================================================= -% ================================================================= -% ================================================================= - - - -eval_20(Eq,RetType,Depth,Self,['if',Cond,Then,Else],Res):- !, - eval(Eq,'Bool',Depth,Self,Cond,TF), - (is_True(TF) - -> eval(Eq,RetType,Depth,Self,Then,Res) - ; eval(Eq,RetType,Depth,Self,Else,Res)). - -eval_20(Eq,RetType,Depth,Self,['If',Cond,Then,Else],Res):- !, - eval(Eq,'Bool',Depth,Self,Cond,TF), - (is_True(TF) - -> eval(Eq,RetType,Depth,Self,Then,Res) - ; eval(Eq,RetType,Depth,Self,Else,Res)). - -eval_20(Eq,RetType,Depth,Self,['If',Cond,Then],Res):- !, - eval(Eq,'Bool',Depth,Self,Cond,TF), - (is_True(TF) -> eval(Eq,RetType,Depth,Self,Then,Res) ; - (!, fail,Res = [],!)). - -eval_20(Eq,RetType,Depth,Self,['if',Cond,Then],Res):- !, - eval(Eq,'Bool',Depth,Self,Cond,TF), - (is_True(TF) -> eval(Eq,RetType,Depth,Self,Then,Res) ; - (!, fail,Res = [],!)). - - -eval_20(Eq,RetType,_Dpth,_Slf,[_,Nothing],NothingO):- - 'Nothing'==Nothing,!,do_expander(Eq,RetType,Nothing,NothingO). - -% ================================================================= -% ================================================================= -% ================================================================= -% LET/LET* -% ================================================================= -% ================================================================= -% ================================================================= - - - -eval_until_unify(_Eq,_RetType,_Dpth,_Slf,X,X):- !. -eval_until_unify(Eq,RetType,Depth,Self,X,Y):- eval_until_eq(Eq,RetType,Depth,Self,X,Y),!. - -eval_until_eq(Eq,RetType,_Dpth,_Slf,X,Y):- X=Y,check_returnval(Eq,RetType,Y). -%eval_until_eq(Eq,RetType,Depth,Self,X,Y):- var(Y),!,eval_in_steps_or_same(Eq,RetType,Depth,Self,X,XX),Y=XX. -%eval_until_eq(Eq,RetType,Depth,Self,Y,X):- var(Y),!,eval_in_steps_or_same(Eq,RetType,Depth,Self,X,XX),Y=XX. -eval_until_eq(Eq,RetType,Depth,Self,X,Y):- \+is_list(Y),!,eval_in_steps_some_change(Eq,RetType,Depth,Self,X,XX),Y=XX. -eval_until_eq(Eq,RetType,Depth,Self,Y,X):- \+is_list(Y),!,eval_in_steps_some_change(Eq,RetType,Depth,Self,X,XX),Y=XX. -eval_until_eq(Eq,RetType,Depth,Self,X,Y):- eval_in_steps_some_change(Eq,RetType,Depth,Self,X,XX),eval_until_eq(Eq,RetType,Depth,Self,Y,XX). -eval_until_eq(_Eq,_RetType,_Dpth,_Slf,X,Y):- length(X,Len), \+ length(Y,Len),!,fail. -eval_until_eq(Eq,RetType,Depth,Self,X,Y):- nth1(N,X,EX,RX), nth1(N,Y,EY,RY), - EX=EY,!, maplist(eval_until_eq(Eq,RetType,Depth,Self),RX,RY). -eval_until_eq(Eq,RetType,Depth,Self,X,Y):- nth1(N,X,EX,RX), nth1(N,Y,EY,RY), - ((var(EX);var(EY)),eval_until_eq(Eq,RetType,Depth,Self,EX,EY)), - maplist(eval_until_eq(Eq,RetType,Depth,Self),RX,RY). -eval_until_eq(Eq,RetType,Depth,Self,X,Y):- nth1(N,X,EX,RX), nth1(N,Y,EY,RY), - h((is_list(EX);is_list(EY)),eval_until_eq(Eq,RetType,Depth,Self,EX,EY)), - maplist(eval_until_eq(Eq,RetType,Depth,Self),RX,RY). - - eval_1change(Eq,RetType,Depth,Self,EX,EXX):- - eval_20(Eq,RetType,Depth,Self,EX,EXX), EX \=@= EXX. - -eval_complete_change(Eq,RetType,Depth,Self,EX,EXX):- - eval(Eq,RetType,Depth,Self,EX,EXX), EX \=@= EXX. - -eval_in_steps_some_change(_Eq,_RetType,_Dpth,_Slf,EX,_):- \+ is_list(EX),!,fail. -eval_in_steps_some_change(Eq,RetType,Depth,Self,EX,EXX):- eval_1change(Eq,RetType,Depth,Self,EX,EXX). -eval_in_steps_some_change(Eq,RetType,Depth,Self,X,Y):- append(L,[EX|R],X),is_list(EX), - eval_in_steps_some_change(Eq,RetType,Depth,Self,EX,EXX), EX\=@=EXX, - append(L,[EXX|R],XX),eval_in_steps_or_same(Eq,RetType,Depth,Self,XX,Y). - -eval_in_steps_or_same(Eq,RetType,Depth,Self,X,Y):-eval_in_steps_some_change(Eq,RetType,Depth,Self,X,Y). -eval_in_steps_or_same(Eq,RetType,_Dpth,_Slf,X,Y):- X=Y,check_returnval(Eq,RetType,Y). - - % (fail,return_empty([],Template))). -possible_type(_Self,_Var,_RetTypeV). - -eval_20(Eq,RetType,Depth,Self,['let',A,A5,AA],OO):- !, - %(var(A)->true;trace), - possible_type(Self,A,RetTypeV), - eval(Eq,RetTypeV,Depth,Self,A5,AR), A=AR, - eval(Eq,RetType,Depth,Self,AA,OO). - -%eval_20(Eq,RetType,Depth,Self,['let',A,A5,AA],AAO):- !,eval(Eq,RetType,Depth,Self,A5,A),eval(Eq,RetType,Depth,Self,AA,AAO). -eval_20(Eq,RetType,Depth,Self,['let*',[],Body],RetVal):- !, eval(Eq,RetType,Depth,Self,Body,RetVal). -%eval_20(Eq,RetType,Depth,Self,['let*',[[Var,Val]|LetRest],Body],RetVal):- !, -% eval_until_unify(Eq,_RetTypeV,Depth,Self,Val,Var), -% eval_20(Eq,RetType,Depth,Self,['let*',LetRest,Body],RetVal). -eval_20(Eq,RetType,Depth,Self,['let*',[[Var,Val]|LetRest],Body],RetVal):- !, - eval_20(Eq,RetType,Depth,Self,['let',Var,Val,['let*',LetRest,Body]],RetVal). - - -% ================================================================= -% ================================================================= -% ================================================================= -% CONS/CAR/CDR -% ================================================================= -% ================================================================= -% ================================================================= - - - -into_pl_list(Var,Var):- var(Var),!. -into_pl_list(Nil,[]):- Nil == 'Nil',!. -into_pl_list([Cons,H,T],[HH|TT]):- Cons == 'Cons', !, into_pl_list(H,HH),into_pl_list(T,TT),!. -into_pl_list(X,X). - -into_metta_cons(Var,Var):- var(Var),!. -into_metta_cons([],'Nil'):-!. -into_metta_cons([Cons, A, B ],['Cons', AA, BB]):- 'Cons'==Cons, no_cons_reduce, !, - into_metta_cons(A,AA), into_metta_cons(B,BB). -into_metta_cons([H|T],['Cons',HH,TT]):- into_metta_cons(H,HH),into_metta_cons(T,TT),!. -into_metta_cons(X,X). - -into_listoid(AtomC,Atom):- AtomC = [Cons,H,T],Cons=='Cons',!, Atom=[H,[T]]. -into_listoid(AtomC,Atom):- is_list(AtomC),!,Atom=AtomC. -into_listoid(AtomC,Atom):- typed_list(AtomC,_,Atom),!. - -:- if( \+ current_predicate( typed_list / 3 )). -typed_list(Cmpd,Type,List):- compound(Cmpd), Cmpd\=[_|_], compound_name_arguments(Cmpd,Type,[List|_]),is_list(List). -:- endif. - -%eval_20(Eq,RetType,Depth,Self,['colapse'|List], Flat):- !, maplist(eval(Eq,RetType,Depth,Self),List,Res),flatten(Res,Flat). - -%eval_20(Eq,RetType,Depth,Self,['flatten'|List], Flat):- !, maplist(eval(Eq,RetType,Depth,Self),List,Res),flatten(Res,Flat). - - -eval_20(Eq,RetType,_Dpth,_Slf,['car-atom',Atom],CAR_Y):- !, Atom=[CAR|_],!,do_expander(Eq,RetType,CAR,CAR_Y). -eval_20(Eq,RetType,_Dpth,_Slf,['cdr-atom',Atom],CDR_Y):- !, Atom=[_|CDR],!,do_expander(Eq,RetType,CDR,CDR_Y). - -eval_20(Eq,RetType,Depth,Self,['Cons', A, B ],['Cons', AA, BB]):- no_cons_reduce, !, - eval(Eq,RetType,Depth,Self,A,AA), eval(Eq,RetType,Depth,Self,B,BB). - -%eval_20(_Eq,_RetType,Depth,Self,['::'|PL],Prolog):- maplist(as_prolog(Depth,Self),PL,Prolog),!. -%eval_20(_Eq,_RetType,Depth,Self,['@'|PL],Prolog):- as_prolog(Depth,Self,['@'|PL],Prolog),!. - -eval_20(Eq,RetType,Depth,Self,['Cons', A, B ],[AA|BB]):- \+ no_cons_reduce, !, - eval(Eq,RetType,Depth,Self,A,AA), eval(Eq,RetType,Depth,Self,B,BB). - - - -% ================================================================= -% ================================================================= -% ================================================================= -% STATE EDITING -% ================================================================= -% ================================================================= -% ================================================================= - -eval_20(Eq,RetType,Depth,Self,['change-state!',StateExpr, UpdatedValue], Ret):- !, - call_in_shared_space(((eval(Eq,RetType,Depth,Self,StateExpr,StateMonad), - eval(Eq,RetType,Depth,Self,UpdatedValue,Value), 'change-state!'(Depth,Self,StateMonad, Value, Ret)))). -eval_20(Eq,RetType,Depth,Self,['new-state',UpdatedValue],StateMonad):- !, - call_in_shared_space(((eval(Eq,RetType,Depth,Self,UpdatedValue,Value), 'new-state'(Depth,Self,Value,StateMonad)))). -eval_20(Eq,RetType,Depth,Self,['get-state',StateExpr],Value):- !, - call_in_shared_space((eval(Eq,RetType,Depth,Self,StateExpr,StateMonad), 'get-state'(StateMonad,Value))). - -call_in_shared_space(G):- call_in_thread(main,G). - -% eval_20(Eq,RetType,Depth,Self,['get-state',Expr],Value):- !, eval(Eq,RetType,Depth,Self,Expr,State), arg(1,State,Value). - - - -check_type:- option_else(typecheck,TF,'False'), TF=='True'. - -:- dynamic is_registered_state/1. -:- flush_output. -:- setenv('RUST_BACKTRACE',full). - -% Function to check if an value is registered as a state name -:- dynamic(is_registered_state/1). -is_nb_state(G):- is_valid_nb_state(G) -> true ; - is_registered_state(G),nb_current(G,S),is_valid_nb_state(S). - - -:- multifile(state_type_method/3). -:- dynamic(state_type_method/3). -state_type_method(is_nb_state,new_state,init_state). -state_type_method(is_nb_state,clear_state,clear_nb_values). -state_type_method(is_nb_state,add_value,add_nb_value). -state_type_method(is_nb_state,remove_value,'change-state!'). -state_type_method(is_nb_state,replace_value,replace_nb_value). -state_type_method(is_nb_state,value_count,value_nb_count). -state_type_method(is_nb_state,'get-state','get-state'). -state_type_method(is_nb_state,value_iter,value_nb_iter). -%state_type_method(is_nb_state,query,state_nb_query). - -% Clear all values from a state -clear_nb_values(StateNameOrInstance) :- - fetch_or_create_state(StateNameOrInstance, State), - nb_setarg(1, State, []). - - - -% Function to confirm if a term represents a state -is_valid_nb_state(State):- compound(State),functor(State,'State',_). - -% Find the original name of a given state -state_original_name(State, Name) :- - is_registered_state(Name), - call_in_shared_space(nb_current(Name, State)). - -% Register and initialize a new state -init_state(Name) :- - State = 'State'(_,_), - asserta(is_registered_state(Name)), - call_in_shared_space(nb_setval(Name, State)). - -% Change a value in a state -'change-state!'(Depth,Self,StateNameOrInstance, UpdatedValue, Out) :- - fetch_or_create_state(StateNameOrInstance, State), - arg(2, State, Type), - ( (check_type,\+ get_type(Depth,Self,UpdatedValue,Type)) - -> (Out = ['Error', UpdatedValue, 'BadType']) - ; (nb_setarg(1, State, UpdatedValue), Out = State) ). - -% Fetch all values from a state -'get-state'(StateNameOrInstance, Values) :- - fetch_or_create_state(StateNameOrInstance, State), - arg(1, State, Values). - -'new-state'(Depth,Self,Init,'State'(Init, Type)):- check_type->get_type(Depth,Self,Init,Type);true. - -'new-state'(Init,'State'(Init, Type)):- check_type->get_type(10,'&self',Init,Type);true. - -fetch_or_create_state(Name):- fetch_or_create_state(Name,_). -% Fetch an existing state or create a new one - -fetch_or_create_state(State, State) :- is_valid_nb_state(State),!. -fetch_or_create_state(NameOrInstance, State) :- - ( atom(NameOrInstance) - -> (is_registered_state(NameOrInstance) - -> nb_current(NameOrInstance, State) - ; init_state(NameOrInstance), - nb_current(NameOrInstance, State)) - ; is_valid_nb_state(NameOrInstance) - -> State = NameOrInstance - ; writeln('Error: Invalid input.') - ), - is_valid_nb_state(State). - -% ================================================================= -% ================================================================= -% ================================================================= -% GET-TYPE -% ================================================================= -% ================================================================= -% ================================================================= - -eval_20(Eq,RetType,Depth,Self,['get-type',Val],TypeO):- !, - eval_get_type(Eq,RetType,Depth,Self,Val,TypeO). - - -eval_get_type(Eq,RetType,Depth,Self,Val,TypeO):- - get_type(Depth,Self,Val,Type),ground(Type),Type\==[], Type\==Val,!, - do_expander(Eq,RetType,Type,TypeO). - - - -eval_20(Eq,RetType,Depth,Self,['length',L],Res):- !, eval(Eq,RetType,Depth,Self,L,LL), !, (is_list(LL)->length(LL,Res);Res=1). -eval_20(Eq,RetType,Depth,Self,['CountElement',L],Res):- !, eval(Eq,RetType,Depth,Self,L,LL), !, (is_list(LL)->length(LL,Res);Res=1). - -eval_20(_Eq,_RetType,_Depth,_Self,['get-metatype',Val],TypeO):- !, - get_metatype(Val,TypeO). - -get_metatype(Val,Want):- get_metatype0(Val,Was),!,Want=Was. -get_metatype0(Val,'Variable'):- var(Val). -get_metatype0(Val,'Symbol'):- symbol(Val). -get_metatype0(Val,'Expression'):- is_list(Val). -get_metatype0(_Val,'Grounded'). - - - - - -% ================================================================= -% ================================================================= -% ================================================================= -% IMPORT/BIND -% ================================================================= -% ================================================================= -% ================================================================= -nb_bind(Name,Value):- nb_current(Name,Was),same_term(Value,Was),!. -nb_bind(Name,Value):- call_in_shared_space(nb_setval(Name,Value)),!. -eval_20(Eq,RetType,Depth,Self,['import!',Other,File],RetVal):- !, - (( into_space(Depth,Self,Other,Space), include_metta(Space,File),!,return_empty(Space,RetVal))), - check_returnval(Eq,RetType,RetVal). %RetVal=[]. -eval_20(Eq,RetType,_Depth,_Slf,['bind!',Other,['new-space']],RetVal):- atom(Other),!,assert(was_asserted_space(Other)), - return_empty([],RetVal), check_returnval(Eq,RetType,RetVal). -eval_20(Eq,RetType,Depth,Self,['bind!',Other,Expr],RetVal):- !, - must_det_ll((into_name(Self,Other,Name),!,eval(Eq,RetType,Depth,Self,Expr,Value), - nb_bind(Name,Value), return_empty(Value,RetVal))), - check_returnval(Eq,RetType,RetVal). -eval_20(Eq,RetType,Depth,Self,['pragma!',Other,Expr],RetVal):- !, - must_det_ll((into_name(Self,Other,Name),nd_ignore((eval(Eq,RetType,Depth,Self,Expr,Value), - set_option_value_interp(Name,Value))), return_empty(Value,RetVal), - check_returnval(Eq,RetType,RetVal))). -eval_20(Eq,RetType,_Dpth,Self,['transfer!',File],RetVal):- !, must_det_ll((include_metta(Self,File), - return_empty(Self,RetVal),check_returnval(Eq,RetType,RetVal))). - - -fromNumber(Var1,Var2):- var(Var1),var(Var2),!,freeze(Var1,fromNumber(Var1,Var2)),freeze(Var2,fromNumber(Var1,Var2)). -fromNumber(0,'Z'):-!. -fromNumber(N,['S',Nat]):- integer(N), M is N -1,!,fromNumber(M,Nat). - -eval_20(Eq,RetType,Depth,Self,['fromNumber',NE],RetVal):- !, - eval('=','Number',Depth,Self,NE,N), - fromNumber(N,RetVal), check_returnval(Eq,RetType,RetVal). - -eval_20(Eq,RetType,Depth,Self,['dedup!',Eval],RetVal):- !, - term_variables(Eval+RetVal,Vars), - no_repeats_var(YY),!, - eval_20(Eq,RetType,Depth,Self,Eval,RetVal),YY=Vars. - - -nd_ignore(Goal):- call(Goal)*->true;true. - - - - - - - - - -% ================================================================= -% ================================================================= -% ================================================================= -% AND/OR -% ================================================================= -% ================================================================= -% ================================================================= - -is_True(T):- atomic(T), T\=='False', T\==0. - -is_and(S):- \+ atom(S),!,fail. -is_and(','). -is_and(S):- is_and(S,_). - -is_and(S,_):- \+ atom(S),!,fail. -is_and('and','True'). -is_and('and2','True'). -is_and('#COMMA','True'). is_and(',','True'). % is_and('And'). - -is_comma(C):- var(C),!,fail. -is_comma(','). -is_comma('{}'). - -eval_20(Eq,RetType,Depth,Self,[Comma,X ],Res):- is_comma(Comma),!, eval_args(Eq,RetType,Depth,Self,X,Res). -eval_20(Eq,RetType,Depth,Self,[Comma,X,Y],Res):- is_comma(Comma),!, eval_args(Eq,_,Depth,Self,X,_), - eval_args(Eq,RetType,Depth,Self,Y,Res). -eval_20(Eq,RetType,Depth,Self,[Comma,X|Y],Res):- is_comma(Comma),!, eval_args(Eq,_,Depth,Self,X,_), - eval_args(Eq,RetType,Depth,Self,[Comma|Y],Res). - - -eval_20(Eq,RetType,_Dpth,_Slf,[And],True):- is_and(And,True),!,check_returnval(Eq,RetType,True). -%eval_20(Eq,RetType,Depth,Self,[And,X,Y],TF):- is_and(And,True),!, -% as_tf(( eval_args(Eq,RetType,Depth,Self,X,True),eval_args(Eq,RetType,Depth,Self,Y,True)),TF). -eval_20(Eq,RetType,Depth,Self,[And,X],TF):- is_and(And,True),!, as_tf(eval_args(Eq,RetType,Depth,Self,X,True),TF). -eval_20(Eq,RetType,Depth,Self,[And,X|Y],TF):- is_and(And,True),!, as_tf(eval_args(Eq,RetType,Depth,Self,X,True),TF1), - (TF1=='False' -> TF=TF1 ; eval_args(Eq,RetType,Depth,Self,[And|Y],TF)). - - -eval_20(Eq,RetType,Depth,Self,[chain,X],TF):- - eval_args(Eq,RetType,Depth,Self,X,TF). -eval_20(Eq,RetType,Depth,Self,[chain,X|Y],TF):- - eval_args(Eq,RetType,Depth,Self,X,_), - eval_args(Eq,RetType,Depth,Self,[chain|Y],TF). - -eval_20(Eq,RetType,Depth,Self,['or',X,Y],TF):- !, - as_tf((eval_args_true(Eq,RetType,Depth,Self,X);eval_args_true(Eq,RetType,Depth,Self,Y)),TF). - -eval_20(Eq,RetType,Depth,Self,['not',X],TF):- !, - as_tf(( \+ eval_args_true(Eq,RetType,Depth,Self,X)), TF). - -eval_20(Eq,RetType,Depth,Self,['eval',X],TF):- !, - eval_args(Eq,RetType,Depth,Self,X, TF). - -eval_20(Eq,RetType,Depth,Self,['number-of',X],N):- !, - bagof_eval(Eq,RetType,Depth,Self,X,ResL), - length(ResL,N), ignore(RetType='Number'). - -eval_20(Eq,RetType,Depth,Self,['number-of',X,N],TF):- !, - bagof_eval(Eq,RetType,Depth,Self,X,ResL), - length(ResL,N), true_type(Eq,RetType,TF). - -eval_20(Eq,RetType,Depth,Self,['findall!',Template,X],ResL):- !, - findall(Template,eval_args(Eq,RetType,Depth,Self,X,_),ResL). - - - -eval_20(Eq,RetType,Depth,Self,['limit!',N,E],R):- !, eval_20(Eq,RetType,Depth,Self,['limit',N,E],R). -eval_20(Eq,RetType,Depth,Self,['limit',NE,E],R):- !, - eval('=','Number',Depth,Self,NE,N), - limit(N,eval_ne(Eq,RetType,Depth,Self,E,R)). - -eval_20(Eq,RetType,Depth,Self,['offset!',N,E],R):- !, eval_20(Eq,RetType,Depth,Self,['offset',N,E],R). -eval_20(Eq,RetType,Depth,Self,['offset',NE,E],R):- !, - eval('=','Number',Depth,Self,NE,N), - offset(N,eval_ne(Eq,RetType,Depth,Self,E,R)). - -eval_20(Eq,RetType,Depth,Self,['max-time!',N,E],R):- !, eval_20(Eq,RetType,Depth,Self,['max-time',N,E],R). -eval_20(Eq,RetType,Depth,Self,['max-time',NE,E],R):- !, - eval('=','Number',Depth,Self,NE,N), - cwtl(N,eval_ne(Eq,RetType,Depth,Self,E,R)). - - -eval_20(Eq,RetType,Depth,Self,['call-cleanup!',NE,E],R):- !, - call_cleanup(eval(Eq,RetType,Depth,Self,NE,R), - eval(Eq,_U_,Depth,Self,NE,_)). - -eval_20(Eq,RetType,Depth,Self,['setup-call-cleanup!',S,NE,E],R):- !, - setup_call_cleanup(eval(Eq,_,Depth,Self,S,_), - eval(Eq,RetType,Depth,Self,NE,R), - eval(Eq,_,Depth,Self,NE,_)). - -eval_20(Eq,RetType,Depth,Self,['with-output-to!',S,NE],R):- !, - eval(Eq,_,Depth,Self,S,OUT), - with_output_to_stream(OUT, - eval(Eq,RetType,Depth,Self,NE,R)). - - - -% ================================================================= -% ================================================================= -% ================================================================= -% DATA FUNCTOR -% ================================================================= -% ================================================================= -% ================================================================= -eval20_failked(Eq,RetType,Depth,Self,[V|VI],[V|VO]):- - nonvar(V),is_metta_data_functor(V),is_list(VI),!, - maplist(eval(Eq,RetType,Depth,Self),VI,VO). - - -% ================================================================= -% ================================================================= -% ================================================================= -% EVAL FAILED -% ================================================================= -% ================================================================= -% ================================================================= - -eval_failed(Depth,Self,T,TT):- - finish_eval(Depth,Self,T,TT). - -%finish_eval(_,_,X,X):-!. - -finish_eval(_Dpth,_Slf,T,TT):- var(T),!,TT=T. -finish_eval(_Dpth,_Slf,[],[]):-!. -finish_eval(_Dpth,_Slf,[F|LESS],Res):- once(eval_selfless([F|LESS],Res)),fake_notrace([F|LESS]\==Res),!. -%finish_eval(Depth,Self,[V|Nil],[O]):- Nil==[], once(eval(Eq,RetType,Depth,Self,V,O)),V\=@=O,!. -finish_eval(Depth,Self,[H|T],[HH|TT]):- !, eval(Depth,Self,H,HH), finish_eval(Depth,Self,T,TT). -finish_eval(Depth,Self,T,TT):- eval(Depth,Self,T,TT). - - %eval(Eq,RetType,Depth,Self,X,Y):- eval_20(Eq,RetType,Depth,Self,X,Y)*->true;Y=[]. - -%eval_20(Eq,RetType,Depth,_,_,_):- Depth<1,!,fail. -%eval_20(Eq,RetType,Depth,_,X,Y):- Depth<3, !, ground(X), (Y=X). -%eval_20(Eq,RetType,_Dpth,_Slf,X,Y):- self_eval(X),!,Y=X. - -% Kills zero arity functions eval_20(Eq,RetType,Depth,Self,[X|Nil],[Y]):- Nil ==[],!,eval(Eq,RetType,Depth,Self,X,Y). - - - -% ================================================================= -% ================================================================= -% ================================================================= -% METTLOG PREDEFS -% ================================================================= -% ================================================================= -% ================================================================= - - -eval_20(Eq,RetType,_Dpth,_Slf,['arity',F,A],TF):- !,as_tf(current_predicate(F/A),TF),check_returnval(Eq,RetType,TF). -eval_20(Eq,RetType,Depth,Self,['CountElement',L],Res):- !, eval(Eq,RetType,Depth,Self,L,LL), !, (is_list(LL)->length(LL,Res);Res=1),check_returnval(Eq,RetType,Res). -eval_20(Eq,RetType,_Dpth,_Slf,['make_list',List],MettaList):- !, into_metta_cons(List,MettaList),check_returnval(Eq,RetType,MettaList). - - -eval_20(Eq,RetType,Depth,Self,['maplist!',Pred,ArgL1],ResL):- !, - maplist(eval_pred(Eq,RetType,Depth,Self,Pred),ArgL1,ResL). -eval_20(Eq,RetType,Depth,Self,['maplist!',Pred,ArgL1,ArgL2],ResL):- !, - maplist(eval_pred(Eq,RetType,Depth,Self,Pred),ArgL1,ArgL2,ResL). -eval_20(Eq,RetType,Depth,Self,['maplist!',Pred,ArgL1,ArgL2,ArgL3],ResL):- !, - maplist(eval_pred(Eq,RetType,Depth,Self,Pred),ArgL1,ArgL2,ArgL3,ResL). - - eval_pred(Eq,RetType,Depth,Self,Pred,Arg1,Res):- - eval(Eq,RetType,Depth,Self,[Pred,Arg1],Res). - eval_pred(Eq,RetType,Depth,Self,Pred,Arg1,Arg2,Res):- - eval(Eq,RetType,Depth,Self,[Pred,Arg1,Arg2],Res). - eval_pred(Eq,RetType,Depth,Self,Pred,Arg1,Arg2,Arg3,Res):- - eval(Eq,RetType,Depth,Self,[Pred,Arg1,Arg2,Arg3],Res). - -eval_20(Eq,RetType,Depth,Self,['concurrent-maplist!',Pred,ArgL1],ResL):- !, - metta_concurrent_maplist(eval_pred(Eq,RetType,Depth,Self,Pred),ArgL1,ResL). -eval_20(Eq,RetType,Depth,Self,['concurrent-maplist!',Pred,ArgL1,ArgL2],ResL):- !, - concurrent_maplist(eval_pred(Eq,RetType,Depth,Self,Pred),ArgL1,ArgL2,ResL). -eval_20(Eq,RetType,Depth,Self,['concurrent-maplist!',Pred,ArgL1,ArgL2,ArgL3],ResL):- !, - concurrent_maplist(eval_pred(Eq,RetType,Depth,Self,Pred),ArgL1,ArgL2,ArgL3,ResL). -eval_20(Eq,RetType,Depth,Self,['concurrent-forall!',Gen,Test|Options],Empty):- !, - maplist(s2p,Options,POptions), - call(thread:concurrent_forall( - user:eval_ne(Eq,RetType,Depth,Self,Gen,_), - user:forall(eval(Eq,RetType,Depth,Self,Test,_),true), - POptions)), - return_empty([],Empty). - -eval_20(Eq,RetType,Depth,Self,['hyperpose',ArgL],Res):- !, metta_hyperpose(Eq,RetType,Depth,Self,ArgL,Res). - - -simple_math(Var):- attvar(Var),!,fail. -simple_math([F|XY]):- !, atom(F),atom_length(F,1), is_list(XY),maplist(simple_math,XY). -simple_math(X):- number(X),!. - - -eval_20(Eq,RetType,Depth,Self,X,Y):- - (eval_40(Eq,RetType,Depth,Self,X,M)*-> M=Y ; - % finish_eval(Depth,Self,M,Y); - (eval_failed(Depth,Self,X,Y)*->true;X=Y)). - -eval_40(_Eq,_RetType,_Dpth,_Slf,['extend-py!',Module],Res):- !, 'extend-py!'(Module,Res). - -/* -into_values(List,Many):- List==[],!,Many=[]. -into_values([X|List],Many):- List==[],is_list(X),!,Many=X. -into_values(Many,Many). -eval_40(Eq,RetType,_Dpth,_Slf,Name,Value):- atom(Name), nb_current(Name,Value),!. -*/ -% Macro Functions -%eval_20(Eq,RetType,Depth,_,_,_):- Depth<1,!,fail. -eval_40(_Eq,_RetType,Depth,_,X,Y):- Depth<3, !, fail, ground(X), (Y=X). -eval_40(Eq,RetType,Depth,Self,[F|PredDecl],Res):- - fail, - Depth>1, - fake_notrace((sub_sterm1(SSub,PredDecl), ground(SSub),SSub=[_|Sub], is_list(Sub), maplist(atomic,SSub))), - eval(Eq,RetType,Depth,Self,SSub,Repl), - fake_notrace((SSub\=Repl, subst(PredDecl,SSub,Repl,Temp))), - eval(Eq,RetType,Depth,Self,[F|Temp],Res). - -% ================================================================= -% ================================================================= -% ================================================================= -% PLUS/MINUS -% ================================================================= -% ================================================================= -% ================================================================= -eval_40(_Eq,_RetType,_Dpth,_Slf,LESS,Res):- - ((((eval_selfless(LESS,Res),fake_notrace(LESS\==Res))))),!. - -eval_40(Eq,RetType,Depth,Self,['+',N1,N2],N):- number(N1),!, - eval(Eq,RetType,Depth,Self,N2,N2Res), fake_notrace(catch_err(N is N1+N2Res,_E,(set_last_error(['Error',N2Res,'Number']),fail))). -eval_40(Eq,RetType,Depth,Self,['-',N1,N2],N):- number(N1),!, - eval(Eq,RetType,Depth,Self,N2,N2Res), fake_notrace(catch_err(N is N1-N2Res,_E,(set_last_error(['Error',N2Res,'Number']),fail))). -eval_40(Eq,RetType,Depth,Self,['*',N1,N2],N):- number(N1),!, - eval(Eq,RetType,Depth,Self,N2,N2Res), fake_notrace(catch_err(N is N1*N2Res,_E,(set_last_error(['Error',N2Res,'Number']),fail))). - -eval_40(Eq,RetType,Depth,Self,['length',L],Res):- !, eval(Depth,Self,L,LL), - (is_list(LL)->length(LL,Res);Res=1), - check_returnval(Eq,RetType,Res). - - - -eval_40(Eq,RetType,Depth,Self,[P,A,X|More],YY):- is_list(X),X=[_,_,_],simple_math(X), - eval_selfless_2(X,XX),X\=@=XX,!, - eval_40(Eq,RetType,Depth,Self,[P,A,XX|More],YY). - -eval_40(Eq,RetType,_Dpth,_Slf,['==',X,Y],Res):- !, - suggest_type(RetType,'Bool'), - eq_unify(Eq,_SharedType, X, Y, Res). - -eq_unify(_Eq,_SharedType, X, Y, TF):- as_tf(X=:=Y,TF),!. -eq_unify(_Eq,_SharedType, X, Y, TF):- as_tf( '#='(X,Y),TF),!. -eq_unify( Eq, SharedType, X, Y, TF):- as_tf(eval_until_unify(Eq,SharedType, X, Y), TF). - - -suggest_type(_RetType,_Bool). - -eval_40(Eq,RetType,Depth,Self,[AE|More],Res):- fail, %is_special_op(AE),!, - eval_70(Eq,RetType,Depth,Self,[AE|More],Res), - check_returnval(Eq,RetType,Res). - -eval_40(Eq,RetType,Depth,Self,[AE|More],Res):- % fail, - maplist(must_eval_args(Eq,_,Depth,Self),More,Adjusted), - eval_70(Eq,RetType,Depth,Self,[AE|Adjusted],Res), - check_returnval(Eq,RetType,Res). - - -must_eval_args(Eq,RetType,Depth,Self,More,Adjusted):- - (eval_args(Eq,RetType,Depth,Self,More,Adjusted)*->true; - (with_debug(eval,eval_args(Eq,RetType,Depth,Self,More,Adjusted))*-> true; - ( - nl,writeq(eval_args(Eq,RetType,Depth,Self,More,Adjusted)),writeln('.'), - (More=Adjusted -> true ; - (trace, throw(must_eval_args(Eq,RetType,Depth,Self,More,Adjusted))))))). - - - -eval_70(Eq,RetType,Depth,Self,PredDecl,Res):- - Do_more_defs = do_more_defs(true), - clause(eval_80(Eq,RetType,Depth,Self,PredDecl,Res),Body), - Do_more_defs == do_more_defs(true), - call_ndet(Body,DET), - nb_setarg(1,Do_more_defs,false), - (DET==true -> ! ; true). - -% ================================================================= -% ================================================================= -% ================================================================= -% inherited by system -% ================================================================= -% ================================================================= -% ================================================================= -is_system_pred(S):- atom(S),atom_concat(_,'!',S). -is_system_pred(S):- atom(S),atom_concat(_,'-fn',S). -is_system_pred(S):- atom(S),atom_concat(_,'-p',S). - -% eval_80/6: Evaluates a Python function call within MeTTa. -% Parameters: -% - Eq: denotes get-type, match, or interpret call. -% - RetType: Expected return type of the MeTTa function. -% - Depth: Recursion depth or complexity control. -% - Self: Context or environment for the evaluation. -% - [MyFun|More]: List with MeTTa function and additional arguments. -% - RetVal: Variable to store the result of the Python function call. -eval_80(Eq, RetType, Depth, Self, [MyFun|More], RetVal) :- - % MyFun as a registered Python function with its module and function name. - metta_atom(Self, ['registered-python-function', PyModule, PyFun, MyFun]), - % Tries to fetch the type definition for MyFun, ignoring failures. - (( get_operator_typedef(Self, MyFun, Params, RetType), - try_adjust_arg_types(RetType, Depth, Self, [RetType|Params], [RetVal|More], [MVal|Adjusted]) - )->true; (maplist(as_prolog, More , Adjusted), MVal=RetVal)), - % Constructs a compound term for the Python function call with adjusted arguments. - compound_name_arguments(Call, PyFun, Adjusted), - % Optionally prints a debug tree of the Python call if tracing is enabled. - if_trace(host;python, print_tree(py_call(PyModule:Call, RetVal))), - % Executes the Python function call and captures the result in MVal which propagates to RetVal. - py_call(PyModule:Call, MVal), - % Checks the return value against the expected type and criteria. - check_returnval(Eq, RetType, RetVal). - - - -%eval_80(_Eq,_RetType,_Dpth,_Slf,LESS,Res):- fake_notrace((once((eval_selfless(LESS,Res),fake_notrace(LESS\==Res))))),!. - -% predicate inherited by system -eval_80(Eq,RetType,_Depth,_Self,[AE|More],TF):- - once((is_system_pred(AE), - length(More,Len), - is_syspred(AE,Len,Pred))), - \+ (atom(AE), atom_concat(_,'-fn',AE)), - current_predicate(Pred/Len), - %fake_notrace( \+ is_user_defined_goal(Self,[AE|More])),!, - %adjust_args(Depth,Self,AE,More,Adjusted), - maplist(as_prolog, More , Adjusted), - if_trace(host;prolog,print_tree(apply(Pred,Adjusted))), - catch_warn(efbug(show_call,eval_call(apply(Pred,Adjusted),TF))), - check_returnval(Eq,RetType,TF). - -show_ndet(G):- call(G). -%show_ndet(G):- call_ndet(G,DET),(DET==true -> ! ; fbug(show_ndet(G))). - -:- if( \+ current_predicate( adjust_args / 2 )). - - :- discontiguous eval_80/6. - -is_user_defined_goal(Self,Head):- - is_user_defined_head(Self,Head). - -:- endif. - -adjust_args_mp(_Eq,_RetType,Res,Res,_Depth,_Self,_Pred,_Len,_AE,Args,Adjusted):- Args==[],!,Adjusted=Args. -adjust_args_mp(Eq,RetType,Res,NewRes,Depth,Self,Pred,Len,AE,Args,Adjusted):- - functor(P,Pred,Len), predicate_property(P,meta_predicate(Needs)), - account_needs(1,Needs,Args,More),!, - adjust_args(Eq,RetType,Res,NewRes,Depth,Self,AE,More,Adjusted). -adjust_args_mp(Eq,RetType,Res,NewRes,Depth,Self,_Pred,_Len,AE,Args,Adjusted):- - adjust_args(Eq,RetType,Res,NewRes,Depth,Self,AE,Args,Adjusted). - -acct(0,A,call(eval(A,_))). -acct(':',A,call(eval(A,_))). -acct(_,A,A). -account_needs(_,_,[],[]). -account_needs(N,Needs,[A|Args],[M|More]):- arg(N,Needs,What),!, - acct(What,A,M),plus(1,N,NP1), - account_needs(NP1,Needs,Args,More). - -:- nodebug(metta(call)). - -s2ps(S,P):- S=='Nil',!,P=[]. -s2ps(S,P):- \+ is_list(S),!,P=S. -s2ps([F|S],P):- atom(F),maplist(s2ps,S,SS),join_s2ps(F,SS,P),!. -s2ps(S,S):-!. -join_s2ps('Cons',[H,T],[H|T]):-!. -join_s2ps(F,Args,P):-atom(F),P=..[F|Args]. - -eval_call(S,TF):- - s2ps(S,P), !, - fbug(eval_call(P,'$VAR'('TF'))),as_tf(P,TF). - -eval_80(Eq,RetType,_Depth,_Self,[AE|More],Res):- - is_system_pred(AE), - length([AE|More],Len), - is_syspred(AE,Len,Pred), - \+ (atom(AE), atom_concat(_,'-p',AE)), - %fake_notrace( \+ is_user_defined_goal(Self,[AE|More])),!, - %adjust_args(Depth,Self,AE,More,Adjusted),!, - Len1 is Len+1, - current_predicate(Pred/Len1), - maplist(as_prolog,More,Adjusted), - append(Adjusted,[Res],Args),!, - if_trace(host;prolog,print_tree(apply(Pred,Args))), - efbug(show_call,catch_warn(apply(Pred,Args))), - check_returnval(Eq,RetType,Res). - -:- if( \+ current_predicate( check_returnval / 3 )). -check_returnval(_,_RetType,_TF). -:- endif. - -:- if( \+ current_predicate( adjust_args / 5 )). -adjust_args(_Depth,_Self,_V,VI,VI). -:- endif. - -% user defined function -%eval_40(Eq,RetType,Depth,Self,[H|PredDecl],Res):- - % fake_notrace(is_user_defined_head(Self,H)),!, - % eval_defn(Eq,RetType,Depth,Self,[H|PredDecl],Res). - -eval_80(Eq,RetType,Depth,Self,PredDecl,Res):- - eval_defn(Eq,RetType,Depth,Self,PredDecl,Res). - - -last_element(T,E):- \+ compound(T),!,E=T. -last_element(T,E):- is_list(T),last(T,L),last_element(L,E),!. -last_element(T,E):- compound_name_arguments(T,_,List),last_element(List,E),!. - - - - -catch_warn(G):- quietly(catch_err(G,E,(fbug(catch_warn(G)-->E),fail))). -catch_nowarn(G):- quietly(catch_err(G,error(_,_),fail)). - - -% less Macro-ey Functions - - -as_tf(G,TF):- G\=[_|_], catch_nowarn((call(G)*->TF='True';TF='False')). -%eval_selfless_1(['==',X,Y],TF):- as_tf(X=:=Y,TF),!. -%eval_selfless_1(['==',X,Y],TF):- as_tf(X=@=Y,TF),!. - -is_assignment(V):- \+ atom(V),!, fail. -is_assignment('is'). is_assignment('is!'). -is_assignment('='). is_assignment('=='). -is_assignment('=:='). is_assignment(':='). - -eval_selfless(E,R):- eval_selfless_0(E,R). - -eval_selfless_0([F,X,XY],TF):- is_assignment(F), fake_notrace(args_to_mathlib([X,XY],Lib)),!,eval_selfless3(Lib,['=',X,XY],TF). -eval_selfless_0([F|XY],TF):- eval_selfless_1([F|XY],TF),!. -eval_selfless_0(E,R):- eval_selfless_2(E,R). - -eval_selfless_1([F|XY],TF):- \+ ground(XY),!,fake_notrace(args_to_mathlib(XY,Lib)),!,eval_selfless3(Lib,[F|XY],TF). -eval_selfless_1(['>',X,Y],TF):-!,as_tf(X>Y,TF). -eval_selfless_1(['<',X,Y],TF):-!,as_tf(X',X,Y],TF):-!,as_tf(X>=Y,TF). -eval_selfless_1(['<=',X,Y],TF):-!,as_tf(X=',X,Y],TF):-!,as_tf(X#>Y,TF). -compare_selfless0(cplfd,['<',X,Y],TF):-!,as_tf(X#',X,Y],TF):-!,as_tf(X#>=Y,TF). -compare_selfless0(cplfd,['<=',X,Y],TF):-!,as_tf(X#=',X,Y],TF):-!,as_tf(Lib:{X>Y},TF). -compare_selfless0(Lib,['<',X,Y],TF):-!,as_tf(Lib:{X',X,Y],TF):-!,as_tf(Lib:{X>=Y},TF). -compare_selfless0(Lib,['<=',X,Y],TF):-!,as_tf(Lib:{X=!;true). - -/* -eval_defn(Eq,_RetT,Depth,Self,[H|Args0],B):- - \+ get_operator_typedef1(Self,H,_ParamTypes,_RType),!, - maplist(eval_99(Eq,_,Depth,Self),Args0,Args), - eval_65(Eq,RetType,Depth,Self,[H|Args],B),!. -*/ -/* -eval_defn(Eq,_RetT,Depth,Self,[H|Args0],B):- symbol(H), - \+ fake_notrace((is_user_defined_head_f(Self,H))), - \+ get_operator_typedef1(Self,H,_ParamTypes,_RType),!, - maplist(eval_99(Eq,_,Depth,Self),Args0,Args), - eval_65(Eq,RetType,Depth,Self,[H|Args],B),!. -*/ -/* -eval_defn(Eq,RetType,Depth,Self,H,B):- - (eval_64(Eq,RetType,Depth,Self,H,B)*->true; - (fail,eval_67(Eq,RetType,Depth,Self,H,B))). -*/ -eval_defn(Eq,RetType,Depth,Self,X,Y):- - notrace(flag(eval_num,EX0,EX0+1)), - trace_eval(eval_61(Eq,RetType),metta_defn,Depth,Self,X,Y). - - -eval_61(Eq,RetType,Depth,Self,X,Y):- - if_or_else(eval_64(Eq,RetType,Depth,Self,X,Y), - eval_64_curried(Eq,RetType,Depth,Self,X,Y)). - -%eval_64(Eq,_RetType,_Dpth,Self,H,B):- Eq='=',!, metta_defn(Eq,Self,H,B). -eval_64(Eq,_RetType,_Dpth,Self,H,B):- - Eq=='match',!,call(metta_atom(Self,H)),B=H. - -% eval_64(Eq,RetType,Depth,Self,X,Y):- eval_64_curried(Eq,RetType,Depth,Self,X,Y). - -eval_64(Eq,_RetType,Depth,Self,[H|Args],B):- % no weird template matchers - % forall(metta_defn(Eq,Self,[H|Template],_), - % maplist(not_template_arg,Template)), - Eq='=', - (metta_defn(Eq,Self,[H|Args],B0)*->true;(fail,[H|Args]=B0)), - light_eval(Depth,Self,B0,B). - %(eval(Eq,RetType,Depth,Self,B,Y);metta_atom_iter(Depth,Self,Y)). -% Use the first template match -eval_65(Eq,_RetType,Depth,Self,[H|Args],B):- - Eq='=', - (metta_defn(Eq,Self,[H|Template],B0),Args=Template), - light_eval(Depth,Self,B0,B). - - - -eval_64_curried(Eq,RetType,Depth,Self,[[H|Start]|T1],Y):- - fake_notrace((is_user_defined_head_f(Self,H),is_list(Start))), - metta_defn(Eq,Self,[H|Start],Left), - [Left|T1] \=@= [[H|Start]|T1], - eval(Eq,RetType,Depth,Self,[Left|T1],Y). - - -light_eval(_Depth,_Self,B,B). - -not_template_arg(TArg):- var(TArg), !, \+ attvar(TArg). -not_template_arg(TArg):- atomic(TArg),!. -%not_template_arg(TArg):- is_list(TArg),!,fail. - - -% Has argument that is headed by the same function -eval_67(Eq,RetType,Depth,Self,[H1|Args],Res):- - fake_notrace((append(Left,[[H2|H2Args]|Rest],Args), H2==H1)),!, - eval(Eq,RetType,Depth,Self,[H2|H2Args],ArgRes), - fake_notrace((ArgRes\==[H2|H2Args], append(Left,[ArgRes|Rest],NewArgs))), - eval_defn(Eq,RetType,Depth,Self,[H1|NewArgs],Res). - -eval_67(Eq,RetType,Depth,Self,[[H|Start]|T1],Y):- - fake_notrace((is_user_defined_head_f(Self,H),is_list(Start))), - metta_defn(Eq,Self,[H|Start],Left), - eval(Eq,RetType,Depth,Self,[Left|T1],Y). - -% Has subterm to eval -eval_67(Eq,RetType,Depth,Self,[F|PredDecl],Res):- fail, - Depth>1, - quietly(sub_sterm1(SSub,PredDecl)), - fake_notrace((ground(SSub),SSub=[_|Sub], is_list(Sub),maplist(atomic,SSub))), - eval(Eq,RetType,Depth,Self,SSub,Repl), - fake_notrace((SSub\=Repl,subst(PredDecl,SSub,Repl,Temp))), - eval_defn(Eq,RetType,Depth,Self,[F|Temp],Res). - - - -% ================================================================= -% ================================================================= -% ================================================================= -% AGREGATES -% ================================================================= -% ================================================================= -% ================================================================= - -cwdl(DL,Goal):- call_with_depth_limit(Goal,DL,R), (R==depth_limit_exceeded->(!,fail);true). - -cwtl(DL,Goal):- catch(call_with_time_limit(DL,Goal),time_limit_exceeded(_),fail). - -%bagof_eval(Eq,RetType,Depth,Self,X,L):- bagof_eval(Eq,RetType,_RT,Depth,Self,X,L). - - -%bagof_eval(Eq,RetType,Depth,Self,X,S):- bagof(E,eval_ne(Eq,RetType,Depth,Self,X,E),S)*->true;S=[]. -bagof_eval(_Eq,_RetType,_Dpth,_Slf,X,L):- typed_list(X,_Type,L),!. -bagof_eval(Eq,RetType,Depth,Self,X,L):- - findall(E,eval_ne(Eq,RetType,Depth,Self,X,E),L). - -setof_eval(Depth,Self,X,L):- setof_eval('=',_RT,Depth,Self,X,L). -setof_eval(Eq,RetType,Depth,Self,X,S):- bagof_eval(Eq,RetType,Depth,Self,X,L), - sort(L,S). - - -eval_ne(Eq,RetType,Depth,Self,X,E):- - eval(Eq,RetType,Depth,Self,X,E), \+ var(E), \+ is_empty(E). - - -:- ensure_loaded(metta_subst). - -solve_quadratic(A, B, I, J, K) :- - %X in -1000..1000, % Define a domain for X - (X + A) * (X + B) #= I*X*X + J*X + K. % Define the quadratic equation - %label([X]). % Find solutions for X diff --git a/.Attic/metta_lang/metta_eval.pl b/.Attic/metta_lang/metta_eval.pl index 218a378ec24..da5789a84d4 100755 --- a/.Attic/metta_lang/metta_eval.pl +++ b/.Attic/metta_lang/metta_eval.pl @@ -60,6 +60,8 @@ :- multifile(color_g_mesg/2). self_eval0(X):- \+ callable(X),!. +self_eval0(X):- py_is_py(X),!. +%self_eval0(X):- py_type(X,List), List\==list,!. self_eval0(X):- is_valid_nb_state(X),!. %self_eval0(X):- string(X),!. %self_eval0(X):- number(X),!. @@ -76,6 +78,7 @@ self_eval0('%Undefined%'). self_eval0(X):- atom(X),!, \+ nb_bound(X,_),!. + nb_bound(Name,X):- atom(Name), atom_concat('&', _, Name), nb_current(Name, X). @@ -125,7 +128,11 @@ % is_metta_declaration([F|T]):- is_list(T), is_user_defined_head([F]),!. +% Sets the current self space to '&self'. This is likely used to track the current context or scope during the evaluation of Metta code. :- nb_setval(self_space, '&self'). + +%! eval_to(+X,+Y) is semidet. +% checks if X evals to Y evals_to(XX,Y):- Y=@=XX,!. evals_to(XX,Y):- Y=='True',!, is_True(XX),!. @@ -134,9 +141,13 @@ do_expander('=',_,X,X):-!. do_expander(':',_,X,Y):- !, get_type(X,Y)*->X=Y. -'get_type'(Arg,Type):- 'get-type'(Arg,Type). +get_type(Arg,Type):- eval_H(['get-type',Arg],Type). +%! eval_true(+X) is semidet. +% Evaluates the given term X and succeeds if X is not a constraint (i.e. \+ iz_conz(X)) and is callable, and calling X succeeds. +% +% If X is not callable, this predicate will attempt to evaluate the arguments of X (using eval_args/2) and succeed if the result is not False. eval_true(X):- \+ iz_conz(X), callable(X), call(X). eval_true(X):- eval_args(X,Y), once(var(Y) ; \+ is_False(Y)). @@ -152,6 +163,8 @@ eval(Eq,RetType,Depth,Self,X,Y))). */ + +%! eval_args(+X,-Y) is semidet. eval_args(X,Y):- current_self(Self), eval_args(500,Self,X,Y). %eval_args(Eq,RetType,Depth,_Self,X,_Y):- forall(between(6,Depth,_),write(' ')),writeqln(eval_args(Eq,RetType,X)),fail. eval_args(Depth,Self,X,Y):- eval_args('=',_RetType,Depth,Self,X,Y). @@ -167,7 +180,6 @@ eval_args(Eq,RetType,Depth,Self,X,Y):- notrace(nonvar(Y)),!, eval_args(Eq,RetType,Depth,Self,X,XX),evals_to(XX,Y). - eval_args(Eq,RetType,_Dpth,_Slf,[X|T],Y):- T==[], number(X),!, do_expander(Eq,RetType,X,YY),Y=[YY]. /* @@ -274,6 +286,19 @@ eval_20(Eq,RetType,Depth,Self,X,Y):- atom(Eq), ( Eq \== ('=')) ,!, call(Eq,'=',RetType,Depth,Self,X,Y). + +eval_20(_Eq,_RetType,_Depth,_Self,[V|VI],VO):- atomic(V), py_is_object(V),!, + is_list(VI),!, py_eval_object([V|VI],VO). + +eval_20(Eq,RetType,Depth,Self,[V|VI],VO):- is_list(V), V \== [], + eval_20(Eq,_FRype,Depth,Self,V,VV), V\==VV, atomic(VV), !, + eval_20(Eq,RetType,Depth,Self,[VV|VI],VO). + +eval_20(Eq,RetType,Depth,Self,[F,[Eval,V]|VI],VO):- Eval == eval,!, + ((eval_args(Eq,_FRype,Depth,Self,V,VV), V\=@=VV)*-> true; VV = V), + eval_20(Eq,RetType,Depth,Self,[F,VV|VI],VO). + + % DMILES @ TODO make sure this isnt an implicit curry eval_20(Eq,_RetType,Depth,Self,[V|VI],VO):- \+ callable(V), is_list(VI),!, maplist(eval_ret(Eq,_ArgRetType,Depth,Self),[V|VI],VOO),VO=VOO. @@ -475,18 +500,27 @@ eval_20(Eq,RetType,Depth,Self,['profile!',Cond],Res):- !, time_eval(profile(Cond),profile(eval_args(Eq,RetType,Depth,Self,Cond,Res))). eval_20(Eq,RetType,Depth,Self,['time!',Cond],Res):- !, time_eval(eval_args(Cond),eval_args(Eq,RetType,Depth,Self,Cond,Res)). eval_20(Eq,RetType,Depth,Self,['print',Cond],Res):- !, eval_args(Eq,RetType,Depth,Self,Cond,Res),format('~N'),print(Res),format('~N'). +% !(print! $1) +eval_20(Eq,RetType,Depth,Self,['princ!'|Cond],Res):- !, + maplist(eval_args(Eq,RetType,Depth,Self),Cond,Out), + maplist(princ_impl,Out), + make_nop(RetType,[],Res),check_returnval(Eq,RetType,Res). % !(println! $1) eval_20(Eq,RetType,Depth,Self,['println!'|Cond],Res):- !, maplist(eval_args(Eq,RetType,Depth,Self),Cond,Out), maplist(println_impl,Out), make_nop(RetType,[],Res),check_returnval(Eq,RetType,Res). - +println_impl(X):- format("~N~@~N",[write_sln(X)]),!. println_impl(X):- user_io((ansi_format(fg('#c7ea46'),"~N~@~N",[write_sln(X)]))). +princ_impl(X):- format("~@",[write_sln(X)]),!. + write_sln(X):- string(X), !, write(X). -write_sln(X):- with_indents(false,write_src(X)). +write_sln(X):- write_src_woi(X). +with_output_to_str( Sxx , Goal ):- + wots( Sxx , Goal ). % ================================================================= % ================================================================= @@ -742,8 +776,6 @@ eval_20(Eq,RetType,Depth,Self,['switch',A,CL|T],Res):- !, eval_20(Eq,RetType,Depth,Self,['case',A,CL|T],Res). -eval_20(Eq,RetType,Depth,Self,[P,X|More],YY):- is_list(X),X=[_,_,_],simple_math(X), - eval_selfless_2(X,XX),X\=@=XX,!, eval_20(Eq,RetType,Depth,Self,[P,XX|More],YY). % if there is only a void then always return nothing for each Case eval_20(Eq,_RetType,Depth,Self,['case',A,[[Void,_]]],Res):- '%void%' == Void, @@ -1216,10 +1248,10 @@ format_args_write('#\\'(Arg),_) :- !, write(Arg). format_args_write(Arg,_) :- write_src_woi(Arg). -format_args([], _, _). -format_args(['{','{'|FormatRest], Iterator, Args) :- !, put('{'), format_args(FormatRest, Iterator, Args). % escaped -format_args(['}','}'|FormatRest], Iterator, Args) :- !, put('}'), format_args(FormatRest, Iterator, Args). % escaped -format_args(['{'|FormatRest1], Iterator1, Args) :- +format_nth_args([], _, _). +format_nth_args(['{','{'|FormatRest], Iterator, Args) :- !, put('{'), format_nth_args(FormatRest, Iterator, Args). % escaped +format_nth_args(['}','}'|FormatRest], Iterator, Args) :- !, put('}'), format_nth_args(FormatRest, Iterator, Args). % escaped +format_nth_args(['{'|FormatRest1], Iterator1, Args) :- format_args_get_index(FormatRest1, FormatRest2, Index), format_args_get_format(FormatRest2, ['}'|FormatRest3], Format), % check that the closing '}' is not escaped with another '}' @@ -1229,14 +1261,14 @@ -> ((nth0(Iterator1,Args,Arg),Iterator2 is Iterator1+1)) ; ((nth0(Index,Args,Arg), Iterator2 is Iterator1))), format_args_write(Arg,Format), - format_args(FormatRest3, Iterator2, Args). -format_args([C|FormatRest], Iterator, Args) :- put(C), format_args(FormatRest, Iterator, Args). + format_nth_args(FormatRest3, Iterator2, Args). +format_nth_args([C|FormatRest], Iterator, Args) :- put(C), format_nth_args(FormatRest, Iterator, Args). eval_20(Eq,RetType,Depth,Self,['format-args',Format,Args],Result):- eval_args(Eq,RetType,Depth,Self,Format,EFormat), eval_args(Eq,RetType,Depth,Self,Args,EArgs), is_list(EArgs),string_chars(EFormat, FormatChars), !, - user_io(with_output_to(string(Result), format_args(FormatChars, 0, EArgs))). + user_io(with_output_to_str( Result, format_nth_args(FormatChars, 0, EArgs))). eval_20(Eq,RetType,Depth,Self,['format-args',_Fmt,Args],_Result) :- eval_args(Eq,RetType,Depth,Self,Args,EArgs), \+ is_list(EArgs),!,throw_metta_return(['Error',Args,'BadType']). @@ -1245,6 +1277,16 @@ ignore(RetType='Bool'), !, as_tf(random(0,2,0),Bool), check_returnval(Eq,RetType,Bool). +eval_20( Eq, RetType, Depth, Self, [ 'parse' , L ] , Exp ):- !, + eval_args( Eq, RetType, Depth, Self, L, Str ), + once(parse_sexpr_metta1( Str, Exp )). + +eval_20( _Eq, _RetType, _Depth, _Self, [ 'repr' , L ] , Sxx ):- !, + %eval_args( Eq, RetType, Depth, Self, L, Lis2 ), + with_output_to_str( Sxx , write_src_woi( L ) ). + +eval_20( Eq, RetType, Depth, Self, [ 'output-to-string' , L ] , Sxx ):- !, + with_output_to_str( Sxx , eval_args( Eq, RetType, Depth, Self, L, _ )). % ================================================================= % ================================================================= @@ -1647,51 +1689,107 @@ fromNumber(N,RetVal), check_returnval(Eq,RetType,RetVal). */ +%% lazy_union(:P2, +E1_Call1, +E2_Call2, -E) is nondet. +% - Performs a union operation using lazy evaluation +% Arguments: +% - P2: Any arity 2 predicate +% - E1^Call1: The first goal (Call1) generating elements (E1) +% - E2^Call2: The second goal (Call2) generating elements (E2) +% - E: The resulting element that is part of the union of the two sets +lazy_union(P2, E1^Call1, E2^Call2, E) :- + % Step 1: Use lazy_findall/3 to declare that all elements satisfying Call1 are supposedly in List1 + lazy_findall(E1, Call1, List1), + % Step 2: Use lazy_findall/3 to declare that all elements satisfying Call2 are supposedly in List2 + lazy_findall(E2, Call2, List2), + % Step 3: Perform the union logic + ( % Case 1: If E is a member of List1, include it in the result + member(E, List1) + % Case 2: Otherwise, check if E is a member of List2 + % Additionally, ensure that E does not already exist in List1 + ; (member(E, List2), \+ (member(E1, List1), call(P2, E1, E))) + ). + + +variant_by_type(X,Y):- var(X),!,X==Y. +variant_by_type(X,Y):- X=@=Y. eval_20(Eq,RetType,Depth,Self,['unique',Eval],RetVal):- !, term_variables(Eval+RetVal,Vars), no_repeats_var(YY), eval_20(Eq,RetType,Depth,Self,Eval,RetVal),YY=Vars. +eval_20(Eq,RetType,Depth,Self,['pred-unique',P2,Eval],RetVal):- !, + no_repeats_var(P2,YY), + eval_20(Eq,RetType,Depth,Self,Eval,RetVal),YY=RetVal. + eval_20(Eq,RetType,Depth,Self,['subtraction',Eval1,Eval2],RetVal):- !, - lazy_subtraction(RetVal1^eval_args(Eq,RetType,Depth,Self,Eval1,RetVal1), + lazy_subtraction(variant_by_type,RetVal1^eval_args(Eq,RetType,Depth,Self,Eval1,RetVal1), RetVal2^eval_args(Eq,RetType,Depth,Self,Eval2,RetVal2), RetVal). -eval_20(Eq,RetType,_Dpth,_Slf,['py-list',Atom_list],CDR_Y):- - !, Atom=[_|CDR],!,do_expander(Eq,RetType,Atom_list, CDR_Y ). +eval_20(Eq,RetType,Depth,Self,['pred-subtraction',P2,Eval1,Eval2],RetVal):- !, + lazy_subtraction(P2,RetVal1^eval_args(Eq,RetType,Depth,Self,Eval1,RetVal1), + RetVal2^eval_args(Eq,RetType,Depth,Self,Eval2,RetVal2), + RetVal). + +eval_20(Eq,RetType,Depth,Self,['union',Eval1,Eval2],RetVal):- !, + lazy_union(variant_by_type,RetVal1^eval_args(Eq,RetType,Depth,Self,Eval1,RetVal1), + RetVal2^eval_args(Eq,RetType,Depth,Self,Eval2,RetVal2), + RetVal). + +eval_20(Eq,RetType,Depth,Self,['pred-union',P2,Eval1,Eval2],RetVal):- !, + lazy_union(P2,RetVal1^eval_args(Eq,RetType,Depth,Self,Eval1,RetVal1), + RetVal2^eval_args(Eq,RetType,Depth,Self,Eval2,RetVal2), + RetVal). + +%eval_20(Eq,RetType,_Dpth,_Slf,['py-list',Atom_list],CDR_Y):- +% !, Atom=[_|CDR],!,do_expander(Eq,RetType,Atom_list, CDR_Y ). eval_20(Eq,RetType,Depth,Self,['intersection',Eval1,Eval2],RetVal):- !, - lazy_intersection(RetVal1^eval_args(Eq,RetType,Depth,Self,Eval1,RetVal1), + lazy_intersection(variant_by_type,RetVal1^eval_args(Eq,RetType,Depth,Self,Eval1,RetVal1), + RetVal2^eval_args(Eq,RetType,Depth,Self,Eval2,RetVal2), + RetVal). + +eval_20(Eq,RetType,Depth,Self,['pred-intersection',P2,Eval1,Eval2],RetVal):- !, + lazy_intersection(P2,RetVal1^eval_args(Eq,RetType,Depth,Self,Eval1,RetVal1), RetVal2^eval_args(Eq,RetType,Depth,Self,Eval2,RetVal2), RetVal). -lazy_intersection(E1^Call1, E2^Call2, E1) :- +%% lazy_intersection(:P2, +E1_Call1, +E2_Call2, -E) is nondet. +% - Performs a intersection operation using lazy evaluation. +% - It intersects elements generated by Call2 from those generated by Call1. +% Arguments: +% - P2: Any arity 2 predicate +% - E1^Call1: The first goal (Call1) generating elements (E1). +% - E2^Call2: The second goal (Call2) generating elements (E2). +% - E: The resulting element after subtracting elements of the second set from the first set. +lazy_intersection(P2, E1^Call1, E2^Call2, E1) :- % Step 1: Evaluate Call1 to generate E1 call(Call1), % Step 2: Use lazy_findall/3 to declare that all elements satisfying Call2 are supposedly in List2 lazy_findall(E2, Call2, List2), - % Step 3: Perform the subtraction logic + % Step 3: Perform the intersection logic % Only return E1 if it is not a member of List2 - member(E2, List2), E1 == E2. + member(E2, List2), call(P2,E1,E2). -%% lazy_subtraction(+E1_Call1, +E2_Call2, -E) is nondet. +%% lazy_subtraction(:P2, +E1_Call1, +E2_Call2, -E) is nondet. % - Performs a subtraction operation using lazy evaluation. % - It subtracts elements generated by Call2 from those generated by Call1. % Arguments: +% - P2: Any arity 2 predicate % - E1^Call1: The first goal (Call1) generating elements (E1). % - E2^Call2: The second goal (Call2) generating elements (E2). % - E: The resulting element after subtracting elements of the second set from the first set. -lazy_subtraction(E1^Call1, E2^Call2, E1) :- +lazy_subtraction(P2,E1^Call1, E2^Call2, E1) :- % Step 1: Evaluate Call1 to generate E1 call(Call1), % Step 2: Use lazy_findall/3 to declare that all elements satisfying Call2 are supposedly in List2 lazy_findall(E2, Call2, List2), % Step 3: Perform the subtraction logic % Only return E1 if it is not a member of List2 - \+ (member(E2, List2), E1 =@= E2). + \+ (member(E2, List2), call(P2, E1, E2)). eval_20(Eq,RetType,Depth,Self,PredDecl,Res):- @@ -1776,18 +1874,36 @@ eval_40(Eq,RetType,Depth,Self,['*',N1,N2],N):- number(N1), eval_args(Eq,RetType,Depth,Self,N2,N2Res), fake_notrace(catch_err(N is N1*N2Res,_E,(set_last_error(['Error',N2Res,'Number']),fail))). +eval_20(_Eq,_RetType,_Depth,_Self,['rust',Bang,PredDecl],Res):- Bang == '!', !, + rust_metta_run(exec(PredDecl),Res), nop(write_src(res(Res))). eval_20(_Eq,_RetType,_Depth,_Self,['rust',PredDecl],Res):- !, - must_det_ll((rust_metta_run(PredDecl,Res), - nop(write_src(res(Res))))). + rust_metta_run((PredDecl),Res), nop(write_src(res(Res))). eval_20(_Eq,_RetType,_Depth,_Self,['rust!',PredDecl],Res):- !, - must_det_ll((rust_metta_run(exec(PredDecl),Res), - nop(write_src(res(Res))))). + rust_metta_run(exec(PredDecl),Res), nop(write_src(res(Res))). + +eval_70(_Eq,_RetType,_Depth,_Self,['py-atom',Arg],Res):- !, + must_det_ll((py_atom(Arg,Res))). +eval_40(_Eq,_RetType,_Depth,_Self,['py-atom',Arg,Type],Res):- !, + must_det_ll((py_atom_type(Arg,Type,Res))). +eval_40(_Eq,_RetType,_Depth,_Self,['py-dot',Arg1,Arg2],Res):- !, + must_det_ll((py_dot([Arg1,Arg2],Res))). +eval_40(_Eq,_RetType,_Depth,_Self,['py-list',Arg],Res):- !, + must_det_ll((py_list(Arg,Res))). +eval_40(_Eq,_RetType,_Depth,_Self,['py-dict',Arg],Res):- !, + must_det_ll((py_dict(Arg,Res))). +eval_40(_Eq,_RetType,_Depth,_Self,['py-tuple',Arg],Res):- !, + must_det_ll((py_tuple(Arg,Res))). +eval_40(_Eq,_RetType,_Depth,_Self,['py-eval',Arg],Res):- !, + must_det_ll((py_eval(Arg,Res))). eval_40(Eq,RetType,Depth,Self,['length',L],Res):- !, eval_args(Depth,Self,L,LL), (is_list(LL)->length(LL,Res);Res=1), check_returnval(Eq,RetType,Res). +eval_20(Eq,RetType,Depth,Self,[P,X|More],YY):- is_list(X),X=[_,_,_],simple_math(X), + eval_selfless_2(X,XX),X\=@=XX,!, eval_20(Eq,RetType,Depth,Self,[P,XX|More],YY). + /* eval_40(Eq,RetType,Depth,Self,[P,A,X|More],YY):- is_list(X),X=[_,_,_],simple_math(X), eval_selfless_2(X,XX),X\=@=XX,!, @@ -1799,6 +1915,15 @@ suggest_type(RetType,'Bool'), eq_unify(Eq,_SharedType, X, Y, Res). +eval_20(_Eq,RetType,_Dpth,_Slf,[EQ,X,Y],TF):- EQ=='===', !, + suggest_type(RetType,'Bool'), + as_tf(X==Y,TF). + +eval_20(_Eq,RetType,_Dpth,_Slf,[EQ,X,Y],TF):- EQ=='====', !, + suggest_type(RetType,'Bool'), + as_tf(same_terms(X,Y),TF). + + eq_unify(_Eq,_SharedType, X, Y, TF):- as_tf(X=:=Y,TF),!. eq_unify(_Eq,_SharedType, X, Y, TF):- as_tf( '#='(X,Y),TF),!. eq_unify( Eq, SharedType, X, Y, TF):- as_tf(eval_until_unify(Eq,SharedType, X, Y), TF). diff --git a/.Attic/metta_lang/metta_eval.prev b/.Attic/metta_lang/metta_eval.prev deleted file mode 100755 index a4a947e568d..00000000000 --- a/.Attic/metta_lang/metta_eval.prev +++ /dev/null @@ -1,1549 +0,0 @@ -% -% post match modew -%:- style_check(-singleton). - -self_eval0(X):- \+ callable(X),!. -self_eval0(X):- is_valid_nb_state(X),!. -%self_eval0(X):- string(X),!. -%self_eval0(X):- number(X),!. -%self_eval0([]). -self_eval0(X):- is_metta_declaration(X),!. -self_eval0(X):- is_list(X),!,fail. -self_eval0(X):- typed_list(X,_,_),!. -%self_eval0(X):- compound(X),!. -%self_eval0(X):- is_ref(X),!,fail. -self_eval0('True'). self_eval0('False'). % self_eval0('F'). -self_eval0('Empty'). -self_eval0(X):- atom(X),!, \+ nb_current(X,_),!. - -self_eval(X):- notrace(self_eval0(X)). - -:- set_prolog_flag(access_level,system). -hyde(F/A):- functor(P,F,A), redefine_system_predicate(P),'$hide'(F/A), '$iso'(F/A). -:- 'hyde'(option_else/2). -:- 'hyde'(atom/1). -:- 'hyde'(quietly/1). -:- 'hyde'(notrace/1). -:- 'hyde'(var/1). -:- 'hyde'(is_list/1). -:- 'hyde'(copy_term/2). -:- 'hyde'(nonvar/1). -:- 'hyde'(quietly/1). -%:- 'hyde'(option_value/2). - - -is_metta_declaration([F|_]):- F == '->',!. -is_metta_declaration([F,_,_|T]):- T ==[], is_metta_declaration_f(F). - -is_metta_declaration_f(F):- F == ':', !. -is_metta_declaration_f(F):- F == '=', !, - \+ (current_self(Space), is_user_defined_head_f(Space,F)). - -(F==':'; - (F=='=', \+ - \+ (current_self(Space), is_user_defined_head_f(Space,F)))). -% is_metta_declaration([F|T]):- is_list(T), is_user_defined_head([F]),!. - -:- nb_setval(self_space, '&self'). -evals_to(XX,Y):- Y=@=XX,!. -evals_to(XX,Y):- Y=='True',!, is_True(XX),!. - -current_self(Space):- nb_current(self_space,Space). - -do_expander('=',_,X,X):-!. -do_expander(':',_,X,Y):- !, get_type(X,Y)*->X=Y. - -'get_type'(Arg,Type):- 'get-type'(Arg,Type). - - - - -eval_args(X,Y):- current_self(Space), - rtrace_on_existence_error(eval(100,Space,X,Y)). -eval_args(Depth,Self,X,Y):- locally(set_prolog_flag(gc,false),rtrace_on_existence_error(eval(Depth,Self,X,Y))). -eval_args(Eq,RetType,Depth,Self,X,Y):- - locally(set_prolog_flag(gc,true), - rtrace_on_existence_error( - eval(Eq,RetType,Depth,Self,X,Y))). - -%eval(Eq,RetType,Depth,_Self,X,_Y):- forall(between(6,Depth,_),write(' ')),writeqln(eval(Eq,RetType,X)),fail. -eval(Depth,Self,X,Y):- eval('=',_RetType,Depth,Self,X,Y). - -%eval(Eq,RetType,_Dpth,_Slf,X,Y):- nonvar(Y),X=Y,!. - -eval(Eq,RetType,Depth,Self,X,Y):- nonvar(Y),!, - get_type(Depth,Self,Y,RetType), !, - eval(Eq,RetType,Depth,Self,X,XX),evals_to(XX,Y). - -eval(_Eq,_RetType,_Dpth,_Slf,X,Y):- var(X),!,Y=X. - -eval(Eq,RetType,_Dpth,_Slf,[X|T],Y):- T==[], number(X),!, do_expander(Eq,RetType,X,YY),Y=[YY]. - -/* -eval(Eq,RetType,Depth,Self,[F|X],Y):- - (F=='superpose' ; ( option_value(no_repeats,false))), - notrace((D1 is Depth-1)),!, - eval_11(Eq,RetType,D1,Self,[F|X],Y). -*/ - -eval(Eq,RetType,Depth,Self,X,Y):- atom(Eq), ( Eq \== ('=')) ,!, - call(Eq,'=',RetType,Depth,Self,X,Y). - -eval(Eq,RetType,Depth,Self,X,Y):- - %notrace(allow_repeats_eval_(X)), - !, - eval_11(Eq,RetType,Depth,Self,X,Y). -eval(Eq,RetType,Depth,Self,X,Y):- - nop(notrace((no_repeats_var(YY)), - D1 is Depth-1)),!, - eval_11(Eq,RetType,D1,Self,X,Y), - notrace(( \+ (Y\=YY))). - -allow_repeats_eval_(_):- !. -allow_repeats_eval_(_):- option_value(no_repeats,false),!. -allow_repeats_eval_(X):- \+ is_list(X),!,fail. -allow_repeats_eval_([F|_]):- atom(F),allow_repeats_eval_f(F). -allow_repeats_eval_f('superpose'). -allow_repeats_eval_f('collapse'). - -debugging_metta(G):- notrace((is_debugging((eval))->ignore(G);true)). - - -:- nodebug(metta(eval)). - - -w_indent(Depth,Goal):- - \+ \+ mnotrace(ignore((( - format('~N'), - setup_call_cleanup(forall(between(Depth,101,_),write(' ')),Goal, format('~N')))))). -indentq(Depth,Term):- - \+ \+ mnotrace(ignore((( - format('~N'), - setup_call_cleanup(forall(between(Depth,101,_),write(' ')),format('~q',[Term]), - format('~N')))))). - - -with_debug(Flag,Goal):- is_debugging(Flag),!, call(Goal). -with_debug(Flag,Goal):- flag(eval_num,_,0), - setup_call_cleanup(set_debug(Flag,true),call(Goal),set_debug(Flag,false)). - -flag_to_var(Flag,Var):- atom(Flag), \+ atom_concat('trace-on-',_,Flag),!,atom_concat('trace-on-',Flag,Var). -flag_to_var(metta(Flag),Var):- !, nonvar(Flag), flag_to_var(Flag,Var). -flag_to_var(Flag,Var):- Flag=Var. - -set_debug(Flag,Val):- \+ atom(Flag), flag_to_var(Flag,Var), atom(Var),!,set_debug(Var,Val). -set_debug(Flag,true):- !, debug(metta(Flag)),flag_to_var(Flag,Var),set_option_value(Var,true). -set_debug(Flag,false):- nodebug(metta(Flag)),flag_to_var(Flag,Var),set_option_value(Var,false). -if_trace((Flag;true),Goal):- !, notrace(( catch_err(ignore((Goal)),E,wdmsg(E-->if_trace((Flag;true),Goal))))). -if_trace(Flag,Goal):- notrace((catch_err(ignore((is_debugging(Flag),Goal)),E,wdmsg(E-->if_trace(Flag,Goal))))). - - -%maybe_efbug(SS,G):- efbug(SS,G)*-> if_trace(eval,wdmsg(SS=G)) ; fail. -maybe_efbug(_,G):- call(G). -%efbug(P1,G):- call(P1,G). -efbug(_,G):- call(G). - - - -is_debugging(Flag):- var(Flag),!,fail. -is_debugging((A;B)):- !, (is_debugging(A) ; is_debugging(B) ). -is_debugging((A,B)):- !, (is_debugging(A) , is_debugging(B) ). -is_debugging(not(Flag)):- !, \+ is_debugging(Flag). -is_debugging(Flag):- Flag== false,!,fail. -is_debugging(Flag):- Flag== true,!. -is_debugging(Flag):- debugging(metta(Flag),TF),!,TF==true. -is_debugging(Flag):- debugging(Flag,TF),!,TF==true. -is_debugging(Flag):- flag_to_var(Flag,Var), - (option_value(Var,true)->true;(Flag\==Var -> is_debugging(Var))). - -:- nodebug(metta(overflow)). - - -eval_99(Eq,RetType,Depth,Self,X,Y):- - eval_20(Eq,RetType,Depth,Self,X,Y)*->true;eval_failed(Depth,Self,X,Y). - - - -eval_00(_Eq,_RetType,Depth,_Slf,X,Y):- Depth<1,!,X=Y, (\+ trace_on_overflow-> true; flag(eval_num,_,0),debug(metta(eval))). -eval_00(_Eq,_RetType,_Dpth,_Slf,X,Y):- self_eval(X),!,Y=X. -eval_00(Eq,RetType,Depth,Self,X,YO):- - Depth2 is Depth-1, - copy_term(X, XX), - eval_20(Eq,RetType,Depth,Self,X,M), - ((M\=@=XX, \+ self_eval(M))-> - eval_00(Eq,RetType,Depth2,Self,M,Y);Y=M), - once(if_or_else(subst_args(Eq,RetType,Depth2,Self,Y,YO), - if_or_else(finish_eval(Depth2,Self,Y,YO), - Y=YO))). - - - -eval_11(_Eq,_RetType,_Dpth,_Slf,X,Y):- self_eval(X),!,Y=X. -eval_11(Eq,RetType,Depth,Self,X,Y):- \+ is_debugging((eval)),!, - D1 is Depth-1, - eval_00(Eq,RetType,D1,Self,X,Y). -eval_11(Eq,RetType,Depth,Self,X,Y):- - notrace(( - - flag(eval_num,EX,EX+1), - D1 is Depth-1, - DR is 99-D1, - PrintRet = _, - option_else('trace-length',Max,100), - if_t((EX>Max), (set_debug(eval,false),MaxP1 is Max+1, set_debug(overflow,false), - format('; Switched off tracing. For a longer trace: !(pragma! trace-length ~w)',[MaxP1]))), - nop(notrace(no_repeats_var(YY))), - - if_t(DR<10,if_trace((eval),(PrintRet=1, indentq(Depth,'-->'(EX,eval(Self,X,'$VAR'('RET')),depth(DR)))))), - Ret=retval(fail))), - - call_cleanup(( - dcall(eval_00(Eq,RetType,D1,Self,X,Y)), - notrace(( \+ (Y\=YY), nb_setarg(1,Ret,Y)))), - - (PrintRet==1 -> indentq(Depth,'<--'(EX,Ret)) ; - mnotrace(ignore(((Y\=@=X, - if_t(DR<10,if_trace((eval),indentq(Depth,'<--'(EX,Ret)))))))))), - - (Ret\=@=retval(fail)->true;(rtrace(eval_00(Eq,RetType,D1,Self,X,Y)),fail)). - - - -eval_15(Eq,RetType,Depth,Self,X,Y):- !, - eval_20(Eq,RetType,Depth,Self,X,Y). - -eval_15(Eq,RetType,Depth,Self,X,Y):- - ((eval_20(Eq,RetType,Depth,Self,X,Y), - if_t(var(Y),dmsg((eval_20(Eq,RetType,Depth,Self,X,Y),var(Y)))), - nonvar(Y))*->true;(eval_failed(Depth,Self,X,Y),fail)). - - - - - - - - - - - - - -:- discontiguous eval_20/6. -:- discontiguous eval_40/6. -%:- discontiguous eval_30fz/5. -%:- discontiguous eval_31/5. -%:- discontiguous eval_defn/5. - -eval_20(Eq,RetType,_Dpth,_Slf,Name,Y):- - atom(Name), !, - (nb_current(Name,X)->do_expander(Eq,RetType,X,Y); - Y = Name). - - -eval_20(Eq,RetType,_Dpth,_Slf,X,Y):- self_eval(X),!,do_expander(Eq,RetType,X,Y). - -% ================================================================= -% ================================================================= -% ================================================================= -% VAR HEADS/ NON-LISTS -% ================================================================= -% ================================================================= -% ================================================================= - -eval_20(Eq,RetType,_Dpth,_Slf,[X|T],Y):- T==[], \+ callable(X),!, do_expander(Eq,RetType,X,YY),Y=[YY]. -%eval_20(Eq,RetType,_Dpth,Self,[X|T],Y):- T==[], atom(X), -% \+ is_user_defined_head_f(Self,X), -% do_expander(Eq,RetType,X,YY),!,Y=[YY]. - -eval_20(Eq,RetType,Depth,Self,X,Y):- atom(Eq), ( Eq \== ('=')) ,!, - call(Eq,'=',RetType,Depth,Self,X,Y). - - -eval_20(Eq,RetType,Depth,Self,[V|VI],VVO):- \+ is_list(VI),!, - eval(Eq,RetType,Depth,Self,VI,VM), - ( VM\==VI -> eval(Eq,RetType,Depth,Self,[V|VM],VVO) ; - (eval(Eq,RetType,Depth,Self,V,VV), (V\==VV -> eval(Eq,RetType,Depth,Self,[VV|VI],VVO) ; VVO = [V|VI]))). - -eval_20(Eq,RetType,_Dpth,_Slf,X,Y):- \+ is_list(X),!,do_expander(Eq,RetType,X,Y). - -eval_20(Eq,_RetType,Depth,Self,[V|VI],[V|VO]):- var(V),is_list(VI),!,maplist(eval(Eq,_ArgRetType,Depth,Self),VI,VO). - - -% ================================================================= -% ================================================================= -% ================================================================= -% TRACE/PRINT -% ================================================================= -% ================================================================= -% ================================================================= - -eval_20(Eq,RetType,_Dpth,_Slf,['repl!'],Y):- !, repl,check_returnval(Eq,RetType,Y). -eval_20(Eq,RetType,Depth,Self,['!',Cond],Res):- !, call(eval(Eq,RetType,Depth,Self,Cond,Res)). -eval_20(Eq,RetType,Depth,Self,['rtrace!',Cond],Res):- !, rtrace(eval(Eq,RetType,Depth,Self,Cond,Res)). -eval_20(Eq,RetType,Depth,Self,['trace',Cond],Res):- !, with_debug(eval,eval(Eq,RetType,Depth,Self,Cond,Res)). -eval_20(Eq,RetType,Depth,Self,['time',Cond],Res):- !, time_eval(eval(Cond),eval(Eq,RetType,Depth,Self,Cond,Res)). -eval_20(Eq,RetType,Depth,Self,['print',Cond],Res):- !, eval(Eq,RetType,Depth,Self,Cond,Res),format('~N'),print(Res),format('~N'). -% !(println! $1) -eval_20(Eq,RetType,Depth,Self,['println!'|Cond],Res):- !, maplist(eval(Eq,RetType,Depth,Self),Cond,[Res|Out]), - format('~N'),maplist(write_src,[Res|Out]),format('~N'). -eval_20(Eq,RetType,Depth,Self,['trace!',A|Cond],Res):- !, maplist(eval(Eq,RetType,Depth,Self),[A|Cond],[AA|Result]), - last(Result,Res), format('~N'),maplist(write_src,[AA]),format('~N'). - -%eval_20(Eq,RetType,Depth,Self,['trace!',A,B],C):- !,eval(Eq,RetType,Depth,Self,B,C),format('~N'),wdmsg(['trace!',A,B]=C),format('~N'). -%eval_20(Eq,RetType,_Dpth,_Slf,['trace!',A],A):- !, format('~N'),wdmsg(A),format('~N'). - -eval_20(Eq,RetType,_Dpth,_Slf,List,YY):- is_list(List),maplist(self_eval,List),List=[H|_], \+ atom(H), !,Y=List,do_expander(Eq,RetType,Y,YY). - -eval_20(Eq,_ListOfRetType,Depth,Self,['TupleConcat',A,B],OO):- fail, !, - eval(Eq,RetType,Depth,Self,A,AA), - eval(Eq,RetType,Depth,Self,B,BB), - append(AA,BB,OO). -eval_20(Eq,OuterRetType,Depth,Self,['range',A,B],OO):- (is_list(A);is_list(B)), - ((eval(Eq,RetType,Depth,Self,A,AA), - eval(Eq,RetType,Depth,Self,B,BB))), - ((AA+BB)\=@=(A+B)), - eval_20(Eq,OuterRetType,Depth,Self,['range',AA,BB],OO),!. - - -%eval_20(Eq,RetType,Depth,Self,['colapse'|List], Flat):- !, maplist(eval(Eq,RetType,Depth,Self),List,Res),flatten(Res,Flat). - - - - -% ================================================================= -% ================================================================= -% ================================================================= -% UNIT TESTING/assert -% ================================================================= -% ================================================================= -% ================================================================= - - -eval_20(Eq,RetType,Depth,Self,['assertTrue', X],TF):- !, eval(Eq,RetType,Depth,Self,['assertEqual',X,'True'],TF). -eval_20(Eq,RetType,Depth,Self,['assertFalse',X],TF):- !, eval(Eq,RetType,Depth,Self,['assertEqual',X,'False'],TF). - -eval_20(Eq,RetType,Depth,Self,['assertEqual',X,Y],RetVal):- !, - loonit_assert_source_tf( - ['assertEqual',X,Y], - (bagof_eval(Eq,RetType,Depth,Self,X,XX), bagof_eval(Eq,RetType,Depth,Self,Y,YY)), - equal_enough_for_test(XX,YY), TF), - (TF=='True'->return_empty(RetVal);RetVal=[got,XX,[expected(_)],YY]). - -eval_20(Eq,RetType,Depth,Self,['assertNotEqual',X,Y],RetVal):- !, - loonit_assert_source_tf( - ['assertEqual',X,Y], - (bagof_eval(Eq,RetType,Depth,Self,X,XX), bagof_eval(Eq,RetType,Depth,Self,Y,YY)), - \+ equal_enough(XX,YY), TF), - (TF=='True'->return_empty(RetVal);RetVal=[got,XX,expected,YY]). - -eval_20(Eq,RetType,Depth,Self,['assertEqualToResult',X,Y],RetVal):- !, - loonit_assert_source_tf( - ['assertEqualToResult',X,Y], - (bagof_eval(Eq,RetType,Depth,Self,X,XX), sort(Y,YY)), - equal_enough_for_test(XX,YY), TF), - (TF=='True'->return_empty(RetVal);RetVal=[got,XX,expected,YY]). - - -loonit_assert_source_tf(Src,Goal,Check,TF):- - copy_term(Goal,OrigGoal), - loonit_asserts(Src, time_eval('\n; EVAL TEST\n;',Goal), Check), - as_tf(Check,TF),!, - ignore(( - once((TF='True', trace_on_pass);(TF='False', trace_on_fail)), - with_debug(metta(eval),time_eval('Trace',OrigGoal)))). - -sort_result(Res,Res):- \+ compound(Res),!. -sort_result([And|Res1],Res):- is_and(And),!,sort_result(Res1,Res). -sort_result([T,And|Res1],Res):- is_and(And),!,sort_result([T|Res1],Res). -sort_result([H|T],[HH|TT]):- !, sort_result(H,HH),sort_result(T,TT). -sort_result(Res,Res). - -unify_enough(L,L). -%unify_enough(L,C):- is_list(L),into_list_args(C,CC),!,unify_lists(CC,L). -%unify_enough(C,L):- is_list(L),into_list_args(C,CC),!,unify_lists(CC,L). -%unify_enough(C,L):- \+ compound(C),!,L=C. -%unify_enough(L,C):- \+ compound(C),!,L=C. -unify_enough(L,C):- into_list_args(L,LL),into_list_args(C,CC),unify_lists(CC,LL). - -%unify_lists(C,L):- \+ compound(C),!,L=C. -%unify_lists(L,C):- \+ compound(C),!,L=C. -unify_lists(L,L):-!. -unify_lists([C|CC],[L|LL]):- unify_enough(L,C),!,unify_lists(CC,LL). - -equal_enough(R,V):- is_list(R),is_list(V),sort(R,RR),sort(V,VV),!,equal_enouf(RR,VV),!. -equal_enough(R,V):- copy_term(R,RR),copy_term(V,VV),equal_enouf(R,V),!,R=@=RR,V=@=VV. - -%s_empty(X):- var(X),!. -s_empty(X):- var(X),!,fail. -is_empty('Empty'). -is_empty([]). -is_empty([X]):-!,is_empty(X). -has_let_star(Y):- sub_var('let*',Y). - -equal_enough_for_test(X,Y):- is_empty(X),!,is_empty(Y). -equal_enough_for_test(X,Y):- has_let_star(Y),!,\+ is_empty(X). -equal_enough_for_test(X,Y):- must_det_ll((subst_vars(X,XX),subst_vars(Y,YY))),!,equal_enough_for_test2(XX,YY),!. -equal_enough_for_test2(X,Y):- equal_enough(X,Y). - -equal_enouf(R,V):- is_ftVar(R), is_ftVar(V), R=V,!. -equal_enouf(X,Y):- is_empty(X),!,is_empty(Y). -equal_enouf(R,V):- R=@=V, R=V, !. -equal_enouf(_,V):- V=@='...',!. -equal_enouf(L,C):- is_list(L),into_list_args(C,CC),!,equal_enouf_l(CC,L). -equal_enouf(C,L):- is_list(L),into_list_args(C,CC),!,equal_enouf_l(CC,L). -%equal_enouf(R,V):- (var(R),var(V)),!, R=V. -equal_enouf(R,V):- (var(R);var(V)),!, R==V. -equal_enouf(R,V):- number(R),number(V),!, RV is abs(R-V), RV < 0.03 . -equal_enouf(R,V):- atom(R),!,atom(V), has_unicode(R),has_unicode(V). -equal_enouf(R,V):- (\+ compound(R) ; \+ compound(V)),!, R==V. -equal_enouf(L,C):- into_list_args(L,LL),into_list_args(C,CC),!,equal_enouf_l(CC,LL). - -equal_enouf_l([S1,V1|_],[S2,V2|_]):- S1 == 'State',S2 == 'State',!, equal_enouf(V1,V2). -equal_enouf_l(C,L):- \+ compound(C),!,L=@=C. -equal_enouf_l(L,C):- \+ compound(C),!,L=@=C. -equal_enouf_l([C|CC],[L|LL]):- !, equal_enouf(L,C),!,equal_enouf_l(CC,LL). - - -has_unicode(A):- atom_codes(A,Cs),member(N,Cs),N>127,!. - -set_last_error(_). - -% ================================================================= -% ================================================================= -% ================================================================= -% SPACE EDITING -% ================================================================= -% ================================================================= -% ================================================================= -% do_metta(_Who,What,Where,PredDecl,_TF):- do_metta(Where,What, PredDecl). -/* -eval_20(Eq,RetType,_Dpth,Self,['add-atom',Other,PredDecl],TF):- !, into_space(Self,Other,Space), as_tf(do_metta(Space,load,PredDecl),TF). -eval_20(Eq,RetType,_Dpth,Self,['remove-atom',Other,PredDecl],TF):- !, into_space(Self,Other,Space), as_tf(do_metta(Space,unload,PredDecl),TF). -eval_20(Eq,RetType,_Dpth,Self,['atom-count',Other],Count):- !, into_space(Self,Other,Space), findall(_,metta_defn(Eq,Other,_,_),L1),length(L1,C1),findall(_,get_metta_atom(Eq,Space,_),L2),length(L2,C2),Count is C1+C2. -eval_20(Eq,RetType,_Dpth,Self,['atom-replace',Other,Rem,Add],TF):- !, into_space(Self,Other,Space), copy_term(Rem,RCopy), - as_tf((metta_atom_iter_ref(Space,RCopy,Ref), RCopy=@=Rem,erase(Ref), do_metta(Other,load,Add)),TF). -*/ -eval_20(Eq,RetType,Depth,Self,[Op,Space|Args],Res):- is_space_op(Op),!, - eval_space_start(Eq,RetType,Depth,Self,[Op,Space|Args],Res). - - -eval_space_start(Eq,RetType,_Depth,_Self,[_Op,_Other,Atom],Res):- - (Atom == [] ; Atom =='Empty'; Atom =='Nil'),!,return_empty('False',Res),check_returnval(Eq,RetType,Res). - -eval_space_start(Eq,RetType,Depth,Self,[Op,Other|Args],Res):- - into_space(Depth,Self,Other,Space), - eval_space(Eq,RetType,Depth,Self,[Op,Space|Args],Res). - - -eval_space(Eq,RetType,_Dpth,_Slf,['add-atom',Space,PredDecl],Res):- !, - do_metta(python,load,Space,PredDecl,TF),return_empty(TF,Res),check_returnval(Eq,RetType,Res). - -eval_space(Eq,RetType,_Dpth,_Slf,['remove-atom',Space,PredDecl],Res):- !, - do_metta(python,unload,Space,PredDecl,TF),return_empty(TF,Res),check_returnval(Eq,RetType,Res). - -eval_space(Eq,RetType,_Dpth,_Slf,['atom-count',Space],Count):- !, - ignore(RetType='Number'),ignore(Eq='='), - findall(Atom, get_metta_atom_from(Space, Atom),Atoms), - length(Atoms,Count). - -eval_space(Eq,RetType,_Dpth,_Slf,['atom-replace',Space,Rem,Add],TF):- !, - copy_term(Rem,RCopy), as_tf((metta_atom_iter_ref(Space,RCopy,Ref), RCopy=@=Rem,erase(Ref), do_metta(Space,load,Add)),TF), - check_returnval(Eq,RetType,TF). - -eval_space(Eq,RetType,_Dpth,_Slf,['get-atoms',Space],Atom):- !, - ignore(RetType='Atom'), get_metta_atom_from(Space, Atom), check_returnval(Eq,RetType,Atom). - -/* -get_atoms(_Dpth,_Slf,Other,Atom):- Other=='&self',!,get_metta_atom_from(Other, Atom). -% get_atoms_fail(Depth,Self,Other,Atom):- fail, is_asserted_space(Other),!, get_metta_atom(Eq,Other,Atom). -get_atoms(Depth,Self,Other,AtomO):- - into_space(Depth,Self,Other,Space), - once((space_to_Space(Depth,Self,Space,SpaceC), - into_listoid(SpaceC,AtomsL))), - %no_repeat_var(NRAtom), - dcall((member(Atom,AtomsL), - %Atom = NRAtom, - AtomO=Atom)). - -space_to_Space(_Dpth,_Slf,Space,SpaceC):- compound(Space),functor(Space,_,1),arg(1,Space,L),is_list(L),!,SpaceC=Space. -space_to_Space(_Dpth,_Slf,Space,SpaceC):- findall(Atom, get_metta_atom_from(Space, Atom),Atoms), - SpaceC = 'hyperon::space::DynSpace'(Atoms). -*/ - -%eval_space(Eq,RetType,Depth,Self,['match',Other,Goal,Template],Template):- into_space(Self,Other,Space),!, metta_atom_iter(Eq,Depth,Space,Goal). -%eval_space(Eq,RetType,Depth,Self,['match',Other,Goal,Template,Else],Template):- into_space(Self,Other,Space),!, (metta_atom_iter(Eq,Depth,Space,Goal)*->true;Else=Template). - -% Match-ELSE -eval_space(Eq,RetType,Depth,Self,['match',Other,Goal,Template,Else],Template):- !, - ((eval_space(Eq,RetType,Depth,Self,['match',Other,Goal,Template],Template), - \+ return_empty([],Template))*->true;Template=Else). -% Match-TEMPLATE - -eval_space(Eq,RetType,Depth,Self,['match',Other,Goal,Template],Res):- !, - metta_atom_iter(Eq,Depth,Self,Other,Goal), - Template=Res. - %finish_eval(Eq,RetType,Depth,Self,Template,Res). -/* - dcall(( % copy_term(Goal+Template,CGoal+CTemplate), - catch_err(try_match(Eq,RetType,Depth,Self,Other,Goal),E, - ((wdmsg(catch_err(try_match(Eq,RetType,Depth,Self,Other,Goal))=E)), - rtrace(try_match(Eq,RetType,Depth,Self,Other,Goal)))))), - %print(Template), - finish_eval(Eq,RetType,Depth,Self,Template,Res). - -try_match(Eq,RetType,Depth,Self,Space,Goal):- !, - % into_space(Depth,Self,Other,Space), - metta_atom_iter(Eq,Depth,Self,Space,Goal). - -%try_match(Depth,Self,Other,Goal,_Template):- get_atoms(Depth,Self,Other,Goal). % Template=Res. -metta_atom_iter(Eq,Depth,Other,Goal):- - current_self(Self), - metta_atom_iter(Eq,Depth,Self,Other,Goal). - -metta_atom_iter_fail(Depth,_Slf,Other,[Equal,[F|H],B]):- fail, '=' == Equal,!, % trace, - dcall(metta_defn(Eq,Other,[F|HH],BB)), - once(eval_until_unify(Eq,RetType,Depth,Other,H,HH)), - once(eval_until_unify(Eq,RetType,Depth,Other,B,BB)). -*/ - -metta_atom_iter(Eq,_Depth,_Slf,Other,[Equal,[F|H],B]):- Eq == Equal,!, % trace, - (metta_defn(Eq,Other,[F|H],B)). % once(eval_until_unify(Eq,RetType,Depth,Other,H,HH)). - -%metta_atom_iter(Eq,Depth,_Slf,Other,[Equal,[F|H],B]):- '=' == Equal,!, % trace, - % dcall(metta_defn(Eq,Other,[F|HH],B)), once(eval_until_unify(Eq,RetType,Depth,Other,H,HH)). - -metta_atom_iter(_Eq,Depth,_,_,_):- Depth<3,!,fail. -% And -metta_atom_iter(Eq,Depth,Self,Other,[And|Y]):- atom(And), is_and(And),!, - (Y==[] -> true ; ( D2 is Depth -1, Y = [H|T], metta_atom_iter(Eq,D2,Self,Other,H),metta_atom_iter(Eq,D2,Self,Other,[And|T]))). - -metta_atom_iter(Eq,_Dpth,_Slf,Other,H):- get_metta_atom(Eq,Other,H). - -% is this OK? -metta_atom_iter(Eq,Depth,Self,Other,H):- metta_defn(Eq,Other,H,B), D2 is Depth -1, metta_atom_iter(Eq,D2,Self,Other,B). -%metta_atom_iter_l2(Depth,Self,Other,H):- metta_atom_iter(Eq,Depth,Self,Other,H). -%$metta_atom_iter(Eq,_Dpth,_Slf,[]):-!. - -eval_20(Eq,RetType,_Dpth,_Slf,['new-space'],Space):- !, 'new-space'(Space),check_returnval(Eq,RetType,Space). - - -/* - -metta_atom_iter(Eq,_Dpth,Other,[Equal,H,B]):- '=' == Equal,!, - (metta_defn(Eq,Other,H,B)*->true;(get_metta_atom(Eq,Other,H),B='True')). - -metta_atom_iter(Eq,Depth,_,_):- Depth<3,!,fail. -metta_atom_iter(Eq,_Dpth,_Slf,[]):-!. -metta_atom_iter(Eq,_Dpth,Other,H):- get_metta_atom(Eq,Other,H). -metta_atom_iter(Eq,Depth,Other,H):- D2 is Depth -1, metta_defn(Eq,Other,H,B),metta_atom_iter(Eq,D2,Other,B). -metta_atom_iter(Eq,_Dpth,_Slf,[And]):- is_and(And),!. -metta_atom_iter(Eq,Depth,Self,[And,X|Y]):- is_and(And),!,D2 is Depth -1, metta_atom_iter(Eq,D2,Self,X),metta_atom_iter(Eq,D2,Self,[And|Y]). -*/ -/* -metta_atom_iter2(_,Self,[=,X,Y]):- metta_defn(Eq,Self,X,Y). -metta_atom_iter2(_Dpth,Other,[Equal,H,B]):- '=' == Equal,!, metta_defn(Eq,Other,H,B). -metta_atom_iter2(_Dpth,Self,X,Y):- metta_defn(Eq,Self,X,Y). %, Y\=='True'. -metta_atom_iter2(_Dpth,Self,X,Y):- get_metta_atom(Eq,Self,[=,X,Y]). %, Y\=='True'. -*/ -%metta_atom_iter_ref(Other,[Eq,H,B],Ref):-clause(metta_defn(Eq,Other,H,B),true,Ref). -metta_atom_iter_ref(Other,H,Ref):-clause(metta_atom_asserted(Other,H),true,Ref). - - -% ================================================================= -% ================================================================= -% ================================================================= -% CASE/SWITCH -% ================================================================= -% ================================================================= -% ================================================================= -% Macro: case -:- nodebug(metta(case)). -/* -!(assertEqualToResult - (case - (Link $X B) - ( ( (g $Y) - (Link $X $Y)))) ()) -*/ -/* -eval_20(Eq,RetType,Depth,Self,['case',A,CL],Value):- !, -((eval(Depth,Self,A,AA), - if_trace((case),(writeqln('switch'(A)=AA))), - eval_case_result(Eq,RetType,Depth,Self,A,AA,CL,Value))*->true; -Value=found_none). - -eval_case_result(Eq,RetType,Depth,Self,A,AA,CL,Value):- - must_det_ll(into_case_list(1,CL,KVs)), - select_switch(Depth,Self,AA,KVs,Match,Value), - if_trace((case),(writeqln('matched'=Match))), - if_trace((case),(writeqln('result'=Value))), - check_returnval(Value,Eq,RetType). -eval_case_result(Eq,RetType,Depth,Self,A,AA,CL,Value):- - select(['%void%',_],CL,Rest), Rest == [],!, Value =[]. -eval_case_result(Eq,RetType,Depth,Self,A,AA,CL,Value):- - select(['%void%',Value],CL,Rest),!. - - -select_switch(Depth,_Self,_A,_Cases,_Match,_Value):- Depth<1,!,fail. -select_switch(Depth,Self,A,Cases,Match,Value):- - Depth2 is Depth -1, - ((if_trace((case),(writeqln('select-1'=A))),select_case(Depth2,Self,A,Cases,Match,Value))*->true; - ((eval_complete_change(Eq,_RetType,Depth2,Self,A,AA),if_trace((case),(writeqln('select-2'=AA))), - select_switch(Depth2,Self, AA,Cases,Match,Value))*->true; - (best_key('%void%',Cases,Match,Value)))). - - select_case(Depth,Self,AA,Cases,Match,Value):- - ((best_key(AA,Cases,Match,Value) *-> true ; - ((maybe_special_keys(Depth,Self,Cases,CasES), best_key(AA,CasES,Match,Value)) *-> true; - (fail)))). - - best_key(AA,Cases,Match,Value):- - ((member(Match-Value,Cases),AA ==Match,must_det_ll(AA = Match))->true; - ((member(Match-Value,Cases),AA=@=Match,must_det_ll(AA = Match))->true; - ((member(Match-Value,Cases), AA=Match))->true; - ((member(Match-Value,Cases),unify_enough(AA,Match))->true))). - - %into_case_list([[C|ASES0]],CASES):- is_list(C),!, into_case_list([C|ASES0],CASES),!. - into_case_list(N,[SV|CL],[S-V|CASES]):- - must_det_ll(is_case(S,SV,V)), - if_trace((case),(format('~N'), writeqln('case'(N)=(S>V)))), - N2 is N+1, - into_case_list(N2,CL,CASES). - into_case_list(_,[],[]). - - is_case(AA,[AA,Value],Value):-!. - is_case(AA,[AA|Value],Value). - - %maybe_special_keys(Depth,Self,[K-V|KVI],[AK-V|KVO]):- fail,eval(Eq,RetType,Depth,Self,K,AK), K\=@=AK,!, maybe_special_keys(Depth,Self,KVI,KVO). - maybe_special_keys(Depth,Self,[_|KVI],KVO):- - fail, maybe_special_keys(Depth,Self,KVI,KVO). - maybe_special_keys(_Depth,_Self,[],[]). - -*/ - -% if there is only a void then always return nothing for each Case -eval_20(Eq,_RetType,Depth,Self,['case',A,[[Void,_]]],Res):- - '%void%' == Void, - eval(Eq,_UnkRetType,Depth,Self,A,_),!,Res =[]. - -% if there is nothing for case just treat like a collapse -eval_20(Eq,_RetType,Depth,Self,['case',A,[]],Empty):- - %forall(eval(Eq,_RetType2,Depth,Self,Expr,_),true), - once(eval(Eq,_RetType2,Depth,Self,A,_)), - return_empty([],Empty). - -% Macro: case -eval_20(Eq,RetType,Depth,Self,['case',A,CL|T],Res):- - must_det_ll(T==[]), - into_case_list(CL,CASES), - findall(Key-Value, - (nth0(Nth,CASES,Case0), - (is_case(Key,Case0,Value), - if_trace(metta(case),(format('~N'),writeqln(c(Nth,Key)=Value))))),KVs),!, - eval_case(Eq,RetType,Depth,Self,A,KVs,Res). - -eval_case(Eq,CaseRetType,Depth,Self,A,KVs,Res):- - ((eval(Eq,_UnkRetType,Depth,Self,A,AA), - if_trace((case),(writeqln('case'=A))), - if_trace(metta(case),writeqln('switch'=AA)), - (select_case(Depth,Self,AA,KVs,Value)->true;(member(Void -Value,KVs),Void=='%void%'))) - *->true;(member(Void -Value,KVs),Void=='%void%')), - eval(Eq,CaseRetType,Depth,Self,Value,Res). - - select_case(Depth,Self,AA,Cases,Value):- - (best_key(AA,Cases,Value) -> true ; - (maybe_special_keys(Depth,Self,Cases,CasES), - (best_key(AA,CasES,Value) -> true ; - (member(Void -Value,CasES),Void=='%void%')))). - - best_key(AA,Cases,Value):- - ((member(Match-Value,Cases),AA ==Match)->true; - ((member(Match-Value,Cases),AA=@=Match)->true; - (member(Match-Value,Cases),AA = Match))). - - %into_case_list([[C|ASES0]],CASES):- is_list(C),!, into_case_list([C|ASES0],CASES),!. - into_case_list(CASES,CASES):- is_list(CASES),!. - is_case(AA,[AA,Value],Value):-!. - is_case(AA,[AA|Value],Value). - - maybe_special_keys(Depth,Self,[K-V|KVI],[AK-V|KVO]):- - eval(Depth,Self,K,AK), K\=@=AK,!, - maybe_special_keys(Depth,Self,KVI,KVO). - maybe_special_keys(Depth,Self,[_|KVI],KVO):- - maybe_special_keys(Depth,Self,KVI,KVO). - maybe_special_keys(_Depth,_Self,[],[]). - - -% ================================================================= -% ================================================================= -% ================================================================= -% COLLAPSE/SUPERPOSE -% ================================================================= -% ================================================================= -% ================================================================= - - - -%[collapse,[1,2,3]] -eval_20(Eq,RetType,Depth,Self,['collapse',List],Res):-!, - bagof_eval(Eq,RetType,Depth,Self,List,Res). - -eval_20(Eq,RetType,Depth,Self,PredDecl,Res):- - Do_more_defs = do_more_defs(true), - clause(eval_21(Eq,RetType,Depth,Self,PredDecl,Res),Body), - Do_more_defs == do_more_defs(true), - call_ndet(Body,DET), - nb_setarg(1,Do_more_defs,false), - (DET==true -> ! ; true). - - -eval_21(Eq,RetType,Depth,Self,['CollapseCardinality',List],Len):-!, - bagof_eval(Eq,RetType,Depth,Self,List,Res), - length(Res,Len). -/* -eval_21(_Eq,_RetType,_Depth,_Self,['TupleCount', [N]],N):- number(N),!. - - -eval_21(Eq,RetType,Depth,Self,['TupleCount',List],Len):-!, - bagof_eval(Eq,RetType,Depth,Self,List,Res), - length(Res,Len). -*/ - -%[superpose,[1,2,3]] -eval_20(Eq,RetType,Depth,Self,['superpose',List],Res):- !, - (((is_user_defined_head(Eq,Self,List) ,eval(Eq,RetType,Depth,Self,List,UList), List\=@=UList) - *-> eval_20(Eq,RetType,Depth,Self,['superpose',UList],Res) - ; ((member(E,List),eval(Eq,RetType,Depth,Self,E,Res))*->true;return_empty([],Res)))), - \+ Res = 'Empty'. - -%[sequential,[1,2,3]] -eval_20(Eq,RetType,Depth,Self,['sequential',List],Res):- !, - (((fail,is_user_defined_head(Eq,Self,List) ,eval(Eq,RetType,Depth,Self,List,UList), List\=@=UList) - *-> eval_20(Eq,RetType,Depth,Self,['sequential',UList],Res) - ; ((member(E,List),eval_ne(Eq,RetType,Depth,Self,E,Res))*->true;return_empty([],Res)))). - - -get_sa_p1(P3,E,Cmpd,SA):- compound(Cmpd), get_sa_p2(P3,E,Cmpd,SA). -get_sa_p2(P3,E,Cmpd,call(P3,N1,Cmpd)):- arg(N1,Cmpd,E). -get_sa_p2(P3,E,Cmpd,SA):- arg(_,Cmpd,Arg),get_sa_p1(P3,E,Arg,SA). -eval20_failed(Eq,RetType,Depth,Self, Term, Res):- - mnotrace(( get_sa_p1(setarg,ST,Term,P1), % ST\==Term, - compound(ST), ST = [F,List],F=='superpose',nonvar(List), %maplist(atomic,List), - call(P1,Var))), !, - %max_counting(F,20), - member(Var,List), - eval(Eq,RetType,Depth,Self, Term, Res). - - -sub_sterm(Sub,Sub). -sub_sterm(Sub,Term):- sub_sterm1(Sub,Term). -sub_sterm1(_ ,List):- \+ compound(List),!,fail. -sub_sterm1(Sub,List):- is_list(List),!,member(SL,List),sub_sterm(Sub,SL). -sub_sterm1(_ ,[_|_]):-!,fail. -sub_sterm1(Sub,Term):- arg(_,Term,SL),sub_sterm(Sub,SL). -eval20_failed_2(Eq,RetType,Depth,Self, Term, Res):- - mnotrace(( get_sa_p1(setarg,ST,Term,P1), - compound(ST), ST = [F,List],F=='collapse',nonvar(List), %maplist(atomic,List), - call(P1,Var))), !, bagof_eval(Eq,RetType,Depth,Self,List,Var), - eval(Eq,RetType,Depth,Self, Term, Res). - - -% ================================================================= -% ================================================================= -% ================================================================= -% NOP/EQUALITU/DO -% ================================================================= -% ================================================================= -% ================================================================ -eval_20(_Eq,_RetType,_Depth,_Self,['nop'], _ ):- !, fail. -eval_20(_Eq,_RetType1,Depth,Self,['nop',Expr], Empty):- !, - ignore(eval('=',_RetType2,Depth,Self,Expr,_)), - return_empty([], Empty). - -eval_20(Eq,_RetType1,Depth,Self,['do',Expr], Empty):- !, - forall(eval(Eq,_RetType2,Depth,Self,Expr,_),true), - %eval_ne(Eq,_RetType2,Depth,Self,Expr,_),!, - return_empty([],Empty). - -max_counting(F,Max):- flag(F,X,X+1), X true; (flag(F,_,10),!,fail). -% ================================================================= -% ================================================================= -% ================================================================= -% if/If -% ================================================================= -% ================================================================= -% ================================================================= - - - -eval_20(Eq,RetType,Depth,Self,['if',Cond,Then,Else],Res):- !, - eval(Eq,'Bool',Depth,Self,Cond,TF), - (is_True(TF) - -> eval(Eq,RetType,Depth,Self,Then,Res) - ; eval(Eq,RetType,Depth,Self,Else,Res)). - -eval_20(Eq,RetType,Depth,Self,['If',Cond,Then,Else],Res):- !, - eval(Eq,'Bool',Depth,Self,Cond,TF), - (is_True(TF) - -> eval(Eq,RetType,Depth,Self,Then,Res) - ; eval(Eq,RetType,Depth,Self,Else,Res)). - -eval_20(Eq,RetType,Depth,Self,['If',Cond,Then],Res):- !, - eval(Eq,'Bool',Depth,Self,Cond,TF), - (is_True(TF) -> eval(Eq,RetType,Depth,Self,Then,Res) ; - (!, fail,Res = [],!)). - -eval_20(Eq,RetType,Depth,Self,['if',Cond,Then],Res):- !, - eval(Eq,'Bool',Depth,Self,Cond,TF), - (is_True(TF) -> eval(Eq,RetType,Depth,Self,Then,Res) ; - (!, fail,Res = [],!)). - - -eval_20(Eq,RetType,_Dpth,_Slf,[_,Nothing],NothingO):- - 'Nothing'==Nothing,!,do_expander(Eq,RetType,Nothing,NothingO). - -% ================================================================= -% ================================================================= -% ================================================================= -% LET/LET* -% ================================================================= -% ================================================================= -% ================================================================= - - - -eval_until_unify(_Eq,_RetType,_Dpth,_Slf,X,X):- !. -eval_until_unify(Eq,RetType,Depth,Self,X,Y):- eval_until_eq(Eq,RetType,Depth,Self,X,Y). - -eval_until_eq(Eq,RetType,_Dpth,_Slf,X,Y):- X=Y,check_returnval(Eq,RetType,Y). -%eval_until_eq(Eq,RetType,Depth,Self,X,Y):- var(Y),!,eval_in_steps_or_same(Eq,RetType,Depth,Self,X,XX),Y=XX. -%eval_until_eq(Eq,RetType,Depth,Self,Y,X):- var(Y),!,eval_in_steps_or_same(Eq,RetType,Depth,Self,X,XX),Y=XX. -eval_until_eq(Eq,RetType,Depth,Self,X,Y):- \+is_list(Y),!,eval_in_steps_some_change(Eq,RetType,Depth,Self,X,XX),Y=XX. -eval_until_eq(Eq,RetType,Depth,Self,Y,X):- \+is_list(Y),!,eval_in_steps_some_change(Eq,RetType,Depth,Self,X,XX),Y=XX. -eval_until_eq(Eq,RetType,Depth,Self,X,Y):- eval_in_steps_some_change(Eq,RetType,Depth,Self,X,XX),eval_until_eq(Eq,RetType,Depth,Self,Y,XX). -eval_until_eq(_Eq,_RetType,_Dpth,_Slf,X,Y):- length(X,Len), \+ length(Y,Len),!,fail. -eval_until_eq(Eq,RetType,Depth,Self,X,Y):- nth1(N,X,EX,RX), nth1(N,Y,EY,RY), - EX=EY,!, maplist(eval_until_eq(Eq,RetType,Depth,Self),RX,RY). -eval_until_eq(Eq,RetType,Depth,Self,X,Y):- nth1(N,X,EX,RX), nth1(N,Y,EY,RY), - ((var(EX);var(EY)),eval_until_eq(Eq,RetType,Depth,Self,EX,EY)), - maplist(eval_until_eq(Eq,RetType,Depth,Self),RX,RY). -eval_until_eq(Eq,RetType,Depth,Self,X,Y):- nth1(N,X,EX,RX), nth1(N,Y,EY,RY), - h((is_list(EX);is_list(EY)),eval_until_eq(Eq,RetType,Depth,Self,EX,EY)), - maplist(eval_until_eq(Eq,RetType,Depth,Self),RX,RY). - - eval_1change(Eq,RetType,Depth,Self,EX,EXX):- - eval_20(Eq,RetType,Depth,Self,EX,EXX), EX \=@= EXX. - -eval_complete_change(Eq,RetType,Depth,Self,EX,EXX):- - eval(Eq,RetType,Depth,Self,EX,EXX), EX \=@= EXX. - -eval_in_steps_some_change(_Eq,_RetType,_Dpth,_Slf,EX,_):- \+ is_list(EX),!,fail. -eval_in_steps_some_change(Eq,RetType,Depth,Self,EX,EXX):- eval_1change(Eq,RetType,Depth,Self,EX,EXX). -eval_in_steps_some_change(Eq,RetType,Depth,Self,X,Y):- append(L,[EX|R],X),is_list(EX), - eval_in_steps_some_change(Eq,RetType,Depth,Self,EX,EXX), EX\=@=EXX, - append(L,[EXX|R],XX),eval_in_steps_or_same(Eq,RetType,Depth,Self,XX,Y). - -eval_in_steps_or_same(Eq,RetType,Depth,Self,X,Y):-eval_in_steps_some_change(Eq,RetType,Depth,Self,X,Y). -eval_in_steps_or_same(Eq,RetType,_Dpth,_Slf,X,Y):- X=Y,check_returnval(Eq,RetType,Y). - - % (fail,return_empty([],Template))). - - -eval_20(Eq,RetType,Depth,Self,['let',A,A5,AA],OO):- !, - %(var(A)->true;trace), - ((eval(Eq,RetType,Depth,Self,A5,AE), AE=A)), - eval(Eq,RetType,Depth,Self,AA,OO). -%eval_20(Eq,RetType,Depth,Self,['let',A,A5,AA],AAO):- !,eval(Eq,RetType,Depth,Self,A5,A),eval(Eq,RetType,Depth,Self,AA,AAO). -eval_20(Eq,RetType,Depth,Self,['let*',[],Body],RetVal):- !, eval(Eq,RetType,Depth,Self,Body,RetVal). -eval_20(Eq,RetType,Depth,Self,['let*',[[Var,Val]|LetRest],Body],RetVal):- !, - eval_20(Eq,RetType,Depth,Self,['let',Var,Val,['let*',LetRest,Body]],RetVal). - - -% ================================================================= -% ================================================================= -% ================================================================= -% CONS/CAR/CDR -% ================================================================= -% ================================================================= -% ================================================================= - - - -into_pl_list(Var,Var):- var(Var),!. -into_pl_list(Nil,[]):- Nil == 'Nil',!. -into_pl_list([Cons,H,T],[HH|TT]):- Cons == 'Cons', !, into_pl_list(H,HH),into_pl_list(T,TT),!. -into_pl_list(X,X). - -into_metta_cons(Var,Var):- var(Var),!. -into_metta_cons([],'Nil'):-!. -into_metta_cons([Cons, A, B ],['Cons', AA, BB]):- 'Cons'==Cons, no_cons_reduce, !, - into_metta_cons(A,AA), into_metta_cons(B,BB). -into_metta_cons([H|T],['Cons',HH,TT]):- into_metta_cons(H,HH),into_metta_cons(T,TT),!. -into_metta_cons(X,X). - -into_listoid(AtomC,Atom):- AtomC = [Cons,H,T],Cons=='Cons',!, Atom=[H,[T]]. -into_listoid(AtomC,Atom):- is_list(AtomC),!,Atom=AtomC. -into_listoid(AtomC,Atom):- typed_list(AtomC,_,Atom),!. - -:- if( \+ current_predicate( typed_list / 3 )). -typed_list(Cmpd,Type,List):- compound(Cmpd), Cmpd\=[_|_], compound_name_arguments(Cmpd,Type,[List|_]),is_list(List). -:- endif. - -%eval_20(Eq,RetType,Depth,Self,['colapse'|List], Flat):- !, maplist(eval(Eq,RetType,Depth,Self),List,Res),flatten(Res,Flat). - -%eval_20(Eq,RetType,Depth,Self,['flatten'|List], Flat):- !, maplist(eval(Eq,RetType,Depth,Self),List,Res),flatten(Res,Flat). - - -eval_20(Eq,RetType,_Dpth,_Slf,['car-atom',Atom],CAR_Y):- !, Atom=[CAR|_],!,do_expander(Eq,RetType,CAR,CAR_Y). -eval_20(Eq,RetType,_Dpth,_Slf,['cdr-atom',Atom],CDR_Y):- !, Atom=[_|CDR],!,do_expander(Eq,RetType,CDR,CDR_Y). - -eval_20(Eq,RetType,Depth,Self,['Cons', A, B ],['Cons', AA, BB]):- no_cons_reduce, !, - eval(Eq,RetType,Depth,Self,A,AA), eval(Eq,RetType,Depth,Self,B,BB). - -eval_20(Eq,RetType,Depth,Self,['Cons', A, B ],[AA|BB]):- \+ no_cons_reduce, !, - eval(Eq,RetType,Depth,Self,A,AA), eval(Eq,RetType,Depth,Self,B,BB). - - - -% ================================================================= -% ================================================================= -% ================================================================= -% STATE EDITING -% ================================================================= -% ================================================================= -% ================================================================= - -eval_20(Eq,RetType,Depth,Self,['change-state!',StateExpr, UpdatedValue], Ret):- !, eval(Eq,RetType,Depth,Self,StateExpr,StateMonad), - eval(Eq,RetType,Depth,Self,UpdatedValue,Value), 'change-state!'(Depth,Self,StateMonad, Value, Ret). -eval_20(Eq,RetType,Depth,Self,['new-state',UpdatedValue],StateMonad):- !, - eval(Eq,RetType,Depth,Self,UpdatedValue,Value), 'new-state'(Depth,Self,Value,StateMonad). -eval_20(Eq,RetType,Depth,Self,['get-state',StateExpr],Value):- !, - eval(Eq,RetType,Depth,Self,StateExpr,StateMonad), 'get-state'(StateMonad,Value). - - - -% eval_20(Eq,RetType,Depth,Self,['get-state',Expr],Value):- !, eval(Eq,RetType,Depth,Self,Expr,State), arg(1,State,Value). - - - -check_type:- option_else(typecheck,TF,'False'), TF=='True'. - -:- dynamic is_registered_state/1. -:- flush_output. -:- setenv('RUST_BACKTRACE',full). - -% Function to check if an value is registered as a state name -:- dynamic(is_registered_state/1). -is_nb_state(G):- is_valid_nb_state(G) -> true ; - is_registered_state(G),nb_current(G,S),is_valid_nb_state(S). - -/* -:- multifile(space_type_method/3). -:- dynamic(space_type_method/3). -space_type_method(is_nb_space,new_space,init_space). -space_type_method(is_nb_space,clear_space,clear_nb_atoms). -space_type_method(is_nb_space,add_atom,add_nb_atom). -space_type_method(is_nb_space,remove_atom,'change-space!'). -space_type_method(is_nb_space,replace_atom,replace_nb_atom). -space_type_method(is_nb_space,atom_count,atom_nb_count). -space_type_method(is_nb_space,get_atoms,'get-space'). -space_type_method(is_nb_space,atom_iter,atom_nb_iter). -*/ - -:- multifile(state_type_method/3). -:- dynamic(state_type_method/3). -state_type_method(is_nb_state,new_state,init_state). -state_type_method(is_nb_state,clear_state,clear_nb_values). -state_type_method(is_nb_state,add_value,add_nb_value). -state_type_method(is_nb_state,remove_value,'change-state!'). -state_type_method(is_nb_state,replace_value,replace_nb_value). -state_type_method(is_nb_state,value_count,value_nb_count). -state_type_method(is_nb_state,'get-state','get-state'). -state_type_method(is_nb_state,value_iter,value_nb_iter). -%state_type_method(is_nb_state,query,state_nb_query). - -% Clear all values from a state -clear_nb_values(StateNameOrInstance) :- - fetch_or_create_state(StateNameOrInstance, State), - nb_setarg(1, State, []). - - - -% Function to confirm if a term represents a state -is_valid_nb_state(State):- compound(State),functor(State,'State',_). - -% Find the original name of a given state -state_original_name(State, Name) :- - is_registered_state(Name), - nb_current(Name, State). - -% Register and initialize a new state -init_state(Name) :- - State = 'State'(_,_), - asserta(is_registered_state(Name)), - nb_setval(Name, State). - -% Change a value in a state -'change-state!'(Depth,Self,StateNameOrInstance, UpdatedValue, Out) :- - fetch_or_create_state(StateNameOrInstance, State), - arg(2, State, Type), - ( (check_type,\+ get_type(Depth,Self,UpdatedValue,Type)) - -> (Out = ['Error', UpdatedValue, 'BadType']) - ; (nb_setarg(1, State, UpdatedValue), Out = State) ). - -% Fetch all values from a state -'get-state'(StateNameOrInstance, Values) :- - fetch_or_create_state(StateNameOrInstance, State), - arg(1, State, Values). - -'new-state'(Depth,Self,Init,'State'(Init, Type)):- check_type->get_type(Depth,Self,Init,Type);true. - -'new-state'(Init,'State'(Init, Type)):- check_type->get_type(10,'&self',Init,Type);true. - -fetch_or_create_state(Name):- fetch_or_create_state(Name,_). -% Fetch an existing state or create a new one - -fetch_or_create_state(State, State) :- is_valid_nb_state(State),!. -fetch_or_create_state(NameOrInstance, State) :- - ( atom(NameOrInstance) - -> (is_registered_state(NameOrInstance) - -> nb_current(NameOrInstance, State) - ; init_state(NameOrInstance), - nb_current(NameOrInstance, State)) - ; is_valid_nb_state(NameOrInstance) - -> State = NameOrInstance - ; writeln('Error: Invalid input.') - ), - is_valid_nb_state(State). - -% ================================================================= -% ================================================================= -% ================================================================= -% GET-TYPE -% ================================================================= -% ================================================================= -% ================================================================= - -eval_20(Eq,RetType,Depth,Self,['get-type',Val],TypeO):- !, get_type(Depth,Self,Val,Type),ground(Type),Type\==[], Type\==Val,!, - do_expander(Eq,RetType,Type,TypeO). - - - -eval_20(Eq,RetType,Depth,Self,['length',L],Res):- !, eval(Eq,RetType,Depth,Self,L,LL), !, (is_list(LL)->length(LL,Res);Res=1). -eval_20(Eq,RetType,Depth,Self,['CountElement',L],Res):- !, eval(Eq,RetType,Depth,Self,L,LL), !, (is_list(LL)->length(LL,Res);Res=1). - - - - - - -% ================================================================= -% ================================================================= -% ================================================================= -% IMPORT/BIND -% ================================================================= -% ================================================================= -% ================================================================= -nb_bind(Name,Value):- nb_current(Name,Was),same_term(Value,Was),!. -nb_bind(Name,Value):- nb_setval(Name,Value),!. -eval_20(Eq,RetType,Depth,Self,['import!',Other,File],RetVal):- - (( into_space(Depth,Self,Other,Space),!, include_metta(Space,File),!,return_empty(Space,RetVal))), - check_returnval(Eq,RetType,RetVal). %RetVal=[]. -eval_20(Eq,RetType,_Depth,_Slf,['bind!',Other,['new-space']],RetVal):- atom(Other),!,assert(was_asserted_space(Other)), - return_empty([],RetVal), check_returnval(Eq,RetType,RetVal). -eval_20(Eq,RetType,Depth,Self,['bind!',Other,Expr],RetVal):- - must_det_ll((into_name(Self,Other,Name),!,eval(Eq,RetType,Depth,Self,Expr,Value), - nb_bind(Name,Value), return_empty(Value,RetVal))), - check_returnval(Eq,RetType,RetVal). -eval_20(Eq,RetType,Depth,Self,['pragma!',Other,Expr],RetVal):- - must_det_ll((into_name(Self,Other,Name),!,nd_ignore((eval(Eq,RetType,Depth,Self,Expr,Value), - set_option_value(Name,Value))), return_empty(Value,RetVal), - check_returnval(Eq,RetType,RetVal))). -eval_20(Eq,RetType,_Dpth,Self,['transfer!',File],RetVal):- !, must_det_ll((include_metta(Self,File), return_empty(Self,RetVal),check_returnval(Eq,RetType,RetVal))). - - -nd_ignore(Goal):- call(Goal)*->true;true. - - - - - - - - - -% ================================================================= -% ================================================================= -% ================================================================= -% AND/OR -% ================================================================= -% ================================================================= -% ================================================================= - -is_True(T):- T\=='False',T\==[]. - -is_and(S):- \+ atom(S),!,fail. -is_and(','). -is_and(S):- is_and(S,_). - -is_and(S,_):- \+ atom(S),!,fail. -is_and('and','True'). -is_and('and2','True'). -is_and('#COMMA','True'). is_and(',','True'). % is_and('And'). - -eval_20(Eq,RetType,_Dpth,_Slf,[And],True):- is_and(And,True),!,check_returnval(Eq,RetType,True). -eval_20(Eq,RetType,Depth,Self,[And,X,Y],TF):- is_and(And,True),!, as_tf(( - eval_args(Eq,RetType,Depth,Self,X,True),eval_args(Eq,RetType,Depth,Self,Y,True)),TF). -eval_20(Eq,RetType,Depth,Self,[And,X],True):- is_and(And,True),!, - eval_args(Eq,RetType,Depth,Self,X,True). -eval_20(Eq,RetType,Depth,Self,[And,X|Y],TF):- is_and(And,_True),!, - eval_args(Eq,RetType,Depth,Self,X,TF1), \+ \+ is_True(TF1), - eval_args(Eq,RetType,Depth,Self,[And|Y],TF). - -eval_20(Eq,RetType,Depth,Self,['or',X,Y],TF):- !, - as_tf((eval_args(Eq,RetType,Depth,Self,X,'True');eval_args(Eq,RetType,Depth,Self,Y,'True')),TF). - - -% ================================================================= -% ================================================================= -% ================================================================= -% MeTTaLog Extras -% ================================================================= -% ================================================================= -% ================================================================= - -eval_20(_Eq,_RetType1,_Depth,_Self,['call',S], TF):- !, eval_call(S,TF). -eval_20(Eq,RetType,Depth,Self,['eval',S], Res):- !, eval(Eq,RetType,Depth,Self,S, Res). - - -% ================================================================= -% ================================================================= -% ================================================================= -% DATA FUNCTOR -% ================================================================= -% ================================================================= -% ================================================================= -eval20_failked(Eq,RetType,Depth,Self,[V|VI],[V|VO]):- - nonvar(V),is_metta_data_functor(V),is_list(VI),!, - maplist(eval(Eq,RetType,Depth,Self),VI,VO). - - -% ================================================================= -% ================================================================= -% ================================================================= -% EVAL FAILED -% ================================================================= -% ================================================================= -% ================================================================= -eval_20(Eq,RetType,Depth,Self,X,Y):- - (eval_40(Eq,RetType,Depth,Self,X,M)*-> - M=Y ; - % finish_eval(Depth,Self,M,Y); - (eval_failed(Depth,Self,X,Y)*->true;X=Y)). - -eval_failed(Depth,Self,T,TT):- - finish_eval(Depth,Self,T,TT). - -finish_eval(_Dpth,_Slf,T,TT):- var(T),!,TT=T. -finish_eval(_Dpth,_Slf,[],[]):-!. -%finish_eval(_Dpth,_Slf,[F|LESS],Res):- once(eval_selfless([F|LESS],Res)),mnotrace([F|LESS]\==Res),!. -%finish_eval(Depth,Self,[V|Nil],[O]):- Nil==[], once(eval(Eq,RetType,Depth,Self,V,O)),V\=@=O,!. -finish_eval(Depth,Self,[H|T],[HH|TT]):- !, - eval(Depth,Self,H,HH), - finish_eval(Depth,Self,T,TT). -finish_eval(Depth,Self,T,TT):- eval(Depth,Self,T,TT). - - %eval(Eq,RetType,Depth,Self,X,Y):- eval_20(Eq,RetType,Depth,Self,X,Y)*->true;Y=[]. - -%eval_20(Eq,RetType,Depth,_,_,_):- Depth<1,!,fail. -%eval_20(Eq,RetType,Depth,_,X,Y):- Depth<3, !, ground(X), (Y=X). -%eval_20(Eq,RetType,_Dpth,_Slf,X,Y):- self_eval(X),!,Y=X. - -% Kills zero arity functions eval_20(Eq,RetType,Depth,Self,[X|Nil],[Y]):- Nil ==[],!,eval(Eq,RetType,Depth,Self,X,Y). - - -/* -into_values(List,Many):- List==[],!,Many=[]. -into_values([X|List],Many):- List==[],is_list(X),!,Many=X. -into_values(Many,Many). -eval_40(Eq,RetType,_Dpth,_Slf,Name,Value):- atom(Name), nb_current(Name,Value),!. -*/ -% Macro Functions -%eval_20(Eq,RetType,Depth,_,_,_):- Depth<1,!,fail. -eval_40(_Eq,_RetType,Depth,_,X,Y):- Depth<3, !, fail, ground(X), (Y=X). -eval_40(Eq,RetType,Depth,Self,[F|PredDecl],Res):- fail, - Depth>1, - mnotrace((sub_sterm1(SSub,PredDecl), ground(SSub),SSub=[_|Sub], is_list(Sub), maplist(atomic,SSub))), - eval(Eq,RetType,Depth,Self,SSub,Repl), - mnotrace((SSub\=Repl, subst(PredDecl,SSub,Repl,Temp))), - eval(Eq,RetType,Depth,Self,[F|Temp],Res). - - -% ================================================================= -% ================================================================= -% ================================================================= -% PLUS/MINUS -% ================================================================= -% ================================================================= -% ================================================================= -eval_40(Eq,RetType,Depth,Self,['+',N1,N2],N):- number(N1),!, - eval(Eq,RetType,Depth,Self,N2,N2Res), notrace(catch_err(N is N1+N2Res,_E,(set_last_error(['Error',N2Res,'Number']),fail))). -eval_40(Eq,RetType,Depth,Self,['-',N1,N2],N):- number(N1),!, - eval(Eq,RetType,Depth,Self,N2,N2Res), notrace(catch_err(N is N1-N2Res,_E,(set_last_error(['Error',N2Res,'Number']),fail))). -eval_40(Eq,RetType,Depth,Self,['*',N1,N2],N):- number(N1),!, - eval(Eq,RetType,Depth,Self,N2,N2Res), notrace(catch_err(N is N1*N2Res,_E,(set_last_error(['Error',N2Res,'Number']),fail))). - -% ================================================================= -% ================================================================= -% ================================================================= -% METTLOG PREDEFS -% ================================================================= -% ================================================================= -% ================================================================= - -eval_40(Eq,RetType,Depth,Self,['length',L],Res):- !, eval(Depth,Self,L,LL), - (is_list(LL)->length(LL,Res);Res=1), - check_returnval(Eq,RetType,Res). - -eval_40(Eq,RetType,_Dpth,_Slf,['arity',F,A],TF):- !,as_tf(current_predicate(F/A),TF),check_returnval(Eq,RetType,TF). - -eval_40(Eq,RetType,Depth,Self,['CountElement',L],Res):- !, eval(Eq,RetType,Depth,Self,L,LL), !, (is_list(LL)->length(LL,Res);Res=1),check_returnval(Eq,RetType,Res). -eval_40(Eq,RetType,_Dpth,_Slf,['make_list',List],MettaList):- !, into_metta_cons(List,MettaList),check_returnval(Eq,RetType,MettaList). - -% user defined function -eval_40(Eq,RetType,Depth,Self,[H|PredDecl],Res):- - mnotrace(is_user_defined_head(Self,H)),!, - eval_defn(Eq,RetType,Depth,Self,[H|PredDecl],Res). - -eval_40(Eq,RetType,_Dpth,_Slf,['==',X,Y],Res):- !, - suggest_type(RetType,'Bool'), - eq_unify(Eq,_SharedType, X, Y, Res). - -eq_unify(_Eq,_SharedType, X, Y, TF):- as_tf(X=:=Y,TF),!. -eq_unify(_Eq,_SharedType, X, Y, TF):- as_tf( '#='(X,Y),TF),!. -eq_unify( Eq, SharedType, X, Y, TF):- as_tf(eval_until_unify(Eq,SharedType, X, Y), TF). - - -suggest_type(_RetType,_Bool). - -eval_40(Eq,RetType,Depth,Self,[AE|More],Res):- is_special_op(AE),!, - eval_70(Eq,RetType,Depth,Self,[AE|More],Res), - check_returnval(Eq,RetType,Res). - -eval_40(Eq,RetType,Depth,Self,[AE|More],Res):- - maplist(must_eval_args(Eq,_,Depth,Self),More,Adjusted), - eval_70(Eq,RetType,Depth,Self,[AE|Adjusted],Res), - check_returnval(Eq,RetType,Res). - -must_eval_args(Eq,RetType,Depth,Self,More,Adjusted):- - (eval_args(Eq,RetType,Depth,Self,More,Adjusted)*->true; - (with_debug(eval,eval_args(Eq,RetType,Depth,Self,More,Adjusted))*-> true; - ( - nl,writeq(eval_args(Eq,RetType,Depth,Self,More,Adjusted)),writeln('.'), - (More=Adjusted -> true ; - (trace, throw(must_eval_args(Eq,RetType,Depth,Self,More,Adjusted))))))). - - - - -eval_70(Eq,RetType,Depth,Self,PredDecl,Res):- - Do_more_defs = do_more_defs(true), - clause(eval_80(Eq,RetType,Depth,Self,PredDecl,Res),Body), - Do_more_defs == do_more_defs(true), - call(Body),nb_setarg(1,Do_more_defs,false). - - -% ================================================================= -% ================================================================= -% ================================================================= -% inherited by system -% ================================================================= -% ================================================================= -% ================================================================= -is_system_pred(S):- atom(S),atom_concat(_,'!',S). - - - -eval_80(_Eq,_RetType,_Dpth,_Slf,LESS,Res):- - notrace((ground(LESS),once((eval_selfless(LESS,Res),mnotrace(LESS\==Res))))),!. - - -% predicate inherited by system -eval_80(Eq,RetType,_Depth,_Self,[AE|More],TF):- - is_system_pred(AE), - length(More,Len), - is_syspred(AE,Len,Pred), - %mnotrace( \+ is_user_defined_goal(Self,[AE|More])),!, - %adjust_args(Depth,Self,AE,More,Adjusted), - More = Adjusted, - catch_warn(efbug(show_call,eval_call(apply(Pred,Adjusted),TF))), - check_returnval(Eq,RetType,TF). - -:- if( \+ current_predicate( adjust_args / 2 )). - - :- discontiguous eval_80/6. - -is_user_defined_goal(Self,Head):- - is_user_defined_head(Self,Head). - -:- endif. - -eval_call(S,TF):- - s2p(S,P), !, - dmsg(eval_call(P,'$VAR'('TF'))),as_tf(P,TF). - -eval_80(Eq,RetType,_Depth,_Self,[AE|More],Res):- - is_system_pred(AE), - length([AE|More],Len), - is_syspred(AE,Len,Pred), - %mnotrace( \+ is_user_defined_goal(Self,[AE|More])),!, - %adjust_args(Depth,Self,AE,More,Adjusted),!, - More = Adjusted, - append(Adjusted,[Res],Args),!, - efbug(show_call,catch_warn(apply(Pred,Args))), - check_returnval(Eq,RetType,Res). - -:- if( \+ current_predicate( check_returnval / 3 )). -check_returnval(_,_RetType,_TF). -:- endif. - -:- if( \+ current_predicate( adjust_args / 5 )). -adjust_args(_Depth,_Self,_V,VI,VI). -:- endif. - -eval_80(Eq,RetType,Depth,Self,PredDecl,Res):- - eval_67(Eq,RetType,Depth,Self,PredDecl,Res). - - - -last_element(T,E):- \+ compound(T),!,E=T. -last_element(T,E):- is_list(T),last(T,L),last_element(L,E),!. -last_element(T,E):- compound_name_arguments(T,_,List),last_element(List,E),!. - - - - -catch_warn(G):- quietly(catch_err(G,E,(wdmsg(catch_warn(G)-->E),fail))). -catch_nowarn(G):- quietly(catch_err(G,error(_,_),fail)). - - -as_tf(G,TF):- G\=[_|_], catch_nowarn((call(G)*->TF='True';TF='False')). -%eval_selfless(['==',X,Y],TF):- as_tf(X=:=Y,TF),!. -%eval_selfless(['==',X,Y],TF):- as_tf(X=@=Y,TF),!. -eval_selfless(['>',X,Y],TF):-!,as_tf(X>Y,TF). -eval_selfless(['<',X,Y],TF):-!,as_tf(X',X,Y],TF):-!,as_tf(X>=Y,TF). -eval_selfless(['<=',X,Y],TF):-!,as_tf(X='). -is_special_op('let'). -is_special_op('let*'). -is_special_op('if'). -is_special_op('rtrace'). -is_special_op('or'). -is_special_op('and'). -is_special_op('not'). -is_special_op('match'). -is_special_op('call'). -is_special_op('let'). -is_special_op('nop'). -is_special_op('assertEqual'). -is_special_op('assertEqualToResult'). - -is_metta_builtin(Special):- is_special_op(Special). -is_metta_builtin('=='). -is_metta_builtin(F):- once(atom(F);var(F)), current_op(_,yfx,F). -is_metta_builtin('println!'). -is_metta_builtin('transfer!'). -is_metta_builtin('collapse'). -is_metta_builtin('superpose'). -is_metta_builtin('+'). -is_metta_builtin('-'). -is_metta_builtin('*'). -is_metta_builtin('/'). -is_metta_builtin('%'). -is_metta_builtin('=='). -is_metta_builtin('<'). -is_metta_builtin('>'). -is_metta_builtin('all'). -is_metta_builtin('import!'). -is_metta_builtin('pragma!'). - -*/ -% ================================================================= -% ================================================================= -% ================================================================= -% USER DEFINED FUNCTIONS -% ================================================================= -% ================================================================= -% ================================================================= - -call_ndet(Goal,DET):- call(Goal),deterministic(DET). - -eval_defn(Eq,RetType,Depth,Self,H,B):- - (eval_64(Eq,RetType,Depth,Self,H,B)*->true; - (fail,eval_67(Eq,RetType,Depth,Self,H,B))). - - -%eval_64(Eq,_RetType,_Dpth,Self,H,B):- Eq='=',!, metta_defn(Eq,Self,H,B). -eval_64(Eq,_RetType,_Dpth,Self,H,B):- - Eq='match', dcall(metta_atom(Self,H)),B=H. - - -eval_64(Eq,RetType,Depth,Self,[[H|Start]|T1],Y):- - mnotrace((is_user_defined_head_f(Self,H),is_list(Start))), - metta_defn(Eq,Self,[H|Start],Left), - [Left|T1] \=@= [[H|Start]|T1], - eval(Eq,RetType,Depth,Self,[Left|T1],Y). - -eval_64(Eq,_RetType,Depth,Self,[H|Args],B):- % no weird template matchers - % forall(metta_defn(Eq,Self,[H|Template],_), - % maplist(not_template_arg,Template)), - Eq='=', - (metta_defn(Eq,Self,[H|Args],B0)*->true;(fail,[H|Args]=B0)), - light_eval(Depth,Self,B0,B). - %(eval(Eq,RetType,Depth,Self,B,Y);metta_atom_iter(Depth,Self,Y)). -% Use the first template match -eval_64(Eq,_RetType,Depth,Self,[H|Args],B):- fail, - Eq='=', - (metta_defn(Eq,Self,[H|Template],B0),Args=Template), - light_eval(Depth,Self,B0,B). - - -light_eval(_Depth,_Self,B,B). - -not_template_arg(TArg):- var(TArg), !, \+ attvar(TArg). -not_template_arg(TArg):- atomic(TArg),!. -%not_template_arg(TArg):- is_list(TArg),!,fail. - - -% Has argument that is headed by the same function -eval_67(Eq,RetType,Depth,Self,[H1|Args],Res):- - mnotrace((append(Left,[[H2|H2Args]|Rest],Args), H2==H1)),!, - eval(Eq,RetType,Depth,Self,[H2|H2Args],ArgRes), - mnotrace((ArgRes\==[H2|H2Args], append(Left,[ArgRes|Rest],NewArgs))), - eval_defn(Eq,RetType,Depth,Self,[H1|NewArgs],Res). - -eval_67(Eq,RetType,Depth,Self,[[H|Start]|T1],Y):- - mnotrace((is_user_defined_head_f(Self,H),is_list(Start))), - metta_defn(Eq,Self,[H|Start],Left), - eval(Eq,RetType,Depth,Self,[Left|T1],Y). - -% Has subterm to eval -eval_67(Eq,RetType,Depth,Self,[F|PredDecl],Res):- fail, - Depth>1, - quietly(sub_sterm1(SSub,PredDecl)), - mnotrace((ground(SSub),SSub=[_|Sub], is_list(Sub),maplist(atomic,SSub))), - eval(Eq,RetType,Depth,Self,SSub,Repl), - mnotrace((SSub\=Repl,subst(PredDecl,SSub,Repl,Temp))), - eval_defn(Eq,RetType,Depth,Self,[F|Temp],Res). - -%eval_67(Eq,RetType,Depth,Self,X,Y):- (eval_68(Eq,RetType,Depth,Self,X,Y)*->true;metta_atom_iter(Depth,Self,[=,X,Y])). -/* -eval_67_fail(Depth,Self,PredDecl,Res):- fail, - ((term_variables(PredDecl,Vars), - (metta_atom(Self,PredDecl) *-> (Vars ==[]->Res='True';Vars=Res); - (eval(Eq,RetType,Depth,Self,PredDecl,Res),ignore(Vars ==[]->Res='True';Vars=Res))))), - PredDecl\=@=Res. -*/ - -%eval_68(Eq,RetType,_Dpth,Self,[H|_],_):- mnotrace( \+ is_user_defined_head_f(Self,H) ), !,fail. -%eval_68(Eq,RetType,_Dpth,Self,[H|T1],Y):- metta_defn(Eq,Self,[H|T1],Y). -%eval_68(Eq,RetType,_Dpth,Self,[H|T1],'True'):- metta_atom(Self,[H|T1]). -%eval_68(Eq,RetType,_Dpth,Self,CALL,Y):- fail,append(Left,[Y],CALL),metta_defn(Eq,Self,Left,Y). - - -%eval_6(Depth,Self,['ift',CR,Then],RO):- fail, !, %fail, % trace, -% metta_defn(Eq,Self,['ift',R,Then],Become),eval(Eq,RetType,Depth,Self,CR,R),eval(Eq,RetType,Depth,Self,Then,_True),eval(Eq,RetType,Depth,Self,Become,RO). - - -%not_compound(Term):- \+ is_list(Term),!. -%eval_40(Eq,RetType,Depth,Self,Term,Res):- maplist(not_compound,Term),!,eval_645(Depth,Self,Term,Res). - - -% function inherited by system -/* -eval_80(Eq,RetType,Depth,Self,[F|X],FY):- is_function(F), \+ is_special_op(F), is_list(X), - maplist(eval(Eq,ArgTypes,Depth,Self),X,Y),!, - eval_maybe_subst(Depth,Self,[F|Y],FY). - -eval_80(Eq,RetType,Depth,Self,FX,FY):- eval_maybe_subst(Depth,Self,FX,FY). - -eval_maybe_subst(Depth,Self,[AE|More],TF):- length(More,Len), - (is_syspred(AE,Len,Pred),catch_warn(as_tf(apply(Pred,More),TF)))*->true;eval_86(Depth,Self,[AE|More],TF). -eval_86(_Dpth,_Slf,[AE|More],TF):- length([AE|More],Len), is_syspred(AE,Len,Pred),append(More,[TF],Args),!,catch_warn(apply(Pred,Args)). -*/ -%eval_80(Eq,RetType,Depth,Self,[X1|[F2|X2]],[Y1|Y2]):- is_function(F2),!,eval(Eq,RetType,Depth,Self,[F2|X2],Y2),eval(Eq,RetType,Depth,Self,X1,Y1). - - -% ================================================================= -% ================================================================= -% ================================================================= -% AGREGATES -% ================================================================= -% ================================================================= -% ================================================================= - -cwdl(DL,Goal):- call_with_depth_limit(Goal,DL,R), (R==depth_limit_exceeded->(!,fail);true). - -%bagof_eval(Eq,RetType,Depth,Self,X,L):- bagof_eval(Eq,RetType,_RT,Depth,Self,X,L). - - -%bagof_eval(Eq,RetType,Depth,Self,X,S):- bagof(E,eval_ne(Eq,RetType,Depth,Self,X,E),S)*->true;S=[]. -bagof_eval(_Eq,_RetType,_Dpth,_Slf,X,L):- typed_list(X,_Type,L),!. -bagof_eval(Eq,RetType,Depth,Self,X,L):- - findall(E,eval_ne(Eq,RetType,Depth,Self,X,E),L). - -setof_eval(Depth,Self,X,L):- setof_eval('=',_RT,Depth,Self,X,L). -setof_eval(Eq,RetType,Depth,Self,X,S):- bagof_eval(Eq,RetType,Depth,Self,X,L), - sort(L,S). - - -eval_ne(Eq,RetType,Depth,Self,X,E):- - eval(Eq,RetType,Depth,Self,X,E), \+ var(E), \+ is_empty(E). - - - - -:- ensure_loaded(metta_subst). diff --git a/.Attic/metta_lang/metta_interp.new b/.Attic/metta_lang/metta_interp.new deleted file mode 100755 index b7c3898d074..00000000000 --- a/.Attic/metta_lang/metta_interp.new +++ /dev/null @@ -1,1921 +0,0 @@ -:- encoding(iso_latin_1). -:- multifile(is_metta_data_functor/1). -:- dynamic(is_metta_data_functor/1). -:- multifile(is_nb_space/1). -:- dynamic(is_nb_space/1). -%:- '$set_source_module'('user'). -:- set_stream(user_input,tty(true)). -:- use_module(library(readline)). -:- use_module(library(editline)). -:- use_module(library(filesex)). -:- use_module(library(shell)). -%:- use_module(library(tabling)). -:- use_module(library(system)). -:- ensure_loaded(metta_compiler). -%:- ensure_loaded(metta_types). -:- ensure_loaded(metta_data). -:- ensure_loaded(metta_space). -:- ensure_loaded(metta_eval). -:- set_stream(user_input,tty(true)). -:- set_prolog_flag(encoding,iso_latin_1). -:- set_prolog_flag(encoding,utf8). -%:- set_prolog_flag(encoding,octet). -/* -Now PASSING NARS.TEC:\opt\logicmoo_workspace\packs_sys\logicmoo_opencog\MeTTa\hyperon-wam\src\pyswip\metta_interp.pl -C:\opt\logicmoo_workspace\packs_sys\logicmoo_opencog\MeTTa\hyperon-wam\src\pyswip1\metta_interp.pl -STS1.01) -Now PASSING TEST-SCRIPTS.B5-TYPES-PRELIM.08) -Now PASSING TEST-SCRIPTS.B5-TYPES-PRELIM.14) -Now PASSING TEST-SCRIPTS.B5-TYPES-PRELIM.15) -Now PASSING TEST-SCRIPTS.C1-GROUNDED-BASIC.15) -Now PASSING TEST-SCRIPTS.E2-STATES.08) -PASSING TEST-SCRIPTS.B5-TYPES-PRELIM.02) -PASSING TEST-SCRIPTS.B5-TYPES-PRELIM.07) -PASSING TEST-SCRIPTS.B5-TYPES-PRELIM.09) -PASSING TEST-SCRIPTS.B5-TYPES-PRELIM.11) -PASSING TEST-SCRIPTS.C1-GROUNDED-BASIC.14) -PASSING TEST-SCRIPTS.E2-STATES.07) ------------------------------------------ -FAILING TEST-SCRIPTS.D5-AUTO-TYPES.01) -Now FAILING TEST-SCRIPTS.00-LANG-CASE.03) -Now FAILING TEST-SCRIPTS.B5-TYPES-PRELIM.19) -Now FAILING TEST-SCRIPTS.C1-GROUNDED-BASIC.20) - -*/ - - -option_value_def('repl',auto). -option_value_def('prolog',false). -option_value_def('compile',false). -option_value_def('table',false). -option_value_def(no_repeats,false). -option_value_def('time',true). -option_value_def('exec',true). -option_value_def('html',false). -option_value_def('python',false). -option_value_def('halt',false). -option_value_def('doing_repl',false). -option_value_def('test-retval',false). -option_value_def('trace-length',100). -option_value_def('stack-max',100). -option_value_def('trace-on-overtime',20.0). -option_value_def('trace-on-overflow',false). -option_value_def('trace-on-error',true). -option_value_def('trace-on-load',true). -option_value_def('trace-on-exec',true). -option_value_def('trace-on-eval',true). -option_value_def('trace-on-fail',false). -option_value_def('trace-on-pass',false). - - - - -set_is_unit_test(TF):- - set_option_value('trace-on-load',TF), - set_option_value('trace-on-exec',TF), - set_option_value('trace-on-eval',TF), - set_option_value('trace-on-pass',false), - set_option_value('trace-on-fail',false), - set_option_value('exec',rtrace), - set_option_value('eval',rtrace), - !. - -:- set_is_unit_test(true). -%:- set_is_unit_test. - -trace_on_fail:- option_value('trace-on-fail',true). -trace_on_overflow:- option_value('trace-on-overflow',true). -trace_on_pass:- option_value('trace-on-pass',true). -doing_repl:- option_value('doing_repl',true). -if_repl(Goal):- doing_repl->call(Goal);true. - -any_floats(S):- member(E,S),float(E),!. - -% ============================ -% %%%% Arithmetic Operations -% ============================ -%:- use_module(library(clpfd)). -:- use_module(library(clpq)). -%:- use_module(library(clpr)). - -% Addition -%'+'(Addend1, Addend2, Sum):- \+ any_floats([Addend1, Addend2, Sum]),!,Sum #= Addend1+Addend2 . -'+'(Addend1, Addend2, Sum):- notrace(catch_err(plus(Addend1, Addend2, Sum),_,fail)),!. -'+'(Addend1, Addend2, Sum):- {Sum = Addend1+Addend2}. -% Subtraction -'-'(Sum, Addend1, Addend2):- '+'(Addend1, Addend2, Sum). - -% Multiplication -'*'(Factor1, Factor2, Product):- {Product = Factor1*Factor2}. -% Division -'/'(Dividend, Divisor, Quotient):- {Dividend = Quotient * Divisor}. -% Modulus -'mod'(Dividend, Divisor, Remainder):- {Remainder = Dividend mod Divisor}. -% Exponentiation -'exp'(Base, Exponent, Result):- eval_H(['exp', Base, Exponent], Result). -% Square Root -'sqrt'(Number, Root):- eval_H(['sqrt', Number], Root). - -% ============================ -% %%%% List Operations -% ============================ -% Retrieve Head of the List -'car-atom'(List, Head):- eval_H(['car-atom', List], Head). -% Retrieve Tail of the List -'cdr-atom'(List, Tail):- eval_H(['cdr-atom', List], Tail). -% Construct a List -'Cons'(Element, List, 'Cons'(Element, List)):- !. -% Collapse List -'collapse'(List, CollapsedList):- eval_H(['collapse', List], CollapsedList). -% Count Elements in List -'CountElement'(List, Count):- eval_H(['CountElement', List], Count). -% Find Length of List -%'length'(List, Length):- eval_H(['length', List], Length). - -% ============================ -% %%%% Nondet Opteration -% ============================ -% Superpose a List -'superpose'(List, SuperposedList):- eval_H(['superpose', List], SuperposedList). - -% ============================ -% %%%% Testing -% ============================ - -% `assertEqual` Predicate -% This predicate is used for asserting that the Expected value is equal to the Actual value. -% Expected: The value that is expected. -% Actual: The value that is being checked against the Expected value. -% Result: The result of the evaluation of the equality. -% Example: `assertEqual(5, 5, Result).` would succeed, setting Result to true (or some success indicator). -%'assertEqual'(Expected, Actual, Result):- use_metta_compiler,!,as_tf((Expected=Actual),Result). -'assertEqual'(Expected, Actual, Result):- ignore(Expected=Actual), eval_H(['assertEqual', Expected, Actual], Result). - -% `assertEqualToResult` Predicate -% This predicate asserts that the Expected value is equal to the Result of evaluating Actual. -% Expected: The value that is expected. -% Actual: The expression whose evaluation is being checked against the Expected value. -% Result: The result of the evaluation of the equality. -% Example: If Actual evaluates to the Expected value, this would succeed, setting Result to true (or some success indicator). -'assertEqualToResult'(Expected, Actual, Result):- eval_H(['assertEqualToResult', Expected, Actual], Result). - -% `assertFalse` Predicate -% This predicate is used to assert that the evaluation of EvalThis is false. -% EvalThis: The expression that is being evaluated and checked for falsehood. -% Result: The result of the evaluation. -% Example: `assertFalse((1 > 2), Result).` would succeed, setting Result to true (or some success indicator), as 1 > 2 is false. -'assertFalse'(EvalThis, Result):- eval_H(['assertFalse', EvalThis], Result). - -% `assertNotEqual` Predicate -% This predicate asserts that the Expected value is not equal to the Actual value. -% Expected: The value that is expected not to match the Actual value. -% Actual: The value that is being checked against the Expected value. -% Result: The result of the evaluation of the inequality. -% Example: `assertNotEqual(5, 6, Result).` would succeed, setting Result to true (or some success indicator). -'assertNotEqual'(Expected, Actual, Result):- eval_H(['assertNotEqual', Expected, Actual], Result). - -% `assertTrue` Predicate -% This predicate is used to assert that the evaluation of EvalThis is true. -% EvalThis: The expression that is being evaluated and checked for truth. -% Result: The result of the evaluation. -% Example: `assertTrue((2 > 1), Result).` would succeed, setting Result to true (or some success indicator), as 2 > 1 is true. -'assertTrue'(EvalThis, Result):- eval_H(['assertTrue', EvalThis], Result). - -% `rtrace` Predicate -% This predicate is likely used for debugging; possibly for tracing the evaluation of Condition. -% Condition: The condition/expression being traced. -% EvalResult: The result of the evaluation of Condition. -% Example: `rtrace((2 + 2), EvalResult).` would trace the evaluation of 2 + 2 and store its result in EvalResult. -'rtrace'(Condition, EvalResult):- eval_H(['rtrace', Condition], EvalResult). - -% `time` Predicate -% This predicate is used to measure the time taken to evaluate EvalThis. -% EvalThis: The expression whose evaluation time is being measured. -% EvalResult: The result of the evaluation of EvalThis. -% Example: `time((factorial(5)), EvalResult).` would measure the time taken to evaluate factorial(5) and store its result in EvalResult. -'time'(EvalThis, EvalResult):- eval_H(['time', EvalThis], EvalResult). - -% ============================ -% %%%% Debugging, Printing and Utility Operations -% ============================ -% REPL Evaluation -'repl!'(EvalResult):- eval_H(['repl!'], EvalResult). -% Condition Evaluation -'!'(Condition, EvalResult):- eval_H(['!', Condition], EvalResult). -% Import File into Environment -'import!'(Environment, Filename, Namespace):- eval_H(['import!', Environment, Filename], Namespace). -% Evaluate Expression with Pragma -'pragma!'(Environment, Expression, EvalValue):- eval_H(['pragma!', Environment, Expression], EvalValue). -% Print Message to Console -'print'(Message, EvalResult):- eval_H(['print', Message], EvalResult). -% No Operation, Returns EvalResult unchanged -'nop'(Expression, EvalResult):- eval_H(['nop', Expression], EvalResult). - -% ============================ -% %%%% Variable Bindings -% ============================ -% Bind Variables -'bind!'(Environment, Variable, Value):- eval_H(['bind!', Environment, Variable], Value). -% Let binding for single variable -'let'(Variable, Expression, Body, Result):- eval_H(['let', Variable, Expression, Body], Result). -% Sequential let binding -'let*'(Bindings, Body, Result):- eval_H(['let*', Bindings, Body], Result). - -% ============================ -% %%%% Reflection -% ============================ -% Get Type of Value -'get-type'(Value, Type):- eval_H(['get-type', Value], Type). - - -metta_cmd_args(Rest):- current_prolog_flag(late_metta_opts,Rest),!. -metta_cmd_args(Rest):- current_prolog_flag(argv,P),append(_,['--'|Rest],P),!. -metta_cmd_args(Rest):- current_prolog_flag(os_argv,P),append(_,['--'|Rest],P),!. -metta_cmd_args(Rest):- current_prolog_flag(argv,Rest). -run_cmd_args:- metta_cmd_args(Rest), !, do_cmdline_load_metta('&self',Rest). - - -metta_make_hook:- loonit_reset, option_value(not_a_reload,true),!. -metta_make_hook:- - metta_cmd_args(Rest), into_reload_options(Rest,Reload), cmdline_load_metta('&self',Reload). - -:- multifile(prolog:make_hook/2). -:- dynamic(prolog:make_hook/2). -prolog:make_hook(after, _Some):- nop( metta_make_hook). - -into_reload_options(Reload,Reload). - -is_cmd_option(Opt,M, TF):- atom(M), - atom_concat('-',Opt,Flag), - atom_contains(M,Flag),!, - get_flag_value(M,FV), - TF=FV. - -get_flag_value(M,V):- atomic_list_concat([_,V],'=',M),!. -get_flag_value(M,false):- atom_contains(M,'-no'),!. -get_flag_value(_,true). - - -:- ignore((( - \+ prolog_load_context(reloading,true), - forall(option_value_def(Opt,Default),set_option_value(Opt,Default))))). - -%process_option_value_def:- \+ option_value('python',false), skip(ensure_loaded(metta_python)). -process_option_value_def:- option_value('python',load), ensure_loaded(src/main/metta_python). -process_option_value_def. - - -%process_late_opts:- once(option_value('html',true)), once(shell('./total_loonits.sh')). -process_late_opts:- current_prolog_flag(os_argv,[_]),!,ignore(repl). -process_late_opts:- forall(process_option_value_def,true). -%process_late_opts:- halt(7). -process_late_opts. - -%do_cmdline_load_metta(_Slf,Rest):- select('--prolog',Rest,RRest),!, -% set_option_value('prolog',true), -% set_prolog_flag(late_metta_opts,RRest). -do_cmdline_load_metta(Self,Rest):- - set_prolog_flag(late_metta_opts,Rest), - forall(process_option_value_def,true), - cmdline_load_metta(Self,Rest),!, - forall(process_late_opts,true). - -load_metta_file(Self,Filemask):- atom_concat(_,'.metta',Filemask),!, load_metta(Self,Filemask). -load_metta_file(_Slf,Filemask):- load_flybase(Filemask). - -% done -cmdline_load_metta(_,Nil):- Nil==[],!. -cmdline_load_metta(Self,[Filemask|Rest]):- atom(Filemask), \+ atom_concat('-',_,Filemask), - must_det_ll((Src=load_metta_file(Self,Filemask),nl,write('; '),write_src(Src),nl,catch_red(Src),!,flush_output, - cmdline_load_metta(Self,Rest))). - -cmdline_load_metta(Self,['-g',M|Rest]):- - read_term_from_atom(M, Term, []), - ignore(call(Term)), - cmdline_load_metta(Self,Rest). - -cmdline_load_metta(Self,[M|Rest]):- - m_opt(M,Opt),!, - is_cmd_option(Opt,M,TF),!, - format('~N'),write(' ; '), write_src(is_cmd_option(Opt,M,TF)), nl, !, set_option_value(Opt,TF), - set_tty_color_term(true), - cmdline_load_metta(Self,Rest). - -cmdline_load_metta(Self,[M|Rest]):- - format('~N'),write('; unused '), write_src(M), nl, !, - cmdline_load_metta(Self,Rest). - - -set_tty_color_term(TF):- - current_output(X),set_stream(X,tty(TF)), - set_stream(current_output,tty(TF)), - set_prolog_flag(color_term ,TF). - -m_opt(M,Opt):- - m_opt0(M,Opt1), - m_opt1(Opt1,Opt). - -m_opt1(Opt1,Opt):- atomic_list_concat([Opt|_],'=',Opt1). - -m_opt0(M,Opt):- atom_concat('--no-',Opt,M),!. -m_opt0(M,Opt):- atom_concat('--',Opt,M),!. -m_opt0(M,Opt):- atom_concat('-',Opt,M),!. - -:- set_prolog_flag(occurs_check,true). - -start_html_of(_Filename):- \+ tee_file(_TEE_FILE),!. -start_html_of(_Filename):- - must_det_ll(( - S = _, - %retractall(metta_defn(Eq,S,_,_)), - nop(retractall(metta_type(S,_,_))), - %retractall(get_metta_atom(Eq,S,_,_,_)), - loonit_reset, - tee_file(TEE_FILE), - sformat(S,'cat /dev/null > "~w"',[TEE_FILE]), - - writeln(doing(S)), - ignore(shell(S)))). - -save_html_of(_Filename):- \+ tee_file(_TEE_FILE),!. -save_html_of(_):- \+ has_loonit_results, \+ option_value('html',true). -save_html_of(Filename):- - must_det_ll(( - file_name_extension(Base,_,Filename), - file_name_extension(Base,'metta.html',HtmlFilename), - loonit_reset, - tee_file(TEE_FILE), - writeln('
Return to Summaries
'), - sformat(S,'ansi2html -u < "~w" > "~w" ',[TEE_FILE,HtmlFilename]), - writeln(doing(S)), - ignore(shell(S)))). - -tee_file(TEE_FILE):- getenv('TEE_FILE',TEE_FILE),!. -tee_file(TEE_FILE):- metta_dir(Dir),directory_file_path(Dir,'TEE.ansi',TEE_FILE),!. -metta_dir(Dir):- getenv('METTA_DIR',Dir),!. - -load_metta(Filename):- - %clear_spaces, - load_metta('&self',Filename). - - -load_metta(_Self,Filename):- Filename=='--repl',!,repl. -load_metta(Self,Filename):- - (\+ atom(Filename); \+ exists_file(Filename)),!, - with_wild_path(load_metta(Self),Filename),!,loonit_report. -load_metta(Self,RelFilename):- - atom(RelFilename), - exists_file(RelFilename),!, - absolute_file_name(RelFilename,Filename), - track_load_into_file(Filename, - include_metta(Self,RelFilename)). - -include_metta(Self,Filename):- - (\+ atom(Filename); \+ exists_file(Filename)),!, - must_det_ll(with_wild_path(include_metta(Self),Filename)),!. - -include_metta(Self,RelFilename):- - must_det_ll(( - atom(RelFilename), - exists_file(RelFilename),!, - absolute_file_name(RelFilename,Filename), - must_det_ll((setup_call_cleanup(open(Filename,read,In, [encoding(utf8)]), - ((directory_file_path(Directory, _, Filename), - assert(metta_file(Self,Filename,Directory)), - with_cwd(Directory, - must_det_ll( load_metta_file_stream(Filename,Self,In))))),close(In)))))). - -load_metta_file_stream(Filename,Self,In):- - with_option(loading_file,Filename, - %current_exec_file(Filename), - ((must_det_ll(( - set_exec_num(Filename,1), - load_answer_file(Filename), - set_exec_num(Filename,0))), - once((repeat, (( - ((nb_current(read_mode,Mode),Mode\==[])->true;Mode=load), - once(read_metta(In,Expr)), %write_src(read_metta=Expr),nl, - must_det_ll((do_metta(file(Filename),Mode,Self,Expr,_O)->true; - pp_m(unknown_do_metta(file(Filename),Mode,Self,Expr)))), - flush_output)), - at_end_of_stream(In)))))),!. - - -clear_spaces:- clear_space(_). -clear_space(S):- - %retractall(metta_defn(_,S,_,_)), - nop(retractall(metta_type(S,_,_))), - retractall(metta_atom_asserted(S,_)). - - -lsm:- lsm(_). -lsm(S):- - listing(metta_file(S,_,_)), - %listing(mdyn_type(S,_,_,_)), - forall(mdyn_type(S,_,_,Src),color_g_mesg('#22a5ff',write_f_src(Src))), - nl,nl,nl, - forall(mdyn_defn(S,_,_,Src),color_g_mesg('#00ffa5',write_f_src(Src))), - %listing(mdyn_defn(S,_,_,_)), - !. - -write_f_src(H,B):- H=@=B,!,write_f_src(H). -write_f_src(H,B):- write_f_src(['=',H,B]). - -hb_f(HB,ST):- sub_term(ST,HB),(atom(ST),ST\==(=),ST\==(:)),!. -write_f_src(HB):- - hb_f(HB,ST), - option_else(current_def,CST,[]),!, - (CST == ST -> true ; (nl,nl,nl,set_option_value(current_def,ST))), - write_src(HB). - - - -debug_only(G):- notrace(ignore(catch_warn(G))). -debug_only(_What,G):- ignore((fail,notrace(catch_warn(G)))). - - -'True':- true. -'False':- fail. - - -'mettalog::vspace-main':- repl. - -into_underscores(D,U):- atom(D),!,atomic_list_concat(L,'-',D),atomic_list_concat(L,'_',U). -into_underscores(D,U):- descend_and_transform(into_underscores,D,U),!. - -into_hyphens(D,U):- atom(D),!,atomic_list_concat(L,'_',D),atomic_list_concat(L,'-',U). -into_hyphens(D,U):- descend_and_transform(into_hyphens,D,U),!. - -descend_and_transform(P2, Input, Transformed) :- - ( var(Input) - -> Transformed = Input % Keep variables as they are - ; compound(Input) - -> (compound_name_arguments(Input, Functor, Args), - maplist(descend_and_transform(P2), Args, TransformedArgs), - compound_name_arguments(Transformed, Functor, TransformedArgs)) - ; (atom(Input),call(P2,Input,Transformed)) - -> true % Transform atoms using xform_atom/2 - ; Transformed = Input % Keep other non-compound terms as they are - ). - -/* -is_syspred(H,Len,Pred):- notrace(is_syspred0(H,Len,Pred)). -is_syspred0(H,_Ln,_Prd):- \+ atom(H),!,fail. -is_syspred0(H,_Ln,_Prd):- upcase_atom(H,U),downcase_atom(H,U),!,fail. -is_syspred0(H,Len,Pred):- current_predicate(H/Len),!,Pred=H. -is_syspred0(H,Len,Pred):- atom_concat(Mid,'!',H), H\==Mid, is_syspred0(Mid,Len,Pred),!. -is_syspred0(H,Len,Pred):- into_underscores(H,Mid), H\==Mid, is_syspred0(Mid,Len,Pred),!. - -fn_append(List,X,Call):- - fn_append1(List,X,ListX), - into_fp(ListX,Call). - - - - - -is_metta_data_functor(Eq,F):- - current_self(Self),is_metta_data_functor(Eq,Self,F). - -is_metta_data_functor(Eq,Other,H):- - metta_type(Other,H,_), - \+ get_metta_atom(Eq,Other,[H|_]), - \+ metta_defn(Eq,Other,[H|_],_). -*/ -is_function(F):- atom(F). - -is_False(X):- X\=='True', (is_False1(X)-> true ; (eval_H(X,Y),is_False1(Y))). -is_False1(Y):- (Y==0;Y==[];Y=='False'). - -is_conz(Self):- compound(Self), Self=[_|_]. - -%dont_x(eval_H(Depth,Self,metta_if(A=1,atom_concat(metta_,_,F). -needs_expanded(eval_H(Term,_),Expand):- !,sub_term(Expand,Term),compound(Expand),Expand\=@=Term, - compound(Expand), \+ is_conz(Expand), \+ is_ftVar(Expand), needs_expand(Expand). -needs_expanded([A|B],Expand):- sub_term(Expand,[A|B]), compound(Expand), \+ is_conz(Expand), \+ is_ftVar(Expand), needs_expand(Expand). - -fn_append1(eval_H(Term,X),X,eval_H(Term,X)):-!. -fn_append1(Term,X,eval_H(Term,X)). - - -% Check if parentheses are balanced in a list of characters -balanced_parentheses(Chars) :- balanced_parentheses(Chars, 0). -balanced_parentheses([], 0). -balanced_parentheses(['('|T], N) :- N1 is N + 1, balanced_parentheses(T, N1). -balanced_parentheses([')'|T], N) :- N > 0, N1 is N - 1, balanced_parentheses(T, N1). -balanced_parentheses([H|T], N) :- H \= '(', H \= ')', balanced_parentheses(T, N). -% Recursive function to read lines until parentheses are balanced. -repl_read(NewAccumulated, Expr):- - atom_concat(Atom, '.', NewAccumulated), - catch_err((read_term_from_atom(Atom, Term, []), Expr=call(Term)), E, - (write('Syntax error: '), writeq(E), nl, repl_read(Expr))),!. - - -repl_read("!", '!'):-!. -repl_read("+", '+'):-!. -repl_read(Str,Atom):- atom_string(Atom,Str),metta_interp_mode(Atom,_),!. - -repl_read(Str, Expr):- atom_concat('@',_,Str),!,atom_string(Expr,Str). -repl_read(NewAccumulated, Expr):- - normalize_space(string(Renew),NewAccumulated), Renew \== NewAccumulated, !, - repl_read(Renew, Expr). -%repl_read(NewAccumulated,exec(Expr)):- string_concat("!",Renew,NewAccumulated), !, repl_read(Renew, Expr). -repl_read(NewAccumulated, Expr):- string_chars(NewAccumulated, Chars), - balanced_parentheses(Chars), length(Chars, Len), Len > 0, - parse_sexpr_metta(NewAccumulated, Expr), !, - normalize_space(string(Renew),NewAccumulated), - add_history_string(Renew). -repl_read(Accumulated, Expr) :- read_line_to_string(current_input, Line), repl_read(Accumulated, Line, Expr). -repl_read(Accumulated, "", Expr):- !, repl_read(Accumulated, Expr). -repl_read(_Accumulated, Line, Expr):- Line == end_of_file, !, Expr = Line. -repl_read(Accumulated, Line, Expr) :- atomics_to_string([Accumulated," ",Line], NewAccumulated), !, - repl_read(NewAccumulated, Expr). - -repl_read(O2):- clause(t_l:s_reader_info(O2),_,Ref),erase(Ref). -repl_read(Expr) :- repeat, - remove_pending_buffer_codes(_,Was),text_to_string(Was,Str), - repl_read(Str, Expr1), - once(((atom(Expr1),atom_concat('@',_,Expr1), - \+ atom_contains(Expr1,"="), - repl_read(Expr2)) - -> Expr=[Expr1,Expr2] ; Expr1 = Expr)), - % this cutrs the repeat/0 - ((peek_pending_codes(_,Peek),Peek==[])->!;true). - -add_history_string(Str):- notrace(ignore(add_history01(Str))),!. - -add_history_src(Exec):- notrace(ignore((Exec\=[],with_output_to(string(H),with_indents(false,write_src(Exec))),add_history_string(H)))). - - -add_history_pl(Exec):- notrace(ignore((Exec\=[],with_output_to(string(H),with_indents(false,(writeq(Exec),writeln('.')))),add_history_string(H)))). - -read_metta1(_,O2):- clause(t_l:s_reader_info(O2),_,Ref),erase(Ref). -read_metta1(In,Expr):- current_input(In0),In==In0,!, repl_read(Expr). -read_metta1(In,Expr):- string(In),!,parse_sexpr_metta(In,Expr),!. -read_metta1(In,Expr):- peek_char(In,Char), read_metta1(In,Char,Expr). - -read_metta1(In,Char,Expr):- char_type(Char,white),get_char(In,Char),put(Char),!,read_metta1(In,Expr). -read_metta1(In,'!',Expr):- get_char(In,_), !, read_metta(In,Read1),!,Expr=exec(Read1). -read_metta1(In,';',Expr):- get_char(In,_), !, (maybe_read_pl(In,Expr)-> true ; (read_line_to_string(In,Str),write_comment(Str),!,read_metta(In,Expr))),!. -read_metta1(In,_,Expr):- maybe_read_pl(In,Expr),!. -read_metta1(In,_,Read1):- parse_sexpr_metta(In,Expr),!,must_det_ll(Expr=Read1). - - -maybe_read_pl(In,Expr):- - peek_line(In,Line1), Line1\=='', atom_contains(Line1, '.'),atom_contains(Line1, ':-'), - notrace(((catch_err((read_term_from_atom(Line1, Term, []), Term\==end_of_file, Expr=call(Term)),_, fail),!, - read_term(In, Term, [])))). -peek_line(In,Line1):- peek_string(In, 1024, Str), split_string(Str, "\r\n", "\s", [Line1,_|_]),!. -peek_line(In,Line1):- peek_string(In, 4096, Str), split_string(Str, "\r\n", "\s", [Line1,_|_]),!. - - - - -%read_line_to_sexpr(Stream,UnTyped), -read_sform(Str,F):- trace, string(Str),open_string(Str,S),!,read_sform(S,F). -read_sform(S,F):- - read_sform1(S,F1), - ( F1\=='!' -> F=F1 ; - (read_sform1(S,F2), F = exec(F2))). - -read_sform1(Str,F):- string(Str),open_string(Str,S),!,read_sform1(S,F). -read_sform1(S,F):- at_end_of_stream(S),!,F=end_of_file. -read_sform1(S,M):- peek_char(S,C),read_sform3(C,S,F), untyped_to_metta(F,M). -%read_sform1(S,F):- profile(parse_sexpr_metta(S,F)). - -read_sform3(C,S,F):- char_type(C,white),get_char(S,_),!,read_sform1(S,F). -read_sform3(';',S,'$COMMENT'(F,0,0)):- !, read_line_to_string(S,F). -read_sform3(';',S,F):- read_line_to_string(S,_),!,read_sform1(S,F). -read_sform3('!',S,exec(F)):- !,get_char(S,_),read_sform1(S,F). -read_sform3(_,S,F):- read_line_to_string(S,L),!,read_sform_cont(L,S,F). - -read_sform_cont(L,S,F):- L=="", !, read_sform1(S,F). -read_sform_cont(L,_S,F):- input_to_forms(L,F),!. -read_sform_cont(L,S,F):- read_line_to_string(S,L2), - atomic_to_string([L,' ',L2],L3),read_sform_cont(L3,S,F),!. - -in2_stream(N1,S1):- integer(N1),!,stream_property(S1,file_no(N1)),!. -in2_stream(N1,S1):- atom(N1),stream_property(S1,alias(N1)),!. -in2_stream(N1,S1):- is_stream(N1),S1=N1,!. -in2_stream(N1,S1):- atom(N1),stream_property(S1,file_name(N1)),!. -is_same_streams(N1,N2):- in2_stream(N1,S1),in2_stream(N2,S2),!,S1==S2. - -%read_metta(In,Expr):- current_input(CI), \+ is_same_streams(CI,In), !, read_sform(In,Expr). -read_metta(_,O2):- clause(t_l:s_reader_info(O2),_,Ref),erase(Ref). -read_metta(In,Expr):- current_input(In0),In==In0,!, repl_read(Expr). -read_metta(In,Expr):- - read_metta1(In,Read1), - (Read1=='!' - -> (read_metta1(In,Read2), Expr=exec(Read2), nop(add_history_src(Expr))) - ; Expr = Read1),!. - -parse_sexpr_metta(I,O):- string(I),normalize_space(string(M),I),parse_sexpr_metta1(M,O),!. -parse_sexpr_metta(I,O):- parse_sexpr_untyped(I,U),trly(untyped_to_metta,U,O). - -parse_sexpr_metta1(M,exec(O)):- string_concat('!',I,M),!,parse_sexpr_metta1(I,O). -parse_sexpr_metta1(M,(O)):- string_concat('+',I,M),!,parse_sexpr_metta1(I,O). -parse_sexpr_metta1(I,O):- parse_sexpr_untyped(I,U),trly(untyped_to_metta,U,O). - - -write_comment(_):- silent_loading,!. -write_comment(Cmt):- connlf,format(';;~w~n',[Cmt]). -do_metta_cmt(_,'$COMMENT'(Cmt,_,_)):- write_comment(Cmt),!. -do_metta_cmt(_,'$STRING'(Cmt)):- write_comment(Cmt),!. -do_metta_cmt(Self,[Cmt]):- !, do_metta_cmt(Self, Cmt),!. - - -mlog_sym('@'). - -%untyped_to_metta(I,exec(O)):- compound(I),I=exec(M),!,untyped_to_metta(M,O). -untyped_to_metta(I,O):- - must_det_ll(( - trly(mfix_vars1,I,M), - trly(cons_to_c,M,OM), - trly(cons_to_l,OM,O))). - - -trly(P2,A,B):- once(call(P2,A,M)),A\=@=M,!,trly(P2,M,B). -trly(_,A,A). - -mfix_vars1(I,O):- var(I),!,I=O. -mfix_vars1('$t','$VAR'('T')):-!. -mfix_vars1('$T','$VAR'('T')):-!. -%mfix_vars1(I,O):- I=='T',!,O='True'. -%mfix_vars1(I,O):- I=='F',!,O='False'. -%mfix_vars1(I,O):- is_i_nil(I),!,O=[]. -mfix_vars1(I,O):- I=='true',!,O='True'. -mfix_vars1(I,O):- I=='false',!,O='False'. -mfix_vars1('$STRING'(I),O):- option_value(strings,true),!, mfix_vars1(I,O). -mfix_vars1('$STRING'(I),O):- !, mfix_vars1(I,M),atom_chars(O,M),!. -%mfix_vars1('$STRING'(I),O):- !, mfix_vars1(I,M),name(O,M),!. -mfix_vars1([H|T],O):- H=='[', is_list(T), last(T,L),L==']',append(List,[L],T), !, O = ['[...]',List]. -mfix_vars1([H|T],O):- H=='{', is_list(T), last(T,L),L=='}',append(List,[L],T), !, O = ['{...}',List]. -mfix_vars1('$OBJ'(claz_bracket_vector,List),O):- is_list(List),!, O = ['[...]',List]. -mfix_vars1(I,O):- I = ['[', X, ']'], nonvar(X), !, O = ['[...]',X]. -mfix_vars1(I,O):- I = ['{', X, '}'], nonvar(X), !, O = ['{...}',X]. -mfix_vars1('$OBJ'(claz_bracket_vector,List),Res):- is_list(List),!, append(['['|List],[']'],Res),!. -mfix_vars1(I,O):- I==[Quote, S], Quote==quote,S==s,!, O=is. -mfix_vars1([K,H|T],Cmpd):- atom(K),mlog_sym(K),is_list(T),mfix_vars1([H|T],[HH|TT]),atom(HH),is_list(TT),!, - compound_name_arguments(Cmpd,HH,TT). -%mfix_vars1([H|T],[HH|TT]):- !, mfix_vars1(H,HH),mfix_vars1(T,TT). -mfix_vars1(List,ListO):- is_list(List),!,maplist(mfix_vars1,List,ListO). -mfix_vars1(I,O):- string(I),option_value('string-are-atoms',true),!,atom_string(O,I). - -mfix_vars1(I,O):- compound(I),!,compound_name_arguments(I,F,II),F\=='$VAR',maplist(mfix_vars1,II,OO),!,compound_name_arguments(O,F,OO). -mfix_vars1(I,O):- \+ atom(I),!,I=O. -mfix_vars1(I,'$VAR'(O)):- atom_concat('$',N,I),dvar_name(N,O),!. -mfix_vars1(I,I). - -no_cons_reduce. - -dvar_name(t,'T'):- !. -dvar_name(N,O):- atom(N),atom_number(N,Num),atom_concat('Num',Num,M),!,svar_fixvarname(M,O). -dvar_name(N,O):- number(N),atom_concat('Num',N,M),!,svar_fixvarname(M,O). -dvar_name(N,O):- \+ atom(N),!,format(atom(A),'~w',[N]),dvar_name(A,O). -dvar_name('','__'):-!. % "$" -dvar_name('_','_'):-!. % "$_" -dvar_name(N,O):- svar_fixvarname(N,O),!. -dvar_name(N,O):- must_det_ll((atom_chars(N,Lst),maplist(c2vn,Lst,NList),atomic_list_concat(NList,S),svar_fixvarname(S,O))),!. -c2vn(A,A):- char_type(A,prolog_identifier_continue),!. -c2vn(A,A):- char_type(A,prolog_var_start),!. -c2vn(A,AA):- char_code(A,C),atomic_list_concat(['_C',C,'_'],AA). - -cons_to_l(I,I):- no_cons_reduce,!. -cons_to_l(I,O):- var(I),!,O=I. -cons_to_l(I,O):- is_i_nil(I),!,O=[]. -cons_to_l(I,O):- I=='nil',!,O=[]. -cons_to_l(C,O):- \+ compound(C),!,O=C. -cons_to_l([Cons,H,T|List],[HH|TT]):- List==[], atom(Cons),is_cons_f(Cons), t_is_ttable(T), cons_to_l(H,HH),!,cons_to_l(T,TT). -cons_to_l(List,ListO):- is_list(List),!,maplist(cons_to_l,List,ListO). -cons_to_l(I,I). - -cons_to_c(I,I):- no_cons_reduce,!. -cons_to_c(I,O):- var(I),!,O=I. -cons_to_c(I,O):- is_i_nil(I),!,O=[]. -cons_to_c(I,O):- I=='nil',!,O=[]. -cons_to_c(C,O):- \+ compound(C),!,O=C. -cons_to_c([Cons,H,T|List],[HH|TT]):- List==[], atom(Cons),is_cons_f(Cons), t_is_ttable(T), cons_to_c(H,HH),!,cons_to_c(T,TT). -cons_to_c(I,O):- \+ is_list(I), compound_name_arguments(I,F,II),maplist(cons_to_c,II,OO),!,compound_name_arguments(O,F,OO). -cons_to_c(I,I). - - - -t_is_ttable(T):- var(T),!. -t_is_ttable(T):- is_i_nil(T),!. -t_is_ttable(T):- is_ftVar(T),!. -t_is_ttable([F|Args]):- F=='Cons',!,is_list(Args). -t_is_ttable([_|Args]):- !, \+ is_list(Args). -t_is_ttable(_). - -is_cons_f(Cons):- is_cf_nil(Cons,_). -is_cf_nil('Cons','NNNil'). -%is_cf_nil('::','nil'). - -is_i_nil(I):- - is_cf_nil('Cons',Nil), I == Nil. - -subst_vars(TermWDV, NewTerm):- - subst_vars(TermWDV, NewTerm, NamedVarsList), - maybe_set_var_names(NamedVarsList). - -subst_vars(TermWDV, NewTerm, NamedVarsList) :- - subst_vars(TermWDV, NewTerm, [], NamedVarsList). - -subst_vars(Term, Term, NamedVarsList, NamedVarsList) :- var(Term), !. -subst_vars([], [], NamedVarsList, NamedVarsList):- !. -subst_vars([TermWDV|RestWDV], [Term|Rest], Acc, NamedVarsList) :- !, - subst_vars(TermWDV, Term, Acc, IntermediateNamedVarsList), - subst_vars(RestWDV, Rest, IntermediateNamedVarsList, NamedVarsList). -subst_vars('$VAR'('_'), _, NamedVarsList, NamedVarsList) :- !. -subst_vars('$VAR'(VName), Var, Acc, NamedVarsList) :- nonvar(VName), svar_fixvarname(VName,Name), !, - (memberchk(Name=Var, Acc) -> NamedVarsList = Acc ; ( !, Var = _, NamedVarsList = [Name=Var|Acc])). -subst_vars(Term, Var, Acc, NamedVarsList) :- atom(Term),atom_concat('$',DName,Term), - dvar_name(DName,Name),!,subst_vars('$VAR'(Name), Var, Acc, NamedVarsList). - -subst_vars(TermWDV, NewTerm, Acc, NamedVarsList) :- - compound(TermWDV), !, - compound_name_arguments(TermWDV, Functor, ArgsWDV), - subst_vars(ArgsWDV, Args, Acc, NamedVarsList), - compound_name_arguments(NewTerm, Functor, Args). -subst_vars(Term, Term, NamedVarsList, NamedVarsList). - - - -:- nb_setval(variable_names,[]). - - -assert_preds(_Self,_Load,_Preds):- \+ preview_compiler,!. -assert_preds(_Self,Load,Preds):- - expand_to_hb(Preds,H,_B),functor(H,F,A), - color_g_mesg('#005288',( - ignore(( - \+ predicate_property(H,defined), - if_t(use_metta_compiler,catch_i(dynamic(F,A))), - format(' :- ~q.~n',[dynamic(F/A)]), - if_t(option_value('tabling',true), format(' :- ~q.~n',[table(F/A)])))), - if_t((preview_compiler), - format('~N~n ~@',[portray_clause(Preds)])), - if_t(use_metta_compiler,if_t(\+ predicate_property(H,static),add_assertion(Preds))))), - nop(metta_anew1(Load,Preds)). - - -%load_hook(_Load,_Hooked):- !. -load_hook(Load,Hooked):- ignore(( \+ ((forall(load_hook0(Load,Hooked),true))))),!. - -load_hook0(_,_):- \+ current_prolog_flag(metta_interp,ready),!. -load_hook0(_,_):- \+ preview_compiler,!. -load_hook0(Load,metta_defn(=,Self,H,B)):- - functs_to_preds([=,H,B],Preds), - assert_preds(Self,Load,Preds). -/* -load_hook0(Load,get_metta_atom(Eq,Self,H)):- B = 'True', - H\=[':'|_], functs_to_preds([=,H,B],Preds), - assert_preds(Self,Load,Preds). -*/ - -use_metta_compiler:- notrace(option_value('compile','full')), !. -preview_compiler:- \+ option_value('compile',false), !. -%preview_compiler:- use_metta_compiler,!. - - - -op_decl(match, [ 'Space', 'Atom', 'Atom'], '%Undefined%'). -op_decl('remove-atom', [ 'Space', 'Atom'], 'EmptyType'). -op_decl('add-atom', [ 'Space', 'Atom'], 'EmptyType'). -op_decl('get-atoms', [ 'Space' ], 'Atom'). - -op_decl('car-atom', [ 'Expression' ], 'Atom'). -op_decl('cdr-atom', [ 'Expression' ], 'Expression'). - -op_decl(let, [ 'Atom', '%Undefined%', 'Atom' ], 'Atom'). -op_decl('let*', [ 'Expression', 'Atom' ], 'Atom'). - -op_decl(and, [ 'Bool', 'Bool' ], 'Bool'). -op_decl(or, [ 'Bool', 'Bool' ], 'Bool'). -op_decl(case, [ 'Expression', 'Atom' ], 'Atom'). -/* -op_decl(apply, [ 'Atom', 'Variable', 'Atom' ], 'Atom'). -op_decl(chain, [ 'Atom', 'Variable', 'Atom' ], 'Atom'). -op_decl('filter-atom', [ 'Expression', 'Variable', 'Atom' ], 'Expression'). -op_decl('foldl-atom', [ 'Expression', 'Atom', 'Variable', 'Variable', 'Atom' ], 'Atom'). -op_decl('map-atom', [ 'Expression', 'Variable', 'Atom' ], 'Expression'). -op_decl(quote, [ 'Atom' ], 'Atom'). -op_decl('if-decons', [ 'Atom', 'Variable', 'Variable', 'Atom', 'Atom' ], 'Atom'). -op_decl('if-empty', [ 'Atom', 'Atom', 'Atom' ], 'Atom'). -op_decl('if-error', [ 'Atom', 'Atom', 'Atom' ], 'Atom'). -op_decl('if-non-empty-expression', [ 'Atom', 'Atom', 'Atom' ], 'Atom'). -op_decl('if-not-reducible', [ 'Atom', 'Atom', 'Atom' ], 'Atom'). -op_decl(return, [ 'Atom' ], 'ReturnType'). -op_decl('return-on-error', [ 'Atom', 'Atom'], 'Atom'). -op_decl(unquote, [ '%Undefined%'], '%Undefined%'). -op_decl(cons, [ 'Atom', 'Atom' ], 'Atom'). -op_decl(decons, [ 'Atom' ], 'Atom'). -op_decl(empty, [], '%Undefined%'). -op_decl('Error', [ 'Atom', 'Atom' ], 'ErrorType'). -op_decl(eval, [ 'Atom' ], 'Atom'). -op_decl(function, [ 'Atom' ], 'Atom'). -op_decl(id, [ 'Atom' ], 'Atom'). -op_decl(unify, [ 'Atom', 'Atom', 'Atom', 'Atom' ], 'Atom'). -*/ -op_decl(unify, [ 'Atom', 'Atom', 'Atom', 'Atom'], '%Undefined%'). -op_decl(if, [ 'Bool', 'Atom', 'Atom'], _T). -op_decl('%', [ 'Number', 'Number' ], 'Number'). -op_decl('*', [ 'Number', 'Number' ], 'Number'). -op_decl('-', [ 'Number', 'Number' ], 'Number'). -op_decl('+', [ 'Number', 'Number' ], 'Number'). -op_decl(combine, [ X, X], X). - -op_decl('bind!', ['Symbol','%Undefined%'], 'EmptyType'). -op_decl('import!', ['Space','Atom'], 'EmptyType'). -op_decl('get-type', ['Atom'], 'Atom'). - -type_decl('Any'). -type_decl('Atom'). -type_decl('Bool'). -type_decl('ErrorType'). -type_decl('Expression'). -type_decl('Number'). -type_decl('ReturnType'). -type_decl('Space'). -type_decl('Symbol'). -type_decl('MemoizedState'). -type_decl('Type'). -type_decl('%Undefined%'). -type_decl('Variable'). - -:- dynamic(get_metta_atom/2). -:- dynamic(metta_atom_asserted/2). -metta_atom_stdlib([:, Type, 'Type']):- type_decl(Type). -metta_atom_stdlib([:, Op, [->|List]]):- op_decl(Op,Params,ReturnType),append(Params,[ReturnType],List). - -%get_metta_atom(Eq,KB, [F|List]):- KB='&flybase',fb_pred(F, Len), length(List,Len),apply(F,List). - - -get_metta_atom(Eq,Space, Atom):- get_metta_atom_from(Space, Atom), \+ (Atom =[EQ,_,_], EQ==Eq). - -get_metta_atom_from(KB, [F, A| List]):- KB='&flybase',fb_pred(F, Len), length([A|List],Len),apply(F,[A|List]). -get_metta_atom_from([Superpose,ListOf], Atom):- Superpose == 'superpose',is_list(ListOf),!,member(KB,ListOf),get_metta_atom_from(KB,Atom). -get_metta_atom_from(Space, Atom):- typed_list(Space,_,L),!, member(Atom,L). -get_metta_atom_from(KB,Atom):- (KB=='&self'; KB='&stdlib'), metta_atom_stdlib(Atom). -get_metta_atom_from(KB,Atom):- if_or_else(metta_atom_asserted( KB,Atom),metta_atom_asserted_fallback( KB,Atom)). - -metta_atom_asserted_fallback( KB,Atom):- fail, is_list(KB),!, member(Atom,KB). -%metta_atom_asserted_fallback( KB,Atom):- get_metta_atom_from(KB,Atom) - -%metta_atom(KB,[F,A|List]):- metta_atom(KB,F,A,List), F \== '=',!. -metta_defn(Eq,KB,Head,Body):- ignore(Eq = '='), get_metta_atom_from(KB,[Eq,Head,Body]). -metta_type(S,H,B):- get_metta_atom_from(S,[':',H,B]). -%typed_list(Cmpd,Type,List):- compound(Cmpd), Cmpd\=[_|_], compound_name_arguments(Cmpd,Type,[List|_]),is_list(List). - - -%maybe_xform(metta_atom(KB,[F,A|List]),metta_atom(KB,F,A,List)):- is_list(List),!. -maybe_xform(metta_defn(Eq,KB,Head,Body),metta_atom(KB,[Eq,Head,Body])). -maybe_xform(metta_type(KB,Head,Body),metta_atom(KB,[':',Head,Body])). -maybe_xform(metta_atom(KB,HeadBody),metta_atom_asserted(KB,HeadBody)). -maybe_xform(_OBO,_XForm):- !, fail. - -metta_anew1(Load,_OBO):- var(Load),trace,!. -metta_anew1(Load,OBO):- maybe_xform(OBO,XForm),!,metta_anew1(Load,XForm). - -metta_anew1(Ch,OBO):- metta_interp_mode(Ch,Mode), !, metta_anew1(Mode,OBO). -metta_anew1(load,OBO):- OBO= metta_atom(Space,Atom),!,'add-atom'(Space, Atom). -metta_anew1(unload,OBO):- OBO= metta_atom(Space,Atom),!,'remove-atom'(Space, Atom). - -metta_anew1(load,OBO):- !, must_det_ll((load_hook(load,OBO), - subst_vars(OBO,Cl),show_failure(assertz_if_new(Cl)))). %to_metta(Cl). -metta_anew1(unload,OBO):- subst_vars(OBO,Cl),load_hook(unload,OBO), - expand_to_hb(Cl,Head,Body), - predicate_property(Head,number_of_clauses(_)), - ignore((clause(Head,Body,Ref),clause(Head2,Body2,Ref),(Head+Body)=@=(Head2+Body2),erase(Ref),pp_m(Cl))). - -metta_anew2(Load,_OBO):- var(Load),trace,!. -metta_anew2(Load,OBO):- maybe_xform(OBO,XForm),!,metta_anew2(Load,XForm). -metta_anew2(Ch,OBO):- metta_interp_mode(Ch,Mode), !, metta_anew2(Mode,OBO). -metta_anew2(load,OBO):- must_det_ll((load_hook(load,OBO),subst_vars_not_last(OBO,Cl),assertz_if_new(Cl))). %to_metta(Cl). -metta_anew2(unload,OBO):- subst_vars_not_last(OBO,Cl),load_hook(unload,OBO), - expand_to_hb(Cl,Head,Body), - predicate_property(Head,number_of_clauses(_)), - ignore((clause(Head,Body,Ref),clause(Head2,Body2,Ref),(Head+Body)=@=(Head2+Body2),erase(Ref),pp_m(Cl))). - - -metta_anew(Ch,Src,OBO):- metta_interp_mode(Ch,Mode), !, metta_anew(Mode,Src,OBO). -metta_anew(Load,_Src,OBO):- silent_loading,!,metta_anew1(Load,OBO). -metta_anew(Load,Src,OBO):- maybe_xform(OBO,XForm),!,metta_anew(Load,Src,XForm). -metta_anew(Load,Src,OBO):- format('~N'), color_g_mesg('#0f0f0f',(write(' ; Action: '),writeq(Load=OBO))), - color_g_mesg('#ffa500', write_src(Src)), - metta_anew1(Load,OBO),format('~n'). - -subst_vars_not_last(A,B):- - functor(A,_F,N),arg(N,A,E), - subst_vars(A,B), - nb_setarg(N,B,E),!. - -con_write(W):-check_silent_loading, write(W). -con_writeq(W):-check_silent_loading, writeq(W). -writeqln(Q):- check_silent_loading,write(' '),con_writeq(Q),connl. - -connlf:- check_silent_loading, format('~N'). -connl:- check_silent_loading,nl. -% check_silent_loading:- silent_loading,!,trace,break. -check_silent_loading. -silent_loading:- is_converting,!. -silent_loading:- \+ option_value('trace-on-load',true), !. - - - -uncompound(OBO,Src):- \+ compound(OBO),!, Src = OBO. -uncompound('$VAR'(OBO),'$VAR'(OBO)):-!. -uncompound(IsList,Src):- is_list(IsList),!,maplist(uncompound,IsList,Src). -uncompound([Is|NotList],[SrcH|SrcT]):-!, uncompound(Is,SrcH),uncompound(NotList,SrcT). -uncompound(Compound,Src):- compound_name_arguments(Compound,Name,Args),maplist(uncompound,[Name|Args],Src). - -:- dynamic(all_data_to/1). -all_data_once:- all_data_to(_),!. -all_data_once:- open(all_data,write,Out,[alias(all_data),encoding(utf8),lock(write)]), - assert(all_data_to(Out)), - writeln(Out,':- encoding(utf8).'), - writeln(Out,':- style_check(-discontiguous).'), - all_data_preds. - -all_data_preds:- - all_data_to(Out), - with_output_to(Out, -((listing(table_n_type/3), - listing(load_state/2), - listing(is_loaded_from_file_count/2), - listing(fb_pred/2), - listing(fb_arg_type/1), - listing(fb_arg_table_n/3), - listing(fb_arg/1), - listing(done_reading/1)))),!. - -all_data_done:- - all_data_preds, - retract(all_data_to(Out)), - close(Out). - - - -%real_assert(OBO):- is_converting,!,print_src(OBO). -real_assert(OBO):- all_data_to(Out),!,write_canonical(Out,OBO),!,writeln(Out,'.'). -real_assert(OBO):- call(OBO),!. -real_assert(OBO):- assert(OBO), - (is_converting->print_src(OBO);true). - -print_src(OBO):- format('~N'), uncompound(OBO,Src),!, write_src(Src). - -assert_to_metta(_):- reached_file_max,!. -assert_to_metta(OBO):- !, functor(OBO,Fn,A),decl_fb_pred(Fn,A), !,real_assert(OBO),!, - incr_file_count(_),heartbeat. - -assert_to_metta(OBO):- - ignore(( A>=2,A<700, - OBO=..[Fn|Cols], - must_det_ll(( - make_assertion4(Fn,Cols,Data,OldData), - functor(Data,FF,AA), - decl_fb_pred(FF,AA), - ((fail,call(Data))->true;( - must_det_ll(( - real_assert(Data), - incr_file_count(_), - ignore((((should_show_data(X), - ignore((fail,OldData\==Data,write('; oldData '),write_src(OldData),format(' ; ~w ~n',[X]))), - write_src(Data),format(' ; ~w ~n',[X]))))), - ignore(( - fail, option_value(output_stream,OutputStream), - is_stream(OutputStream), - should_show_data(X1),X1<1000,must_det_ll((display(OutputStream,Data),writeln(OutputStream,'.'))))))))))))),!. - -assert_MeTTa(OBO):- !, assert_to_metta(OBO). -%assert_MeTTa(OBO):- !, assert_to_metta(OBO),!,heartbeat. -/* -assert_MeTTa(Data):- !, heartbeat, functor(Data,F,A), A>=2, - decl_fb_pred(F,A), - incr_file_count(_), - ignore((((should_show_data(X), - write(newData(X)),write(=),write_src(Data))))), - assert(Data),!. -*/ - - -%:- dynamic((metta_type/3,metta_defn/3,get_metta_atom/2)). - -into_space(Self,'&self',Self):-!. -into_space(_,Other,Other):-!. - - -into_space(Self,Myself,SelfO):- into_space(30,Self,Myself,SelfO). - -into_space(_Dpth,Self,Myself,Self):-Myself=='&self',!. -into_space(_Dpth,Self,None,Self):- 'None' == None,!. -into_space(Depth,Self,Other,Result):- eval_H(Depth,Self,Other,Result). -into_name(_,Other,Other). - -%eval_f_args(Depth,Self,F,ARGS,[F|EARGS]):- maplist(eval_H(Depth,Self),ARGS,EARGS). - - -combine_result(TF,R2,R2):- TF == [], !. -combine_result(TF,_,TF):-!. - - -do_metta1_e(_Self,_,exec(Exec)):- !,write_exec(Exec),!. -do_metta1_e(_Self,_,[=,A,B]):- !, with_concepts(false, - (con_write('(= '), with_indents(false,write_src(A)), (is_list(B) -> connl ; true),con_write(' '),with_indents(true,write_src(B)),con_write(')'))),connl. -do_metta1_e(_Self,_LoadExec,Term):- write_src(Term),connl. - -write_exec(Exec):- notrace(write_exec0(Exec)). -%write_exec0(Exec):- atom(Exec),!,write_exec0([Exec]). -write_exec0(Exec):- - wots(S,write_src(exec(Exec))), - nb_setval(exec_src,Exec), - ignore((notrace((color_g_mesg_ok('#0D6328',(format('~N'),writeln(S))))))). - - - - -asserted_do_metta(Space,Load,Src):- asserted_do_metta2(Space,Load,Src,Src). - -asserted_do_metta2(Self,Load,[TypeOp,Fn,Type], Src):- TypeOp = ':', \+ is_list(Type),!, - must_det_ll(( - color_g_mesg_ok('#ffa500',metta_anew(Load,Src,metta_atom(Self,[':',Fn,Type]))))),!. - -asserted_do_metta2(Self,Load,[TypeOp,Fn,TypeDecL], Src):- TypeOp = ':',!, - must_det_ll(( - decl_length(TypeDecL,Len),LenM1 is Len - 1, last_element(TypeDecL,LE), - color_g_mesg_ok('#ffa500',metta_anew(Load,Src,metta_atom(Self,[':',Fn,TypeDecL]))), - metta_anew1(Load,metta_arity(Self,Fn,LenM1)), - arg_types(TypeDecL,[],EachArg), - metta_anew1(Load,metta_params(Self,Fn,EachArg)),!, - metta_anew1(Load,metta_last(Self,Fn,LE)))). - -asserted_do_metta2(Self,Load,[TypeOp,Fn,TypeDecL,RetType], Src):- TypeOp = ':',!, - must_det_ll(( - decl_length(TypeDecL,Len), - append(TypeDecL,[RetType],TypeDecLRet), - color_g_mesg_ok('#ffa500',metta_anew(Load,Src,metta_atom(Self,[':',Fn,TypeDecLRet]))), - metta_anew1(Load,metta_arity(Self,Fn,Len)), - arg_types(TypeDecL,[RetType],EachArg), - metta_anew1(Load,metta_params(Self,Fn,EachArg)), - metta_anew1(Load,metta_return(Self,Fn,RetType)))),!. - -/*do_metta(File,Self,Load,PredDecl, Src):-fail, - metta_anew(Load,Src,metta_atom(Self,PredDecl)), - ignore((PredDecl=['=',Head,Body], metta_anew(Load,Src,metta_defn(Eq,Self,Head,Body)))), - ignore((Body == 'True',!,do_metta(File,Self,Load,Head))), - nop((fn_append(Head,X,Head), fn_append(PredDecl,X,Body), - metta_anew((Head:- Body)))),!.*/ - -asserted_do_metta2(Self,Load,[EQ,Head,Result], Src):- EQ=='=', !, - must_det_ll(( - discover_head(Self,Load,Head), - color_g_mesg_ok('#ffa500',metta_anew(Load,Src,metta_defn(EQ,Self,Head,Result))), - discover_body(Self,Load,Result))). - -asserted_do_metta2(Self,Load,PredDecl, Src):- - ignore(discover_head(Self,Load,PredDecl)), - color_g_mesg_ok('#ffa500',metta_anew(Load,Src,metta_atom(Self,PredDecl))). - - -always_exec(exec(W)):- !, is_list(W), always_exec(W). -always_exec(Comp):- compound(Comp),compound_name_arity(Comp,Name,N),atom_concat('eval',_,Name),Nm1 is N-1, arg(Nm1,Comp,TA),!,always_exec(TA). -always_exec(List):- \+ is_list(List),!,fail. -always_exec([Var|_]):- \+ atom(Var),!,fail. -always_exec(['extend-py!'|_]):- !, fail. -always_exec([H|_]):- atom_concat(_,'!',H),!. %pragma!/print!/transfer!/include! etc -always_exec(['assertEqualToResult'|_]):-!,fail. -always_exec(['assertEqual'|_]):-!,fail. -always_exec(_):-!,fail. % everything else - -if_t(A,B,C):- trace,if_t((A,B),C). - - -check_answers_for(TermV,Ans):- (string(TermV);var(Ans);var(TermV)),!,fail. -check_answers_for(TermV,_):- sformat(S,'~q',[TermV]),atom_contains(S,"[assert"),!,fail. -check_answers_for(_,Ans):- contains_var('BadType',Ans),!,fail. -check_answers_for(TermV,_):- inside_assert(TermV,BaseEval), always_exec(BaseEval),!,fail. - -%check_answers_for([TermV],Ans):- !, check_answers_for(TermV,Ans). -%check_answers_for(TermV,[Ans]):- !, check_answers_for(TermV,Ans). -check_answers_for(_,_). - -got_exec_result2(Val,Nth,Ans):- is_list(Ans), exclude(==(','),Ans,Ans2), Ans\==Ans2,!, - got_exec_result2(Val,Nth,Ans2). -got_exec_result2(Val,Nth,Ans):- - must_det_ll(( - Nth100 is Nth+100, - get_test_name(Nth100,TestName), - nb_current(exec_src,Exec), - if_t( ( \+ is_unit_test_exec(Exec)), - ((equal_enough(Val,Ans) - -> write_pass_fail_result_now(TestName,exec,Exec,'PASS',Ans,Val) - ; write_pass_fail_result_now(TestName,exec,Exec,'FAIL',Ans,Val)))))). - -write_pass_fail_result_now(TestName,exec,Exec,PASS_FAIL,Ans,Val):- - (PASS_FAIL=='PASS'->flag(loonit_success, X, X+1);flag(loonit_failure, X, X+1)), - (PASS_FAIL=='PASS'->Color=cyan;Color=red), - color_g_mesg(Color,write_pass_fail_result_c(TestName,exec,Exec,PASS_FAIL,Ans,Val)),!,nl, - nl,writeln('--------------------------------------------------------------------------'),!. - -write_pass_fail_result_c(TestName,exec,Exec,PASS_FAIL,Ans,Val):- - nl,write_mobj(exec,[(['assertEqualToResult',Exec,Ans])]), - nl,write_src('!'(['assertEqual',Val,Ans])), - write_pass_fail_result(TestName,exec,Exec,PASS_FAIL,Ans,Val). - -is_unit_test_exec(Exec):- sformat(S,'~w',[Exec]),sub_atom(S,_,_,_,'assert'). -is_unit_test_exec(Exec):- sformat(S,'~q',[Exec]),sub_atom(S,_,_,_,"!',"). - -return_empty('Empty'). -return_empty(_,Empty):- return_empty(Empty). -return_empty(_RetType,_,Empty):- return_empty(Empty). - -convert_tax(_How,Self,Tax,Expr,NewHow):- - metta_interp_mode(Ch,Mode), - string_concat(Ch,TaxM,Tax),!, - normalize_space(string(NewTax),TaxM), - convert_tax(Mode,Self,NewTax,Expr,NewHow). -convert_tax(How,_Self,Tax,Expr,How):- - %parse_sexpr_metta(Tax,Expr). - normalize_space(string(NewTax),Tax), - read_metta(NewTax,Expr). - - -metta_interp_mode('+',load). -metta_interp_mode('-',unload). -metta_interp_mode('!',exec). -metta_interp_mode('?',call). -metta_interp_mode('^',load_like_file). - - -call_sexpr(Mode,Self,Tax,_S,Out):- - metta_interp_mode(Mode,How), - (atom(Tax);string(Tax)), - normalize_space(string(TaxM),Tax), - convert_tax(How,Self,TaxM,Expr,NewHow),!, - show_call(do_metta(python,NewHow,Self,Expr,Out)). - - -do_metta(_File,_Load,_Self,In,Out):- var(In),!,In=Out. -do_metta(_From,_Mode,_Self,end_of_file,'Empty'):- !. %, halt(7), writeln('\n\n% To restart, use: ?- repl.'). -do_metta(_File,_Load,_Self,Cmt,Out):- Cmt==[],!, Out=[]. - -do_metta(From,Load,Self,'$COMMENT'(Expr,_,_),Out):- !, do_metta(From,comment(Load),Self,Expr,Out). -do_metta(From,Load,Self,'$STRING'(Expr),Out):- !, do_metta(From,comment(Load),Self,Expr,Out). -do_metta(From,comment(Load),Self,[Expr],Out):- !, do_metta(From,comment(Load),Self,Expr,Out). -do_metta(From,comment(Load),Self,Cmt,Out):- write_comment(Cmt), !, - ignore(( atomic(Cmt),atomic_list_concat([_,Src],'MeTTaLog only: ',Cmt),!,atom_string(Src,SrcCode),do_metta(mettalog_only(From),Load,Self,SrcCode,Out))), - ignore(( atomic(Cmt),atomic_list_concat([_,Src],'MeTTaLog: ',Cmt),!,atom_string(Src,SrcCode),do_metta(mettalog_only(From),Load,Self,SrcCode,Out))),!. - -do_metta(From,How,Self,Src,Out):- string(Src),!, - normalize_space(string(TaxM),Src), - convert_tax(How,Self,TaxM,Expr,NewHow),!, - do_metta(From,NewHow,Self,Expr,Out). - -do_metta(From,_,Self,exec(Expr),Out):- !, do_metta(From,exec,Self,Expr,Out). -do_metta(From,_,Self, call(Expr),Out):- !, do_metta(From,call,Self,Expr,Out). -do_metta(From,_,Self, ':-'(Expr),Out):- !, do_metta(From,call,Self,Expr,Out). -do_metta(From,call,Self,TermV,FOut):- !, - call_for_term_variables(TermV,Term,NamedVarsList,X), must_be(nonvar,Term), - copy_term(NamedVarsList,Was), - Output = NamedVarsList, - user:interactively_do_metta_exec(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut). -do_metta(_File,Load,Self,Src,Out):- Load\==exec, !, as_tf(asserted_do_metta(Self,Load,Src),Out). - -do_metta(file(Filename),exec,Self,TermV,Out):- - notrace(( - inc_exec_num(Filename), - must_det_ll(( - get_exec_num(Filename,Nth), - Nth>0)), - file_answers(Filename, Nth, Ans), - check_answers_for(TermV,Ans),!, - must_det_ll(( - color_g_mesg_ok('#ffa500', - (writeln(';; In file as: '), - color_g_mesg([bold,fg('#FFEE58')], write_src(exec(TermV))), - write(';; To unit test case:'))))),!, - do_metta_exec(file(Filename),Self,['assertEqualToResult',TermV,Ans],Out))). - -do_metta(From,exec,Self,TermV,Out):- !, do_metta_exec(From,Self,TermV,Out). - -do_metta_exec(From,Self,TermV,FOut):- - Output = X, - notrace(into_metta_callable(Self,TermV,Term,X,NamedVarsList,Was)), - user:interactively_do_metta_exec(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut). - - -call_for_term_variables(TermV,catch_red(show_failure(Term)),NamedVarsList,X):- - term_variables(TermV, AllVars), call_for_term_variables4v(TermV,AllVars,Term,NamedVarsList,X),!, - must_be(callable,Term). -call_for_term_variables(TermV,catch_red(show_failure(Term)),NamedVarsList,X):- - get_term_variables(TermV, DCAllVars, Singletons, NonSingletons), - call_for_term_variables5(TermV, DCAllVars, Singletons, NonSingletons, Term,NamedVarsList,X),!, - must_be(callable,Term). - -into_metta_callable(_Self,TermV,Term,X,NamedVarsList,Was):- use_metta_compiler, !, - must_det_ll(((( - - % ignore(Res = '$VAR'('ExecRes')), - RealRes = Res, - compile_for_exec(Res,TermV,ExecGoal),!, - subst_vars(Res+ExecGoal,Res+Term,NamedVarsList), - copy_term(NamedVarsList,Was), - term_variables(Term,Vars), - notrace((color_g_mesg('#114411',print_tree(exec(Res):-ExecGoal)))), - %nl,writeq(Term),nl, - ((\+ \+ - ((numbervars(v(TermV,Term,NamedVarsList,Vars),999,_,[attvar(bind)]), - %nb_current(variable_names,NamedVarsList), - %nl,print(subst_vars(Term,NamedVarsList,Vars)), - nl)))), - nop(maplist(verbose_unify,Vars)), - %NamedVarsList=[_=RealRealRes|_], - var(RealRes), X = RealRes)))),!. - - -into_metta_callable(Self,TermV,CALL,X,NamedVarsList,Was):-!, - option_else('stack-max',StackMax,100), - CALL = eval_H(StackMax,Self,Term,X), - notrace(( must_det_ll(( - if_t(preview_compiler,write_compiled_exec(TermV,_Goal)), - subst_vars(TermV,Term,NamedVarsList), - copy_term(NamedVarsList,Was) - %term_variables(Term,Vars), - %nl,writeq(Term),nl, - %skip((\+ \+ - %((numbervars(v(TermV,Term,NamedVarsList,Vars),999,_,[attvar(bind)]), %nb_current(variable_names,NamedVarsList), - %nl,print(subst_vars(TermV,Term,NamedVarsList,Vars)),nl)))), - %nop(maplist(verbose_unify,Vars)))))),!. - )))). - -eval_H(StackMax,Self,Term,X):- - (always_exec(Term) -> - if_or_else(eval_args('=',_,StackMax,Self,Term,X), - (fail,subst_args('=',_,StackMax,Self,Term,X))); - call_max_time(eval_args('=',_,StackMax,Self,Term,X),3.0, - (fail,subst_args('=',_,StackMax,Self,Term,X)))). - -eval_H(Term,X):- - if_or_else((eval_args(Term,X),X\==Term),(fail,subst_args(Term,Y),Y\==Term)). - -%eval_H(Term,X):- if_or_else((subst_args(Term,X),X\==Term),(eval_args(Term,Y),Y\==Term)). - -print_goals(TermV):- write_src(TermV). - - -if_or_else(Goal,Else):- call(Goal)*->true;call(Else). - -interacting:- tracing,!. -interacting:- current_prolog_flag(debug,true),!. -interacting:- option_value(interactive,true),!. - -% call_max_time(+Goal, +MaxTime, +Else) -call_max_time(Goal,_MaxTime, Else) :- interacting,!, if_or_else(Goal,Else). -call_max_time(Goal,_MaxTime, Else) :- !, if_or_else(Goal,Else). -call_max_time(Goal, MaxTime, Else) :- - catch(if_or_else(call_with_time_limit(MaxTime, Goal),Else), time_limit_exceeded, Else). - - -catch_err(G,E,C):- catch(G,E,(atom(E)->throw(E);C)). - -%repl:- option_value('repl',prolog),!,prolog. -%:- ensure_loaded(metta_toplevel). - -%:- discontiguous do_metta_exec/3. - -repl:- setup_call_cleanup(flag(repl_level,Was,Was+1),repl0, - (flag(repl_level,_,Was),(Was==0 -> maybe_halt(7) ; true))). - -repl0:- catch(repl2,end_of_input,true). -repl1:- - with_option('doing_repl',true, - with_option(repl,true,repl2)). %catch((repeat, repl2, fail)'$aborted',true). -repl2:- -%notrace((current_input(In),nop(catch(load_history,_,true)))), - % ignore(install_readline(In)), - repeat, - %with_option(not_a_reload,true,make), - catch(once(repl3),restart_reading,true),fail. -repl3:- - notrace(( flag(eval_num,_,0), - current_space(Self), - ((nb_current(read_mode,Mode),Mode\==[])->true;Mode='!'), - ignore(shell('stty sane ; stty echo')), - current_input(In), - format(atom(P),'metta ~w ~w> ',[Self, Mode]))), - setup_call_cleanup( - notrace(prompt(Was,P)), - notrace((ttyflush,read_metta(In,Expr),ttyflush)), - notrace(prompt(_,Was))), - ignore(shell('stty sane ; stty echo')), - notrace(ignore(check_has_directive(Expr))), - notrace(if_t(Expr==end_of_file,throw(end_of_input))), - once(do_metta(repl_true,Mode,Self,Expr,_)). - -check_has_directive(Atom):- atom(Atom),atom_concat(_,'.',Atom),!. -check_has_directive(call(N=V)):- nonvar(N),!, set_directive(N,V). -check_has_directive(call(Rtrace)):- rtrace == Rtrace,!, rtrace,notrace(throw(restart_reading)). -check_has_directive(NEV):- atom(NEV), atomic_list_concat([N,V],'=',NEV), set_directive(N,V). -check_has_directive([AtEq,Value]):-atom(AtEq),atom_concat('@',Name,AtEq), set_directive(Name,Value). -check_has_directive(ModeChar):- atom(ModeChar),metta_interp_mode(ModeChar,_Mode),!,set_directive(read_mode,ModeChar). -check_has_directive(AtEq):-atom(AtEq),atom_concat('@',NEV,AtEq),check_has_directive(NEV,true). -check_has_directive(_). -set_directive(N,V):- atom_concat('@',NN,N),!,set_directive(NN,V). -set_directive(N,V):- N==mode,!,set_directive(read_mode,V). -set_directive(N,V):- show_call(set_option_value(N,V)),!,notrace(throw(restart_reading)). - -read_pending_white_codes(In):- - read_pending_codes(In,[10],[]),!. -read_pending_white_codes(_). - -call_for_term_variables4v(Term,[] ,as_tf(Term,TF),NamedVarsList,TF):- get_global_varnames(NamedVarsList),!. -call_for_term_variables4v(Term,[X] , Term, NamedVarsList,X):- get_global_varnames(NamedVarsList). - - -not_in_eq(List, Element) :- - member(V, List), V == Element. - -get_term_variables(Term, DontCaresN, CSingletonsN, CNonSingletonsN) :- - term_variables(Term, AllVars), - get_global_varnames(VNs), - writeqln(term_variables(Term, AllVars)=VNs), - term_singletons(Term, Singletons), - term_dont_cares(Term, DontCares), - include(not_in_eq(Singletons), AllVars, NonSingletons), - include(not_in_eq(DontCares), NonSingletons, CNonSingletons), - include(not_in_eq(DontCares), Singletons, CSingletons), - maplist(into_named_vars,[DontCares, CSingletons, CNonSingletons], - [DontCaresN, CSingletonsN, CNonSingletonsN]), - writeqln([DontCaresN, CSingletonsN, CNonSingletonsN]). - -term_dont_cares(Term, DontCares):- - term_variables(Term, AllVars), - get_global_varnames(VNs), - include(has_sub_var(AllVars),VNs,HVNs), - include(underscore_vars,HVNs,DontCareNs), - maplist(arg(2),DontCareNs,DontCares). - -into_named_vars(Vars,L):- is_list(Vars), !, maplist(name_for_var_vn,Vars,L). -into_named_vars(Vars,L):- term_variables(Vars,VVs),!,into_named_vars(VVs,L). - -has_sub_var(AllVars,_=V):- sub_var(V,AllVars). -underscore_vars(V):- var(V),!,name_for_var(V,N),!,underscore_vars(N). -underscore_vars(N=_):- !, atomic(N),!,underscore_vars(N). -underscore_vars(N):- atomic(N),!,atom_concat('_',_,N). - -get_global_varnames(VNs):- nb_current('variable_names',VNs),VNs\==[],!. -get_global_varnames(VNs):- prolog_load_context(variable_names,VNs),!. -maybe_set_var_names(List):- List==[],!. -maybe_set_var_names(List):- % wdmsg(maybe_set_var_names(List)), - is_list(List),!,nb_linkval(variable_names,List). -maybe_set_var_names(_). - -name_for_var_vn(V,N=V):- name_for_var(V,N). - -name_for_var(V,N):- var(V),!,get_global_varnames(VNs),member(N=VV,VNs),VV==V,!. -name_for_var(N=_,N):- !. -name_for_var(V,N):- term_to_atom(V,N),!. - - - %call_for_term_variables5(Term,[],as_tf(Term,TF),[],TF):- atom(Term),!. -call_for_term_variables5(Term,[],[],[],as_tf(Term,TF),[],TF):- ground(Term),!. -call_for_term_variables5(Term,DC,[],[],call_nth(Term,TF),DC,TF):- ground(Term),!. -call_for_term_variables5(Term,_,[],[_=Var],call_nth(Term,Count),['Count'=Count],Var). -call_for_term_variables5(Term,_,[_=Var],[],call_nth(Term,Count),['Count'=Count],Var). -call_for_term_variables5(Term,_,Vars,[_=Var],Term,Vars,Var). -call_for_term_variables5(Term,_,[_=Var],Vars,Term,Vars,Var). -call_for_term_variables5(Term,_,SVars,Vars,call_nth(Term,Count),[Vars,SVars],Count). - - - -is_interactive(From):- notrace(is_interactive0(From)). -is_interactive0(From):- From==false,!,fail. -is_interactive0(From):- atomic(From),is_stream(From),!, \+ stream_property(From,filename(_)). -is_interactive0(From):- From = repl_true,!. -is_interactive0(From):- From = true,!. - - -:- set_prolog_flag(history, 20). - -inside_assert(Var,Var):- \+ compound(Var),!. -inside_assert([H,IA,_],IA):- atom(H),atom_concat('assert',_,H),!. -inside_assert(Conz,Conz):- is_conz(Conz),!. -inside_assert(call(I),O):- !, inside_assert(I,O). -inside_assert( ?-(I), O):- !, inside_assert(I,O). -inside_assert( :-(I), O):- !, inside_assert(I,O). -inside_assert(exec(I),O):- !, inside_assert(I,O). -inside_assert(eval_H(A,B,I,C),eval_H(A,B,O,C)):- !, inside_assert(I,O). -inside_assert(eval_H(I,C),eval_H(O,C)):- !, inside_assert(I,O). -inside_assert(Eval,O):- functor(Eval,F,A), atom_concat('eval',_,F), A1 is A-1, arg(A1,Eval,I),!, inside_assert(I,O). -inside_assert(I,O):- I=..[_,F|_],!,compound(F),inside_assert(F,O). -inside_assert(Var,Var). - -current_space(Self):- ((nb_current(self_space,Self),Self\==[])->true;Self='&self'). - -eval(all(Form)):- nonvar(Form), !, forall(eval(Form,_),true). -eval(Form):- - current_space(Self), - do_metta(true,exec,Self,Form,_Out). - -eval(Self,Form):- - current_space(SelfS),SelfS==Self,!, - do_metta(true,exec,Self,Form,_Out). -eval(Form,Out):- - current_space(Self), - eval(Self,Form,Out). - - -eval(Self,Form,Out):- - do_metta(prolog,exec,Self,Form,Out). - -name_vars(X='$VAR'(X)). - -interactively_do_metta_exec(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut):- - notrace(( - Result = res(FOut), - inside_assert(Term,BaseEval), - option_else(answer,Leap,each), - Control = contrl(Leap), - Skipping = _, - % Initialize Control as a compound term with 'each' as its argument. - %GG = interact(['Result'=X|NamedVarsList],Term,trace_off), - (((From = file(_Filename), option_value('exec',skip), \+ always_exec(BaseEval))) - -> (GG = (skip(Term),deterministic(Complete)), - %Output = - %FOut = "Skipped", - Skipping = 1,!, - %color_g_mesg('#da70d6', (write('% SKIPPING: '), writeq(eval_H(100,Self,BaseEval,X)),writeln('.'))), - % color_g_mesg('#fa90f6', (writeln('; SKIPPING'), with_indents(true,write_src(exec(BaseEval))))), - % if_t(is_list(BaseEval),add_history_src(exec(TermV))), - true - ) - ; GG = locally(set_prolog_flag(gc,false), - ( (dcall(Term),deterministic(Complete)), nb_setarg(1,Result,Output))), - - !, % metta_toplevel - flag(result_num,_,0), - PL=eval(Self,BaseEval,X), - ( % with_indents(true, - \+ \+ ( - maplist(name_vars,NamedVarsList), - name_vars('OUT'=X), - % add_history_src(exec(BaseEval)), - write_exec(TermV), - if_t(Skipping==1,writeln(' ; SKIPPING')), - if_t(TermV\=BaseEval,color_g_mesg('#fa90f6', (write('; '), with_indents(false,write_src(exec(BaseEval)))))), - if_t((is_interactive(From);Skipping==1), - ( - if_t( \+ option_value(doing_repl,true), - if_t( \+ option_value(repl,true), - if_t( option_value(prolog,true), add_history_pl(PL)))), - if_t(option_value(repl,true), add_history_src(exec(BaseEval))))), - - color_g_mesg('#da70d6', (write('% DEBUG: '), writeq(PL),writeln('.'))), - true))))), - - (forall_interactive( - From, WasInteractive,Complete,may_rtrace(GG), - ((Complete==true->!;true), - %repeat, - set_option_value(interactive,WasInteractive), - nb_setarg(1,Result,Output), - read_pending_codes(user_input,_,[]), - flag(result_num,R,R+1), - flag(result_num,ResNum,ResNum), - (((ResNum==1,Complete==true)->(format('~NDeterministic: ', []), !); %or Nondet - ( Complete==true -> (format('~NLast Result(~w): ',[ResNum]),! ); - format('~NNDet Result(~w): ',[ResNum])))), - color_g_mesg(yellow, ignore((( if_t( \+ atomic(Output), nl), write_src(Output), nl)))), - color_g_mesg(green, - ignore((NamedVarsList \=@= Was ->( maplist(print_var,NamedVarsList), nl) ; true))), - ((Complete\==true, WasInteractive, Control \== contrl(leap))-> - (write("More Solutions? "),get_single_char_key(C), writeq(key=C),nl, - (C=='b' -> (once(repl),fail) ; - (C=='m' -> make ; - (C=='t' -> (nop(set_debug(eval,true)),rtrace) ; - (C=='T' -> (set_debug(eval,true)); - (C==';' -> true ; - (C==esc('[A',[27,91,65]) -> nb_setarg(1, Control, leap) ; - (C=='l' -> nb_setarg(1, Control, leap) ; - (((C=='\n');(C=='\r')) -> (!,fail); - (!,fail))))))))))); - (Complete\==true, \+ WasInteractive, Control == contrl(leap)) -> true ; - (((Complete==true ->! ; true))))) - *-> (ignore(Result = res(FOut)),ignore(Output = (FOut))) - ; (flag(result_num,ResNum,ResNum),(ResNum==0->(format('~N~n~n'),!,fail);true))), - ignore(Result = res(FOut)). - - -get_single_char_key(O):- get_single_char(C),get_single_char_key(C,O). -get_single_char_key(27,esc(A,[27|O])):- !,read_pending_codes(user_input,O,[]),name(A,O). -get_single_char_key(C,A):- name(A,[C]). - -forall_interactive(file(_),false,Complete,Goal,After):- !, Goal, (Complete==true -> ( After,!) ; ( \+ After )). -forall_interactive(prolog,false,Complete,Goal,After):- !, Goal, (Complete == true -> ! ; true), quietly(After). -forall_interactive(From,WasInteractive,Complete,Goal,After):- - (is_interactive(From) -> WasInteractive = true ; WasInteractive = false),!, - Goal, (Complete==true -> ( quietly(After),!) ; ( quietly( \+ After) )). - -print_var(Name=Var) :- print_var(Name,Var). -print_var(Name,Var):- write('$'),write(Name), write(' = '), write_src(Var), nl. - -% Entry point for the user to call with tracing enabled -toplevel_goal(Goal) :- - term_variables(Goal,Vars), - trace_goal(Vars, Goal, trace_off). - -% Entry point for the user to call with tracing enabled -trace_goal(Goal) :- - trace_goal(Goal, trace_on). - -% Handle tracing -trace_goal(Goal, Tracing) :- - (Tracing == trace_on -> writeln('Entering goal:'), writeln(Goal) ; true), - term_variables(Goal, Variables), - ( call(Goal) -> - (Tracing == trace_on -> writeln('Goal succeeded with:'), writeln(Variables) ; true), - interact(Variables, Goal, Tracing) - ; (Tracing == trace_on -> writeln('Goal failed.') ; true), - false - ). - -% Interaction with the user -interact(Variables, Goal, Tracing) :- - call(Goal),write('Solution: '), write_src(Variables), - write(' [;next]?'), - get_single_char(Code), - (command(Code, Command) -> - handle_command(Command, Variables, Goal, Tracing) - ; writeln('Unknown command.'), interact(Variables, Goal, Tracing) % handle unknown commands - ). - -install_readline(Input):- - add_history_string("!(pfb3)"), - add_history_string("!(load-flybase-full)"), - add_history_string("!(obo-alt-id $X BS:00063)"), - add_history_string("!(and (total-rows $T TR$) (unique-values $T2 $Col $TR))"), - ignore(editline:el_wrap), - ignore(editline:add_prolog_commands(Input)). - - - - -% Command descriptions -command(59, retry). % ';' to retry -command(115, skip). % 's' to skip to the next solution -command(108, leap). % 'l' to leap (end the debugging session) -command(103, goals). % 'g' to show current goals -command(102, fail). % 'f' to force fail -command(116, trace). % 't' to toggle tracing -command(117, up). % 'u' to continue without interruption -command(101, exit). % 'e' to exit the debugger -command(97, abort). % 'a' to abort -command(98, break). % 'b' to set a breakpoint -command(99, creep). % 'c' to proceed step by step -command(104, help). % 'h' for help -command(65, alternatives). % 'A' for alternatives -command(109, make). % 'm' for make (recompile) -command(67, compile). % 'C' for Compile (compile new executable) - -:- style_check(-singleton). - -% Command implementations -handle_command(make, Variables, Goal, Tracing) :- - writeln('Recompiling...'), - % Insert the logic to recompile the code. - % This might involve calling `make/0` or similar. - make, % This is assuming your Prolog environment has a `make` predicate. - fail. % interact(Variables, Goal, Tracing). - -handle_command(compile, Variables, Goal, Tracing) :- - writeln('Compiling new executable...'), - % Insert the logic to compile a new executable. - % This will depend on how you compile Prolog programs in your environment. - % For example, you might use `qsave_program/2` to create an executable. - % Pseudocode: compile_executable(ExecutableName) - fail. % interact(Variables, Goal, Tracing). -handle_command(alternatives, Variables, Goal, Tracing) :- - writeln('Showing alternatives...'), - % Here you would include the logic for displaying the alternatives. - % For example, showing other clauses that could be tried for the current goal. - writeln('Alternatives for current goal:'), - writeln(Goal), - % Pseudocode: find_alternatives(Goal, Alternatives) - % Pseudocode: print_alternatives(Alternatives) - fail. % interact(Variables, Goal, Tracing). -% Extend the command handling with the 'help' command implementation -handle_command(help, Variables, Goal, Tracing) :- - print_help, - fail. % interact(Variables, Goal, Tracing). -handle_command(abort, _, _, _) :- - writeln('Aborting...'), abort. -handle_command(break, Variables, Goal, Tracing) :- - writeln('Breakpoint set.'), % Here you should define what 'setting a breakpoint' means in your context - fail. % interact(Variables, Goal, Tracing). -handle_command(creep, Variables, Goal, Tracing) :- - writeln('Creeping...'), % Here you should define how to 'creep' (step by step execution) through the code - trace. % interact(Variables, Goal, Tracing). -handle_command(retry, Variables, Goal, Tracing) :- - writeln('Continuing...'),!. - %trace_goal(Goal, Tracing). -handle_command(skip, Variables, Goal, Tracing) :- - writeln('Skipping...'). -handle_command(leap, _, _, _) :- - writeln('Leaping...'), nontrace. % Cut to ensure we stop the debugger -handle_command(goals, Variables, Goal, Tracing) :- - writeln('Current goal:'), writeln(Goal), - writeln('Current variables:'), writeln(Variables), - bt,fail. % interact(Variables, Goal, Tracing). -handle_command(fail, _, _, _) :- - writeln('Forcing failure...'), fail. -handle_command(trace, Variables, Goal, Tracing) :- - (Tracing == trace_on -> - NewTracing = trace_off, writeln('Tracing disabled.') - ; NewTracing = trace_on, writeln('Tracing enabled.') - ), - interact(Variables, Goal, NewTracing). -handle_command(up, Variables, Goal, Tracing) :- - writeln('Continuing up...'), - repeat, - ( trace_goal(Goal, Tracing) -> true ; !, fail ). -handle_command(exit, _, _, _) :- - writeln('Exiting debugger...'), !. % Cut to ensure we exit the debugger - -:- style_check(+singleton). - - -% Help description -print_help :- - writeln('Debugger commands:'), - writeln('(;) next - Retry with next solution.'), - writeln('(g) goal - Show the current goal.'), - writeln('(u) up - Finish this goal without interruption.'), - writeln('(s) skip - Skip to the next solution.'), - writeln('(c) creep or - Proceed step by step.'), - writeln('(l) leap - Leap over (the debugging).'), - writeln('(f) fail - Force the current goal to fail.'), - writeln('(B) back - Go back to the previous step.'), - writeln('(t) trace - Toggle tracing on or off.'), - writeln('(e) exit - Exit the debugger.'), - writeln('(a) abort - Abort the current operation.'), - writeln('(b) break - Break to a new sub-REPL.'), - writeln('(h) help - Display this help message.'), - writeln('(A) alternatives - Show alternative solutions.'), - writeln('(m) make - Recompile/Update the current running code.'), - writeln('(C) compile - Compile a fresh executable (based on the running state).'), - writeln('(E) error msg - Show the latest error messages.'), - writeln('(r) retry - Retry the previous command.'), - writeln('(I) info - Show information about the current state.'), - !. - - - - -really_trace:- once(option_value('exec',rtrace);option_value('eval',rtrace);is_debugging((exec));is_debugging((eval))). -% !(pragma! exec rtrace) -may_rtrace(Goal):- really_trace,!, really_rtrace(Goal). -may_rtrace(Goal):- rtrace_on_existence_error(time_eval(dcall(Goal)))*->true;really_rtrace(Goal). -really_rtrace(Goal):- use_metta_compiler,!,rtrace(call(Goal)). -really_rtrace(Goal):- with_debug((eval),with_debug((exec),Goal)). - -rtrace_on_existence_error(G):- !, catch(G,E,(wdmsg(E),rtrace(G))). -%rtrace_on_existence_error(G):- catch(G,error(existence_error(procedure,W),Where),rtrace(G)). - - - -write_compiled_exec(Exec,Goal):- -% ignore(Res = '$VAR'('ExecRes')), - compile_for_exec(Res,Exec,Goal), - notrace((color_g_mesg('#114411',portray_clause(exec(Res):-Goal)))). - -verbose_unify(Term):- verbose_unify(trace,Term). -verbose_unify(What,Term):- term_variables(Term,Vars),maplist(verbose_unify0(What),Vars),!. -verbose_unify0(What,Var):- put_attr(Var,verbose_unify,What). -verbose_unify:attr_unify_hook(Attr, Value) :- - format('~N~q~n',[verbose_unify:attr_unify_hook(Attr, Value)]), - vu(Attr,Value). -vu(_Attr,Value):- is_ftVar(Value),!. -vu(fail,_Value):- !, fail. -vu(true,_Value):- !. -vu(trace,_Value):- trace. -:- nodebug(metta(eval)). -:- nodebug(metta(exec)). -% Measures the execution time of a Prolog goal and displays the duration in seconds, -% milliseconds, or microseconds, depending on the execution time. -% -% Args: -% - Goal: The Prolog goal to be executed and timed. -% -% The predicate uses the `statistics/2` predicate to measure the CPU time before -% and after executing the provided goal. It calculates the elapsed time in seconds -% and converts it to milliseconds and microseconds. The output is formatted to -% provide clear timing information: -% -% - If the execution takes more than 2 seconds, it displays the time in seconds. -% - If the execution takes between 1 millisecond and 2 seconds, it displays the time -% in milliseconds. -% - If the execution takes less than 1 millisecond, it displays the time in microseconds. -% -% Example usage: -% ?- time_eval(my_goal(X)). -% -% ?- time_eval(sleep(0.95)). -% -% Output examples: -% ; Evaluation took 2.34 seconds. -% ; Evaluation took 123.45 ms. -% ; Evaluation took 0.012 ms. (12.33 microseconds) -% -time_eval(Goal):- - time_eval('Evaluation',Goal). -time_eval(What,Goal) :- - statistics(cputime, Start), - call(Goal), - statistics(cputime, End), - Seconds is End - Start, - Milliseconds is Seconds * 1_000, - (Seconds > 2 - -> format('; ~w took ~2f seconds.~n', [What, Seconds]) - ; (Milliseconds >= 1 - -> format('; ~w took ~3f secs. (~2f milliseconds) ~n', [What, Seconds, Milliseconds]) - ;( Micro is Milliseconds * 1_000, - format('; ~w took ~6f secs. (~2f microseconds) ~n', [What, Seconds, Micro])))). - -example0(_):- fail. -example1(a). example1(_):- fail. -example2(a). example2(b). example2(_):- fail. -example3(a). example3(b). example3(c). example3(_):- fail. -%eval_H(100,'&self',['change-state!','&var',[+,1,['get-state','&var']]],OUT) -%dcall(X):- (call(X),deterministic(YN)),trace,((YN==true)->!;true). -dcall(XX):- !, call(XX). -dcall(XX):- - USol = sol(dead), - copy_term(XX,X), - call_nth(USol,X,Nth,Det,Prev), - %wdmsg(call_nth(USol,X,Nth,Det,Prev)), - XX=Prev, - (Det==yes -> (!, (XX=Prev;XX=X)) ; - (((var(Nth) -> ( ! , Prev\==dead) ; - true), - (Nth==1 -> ! ; true)))). - -call_nth(USol,XX,Nth,Det,Prev):- - repeat, - ((call_nth(XX,Nth),deterministic(Det),arg(1,USol,Prev))*-> - ( nb_setarg(1,USol,XX)) - ; (!, arg(1,USol,Prev))). - -catch_red(Term):- catch(Term,E,pp_m(red,in(Term,E))). - -s2p(I,O):- sexpr_s2p(I,O),!. - -discover_head(Self,Load,Head):- - ignore(([Fn|PredDecl]=Head, - nop(( arg_types(PredDecl,[],EachArg), - metta_anew1(Load,metta_head(Self,Fn,EachArg)))))). - -discover_body(Self,Load,Body):- - nop(( [Fn|PredDecl] = Body, arg_types(PredDecl,[],EachArg), - metta_anew1(Load,metta_body(Self,Fn,EachArg)))). - -decl_length(TypeDecL,Len):- is_list(TypeDecL),!,length(TypeDecL,Len). -decl_length(_TypeDecL,1). - -arg_types([['->'|L]],R,LR):-!, arg_types(L,R,LR). -arg_types(['->'|L],R,LR):-!, arg_types(L,R,LR). -arg_types(L,R,LR):- append(L,R,LR). - -%:- ensure_loaded('../../examples/factorial'). -%:- ensure_loaded('../../examples/fibonacci'). - -%print_preds_to_functs:-preds_to_functs_src(factorial_tail_basic) - -:- dynamic(began_loon/1). -loon:- loon(typein). - -catch_red_ignore(G):- catch_red(G)*->true;true. - -:- export(loon/1). -:- public(loon/1). - -%loon(Why):- began_loon(Why),!,wdmsg(begun_loon(Why)). -loon(Why):- is_compiling,!,wdmsg(compiling_loon(Why)),!. -%loon( _Y):- current_prolog_flag(os_argv,ArgV),member('-s',ArgV),!. -loon(Why):- is_compiled, Why\==toplevel,Why\==default, Why\==program,!,wdmsg(compiled_loon(Why)),!. -loon(Why):- began_loon(_),!,wdmsg(skip_loon(Why)). -loon(Why):- wdmsg(began_loon(Why)), assert(began_loon(Why)), - do_loon. - -do_loon:- - ignore(( - \+ prolog_load_context(reloading,true), - maplist(catch_red_ignore,[ - - metta_final, - load_history, - update_changed_files, - run_cmd_args, - pre_halt, - maybe_halt(7)]))),!. - - - -pre_halt:- option_value('prolog',true),!,call_cleanup(prolog,(set_option_value('prolog',false),pre_halt)). -pre_halt:- option_value('repl',true),!,call_cleanup(repl,(set_option_value('repl',false),pre_halt)). -pre_halt:- loonit_report. -%loon:- time(loon_metta('./examples/compat/test_scripts/*.metta')),fail. -%loon:- repl, (option_value('halt',false)->true;halt(7)). -%maybe_halt(Seven):- option_value('prolog',true),!,call_cleanup(prolog,(set_option_value('prolog',false),maybe_halt(Seven))). -%maybe_halt(Seven):- option_value('repl',true),!,call_cleanup(repl,(set_option_value('repl',false),maybe_halt(Seven))). -%maybe_halt(Seven):- option_value('repl',true),!,halt(Seven). -maybe_halt(_):- once(pre_halt), fail. -maybe_halt(Seven):- option_value('halt',true),!,halt(Seven). -maybe_halt(Seven):- wdmsg(maybe_halt(Seven)). - -is_compiling:- current_prolog_flag(os_argv,ArgV),member(E,ArgV), - (E==qcompile_mettalog;E==qsave_program),!. -is_compiled:- current_prolog_flag(os_argv,ArgV),\+ member('swipl',ArgV),!. -is_converting:- nb_current('convert','True'),!. -is_converting:- current_prolog_flag(os_argv,ArgV), member('--convert',ArgV),!. -show_os_argv:- current_prolog_flag(os_argv,ArgV),write('; libswipl: '),writeln(ArgV). -is_pyswip:- current_prolog_flag(os_argv,ArgV),member( './',ArgV). -% libswipl: ['./','-q',--home=/usr/local/lib/swipl] - -:- initialization(show_os_argv). - -:- initialization(loon(program),program). -:- initialization(loon(default)). - -ensure_mettalog_system:- - abolish(began_loon/1), - dynamic(began_loon/1), - system:use_module(library(quasi_quotations)), - system:use_module(library(hashtable)), - system:use_module(library(gensym)), - system:use_module(library(sort)), - system:use_module(library(writef)), - system:use_module(library(rbtrees)), - system:use_module(library(dicts)), - system:use_module(library(shell)), - system:use_module(library(edinburgh)), - % system:use_module(library(lists)), - system:use_module(library(statistics)), - system:use_module(library(nb_set)), - system:use_module(library(assoc)), - system:use_module(library(pairs)), - user:use_module(library(swi_ide)), - user:use_module(library(prolog_profile)), - ensure_loaded('./src/main/flybase_convert'), - ensure_loaded('./src/main/flybase_main'), - autoload_all, - make, - autoload_all, - %pack_install(predicate_streams, [upgrade(true),global(true)]), - %pack_install(logicmoo_utils, [upgrade(true),global(true)]), - %pack_install(dictoo, [upgrade(true),global(true)]), - !. - -file_save_name(E,_):- \+ atom(E),!,fail. -file_save_name(E,Name):- file_base_name(E,BN),BN\==E,!,file_save_name(BN,Name). -file_save_name(E,E):- atom_concat('Sav.',_,E),!. -file_save_name(E,E):- atom_concat('Bin.',_,E),!. -before_underscore(E,N):-atomic_list_concat([N|_],'_',E),!. -save_name(Name):- current_prolog_flag(os_argv,ArgV),member(E,ArgV),file_save_name(E,Name),!. -next_save_name(Name):- save_name(E), - before_underscore(E,N), - atom_concat(N,'_',Stem), - gensym(Stem,Name), - \+ exists_file(Name), - Name\==E,!. -next_save_name('Sav.MeTTaLog'). -qcompile_mettalog:- - ensure_mettalog_system, - catch(qsave_program('Sav.MeTTaLog', - [class(development),autoload(true),goal(loon(goal)), toplevel(loon(toplevel)), stand_alone(true)]),E,writeln(E)), - halt(0). -qsave_program:- ensure_mettalog_system, next_save_name(Name), - catch(qsave_program(Name, - [class(development),autoload(true),goal(loon(goal)), toplevel(loon(toplevel)), stand_alone(false)]),E,writeln(E)), - !. - - -:- initialization(update_changed_files,restore). - -:- ignore((( - \+ prolog_load_context(reloading,true), - initialization(loon(restore),restore), - metta_final -))). -:- set_prolog_flag(metta_interp,ready). diff --git a/.Attic/metta_lang/metta_interp.pl b/.Attic/metta_lang/metta_interp.pl index 6a591acaa05..55af8a4433f 100755 --- a/.Attic/metta_lang/metta_interp.pl +++ b/.Attic/metta_lang/metta_interp.pl @@ -54,7 +54,7 @@ :- encoding(utf8). :- set_prolog_flag(encoding, utf8). :- nb_setval(cmt_override,lse('; ',' !(" ',' ") ')). -:- ensure_loaded(swi_support). +:- set_prolog_flag(source_search_working_directory,true). :- set_prolog_flag(backtrace,true). :- set_prolog_flag(backtrace_depth,100). :- set_prolog_flag(backtrace_goal_dept,100). @@ -62,6 +62,7 @@ :- set_prolog_flag(write_attributes,portray). :- set_prolog_flag(debug_on_interrupt,true). :- set_prolog_flag(debug_on_error,true). +:- ensure_loaded(swi_support). %:- set_prolog_flag(compile_meta_arguments,control). :- (prolog_load_context(directory, Value);Value='.'), absolute_file_name('../packs/',Dir,[relative_to(Value)]), atom_concat(Dir,'predicate_streams',PS), @@ -74,7 +75,7 @@ is_win64:- current_prolog_flag(windows,_). is_win64_ui:- is_win64,current_prolog_flag(hwnd,_). - +dont_change_streams:- true. :- dynamic(user:is_metta_src_dir/1). :- prolog_load_context(directory,Dir), @@ -128,15 +129,15 @@ :-dynamic(user:loaded_into_kb/2). :- dynamic(user:is_metta_dir/1). -once_writeq_ln(_):- \+ clause(pfcTraceExecution,true),!. -once_writeq_ln(P):- nb_current('$once_writeq_ln',W),W=@=P,!. -once_writeq_ln(P):- +once_writeq_nl(_):- \+ clause(pfcTraceExecution,true),!. +once_writeq_nl(P):- nb_current('$once_writeq_ln',W),W=@=P,!. +once_writeq_nl(P):- \+ \+ (numbervars(P,444,_,[attvar(skip),singletons(true)]), ansi_format([fg(cyan)],'~N~q.~n',[P])),nb_setval('$once_writeq_ln',P),!. % TODO uncomment this next line but it is breaking the curried chainer % pfcAdd_Now(P):- pfcAdd(P),!. -pfcAdd_Now(P):- current_predicate(pfcAdd/1),!, once_writeq_ln(pfcAdd(P)),pfcAdd(P). -pfcAdd_Now(P):- once_writeq_ln(asssert(P)),assert(P). +pfcAdd_Now(P):- current_predicate(pfcAdd/1),!, once_writeq_nl(pfcAdd(P)),pfcAdd(P). +pfcAdd_Now(P):- once_writeq_nl(asssert(P)),assert(P). %:- endif. system:copy_term_g(I,O):- ground(I),!,I=O. @@ -208,6 +209,7 @@ is_compatio0:- !. keep_output:- !. +keep_output:- dont_change_streams,!. keep_output:- is_win64,!. keep_output:- is_mettalog,!. keep_output:- is_testing,!. @@ -222,19 +224,22 @@ unnullify_output:- current_output(MFS), original_user_output(OUT), MFS==OUT, !. unnullify_output:- original_user_output(MFS), set_prolog_IO(user_input,MFS,user_error). +null_output(MFS):- dont_change_streams,!, original_user_output(MFS),!. null_output(MFS):- use_module(library(memfile)), new_memory_file(MF),open_memory_file(MF,append,MFS). +:- volatile(null_user_output/1). :- dynamic(null_user_output/1). :- null_user_output(_)->true;(null_output(MFS), asserta(null_user_output(MFS))). nullify_output:- keep_output,!. +nullify_output:- dont_change_streams,!. nullify_output:- nullify_output_really. nullify_output_really:- current_output(MFS), null_user_output(OUT), MFS==OUT, !. nullify_output_really:- null_user_output(MFS), set_prolog_IO(user_input,MFS,MFS). -%set_output_stream :- !. +set_output_stream :- dont_change_streams,!. set_output_stream :- \+ keep_output -> nullify_output; unnullify_output. :- set_output_stream. % :- nullify_output. @@ -408,10 +413,12 @@ % if_t( \+ TF , set_prolog_flag(debug_on_interrupt,true)), !. -fake_notrace(G):- tracing,!,notrace(G). +:- meta_predicate fake_notrace(0). +fake_notrace(G):- tracing,!,real_notrace(G). fake_notrace(G):- !,once(G). +% `quietly/1` allows breaking in and inspection (real `no_trace/1` does not) fake_notrace(G):- quietly(G),!. -real_notrace(Goal):-!,notrace(Goal). +:- meta_predicate real_notrace(0). real_notrace(Goal) :- setup_call_cleanup('$notrace'(Flags, SkipLevel), once(Goal), @@ -420,7 +427,7 @@ :- dynamic(is_answer_output_stream/2). answer_output(Stream):- is_testing,original_user_output(Stream),!. -answer_output(Stream):- !,original_user_output(Stream),!. +answer_output(Stream):- !,original_user_output(Stream),!. % yes, the cut is on purpose answer_output(Stream):- is_answer_output_stream(_,Stream),!. answer_output(Stream):- tmp_file('answers',File), open(File,write,Stream,[encoding(utf8)]), @@ -466,8 +473,9 @@ :- ensure_loaded(metta_utils). -:- ensure_loaded(metta_data). %:- ensure_loaded(mettalog('metta_ontology.pfc.pl')). +:- ensure_loaded(metta_pfc_base). +:- ensure_loaded(metta_pfc_support). :- ensure_loaded(metta_compiler). :- ensure_loaded(metta_convert). :- ensure_loaded(metta_types). @@ -476,159 +484,101 @@ :- set_is_unit_test(false). -% ============================ -% %%%% Arithmetic Operations -% ============================ - -'repr'( Atomx, String_metta ):- eval_H( [ repr, Atomx ], String_metta ). -'parse'( Strx, Atom_metta ):- eval_H( [ parse, Strx ], Atom_metta ). - -% Addition -%'+'(A, B, Sum):- \+ any_floats([A, B, Sum]),!,Sum #= A+B . -%'+'(A, B, Sum):- notrace(catch_err(plus(A, B, Sum),_,fail)),!. -'+'(A, B, Sum):- eval_H([+,A,B],Sum). -% Subtraction -'-'( A, B, Sum):- eval_H([-,A,B],Sum). -% Multiplication -'*'(A, B, Product):- eval_H([*,A,B],Product). -% Division -'/'(Dividend, Divisor, Quotient):- eval_H(['/',Dividend, Divisor], Quotient). %{Dividend = Quotient * Divisor}. -% Modulus -'mod'(Dividend, Divisor, Remainder):- eval_H(['mod',Dividend, Divisor], Remainder). -'%'(Dividend, Divisor, Remainder):- eval_H(['mod',Dividend, Divisor], Remainder). -% Exponentiation -'exp'(Base, Exponent, Result):- eval_H(['exp', Base, Exponent], Result). -% Square Root -'sqrt'(Number, Root):- eval_H(['sqrt', Number], Root). - -% 'substraction'( Lx1, Lx2 , Lx_intersct ):- !, eval_H( [ 'substraction', Lx1, Lx2 ], Lx_intersct ). - -% ============================ -% %%%% List Operations -% ============================ -% Retrieve Head of the List -'car-atom'(List, Head):- eval_H(['car-atom', List], Head). -% Retrieve Tail of the List -'cdr-atom'(List, Tail):- eval_H(['cdr-atom', List], Tail). -% Construct a List -'Cons'(Element, List, 'Cons'(Element, List)):- !. -% Collapse List -'collapse'(List, CollapsedList):- eval_H(['collapse', List], CollapsedList). -% Count Elements in List -%'CountElement'(List, Count):- eval_H(['CountElement', List], Count). -% Find Length of List -%'length'(List, Length):- eval_H(['length', List], Length). - -% ============================ -% %%%% Nondet Opteration -% ============================ -% Superpose a List -'superpose'(List, SuperposedList):- eval_H(['superpose', List], SuperposedList). - -% ============================ -% %%%% Testing -% ============================ - -% `assertEqual` Predicate -% This predicate is used for asserting that the Expected value is equal to the Actual value. -% Expected: The value that is expected. -% Actual: The value that is being checked against the Expected value. -% Result: The result of the evaluation of the equality. -% Example: `assertEqual(5, 5, Result).` would succeed, setting Result to true (or some success indicator). -%'assertEqual'(Expected, Actual, Result):- use_metta_compiler,!,as_tf((Expected=Actual),Result). -'assertEqual'(Expected, Actual, Result):- ignore(Expected=Actual), eval_H(['assertEqual', Expected, Actual], Result). - -% `assertEqualToResult` Predicate -% This predicate asserts that the Expected value is equal to the Result of evaluating Actual. -% Expected: The value that is expected. -% Actual: The expression whose evaluation is being checked against the Expected value. -% Result: The result of the evaluation of the equality. -% Example: If Actual evaluates to the Expected value, this would succeed, setting Result to true (or some success indicator). -'assertEqualToResult'(Expected, Actual, Result):- eval_H(['assertEqualToResult', Expected, Actual], Result). - -% `assertNotEqual` Predicate -% This predicate asserts that the Expected value is not equal to the Actual value. -% Expected: The value that is expected not to match the Actual value. -% Actual: The value that is being checked against the Expected value. -% Result: The result of the evaluation of the inequality. -% Example: `assertNotEqual(5, 6, Result).` would succeed, setting Result to true (or some success indicator). -'assertNotEqual'(Expected, Actual, Result):- eval_H(['assertNotEqual', Expected, Actual], Result). - - -% `assertFalse` Predicate -% This predicate is used to assert that the evaluation of EvalThis is false. -% EvalThis: The expression that is being evaluated and checked for falsehood. -% Result: The result of the evaluation. -% Example: `assertFalse((1 > 2), Result).` would fail, setting Result to False (or some success indicator), as 1 > 2 is false. -'assertFalse'(EvalThis, Result):- eval_H(['assertFalse', EvalThis], Result). - -% `assertTrue` Predicate -% This predicate is used to assert that the evaluation of EvalThis is true. -% EvalThis: The expression that is being evaluated and checked for truth. -% Result: The result of the evaluation. -% Example: `assertTrue((2 > 1), Result).` would succeed, setting Result to true (or some success indicator), as 2 > 1 is true. -'assertTrue'(EvalThis, Result):- eval_H(['assertTrue', EvalThis], Result). - -% `rtrace` Predicate -% This predicate is likely used for debugging; possibly for tracing the evaluation of Condition. -% Condition: The condition/expression being traced. -% EvalResult: The result of the evaluation of Condition. -% Example: `rtrace((2 + 2), EvalResult).` would trace the evaluation of 2 + 2 and store its result in EvalResult. -'rtrace!'(Condition, EvalResult):- eval_H(['rtrace', Condition], EvalResult). - -% `time` Predicate -% This predicate is used to measure the time taken to evaluate EvalThis. -% EvalThis: The expression whose evaluation time is being measured. -% EvalResult: The result of the evaluation of EvalThis. -% Example: `time((factorial(5)), EvalResult).` would measure the time taken to evaluate factorial(5) and store its result in EvalResult. -'time!'(EvalThis, EvalResult):- eval_H(['time', EvalThis], EvalResult). - -% ============================ -% %%%% Debugging, Printing and Utility Operations -% ============================ -% REPL Evaluation -'repl!'(EvalResult):- eval_H(['repl!'], EvalResult). -% Condition Evaluation -'!'(Condition, EvalResult):- eval_H(['!', Condition], EvalResult). -% Import File into Environment -'import!'(Environment, Filename, Namespace):- eval_H(['import!', Environment, Filename], Namespace). -% Evaluate Expression with Pragma -'pragma!'(Environment, Expression, EvalValue):- eval_H(['pragma!', Environment, Expression], EvalValue). -% Print Message to Console -'print'(Message, EvalResult):- eval_H(['print', Message], EvalResult). -% No Operation, Returns EvalResult unchanged -'nop'(Expression, EvalResult):- eval_H(['nop', Expression], EvalResult). - -% ============================ -% %%%% Variable Bindings -% ============================ -% Bind Variables -'bind!'(Environment, Variable, Value):- eval_H(['bind!', Environment, Variable], Value). -% Let binding for single variable -'let'(Variable, Expression, Body, Result):- eval_H(['let', Variable, Expression, Body], Result). -% Sequential let binding -'let*'(Bindings, Body, Result):- eval_H(['let*', Bindings, Body], Result). - -% ============================ -% %%%% Reflection -% ============================ -% Get Type of Value -'get-type'(Value, Type):- eval_H(['get-type', Value], Type). -% 'get-type-space'(Space, Value, Type):- eval_H(['get-type', Space, Value], Type). - - -% ============================ -% %%%% String Utilities -% ============================ -% conversion between String and List of Chars -'stringToChars'(String, Chars) :- eval_H(['stringToChars', String], Chars). -'charsToString'(Chars, String) :- eval_H(['charsToString', Chars], String). -'format-args'(Format, Args, Result) :- eval_H(['format-args', Format, Args], Result). - -% ============================ -% %%%% Random Utilities -% ============================ -'flip'(Bool) :- eval_H(['flip'], Bool). % see `flip` in metta_eval.pl as `eval_20/6` +extract_prolog_arity([Arrow|ParamTypes],PrologArity):- + Arrow == ('->'),!, + len_or_unbound(ParamTypes,PrologArity). + +add_prolog_code(_KB,AssertZIfNew):- + fbug(writeln(AssertZIfNew)), + assertz_if_new(AssertZIfNew). +gen_interp_stubs(KB,Symb,Def):- + ignore((is_list(Def), + must_det_ll(( + extract_prolog_arity(Def,PrologArity), + symbol(Symb), + symbol_concat('i_',Symb,Tramp), + length(PrologArgs,PrologArity), + append(MeTTaArgs,[RetVal],PrologArgs), + TrampH =.. [Tramp|PrologArgs], + add_prolog_code(KB, + (TrampH :- eval_H([Symb|MeTTaArgs], RetVal))))))). + +% 'int_fa_format-args'(FormatArgs, Result):- eval_H(['format-args'|FormatArgs], Result). +% 'ext_fa_format-args'([EFormat, EArgs], Result):- int_format-args'(EFormat, EArgs, Result) +/* + +'ext_format-args'(Shared,Format, Args, EResult):- + pred_in('format-args',Shared,3), + argn_in(1,Shared,Format,EFormat), + argn_in(2,Shared,Args,EArgs), + argn_in(3,Shared,EResult,Result), + int_format-args'(Shared,EFormat, EArgs, Result), + arg_out(1,Shared,EFormat,Format), + arg_out(2,Shared,EArgs,Args), + arg_out(3,Shared,Result,EResult). + + you are goign to create the clause based on the first 2 args + +?- gen_form_body('format-args',3, HrnClause). + +HrnClause = + ('ext_format-args'(Shared, Arg1, Arg2, EResult):- + pred_in('format-args',Shared,3), + argn_in(1,Shared,Arg1,EArg1), + argn_in(2,Shared,Arg2,EArg2), + argn_in(3,Shared,EResult,Result), + 'int_format-args'(Shared,EArg1, EArg2, Result), + arg_out(1,Shared,EArg1,Arg1), + arg_out(2,Shared,EArg2,Arg2), + arg_out(3,Shared,Result,EResult)). + +*/ + + + +% Helper to generate head of the clause +generate_head(Shared,Arity, FormName, Args, Head) :- + atom_concat('ext_', FormName, ExtFormName), + number_string(Arity, ArityStr), + atom_concat(ExtFormName, ArityStr, FinalFormName), % Append arity to form name for uniqueness + append([FinalFormName, Shared | Args], HeadArgs), + Head =.. HeadArgs. + +% Helper to generate body of the clause, swapping arguments +generate_body(Shared,Arity, FormName, Args, EArgs, Body) :- + atom_concat('int_', FormName, IntFormName), + number_string(Arity, ArityStr), + atom_concat(IntFormName, ArityStr, FinalIntFormName), % Append arity to internal form name for uniqueness + reverse(EArgs, ReversedEArgs), % Reverse the order of evaluated arguments for internal processing + % Generate predicates for input handling + findall(argn_in(Index, Shared, Arg, EArg), + (nth1(Index, Args, Arg), nth1(Index, EArgs, EArg)), ArgIns), + % Internal processing call with reversed arguments + append([Shared | ReversedEArgs], IntArgs), + InternalCall =.. [FinalIntFormName | IntArgs], + % Generate predicates for output handling + findall(arg_out(Index, Shared, EArg, Arg), + (nth1(Index, EArgs, EArg), nth1(Index, Args, Arg)), ArgOuts), + % Combine predicates + PredIn = pred_in(FormName, Shared, Arity), + append([PredIn | ArgIns], [InternalCall | ArgOuts], BodyParts), + list_to_conjunction(BodyParts, Body). + +% Main predicate to generate form body clause +gen_form_body(FormName, Arity, Clause) :- + length(Args,Arity), + length(EArgs,Arity), + generate_head(Shared,Arity, FormName, Args, Head), + generate_body(Shared,Arity, FormName, Args, EArgs, Body), + Clause = (Head :- Body). + + +% Helper to format atoms +format_atom(Format, N, Atom) :- format(atom(Atom), Format, [N]). + + +% 'int_format-args'(Shared,Format, Args, Result):- +% .... actual impl .... @@ -970,7 +920,7 @@ %rtrace_on_error(G):- catch(G,_,fail). rtrace_on_error(G):- catch_err(G,E, - (notrace, + (%notrace, write_src_uo(E=G), %catch(rtrace(G),E,throw(E)), catch(rtrace(G),E,throw(give_up(E=G))), @@ -982,7 +932,7 @@ ignore(rtrace(G)), write_src_uo(rtrace_on_failure(G)), !,fail)),E, - (notrace, + (%notrace, write_src_uo(E=G), %catch(rtrace(G),E,throw(E)), catch(rtrace(G),E,throw(give_up(E=G))), @@ -994,7 +944,7 @@ ignore(rtrace(G)), write_src(rtrace_on_failure(G)), !,break,fail)),E, - (notrace, + (%notrace, write_src_uo(E=G), %catch(rtrace(G),E,throw(E)), catch(rtrace(G),E,throw(give_up(E=G))), @@ -1051,7 +1001,6 @@ metta_atom_asserted_deduced(X,Y), \+ clause(metta_atom_asserted(X,Y),true). - %get_metta_atom(Eq,KB, [F|List]):- KB='&flybase',fb_pred(F, Len), length(List,Len),apply(F,List). @@ -1077,7 +1026,6 @@ metta_atom_asserted('&flybase','&corelib'). metta_atom_asserted('&catalog','&corelib'). metta_atom_asserted('&catalog','&stdlib'). -:- ensure_loaded(metta_corelib). /* 'mod-space'(top,'&self'). @@ -1672,7 +1620,7 @@ %if_t(is_compiled,ensure_mettalog_py), install_readline_editline, - nts, + %nts1, %install_ontology, metta_final, % ensure_corelib_types, @@ -1787,17 +1735,21 @@ :- ensure_loaded(metta_server). :- initialization(update_changed_files,restore). -nts:- !. -nts:- redefine_system_predicate(system:notrace/1), +nts1:- !. % disable redefinition +nts1:- redefine_system_predicate(system:notrace/1), + %listing(system:notrace/1), abolish(system:notrace/1), + dynamic(system:notrace/1), meta_predicate(system:notrace(0)), asserta((system:notrace(G):- (!,once(G)))). -nts:- !. +nts1:- !. + +:- nts1. nts0:- redefine_system_predicate(system:notrace/0), abolish(system:notrace/0), asserta((system:notrace:- wdmsg(notrace))). - +%:- nts0. override_portray:- forall( @@ -1833,6 +1785,7 @@ %:- ensure_loaded('../../library/genome/flybase_loader'). +:- ensure_loaded(metta_python). :- initialization(use_corelib_file). :- ignore((( @@ -1841,7 +1794,7 @@ set_is_unit_test(UNIT_TEST), \+ prolog_load_context(reloading,true), initialization(loon(restore),restore), - % nts, + % nts1, metta_final ))). diff --git a/.Attic/metta_lang/metta_loader.pl b/.Attic/metta_lang/metta_loader.pl index 483a6ff4a7b..dec81a69e0f 100755 --- a/.Attic/metta_lang/metta_loader.pl +++ b/.Attic/metta_lang/metta_loader.pl @@ -461,8 +461,6 @@ format(user_error,'~N; Done translating ~w forms: ~q.', [TF,asserted_metta_pred(MangleP2,Filename)]))). -write_src_woi(Term):- with_indents(false,write_src(Term)). - % write comments write_metta_datalog_term(Output,'$COMMENT'(Term,_,_),_MangleP2,_Lineno):- format(Output,"/* ~w */~n",[Term]). @@ -1151,3 +1149,22 @@ fail. % Continue looping until between/3 fails progress_bar_example. +:- dynamic(using_corelib_file/0). + + +use_corelib_file:- using_corelib_file,!. +use_corelib_file:- asserta(using_corelib_file), fail. +use_corelib_file:- load_corelib_file, generate_interpreter_stubs. + +generate_interpreter_stubs:- + forall(metta_type('&corelib',Symb,Def), + gen_interp_stubs('&corelib',Symb,Def)). + +load_corelib_file:- is_metta_src_dir(Dir), really_use_corelib_file(Dir,'corelib.metta'),!. +load_corelib_file:- is_metta_src_dir(Dir), really_use_corelib_file(Dir,'stdlib_mettalog.metta'),!. +% !(import! &corelib "src/canary/stdlib_mettalog.metta") +really_use_corelib_file(Dir,File):- absolute_file_name(File,Filename,[relative_to(Dir)]), + locally(nb_setval(may_use_fast_buffer,t), + locally(nb_setval(suspend_answers,true), + with_output_to(string(_),include_metta_directory_file('&corelib',Dir,Filename)))). + diff --git a/.Attic/metta_lang/metta_mizer.pl b/.Attic/metta_lang/metta_mizer.pl index e9dde743a4a..fdebabb4b28 100755 --- a/.Attic/metta_lang/metta_mizer.pl +++ b/.Attic/metta_lang/metta_mizer.pl @@ -316,6 +316,10 @@ did_optimize_conj(Head,B1,B2,B12), must_optimize_body(Head,(B12,B3),BN),!. %optimize_conjuncts(Head,(B1,B2),BN1):- optimize_conj(Head,B1,B2,BN1). + + + + optimize_conjuncts(Head,(B1,B2),BN1):- did_optimize_conj(Head,B1,B2,BN1),!. optimize_conjuncts(Head,(B1*->B2),(BN1*->BN2)):- !, optimize_conjuncts(Head,B1,BN1), diff --git a/.Attic/metta_lang/metta_ontology.pl.pfc b/.Attic/metta_lang/metta_ontology.pl.pfc deleted file mode 100755 index aa50e924f46..00000000000 --- a/.Attic/metta_lang/metta_ontology.pl.pfc +++ /dev/null @@ -1,35 +0,0 @@ - - -% enforce the relation between functions snf predicates -p_arity('NullaryPredicate', 0). -p_arity('UnaryPredicate', 1). -p_arity('BinaryPredicate', 2). -p_arity('TernaryPredicate', 3). -p_arity('QuaternaryPredicate', 4). -p_arity('QuinaryPredicate', 5). -p_arity('SenaryPredicate', 6). -p_arity('SeptenaryPredicate', 7). -p_arity('OctaryPredicate', 8). -p_arity('NonaryPredicate', 9). -p_arity('DenaryPredicate', 10). - -f_arity('NullaryFunction', 0). -f_arity('UnaryFunction', 1). -f_arity('BinaryFunction', 2). -f_arity('TernaryFunction', 3). -f_arity('QuaternaryFunction', 4). -f_arity('QuinaryFunction', 5). -f_arity('SenaryFunction', 6). -f_arity('SeptenaryFunction', 7). -f_arity('OctaryFunction', 8). -f_arity('NonaryFunction', 9). - -% Equivalent Types use this rule to spedifiy and enforce that they have the same instances as the other -(equivalentTypes(PredType,FunctType) ==> - (in(FunctorObject,PredType) - <==> - in(FunctorObject,FunctType))). - -% generate some equivalency rules -((p_arity(PredType,PA), plus(FA,1,PA), f_arity(FunctType,FA))) - ==> equivalentTypes(PredType,FunctType). diff --git a/.Attic/metta_lang/metta_ontology.pl.pfc2 b/.Attic/metta_lang/metta_ontology.pl.pfc2 deleted file mode 100755 index c272a58bedd..00000000000 --- a/.Attic/metta_lang/metta_ontology.pl.pfc2 +++ /dev/null @@ -1,684 +0,0 @@ -% Predicate and Function Arity Definitions: -% Specifies the number of arguments (arity) for predicates and functions, which is fundamental -% for understanding the complexity and capabilities of various logical constructs. Predicates are defined -% from Nullary (no arguments) up to Denary (ten arguments), reflecting a range of logical conditions or assertions. -% Functions are similarly defined but focus on operations that return a value, extending up to Nonary (nine arguments). -p_arity('NullaryPredicate', 0). % No arguments. -p_arity('UnaryPredicate', 1). % One argument. -p_arity('BinaryPredicate', 2). % Two arguments. -p_arity('TernaryPredicate', 3). % Three arguments, and so on. -p_arity('QuaternaryPredicate', 4). -p_arity('QuinaryPredicate', 5). -p_arity('SenaryPredicate', 6). -p_arity('SeptenaryPredicate', 7). -p_arity('OctaryPredicate', 8). -p_arity('NonaryPredicate', 9). -p_arity('DenaryPredicate', 10). - -f_arity('NullaryFunction', 0). % No return value, essentially a procedure. -f_arity('UnaryFunction', 1). % Returns a single value, and so on. -f_arity('BinaryFunction', 2). -f_arity('TernaryFunction', 3). -f_arity('QuaternaryFunction', 4). -f_arity('QuinaryFunction', 5). -f_arity('SenaryFunction', 6). -f_arity('SeptenaryFunction', 7). -f_arity('OctaryFunction', 8). -f_arity('NonaryFunction', 9). - -% Enforcing Equivalency Between Predicates and Functions: -% Establishes a logical framework to equate the conceptual roles of predicates and functions based on arity. -% This equivalence bridges the functional programming and logical (declarative) paradigms within Prolog, -% allowing a unified approach to defining operations and assertions. -(equivalentTypes(PredType,FunctType) ==> - (in(FunctorObject,PredType) - <==> - in(FunctorObject,FunctType))). - -% Automatically generating equivalency rules based on the arity of predicates and functions. -% This facilitates a dynamic and flexible understanding of function and predicate equivalences, -% enhancing Prolog's expressive power and semantic richness. -((p_arity(PredType,PA), plus(FA,1,PA), f_arity(FunctType,FA))) - ==> equivalentTypes(PredType,FunctType). - -% Detailed Property Associations: -% These associations define and categorize the functionalities and capabilities of various programming constructs. -% The categorization aids in the intuitive understanding and systematic analysis of different programming elements, -% making the logical structure and execution flow of programs more comprehensible. - -% Flow Control Structures: -% Control structures are essential for directing the execution flow of a program. They enable conditional execution, -% looping, and choice between different paths of execution based on logical conditions or external inputs. -property('if', flow_control). % Conditional execution based on a boolean expression. -property('case', flow_control). % Choice between multiple paths. -property('let', flow_control). % Variable binding in a local scope. -property('let*', flow_control). % Sequential variable binding with dependency. -property('do', flow_control). % Executes a block of code. -property('limit', flow_control_modification). % Limits the number of solutions. -property('offset', flow_control_modification). % Skips a number of solutions. -property('max-time', execution_time_control). % Limits execution time. - -% Inferring backtracking behavior in flow control structures. This indicates that certain paths -% of execution might lead to backtracking, a core concept in Prolog for exploring alternative solutions. -property(P, flow_control) ==> property(P, 'OnFailBacktrack'). - -% Assertions and Testing Mechanisms: -% Assertions provide a powerful tool for validating expected conditions or outcomes within a program. -% They are critical for debugging and verifying the correctness of logic under various conditions. -property('assertTrue', assertions_testing). % Asserts a condition is true. -property('assertFalse', assertions_testing). % Asserts a condition is false. -property('assertEqual', assertions_testing). % Asserts equality between two values. -property('assertNotEqual', assertions_testing). % Asserts inequality. -property('assertEqualToResult', assertions_testing). % Asserts a value equals an expected result. - -% Asserting deterministic outcomes for testing mechanisms. These properties ensure that assertions -% yield predictable, binary outcomes (pass or fail) based on the conditions they test. -property(P, assertions_testing) ==> property(P, 'Deterministic'). - -% Special Operators and System Interaction: -% Special operators and functionalities enhance Prolog's interaction with its execution environment and system, -% enabling dynamic control flows, system-level operations, and interaction with external processes or data. -property('!', special_operators). % Cut operator, controls backtracking. -property('call!', special_operators). % Dynamically calls a predicate. -property('call-fn!', special_operators). % Calls a function dynamically. -property('repl!', system_interaction). % Interactive read-eval-print loop. -property('pyr!', special_operators). % Example of an extension or plugin call. -property('call-cleanup!', resource_management). % Ensures cleanup after execution. -property('setup-call-cleanup!', resource_management). % Setup, call, and cleanup pattern. -property('with-output-to!', output_redirection). % Redirects output to a different stream. - -% Deterministic behavior is noted for operations that have predictable outcomes, -% while nondeterministic behavior is acknowledged for operations whose results may vary. -property('call!', 'Deterministic'). -property('call-fn!', 'Nondeterministic'). -property('!', 'Deterministic'). - -% Data Structures and Manipulation: -% The definition, organization, and manipulation of data structures are foundational aspects of programming. -% These operations facilitate the storage, retrieval, and modification of data in structured forms. -property('Cons', data_structures). % Constructs a pair or list. -property('collapse', data_manipulation). % Flattens nested structures. -property('superpose', data_manipulation). % Overlays data structures. -property('sequential', data_manipulation). % Ensures sequential execution. -property('TupleConcat', data_structures). % Concatenates tuples. - -% Operations on data structures are generally deterministic, yielding predictable outcomes based on the inputs and operations. -property(P, data_manipulation) ==> property(P, 'Deterministic'). - -% This comprehensive reorganization and enhancement of comments provide a deeper, structured insight into the -% properties and functionalities within a Prolog-like environment, aiming for clarity and enriched understanding. - -% Associating properties with atoms for detailed understanding and querying -% --- Flow Control Structures --- -% These properties define the various control flow mechanisms used in programming, -% including conditionals, loops, and explicit control statements. They are fundamental -% to directing the execution flow of programs. -property('if', flow_control). -property('case', flow_control). -property('let', flow_control). -property('let*', flow_control). -property('do', flow_control). -property('limit', flow_control_modification). -property('offset', flow_control_modification). -property('max-time', execution_time_control). -% Flow control structures might involve backtracking on failure, providing multiple paths for execution. -property(P, flow_control) ==> property(P, 'OnFailBacktrack'). - -% --- Assertions and Testing Mechanisms --- -% Assertions are used to validate conditions at runtime. They are essential for testing, -% allowing developers to ensure that their code behaves as expected under various conditions. -property('assertTrue', assertions_testing). -property('assertFalse', assertions_testing). -property('assertEqual', assertions_testing). -property('assertNotEqual', assertions_testing). -property('assertEqualToResult', assertions_testing). -% By nature, assertions yield a deterministic outcome (true or false) based on the given condition. -property(P, assertions_testing) ==> property(P, 'Deterministic'). - -% --- Special Operators and System Interaction --- -% This category encompasses operators and functions that provide unique or enhanced -% functionalities, including system interactions and resource management. -property('!', special_operators). -property('call!', special_operators). -property('call-fn!', special_operators). -property('repl!', system_interaction). -property('pyr!', special_operators). -property('call-cleanup!', resource_management). -property('setup-call-cleanup!', resource_management). -property('with-output-to!', output_redirection). -% Certain operators like 'call!' exhibit deterministic behavior by executing a given goal. -property('call!', 'Deterministic'). -% Others, like 'call-fn!', might produce different results under different conditions, hence considered nondeterministic. -property('call-fn!', 'Nondeterministic'). -% The cut operator '!' is deterministic as it decisively affects control flow by preventing backtracking beyond its point of execution. -property('!', 'Deterministic'). - -% --- Data Structures and Manipulation --- -% Data structures such as lists, trees, and graphs are crucial for organizing and storing data. -% Manipulation includes operations like constructing, modifying, or querying these structures. -property('Cons', data_structures). -property('collapse', data_manipulation). -property('superpose', data_manipulation). -property('sequential', data_manipulation). -property('TupleConcat', data_structures). -% Operations on data structures typically result in deterministic outcomes, producing predictable modifications or constructions. -property(P, data_manipulation) ==> property(P, 'Deterministic'). - -% --- Evaluation and Execution --- -% Evaluation and execution properties pertain to how expressions, commands, or functions are processed and run. -% This includes interpreting code, printing output, and compiling expressions. -property('eval', evaluation_execution). -property('eval-for', evaluation_execution). -property('echo', evaluation_execution). -property('print', evaluation_execution). -property('println!', evaluation_execution). -property('compile-easy!', evaluation_execution). -property('time!', evaluation_execution). -% The 'eval' operation could lead to different outcomes based on the input, thus considered nondeterministic. -property('eval', 'Nondeterministic'). -% Conversely, 'echo' simply reflects its input without alteration, making it deterministic. -property('echo', 'Deterministic'). - -% --- Logic and Comparison --- -% Logical and comparison operations are fundamental in programming, enabling decision making -% and data comparison. This includes basic logical operations and comparisons between values. -property('and', logic_comparison). -property('or', logic_comparison). -property('not', logic_comparison). -% Logical operations result in deterministic outcomes, directly derived from their input values. -property(P, logic_comparison) ==> property(P, 'Deterministic'). - -% --- Additional and Miscellaneous --- -% This section covers a variety of functionalities not classified under the previous categories. -% It includes system interaction, functional programming utilities, arithmetic operations, -% and more, providing a wide range of capabilities. -property('atom-replace', data_manipulation). -property('fb-member', list_operations). -property('nop', control_structure). -property('empty', data_validation). -property('function', functional_programming). -property('return', functional_programming). -property('number-of', quantitative_analysis). -property('new-space', system_interaction). -property('bind!', system_interaction). -property('pragma!', system_interaction). -property('transfer!', system_interaction). -property('registered-python-function', interlanguage_integration). -property('S', symbolic_arithmetic). -property('Z', symbolic_arithmetic). -property('bc-base', recursion_control). -property('bc-base-ground', recursion_control). -property('bc-rec', recursion_control). - -% --- Rules for Automatic Property Inference --- -% These rules allow for automatic inference of certain properties based on categories, -% simplifying the property assignment process and ensuring consistency. -property('function', 'VariableArity'). -property('return', 'Deterministic'). -property(P, system_interaction) ==> property(P, 'Deterministic'). -property('fb-member', 'Nondeterministic'). -property(P, symbolic_arithmetic) ==> property(P, 'Deterministic'). -property(P, recursion_control) ==> property(P, 'Deterministic'). -property('bc-rec', 'Nondeterministic'). - -% This detailed commenting approach provides insights into the rationale behind each property assignment, -% facilitating a better understanding of their roles within the system and their implications on program behavior. - - - - -% Flow control structures indicate branching and looping mechanisms -property('!', special_operators). -property('if', flow_control). -property('case', flow_control). -property('let', flow_control). -property('let*', flow_control). -% 'if' can lead to different execution paths and might be considered nondeterministic -property('if', 'Nondeterministic'). - -property(X, flow_control) ==> property(X, 'OnFailBacktrack'). - -% Assertions and testing mechanisms for validating conditions or values -property('assertTrue', assertions_testing). -property('assertFalse', assertions_testing). -property('assertEqual', assertions_testing). -% Assertions typically produce a deterministic outcome based on their condition -property('assertTrue', 'Deterministic'). -property('assertFalse', 'Deterministic'). -property('assertEqual', 'Deterministic'). -% Mapping success/failure in Prolog to True/False for assertions -property('assertTrue', 'BooleanFunction'). -property('assertFalse', 'BooleanFunction'). - -% Special operators offer unique or enhanced functionality -property('pyr!', special_operators). -property('call!', special_operators). -property('call-fn!', special_operators). -% 'call!' has a deterministic behavior, executing a given goal -property('call!', 'Deterministic'). -% 'call-fn!' may produce different results, hence nondeterministic -property('call-fn!', 'Nondeterministic'). -% '!' (cut) decisively affects the control flow by preventing backtracking -property('!', 'Deterministic'). - -% Data structures and manipulation involve creating and working with compound data -property('Cons', data_structures). -% These operations are typically deterministic, producing a predictable structure -property('Cons', 'Deterministic'). - -property('collapse', 'Deterministic'). -property('collapse', flow_control). - -% Evaluation and execution concern the processing and running of code or expressions -property('eval', evaluation_execution). -property('echo', evaluation_execution). -% 'eval' might evaluate to different outcomes based on its input, thus nondeterministic -property('eval', 'Nondeterministic'). -% 'echo', simply reflecting its input, is deterministic -property('echo', 'Deterministic'). - -% Logic and comparison for logical operations and value comparisons -property('and', logic_comparison). -property('or', logic_comparison). -property('not', logic_comparison). -% Logical operations are deterministic, with outcomes directly derived from their inputs -% however they may be consuming a set of nondeterimiistic values so they might "appear" as nondeterministic -property('and', 'Deterministic'). -property('or', 'Deterministic'). -property('not', 'Deterministic'). - -% General properties provide additional characteristics and behaviors -% 'eval' is interpreted, running without prior compilation -property('eval', 'Interpreted'). -% 'eval-for' also is interpreted due to its dynamic nature -property('eval-for', 'Interpreted'). -% 'echo' might be considered compiled for efficiency in this hypothetical scenario -property('echo', 'Compiled'). -% 'let' directly transpiles into another form without modification -property('let', 'DirectTranspilation'). -% Arity specifics for 'let' and 'call!' -property('let', 'PredicateArity', 3). -property('call!', 'FunctionArity', 2). -% Demonstrating variable arity for 'echo' -property('echo', 'VariableArity', 1, 3). -% 'coerce' forces argument types, ensuring compatibility -property('coerce', 'CoerceArgsToTypes'). -% 'coerce' has a predictable outcome, thus deterministic -property('coerce', 'Deterministic'). -% 'quote' prevents evaluation, returning the input as is -property('quote', 'EvalNoArgs'). -% 'quote' acts as a data functor, encapsulating values -property('quote', 'DataFunctor'). -% Default behavior for 'eval' to return self on failure, ensuring robustness -property('eval', 'OnFailBacktrack'). -% 'let*' supports typed predicates, enhancing type safety -property('let*', 'TypedPred'). -% Expanding to all mentioned properties and their hypothetical applications -% 'quote' represents nondeterminism in this context -property('quote', 'Nondeterministic'). -% 'echo' involves direct transpilation for simplicity -property('echo', 'DirectTranspilation'). -% Assuming 'coerce' is compiled for performance reasons -property('coerce', 'Compiled'). -% 'eval-for' returns the Nth argument, demonstrating specific argument selection -property('eval-for', 'ReturnNthArg'). -% Skipping evaluation for 'quote', focusing on raw data handling -property('quote', 'EvalNoArgs'). -% The cut operator '!' is interpreted, directly influencing the Prolog execution flow -property('!', 'FunInterpreted'). -% 'call!' is compiled, optimizing its execution -property('call!', 'FunCompiled'). -% 'let*' undergoes idiomatic transpilation, preserving the original logic's essence -property('let*', 'IdiomaticTranspilation'). -% Introducing 'case' with the behavior to backtrack on failure, facilitating alternative solutions -property('case', 'OnFailBacktrack'). - -% --- Evaluation and Execution Enhancements --- -% These properties are related to advanced evaluation and execution features, such as dynamic evaluation -% of expressions and runtime execution control. They enable more flexible and powerful programming patterns. -property('car-atom', evaluation_execution_enhancements). -property('cdr-atom', evaluation_execution_enhancements). -% 'car-atom' and 'cdr-atom' allow for manipulation of list structures at runtime, typically in a deterministic manner. -property(P, evaluation_execution_enhancements) ==> property(P, 'Deterministic'). - -% --- Functional Programming Constructs and Utilities --- -% Functional programming is characterized by the use of functions as first-class citizens, -% promoting a declarative programming style and higher-order functions. -property('maplist!', functional_programming). -property('concurrent-maplist!', functional_programming). -% 'maplist!' applies a function to each element in a list deterministically, whereas -% 'concurrent-maplist!' might introduce nondeterminism due to concurrent execution. -property('maplist!', 'Deterministic'). -property('concurrent-maplist!', 'Nondeterministic'). - -% --- Arithmetic and Logical Operations --- -% Arithmetic operations form the basis of mathematical computations in programming, -% including basic operations like addition, subtraction, multiplication, and division. -property('+', arithmetic_operations). -property('-', arithmetic_operations). -property('*', arithmetic_operations). -property('mod', arithmetic_operations). -% These operations are deterministic, yielding specific results from given numeric inputs. -property(P, arithmetic_operations) ==> property(P, 'Deterministic'). - -% --- Error Handling and Advanced Control Flow Mechanisms --- -% Proper error handling is crucial for robust programs, allowing for graceful recovery -% from unexpected states or inputs. Advanced control flow mechanisms provide more complex -% patterns of execution beyond simple conditional checks and loops. -property('catch', error_handling_advanced). -property('throw', error_handling_advanced). -% Error handling operations like 'catch' and 'throw' can influence the control flow based on runtime conditions, -% potentially introducing nondeterminism if the error states or exceptions are not predictable. -property('catch', 'Nondeterministic'). -property('throw', 'Nondeterministic'). - -% --- System Interaction and Interlanguage Integration --- -% Interacting with the system or integrating with other programming languages extends the capabilities -% of Prolog programs, enabling them to leverage external libraries, systems, or frameworks. -property('call-string!', system_interaction). -% 'call-string!' allows for dynamic execution of Prolog code provided as a string, -% which might be nondeterministic depending on the runtime environment and the code being executed. -property('call-string!', 'Nondeterministic'). -property('registered-python-function', interlanguage_integration). -% Registering and invoking Python functions from Prolog illustrates interlanguage integration, -% enabling deterministic interoperability with Python codebases. -property('registered-python-function', 'Deterministic'). - -% --- Symbolic Arithmetic and Recursion Control --- -% Symbolic arithmetic involves the representation and manipulation of mathematical expressions in symbolic form. -% Recursion control is crucial for defining and managing recursive operations, ensuring termination and efficiency. -property('S', symbolic_arithmetic). -property('Z', symbolic_arithmetic). -property('bc-base', recursion_control). -property('bc-base-ground', recursion_control). -property('bc-rec', recursion_control). -% Symbolic arithmetic operations are deterministic, as they follow defined mathematical properties. -property(P, symbolic_arithmetic) ==> property(P, 'Deterministic'). -% Base cases in recursion are deterministic, ensuring predictable behavior and termination of recursive calls. -property('bc-base', 'Deterministic'). -property('bc-base-ground', 'Deterministic'). -% Recursive operations may introduce nondeterminism, especially when dealing with complex or dynamic data structures. -property('bc-rec', 'Nondeterministic'). - -% This continued explanation and categorization provide a deeper understanding of the properties, -% emphasizing the relationship between programming constructs and their expected behaviors in a logical or functional programming context. -% --- List Operations and Data Validation --- -% Operations on lists and validation of data are fundamental in many programming tasks, -% allowing for the manipulation, examination, and assurance of data integrity. -property('fb-member', list_operations). -property('nop', control_structure). -property('empty', data_validation). -% 'fb-member' checks for membership in a list, which could have nondeterministic outcomes based on list contents. -property('fb-member', 'Nondeterministic'). -% 'nop' represents a no-operation, effectively serving as a placeholder or for timing. -property('nop', 'Deterministic'). -% 'empty' checks for or represents an empty structure or condition, a deterministic operation. -property('empty', 'Deterministic'). - -% --- Resource Management and Output Redirection --- -% Managing resources effectively and redirecting output are crucial for creating efficient, -% responsive programs and for controlling how and where information is displayed or logged. -property('call-cleanup!', resource_management). -property('setup-call-cleanup!', resource_management). -property('with-output-to!', output_redirection). -% These operations ensure deterministic management of resources and output, -% following precise specifications for behavior. -property('call-cleanup!', 'Deterministic'). -property('setup-call-cleanup!', 'Deterministic'). -property('with-output-to!', 'Deterministic'). - -% --- Quantitative Analysis and Symbolic Representation --- -% Quantitative analysis involves operations that measure or quantify aspects of data, -% while symbolic representation deals with abstract symbols rather than explicit values. -property('number-of', quantitative_analysis). -property('S', symbolic_arithmetic). -property('Z', symbolic_arithmetic). -% 'number-of' provides a count or measure, yielding deterministic results. -property('number-of', 'Deterministic'). -% 'S' (successor) and 'Z' (zero) are used in Peano arithmetic, representing numbers symbolically. -property('S', 'Deterministic'). -property('Z', 'Deterministic'). - -% --- Recursion Control and Interlanguage Integration --- -% Recursion control is essential for managing recursive algorithms, while interlanguage integration -% allows Prolog to interact with and leverage capabilities from other programming languages. -property('bc-base', recursion_control). -property('bc-base-ground', recursion_control). -property('bc-rec', recursion_control). -property('registered-python-function', interlanguage_integration). -% Base cases in recursion ('bc-base', 'bc-base-ground') ensure predictable termination of recursive calls. -property('bc-base', 'Deterministic'). -property('bc-base-ground', 'Deterministic'). -% Recursive operations ('bc-rec') may introduce complexity, affecting determinism based on data structure and depth. -property('bc-rec', 'Nondeterministic'). -% Integration with Python ('registered-python-function') demonstrates deterministic interoperability. -property('registered-python-function', 'Deterministic'). - -% --- Enhanced System Interaction and Dynamic Execution --- -% Dynamic execution features and enhanced system interaction capabilities extend Prolog's utility, -% enabling runtime evaluation of code and interaction with the system or external environments. -property('call-string!', system_interaction). -% 'call-string!' executes Prolog code provided as a string, potentially introducing nondeterminism -% based on the dynamic nature of the executed code and external state. -property('call-string!', 'Nondeterministic'). - -% This further continuation not only enriches the documentation with detailed explanations of each property and its implications but also -% fosters a deeper understanding of the sophisticated capabilities within a Prolog environment. Through these verbose commentaries, -% the nuanced behaviors and functionalities of programming constructs are elucidated, offering insights into their practical applications and theoretical foundations. -% --- Dynamic Code Evaluation and Modification --- -% Dynamic code evaluation and modification allow for runtime interpretation and alteration of code, -% offering flexibility for adaptive or responsive programming patterns. -property('eval', dynamic_evaluation). -% 'eval' allows for the execution of dynamically constructed code, which could lead to nondeterministic outcomes -% depending on the runtime environment and input data. -property('eval', 'Nondeterministic'). - -% --- Interactivity and Debugging Tools --- -% Tools and functionalities that facilitate interactivity with the user or debugging capabilities -% enhance the development experience by providing insights into program execution and allowing for real-time interaction. -property('trace!', debugging_tools). -property('notrace!', debugging_tools). -property('rtrace!', debugging_tools). -% Debugging commands like 'trace!', 'notrace!', and 'rtrace!' offer deterministic control over tracing and debugging states, -% allowing developers to enable or disable debugging modes as needed. -property(P, debugging_tools) ==> property(P, 'Deterministic'). - -% --- Advanced List Operations and Utilities --- -% Advanced operations on lists and utility functions provide powerful mechanisms for data manipulation and analysis, -% extending the core capabilities for handling lists and collections. -property('dedup!', list_utilities). -% 'dedup!' removes duplicate elements from a list, providing a deterministic way to ensure unique elements. -property('dedup!', 'Deterministic'). - -% --- Arithmetic and Logic Enhancements --- -% Enhancements to arithmetic and logic functionalities support more complex mathematical operations and logical reasoning, -% broadening the scope of computational tasks that can be addressed. -property('hyperpose', arithmetic_enhancements). -% 'hyperpose' could be involved in advanced arithmetic or matrix operations, assumed to be deterministic -% for well-defined mathematical transformations. -property('hyperpose', 'Deterministic'). - -% --- Functional Programming Enhancements --- -% Enhancements and utilities for functional programming emphasize the use of functions as first-class citizens, -% promoting immutability, statelessness, and higher-order functions for more declarative programming approaches. -property('maplist!', functional_enhancements). -% 'maplist!' applies a function to each element of a list in a deterministic manner, preserving list structure. -property('maplist!', 'Deterministic'). - -% --- System and External Integration --- -% System integration and functionalities that enable external integrations extend the capabilities of Prolog -% to interact with operating systems, external libraries, or other programming languages. -property('call-string!', external_integration). -% 'call-string!' dynamically evaluates a string of Prolog code, potentially incorporating external state or data, -% which may introduce nondeterminism depending on the specific usage and external dependencies. -property('call-string!', 'Nondeterministic'). - -property('!', 'FunInterpreted'). -property('!', special_operators). -property('!', special_operators). % Cut operator, controls backtracking. -property('*', arithmetic_operations). -property('+', arithmetic_operations). -property('-', arithmetic_operations). -property('Cons', 'Deterministic'). -property('Cons', data_structures). -property('Cons', data_structures). % Constructs a pair or list. -property('S', 'Deterministic'). -property('S', symbolic_arithmetic). -property('TupleConcat', data_structures). -property('TupleConcat', data_structures). % Concatenates tuples. -property('Z', 'Deterministic'). -property('Z', symbolic_arithmetic). -property('and', 'Deterministic'). -property('and', logic_comparison). -property('assertEqual', 'Deterministic'). -property('assertEqual', assertions_testing). -property('assertEqual', assertions_testing). % Asserts equality between two values. -property('assertEqualToResult', assertions_testing). -property('assertEqualToResult', assertions_testing). % Asserts a value equals an expected result. -property('assertFalse', 'BooleanFunction'). -property('assertFalse', 'Deterministic'). -property('assertFalse', assertions_testing). -property('assertFalse', assertions_testing). % Asserts a condition is false. -property('assertNotEqual', assertions_testing). -property('assertNotEqual', assertions_testing). % Asserts inequality. -property('assertTrue', 'BooleanFunction'). -property('assertTrue', 'Deterministic'). -property('assertTrue', assertions_testing). -property('assertTrue', assertions_testing). % Asserts a condition is true. -property('atom-replace', data_manipulation). -property('bc-base', 'Deterministic'). -property('bc-base', recursion_control). -property('bc-base-ground', 'Deterministic'). -property('bc-base-ground', recursion_control). -property('bc-rec', 'Nondeterministic'). -property('bc-rec', recursion_control). -property('bind!', system_interaction). -property('call!', 'Deterministic'). -property('call!', 'FunCompiled'). -property('call!', 'FunctionArity', 2). -property('call!', special_operators). -property('call!', special_operators). % Dynamically calls a predicate. -property('call-cleanup!', 'Deterministic'). -property('call-cleanup!', resource_management). -property('call-cleanup!', resource_management). % Ensures cleanup after execution. -property('call-fn!', 'Nondeterministic'). -property('call-fn!', special_operators). -property('call-fn!', special_operators). % Calls a function dynamically. -property('call-string!', 'Nondeterministic'). -property('call-string!', external_integration). -property('call-string!', system_interaction). -property('car-atom', evaluation_execution_enhancements). -property('case', 'OnFailBacktrack'). -property('case', flow_control). -property('case', flow_control). % Choice between multiple paths. -property('catch', 'Nondeterministic'). -property('catch', error_handling_advanced). -property('cdr-atom', evaluation_execution_enhancements). -property('coerce', 'CoerceArgsToTypes'). -property('coerce', 'Compiled'). -property('coerce', 'Deterministic'). -property('collapse', 'Deterministic'). -property('collapse', data_manipulation). -property('collapse', data_manipulation). % Flattens nested structures. -property('collapse', flow_control). -property('compile-easy!', evaluation_execution). -property('concurrent-maplist!', 'Nondeterministic'). -property('concurrent-maplist!', functional_programming). -property('dedup!', 'Deterministic'). -property('dedup!', list_utilities). -property('do', flow_control). -property('do', flow_control). % Executes a block of code. -property('echo', 'Compiled'). -property('echo', 'Deterministic'). -property('echo', 'DirectTranspilation'). -property('echo', 'VariableArity', 1, 3). -property('echo', evaluation_execution). -property('empty', 'Deterministic'). -property('empty', data_validation). -property('eval', 'Interpreted'). -property('eval', 'Nondeterministic'). -property('eval', 'OnFailBacktrack'). -property('eval', dynamic_evaluation). -property('eval', evaluation_execution). -property('eval-for', 'Interpreted'). -property('eval-for', 'ReturnNthArg'). -property('eval-for', evaluation_execution). -property('fb-member', 'Nondeterministic'). -property('fb-member', list_operations). -property('function', 'VariableArity'). -property('function', functional_programming). -property('hyperpose', 'Deterministic'). -property('hyperpose', arithmetic_enhancements). -property('if', 'Nondeterministic'). -property('if', flow_control). -property('if', flow_control). % Conditional execution based on a boolean expression. -property('let', 'DirectTranspilation'). -property('let', 'PredicateArity', 3). -property('let', flow_control). -property('let', flow_control). % Variable binding in a local scope. -property('let*', 'IdiomaticTranspilation'). -property('let*', 'TypedPred'). -property('let*', flow_control). -property('let*', flow_control). % Sequential variable binding with dependency. -property('limit', flow_control_modification). -property('limit', flow_control_modification). % Limits the number of solutions. -property('maplist!', 'Deterministic'). -property('maplist!', functional_enhancements). -property('maplist!', functional_programming). -property('max-time', execution_time_control). -property('max-time', execution_time_control). % Limits execution time. -property('mod', arithmetic_operations). -property('new-space', system_interaction). -property('nop', 'Deterministic'). -property('nop', control_structure). -property('not', 'Deterministic'). -property('not', logic_comparison). -property('notrace!', debugging_tools). -property('number-of', 'Deterministic'). -property('number-of', quantitative_analysis). -property('offset', flow_control_modification). -property('offset', flow_control_modification). % Skips a number of solutions. -property('or', 'Deterministic'). -property('or', logic_comparison). -property('pragma!', system_interaction). -property('print', evaluation_execution). -property('println!', evaluation_execution). -property('pyr!', special_operators). -property('pyr!', special_operators). % Example of an extension or plugin call. -property('quote', 'DataFunctor'). -property('quote', 'EvalNoArgs'). -property('quote', 'Nondeterministic'). -property('registered-python-function', 'Deterministic'). -property('registered-python-function', interlanguage_integration). -property('repl!', system_interaction). -property('repl!', system_interaction). % Interactive read-eval-print loop. -property('return', 'Deterministic'). -property('return', functional_programming). -property('rtrace!', debugging_tools). -property('sequential', data_manipulation). -property('sequential', data_manipulation). % Ensures sequential execution. -property('setup-call-cleanup!', 'Deterministic'). -property('setup-call-cleanup!', resource_management). -property('setup-call-cleanup!', resource_management). % Setup, call, and cleanup pattern. -property('superpose', data_manipulation). -property('superpose', data_manipulation). % Overlays data structures. -property('throw', 'Nondeterministic'). -property('throw', error_handling_advanced). -property('time!', evaluation_execution). -property('trace!', debugging_tools). -property('transfer!', system_interaction). -property('with-output-to!', 'Deterministic'). -property('with-output-to!', output_redirection). -property('with-output-to!', output_redirection). % Redirects output to a different stream. -property(P, arithmetic_operations) ==> property(P, 'Deterministic'). -property(P, assertions_testing) ==> property(P, 'Deterministic'). -property(P, data_manipulation) ==> property(P, 'Deterministic'). -property(P, debugging_tools) ==> property(P, 'Deterministic'). -property(P, evaluation_execution_enhancements) ==> property(P, 'Deterministic'). -property(P, flow_control) ==> property(P, 'OnFailBacktrack'). -property(P, logic_comparison) ==> property(P, 'Deterministic'). -property(P, recursion_control) ==> property(P, 'Deterministic'). -property(P, symbolic_arithmetic) ==> property(P, 'Deterministic'). -property(P, system_interaction) ==> property(P, 'Deterministic'). -property(X, flow_control) ==> property(X, 'OnFailBacktrack'). - diff --git a/.Attic/metta_lang/metta_ontology.pl.pfc3 b/.Attic/metta_lang/metta_ontology.pl.pfc3 deleted file mode 100755 index 4f78029649c..00000000000 --- a/.Attic/metta_lang/metta_ontology.pl.pfc3 +++ /dev/null @@ -1,117 +0,0 @@ - -% --- Core Logical and Arithmetic Operators --- -property('!', special_operators). % Cut operator, prevents backtracking beyond its point. -property('\\=', logic_comparison). % Inequality test. -property('=', logic_comparison). % Equality/unification operator. -property('==', logic_comparison). % Strict equality test. -property('=<', logic_comparison). % Less than or equal to. -property('<', logic_comparison). % Less than. -property('>=', logic_comparison). % Greater than or equal to. -property('>', logic_comparison). % Greater than. -property('->', control_flow). % If-then construct. -property(';', control_flow). % Disjunction; or. -property(',', control_flow). // Conjunction; and. -property('+', arithmetic_operations). % Addition. -property('-', arithmetic_operations). // Subtraction. -property('*', arithmetic_operations). % Multiplication. -property('mod', arithmetic_operations). % Modulus operation. - -% --- Data Structures, Manipulation, and List Operations --- -property('collapse', data_manipulation). % Collapses a structure. -property('sequential', data_manipulation). % Sequentially applies operations. -property('car-atom', list_operations). % Retrieves the head of a list. -property('cdr-atom', list_operations). % Retrieves the tail of a list. - -property('Cons', data_structures). % Constructs a list. -property('TupleConcat', data_structures). % Concatenates tuples. -property('make_list', list_creation). % Creates a list with specified elements. - - -% --- Evaluation, Execution, and Functionality --- -property('eval', evaluation_execution). % Evaluates an expression. -property('time!', evaluation_execution). % Execution timing. - -% --- System and External Integration --- -property('call-string!', code_inclusion). % Evaluates a string of Prolog code. -property('registered-python-function', code_inclusion). % Interacts with Python functions. - -% --- Assertions, Testing, and Debugging --- -property('assertTrue', assertions_testing). % Asserts a condition is true. -property('assertFalse', assertions_testing). % Asserts a condition is false. -property('assertEqual', assertions_testing). % Asserts two values are equal. -property('assertNotEqual', assertions_testing). % Asserts two values are not equal. -property('assertEqualToResult', assertions_testing). % Asserts equality to a result. - -property('trace!', debugging_tools). % Prints some debug - -property('no-rtrace!', debugging_tools). % Disables tracing for debugging. -property('rtrace!', debugging_tools). % Enables tracing for debugging. - -% --- Error Handling, Control Flow, and Conditional Execution --- -property('if', flow_control). % Conditional execution. -property('case', flow_control). % Case selection. -property('let', flow_control). % Variable assignment. -property('let*', flow_control). % Sequential variable assignment. -property('do', flow_control). % Looping construct. -property('catch', error_handling_advanced). % Catches exceptions. -property('throw', error_handling_advanced). % Throws exceptions. -property('function', flow_control). % a Function block. -property('return', flow_control). % return value of a function block - -property('dedup!', iteration_limit). % Removes duplicate elements from iteration -property('nth!', iteration_limit). % Allows only the Nth1 Iterator -property('limit!', iteration_limit). % Allows only the Nth1 Iterator -property('time-limit!', iteration_limit). -property(offset!', iteration_limit). - -property('pragma!', compiler_directive). % Compiler directive for optimizations/settings. -property('include!', code_inclusion). % Includes code from another file or context. -property('load-ascii', code_inclusion). % Loads ASCII file content. -property('extend-py!', code_inclusion). % Extends integration with Python. -property('pyr', code_inclusion). % Calls Python code directly. -property('import!', code_inclusion). % Imports an external module or file. -property('transfer!', state_transfer). % Transfers space content to another space - - -% --- Symbolic Arithmetic, Enhancements, and Miscellaneous --- -property('S', symbolic_arithmetic). % Successor in Peano arithmetic. -property('Z', symbolic_arithmetic). % Zero in Peano arithmetic. -property('fromNumber', type_conversion). % Converts from a numeric type. - - -property('quote', data_manipulation). % Prevents evaluation, treating input as literal. -property('coerce', type_conversion). % Forces argument types for compatibility. -property('enforce', logic_enforcement). % Enforces a logical rule. - -% --- Newly Included and Miscellaneous Properties --- -property('change-state!', system_interaction). % Changes the state of a system component. -property('set-state', state_management). % Sets the state of a component or system. -property('get-state', state_management). % Gets the state of a component or system. - - -property('remove-atom', data_manipulation). % Removes an atom from a structure. -property('replace-atom', data_manipulation). % Replaces an atom within a structure. -property(',', control_flow). % Conjunction; and. -property('match', pattern_matching). % Matches patterns within structures or data. -property('get-atoms', data_retrieval). % Retrieves atoms from a structure. -property('new-space', memory_management). % Allocates new space or memory region. - -property('or', logic_comparison). % Logical OR. -property('and', logic_comparison). % Logical OR. -property('not', logic_comparison). % Logical OR. - -property('range', arithmetic_operations). % Generates a range of numbers. -property('current-arity', property_definition). % Defines the arity of predicates/functions. -property('countElement', list_operations). % Counts occurrences of an element. -property('collapseCardinality', data_manipulation). % Collapses structures with cardinality consideration. -property('Error', error_handling). % Defines or triggers an error. -property('length', list_operations). % Determines the length of a list. -property('nop', control_structure). % No-operation placeholder. -property('number-of', quantitative_analysis). % Quantifies occurrences. -property('print', output_operations). % Prints text to output. -property('println!', output_operations). % Prints text with newline to output. -property('remove-atom', data_manipulation). % Removes an atom from structures. -property('replace-atom', data_manipulation). % Replaces atoms within structures. -property('superpose', data_manipulation). % Superposes data structures. -property('tuple-count', data_manipulation). % Counts tuples within a structure. -property('with-output-to!', output_redirection). % Redirects output to a specified target. diff --git a/.Attic/metta_lang/metta_ontology_level_1.pfc.pl b/.Attic/metta_lang/metta_ontology_level_1.pfc.pl deleted file mode 100755 index 83e12e977ee..00000000000 --- a/.Attic/metta_lang/metta_ontology_level_1.pfc.pl +++ /dev/null @@ -1,388 +0,0 @@ - - - - - - - - -%:- multifile(baseKB:agent_action_queue/3). -%:- dynamic(baseKB:agent_action_queue/3). - -:- set_prolog_flag(gc,true). - -:- thread_local(t_l:disable_px/0). -:- retractall(t_l:disable_px). - -:- must(\+ t_l:disable_px). - -:- op(500,fx,'~'). -:- op(1050,xfx,('=>')). -:- op(1050,xfx,'<==>'). -:- op(1050,xfx,('<-')). -:- op(1100,fx,('==>')). -:- op(1150,xfx,('::::')). -:- - current_prolog_flag(access_level,Was), - set_prolog_flag(access_level,system), - op(1190,xfx,('::::')), - op(1180,xfx,('==>')), - op(1170,xfx,'<==>'), - op(1160,xfx,('<-')), - op(1150,xfx,'=>'), - op(1140,xfx,'<='), - op(1130,xfx,'<=>'), - op(600,yfx,'&'), - op(600,yfx,'v'), - op(350,xfx,'xor'), - op(300,fx,'~'), - op(300,fx,'-'), - op(1199,fx,('==>')), - set_prolog_flag(access_level,Was). - -:- style_check(-discontiguous). -%:- enable_mpred_expansion. -%:- expects_dialect(pfc). - -/* -:- dynamic lmcache:session_io/4, lmcache:session_agent/2, lmcache:agent_session/2, telnet_fmt_shown/3, agent_action_queue/3). -:- dynamic lmcache:session_io/4, lmcache:session_agent/2, lmcache:agent_session/2, telnet_fmt_shown/3, agent_action_queue/3). - -*/ -%:- nop('$set_source_module'( baseKB)). -:- set_prolog_flag(runtime_speed, 0). -:- set_prolog_flag(runtime_safety, 2). -:- set_prolog_flag(runtime_debug, 2). -:- set_prolog_flag(unsafe_speedups, false). - -:- set_prolog_flag(expect_pfc_file,always). - - -% Predicate and Function Arity Definitions: -% Specifies the number of arguments (arity) for predicates and functions, which is fundamental -% for understanding the complexity and capabilities of various logical constructs. Predicates are defined -% from Nullary (no arguments) up to Denary (ten arguments), reflecting a range of logical conditions or assertions. -% Functions are similarly defined but focus on operations that return a value, extending up to Nonary (nine arguments). -p_arity('NullaryPredicate', 0). % No arguments. -p_arity('UnaryPredicate', 1). % One argument. -p_arity('BinaryPredicate', 2). % Two arguments. -p_arity('TernaryPredicate', 3). % Three arguments, and so on. -p_arity('QuaternaryPredicate', 4). -p_arity('QuinaryPredicate', 5). -p_arity('SenaryPredicate', 6). -p_arity('SeptenaryPredicate', 7). -p_arity('OctaryPredicate', 8). -p_arity('NonaryPredicate', 9). -p_arity('DenaryPredicate', 10). - -f_arity('NullaryFunction', 0). % No return value, essentially a procedure. -f_arity('UnaryFunction', 1). % Returns a single value, and so on. -f_arity('BinaryFunction', 2). -f_arity('TernaryFunction', 3). -f_arity('QuaternaryFunction', 4). -f_arity('QuinaryFunction', 5). -f_arity('SenaryFunction', 6). -f_arity('SeptenaryFunction', 7). -f_arity('OctaryFunction', 8). -f_arity('NonaryFunction', 9). - -% Enforcing Equivalency Between Predicates and Functions: -% Establishes a logical framework to equate the conceptual roles of predicates and functions based on arity. -% This equivalence bridges the functional programming and logical (declarative) paradigms within Prolog, -% allowing a unified approach to defining operations and assertions. -(equivalentTypes(PredType,FunctType) ==> - (in(FunctorObject,PredType) - <==> - in(FunctorObject,FunctType))). -% Automatically generating equivalency rules based on the arity of predicates and functions. -% This facilitates a dynamic and flexible understanding of function and predicate equivalences, -% enhancing Prolog's expressive power and semantic richness. -(((p_arity(PredType,PA), {plus(FA,1,PA), FA>=0}, f_arity(FunctType,FA))) - ==> equivalentTypes(PredType,FunctType)). - - - -% Interactivity and Debugging Tools: -% Tools and functionalities that facilitate interactivity with the user or debugging capabilities -% enhance the development experience by providing insights into program execution and allowing for real-time interaction. -property('trace!', debugging_tools). -property('nortrace!', debugging_tools). -property('rtrace!', debugging_tools). -% Debugging commands like 'trace!', 'notrace!', and 'rtrace!' offer deterministic control over tracing and debugging states, -% allowing developers to enable or disable debugging modes as needed. -property(P, debugging_tools) ==> property(P, 'Deterministic'). - -% --- Error Handling, Control Flow, and Conditional Execution --- -% Control structures are essential for directing the execution flow of a program. They enable conditional execution, -% looping, and choice between different paths of execution based on logical conditions or external inputs. -property('if', flow_control). % Executes a block of code if a given condition is true. -property('case', flow_control). % Selects a block of code to execute from multiple options based on a condition. -property('let', flow_control). % Assigns a value to a variable within a local scope. -property('let*', flow_control). % Sequentially binds variables to values, allowing later bindings to depend on earlier ones. -property('do', flow_control). % General looping construct. -property('catch', error_handling_advanced). % Catches exceptions, allowing for custom error handling. -property('throw', error_handling_advanced). % Throws a custom exception, which can be caught by a catch block. -property('function',flow_control). % a Function block. -property('return', flow_control). % return value of a function block -% Inferring backtracking behavior in flow control structures. This indicates that certain paths -% of execution might lead to backtracking, a core concept in Prolog for exploring alternative solutions. -property(P, flow_control) ==> property(P, 'OnFailBacktrack'). - - -property('limit', flow_control_modification). % Limits the number of solutions. -property('offset', flow_control_modification). % Skips a number of solutions. -property('max-time', flow_control_modification). % Limits execution time. - - -% Assertions and Testing Mechanisms: -% Assertions provide a powerful tool for validating expected conditions or outcomes within a program. -% They are critical for debugging and verifying the correctness of logic under various conditions. -property('assertTrue', assertions_testing). % Asserts a condition is true. -property('assertFalse', assertions_testing). % Asserts a condition is false. -property('assertEqual', assertions_testing). % Asserts equality between two values. -property('assertNotEqual', assertions_testing). % Asserts inequality. -property('assertEqualToResult', assertions_testing). % Asserts a value equals an expected result. -% Asserting deterministic outcomes for testing mechanisms. These properties ensure that assertions -% yield predictable, binary outcomes (pass or fail) based on the conditions they test. -property(P, assertions_testing) ==> property(P, 'Deterministic'). - -% Special Operators and System Interaction: -% Special operators and functionalities enhance Prolog's interaction with its execution environment and system, -% enabling dynamic control flows, system-level operations, and interaction with external processes or data. -property('!', special_operators). % Cut operator, controls backtracking. -property('call!', special_operators). % Dynamically calls a predicate. -property('call-fn!', special_operators). % Calls a function dynamically. -property('repl!', system_interaction). % Interactive read-eval-print loop. -property('pyr!', special_operators). % Example of an extension or plugin call. -property('call-cleanup!', resource_management). % Ensures cleanup after execution. -property('setup-call-cleanup!', resource_management). % Setup, call, and cleanup pattern. -property('with-output-to!', output_redirection). % Redirects output to a different stream. -% Deterministic behavior is noted for operations that have predictable outcomes, -% while nondeterministic behavior is acknowledged for operations whose results may vary. -property('call!', 'Deterministic'). -property('call-fn!', 'Nondeterministic'). -property('!', 'Deterministic'). - -% Data Structures and Manipulation: -% The definition, organization, and manipulation of data structures are foundational aspects of programming. -% These operations facilitate the storage, retrieval, and modification of data in structured forms. -property('Cons', data_structures). % Constructs a pair or list. -property('collapse', data_manipulation). % Flattens nested structures. -property('superpose', data_manipulation). % Overlays data structures. -property('sequential', data_manipulation). % Ensures sequential execution. -%property('TupleConcat', data_structures). % Concatenates tuples. -% Operations on data structures are generally deterministic, yielding predictable outcomes based on the inputs and operations. -property(P, data_manipulation) ==> property(P, 'Deterministic'). - -% Logic and Comparison: -% Logical and comparison operations are fundamental in programming, enabling decision making -% and data comparison. This includes basic logical operations and comparisons between values. -property('and', logic_comparison). -property('or', logic_comparison). -property('not', logic_comparison). -% Logical operations result in deterministic outcomes, directly derived from their input values. -property(P, logic_comparison) ==> property(P, 'Deterministic'). - -% Additional and Miscellaneous: -% This section covers a variety of functionalities not classified under the previous categories. -% It includes system interaction, functional programming utilities, arithmetic operations, -% and more, providing a wide range of capabilities. -property('atom-replace', data_manipulation). -property('fb-member', list_operations). -property('nop', control_structure). -property('empty', data_validation). -property('function', functional_programming). -property('number-of', quantitative_analysis). -property('new-space', system_interaction). -property('bind!', system_interaction). -property('pragma!', system_interaction). -property('transfer!', system_interaction). -property('registered-python-function', interlanguage_integration). - - -property('S', symbolic_arithmetic). -property('Z', symbolic_arithmetic). - - -% Rules for Automatic Property Inference: -% These rules allow for automatic inference of certain properties based on categories, -% simplifying the property assignment process and ensuring consistency. -property('function', 'VariableArity'). -property('return', 'Deterministic'). -property(P, system_interaction) ==> property(P, 'Deterministic'). -property('fb-member', 'Nondeterministic'). -property(P, symbolic_arithmetic) ==> property(P, 'Deterministic'). -property(P, recursion_control) ==> property(P, 'Deterministic'). -property('bc-rec', 'Nondeterministic'). - - -% Evaluation and Execution: -% Evaluation and execution properties pertain to how expressions, commands, or functions are processed and run. -% This includes interpreting code, printing output, and compiling expressions. -% 'eval' allows for the execution of dynamically constructed code, which could lead to nondeterministic outcomes -% depending on the runtime environment and input data. -property('eval', 'Nondeterministic'). -property('eval-for', evaluation_execution). -property('echo', evaluation_execution). -property('print', evaluation_execution). -property('println!', evaluation_execution). -property('compile-easy!', evaluation_execution). -property('time!', evaluation_execution). -% The 'eval' operation could lead to different outcomes based on the input, thus considered nondeterministic. -property('eval', 'Nondeterministic'). -% Conversely, 'echo' simply reflects its input without alteration, making it deterministic. -property('echo', 'Deterministic'). - -% Enhanced System Interaction and Dynamic Execution: -% Dynamic execution features and enhanced system interaction capabilities extend Prolog's utility, -% enabling runtime evaluation of code and interaction with the system or external environments. -% 'call-string!' executes Prolog code provided as a string, potentially introducing nondeterminism -% based on the dynamic nature of the executed code and external state. -property('call-string!', external_integration). -% 'call-string!' allows for dynamic execution of Prolog code provided as a string, -% which might be nondeterministic depending on the runtime environment and the code being executed. -property('call-string!', 'Nondeterministic'). -% Registering and invoking Python functions from Prolog illustrates interlanguage integration, -% enabling deterministic interoperability with Python codebases. -property('registered-python-function', 'Deterministic'). -% Error Handling and Advanced Control Flow Mechanisms: -% Proper error handling is crucial for robust programs, allowing for graceful recovery -% from unexpected states or inputs. Advanced control flow mechanisms provide more complex -% patterns of execution beyond simple conditional checks and loops. -property('catch', error_handling_advanced). -property('throw', error_handling_advanced). -% Error handling operations like 'catch' and 'throw' can influence the control flow based on runtime conditions, -% potentially introducing nondeterminism if the error states or exceptions are not predictable. -property('catch', 'Nondeterministic'). -property('throw', 'Nondeterministic'). - -% Arithmetic and Logical Operations: -% Arithmetic operations form the basis of mathematical computations in programming, -% including basic operations like addition, subtraction, multiplication, and division. -property('+', arithmetic_operations). -property('-', arithmetic_operations). -property('*', arithmetic_operations). -property('mod', arithmetic_operations). -% These operations are deterministic, yielding specific results from given numeric inputs. -property(P, arithmetic_operations) ==> property(P, 'Deterministic'). - -% List Operations and Data Validation: -% Operations on lists and validation of data are fundamental in many programming tasks, -% allowing for the manipulation, examination, and assurance of data integrity. -property('fb-member', list_operations). -% 'fb-member' checks for membership in a list, which could have nondeterministic outcomes based on list contents. -property('fb-member', 'Nondeterministic'). -property('nop', control_structure). -% 'nop' represents a no-operation, effectively serving as a placeholder or for timing. -property('nop', 'Deterministic'). -property('empty', data_validation). -% 'empty' checks for or represents an empty structure or condition, a deterministic operation. -property('empty', 'Deterministic'). - -% Advanced List Operations and Utilities: -% Advanced operations on lists and utility functions provide powerful mechanisms for data manipulation and analysis, -% extending the core capabilities for handling lists and collections. -property('dedup!', list_utilities). -% 'dedup!' removes duplicate elements from a list, providing a deterministic way to ensure unique elements. -property('dedup!', 'Deterministic'). - -% Arithmetic and Logic Enhancements: -% Enhancements to arithmetic and logic functionalities support more complex mathematical operations and logical reasoning, -% broadening the scope of computational tasks that can be addressed. -property('hyperpose', arithmetic_enhancements). -% 'hyperpose' could be involved in advanced arithmetic or matrix operations, assumed to be deterministic -% for well-defined mathematical transformations. -property('hyperpose', 'Deterministic'). - -% Functional Programming Enhancements: -% Enhancements and utilities for functional programming emphasize the use of functions as first-class citizens, -% promoting immutability, statelessness, and higher-order functions for more declarative programming approaches. -property('maplist!', functional_enhancements). -% 'maplist!' applies a function to each element of a list in a deterministic manner, preserving list structure. -property('maplist!', 'Deterministic'). -property('concurrent-maplist!', functional_programming). -% 'concurrent-maplist!' might introduce nondeterminism due to concurrent execution. -property('concurrent-maplist!', 'Nondeterministic'). - - - -% Quantitative Analysis and Symbolic Representation: -% Quantitative analysis involves operations that measure or quantify aspects of data, -% while symbolic representation deals with abstract symbols rather than explicit values. -property('number-of', quantitative_analysis). -% 'number-of' provides a count or measure, yielding deterministic results. -property('number-of', 'Deterministic'). -property('S', symbolic_arithmetic). -property('Z', symbolic_arithmetic). -% 'S' (successor) and 'Z' (zero) are used in Peano arithmetic, representing numbers symbolically. -property('S', 'Deterministic'). -property('Z', 'Deterministic'). - - - % --- Core Logical and Arithmetic Operators --- - % These operators are fundamental in controlling logic flow and evaluating conditions within programs. - properties('!', [special_operators, 'Deterministic']). % Cut operator, prevents backtracking beyond its point. - properties('\\=', [logic_comparison, 'Deterministic']). % Inequality test. - properties('=', [logic_comparison, 'Deterministic']). % Equality/unification operator. - properties('==', [logic_comparison, 'Deterministic']). % Strict equality test. - properties('=<', [logic_comparison, 'Deterministic']). % Less than or equal to. - properties('<', [logic_comparison, 'Deterministic']). % Less than. - properties('>=', [logic_comparison, 'Deterministic']). % Greater than or equal to. - properties('>', [logic_comparison, 'Deterministic']). % Greater than. - properties('->', [control_flow, 'Deterministic']). % If-then construct. - properties(';', [control_flow, 'Nondeterministic']). % Disjunction; or. - properties(',', [control_flow, 'Deterministic']). % Conjunction; and. - properties('+', [arithmetic_operations, 'Deterministic']). % Addition. - properties('-', [arithmetic_operations, 'Deterministic']). % Subtraction. - properties('*', [arithmetic_operations, 'Deterministic']). % Multiplication. - properties('mod', [arithmetic_operations, 'Deterministic']). % Modulus operation. - - % --- Data Structures, Manipulation, and List Operations --- - % Operations that involve the creation, manipulation, and analysis of complex data structures. - properties('Cons', [data_structures, 'Deterministic']). % Constructs a list or pair. - properties('collapse', [data_manipulation, 'Deterministic']). % Collapses nested structures into a simpler form. - %properties('TupleConcat', [data_structures, 'Deterministic']). % Concatenates tuples into a single tuple. - properties('sequential', [data_manipulation, 'Deterministic']). % Applies operations in a sequential manner. - properties('dedup!', [list_utilities, 'Deterministic']). % Removes duplicate elements from a list. - properties('car-atom', [list_operations, 'Deterministic']). % Retrieves the head of a list. - properties('cdr-atom', [list_operations, 'Deterministic']). % Retrieves the tail of a list, excluding the head. - - % --- Evaluation, Execution, and Functionality --- - % Pertains to the evaluation of expressions, execution of blocks, and general functionality enhancements. - properties('eval', [evaluation_execution, 'Nondeterministic']). % Dynamically evaluates a given expression. - properties('echo', [evaluation_execution, 'Deterministic']). % Echoes or returns the given input. - properties('compile-easy!', [evaluation_execution, 'Deterministic']). % Simplifies the compilation process. - properties('time!', [evaluation_execution, 'Deterministic']). % Measures the execution time of a block. - - % --- System and External Integration --- - % Includes properties for integrating with external systems, files, and languages. - properties('call-string!', [external_integration, 'Nondeterministic']). % Executes Prolog code provided as a string. - properties('registered-python-function', [interlanguage_integration, 'Deterministic']). % Allows calling Python functions from Prolog. - properties('extend-py!', [interlanguage_integration, 'Deterministic']). % Extends integration capabilities with Python. - properties('get-state', [state_management, 'Deterministic']). % Retrieves the current state of a specified system component. - - % --- Assertions, Testing, and Debugging --- - % Tools and properties aimed at facilitating testing, debugging, and asserting conditions within programs. - properties('assertTrue', [assertions_testing, 'Deterministic']). % Asserts that a given condition evaluates to true. - properties('assertFalse', [assertions_testing, 'Deterministic']). % Asserts that a given condition evaluates to false. - properties('assertEqual', [assertions_testing, 'Deterministic']). % Asserts the equality of two expressions. - properties('assertNotEqual', [assertions_testing, 'Deterministic']). % Asserts the inequality of two expressions. - properties('assertEqualToResult', [assertions_testing, 'Deterministic']). % Asserts that an expression equals an expected result. - properties('trace!', [debugging_tools, 'Deterministic']). % Enables tracing for debugging purposes. - properties('notrace!', [debugging_tools, 'Deterministic']). % Disables tracing. - properties('rtrace!', [debugging_tools, 'Deterministic']). % Reversible tracing for debugging, allows toggling on/off. - - - % --- Symbolic Arithmetic, Enhancements, and Miscellaneous --- - % Additional properties that provide enhancements, symbolic arithmetic operations, and miscellaneous functionality. - properties('S', [symbolic_arithmetic, 'Deterministic']). % Represents the successor function in Peano arithmetic. - properties('Z', [symbolic_arithmetic, 'Deterministic']). % Represents zero in Peano arithmetic. - properties('quote', [data_manipulation, 'Nondeterministic']). % Treats the given input as a literal, preventing its evaluation. - properties('coerce', [type_conversion, 'Deterministic']). % Forces the arguments to match expected types, ensuring compatibility. - - - -:- all_source_file_predicates_are_transparent. - -:- fixup_exports. - diff --git a/.Attic/metta_lang/metta_ontology_level_2.pfc.pl b/.Attic/metta_lang/metta_ontology_level_2.pfc.pl deleted file mode 100755 index 4069d286fb3..00000000000 --- a/.Attic/metta_lang/metta_ontology_level_2.pfc.pl +++ /dev/null @@ -1,251 +0,0 @@ -% Predicate and Function Arity Definitions: -% Specifies the number of arguments (arity) for predicates and functions, which is fundamental -% for understanding the complexity and capabilities of various logical constructs. Predicates are defined -% from Nullary (no arguments) up to Denary (ten arguments), reflecting a range of logical conditions or assertions. -% Functions are similarly defined but focus on operations that return a value, extending up to Nonary (nine arguments). -p_arity('NullaryPredicate', 0). % No arguments. -p_arity('UnaryPredicate', 1). % One argument. -p_arity('BinaryPredicate', 2). % Two arguments. -p_arity('TernaryPredicate', 3). % Three arguments, and so on. -p_arity('QuaternaryPredicate', 4). -p_arity('QuinaryPredicate', 5). -p_arity('SenaryPredicate', 6). -p_arity('SeptenaryPredicate', 7). -p_arity('OctaryPredicate', 8). -p_arity('NonaryPredicate', 9). -p_arity('DenaryPredicate', 10). - -f_arity('NullaryFunction', 0). % No return value, essentially a procedure. -f_arity('UnaryFunction', 1). % Returns a single value, and so on. -f_arity('BinaryFunction', 2). -f_arity('TernaryFunction', 3). -f_arity('QuaternaryFunction', 4). -f_arity('QuinaryFunction', 5). -f_arity('SenaryFunction', 6). -f_arity('SeptenaryFunction', 7). -f_arity('OctaryFunction', 8). -f_arity('NonaryFunction', 9). - -% Enforcing Equivalency Between Predicates and Functions: -% Establishes a logical framework to equate the conceptual roles of predicates and functions based on arity. -% This equivalence bridges the functional programming and logical (declarative) paradigms within Prolog, -% allowing a unified approach to defining operations and assertions. -(equivalentTypes(PredType,FunctType) ==> - (in(FunctorObject,PredType) - <==> - in(FunctorObject,FunctType))). -% Automatically generating equivalency rules based on the arity of predicates and functions. -% This facilitates a dynamic and flexible understanding of function and predicate equivalences, -% enhancing Prolog's expressive power and semantic richness. -((p_arity(PredType,PA), plus(FA,1,PA), f_arity(FunctType,FA))) - ==> equivalentTypes(PredType,FunctType)). - -% Flow Control Structures: -% Control structures are essential for directing the execution flow of a program. They enable conditional execution, -% looping, and choice between different paths of execution based on logical conditions or external inputs. -property('if', flow_control). % Conditional execution based on a boolean expression. -property('case', flow_control). % Choice between multiple paths. -property('let', flow_control). % Variable binding in a local scope. -property('let*', flow_control). % Sequential variable binding with dependency. -property('do', flow_control). % Executes a block of code. -property('limit', flow_control_modification). % Limits the number of solutions. -property('offset', flow_control_modification). % Skips a number of solutions. -property('max-time', execution_time_control). % Limits execution time. -% Inferring backtracking behavior in flow control structures. This indicates that certain paths -% of execution might lead to backtracking, a core concept in Prolog for exploring alternative solutions. -property(P, flow_control) ==> property(P, 'OnFailBacktrack'). - -% Assertions and Testing Mechanisms: -% Assertions provide a powerful tool for validating expected conditions or outcomes within a program. -% They are critical for debugging and verifying the correctness of logic under various conditions. -property('assertTrue', assertions_testing). % Asserts a condition is true. -property('assertFalse', assertions_testing). % Asserts a condition is false. -property('assertEqual', assertions_testing). % Asserts equality between two values. -property('assertNotEqual', assertions_testing). % Asserts inequality. -property('assertEqualToResult', assertions_testing). % Asserts a value equals an expected result. -% Asserting deterministic outcomes for testing mechanisms. These properties ensure that assertions -% yield predictable, binary outcomes (pass or fail) based on the conditions they test. -property(P, assertions_testing) ==> property(P, 'Deterministic'). - -% Special Operators and System Interaction: -% Special operators and functionalities enhance Prolog's interaction with its execution environment and system, -% enabling dynamic control flows, system-level operations, and interaction with external processes or data. -property('!', special_operators). % Cut operator, controls backtracking. -property('call!', special_operators). % Dynamically calls a predicate. -property('call-fn!', special_operators). % Calls a function dynamically. -property('repl!', system_interaction). % Interactive read-eval-print loop. -property('pyr!', special_operators). % Example of an extension or plugin call. -property('call-cleanup!', resource_management). % Ensures cleanup after execution. -property('setup-call-cleanup!', resource_management). % Setup, call, and cleanup pattern. -property('with-output-to!', output_redirection). % Redirects output to a different stream. -% Deterministic behavior is noted for operations that have predictable outcomes, -% while nondeterministic behavior is acknowledged for operations whose results may vary. -property('call!', 'Deterministic'). -property('call-fn!', 'Nondeterministic'). -property('!', 'Deterministic'). - -% Data Structures and Manipulation: -% The definition, organization, and manipulation of data structures are foundational aspects of programming. -% These operations facilitate the storage, retrieval, and modification of data in structured forms. -property('Cons', data_structures). % Constructs a pair or list. -property('collapse', data_manipulation). % Flattens nested structures. -property('superpose', data_manipulation). % Overlays data structures. -property('sequential', data_manipulation). % Ensures sequential execution. -property('TupleConcat', data_structures). % Concatenates tuples. -% Operations on data structures are generally deterministic, yielding predictable outcomes based on the inputs and operations. -property(P, data_manipulation) ==> property(P, 'Deterministic'). - -% Logic and Comparison: -% Logical and comparison operations are fundamental in programming, enabling decision making -% and data comparison. This includes basic logical operations and comparisons between values. -property('and', logic_comparison). -property('or', logic_comparison). -property('not', logic_comparison). -% Logical operations result in deterministic outcomes, directly derived from their input values. -property(P, logic_comparison) ==> property(P, 'Deterministic'). - -% Additional and Miscellaneous: -% This section covers a variety of functionalities not classified under the previous categories. -% It includes system interaction, functional programming utilities, arithmetic operations, -% and more, providing a wide range of capabilities. -property('atom-replace', data_manipulation). -property('fb-member', list_operations). -property('nop', control_structure). -property('empty', data_validation). -property('function', functional_programming). -property('return', functional_programming). -property('number-of', quantitative_analysis). -property('new-space', system_interaction). -property('bind!', system_interaction). -property('pragma!', system_interaction). -property('transfer!', system_interaction). -property('registered-python-function', interlanguage_integration). -property('S', symbolic_arithmetic). -property('Z', symbolic_arithmetic). -property('bc-base', recursion_control). -property('bc-base-ground', recursion_control). -property('bc-rec', recursion_control). - -% Rules for Automatic Property Inference: -% These rules allow for automatic inference of certain properties based on categories, -% simplifying the property assignment process and ensuring consistency. -property('function', 'VariableArity'). -property('return', 'Deterministic'). -property(P, system_interaction) ==> property(P, 'Deterministic'). -property('fb-member', 'Nondeterministic'). -property(P, symbolic_arithmetic) ==> property(P, 'Deterministic'). -property(P, recursion_control) ==> property(P, 'Deterministic'). -property('bc-rec', 'Nondeterministic'). - - -% Evaluation and Execution: -% Evaluation and execution properties pertain to how expressions, commands, or functions are processed and run. -% This includes interpreting code, printing output, and compiling expressions. -% 'eval' allows for the execution of dynamically constructed code, which could lead to nondeterministic outcomes -% depending on the runtime environment and input data. -property('eval', 'Nondeterministic'). -property('eval-for', evaluation_execution). -property('echo', evaluation_execution). -property('print', evaluation_execution). -property('println!', evaluation_execution). -property('compile-easy!', evaluation_execution). -property('time!', evaluation_execution). -% The 'eval' operation could lead to different outcomes based on the input, thus considered nondeterministic. -property('eval', 'Nondeterministic'). -% Conversely, 'echo' simply reflects its input without alteration, making it deterministic. -property('echo', 'Deterministic'). - -% Enhanced System Interaction and Dynamic Execution: -% Dynamic execution features and enhanced system interaction capabilities extend Prolog's utility, -% enabling runtime evaluation of code and interaction with the system or external environments. -% 'call-string!' executes Prolog code provided as a string, potentially introducing nondeterminism -% based on the dynamic nature of the executed code and external state. -property('call-string!', external_integration). -% 'call-string!' allows for dynamic execution of Prolog code provided as a string, -% which might be nondeterministic depending on the runtime environment and the code being executed. -property('call-string!', 'Nondeterministic'). -% Registering and invoking Python functions from Prolog illustrates interlanguage integration, -% enabling deterministic interoperability with Python codebases. -property('registered-python-function', 'Deterministic'). -% Error Handling and Advanced Control Flow Mechanisms: -% Proper error handling is crucial for robust programs, allowing for graceful recovery -% from unexpected states or inputs. Advanced control flow mechanisms provide more complex -% patterns of execution beyond simple conditional checks and loops. -property('catch', error_handling_advanced). -property('throw', error_handling_advanced). -% Error handling operations like 'catch' and 'throw' can influence the control flow based on runtime conditions, -% potentially introducing nondeterminism if the error states or exceptions are not predictable. -property('catch', 'Nondeterministic'). -property('throw', 'Nondeterministic'). - -% Arithmetic and Logical Operations: -% Arithmetic operations form the basis of mathematical computations in programming, -% including basic operations like addition, subtraction, multiplication, and division. -property('+', arithmetic_operations). -property('-', arithmetic_operations). -property('*', arithmetic_operations). -property('mod', arithmetic_operations). -% These operations are deterministic, yielding specific results from given numeric inputs. -property(P, arithmetic_operations) ==> property(P, 'Deterministic'). - -% List Operations and Data Validation: -% Operations on lists and validation of data are fundamental in many programming tasks, -% allowing for the manipulation, examination, and assurance of data integrity. -property('fb-member', list_operations). -% 'fb-member' checks for membership in a list, which could have nondeterministic outcomes based on list contents. -property('fb-member', 'Nondeterministic'). -property('nop', control_structure). -% 'nop' represents a no-operation, effectively serving as a placeholder or for timing. -property('nop', 'Deterministic'). -property('empty', data_validation). -% 'empty' checks for or represents an empty structure or condition, a deterministic operation. -property('empty', 'Deterministic'). - -% Advanced List Operations and Utilities: -% Advanced operations on lists and utility functions provide powerful mechanisms for data manipulation and analysis, -% extending the core capabilities for handling lists and collections. -property('dedup!', list_utilities). -% 'dedup!' removes duplicate elements from a list, providing a deterministic way to ensure unique elements. -property('dedup!', 'Deterministic'). - -% Arithmetic and Logic Enhancements: -% Enhancements to arithmetic and logic functionalities support more complex mathematical operations and logical reasoning, -% broadening the scope of computational tasks that can be addressed. -property('hyperpose', arithmetic_enhancements). -% 'hyperpose' could be involved in advanced arithmetic or matrix operations, assumed to be deterministic -% for well-defined mathematical transformations. -property('hyperpose', 'Deterministic'). - -% Functional Programming Enhancements: -% Enhancements and utilities for functional programming emphasize the use of functions as first-class citizens, -% promoting immutability, statelessness, and higher-order functions for more declarative programming approaches. -property('maplist!', functional_enhancements). -% 'maplist!' applies a function to each element of a list in a deterministic manner, preserving list structure. -property('maplist!', 'Deterministic'). -property('concurrent-maplist!', functional_programming). -% 'concurrent-maplist!' might introduce nondeterminism due to concurrent execution. -property('concurrent-maplist!', 'Nondeterministic'). - - -% Interactivity and Debugging Tools: -% Tools and functionalities that facilitate interactivity with the user or debugging capabilities -% enhance the development experience by providing insights into program execution and allowing for real-time interaction. -property('trace!', debugging_tools). -property('notrace!', debugging_tools). -property('rtrace!', debugging_tools). -% Debugging commands like 'trace!', 'notrace!', and 'rtrace!' offer deterministic control over tracing and debugging states, -% allowing developers to enable or disable debugging modes as needed. -property(P, debugging_tools) ==> property(P, 'Deterministic'). - -% Quantitative Analysis and Symbolic Representation: -% Quantitative analysis involves operations that measure or quantify aspects of data, -% while symbolic representation deals with abstract symbols rather than explicit values. -property('number-of', quantitative_analysis). -% 'number-of' provides a count or measure, yielding deterministic results. -property('number-of', 'Deterministic'). -property('S', symbolic_arithmetic). -property('Z', symbolic_arithmetic). -% 'S' (successor) and 'Z' (zero) are used in Peano arithmetic, representing numbers symbolically. -property('S', 'Deterministic'). -property('Z', 'Deterministic'). - diff --git a/.Attic/metta_lang/metta_pfc_base.pl b/.Attic/metta_lang/metta_pfc_base.pl index aad619a51fe..14c8ccda24e 100755 --- a/.Attic/metta_lang/metta_pfc_base.pl +++ b/.Attic/metta_lang/metta_pfc_base.pl @@ -1278,7 +1278,7 @@ pfc_eval_rhs1(Assertion,Support) :- % an assertion to be added. - once_writeq_ln(pfcRHS(Assertion)), + once_writeq_nl(pfcRHS(Assertion)), (must_ex(pfcPost1(Assertion,Support))*->true ; pfcWarn("Malformed rhs of a rule: ~p",[Assertion])). diff --git a/.Attic/metta_lang/metta_printer.pl b/.Attic/metta_lang/metta_printer.pl index 5c318fed386..bcd3060da41 100755 --- a/.Attic/metta_lang/metta_printer.pl +++ b/.Attic/metta_lang/metta_printer.pl @@ -107,6 +107,8 @@ is_final_write(V):- var(V), !, write_dvar(V),!. is_final_write('$VAR'(S)):- !, write_dvar(S),!. is_final_write('#\\'(S)):- !, format("'~w'",[S]). +is_final_write(V):- py_is_enabled,py_is_py(V),!,py_ppp(V),!. + is_final_write([VAR,V|T]):- '$VAR'==VAR, T==[], !, write_dvar(V). is_final_write('[|]'):- write('Cons'),!. is_final_write([]):- !, write('()'). @@ -139,16 +141,23 @@ setup_call_cleanup(nb_setval(W,true), once(Mesg),nb_setval(W,false)),nb_setval(W,false). -py_is_enabled:- predicate_property(py_is_object(_),foreign). +:- dynamic(py_is_enabled/0). +py_is_enabled:- predicate_property(py_ppp(_),defined), asserta((py_is_enabled:-!)). + +%write_src(V):- !, \+ \+ quietly(pp_sex(V)),!. +write_src(V):- \+ \+ notrace(( + guess_metta_vars(V),pp_sex(V))),!. +write_src_woi(Term):- + notrace((with_indents(false,write_src(Term)))). +write_src_woi_nl(X):- \+ \+ + notrace((guess_metta_vars(X), + format('~N'),write_src_woi(X),format('~N'))). -write_src(V):- \+ \+ quietly(pp_sex(V)),!. pp_sex(V):- pp_sexi(V),!. % Various 'write_src' and 'pp_sex' rules are handling the writing of the source, % dealing with different types of values, whether they are lists, atoms, numbers, strings, compounds, or symbols. pp_sexi(V):- is_final_write(V),!. -pp_sexi(V):- atomic(V),py_is_enabled,py_is_object(V),metta_py_pp(V),!. -pp_sexi(V):- py_is_enabled,once((py_is_object(V),py_to_pl(V,PL))),V\=@=PL,!,print(PL). pp_sexi(V):- is_dict(V),!,print(V). pp_sexi((USER:Body)) :- USER==user,!, pp_sex(Body). pp_sexi(V):- allow_concepts,!,with_concepts('False',pp_sex(V)),flush_output. diff --git a/.Attic/metta_lang/metta_python.pl b/.Attic/metta_lang/metta_python.pl index 32ae4fdb31f..fb3d70563f7 100755 --- a/.Attic/metta_lang/metta_python.pl +++ b/.Attic/metta_lang/metta_python.pl @@ -102,10 +102,39 @@ py_call_c(G):- py_catch(py_call(G)). py_call_c(G,R):- py_catch(py_call(G,R)). -py_is_module(M):-notrace((with_safe_argv(catch((py_call(M,X),py_type(X,module)),_,fail)))). +py_is_module(M):-notrace((with_safe_argv(py_is_module_unsafe(M)))). + +py_is_module_unsafe(M):- py_is_object(M),!,py_type(M,module). +py_is_module_unsafe(M):- catch((py_call(M,X),py_type(X,module)),_,fail). + +%py_is_py(_):- \+ py_is_enabled, !, fail. +py_is_py(V):- var(V),!, get_attr(V,pyobj,_),!. +py_is_py(V):- compound(V),!,fail. +py_is_py(V):- is_list(V),!,fail. +py_is_py(V):- atomic(V), !, \+ atom(V), py_is_object(V),!. +py_is_py(V):- \+ callable(V),!,fail. +py_is_py(V):- py_is_tuple(V),!. +py_is_py(V):- py_is_py_dict(V),!. +py_is_py(V):- py_is_list(V),!. + +py_resolve(V,Py):- var(V),!, get_attr(V,pyobj,Py),!. +py_resolve(V,Py):- \+ compound(V),!,py_is_object(V),Py=V. +py_resolve(V,Py):- is_list(V),!,fail,maplist(py_resolve,V,Py). +py_resolve(V,Py):- V=Py. + +py_is_tuple(X):- py_resolve(X,V), py_tuple(V,T),py_tuple(T,TT),T==TT, \+ py_type(V,str). +py_is_py_dict(X):- atomic(X),py_is_object(X),py_type(X,dict). +%py_is_py_dict(X):- py_resolve(X,V), py_dict(V,T), py_dict(T,TT), T==TT. +py_is_list(X):- py_resolve(X,V), py_type(V,list). +%py_is_list(V):- py_is_tuple(V). % Evaluations and Iterations -load_builtin_module:- py_module(builtin_module, +:- thread_local(did_load_builtin_module/0). +:- volatile(did_load_builtin_module/0). +:- dynamic(did_load_builtin_module/0). +load_builtin_module:- did_load_builtin_module,!. +load_builtin_module:- assert(did_load_builtin_module), +py_module(builtin_module, ' import sys #import numpy @@ -124,6 +153,12 @@ local_vars = locals() return exec(s,global_vars,local_vars) +def py_nth(s,nth): + return s[nth] + +def identity(s): + return s + def get_globals(): return globals() @@ -165,9 +200,27 @@ def string_representation(s): return repr(s) -def get_length(s): +def py_len(s): return len(s) +def py_list(s): + return list(s) + +def py_dict(s): + return dict(s) + +def py_dict0(): + return dict() + +def py_map(s): + return map(s) + +def py_tuple(s): + return tuple(s) + +def py_set(s): + return set(s) + def absolute_value(num): return abs(num) @@ -231,6 +284,9 @@ def isinstance_of(obj, classinfo): return isinstance(obj, classinfo) +def print_nonl(sub): + return print(sub, end="") + def issubclass_of(sub, superclass): return issubclass(sub, superclass) @@ -277,18 +333,39 @@ '). +pych_chars(Chars,P):- \+ is_list(Chars), !, P = Chars. +pych_chars(Chars,P):- append(O,`\r@(none)`,Chars),!,pych_chars(O,P). +pych_chars(Chars,P):- append(O,`\n@(none)`,Chars),!,pych_chars(O,P). +pych_chars(Chars,P):- append(O,`@(none)`,Chars),!,pych_chars(O,P). +pych_chars(Chars,P):- append(O,[WS],Chars),code_type(WS,new_line),!,pych_chars(O,P). +pych_chars(Chars,P):- append(O,[WS],Chars),code_type(WS,end_of_line),!,pych_chars(O,P). +pych_chars(P,P). +py_ppp(V):-flush_output, with_output_to(codes(Chars), once(py_pp(V))), + pych_chars(Chars,P),!,format('~s',[P]),!,flush_output. + +%atom_codes(Codes,P),writeq(Codes), +%py_ppp(V):- !, flush_output, py_mbi(print_nonl(V),_),!,flush_output. +%py_ppp(V):- writeq(py(V)),!. +%py_ppp(V):-once((py_is_object(V),py_to_pl(V,PL))),V\=@=PL,!,print(PL). +%py_ppp(V):-metta_py_pp(V). + % Evaluations and Iterations -load_hyperon_module:- py_module(hyperon_module, -' +:- thread_local(did_load_hyperon_module/0). +:- volatile(did_load_hyperon_module/0). +:- dynamic(did_load_hyperon_module/0). +load_hyperon_module:- did_load_hyperon_module,!. +load_hyperon_module:- assert(did_load_hyperon_module), + py_module(hyperon_module,' + from hyperon.base import Atom -from hyperon.atoms import OperationAtom, E +from hyperon.atoms import OperationAtom, E, GroundedAtom, GroundedObject from hyperon.ext import register_tokens from hyperon.ext import register_atoms from hyperon.atoms import G, AtomType from hyperon.runner import MeTTa - +from hyperon.atoms import * import hyperonpy as hp import sys @@ -304,40 +381,67 @@ def rust_metta_run(obj): return runner.run(obj) + +def rust_unwrap(obj): + if isinstance(obj,SymbolAtom): + return obj.get_name() + if isinstance(obj,ExpressionAtom): + return obj.get_children() + if isinstance(obj,GroundedAtom): + return obj.get_object() + if isinstance(obj,GroundedObject): + return obj.content + return obj + +def rust_deref(obj): + while True: + undone = rust_unwrap(obj) + if undone is obj: return obj + if undone is None: return obj + obj = undone + '). py_mcall(I,O):- catch(py_call(I,M,[py_object(false),py_string_as(string),py_dict_as({})]),error(_,_),fail),!,O=M. +py_scall(I,O):- catch(py_call(I,M,[py_string_as(string)]),error(_,_),fail),!,O=M. +py_acall(I,O):- catch(py_call(I,M,[py_string_as(atom)]),error(_,_),fail),!,O=M. +py_ocall(I,O):- catch(py_call(I,M,[py_object(true),py_string_as(string)]),error(_,_),fail),!,O=M. + -get_str_rep(I,O):- py_mcall(builtin_module:get_str_rep(I),O),!. +py_bi(I,O,Opts):- load_builtin_module,catch(py_call(builtin_module:I,M,Opts),error(_,_),fail),!,O=M. +py_obi(I,O):- load_builtin_module,py_ocall(builtin_module:I,O). +py_mbi(I,O):- load_builtin_module,py_mcall(builtin_module:I,O). +%?- py_call(type(hi-there), P),py_pp(P). +get_str_rep(I,O):- py_mbi(get_str_rep(I),O),!. py_atom(I,O):- var(I),!,O=I. -py_atom([I|Is],O):-!, py_dot(I,II),py_dot_from(II,Is,O). +py_atom([I|Is],O):-!, py_dot(I,II),py_dot_from(II,Is,O),!. py_atom(I,O):- atomic(I),!,py_atomic(I,O). -py_atom(I,O):- py_mcall(I,O),!. +py_atom(I,O):- py_ocall(I,O),!. py_atom(I,O):- I=O. py_atom_type(I,_Type,O):- var(I),!,O=I. py_atom_type([I|Is],_Type,O):-!, py_dot(I,II),py_dot_from(II,Is,O). py_atom_type(I,_Type,O):- atomic(I),!,py_atomic(I,O). -py_atom_type(I,_Type,O):- py_mcall(I,O),!. +py_atom_type(I,_Type,O):- py_ocall(I,O),!. py_atom_type(I,_Type,O):- I=O. -py_atomic([],O):-py_mcall("[]",O),!. +py_atomic([],O):-py_ocall("[]",O),!. py_atomic(I,O):- py_is_object(I),!,O=I. -py_atomic(I,O):- py_mcall(I,O),!. py_atomic(I,O):- string(I),py_eval(I,O),!. +py_atomic(I,O):- py_ocall(I,O),!. py_atomic(I,O):- py_eval(I,O),!. py_atomic(I,O):- \+ symbol_contains(I,'('),atomic_list_concat([A,B|C],'.',I),py_dot([A,B|C],O),!. py_atomic(I,O):- string(I), py_dot(I,O),!. py_atomic(I,O):- I=O. -get_globals(O):- py_mcall(builtin_module:get_globals(),O). -get_locals(O):- py_mcall(builtin_module:get_locals(),O). -merge_modules_and_globals(O):- py_mcall(builtin_module:merge_modules_and_globals(),O). -py_eval(I,O):- py_mcall(builtin_module:eval_string(I),O). +get_globals(O):- py_mbi(get_globals(),O). +get_locals(O):- py_mbi(get_locals(),O). +merge_modules_and_globals(O):- py_mbi(merge_modules_and_globals(),O). +py_eval(I,O):- py_obi(eval_string(I),O). py_eval(I):- py_eval(I,O),pybug(O). -py_exec(I,O):- py_mcall(builtin_module:exec_string(I),O). +py_exec(I,O):- py_mbi(exec_string(I),O). py_exec(I):- py_exec(I,O),pybug(O). py_dot(I,O):- string(I),atom_string(A,I),py_atom(A,O),A\==O,!. @@ -348,8 +452,14 @@ py_dot_from(From,I,O):- atomic_list_concat([A,B|C],'.',I),!,py_dot_from(From,[A,B|C],O). py_dot_from(From,I,O):- py_dot(From,I,O). -py_eval_object([V|VI],VO):- - py_eval_from(V,VI,VO). +py_eval_object(Var,VO):- var(Var),!,VO=Var. +py_eval_object([V|VI],VO):- py_is_function(V),!,py_eval_from(V,VI,VO). +py_eval_object([V|VI],VO):- maplist(py_eval_object,[V|VI],VO). +py_eval_object(VO,VO). + +py_is_function(O):- \+ py_is_object(O),!,fail. +py_is_function(O):- py_type(O, function),!. +%py_is_function(O):- py_type(O, method),!. py_eval_from(From,I,O):- I==[],!,py_dot(From,O). py_eval_from(From,[I],O):- !, py_fcall(From,I,O). @@ -357,7 +467,7 @@ py_eval_from(From,I,O):- atomic_list_concat([A,B|C],'.',I),!,py_eval_from(From,[A,B|C],O). py_eval_from(From,I,O):- py_fcall(From,I,O). -py_fcall(From,I,O):- py_mcall(From:I,O). +py_fcall(From,I,O):- py_ocall(From:I,O). ensure_space_py(Space,GSpace):- py_is_object(Space),!,GSpace=Space. ensure_space_py(Space,GSpace):- var(Space),ensure_primary_metta_space(GSpace), Space=GSpace. @@ -390,8 +500,8 @@ asserta(is_mettalog(MettaLearner)))). ensure_mettalog_py:- - load_builtin_module, - load_hyperon_module, + %load_builtin_module, + %load_hyperon_module, setenv('VSPACE_VERBOSE',0), with_safe_argv(ensure_mettalog_py(_)),!. @@ -484,6 +594,8 @@ py_to_pl(VL, Par, Cir, CirO, O, E) :- py_is_object(O), py_class(O, Cl), !, pyo_to_pl(VL, Par, [O = E | Cir], CirO, Cl, O, E). % If L is in the Cir list, unify E with L. + +%py_to_pl(_VL,_Par,Cir,Cir,L,E):- py_is_dict(L),!,py_mbi(identity(L),E). py_to_pl(_VL,_Par,Cir,Cir,L,E):- member(N-NE,Cir), N==L, !, (E=L;NE=E), !. % If LORV is a variable or nil, unify it directly. py_to_pl(_VL,_Par,Cir,Cir, LORV:B,LORV:B):- is_var_or_nil(LORV), !. @@ -578,17 +690,57 @@ %pyo_to_pl(_VL,_Par,Cir,Cir,Cl,O,E):- get_str_rep(O,Str), E=..[Cl,Str]. pyo_to_pl(_VL,_Par,Cir,Cir,_Cl,O,E):- O = E,!. +pl_to_rust(Var,Py):- pl_to_rust(_VL,Var,Py). +pl_to_rust(VL,Var,Py):- var(VL),!,ignore(VL=[vars]),pl_to_rust(VL,Var,Py). + +pl_to_rust(_VL,Sym,Py):- is_list(Sym),!, maplist(pl_to_rust,Sym,PyL), py_call(src:'mettalog':'MkExpr'(PyL),Py),!. +pl_to_rust(VL,Var,Py):- var(Var), !, real_VL_var(Sym,VL,Var), py_call('hyperon.atoms':'V'(Sym),Py),!. +pl_to_rust(VL,'$VAR'(Sym),Py):- !, real_VL_var(Sym,VL,_),py_call('hyperon.atoms':'V'(Sym),Py),!. +pl_to_rust(VL,DSym,Py):- atom(DSym),atom_concat('$',VName,DSym), rinto_varname(VName,Sym),!, pl_to_rust(VL,'$VAR'(Sym),Py). +pl_to_rust(_VL,Sym,Py):- atom(Sym),!, py_call('hyperon.atoms':'S'(Sym),Py),!. +%pl_to_rust(VL,Sym,Py):- is_list(Sym), maplist(pl_to_rust,Sym,PyL), py_call('hyperon.atoms':'E'(PyL),Py),!. +pl_to_rust(_VL,Sym,Py):- string(Sym),!, py_call('hyperon.atoms':'ValueAtom'(Sym),Py),!. +pl_to_rust(_VL,Sym,Py):- py_is_object(Sym),py_call('hyperon.atoms':'ValueAtom'(Sym),Py),!. +pl_to_rust(_VL,Sym,Py):- py_call('hyperon.atoms':'ValueAtom'(Sym),Py),!. + +py_list(MeTTa,PyList):- pl_to_py(MeTTa,PyList). + +py_tuple(O,Py):- py_ocall(tuple(O),Py),!. +py_tuple(O,Py):- py_obi(py_tuple(O),Py),!. + +py_dict(O,Py):- catch(py_is_py_dict(O),_,fail),!,O=Py. +py_dict(O,Py):- py_ocall(dict(O),Py),!. + +% ?- py_list([1, 2.0, "string"], X),py_type(X,Y). +% ?- py_list_index([1, 2.0, "string"], X),py_type(X,Y). +py_nth(L,Nth,E):- py_obi(py_nth(L,Nth),E). +py_len(L,E):- py_mbi(py_len(L),E). +py_o(O,Py):- py_obi(identity(O),Py),!. +py_m(O,Py):- py_mbi(identity(O),Py),!. pl_to_py(Var,Py):- pl_to_py(_VL,Var,Py). pl_to_py(VL,Var,Py):- var(VL),!,ignore(VL=[vars]),pl_to_py(VL,Var,Py). -pl_to_py(_VL,Sym,Py):- is_list(Sym),!, maplist(pl_to_py,Sym,PyL), py_call(src:'mettalog':'MkExpr'(PyL),Py),!. +pl_to_py(_VL,Sym,Py):- py_is_object(Sym),!,Sym=Py. +%pl_to_py(_VL,O,Py):- py_is_dict(O),!,py_obi(identity(O),Py). +pl_to_py(_VL,MeTTa,Python):- float(MeTTa), !, py_obi(float_conversion(MeTTa),Python). +pl_to_py(_VL,MeTTa,Python):- string(MeTTa), !, py_obi(string_conversion(MeTTa),Python). +pl_to_py(_VL,MeTTa,Python):- integer(MeTTa), !, py_obi(int_conversion(MeTTa),Python). +pl_to_py(VL,Sym,Py):- is_list(Sym),!, maplist(pl_to_py(VL),Sym,PyL), py_obi(py_list(PyL),Py). pl_to_py(VL,Var,Py):- var(Var), !, real_VL_var(Sym,VL,Var), py_call('hyperon.atoms':'V'(Sym),Py),!. pl_to_py(VL,'$VAR'(Sym),Py):- !, real_VL_var(Sym,VL,_),py_call('hyperon.atoms':'V'(Sym),Py),!. -pl_to_py(VL,DSym,Py):- atom(DSym),atom_concat('$',VName,DSym), rinto_varname(VName,Sym),!, pl_to_py(VL,'$VAR'(Sym),Py). -pl_to_py(_VL,Sym,Py):- atom(Sym),!, py_call('hyperon.atoms':'S'(Sym),Py),!. -pl_to_py(_VL,Sym,Py):- string(Sym),!, py_call('hyperon.atoms':'S'(Sym),Py),!. +pl_to_py(_VL,O,Py):- py_type(O,_),!,O=Py. +% % %pl_to_py(_VL,O,Py):- py_is_dict(O),!,O=Py. +%pl_to_py(VL,DSym,Py):- atom(DSym),atom_concat('$',VName,DSym), rinto_varname(VName,Sym),!, pl_to_py(VL,'$VAR'(Sym),Py). +%pl_to_py(_VL,Sym,Py):- atom(Sym),!, py_call('hyperon.atoms':'S'(Sym),Py),!. +%pl_to_py(_VL,Sym,Py):- string(Sym),!, py_call('hyperon.atoms':'S'(Sym),Py),!. %pl_to_py(VL,Sym,Py):- is_list(Sym), maplist(pl_to_py,Sym,PyL), py_call('hyperon.atoms':'E'(PyL),Py),!. -pl_to_py(_VL,Sym,Py):- py_is_object(Sym),py_call('hyperon.atoms':'ValueAtom'(Sym),Py),!. -pl_to_py(_VL,Sym,Py):- py_call('hyperon.atoms':'ValueAtom'(Sym),Py),!. +%pl_to_py(_VL,Sym,Py):- py_is_object(Sym),py_call('hyperon.atoms':'ValueAtom'(Sym),Py),!. +pl_to_py(_VL,MeTTa,MeTTa). +%pl_to_py(_VL,Sym,Py):- py_call('hyperon.atoms':'ValueAtom'(Sym),Py),!. + +py_key(O,I):- py_m(O,M),key(M,I). +py_items(O,I):- py_m(O,M),items(M,I). +%py_values(O,K,V):- py_m(O,M),values(M,K,V). +py_values(O,K,V):- py_items(O,L),member(K:V,L). %elements(Atoms,E):- is_list(Atoms),!, meets_dir(L,M):- atom(M),!,member(M,L),!. @@ -606,7 +758,7 @@ with_output_to(string(Str),py_pp(PyObj,[nl(false)])). tafs:- - atoms_from_space(Space, _),py_to_pl(VL,Space,AA), print_tree(aa(Pl,aa)),pl_to_py(VL,AA,Py), print_tree(py(Pl,py)),pl_to_py(VL,Py,Pl),print_tree(pl(Pl,pl)) + atoms_from_space(Space, _),py_to_pl(VL,Space,AA), print_tree(aa(Pl,aa)),pl_to_rust(VL,AA,Py), print_tree(py(Pl,py)),pl_to_rust(VL,Py,Pl),print_tree(pl(Pl,pl)) , atoms_from_space(Space, [A]),py_to_pl(VL,A,AA), atoms_from_space(Space, [A]),py_obj_dir(A,D),writeq(D),!,py_to_pl(VL,D:get_object(),AA),writeq(AA),!,fail. @@ -694,36 +846,92 @@ (nonvar(File)-> Use=File ; Use=Module), pybug('extend-py!'(Use)), %py_call(mettalog:use_mettalog()), - (Use==mettalog->true;(py_call(mettalog:load_functions(Use),R),pybug(R))), + (Use==mettalog->true;py_load_modfile(Use)), %listing(ensure_rust_metta/1), %ensure_mettalog_py, nb_setval('$py_ready','true'), %working_directory(PWD,PWD), py_add_lib_dir(PWD), %replace_in_string(["/"="."],Module,ToPython), - %py_call(mettalog:import_module_to_rust(ToPython)), - %sformat(S,'!(import! &self ~w)',[ToPython]),rust_metta_run(S), + %py_mcall(mettalog:import_module_to_rust(ToPython)), + %sformat(S,'!(import! &self ~w)',[Use]),rust_metta_run(S,R), + R = [], %py_module_exists(Module), %py_call(MeTTa:load_py_module(ToPython),Result), true)),!. +py_load_modfile(Use):- py_ocall(mettalog:load_functions(Use),R),!,pybug(R). +py_load_modfile(Use):- exists_directory(Use),!,directory_file_path(Use,'_init_.py',File),py_load_modfile(File). +py_load_modfile(Use):- file_to_modname(Use,Mod),read_file_to_string(Use,Src,[]),!,py_module(Mod,Src). + +file_to_modname(Filename,ModName):- symbol_concat('../',Name,Filename),!,file_to_modname(Name,ModName). +file_to_modname(Filename,ModName):- symbol_concat('./',Name,Filename),!,file_to_modname(Name,ModName). +file_to_modname(Filename,ModName):- symbol_concat(Name,'/_init_.py',Filename),!,file_to_modname(Name,ModName). +file_to_modname(Filename,ModName):- symbol_concat(Name,'.py',Filename),!,file_to_modname(Name,ModName). +file_to_modname(Filename,ModName):- replace_in_string(["/"="."],Filename,ModName). + %import_module_to_rust(ToPython):- sformat(S,'!(import! &self ~w)',[ToPython]),rust_metta_run(S). rust_metta_run(S,Run):- var(S),!,freeze(S,rust_metta_run(S,Run)). -rust_metta_run(exec(S),Run):- \+ callable(S), string_concat('!',S,SS),!,rust_metta_run(SS,Run). -rust_metta_run(S,Run):- \+ string(S),coerce_string(S,R),!,rust_metta_run(R,Run). -rust_metta_run(I,O):- !, py_mcall(hyperon_module:rust_metta_run(I),O),!. -rust_metta_run(R,Run):- % run +%rust_metta_run(exec(S),Run):- \+ callable(S), string_concat('!',S,SS),!,rust_metta_run(SS,Run). +rust_metta_run(S,Run):- coerce_string(S,R),!,rust_metta_run1(R,Run). +%rust_metta_run(I,O):- +rust_metta_run1(I,O):- load_hyperon_module, !, py_ocall(hyperon_module:rust_metta_run(I),M),!,rust_return(M,O). +rust_metta_run1(R,Run):- % run with_safe_argv(((( %ensure_rust_metta(MeTTa), py_call(mettalog:rust_metta_run(R),Run))))). +rust_return(M,O):- (py_iter(M,R,[py_object(true)]),py_iter(R,R1,[py_object(true)]))*->rust_to_pl(R1,O);(fail,rust_to_pl(M,O)). +%rust_return(M,O):- rust_to_pl(M,O). +%rust_return(M,O):- py_iter(M,R,[py_object(true)]),rust_to_pl(R,O). +%rust_return(M,O):- py_iter(M,O). %,delist1(R,O). +delist1([R],R):-!. +delist1(R,R). % Maybe warn here? + +rust_to_pl(L,P):- var(L),!,L=P. +%rust_to_pl([],P):- !, P=[]. +rust_to_pl(L,P):- is_list(L),!,maplist(rust_to_pl,L,P). +rust_to_pl(R,P):- compound(R),!,compound_name_arguments(R,F,RR),maplist(rust_to_pl,RR,PP),compound_name_arguments(P,F,PP). +rust_to_pl(R,P):- \+ py_is_object(R),!,P=R. +rust_to_pl(R,P):- py_type(R,'ExpressionAtom'),py_mcall(R:get_children(),L),!,maplist(rust_to_pl,L,P). +rust_to_pl(R,P):- py_type(R,'SymbolAtom'),py_acall(R:get_name(),P),!. +rust_to_pl(R,P):- py_type(R,'VariableAtom'),py_scall(R:get_name(),N),!,as_var(N,P),!. +%rust_to_pl(R,P):- py_type(R,'VariableAtom'),py_acall(R:get_name(),N),!,atom_concat('$',N,P). +rust_to_pl(R,N):- py_type(R,'OperationObject'),py_acall(R:name(),N),!,cache_op(N,R). +rust_to_pl(R,P):- py_type(R,'SpaceRef'),!,P=R. % py_scall(R:'__str__'(),P),!. +rust_to_pl(R,P):- py_type(R,'ValueObject'),py_ocall(R:'value'(),L),!,rust_to_pl(L,P). +rust_to_pl(R,PT):- py_type(R,'GroundedAtom'),py_ocall(R:get_grounded_type(),T),rust_to_pl(T,TT),py_ocall(R:get_object(),L),!,rust_to_pl(L,P),combine_term_l(TT,P,PT). +rust_to_pl(R,P):- py_is_list(R),py_m(R,L),R\==L,!,rust_to_pl(L,P). +rust_to_pl(R,PT):- py_type(R,T),combine_term_l(T,R,PT),!. +%rust_to_pl(R,P):- py_acall(R:'__repr__'(),P),!. +rust_to_pl(R,P):- + load_hyperon_module, !, py_ocall(hyperon_module:rust_deref(R),M),!, + (R\==M -> rust_to_pl(M,P) ; M=P). + +as_var('_',_):-!. +as_var(N,'$VAR'(S)):-sformat(S,'_~w',[N]),!. + rust_metta_run(S):- rust_metta_run(S,Py), print_py(Py). +:- volatile(cached_py_op/2). +cache_op(N,R):- asserta_if_new(cached_py_op(N,R)),fbug(cached_py_op(N,R)). +:- volatile(cached_py_type/2). +cache_type(N,R):- asserta_if_new(cached_py_type(N,R)),fbug(cached_py_type(N,R)). + print_py(Py):- py_to_pl(Py,R), print(R),nl. -coerce_string(S,R):- atom(S), sformat(R,'~w',[S]),!. +combine_term_l('OperationObject',P,P):-!. +combine_term_l('Number',P,P):-!. +combine_term_l('Bool',P,P):-!. +combine_term_l('ValueObject',R,P):-R=P,!. %rust_to_pl(R,P),!. +combine_term_l('%Undefined%',R,P):-rust_to_pl(R,P),!. +combine_term_l('hyperon::space::DynSpace',P,P):-!. +combine_term_l([Ar|Stuff],Op,Op):- Ar == (->), !, cache_type(Op,[Ar|Stuff]). +combine_term_l(T,P,ga(P,T)). + +%coerce_string(S,R):- atom(S), sformat(R,'~w',[S]),!. coerce_string(S,R):- string(S),!,S=R. coerce_string(S,R):- with_output_to(string(R),write_src(S)),!. @@ -767,7 +975,6 @@ */ %:- ensure_loaded(metta_interp). -on_restore1:- ensure_mettalog_py. :- dynamic(want_py_lib_dir/1). :- prolog_load_context(directory, ChildDir), @@ -811,5 +1018,22 @@ % py_initialize(, +Argv, +Options) -:- load_builtin_module. +on_restore1:- ensure_mettalog_py. +on_restore2:- !. +%on_restore2:- load_builtin_module. %:- load_hyperon_module. + + + +% grab the 1st variable Var +subst_each_var([Var|RestOfVars],Term,Output):- !, + % replace all occurences of Var with _ (Which is a new anonymous variable) + subst(Term, Var, _ ,Mid), + % Do the RestOfVars + subst_each_var(RestOfVars,Mid,Output). +% no more vars left to replace +subst_each_var(_, TermIO, TermIO). + + + + diff --git a/.Attic/metta_lang/metta_repl.pl b/.Attic/metta_lang/metta_repl.pl index 0f90f1a9d5c..20a48794b39 100755 --- a/.Attic/metta_lang/metta_repl.pl +++ b/.Attic/metta_lang/metta_repl.pl @@ -551,7 +551,8 @@ %add_history_string("!(load-flybase-full)"), %add_history_string("!(pfb3)"), %add_history_string("!(obo-alt-id $X BS:00063)"), - %add_history_string("!(and (total-rows $T TR$) (unique-values $T2 $Col $TR))"),!. + %add_history_string("!(and (total-rows $T TR$) (unique-values $T2 $Col $TR))"), + !. install_readline(_NoTTY). % For non-tty(true) clients over SWISH/Http/Rest server :- dynamic setup_done/0. diff --git a/.Attic/metta_lang/metta_rust.pl b/.Attic/metta_lang/metta_rust.pl deleted file mode 100755 index fcae66a45ba..00000000000 --- a/.Attic/metta_lang/metta_rust.pl +++ /dev/null @@ -1,5 +0,0 @@ - - -:- ensure_loaded(metta_python). -:- ensure_loaded(metta_interp). - diff --git a/.Attic/metta_lang/metta_server.pl b/.Attic/metta_lang/metta_server.pl index 343d2a5afcd..ef4591ce794 100755 --- a/.Attic/metta_lang/metta_server.pl +++ b/.Attic/metta_lang/metta_server.pl @@ -140,7 +140,10 @@ tcp_open_socket(Socket, Stream). % Helper to send goal and receive response -send_term(Stream, MeTTa) :- write_canonical(Stream, MeTTa),writeln(Stream, '.'), flush_output(Stream). +send_term(Stream, MeTTa) :- + write_canonical(Stream, MeTTa), + writeln(Stream, '.'), + flush_output(Stream). recv_term(Stream, MeTTa) :- read_term(Stream, MeTTa, []). diff --git a/.Attic/metta_lang/metta_space.pl b/.Attic/metta_lang/metta_space.pl index fc96c1a295b..a8a02d48c9a 100755 --- a/.Attic/metta_lang/metta_space.pl +++ b/.Attic/metta_lang/metta_space.pl @@ -553,7 +553,7 @@ has_type(S,Type):- sub_atom(S,0,4,Aft,FB),flybase_identifier(FB,Type),!,Aft>0. -call_sexpr(S):- once_writeq_ln(call_sexpr(S)). +call_sexpr(S):- once_writeq_nl(call_sexpr(S)). %call_sexpr(Space,Expr,Result):- :- dynamic(fb_pred/2). @@ -666,4 +666,25 @@ symbolic_list_concat(A,B):- atomic_list_concat(A,B). symbol_contains(T,TT):- atom_contains(T,TT). */ +search_for1(X):- + forall((metta_atom(_Where,What),contains_var(X,What)), + (nl,write_src_nl(What))). + +search_for2(X):- + forall((metta_file_src(_Where,What),contains_var(X,What)), + (nl,write_src_nl(What))). + + +metta_file_src(Where,What):- + loaded_into_kb(Where,File), metta_file_buffer(_,What,Vars,File,_Loc), + ignore(maplist(name_the_var,Vars)). + + +guess_metta_vars(What):- + ignore(once((metta_file_buffer(_,What0,Vars,_File,_Loc), + alpha_unify(What,What0), + maplist(name_the_var,Vars)))). +name_the_var(N=V):- ignore((atom_concat('_',NV,N),V='$VAR'(NV))). + +alpha_unify(What,What0):- What=@=What0,(nonvar(What)->What=What0;What==What0). diff --git a/.Attic/metta_lang/metta_subst.bk b/.Attic/metta_lang/metta_subst.bk deleted file mode 100755 index 55f0ca41a89..00000000000 --- a/.Attic/metta_lang/metta_subst.bk +++ /dev/null @@ -1,833 +0,0 @@ -%self_eval_l1t(X):- var(X),!. -%self_eval_l1t(X):- string(X),!. -%self_eval_l1t(X):- number(X),!. -%self_eval_l1t([]). -self_eval_l1t(X):- \+ callable(X),!. -self_eval_l1t(X):- is_valid_nb_state(X),!. -self_eval_l1t(X):- is_list(X),!,fail. -%self_eval_l1t(X):- compound(X),!. -%self_eval_l1t(X):- is_ref(X),!,fail. -self_eval_l1t(X):- atom(X),!, \+ nb_current(X,_),!. -self_eval_l1t('True'). self_eval_l1t('False'). self_eval_l1t('F'). - - -:- nb_setval(self_space, '&self'). -eval_l1ts_to(XX,Y):- Y==XX,!. -eval_l1ts_to(XX,Y):- Y=='True',!, is_True(XX),!. - -%current_self(Space):- nb_current(self_space,Space). -eval_l1t_args(A,AA):- - current_self(Space), - eval_l1t_args(11,Space,A,AA). - -%eval_l1t_args(Depth,_Self,X,_Y):- forall(between(6,Depth,_),write(' ')),writeqln(eval_l1t_args(X)),fail. - -eval_l1t_args(_Dpth,_Slf,X,Y):- nonvar(Y),X=Y,!. - -eval_l1t_args(Depth,Self,X,Y):- nonvar(Y),!,eval_l1t_args(Depth,Self,X,XX),eval_l1ts_to(XX,Y). -eval_l1t_args(_Dpth,_Slf,X,Y):- self_eval_l1t(X),!,Y=X. -eval_l1t_args(_Dpth,_Slf,[X|T],Y):- T==[], \+ callable(X),!,Y=[X]. - -eval_l1t_args(Depth,Self,[F|X],Y):- - (F=='superpose' ; ( option_value(no_repeats,false))), - mnotrace((D1 is Depth-1)),!, - eval_l1t_args0(D1,Self,[F|X],Y). - -eval_l1t_args(Depth,Self,X,Y):- - mnotrace((no_repeats_var(YY), - D1 is Depth-1)), - eval_l1t_args0(D1,Self,X,Y), - mnotrace(( \+ (Y\=YY))). - - - - - -:- nodebug(metta(eval_l1t)). - -/* -debugging_metta(G):-is_debugging((eval_l1t))->ignore(G);true. -w_indent(Depth,Goal):- - \+ \+ mnotrace(ignore((( - format('~N'), - setup_call_cleanup(forall(between(Depth,101,_),write(' ')),Goal, format('~N')))))). -indentq(Depth,Term):- - \+ \+ mnotrace(ignore((( - format('~N'), - setup_call_cleanup(forall(between(Depth,101,_),write(' ')),format('~q',[Term]), - format('~N')))))). - - -with_debug(Flag,Goal):- is_debugging(Flag),!, call(Goal). -with_debug(Flag,Goal):- flag(eval_l1t_num,_,0), - setup_call_cleanup(set_debug(Flag,true),call(Goal),set_debug(Flag,flase)). - -flag_to_var(Flag,Var):- atom(Flag), \+ atom_concat('trace-on-',_,Flag),!,atom_concat('trace-on-',Flag,Var). -flag_to_var(metta(Flag),Var):- !, nonvar(Flag), flag_to_var(Flag,Var). -flag_to_var(Flag,Var):- Flag=Var. - -set_debug(Flag,Val):- \+ atom(Flag), flag_to_var(Flag,Var), atom(Var),!,set_debug(Var,Val). -set_debug(Flag,true):- !, debug(metta(Flag)),flag_to_var(Flag,Var),set_option_value(Var,true). -set_debug(Flag,false):- nodebug(metta(Flag)),flag_to_var(Flag,Var),set_option_value(Var,false). -if_trace((Flag;true),Goal):- !, notrace(( catch_err(ignore((Goal)),E,wdmsg(E-->if_trace((Flag;true),Goal))))). -if_trace(Flag,Goal):- notrace((catch_err(ignore((is_debugging(Flag),Goal)),E,wdmsg(E-->if_trace(Flag,Goal))))). - - -%maybe_efbug(SS,G):- efbug(SS,G)*-> if_trace(eval_l1t,wdmsg(SS=G)) ; fail. -maybe_efbug(_,G):- call(G). -%efbug(P1,G):- call(P1,G). -efbug(_,G):- call(G). - - - -is_debugging(Flag):- var(Flag),!,fail. -is_debugging((A;B)):- !, (is_debugging(A) ; is_debugging(B) ). -is_debugging((A,B)):- !, (is_debugging(A) , is_debugging(B) ). -is_debugging(not(Flag)):- !, \+ is_debugging(Flag). -is_debugging(Flag):- Flag== false,!,fail. -is_debugging(Flag):- Flag== true,!. -is_debugging(Flag):- debugging(metta(Flag),TF),!,TF==true. -is_debugging(Flag):- debugging(Flag,TF),!,TF==true. -is_debugging(Flag):- flag_to_var(Flag,Var), - (option_value(Var,true)->true;(Flag\==Var -> is_debugging(Var))). - -:- nodebug(metta(overflow)). - -*/ - -eval_l1t_args0(Depth,_Slf,X,Y):- Depth<1,!,X=Y, (\+ trace_on_overflow-> true; flag(eval_l1t_num,_,0),debug(metta(eval_l1t))). -eval_l1t_args0(_Dpth,_Slf,X,Y):- self_eval_l1t(X),!,Y=X. -eval_l1t_args0(Depth,Self,X,Y):- - Depth2 is Depth-1, - eval_l1t_args11(Depth,Self,X,M), - (M\=@=X ->eval_l1t_args0(Depth2,Self,M,Y);Y=X). - - - -eval_l1t_args11(_Dpth,_Slf,X,Y):- self_eval_l1t(X),!,Y=X. -eval_l1t_args11(Depth,Self,X,Y):- \+ debugging(metta(eval_l1t)),!, eval_l1t_args1(Depth,Self,X,Y). -eval_l1t_args11(Depth,Self,X,Y):- flag(eval_l1t_num,EX,EX+1), - option_else(traclen,Max,100), - (EX>Max->(nodebug(metta(eval_l1t)),write('Switched off tracing. For a longer trace !(pragma! tracelen 101))'));true), - mnotrace((no_repeats_var(YY), D1 is Depth-1)), - DR is 99-D1, - if_trace(metta(eval_l1t),indentq(Depth,'-->'(EX,Self,X,depth(DR)))), - Ret=retval(fail), - call_cleanup(( - eval_l1t_args1(D1,Self,X,Y), - mnotrace(( \+ (Y\=YY), nb_setarg(1,Ret,Y)))), - mnotrace(ignore(((Y\=@=X,if_trace(metta(eval_l1t),indentq(Depth,'<--'(EX,Ret)))))))), - (Ret\=@=retval(fail)->true;(rtrace(eval_l1t_args0(D1,Self,X,Y)),fail)). - - -:- discontiguous eval_l1t_args1/4. -:- discontiguous eval_l1t_args2/4. - -eval_l1t_args1(_Dpth,_Slf,Name,Value):- atom(Name), nb_current(Name,Value),!. - -eval_l1t_args1(Depth,Self,[V|VI],VVO):- \+ is_list(VI),!, - eval_l1t_args(Depth,Self,VI,VM), - ( VM\==VI -> eval_l1t_args(Depth,Self,[V|VM],VVO) ; - (eval_l1t_args(Depth,Self,V,VV), (V\==VV -> eval_l1t_args(Depth,Self,[VV|VI],VVO) ; VVO = [V|VI]))). - -eval_l1t_args1(_Dpth,_Slf,X,Y):- \+ is_list(X),!,Y=X. - -eval_l1t_args1(Depth,Self,[V|VI],[V|VO]):- var(V),is_list(VI),!,maplist(eval_l1t_args(Depth,Self),VI,VO). - -eval_l1t_args1(_Dpth,_Slf,['repl!'],'True'):- !, repl. -eval_l1t_args1(Depth,Self,['!',Cond],Res):- !, call(eval_l1t_args(Depth,Self,Cond,Res)). -eval_l1t_args1(Depth,Self,['rtrace',Cond],Res):- !, rtrace(eval_l1t_args(Depth,Self,Cond,Res)). -eval_l1t_args1(Depth,Self,['time',Cond],Res):- !, time(eval_l1t_args(Depth,Self,Cond,Res)). -eval_l1t_args1(Depth,Self,['print',Cond],Res):- !, eval_l1t_args(Depth,Self,Cond,Res),format('~N'),print(Res),format('~N'). -% !(println! $1) -eval_l1t_args1(Depth,Self,['println!',Cond],Res):- !, eval_l1t_args(Depth,Self,Cond,Res),format('~N'),print(Res),format('~N'). - -eval_l1t_args1(_Dpth,_Slf,List,Y):- is_list(List),maplist(self_eval_l1t,List),List=[H|_], \+ atom(H), !,Y=List. - -eval_l1t_args1(Depth,Self,['assertTrue', X],TF):- !, eval_l1t_args(Depth,Self,['assertEqual',X,'True'],TF). -eval_l1t_args1(Depth,Self,['assertFalse',X],TF):- !, eval_l1t_args(Depth,Self,['assertEqual',X,'False'],TF). - -eval_l1t_args1(Depth,Self,['assertEqual',X0,Y0],RetVal):- !, - subst_vars(X0,X),subst_vars(Y0,Y), - l1t_loonit_assert_source_tf( - ['assertEqual',X0,Y0], - (bagof_eval_l1t(Depth,Self,X,XX), - bagof_eval_l1t(Depth,Self,Y,YY)), - equal_enough_for_test(XX,YY), TF), - (TF=='True'->return_empty(RetVal);RetVal=[got,XX,expected,YY]). - -eval_l1t_args1(Depth,Self,['assertNotEqual',X0,Y0],RetVal):- !, - subst_vars(X0,X),subst_vars(Y0,Y), - l1t_loonit_assert_source_tf( - ['assertNotEqual',X0,Y0], - (setof_eval_l1t(Depth,Self,X,XX), setof_eval_l1t(Depth,Self,Y,YY)), - \+ equal_enough(XX,YY), TF), - (TF=='True'->return_empty(RetVal);RetVal=[got,XX,expected,not,YY]). - -eval_l1t_args1(Depth,Self,['assertEqualToResult',X0,Y0],RetVal):- !, - subst_vars(X0,X),subst_vars(Y0,Y), - l1t_loonit_assert_source_tf( - ['assertEqualToResult',X0,Y0], - (bagof_eval_l1t(Depth,Self,X,XX), =(Y,YY)), - equal_enough_for_test(XX,YY), TF), - (TF=='True'->return_empty(RetVal);RetVal=[got,XX,expected,YY]),!. - - -l1t_loonit_assert_source_tf(Src,Goal,Check,TF):- - copy_term(Goal,OrigGoal), - l1t_loonit_asserts(Src, time_eval('\n; EVAL TEST\n;',Goal), Check), - as_tf(Check,TF),!, - ignore(( - once((TF='True', is_debugging(pass));(TF='False', is_debugging(fail))), - with_debug((eval_l1t),time_eval('Trace',OrigGoal)))). - -l1t_loonit_asserts(Src,Goal,Check):- - loonit_asserts(Src,Goal,Check). - - -/* -sort_result(Res,Res):- \+ compound(Res),!. -sort_result([And|Res1],Res):- is_and(And),!,sort_result(Res1,Res). -sort_result([T,And|Res1],Res):- is_and(And),!,sort_result([T|Res1],Res). -sort_result([H|T],[HH|TT]):- !, sort_result(H,HH),sort_result(T,TT). -sort_result(Res,Res). - -unify_enough(L,L):-!. -unify_enough(L,C):- is_list(L),into_list_args(C,CC),!,unify_lists(CC,L). -unify_enough(C,L):- is_list(L),into_list_args(C,CC),!,unify_lists(CC,L). -unify_enough(C,L):- \+ compound(C),!,L=C. -unify_enough(L,C):- \+ compound(C),!,L=C. -unify_enough(L,C):- into_list_args(L,LL),into_list_args(C,CC),!,unify_lists(CC,LL). - -unify_lists(C,L):- \+ compound(C),!,L=C. -unify_lists(L,C):- \+ compound(C),!,L=C. -unify_lists([C|CC],[L|LL]):- unify_enough(L,C),!,unify_lists(CC,LL). - -equal_enough(R,V):- is_list(R),is_list(V),sort(R,RR),sort(V,VV),!,equal_enouf(RR,VV),!. -equal_enough(R,V):- copy_term(R,RR),copy_term(V,VV),equal_enouf(R,V),!,R=@=RR,V=@=VV. - -equal_enough_for_test(X,Y):- must_det_ll((subst_vars(X,XX),subst_vars(Y,YY))),!,equal_enough(XX,YY),!. - -equal_enouf(R,V):- R=@=V, !. -equal_enouf(_,V):- V=@='...',!. -equal_enouf(L,C):- is_list(L),into_list_args(C,CC),!,equal_enouf_l(CC,L). -equal_enouf(C,L):- is_list(L),into_list_args(C,CC),!,equal_enouf_l(CC,L). -%equal_enouf(R,V):- (var(R),var(V)),!, R=V. -equal_enouf(R,V):- (var(R);var(V)),!, R==V. -equal_enouf(R,V):- number(R),number(V),!, RV is abs(R-V), RV < 0.03 . -equal_enouf(R,V):- atom(R),!,atom(V), has_unicode(R),has_unicode(V). -equal_enouf(R,V):- (\+ compound(R) ; \+ compound(V)),!, R==V. -equal_enouf(L,C):- into_list_args(L,LL),into_list_args(C,CC),!,equal_enouf_l(CC,LL). - -equal_enouf_l(C,L):- \+ compound(C),!,L=@=C. -equal_enouf_l(L,C):- \+ compound(C),!,L=@=C. -equal_enouf_l([C|CC],[L|LL]):- !, equal_enouf(L,C),!,equal_enouf_l(CC,LL). - - -has_unicode(A):- atom_codes(A,Cs),member(N,Cs),N>127,!. -set_last_error(_). - -*/ - -eval_l1t_args1(Depth,Self,['match',Other,Goal,Template],Template):- into_space(Self,Other,Space),!, metta_atom_iter_l1t(Depth,Space,Goal). -eval_l1t_args1(Depth,Self,['match',Other,Goal,Template,Else],Template):- - (eval_l1t_args1(Depth,Self,['match',Other,Goal,Template],Template)*->true;Template=Else). - -% Macro: case -eval_l1t_args1(Depth,Self,X,Res):- - X= [CaseSym,A,CL],CaseSym == 'case', !, - into_case_l1t_list(CL,CASES), - findall(Key-Value, - (nth0(Nth,CASES,Case0), - (is_case_l1t(Key,Case0,Value), - if_trace((case),(format('~N'), - writeqln(c(Nth,Key)=Value))))),KVs),!, - ((eval_l1t_args(Depth,Self,A,AA), if_trace((case),writeqln(switch=AA)), - (select_case_l1t(Depth,Self,AA,KVs,Value)->true;(member(Void -Value,KVs),Void=='%void%'))) - *->true;(member(Void -Value,KVs),Void=='%void%')), - eval_l1t_args(Depth,Self,Value,Res). - - select_case_l1t(Depth,Self,AA,Cases,Value):- - (best_key_l1t(AA,Cases,Value) -> true ; - (maybe_special_key_l1ts(Depth,Self,Cases,CasES), - (best_key_l1t(AA,CasES,Value) -> true ; - (member(Void -Value,CasES),Void=='%void%')))). - - best_key_l1t(AA,Cases,Value):- - ((member(Match-Value,Cases),unify_enough(AA,Match))->true; - ((member(Match-Value,Cases),AA ==Match)->true; - ((member(Match-Value,Cases),AA=@=Match)->true; - (member(Match-Value,Cases),AA = Match)))). - - %into_case_l1t_list([[C|ASES0]],CASES):- is_list(C),!, into_case_l1t_list([C|ASES0],CASES),!. - into_case_l1t_list(CASES,CASES):- is_list(CASES),!. - is_case_l1t(AA,[AA,Value],Value):-!. - is_case_l1t(AA,[AA|Value],Value). - - maybe_special_key_l1ts(Depth,Self,[K-V|KVI],[AK-V|KVO]):- - eval_l1t_args(Depth,Self,K,AK), K\=@=AK,!, - maybe_special_key_l1ts(Depth,Self,KVI,KVO). - maybe_special_key_l1ts(Depth,Self,[_|KVI],KVO):- - maybe_special_key_l1ts(Depth,Self,KVI,KVO). - maybe_special_key_l1ts(_Depth,_Self,[],[]). - - -%[collapse,[1,2,3]] -eval_l1t_args1(Depth,Self,['collapse',List],Res):-!, bagof_eval_l1t(Depth,Self,List,Res). -%[superpose,[1,2,3]] -eval_l1t_args1(Depth,Self,['superpose',List],Res):- !, member(E,List),eval_l1t_args(Depth,Self,E,Res). -get_l1t_sa_p1(P3,E,Cmpd,SA):- compound(Cmpd), get_l1t_sa_p2(P3,E,Cmpd,SA). -get_l1t_sa_p2(P3,E,Cmpd,call(P3,N1,Cmpd)):- arg(N1,Cmpd,E). -get_l1t_sa_p2(P3,E,Cmpd,SA):- arg(_,Cmpd,Arg),get_l1t_sa_p1(P3,E,Arg,SA). -eval_l1t_args1(Depth,Self, Term, Res):- fail, - mnotrace(( get_l1t_sa_p1(setarg,ST,Term,P1), % ST\==Term, - compound(ST), ST = [F,List],F=='superpose',nonvar(List), %maplist(atomic,List), - call(P1,Var))), !, - %max_counting(F,20), - member(Var,List), - eval_l1t_args(Depth,Self, Term, Res). - -/* - -sub_sterm(Sub,Sub). -sub_sterm(Sub,Term):- sub_sterm1(Sub,Term). -sub_sterm1(_ ,List):- \+ compound(List),!,fail. -sub_sterm1(Sub,List):- is_list(List),!,member(SL,List),sub_sterm(Sub,SL). -sub_sterm1(_ ,[_|_]):-!,fail. -sub_sterm1(Sub,Term):- arg(_,Term,SL),sub_sterm(Sub,SL). -*/ - - - -eval_l1t_args1(Depth,Self, Term, Res):- - mnotrace(( get_l1t_sa_p1(setarg,ST,Term,P1), - compound(ST), ST = [F,List],F=='collapse',nonvar(List), %maplist(atomic,List), - call(P1,Var))), !, setof_eval_l1t(Depth,Self,List,Var), - eval_l1t_args(Depth,Self, Term, Res). - - -%max_counting(F,Max):- flag(F,X,X+1), X true; (flag(F,_,10),!,fail). - - -eval_l1t_args1(Depth,Self,['if',Cond,Then],Res):- !, - eval_l1t_args(Depth,Self,Cond,TF), - (is_True(TF) -> eval_l1t_args(Depth,Self,Then,Res) ; Res = []). - -eval_l1t_args1(Depth,Self,['if',Cond,Then,Else],Res):- !, - eval_l1t_args(Depth,Self,Cond,TF), - (is_True(TF) -> eval_l1t_args(Depth,Self,Then,Res);eval_l1t_args(Depth,Self,Else,Res)). - -eval_l1t_args1(_Dpth,_Slf,[_,Nothing],Nothing):- 'Nothing'==Nothing,!. - -eval_l1t_args1(Depth,Self,['let',A,A5,AA],OO):- !, - %(var(A)->true;trace), - ((eval_l1t_args(Depth,Self,A5,AE), AE=A)), - eval_l1t_args(Depth,Self,AA,OO). -%eval_l1t_args1(Depth,Self,['let',A,A5,AA],AAO):- !,eval_l1t_args(Depth,Self,A5,A),eval_l1t_args(Depth,Self,AA,AAO). -eval_l1t_args1(Depth,Self,['let*',[],Body],RetVal):- !, eval_l1t_args(Depth,Self,Body,RetVal). -eval_l1t_args1(Depth,Self,['let*',[[Var,Val]|LetRest],Body],RetVal):- !, - eval_l1t_args1(Depth,Self,['let',Var,Val,['let*',LetRest,Body]],RetVal). - -eval_l1t_args1(Depth,Self,['colapse'|List], Flat):- !, maplist(eval_l1t_args(Depth,Self),List,Res),flatten(Res,Flat). -eval_l1t_args1(Depth,Self,['get-atoms',Other],PredDecl):- !,into_space(Self,Other,Space), metta_atom_iter_l1t(Depth,Space,PredDecl). -eval_l1t_args1(_Dpth,_Slf,['car-atom',Atom],CAR):- !, Atom=[CAR|_],!. -eval_l1t_args1(_Dpth,_Slf,['cdr-atom',Atom],CDR):- !, Atom=[_|CDR],!. - -eval_l1t_args1(Depth,Self,['Cons', A, B ],['Cons', AA, BB]):- no_cons_reduce, !, - eval_l1t_args(Depth,Self,A,AA), eval_l1t_args(Depth,Self,B,BB). - -eval_l1t_args1(Depth,Self,['Cons', A, B ],[AA|BB]):- \+ no_cons_reduce, !, - eval_l1t_args(Depth,Self,A,AA), eval_l1t_args(Depth,Self,B,BB). - - -eval_l1t_args1(Depth,Self,['change-state!',StateExpr, UpdatedValue], Ret):- !, eval_l1t_args(Depth,Self,StateExpr,StateMonad), - eval_l1t_args(Depth,Self,UpdatedValue,Value), 'change-state!'(Depth,Self,StateMonad, Value, Ret). -eval_l1t_args1(Depth,Self,['new-state',UpdatedValue],StateMonad):- !, - eval_l1t_args(Depth,Self,UpdatedValue,Value), 'new-state'(Depth,Self,Value,StateMonad). -eval_l1t_args1(Depth,Self,['get-state',StateExpr],Value):- !, - eval_l1t_args(Depth,Self,StateExpr,StateMonad), 'get-state'(StateMonad,Value). - - - -% eval_l1t_args1(Depth,Self,['get-state',Expr],Value):- !, eval_l1t_args(Depth,Self,Expr,State), arg(1,State,Value). - - - -% check_type:- option_else(typecheck,TF,'False'), TF=='True'. - -:- dynamic is_registered_state/1. -:- flush_output. -:- setenv('RUST_BACKTRACE',full). - -/* -% Function to check if an value is registered as a state name -:- dynamic(is_registered_state/1). - -is_nb_state(G):- is_valid_nb_state(G) -> true ; - is_registered_state(G),nb_current(G,S),is_valid_nb_state(S). - - -:- multifile(state_type_method/3). -:- dynamic(state_type_method/3). -space_type_method(is_nb_state,new_space,init_state). -space_type_method(is_nb_state,clear_space,clear_nb_values). -space_type_method(is_nb_state,add_atom,add_nb_value). -space_type_method(is_nb_state,remove_atom,'change-state!'). -space_type_method(is_nb_state,replace_atom,replace_nb_value). -space_type_method(is_nb_state,atom_count,value_nb_count). -space_type_method(is_nb_state,get_atoms,'get-state'). -space_type_method(is_nb_state,atom_iter,value_nb_iter). - -state_type_method(is_nb_state,new_state,init_state). -state_type_method(is_nb_state,clear_state,clear_nb_values). -state_type_method(is_nb_state,add_value,add_nb_value). -state_type_method(is_nb_state,remove_value,'change-state!'). -state_type_method(is_nb_state,replace_value,replace_nb_value). -state_type_method(is_nb_state,value_count,value_nb_count). -state_type_method(is_nb_state,'get-state','get-state'). -state_type_method(is_nb_state,value_iter,value_nb_iter). -%state_type_method(is_nb_state,query,state_nb_query). - -% Clear all values from a state -clear_nb_values(StateNameOrInstance) :- - fetch_or_create_state(StateNameOrInstance, State), - nb_setarg(1, State, []). - - - -% Function to confirm if a term represents a state -is_valid_nb_state(State):- compound(State),functor(State,'State',_). - -% Find the original name of a given state -state_original_name(State, Name) :- - is_registered_state(Name), - nb_current(Name, State). - -% Register and initialize a new state -init_state(Name) :- - State = 'State'(_,_), - asserta(is_registered_state(Name)), - nb_setval(Name, State). - -% Change a value in a state -'change-state!'(Depth,Self,StateNameOrInstance, UpdatedValue, Out) :- - fetch_or_create_state(StateNameOrInstance, State), - arg(2, State, Type), - ( (check_type,\+ get_type(Depth,Self,UpdatedValue,Type)) - -> (Out = ['Error', UpdatedValue, 'BadType']) - ; (nb_setarg(1, State, UpdatedValue), Out = State) ). - -% Fetch all values from a state -'get-state'(StateNameOrInstance, Values) :- - fetch_or_create_state(StateNameOrInstance, State), - arg(1, State, Values). - -'new-state'(Depth,Self,Init,'State'(Init, Type)):- check_type->get_type(Depth,Self,Init,Type);true. - -'new-state'(Init,'State'(Init, Type)):- check_type->get_type(10,'&self',Init,Type);true. - -fetch_or_create_state(Name):- fetch_or_create_state(Name,_). -% Fetch an existing state or create a new one - -fetch_or_create_state(State, State) :- is_valid_nb_state(State),!. -fetch_or_create_state(NameOrInstance, State) :- - ( atom(NameOrInstance) - -> (is_registered_state(NameOrInstance) - -> nb_current(NameOrInstance, State) - ; init_state(NameOrInstance), - nb_current(NameOrInstance, State)) - ; is_valid_nb_state(NameOrInstance) - -> State = NameOrInstance - ; writeln('Error: Invalid input.') - ), - is_valid_nb_state(State). - -*/ - -eval_l1t_args1(Depth,Self,['get-type',Val],Type):- !, get_type(Depth,Self,Val,Type),ground(Type),Type\==[], Type\==Val,!. - -% mnotrace(G):- once(G). -/* -is_decl_type(ST):- metta_type(_,_,Type),sub_term(T,Type),T=@=ST, \+ nontype(ST). -is_type(Type):- nontype(Type),!,fail. -is_type(Type):- is_decl_type(Type). -is_type(Type):- atom(Type). - -nontype(Type):- var(Type),!. -nontype('->'). -nontype(N):- number(N). - -needs_eval_l1t(EvalMe):- is_list(EvalMe),!. - -get_type(_Dpth,_Slf,Var,'%Undefined%'):- var(Var),!. -get_type(_Dpth,_Slf,Val,'Number'):- number(Val),!. -get_type(Depth,Self,Expr,['StateMonad',Type]):- is_valid_nb_state(Expr),'get-state'(Expr,Val),!, - get_type(Depth,Self,Val,Type). - - -get_type(Depth,Self,EvalMe,Type):- needs_eval_l1t(EvalMe),eval_l1t_args(Depth,Self,EvalMe,Val), \+ needs_eval_l1t(Val),!, - get_type(Depth,Self,Val,Type). - -get_type(_Dpth,Self,[Fn|_],Type):- symbol(Fn),metta_type(Self,Fn,List),last_element(List,Type), nonvar(Type), - is_type(Type). -get_type(_Dpth,Self,List,Type):- is_list(List),metta_type(Self,List,LType),last_element(LType,Type), nonvar(Type), - is_type(Type). - -get_type(Depth,_Slf,Type,Type):- Depth<1,!. -get_type(_Dpth,Self,List,Type):- is_list(List),metta_type(Self,Type,['->'|List]). -get_type(Depth,Self,List,Types):- List\==[], is_list(List),Depth2 is Depth-1,maplist(get_type(Depth2,Self),List,Types). -get_type(_Dpth,Self,Fn,Type):- symbol(Fn),metta_type(Self,Fn,Type),!. -%get_type(Depth,Self,Fn,Type):- nonvar(Fn),metta_type(Self,Fn,Type2),Depth2 is Depth-1,get_type(Depth2,Self,Type2,Type). -%get_type(Depth,Self,Fn,Type):- Depth>0,nonvar(Fn),metta_type(Self,Type,Fn),!. %,!,last_element(List,Type). - -get_type(Depth,Self,Expr,Type):-Depth2 is Depth-1, eval_l1t_args(Depth2,Self,Expr,Val),Expr\=@=Val,get_type(Depth2,Self,Val,Type). - - -get_type(_Dpth,_Slf,Val,'String'):- string(Val),!. -get_type(_Dpth,_Slf,Val,Type):- is_decl_type(Val),Type=Val. -get_type(_Dpth,_Slf,Val,'Bool'):- (Val=='False';Val=='True'),!. -get_type(_Dpth,_Slf,Val,'Symbol'):- symbol(Val). -%get_type(Depth,Self,[T|List],['List',Type]):- Depth2 is Depth-1, is_list(List),get_type(Depth2,Self,T,Type),!, -% forall((member(Ele,List),nonvar(Ele)),get_type(Depth2,Self,Ele,Type)),!. -%get_type(Depth,_Slf,Cmpd,Type):- compound(Cmpd), functor(Cmpd,Type,1),!. -get_type(_Dpth,_Slf,Cmpd,Type):- \+ ground(Cmpd),!,Type=[]. -get_type(_Dpth,_Slf,_,'%Undefined%'):- fail. -*/ - -eval_l1t_args1(Depth,Self,['length',L],Res):- !, eval_l1t_args(Depth,Self,L,LL), !, (is_list(LL)->length(LL,Res);Res=1). -eval_l1t_args1(Depth,Self,['CountElement',L],Res):- !, eval_l1t_args(Depth,Self,L,LL), !, (is_list(LL)->length(LL,Res);Res=1). - -/* - -is_feo_f('Cons'). - -is_seo_f('{...}'). -is_seo_f('[...]'). -is_seo_f('{}'). -is_seo_f('[]'). -is_seo_f('StateMonad'). -is_seo_f('State'). -is_seo_f('Event'). -is_seo_f('Concept'). -is_seo_f(N):- number(N),!. - -*/ - -/* -eval_l1t_args1(Depth,Self,[F,A|Args],Res):- - \+ self_eval_l1t(A), - eval_l1t_args(Depth,Self,A,AA),AA\==A, - eval_l1t_args(Depth,Self,[F,AA|Args],Res). - - -eval_l1t_args1(Depth,Self,[F,A1|AArgs],Res):- fail, member(F,['+']), - cwdl(40,(( - append(L,[A|R],AArgs), - \+ self_eval_l1t(A), - eval_l1t_args(Depth,Self,A,AA),AA\==A,!, - append(L,[AA|R],NewArgs), eval_l1t_args(Depth,Self,[F,A1|NewArgs],Res)))). -*/ - -/* %% - -% !(assertEqualToResult ((inc) 2) (3)) -eval_l1t_args1(Depth,Self,[F|Args],Res):- is_list(F), - metta_atom_iter_l1t(Depth,Self,['=',F,R]), eval_l1t_args(Depth,Self,[R|Args],Res). - -eval_l1t_args1(Depth,Self,[F|Args],Res):- is_list(F), Args\==[], - append(F,Args,FArgs),!,eval_l1t_args(Depth,Self,FArgs,Res). -*/ -eval_l1t_args1(_Dpth,Self,['import!',Other,File],RetVal):- into_space(Self,Other,Space),!, include_metta(Space,File),!,return_empty(Space,RetVal). %RetVal=[]. -eval_l1t_args1(Depth,Self,['bind!',Other,Expr],RetVal):- - into_name(Self,Other,Name),!,eval_l1t_args(Depth,Self,Expr,Value),nb_setval(Name,Value), return_empty(Value,RetVal). -eval_l1t_args1(Depth,Self,['pragma!',Other,Expr],RetVal):- - into_name(Self,Other,Name),!,eval_l1t_args(Depth,Self,Expr,Value),set_option_value(Name,Value), return_empty(Value,RetVal). -eval_l1t_args1(_Dpth,Self,['transfer!',File],RetVal):- !, include_metta(Self,File), return_empty(Self,RetVal). - - - -eval_l1t_args1(Depth,Self,['nop',Expr],Empty):- !, eval_l1t_args(Depth,Self,Expr,_), return_empty([],Empty). - -/* -is_True(T):- T\=='False',T\=='F',T\==[]. - -is_and(S):- \+ atom(S),!,fail. -is_and('#COMMA'). is_and(','). is_and('and'). is_and('And'). -*/ -eval_l1t_args1(_Dpth,_Slf,[And],'True'):- is_and(And),!. -eval_l1t_args1(Depth,Self,['and',X,Y],TF):- !, as_tf((eval_l1t_args(Depth,Self,X,'True'),eval_l1t_args(Depth,Self,Y,'True')),TF). -eval_l1t_args1(Depth,Self,[And,X|Y],TF):- is_and(And),!,eval_l1t_args(Depth,Self,X,TF1), - is_True(TF1),eval_l1t_args1(Depth,Self,[And|Y],TF). -%eval_l1t_args2(Depth,Self,[H|T],_):- \+ is_list(T),!,fail. -eval_l1t_args1(Depth,Self,['or',X,Y],TF):- !, as_tf((eval_l1t_args(Depth,Self,X,'True');eval_l1t_args(Depth,Self,Y,'True')),TF). - - - -eval_l1t_args1(_Dpth,Self,['add-atom',Other,PredDecl],TF):- !, into_space(Self,Other,Space), as_tf(do_metta(Space,load,PredDecl),TF). -eval_l1t_args1(_Dpth,Self,['remove-atom',Other,PredDecl],TF):- !, into_space(Self,Other,Space), as_tf(do_metta(Space,unload,PredDecl),TF). -eval_l1t_args1(_Dpth,Self,['atom-count',Other],Count):- !, into_space(Self,Other,Space), findall(_,metta_defn(Expander,Other,_,_),L1),length(L1,C1),findall(_,metta_atom(Space,_),L2),length(L2,C2),Count is C1+C2. -eval_l1t_args1(_Dpth,Self,['atom-replace',Other,Rem,Add],TF):- !, into_space(Self,Other,Space), copy_term(Rem,RCopy), - as_tf((metta_atom_iter_l1t_ref(Space,RCopy,Ref), RCopy=@=Rem,erase(Ref), do_metta(Other,load,Add)),TF). - - -eval_l1t_args1(Depth,Self,['+',N1,N2],N):- number(N1),!, - eval_l1t_args(Depth,Self,N2,N2Res), catch_err(N is N1+N2Res,_E,(set_last_error(['Error',N2Res,'Number']),fail)). -eval_l1t_args1(Depth,Self,['-',N1,N2],N):- number(N1),!, - eval_l1t_args(Depth,Self,N2,N2Res), catch_err(N is N1-N2Res,_E,(set_last_error(['Error',N2Res,'Number']),fail)). - -eval_l1t_args1(Depth,Self,[V|VI],[V|VO]):- nonvar(V),is_metta_data_functor(V),is_list(VI),!,maplist(eval_l1t_args(Depth,Self),VI,VO). - -eval_l1t_args1(Depth,Self,X,Y):- - (eval_l1t_args2(Depth,Self,X,Y)*->true; - (eval_l1t_args2_failed(Depth,Self,X,Y)*->true;X=Y)). - - -eval_l1t_args2_failed(_Dpth,_Slf,T,TT):- T==[],!,TT=[]. -eval_l1t_args2_failed(_Dpth,_Slf,T,TT):- var(T),!,TT=T. -eval_l1t_args2_failed(_Dpth,_Slf,[F|LESS],Res):- once(eval_l1t_selfless([F|LESS],Res)),mnotrace([F|LESS]\==Res),!. -%eval_l1t_args2_failed(Depth,Self,[V|Nil],[O]):- Nil==[], once(eval_l1t_args(Depth,Self,V,O)),V\=@=O,!. -eval_l1t_args2_failed(Depth,Self,[H|T],[HH|TT]):- !, - eval_l1t_args(Depth,Self,H,HH), - eval_l1t_args2_failed(Depth,Self,T,TT). - -eval_l1t_args2_failed(Depth,Self,T,TT):- eval_l1t_args(Depth,Self,T,TT). - - %eval_l1t_args(Depth,Self,X,Y):- eval_l1t_args1(Depth,Self,X,Y)*->true;Y=[]. - -%eval_l1t_args1(Depth,_,_,_):- Depth<1,!,fail. -%eval_l1t_args1(Depth,_,X,Y):- Depth<3, !, ground(X), (Y=X). -%eval_l1t_args1(_Dpth,_Slf,X,Y):- self_eval_l1t(X),!,Y=X. - -% Kills zero arity functions eval_l1t_args1(Depth,Self,[X|Nil],[Y]):- Nil ==[],!,eval_l1t_args(Depth,Self,X,Y). - - -/* -into_values(List,Many):- List==[],!,Many=[]. -into_values([X|List],Many):- List==[],is_list(X),!,Many=X. -into_values(Many,Many). -eval_l1t_args2(_Dpth,_Slf,Name,Value):- atom(Name), nb_current(Name,Value),!. -*/ -% Macro Functions -%eval_l1t_args1(Depth,_,_,_):- Depth<1,!,fail. -eval_l1t_args2(Depth,_,X,Y):- Depth<3, !, fail, ground(X), (Y=X). -eval_l1t_args2(Depth,Self,[F|PredDecl],Res):- - Depth>1, - mnotrace((sub_sterm1(SSub,PredDecl), ground(SSub),SSub=[_|Sub], is_list(Sub), maplist(atomic,SSub))), - eval_l1t_args(Depth,Self,SSub,Repl), - mnotrace((SSub\=Repl, subst(PredDecl,SSub,Repl,Temp))), - eval_l1t_args(Depth,Self,[F|Temp],Res). - - - -% user defined function -eval_l1t_args2(Depth,Self,[H|PredDecl],Res):- mnotrace(is_user_defined_head(Self,H)),!, - eval_l1t_args30(Depth,Self,[H|PredDecl],Res). - -% function inherited by system -eval_l1t_args2(Depth,Self,PredDecl,Res):- eval_l1t_args40(Depth,Self,PredDecl,Res). - -/* -last_element(T,E):- \+ compound(T),!,E=T. -last_element(T,E):- is_list(T),last(T,L),last_element(L,E),!. -last_element(T,E):- compound_name_arguments(T,_,List),last_element(List,E),!. - - - - -%catch_warn(G):- notrace(catch_err(G,E,(wdmsg(catch_warn(G)-->E),fail))). -%catch_nowarn(G):- notrace(catch_err(G,error(_,_),fail)). - -%as_tf(G,TF):- catch_nowarn((call(G)*->TF='True';TF='False')). -*/ -eval_l1t_selfless(['==',X,Y],TF):- as_tf(X=:=Y,TF),!. -eval_l1t_selfless(['==',X,Y],TF):- as_tf(X=@=Y,TF),!. -eval_l1t_selfless(['=',X,Y],TF):-!,as_tf(X=Y,TF). -eval_l1t_selfless(['>',X,Y],TF):-!,as_tf(X>Y,TF). -eval_l1t_selfless(['<',X,Y],TF):-!,as_tf(X',X,Y],TF):-!,as_tf(X>=Y,TF). -eval_l1t_selfless(['<=',X,Y],TF):-!,as_tf(X= Bool Atom Atom)) -(= (ift True $then) $then) - -; For anything that is green, assert it is Green in &kb22 -!(ift (green $x) - (add-atom &kb22 (Green $x))) - -; Retrieve the inferred Green things: Fritz and Sam. -!(assertEqualToResult - (match &kb22 (Green $x) $x) - (Fritz Sam)) -*/ -:- discontiguous eval_l1t_args3/4. -%eval_l1t_args2(Depth,Self,PredDecl,Res):- eval_l1t_args3(Depth,Self,PredDecl,Res). - -%eval_l1t_args2(_Dpth,_Slf,L1,Res):- is_list(L1),maplist(self_eval_l1t,L1),!,Res=L1. -%eval_l1t_args2(_Depth,_Self,X,X). - -/* -is_user_defined_head(Other,H):- mnotrace(is_user_defined_head0(Other,H)). -is_user_defined_head0(Other,[H|_]):- !, nonvar(H),!, is_user_defined_head_f(Other,H). -is_user_defined_head0(Other,H):- callable(H),!,functor(H,F,_), is_user_defined_head_f(Other,F). -is_user_defined_head0(Other,H):- is_user_defined_head_f(Other,H). - -is_user_defined_head_f(Other,H):- is_user_defined_head_f1(Other,H). -is_user_defined_head_f(Other,H):- is_user_defined_head_f1(Other,[H|_]). - -%is_user_defined_head_f1(Other,H):- metta_type(Other,H,_). -is_user_defined_head_f1(Other,H):- metta_atom(Other,[H|_]). -is_user_defined_head_f1(Other,H):- metta_defn(Expander,Other,[H|_],_). -%is_user_defined_head_f(_,H):- is_metta_builtin(H). - - -is_special_op(F):- \+ atom(F), \+ var(F), !, fail. -is_special_op('case'). -is_special_op(':'). -is_special_op('='). -is_special_op('->'). -is_special_op('let'). -is_special_op('let*'). -is_special_op('if'). -is_special_op('rtrace'). -is_special_op('or'). -is_special_op('and'). -is_special_op('not'). -is_special_op('match'). -is_special_op('call'). -is_special_op('let'). -is_special_op('let*'). -is_special_op('nop'). -is_special_op('assertEqual'). -is_special_op('assertEqualToResult'). - -is_metta_builtin(Special):- is_special_op(Special). -is_metta_builtin('=='). -is_metta_builtin(F):- once(atom(F);var(F)), current_op(_,yfx,F). -is_metta_builtin('println!'). -is_metta_builtin('transfer!'). -is_metta_builtin('collapse'). -is_metta_builtin('superpose'). -is_metta_builtin('+'). -is_metta_builtin('-'). -is_metta_builtin('*'). -is_metta_builtin('/'). -is_metta_builtin('%'). -is_metta_builtin('=='). -is_metta_builtin('<'). -is_metta_builtin('>'). -is_metta_builtin('all'). -is_metta_builtin('import!'). -is_metta_builtin('pragma!'). -*/ - - -eval_l1t_args30(Depth,Self,H,B):- (eval_l1t_args34(Depth,Self,H,B)*->true;eval_l1t_args37(Depth,Self,H,B)). - -eval_l1t_args34(_Dpth,Self,H,B):- (metta_defn(Expander,Self,H,B);(metta_atom(Self,H),B='True')). - -% Has argument that is headed by the same function -eval_l1t_args37(Depth,Self,[H1|Args],Res):- - mnotrace((append(Left,[[H2|H2Args]|Rest],Args), H2==H1)),!, - eval_l1t_args(Depth,Self,[H2|H2Args],ArgRes), - mnotrace((ArgRes\==[H2|H2Args], append(Left,[ArgRes|Rest],NewArgs))), - eval_l1t_args30(Depth,Self,[H1|NewArgs],Res). - -eval_l1t_args37(Depth,Self,[[H|Start]|T1],Y):- - mnotrace((is_user_defined_head_f(Self,H),is_list(Start))), - metta_defn(Expander,Self,[H|Start],Left), - eval_l1t_args(Depth,Self,[Left|T1],Y). - -% Has subterm to eval_l1t -eval_l1t_args37(Depth,Self,[F|PredDecl],Res):- - Depth>1, - quietly(sub_sterm1(SSub,PredDecl)), - mnotrace((ground(SSub),SSub=[_|Sub], is_list(Sub),maplist(atomic,SSub))), - eval_l1t_args(Depth,Self,SSub,Repl), - mnotrace((SSub\=Repl,subst(PredDecl,SSub,Repl,Temp))), - eval_l1t_args30(Depth,Self,[F|Temp],Res). - -%eval_l1t_args37(Depth,Self,X,Y):- (eval_l1t_args38(Depth,Self,X,Y)*->true;metta_atom_iter_l1t(Depth,Self,[=,X,Y])). - -eval_l1t_args37(Depth,Self,PredDecl,Res):- fail, - ((term_variables(PredDecl,Vars), - (metta_atom(Self,PredDecl) *-> (Vars ==[]->Res='True';Vars=Res); - (eval_l1t_args(Depth,Self,PredDecl,Res),ignore(Vars ==[]->Res='True';Vars=Res))))), - PredDecl\=@=Res. - -eval_l1t_args38(_Dpth,Self,[H|_],_):- mnotrace( \+ is_user_defined_head_f(Self,H) ), !,fail. -eval_l1t_args38(_Dpth,Self,[H|T1],Y):- metta_defn(Expander,Self,[H|T1],Y). -eval_l1t_args38(_Dpth,Self,[H|T1],'True'):- metta_atom(Self,[H|T1]). -eval_l1t_args38(_Dpth,Self,CALL,Y):- fail,append(Left,[Y],CALL),metta_defn(Expander,Self,Left,Y). - - -%eval_l1t_args3(Depth,Self,['ift',CR,Then],RO):- fail, !, %fail, % trace, -% metta_defn(Expander,Self,['ift',R,Then],Become),eval_l1t_args(Depth,Self,CR,R),eval_l1t_args(Depth,Self,Then,_True),eval_l1t_args(Depth,Self,Become,RO). - -metta_atom_iter_l1t(_Dpth,Other,[Equal,H,B]):- '=' == Equal,!, - (metta_defn(Expander,Other,H,B)*->true;(metta_atom(Other,H),B='True')). - -metta_atom_iter_l1t(Depth,_,_):- Depth<3,!,fail. -metta_atom_iter_l1t(_Dpth,_Slf,[]):-!. -metta_atom_iter_l1t(_Dpth,Other,H):- metta_atom(Other,H). -metta_atom_iter_l1t(Depth,Other,H):- D2 is Depth -1, metta_defn(Expander,Other,H,B),metta_atom_iter_l1t(D2,Other,B). -metta_atom_iter_l1t(_Dpth,_Slf,[And]):- is_and(And),!. -metta_atom_iter_l1t(Depth,Self,[And,X|Y]):- is_and(And),!,D2 is Depth -1, metta_atom_iter_l1t(D2,Self,X),metta_atom_iter_l1t(D2,Self,[And|Y]). -/* -metta_atom_iter_l1t2(_,Self,[=,X,Y]):- metta_defn(Expander,Self,X,Y). -metta_atom_iter_l1t2(_Dpth,Other,[Equal,H,B]):- '=' == Equal,!, metta_defn(Expander,Other,H,B). -metta_atom_iter_l1t2(_Dpth,Self,X,Y):- metta_defn(Expander,Self,X,Y). %, Y\=='True'. -metta_atom_iter_l1t2(_Dpth,Self,X,Y):- metta_atom(Self,[=,X,Y]). %, Y\=='True'. - -*/ -metta_atom_iter_l1t_ref(Other,['=',H,B],Ref):-clause(metta_defn(Expander,Other,H,B),true,Ref). -metta_atom_iter_l1t_ref(Other,H,Ref):-clause(metta_atom(Other,H),true,Ref). - -%not_compound(Term):- \+ is_list(Term),!. -%eval_l1t_args2(Depth,Self,Term,Res):- maplist(not_compound,Term),!,eval_l1t_args345(Depth,Self,Term,Res). - - -% function inherited by system -eval_l1t_args40(Depth,Self,[F|X],FY):- is_function(F), \+ is_special_op(F), is_list(X), - maplist(eval_l1t_args(Depth,Self),X,Y),!,eval_l1t_args5(Depth,Self,[F|Y],FY). -eval_l1t_args40(Depth,Self,FX,FY):- eval_l1t_args5(Depth,Self,FX,FY). - -eval_l1t_args5(_Dpth,_Slf,[F|LESS],Res):- once(eval_l1t_selfless([F|LESS],Res)),mnotrace(([F|LESS]\==Res)),!. -eval_l1t_args5(Depth,Self,[AE|More],TF):- length(More,Len), - (is_syspred(AE,Len,Pred),catch_warn(as_tf(apply(Pred,More),TF)))*->true;eval_l1t_args6(Depth,Self,[AE|More],TF). -eval_l1t_args6(_Dpth,_Slf,[AE|More],TF):- length([AE|More],Len), is_syspred(AE,Len,Pred),append(More,[TF],Args),!,catch_warn(apply(Pred,Args)). - -%eval_l1t_args40(Depth,Self,[X1|[F2|X2]],[Y1|Y2]):- is_function(F2),!,eval_l1t_args(Depth,Self,[F2|X2],Y2),eval_l1t_args(Depth,Self,X1,Y1). - - -%cwdl(DL,Goal):- call_with_depth_limit(Goal,DL,R), (R==depth_limit_exceeded->(!,fail);true). -bagof_eval_l1t(Depth,Self,X,L):- !,findall(E,eval_l1t_args(Depth,Self,X,E),L). -setof_eval_l1t(Depth,Self,X,S):- !,findall(E,eval_l1t_args(Depth,Self,X,E),L),sort(L,S). -%setof_eval_l1t(Depth,Self,X,S):- setof(E,eval_l1t_args(Depth,Self,X,E),S)*->true;S=[]. - - diff --git a/.Attic/metta_lang/metta_test_nars_1.pl b/.Attic/metta_lang/metta_test_nars_1.pl deleted file mode 100755 index 9199e2d49e0..00000000000 --- a/.Attic/metta_lang/metta_test_nars_1.pl +++ /dev/null @@ -1,1752 +0,0 @@ -% (track_load_into_file "../../examples/VRUN_tests1.metta") -:-metta_eval(['extend-py!',mettalog]). - -%;; stdlib extension -metta_type('&self','If',[->,'Bool','Atom','Atom']). - -metta_defn_ES(['If','True',Then],Then). - -metta_defn_ES(['If','False',Then],[]). - -metta_type('&self','If',[->,'Bool','Atom','Atom','Atom']). - -metta_defn_ES( - ['If',Cond,Then,Else], - [if,Cond,Then,Else]). - -metta_defn_ES( - ['TupleConcat',Ev1,Ev2], - [ collapse, - [ superpose, - [ [ superpose, Ev1 ], - [ superpose, Ev2 ]]]]). - -metta_defn_ES( - [max,Num1,Num2], - [ 'If', - [>,Num1,Num2], Num1,Num2]). - -metta_defn_ES( - [min,Num1,Num2], - [ 'If', - [<,Num1,Num2], Num1,Num2]). - -metta_defn_ES( - [abs,X], - [ 'If', - [<,X,0], - [-,0,X], - X]). - -metta_type('&self',sequential,[->,'Expression','%Undefined%']). - -metta_defn_ES([sequential,Num1],[superpose,Num1]). - -metta_type('&self',do,[->,'Expression','%Undefined%']). - -metta_defn_ES([do,Num1],[case,Num1,[]]). - -metta_defn_ES(['TupleCount',[]],0). - -metta_defn_ES(['TupleCount',[1]],1). - -metta_defn_ES( - ['BuildTupleCounts',TOld,C,N], - [ let, - T, - [ collapse, - [ superpose, - [ 1, - [superpose,TOld]]]], - [ superpose, - [ [ 'add-atom', - '&self', - [ =, - ['TupleCount',T], - [+,C,2]]], - [ 'If', - [<,C,N], - [ 'BuildTupleCounts', - T, - [+,C,1], - N]]]]]). - -metta_type('&self','CountElement',[->,'Expression','Number']). - -metta_defn_ES( - ['CountElement',X], - [ case, - X, - [ [ Y,1]]]). - -%;;Build for count up to 100 (takes a few sec but it is worth it if space or generally collapse counts are often needed) -:-metta_eval(['BuildTupleCounts',[1],0,100]). - -metta_defn_ES( - [ 'BuildTupleCounts', - [1], 0,100], - [ let, - A, - [ collapse, - [ superpose, - [ 1, - [ superpose, - [1]]]]], - [ superpose, - [ [ 'add-atom', - '&self', - [ =, - ['TupleCount',A], - [+,0,2]]], - [ 'If', - [<,0,100], - [ 'BuildTupleCounts', - A, - [+,0,1], - 100]]]]]). - -metta_type('&self','CollapseCardinality',[->,'Expression','Number']). - -metta_defn_ES( - ['CollapseCardinality',Expression], - [ 'TupleCount', - [ collapse, - ['CountElement',Expression]]]). - -%;; Truth functions -metta_defn_ES( - ['Truth_c2w',C], - [ /, - C, - [-,1,C]]). - -metta_defn_ES( - ['Truth_w2c',W], - [ /, - W, - [+,W,1]]). - -metta_defn_ES( - [ 'Truth_Deduction', - [F1,C1], - [F2,C2]], - [ [*,F1,F2], - [ *, - [*,F1,F2], - [*,C1,C2]]]). - -metta_defn_ES( - [ 'Truth_Abduction', - [F1,C1], - [F2,C2]], - [ F2, - [ 'Truth_w2c', - [ *, - [*,F1,C1], - C2]]]). - -metta_defn_ES( - ['Truth_Induction',T1,T2], - ['Truth_Abduction',T2,T1]). - -metta_defn_ES( - [ 'Truth_Exemplification', - [F1,C1], - [F2,C2]], - [ 1.0, - [ 'Truth_w2c', - [ *, - [*,F1,F2], - [*,C1,C2]]]]). - -metta_defn_ES( - ['Truth_StructuralDeduction',T], - [ 'Truth_Deduction', - T, - [1.0,0.9]]). - -metta_defn_ES( - [ 'Truth_Negation', - [F,C]], - [ [-,1,F], - C]). - -metta_defn_ES( - ['Truth','StructuralDeductionNegated',T], - [ 'Truth_Negation', - ['Truth_StructuralDeduction',T]]). - -metta_defn_ES( - [ 'Truth_Intersection', - [F1,C1], - [F2,C2]], - [ [ * ,F1,F2], - [ * ,C1,C2]]). - -metta_defn_ES( - ['Truth_StructuralIntersection',T], - [ 'Truth_Intersection', - T, - [1.0,0.9]]). - -metta_defn_ES( - ['Truth_or',A,B], - [ -, - 1, - [ *, - [-,1,A], - [-,1,B]]]). - -metta_defn_ES( - [ 'Truth_Comparison', - [F1,C1], - [F2,C2]], - [ let, - F0, - ['Truth_or',F1,F2], - [ [ 'If', - [==,F0,0.0], - 0.0, - [ /, - [*,F1,F2], - F0]], - [ 'Truth_w2c', - [ *, - F0, - [*,C1,C2]]]]]). - -metta_defn_ES( - [ 'Truth_Analogy', - [F1,C1], - [F2,C2]], - [ [*,F1,F2], - [ *, - [*,C1,C2], - F2]]). - -metta_defn_ES( - [ 'Truth_Resemblance', - [F1,C1], - [F2,C2]], - [ [*,F1,F2], - [ *, - [*,C1,C2], - ['Truth_or',F1,F2]]]). - -metta_defn_ES( - [ 'Truth_Union', - [F1,C1], - [F2,C2]], - [ [ 'Truth_or', F1 , F2 ], - [ * , C1 , C2 ]]). - -metta_defn_ES( - [ 'Truth_Difference', - [F1,C1], - [F2,C2]], - [ [ *, - F1, - [-,1,F2]], - [*,C1,C2]]). - -metta_defn_ES( - [ 'Truth_DecomposePNN', - [F1,C1], - [F2,C2]], - [ let, - Fn, - [ *, - F1, - [-,1,F2]], - [ [-,1,Fn], - [ *, - Fn, - [*,C1,C2]]]]). - -metta_defn_ES( - [ 'Truth_DecomposeNPP', - [F1,C1], - [F2,C2]], - [ let, - F, - [ *, - [-,1,F1], - F2], - [ F, - [ *, - F, - [*,C1,C2]]]]). - -metta_defn_ES( - [ 'Truth_DecomposePNP', - [F1,C1], - [F2,C2]], - [ let, - F, - [ *, - F1, - [-,1,F2]], - [ F, - [ *, - F, - [*,C1,C2]]]]). - -metta_defn_ES( - ['Truth_DecomposePPP',V1,V2], - [ 'Truth_DecomposeNPP', - ['Truth_Negation',V1], - V2]). - -metta_defn_ES( - [ 'Truth_DecomposeNNN', - [F1,C1], - [F2,C2]], - [ let, - Fn, - [ *, - [-,1,F1], - [-,1,F2]], - [ [-,1,Fn], - [ *, - Fn, - [*,C1,C2]]]]). - -metta_defn_ES( - [ 'Truth_Eternalize', - [F,C]], - [ F, - ['Truth_w2c',C]]). - -metta_defn_ES( - [ 'Truth_Revision', - [F1,C1], - [F2,C2]], - [ 'let*', - [ [ W1, - ['Truth_c2w',C1]], - [ W2, - ['Truth_c2w',C2]], - [ W, - [+,W1,W2]], - [ F, - [ /, - [ +, - [*,W1,F1], - [*,W2,F2]], - W]], - [ C, - ['Truth_w2c',W]]], - [ [min,1.0,F], - [ min, - 0.99, - [ max, - [max,C,C1], - C2]]]]). - -metta_defn_ES( - [ 'Truth_Expectation', - [F,C]], - [ +, - [ *, - C, - [-,F,0.5]], - 0.5]). -% ;;NAL-1 -% ;;!Syllogistic rules for Inheritance: -metta_defn_ES(['|-',[[A,-->,B],C],[[B,-->,D],E]] , [[A,-->,D],['Truth_Deduction',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[A,-->,D],E]] , [[D,-->,B],['Truth_Induction',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[D,-->,B],E]] , [[D,-->,A],['Truth_Abduction',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[B,-->,D],E]] , [[D,-->,A],['Truth_Exemplification',C,E]]). -% ;;NAL-2 -% ;;!Rules for Similarity: -metta_defn_ES(['|-',[[A,<->,B],C]] , [[B,<->,A],['Truth_StructuralIntersection',C]]). -metta_defn_ES(['|-',[[A,<->,B],C],[[D,<->,A],E]] , [[D,<->,B],['Truth_Resemblance',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[D,-->,B],E]] , [[D,<->,A],['Truth_Comparison',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[A,-->,D],E]] , [[D,<->,B],['Truth_Comparison',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[D,<->,A],E]] , [[D,-->,B],['Truth_Analogy',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[D,<->,B],E]] , [[A,-->,D],['Truth_Analogy',C,E]]). -% ;;!Dealing with properties and instances: -metta_defn_ES(['|-',[[A,-->,['{',B,'}']],C]] , [[A,<->,['{',B,'}']],['Truth_StructuralIntersection',C]]). -metta_defn_ES(['|-',[[['$OBJ'(claz_bracket_vector,['$S'])],-->,A],B]] , [[['$OBJ'(claz_bracket_vector,['$S'])],<->,A],['Truth_StructuralIntersection',B]]). -metta_defn_ES(['|-',[[['{',A,'}'],-->,B],C],[[D,<->,A],E]] , [[['{',D,'}'],-->,B],['Truth_Analogy',C,E]]). -metta_defn_ES(['|-',[[A,-->,['$OBJ'(claz_bracket_vector,['$M'])]],B],[[_,<->,_],C]] , [[A,-->,['$OBJ'(claz_bracket_vector,['$S'])]],['Truth_Analogy',B,C]]). -get_metta_atom(Eq,'&self',[=,['|-',[[['{',A,'}'],<->,['{',B,'}']]],[A,<->,B],['Truth_StructuralIntersection',_]]]). -get_metta_atom(Eq,'&self',[=,['|-',[[['$OBJ'(claz_bracket_vector,[A])],<->,['$OBJ'(claz_bracket_vector,[B])]]],[_,<->,_],['Truth_StructuralIntersection',_]]]). -% ;;NAL-3 -% ;;!Set decomposition: -metta_defn_ES(['|-',[[['{',A,_,'}'],-->,B],C]] , [[['{',A,'}'],-->,B],['Truth_StructuralDeduction',C]]). -metta_defn_ES(['|-',[[['{',_,A,'}'],-->,B],C]] , [[['{',A,'}'],-->,B],['Truth_StructuralDeduction',C]]). -metta_defn_ES(['|-',[['M',-->,['$OBJ'(claz_bracket_vector,[A,B])]],A]] , [['M',-->,['$OBJ'(claz_bracket_vector,[A])]],['Truth_StructuralDeduction',A]]). -metta_defn_ES(['|-',[['M',-->,['$OBJ'(claz_bracket_vector,[A,B])]],A]] , [['M',-->,['$OBJ'(claz_bracket_vector,[B])]],['Truth_StructuralDeduction',A]]). -% ;;!Extensional and intensional intersection decomposition: -metta_defn_ES(['|-',[[[A,'|',_],-->,B],C]] , [[A,-->,B],['Truth_StructuralDeduction',C]]). -metta_defn_ES(['|-',[[A,-->,[B,&,_]],C]] , [[A,-->,B],['Truth_StructuralDeduction',C]]). -metta_defn_ES(['|-',[[[_,'|',A],-->,B],C]] , [[A,-->,B],['Truth_StructuralDeduction',C]]). -metta_defn_ES(['|-',[[A,-->,[_,&,B]],C]] , [[A,-->,B],['Truth_StructuralDeduction',C]]). -metta_defn_ES(['|-',[[[A,~,_],-->,B],C]] , [[A,-->,B],['Truth_StructuralDeduction',C]]). -metta_defn_ES(['|-',[[A,-->,[B,-,_]],C]] , [[A,-->,B],['Truth_StructuralDeduction',C]]). -metta_defn_ES(['|-',[[[_,~,A],-->,B],C]] , [[A,-->,B],['Truth_StructuralDeductionNegated',C]]). -metta_defn_ES(['|-',[[A,-->,[_,-,B]],C]] , [[A,-->,B],['Truth_StructuralDeductionNegated',C]]). -% ;;!Extensional and intensional intersection composition: (sets via reductions). -metta_defn_ES(['|-',[[A,-->,B],C],[[D,-->,B],E]] , [[[A,'|',D],-->,B],['Truth_Intersection',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[D,-->,B],E]] , [[[A,&,D],-->,B],['Truth_Union',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[D,-->,B],E]] , [[[A,~,D],-->,B],['Truth_Difference',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[A,-->,D],E]] , [[A,-->,[B,&,D]],['Truth_Intersection',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[A,-->,D],E]] , [[A,-->,[B,'|',D]],['Truth_Union',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[A,-->,D],E]] , [[A,-->,[B,-,D]],['Truth_Difference',C,E]]). -% ;;!Extensional and intensional intersection decomposition: -metta_defn_ES(['|-',[[A,-->,B],C],[[[A,'|',D],-->,B],E]] , [[D,-->,B],['Truth_DecomposePNN',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[[D,'|',A],-->,B],E]] , [[D,-->,B],['Truth_DecomposePNN',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[[A,&,D],-->,B],E]] , [[D,-->,B],['Truth_DecomposeNPP',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[[D,&,A],-->,B],E]] , [[D,-->,B],['Truth_DecomposeNPP',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[[A,~,D],-->,B],E]] , [[D,-->,B],['Truth_DecomposePNP',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[[D,~,A],-->,B],E]] , [[D,-->,B],['Truth_DecomposeNNN',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[A,-->,[B,&,D]],E]] , [[A,-->,D],['Truth_DecomposePNN',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[A,-->,[D,&,B]],E]] , [[A,-->,D],['Truth_DecomposePNN',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[A,-->,[B,'|',D]],E]] , [[A,-->,D],['Truth_DecomposeNPP',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[A,-->,[D,'|',B]],E]] , [[A,-->,D],['Truth_DecomposeNPP',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[A,-->,[B,-,D]],E]] , [[A,-->,D],['Truth_DecomposePNP',C,E]]). -metta_defn_ES(['|-',[[A,-->,B],C],[[A,-->,[D,-,B]],E]] , [[A,-->,D],['Truth_DecomposeNNN',C,E]]). -% ;; NAL-4 -% ;;!Transformation rules between product and image: -metta_defn_ES(['|-',[[[A,*,B],-->,C],D]] , [[A,-->,[C,'/1',B]],['Truth_StructuralIntersection',D]]). -metta_defn_ES(['|-',[[[A,*,B],-->,C],D]] , [[B,-->,[C,'/2',A]],['Truth_StructuralIntersection',D]]). -metta_defn_ES(['|-',[[A,-->,[B,*,C]],D]] , [[[A,'\\1',C],-->,B],['Truth_StructuralIntersection',D]]). -metta_defn_ES(['|-',[[A,-->,[B,*,C]],D]] , [[[A,'\\2',B],-->,C],['Truth_StructuralIntersection',D]]). -% ;;other direction of same rules (as these are bi-directional). -metta_defn_ES(['|-',[[A,-->,[B,'/1',C]],D]] , [[[A,*,C],-->,B],['Truth_StructuralIntersection',D]]). -metta_defn_ES(['|-',[[A,-->,[B,'/2',C]],D]] , [[[C,*,A],-->,B],['Truth_StructuralIntersection',D]]). -metta_defn_ES(['|-',[[[A,'\\1',B],-->,C],D]] , [[A,-->,[C,*,B]],['Truth_StructuralIntersection',D]]). -metta_defn_ES(['|-',[[[A,'\\2',B],-->,C],D]] , [[A,-->,[B,*,C]],['Truth_StructuralIntersection',D]]). -% ;;!Comparative relations -metta_defn_ES(['|-',[[['{',A,'}'],'|-',>,['$OBJ'(claz_bracket_vector,['$P'])]],B],[[['{',C,'}'],'|-',>,['$OBJ'(claz_bracket_vector,['$P'])]],D]] , [[[['{',A,'}'],*,['{',C,'}']],-->,[>>>,_]],['Truth_FrequencyGreater',B,D]]). -metta_defn_ES(['|-',[[[A,*,B],-->,[>>>,C]],D],[[[B,*,E],-->,[>>>,C]],F]] , [[[A,*,E],-->,[>>>,C]],['Truth_Deduction',D,F]]). -metta_defn_ES(['|-',[[['{',A,'}'],'|-',>,['$OBJ'(claz_bracket_vector,['$P'])]],B],[[['{',C,'}'],'|-',>,['$OBJ'(claz_bracket_vector,['$P'])]],D]] , [[[['{',A,'}'],*,['{',C,'}']],-->,[===,_]],['Truth_FrequencyEqual',B,D]]). -metta_defn_ES(['|-',[[[A,*,B],-->,[===,C]],D],[[[B,*,E],-->,[===,C]],F]] , [[[A,*,E],-->,[===,C]],['Truth_Deduction',D,F]]). -metta_defn_ES(['|-',[[[A,*,B],-->,[===,C]],D]] , [[[B,*,A],-->,[===,C]],['Truth_StructuralIntersection',D]]). -% ;;!Optional rules for more efficient reasoning about relation components: -metta_defn_ES(['|-',[[[A,*,B],-->,C],D],[[[E,*,B],-->,C],F]] , [[E,-->,A],['Truth_Abduction',D,F]]). -metta_defn_ES(['|-',[[[A,*,B],-->,C],D],[[[A,*,E],-->,C],F]] , [[E,-->,B],['Truth_Abduction',D,F]]). -metta_defn_ES(['|-',[[A,-->,[B,*,C]],D],[[A,-->,[E,*,C]],F]] , [[E,-->,B],['Truth_Induction',D,F]]). -metta_defn_ES(['|-',[[A,-->,[B,*,C]],D],[[A,-->,[B,*,E]],F]] , [[E,-->,C],['Truth_Induction',D,F]]). -metta_defn_ES(['|-',[[[A,*,B],-->,C],D],[[E,-->,A],F]] , [[[E,*,B],-->,C],['Truth_Deduction',D,F]]). -metta_defn_ES(['|-',[[[A,*,B],-->,C],D],[[A,-->,E],F]] , [[[E,*,B],-->,C],['Truth_Induction',D,F]]). -metta_defn_ES(['|-',[[[A,*,B],-->,C],D],[[E,<->,A],F]] , [[[E,*,B],-->,C],['Truth_Analogy',D,F]]). -metta_defn_ES(['|-',[[[A,*,B],-->,C],D],[[E,-->,B],F]] , [[[A,*,E],-->,C],['Truth_Deduction',D,F]]). -metta_defn_ES(['|-',[[[A,*,B],-->,C],D],[[B,-->,E],F]] , [[[A,*,E],-->,C],['Truth_Induction',D,F]]). -metta_defn_ES(['|-',[[[A,*,B],-->,C],D],[[E,<->,B],F]] , [[[A,*,E],-->,C],['Truth_Analogy',D,F]]). -metta_defn_ES(['|-',[[A,-->,[B,*,C]],D],[[B,-->,E],F]] , [[A,-->,[E,*,C]],['Truth_Deduction',D,F]]). -metta_defn_ES(['|-',[[A,-->,[B,*,C]],D],[[E,-->,B],F]] , [[A,-->,[E,*,C]],['Truth_Abduction',D,F]]). -metta_defn_ES(['|-',[[A,-->,[B,*,C]],D],[[E,<->,B],F]] , [[A,-->,[E,*,C]],['Truth_Analogy',D,F]]). -metta_defn_ES(['|-',[[A,-->,[B,*,C]],D],[[C,-->,E],F]] , [[A,-->,[B,*,E]],['Truth_Deduction',D,F]]). -metta_defn_ES(['|-',[[A,-->,[B,*,C]],D],[[E,-->,C],F]] , [[A,-->,[B,*,E]],['Truth_Abduction',D,F]]). -metta_defn_ES(['|-',[[A,-->,[B,*,C]],D],[[E,<->,C],F]] , [[A,-->,[B,*,E]],['Truth_Analogy',D,F]]). -metta_defn_ES(['|-',[[[A,*,B],-->,C],D],[[[E,*,B],-->,C],F]] , [[A,<->,E],['Truth_Comparison',D,F]]). -metta_defn_ES(['|-',[[[A,*,B],-->,C],D],[[[A,*,E],-->,C],F]] , [[B,<->,E],['Truth_Comparison',D,F]]). -metta_defn_ES(['|-',[[A,-->,[B,*,C]],D],[[A,-->,[E,*,C]],F]] , [[B,<->,E],['Truth_Comparison',D,F]]). -metta_defn_ES(['|-',[[A,-->,[B,*,C]],D],[[A,-->,[B,*,E]],F]] , [[C,<->,E],['Truth_Comparison',D,F]]). -% ;;NAL-5 -% ;;!Negation conjunction and disjunction decomposition: -metta_defn_ES(['|-',[[!,A],B]],[A,['Truth_Negation',B]]). -metta_defn_ES(['|-',[[A,&&,_],B]],[A,['Truth_StructuralDeduction',B]]). -metta_defn_ES(['|-',[[_,&&,A],B]],[A,['Truth_StructuralDeduction',B]]). -metta_defn_ES(['|-',[[A,&&,B],C]] , [[B,&&,A],['Truth_StructuralIntersection',C]]). -metta_defn_ES(['|-',[A,B],[[A,&&,C],D]],[C,['Truth_DecomposePNN',B,D]]). -metta_defn_ES(['|-',[A,B],[[A,'||',C],D]],[C,['Truth_DecomposeNPP',B,D]]). -metta_defn_ES(['|-',[A,B],[[[!,A],&&,C],D]],[C,['Truth_DecomposeNNN',B,D]]). -metta_defn_ES(['|-',[A,B],[[[!,A],'||',C],D]],[C,['Truth_DecomposePPP',B,D]]). -% ;;!Syllogistic rules for Implication: -metta_defn_ES(['|-',[[A,==>,B],C],[[B,==>,D],E]] , [[A,==>,D],['Truth_Deduction',C,E]]). -metta_defn_ES(['|-',[[A,==>,B],C],[[A,==>,D],E]] , [[D,==>,B],['Truth_Induction',C,E]]). -metta_defn_ES(['|-',[[A,==>,B],C],[[D,==>,B],E]] , [[D,==>,A],['Truth_Abduction',C,E]]). -metta_defn_ES(['|-',[[A,==>,B],C],[[B,==>,D],E]] , [[D,==>,A],['Truth_Exemplification',C,E]]). -% ;;!Conditional composition for conjunction and disjunction: -metta_defn_ES(['|-',[[A,==>,B],C],[[D,==>,B],E]] , [[[A,&&,D],==>,B],['Truth_Union',C,E]]). -metta_defn_ES(['|-',[[A,==>,B],C],[[D,==>,B],E]] , [[[A,'||',D],==>,B],['Truth_Intersection',C,E]]). -metta_defn_ES(['|-',[[A,==>,B],C],[[A,==>,D],E]] , [[A,==>,[B,&&,D]],['Truth_Intersection',C,E]]). -metta_defn_ES(['|-',[[A,==>,B],C],[[A,==>,D],E]] , [[A,==>,[B,'||',D]],['Truth_Union',C,E]]). -% ;;!Multi-conditional inference: -metta_defn_ES(['|-',[[[A,&&,B],==>,C],D],[[A,==>,C],E]],[B,['Truth_Abduction',D,E]]). -metta_defn_ES(['|-',[[[A,&&,B],==>,C],D],[[E,==>,B],F]] , [[[A,&&,E],==>,C],['Truth_Deduction',D,F]]). -metta_defn_ES(['|-',[[[A,&&,B],==>,C],D],[[[A,&&,E],==>,C],F]] , [[E,==>,B],['Truth_Abduction',D,F]]). -metta_defn_ES(['|-',[[[A,&&,B],==>,C],D],[[B,==>,E],F]] , [[[A,&&,E],==>,C],['Truth_Induction',D,F]]). -% ;;!Rules for equivalence: -metta_defn_ES(['|-',[[A,<=>,B],C]] , [[B,<=>,A],['Truth_StructuralIntersection',C]]). -metta_defn_ES(['|-',[[A,==>,B],C],[[B,==>,A],D]] , [[A,<=>,B],['Truth_Intersection',C,D]]). -metta_defn_ES(['|-',[[A,==>,B],C],[[D,==>,B],E]] , [[D,<=>,A],['Truth_Comparison',C,E]]). -metta_defn_ES(['|-',[[A,==>,B],C],[[A,==>,D],E]] , [[D,<=>,B],['Truth_Comparison',C,E]]). -metta_defn_ES(['|-',[[A,==>,B],C],[[D,<=>,A],E]] , [[D,==>,B],['Truth_Analogy',C,E]]). -metta_defn_ES(['|-',[[A,==>,B],C],[[D,<=>,B],E]] , [[A,==>,D],['Truth_Analogy',C,E]]). -metta_defn_ES(['|-',[[A,<=>,B],C],[[D,<=>,A],E]] , [[D,<=>,B],['Truth_Resemblance',C,E]]). -% ;;!Higher-order decomposition -metta_defn_ES(['|-',[A,B],[[A,==>,C],D]],[C,['Truth_Deduction',B,D]]). -metta_defn_ES(['|-',[A,B],[[[A,&&,C],==>,D],E]] , [[C,==>,D],['Truth_Deduction',B,E]]). -metta_defn_ES(['|-',[A,B],[[C,==>,A],D]],[C,['Truth_Abduction',B,D]]). -metta_defn_ES(['|-',[A,B],[[A,<=>,C],D]],[C,['Truth_Analogy',B,D]]). -% ;;NAL term reductions -% ;;!Extensional intersection, union, conjunction reductions: -metta_defn_ES([A,&,A],A). -metta_defn_ES([A,'|',A],A). -metta_defn_ES([A,&&,A],A). -metta_defn_ES([A,'||',A],A). -% ;;!Extensional set reductions: -metta_defn_ES([['{',A,'}'],'|',['{',B,'}']],['{',A,B,'}']). -metta_defn_ES([['{',A,B,'}'],'|',['{',C,'}']],['{',[A|B],C,'}']). -metta_defn_ES([['{',A,'}'],'|',['{',B,C,'}']],['{',A,[B|C],'}']). -% ;;!Intensional set reductions: -metta_defn_ES([['$OBJ'(claz_bracket_vector,[A])],&,['$OBJ'(claz_bracket_vector,[B])]],['$OBJ'(claz_bracket_vector,[A,B])]). -metta_defn_ES([['$OBJ'(claz_bracket_vector,[A,B])],&,['$OBJ'(claz_bracket_vector,[C])]],['$OBJ'(claz_bracket_vector,[[A|B],C])]). -metta_defn_ES([['$OBJ'(claz_bracket_vector,[A])],&,['$OBJ'(claz_bracket_vector,[B,C])]],['$OBJ'(claz_bracket_vector,[A,[B|C]])]). -% ;;!Reduction for set element copula: -metta_defn_ES(['{',[A|B],'}'],['{',A,B,'}']). -metta_defn_ES(['$OBJ'(claz_bracket_vector,[[A|B]])],['$OBJ'(claz_bracket_vector,[A,B])]). - -%;params -metta_defn_ES(['BeliefEventsMax'],10). - -metta_defn_ES(['GoalEventsMax'],10). - -%;spaces -:-metta_eval(['bind!','&belief_events',['new-space']]). - -:-metta_eval(['bind!','&goal_events',['new-space']]). - -%;states -:-metta_eval(['bind!','¤tTime',['new-state',1]]). - -:-metta_eval(['bind!','&evidentialBase',['new-state',1]]). - -metta_defn_ES( - [increment,Atom], - [ 'change-state!', - Atom, - [ +, - 1, - ['get-state',Atom]]]). - -metta_defn_ES( - ['UpdateReasonerState'], - [ [ increment , '¤tTime' ], - [ increment ,'&evidentialBase']]). - -metta_defn_ES( - ['GetReasonerState'], - [ ['get-state','¤tTime'], - [ [ 'get-state' ,'&evidentialBase']]]). - -%;priority of events -metta_defn_ES( - [ 'EventPriorityNow', - [T,P], - T], - [ *, - P, - [ /, - 1, - [ +, - 1, - [-,T,T]]]]). - -%;retrieve the best candidate (allows to use tuples / collapse results / spaces as a PQ) -:-metta_eval(['bind!','&tempbest',['new-state',[]]]). - -:-metta_eval(['bind!','&tempbestscore',['new-state',0]]). - -metta_defn_ES( - ['BestCandidate',Tuple,EvaluateCandidateFunction,T], - [ sequential, - [ [ do, - ['change-state!','&tempbestscore',0]], - [ do, - ['change-state!','&tempbest',[]]], - [ do, - [ 'let*', - [ [ X, - [superpose,Tuple]], - [ Fx, - [EvaluateCandidateFunction,X,T]]], - [ superpose, - [ [ 'If', - [ >, - Fx, - ['get-state','&tempbestscore']], - [ sequential, - [ [ 'change-state!' , '&tempbest' , X ], - [ 'change-state!' ,'&tempbestscore', Fx ]]]]]]]], - ['get-state','&tempbest']]]). - -%;functions to select highest-priority events in belief and goal PQ -metta_defn_ES( - [ 'PriorityOf', - [ 'Event', - Sentence, - [OccT,Ev,Prio]], - T], - ['EventPriorityNow',Prio,T]). - -metta_defn_ES( - ['SelectHighestPriorityEvent',Collection,T], - [ 'BestCandidate', - [ collapse, - ['get-atoms',Collection]], 'PriorityOf',T]). - -%;a belief event to process, which demands adding it to the PQ and updating its concept -metta_defn_ES( - ['ProcessBeliefEvent',Ev,T], - [ sequential, - [ [ 'add-atom' ,'&belief_events', Ev ], - [ 'UpdateConcept' , Ev , T ]]]). - -%;bound the size of the attentional focus for tasks / events -metta_defn_ES( - [ 'BoundEvents', Collection,Threshold, - Increment, TargetAmount, T], - [ sequential, - [ [ do, - [ 'let*', - [ [ Ev, - ['get-atoms',Collection]], - [ [ 'Event', - Sentence, - [Time,Evidence,EPrio]], - Ev]], - [ 'If', - [ <, - ['EventPriorityNow',EPrio,T], - Threshold], - ['remove-atom',Collection,Ev]]]], - [ let, - CurrentAmount, - [ 'CollapseCardinality', - ['get-atoms',Collection]], - [ 'If', - [>,CurrentAmount,TargetAmount], - [ 'BoundEvents', - Collection, - [+,Threshold,Increment], Increment, TargetAmount, T]]]]]). - -%;params -metta_defn_ES(['AttentionalFocusConceptsMax'],10). - -%;spaces -:-metta_eval(['bind!','&concepts',['new-space']]). - -:-metta_eval(['bind!','&attentional_focus',['new-space']]). - -%;priority of concepts -metta_defn_ES( - [ 'ConceptPriorityNow', - [T,P], - T], - [ *, - P, - [ /, - 1, - [ +, - 1, - [-,T,T]]]]). - -%;whether evidence was just counted once -:-metta_eval(['bind!','&tempstate',['new-state','False']]). - -:-metta_eval(['bind!','&tempset',['new-space']]). - -metta_defn_ES( - ['StampDisjoint',X], - [ not, - [ sequential, - [ [ do, - ['change-state!','&tempstate','False']], - [ do, - [ case, - ['get-atoms','&tempset'], - [ [ Y, - ['remove-atom','&tempset',Y]]]]], - [ do, - [ let, - Z, - [superpose,X], - [ case, - [match,'&tempset',Z,Z], - [ [ W, - ['change-state!','&tempstate','True']], - [ '%void%', - ['add-atom','&tempset',Z]]]]]], - ['get-state','&tempstate']]]]). - -%;revise if there is no evidential overlap, else use higher-confident candidate -metta_defn_ES( - [ 'RevisionAndChoice', - [ 'Event', - [ Term1, - [F1,C1]], - [eternal,Ev1,EPrio1]], - [ 'Event', - [ Term2, - [F2,C2]], - [eternal,Ev2,EPrio2]]], - [ let, - ConclusionStamp, - ['TupleConcat',Ev1,Ev2], - [ 'If', - ['StampDisjoint',ConclusionStamp], - [ 'Event', - [ Term1, - [ 'Truth_Revision', - [F1,C1], - [F2,C2]]], - [ eternal, - ConclusionStamp, - [0,0.0]]], - [ 'If', - [>,C1,C2], - [ 'Event', - [ Term1, - [F1,C1]], - [ eternal, - Ev1, - [0,0.0]]], - [ 'Event', - [ Term2, - [F2,C2]], - [ eternal, - Ev2, - [0,0.0]]]]]]). - -%;;update beliefs in existing concept with the new event or create new concept to enter the new evidence -metta_defn_ES( - ['UpdateConcept',NewEvent,T], - [ 'let*', - [ [ [ 'Event', - [Term,TV], - [Time,Evidence,EPrio]], - NewEvent], - [ NewEventEternalized, - ['Eternalize',NewEvent]], - [ MatchConcept, - [ 'Concept', Term,Belief, - BeliefEvent,CPrio]]], - [ sequential, - [ [ case, - [match,'&attentional_focus',MatchConcept,MatchConcept], - [ [ MatchConcept, - [ sequential, - [ ['remove-atom','&attentional_focus',MatchConcept], - [ 'let*', - [ [ RevisedBelief, - ['RevisionAndChoice',Belief,NewEventEternalized]], - [ MaxPrio, - [ 'If', - [ >, - ['EventPriorityNow',EPrio,T], - ['ConceptPriorityNow',CPrio,T]], EPrio,CPrio]]], - [ 'add-atom', - '&attentional_focus', - [ 'Concept', Term, RevisedBelief, NewEvent, MaxPrio]]]]]], - [ '%void%', - [ case, - [match,'&concepts',MatchConcept,MatchConcept], - [ [ MatchConcept, - [ sequential, - [ [ 'remove-atom' , '&concepts' , MatchConcept ], - [ 'add-atom' ,'&attentional_focus', MatchConcept ], - [ 'UpdateConcept' , NewEvent , T ]]]], - [ '%void%', - [ 'add-atom', - '&attentional_focus', - [ 'Concept', Term, NewEventEternalized, NewEvent, EPrio]]]]]]]]]]]). - -%;bound the size of attentional focus of concepts -metta_defn_ES( - [ 'BoundAttention', Threshold,Increment, - TargetAmount,T], - [ sequential, - [ [ do, - [ 'let*', - [ [ C, - ['get-atoms','&attentional_focus']], - [ [ 'Concept', - Term, - ['Event',Sentence,Metadata], BeliefEvent,CPrio], - C]], - [ 'If', - [ <, - ['ConceptPriorityNow',CPrio,T], - Threshold], - [ sequential, - [ [ 'remove-atom' ,'&attentional_focus', C ], - [ 'add-atom' , '&concepts' , C ]]]]]], - [ let, - CurrentAmount, - [ 'CollapseCardinality', - ['get-atoms','&attentional_focus']], - [ 'If', - [>,CurrentAmount,TargetAmount], - [ 'BoundAttention', - [+,Threshold,Increment], Increment, TargetAmount, T]]]]]). - -%;get eternal belief of concept -metta_type('&self','EternalQuestion',[->,'Expression',T]). - -metta_defn_ES( - ['EternalQuestion',Term], - [ case, - [ match, - [ superpose, - ['&attentional_focus','&concepts']], - [ 'Concept', Term,Belief, - BeliefEvent,CPrio], - Belief], - [ [Ev,Ev], - [ '%void%', - [ 'Event', - [ 'None', - [0.5,0.0]], - [eternal,[],0.0]]]]]). - -%;get event belief of concept -metta_type('&self','EventQuestion',[->,'Expression',T]). - -metta_defn_ES( - ['EventQuestion',Term], - [ case, - [ match, - [ superpose, - ['&attentional_focus','&concepts']], - [ 'Concept', Term,Belief, - BeliefEvent,CPrio], - BeliefEvent], - [ [Ev,Ev], - [ '%void%', - [ 'Event', - [ 'None', - [0.5,0.0]], - [0,[],0.0]]]]]). - -%;;Declarative inference (deriving events and knowledge from observed events) -%;Derived belief event priority -metta_defn_ES( - ['ConclusionPriority',EPrio,CPrio,ConcTV], - [ *, - [*,EPrio,CPrio], - ['Truth_Expectation',ConcTV]]). - -%;making declarative inferences on two events (task from PQ and belief from concept) -metta_defn_ES( - [ 'Conclude', - [ 'Event', - S1, - [Time1,Ev1,Prio1]], - [ 'Event', - S2, - [Time2,Ev2,Prio2]], CPrio,T], - [ let, - ConclusionStamp, - ['TupleConcat',Ev1,Ev2], - [ 'If', - ['StampDisjoint',ConclusionStamp], - [ let, - [ConcTerm,ConcTV], - [ superpose, - [ [ '|-', S1 , S2 ], - [ '|-', S2 , S1 ]]], - [ 'Event', - [ConcTerm,ConcTV], - [ Time1, - ConclusionStamp, - [ T, - [ 'ConclusionPriority', - ['EventPriorityNow',Prio1,T], - ['ConceptPriorityNow',CPrio,T], - ConcTV]]]]]]]). - -%;find a belief for the task to generate conclusions with -metta_defn_ES( - [ 'ReasonWithTask', - [ 'Event', - S1, - [Time1,Ev1,Prio1]], - T], - [ let, - [Belief,CPrio], - [ case, - ['get-atoms','&attentional_focus'], - [ [ [ 'Concept', - Term, - [ 'Event', - SE2, - [TimeE2,EvE2,PrioE2]], - [ 'Event', - S2, - [Time2,Ev2,Prio2]], - CPrio], - [ 'If', - [ and, - [ not, - [==,Time1,eternal]], - [ >, - [ abs, - [-,Time1,Time2]], - 20]], - [ [ 'Event', - SE2, - [TimeE2,EvE2,PrioE2]], - Cprio], - [ [ 'Event', - S2, - [Time2,Ev2,Prio2]], - CPrio]]]]], - [ case, - [ 'Conclude', - [ 'Event', - S1, - [Time1,Ev1,Prio1]], - ['TemporallyAlignedBelief',Time1,Belief], CPrio,T], - [ [ ['Event',Num1,Num2], - [ 'ProcessBeliefEvent', - ['Event',Num1,Num2], - T]]]]]). - -%;select the highest priority belief event from the PQ and use it for reasoning -metta_defn_ES( - ['BeliefCycle',T], - [ do, - [ sequential, - [ [ let, - Ev, - ['SelectHighestPriorityEvent','&belief_events',T], - [ sequential, - [ [ 'remove-atom' ,'&belief_events', Ev ], - [ 'ReasonWithTask', Ev , T ]]]], - ['UpdateReasonerState'], - [ 'BoundEvents', '&belief_events',0.0,0.1, - ['BeliefEventsMax'], - T], - [ 'BoundAttention', 0.0,0.1, - ['AttentionalFocusConceptsMax'], - T]]]]). - -%;;Temporal inference (sequence and implication formation based on FIFO) -%;use the event's evidence to induce a time-independent belief which can be used in the future -metta_defn_ES( - ['Eternalize',Ev], - [ let, - [ 'Event', - [Term,TV], - [Time,Evidence,EPrio]], - Ev, - [ 'If', - [==,Time,eternal], - Ev, - [ 'Event', - [ Term, - ['Truth_Eternalize',TV]], - [ eternal, - Evidence, - [0,0.0]]]]]). - -%;use evidence of an event at a slightly different moment in time -metta_defn_ES( - [ 'Projection', - [ 'Event', - [ Term, - [F,C]], - [Time,Evidence,EPrio]], - TargetTime], - [ 'Event', - [ Term, - [ F, - [ *, - C, - [ min, - 1, - [ /, - 1, - [ abs, - [-,Time,TargetTime]]]]]]], - [TargetTime,Evidence,EPrio]]). - -%;make the belief occurrence time compatible with the task's -metta_defn_ES( - ['TemporallyAlignedBelief',TaskTime,Belief], - [ 'If', - [==,TaskTime,eternal], - ['Eternalize',Belief], - ['Projection',Belief,TaskTime]]). - -%;FIFO max. size bound -:-metta_eval(['bind!','&FIFO',['new-state',[]]]). - -metta_defn_ES(['ListFirstK',C,[]],[]). - -metta_defn_ES( - [ 'ListFirstK', - C, - [LH,LT]], - [ 'If', - [>,C,0], - [ LH, - [ 'ListFirstK', - [-,C,1], - LT]], - []]). - -%;Add event to FIFO -metta_defn_ES( - ['EventToFIFO',Ev], - [ let, - Newlist, - [ 'ListFirstK', - 3, - [ Ev, - ['get-state','&FIFO']]], - ['change-state!','&FIFO',Newlist]]). - -%;Form a sequence of two events -metta_defn_ES( - [ 'TemporalSequence', - Ev1, - [ 'Event', - [Term2,Truth2], - [Time2,Evidence2,EPrio2]]], - [ let, - [ 'Event', - [Term1,Truth1], - [Time1,Evidence1,EPrio1]], - ['Projection',Ev1,Time2], - [ 'Event', - [ [ Term1 , &/ , Term2 ], - [ 'Truth_Intersection', Truth1 , Truth2 ]], - [ Time2, - ['TupleConcat',Evidence1,Evidence2], - [0,0.0]]]]). - -%;Form a temporal implication between two events -metta_defn_ES( - [ 'TemporalImplication', - Ev1, - [ 'Event', - [Term2,Truth2], - [Time2,Evidence2,EPrio2]]], - [ let, - [ 'Event', - [Term1,Truth1], - [Time1,Evidence1,EPrio1]], - ['Projection',Ev1,Time2], - [ 'Event', - [ [ Term1 , =/> , Term2 ], - [ 'Truth_Induction', Truth1 , Truth2 ]], - [ Time2, - ['TupleConcat',Evidence1,Evidence2], - [0,0.0]]]]). - -%;Whether an event's term is an operation -metta_defn_ES( - [ 'IsOp', - [ 'Event', - [Term,Truth], - Metadata]], - [ case, - Term, - [ [ [^,Opname], - 'True'], - [Otherwise,'False']]]). - -%;Find implications in the event FIFO: -%;procedural implications -metta_defn_ES( - [ 'TemporalImplicationInduction', - [ Cons, - [ Op, - [Prec,Tail]]]], - [ 'If', - [ and, - ['IsOp',Op], - [ and, - [ not, - ['IsOp',Cons]], - [ not, - ['IsOp',Prec]]]], - [ let, - PrecOp, - ['TemporalSequence',Prec,Op], - ['TemporalImplication',PrecOp,Cons]]]). - -%;and temporal without operation -metta_defn_ES( - [ 'TemporalImplicationInduction', - [ Cons, - [Prec,Tail]]], - [ 'If', - [ and, - [ not, - ['IsOp',Prec]], - [ not, - ['IsOp',Cons]]], - ['TemporalImplication',Prec,Cons]]). - -%;Add negative evidence for implications which predicted the input unsuccessfully -metta_defn_ES( - ['NegConfirmation',PrecTerm,ObservedCons,T], - [ let, - [ 'Event', - [ [PrecTerm,=/>,PredictedCons], - ImpTV], - ImpMetadata], - [ 'EternalQuestion', - [PrecTerm,=/>,PredictedCons]], - [ 'If', - [ not, - [==,ObservedCons,PredictedCons]], - [ 'UpdateConcept', - [ 'Event', - [ [ PrecTerm , =/> ,PredictedCons], - [ 0.0 , 0.1 ]], - [ T, - [], - [0,0.0]]], - T]]]). - -%;Check if the implication's preconditions are met to anticipate the by the implication predicted outcome -get_metta_atom(Eq, '&self', [ - =, - [ 'Anticipate', - [Pos,[]], - T]]). - -metta_defn_ES( - [ 'Anticipate', - [ Pos, - [Pre,[]]], - T], - [ 'let*', - [ [ [ 'Event', - [PreTerm,PreTV], - PreMetadata], - Pre], - [ [ 'Event', - [PosTerm,PosTV], - PosMetadata], - Pos]], - [ 'If', - [ not, - ['IsOp',Pre]], - ['NegConfirmation',PreTerm,PosTerm,T]]]). - -metta_defn_ES( - [ 'Anticipate', - [ Pos, - [ Op, - [Pre,Trail]]], - T], - [ 'let*', - [ [ [ 'Event', - [PreTerm,PreTV], - PreMetadata], - Pre], - [ [ 'Event', - [OpTerm,OpTV], - OpMetadata], - Op], - [ [ 'Event', - [PosTerm,PosTV], - PosMetadata], - Pos], - [ Sequence, - [Pre,&/,'Pos']]], - [ 'If', - [ and, - ['IsOp',Op], - [ not, - ['IsOp',Pre]]], - [ 'NegConfirmation', - [PreTerm,&/,OpTerm], PosTerm,T]]]). - -%;;Input procedure -metta_defn_ES( - ['AddBeliefEvent',Sentence], - [ 'let*', - [ [ [ T , EvidentialBase ], - [ 'GetReasonerState']], - [ InputEvent, - [ 'Event', - Sentence, - [ T, - EvidentialBase, - [T,1.0]]]]], - [ do, - [ sequential, - [ ['EventToFIFO',InputEvent], - [ let, - InducedHypothesis, - [ 'TemporalImplicationInduction', - ['get-state','&FIFO']], - ['UpdateConcept',InducedHypothesis,T]], - ['ProcessBeliefEvent',InputEvent,T], - [ 'Anticipate', - ['get-state','&FIFO'], - T], - ['BeliefCycle',T]]]]]). - -%;;Procedural inference (decision making with operation execution and subgoaling) -%;Derived goal event priority -metta_defn_ES( - ['SubgoalPriority',EPrio,ConcTV], - [ *, - EPrio, - ['Truth_Expectation',ConcTV]]). - -%;Expectation of an operation is the truth expectation of its desire value -metta_defn_ES( - [ 'OpExpectation', - [ 'Decision', - [Opname,DVOp], - Subgoal], - T], - ['Truth_Expectation',DVOp]). - -%;Inject executed operation as an event and return its name -metta_defn_ES( - ['Execute',Opname], - [ superpose, - [ [ 'AddBeliefEvent', - [ Opname, - [1.0,0.9]]], - Opname]]). - -%;Add subgoals to the PQ -metta_defn_ES( - ['DeriveSubgoals',Options], - [ do, - [ let, - ['Decision',Op,Subgoal], - [superpose,Options], - ['add-atom','&goal_events',Subgoal]]]). - -%;execute the operation which most likely gets the goal achieved in current contexts, and if contexts are not yet fulfilled, derive them as subgoals -metta_defn_ES( - [ 'BestDecision', - T, - [ 'Event', - [Term,DV], - [GoalTime,GoalEvBase,GoalPrio]], - FIFO], - [ let, - Options, - [ collapse, - [ 'let*', - [ [ [ 'Event', - [ [ [ Prec, - &/, - [^,Op]], =/>,Term], - ImpTV], - [ImpTime,ImpEvBase,ImpPrio]], - [ 'EternalQuestion', - [ [ Prec, - &/, - [^,Op]], =/>,Term]]], - [ DVPrecOp, - ['Truth_Deduction',DV,ImpTV]], - [ [ 'Event', - [PrecTerm,PrecTV], - PrecMetadata], - [ 'Projection', - ['EventQuestion',Prec], - T]], - [ DVOp, - ['Truth_Deduction',PrecTV,DVPrecOp]], - [ DVPrec, - ['Truth_StructuralDeduction',DVPrecOp]], - [ SubgoalStamp, - ['TupleConcat',GoalEvBase,ImpEvBase]]], - [ 'If', - ['StampDisjoint',SubgoalStamp], - [ 'Decision', - [ [^,Op], - DVOp], - [ 'Event', - [ Prec, - ['Truth_StructuralDeduction',DVPrecOp]], - [ T, - SubgoalStamp, - [ T, - [ 'SubgoalPriority', - ['EventPriorityNow',GoalPrio,T], - DVPrec]]]]]]]], - [ let, - [ 'Decision', - [Opname,DVOp], - Subgoal], - ['BestCandidate',Options,'OpExpectation',T], - [ 'If', - [ >, - ['Truth_Expectation',DVOp], - 0.5], - ['Execute',Opname], - ['DeriveSubgoals',Options]]]]). - -%;;select the highest priority goal event from the PQ and use it for decision making -metta_defn_ES( - ['GoalCycle',T], - [ sequential, - [ [ let, - Ev, - ['SelectHighestPriorityEvent','&goal_events',T], - [ sequential, - [ [ do, - ['remove-atom','&goal_events',Ev]], - [ 'BestDecision', T,Ev, - ['get-state','&FIFO']]]]], - [ do, - ['UpdateReasonerState']], - [ do, - [ 'BoundEvents', '&goal_events',0.0,0.1, - ['GoalEventsMax'], - T]]]]). - -%;;Input procedure -metta_defn_ES( - ['AddGoalEvent',Sentence], - [ 'let*', - [ [ [ T , EvidentialBase ], - [ 'GetReasonerState']], - [ InputEvent, - [ 'Event', - Sentence, - [ T, - EvidentialBase, - [T,1.0]]]]], - [ sequential, - [ [ do, - ['add-atom','&goal_events',InputEvent]], - ['GoalCycle',T]]]]). - -:-metta_eval([print,'$STRING'("NARS test!!!!!!!!!!!!!!!!!!")]). - -:-metta_eval(['mettalog::vspace-main']). - -( :- ( - metta_eval( [ 'AddBeliefEvent', - [ [ ['{',garfield,'}'], -->,cat], - [1.0,0.9]]])) ). - -metta_defn_ES( - [ 'AddBeliefEvent', - [ [ ['{',garfield,'}'], -->,cat], - [1.0,0.9]]], - [ 'let*', - [ [ [ A , B ], - [ 'GetReasonerState']], - [ C, - [ 'Event', - [ [ ['{',garfield,'}'], -->,cat], - [1.0,0.9]], - [ A, - B, - [A,1.0]]]]], - [ do, - [ sequential, - [ ['EventToFIFO',C], - [ let, - D, - [ 'TemporalImplicationInduction', - ['get-state','&FIFO']], - ['UpdateConcept',D,A]], - ['ProcessBeliefEvent',C,A], - [ 'Anticipate', - ['get-state','&FIFO'], - A], - ['BeliefCycle',A]]]]]). - -( :- ( - metta_eval( [ 'AddBeliefEvent', - [ [ [cat,*,sky], -->,like], - [1.0,0.9]]])) ). - -metta_defn_ES( - [ 'AddBeliefEvent', - [ [ [cat,*,sky], -->,like], - [1.0,0.9]]], - [ 'let*', - [ [ [ A , B ], - [ 'GetReasonerState']], - [ C, - [ 'Event', - [ [ [cat,*,sky], -->,like], - [1.0,0.9]], - [ A, - B, - [A,1.0]]]]], - [ do, - [ sequential, - [ ['EventToFIFO',C], - [ let, - D, - [ 'TemporalImplicationInduction', - ['get-state','&FIFO']], - ['UpdateConcept',D,A]], - ['ProcessBeliefEvent',C,A], - [ 'Anticipate', - ['get-state','&FIFO'], - A], - ['BeliefCycle',A]]]]]). - -( :- ( - metta_eval( [ 'AddBeliefEvent', - [ [ sky, - -->, - [ '$OBJ'(claz_bracket_vector,[blue])]], - [1.0,0.9]]])) ). - -metta_defn_ES( - [ 'AddBeliefEvent', - [ [ sky, - -->, - [ '$OBJ'(claz_bracket_vector,[blue])]], - [1.0,0.9]]], - [ 'let*', - [ [ [ A , B ], - [ 'GetReasonerState']], - [ C, - [ 'Event', - [ [ sky, - -->, - [ '$OBJ'(claz_bracket_vector,[blue])]], - [1.0,0.9]], - [ A, - B, - [A,1.0]]]]], - [ do, - [ sequential, - [ ['EventToFIFO',C], - [ let, - D, - [ 'TemporalImplicationInduction', - ['get-state','&FIFO']], - ['UpdateConcept',D,A]], - ['ProcessBeliefEvent',C,A], - [ 'Anticipate', - ['get-state','&FIFO'], - A], - ['BeliefCycle',A]]]]]). - -%;The following question needs both a deduction and abduction step: -( :- ( - metta_eval( [ 'EternalQuestion', - [ [ ['{',garfield,'}'], - *, - [ '$OBJ'(claz_bracket_vector,[blue])]], -->,like]])) ). - -metta_defn_ES( - [ 'EternalQuestion', - [ [ ['{',garfield,'}'], - *, - [ '$OBJ'(claz_bracket_vector,[blue])]], -->,like]], - [ case, - [ match, - [ superpose, - ['&attentional_focus','&concepts']], - [ 'Concept', - [ [ ['{',garfield,'}'], - *, - [ '$OBJ'(claz_bracket_vector,[blue])]], -->,like], A,_,_], - A], - [ [B,B], - [ '%void%', - [ 'Event', - [ 'None', - [0.5,0.0]], - [eternal,[],0.0]]]]]). - -%;expected: [(Event (((({ garfield }) * ([ blue ])) --> like) (1.0 0.2965825874694874)) (eternal (Cons 2 (Cons 1 (Cons 3 Nil))) 0.643288027761712))] -%;Lets stress the control mechanism as these type of events with common extension or intension causes dozens of derivations: -( :- ( - metta_eval( [ 'AddBeliefEvent', - [ [ A ,-->,cat], - [ 1.0,0.9]]])) ). - -metta_defn_ES( - [ 'AddBeliefEvent', - [ [ 'A',-->,cat], - [ 1.0,0.9]]], - [ 'let*', - [ [ [ A , B ], - [ 'GetReasonerState']], - [ C, - [ 'Event', - [ [ 'A',-->,cat], - [ 1.0,0.9]], - [ A, - B, - [A,1.0]]]]], - [ do, - [ sequential, - [ ['EventToFIFO',C], - [ let, - D, - [ 'TemporalImplicationInduction', - ['get-state','&FIFO']], - ['UpdateConcept',D,A]], - ['ProcessBeliefEvent',C,A], - [ 'Anticipate', - ['get-state','&FIFO'], - A], - ['BeliefCycle',A]]]]]). - -( :- ( - metta_eval( [ 'AddBeliefEvent', - [ [ B ,-->,cat], - [ 1.0,0.9]]])) ). - -metta_defn_ES( - [ 'AddBeliefEvent', - [ [ 'B',-->,cat], - [ 1.0,0.9]]], - [ 'let*', - [ [ [ A , B ], - [ 'GetReasonerState']], - [ C, - [ 'Event', - [ [ 'B',-->,cat], - [ 1.0,0.9]], - [ A, - B, - [A,1.0]]]]], - [ do, - [ sequential, - [ ['EventToFIFO',C], - [ let, - D, - [ 'TemporalImplicationInduction', - ['get-state','&FIFO']], - ['UpdateConcept',D,A]], - ['ProcessBeliefEvent',C,A], - [ 'Anticipate', - ['get-state','&FIFO'], - A], - ['BeliefCycle',A]]]]]). - -( :- ( - metta_eval( [ 'AddBeliefEvent', - [ [ C ,-->,cat], - [ 1.0,0.9]]])) ). - -metta_defn_ES( - [ 'AddBeliefEvent', - [ [ 'C',-->,cat], - [ 1.0,0.9]]], - [ 'let*', - [ [ [ A , B ], - [ 'GetReasonerState']], - [ C, - [ 'Event', - [ [ 'C',-->,cat], - [ 1.0,0.9]], - [ A, - B, - [A,1.0]]]]], - [ do, - [ sequential, - [ ['EventToFIFO',C], - [ let, - D, - [ 'TemporalImplicationInduction', - ['get-state','&FIFO']], - ['UpdateConcept',D,A]], - ['ProcessBeliefEvent',C,A], - [ 'Anticipate', - ['get-state','&FIFO'], - A], - ['BeliefCycle',A]]]]]). - -:-metta_eval(['EternalQuestion',[['A',&,'B'],-->,cat]]). - -metta_defn_ES( - [ 'EternalQuestion', - [['A',&,'B'],-->,cat]], - [ case, - [ match, - [ superpose, - ['&attentional_focus','&concepts']], - [ 'Concept', - [['A',&,'B'],-->,cat], A,_,_], - A], - [ [B,B], - [ '%void%', - [ 'Event', - [ 'None', - [0.5,0.0]], - [eternal,[],0.0]]]]]). - -%;expected: [(Event (((A & B) --> cat) (1.0 0.44751381215469616)) (eternal (Cons 4 (Cons 5 Nil)) (5 0.4525)))] -:-metta_eval(['EternalQuestion',[['B',&,'C'],-->,cat]]). - -metta_defn_ES( - [ 'EternalQuestion', - [['B',&,'C'],-->,cat]], - [ case, - [ match, - [ superpose, - ['&attentional_focus','&concepts']], - [ 'Concept', - [['B',&,'C'],-->,cat], A,_,_], - A], - [ [B,B], - [ '%void%', - [ 'Event', - [ 'None', - [0.5,0.0]], - [eternal,[],0.0]]]]]). - -%;expected: [(Event (((B & C) --> cat) (1.0 0.44751381215469616)) (eternal (Cons 5 (Cons 6 Nil)) (6 0.4525)))] -( :- ( - metta_eval( [ 'EternalQuestion', - [ [['A',&,'B'],&,'C'], -->,cat]])) ). - -metta_defn_ES( - [ 'EternalQuestion', - [ [['A',&,'B'],&,'C'], -->,cat]], - [ case, - [ match, - [ superpose, - ['&attentional_focus','&concepts']], - [ 'Concept', - [ [['A',&,'B'],&,'C'], -->,cat], A,_,_], - A], - [ [B,B], - [ '%void%', - [ 'Event', - [ 'None', - [0.5,0.0]], - [eternal,[],0.0]]]]]). - -%;expected: [(Event ((((A & B) & C) --> cat) (1.0 0.42163100057836905)) (eternal (Cons 5 (Cons 4 (Cons 6 Nil))) (6 0.195593125))) -( :- ( - metta_eval( [ 'AddBeliefEvent', - [ [ [ ['{',garfield,'}'], - *, - [ '$OBJ'(claz_bracket_vector,[blue])]], -->,like], - [1.0,0.9]]])) ). - -metta_defn_ES( - [ 'AddBeliefEvent', - [ [ [ ['{',garfield,'}'], - *, - [ '$OBJ'(claz_bracket_vector,[blue])]], -->,like], - [1.0,0.9]]], - [ 'let*', - [ [ [ A , B ], - [ 'GetReasonerState']], - [ C, - [ 'Event', - [ [ [ ['{',garfield,'}'], - *, - [ '$OBJ'(claz_bracket_vector,[blue])]], -->,like], - [1.0,0.9]], - [ A, - B, - [A,1.0]]]]], - [ do, - [ sequential, - [ ['EventToFIFO',C], - [ let, - D, - [ 'TemporalImplicationInduction', - ['get-state','&FIFO']], - ['UpdateConcept',D,A]], - ['ProcessBeliefEvent',C,A], - [ 'Anticipate', - ['get-state','&FIFO'], - A], - ['BeliefCycle',A]]]]]). - -( :- ( - metta_eval( [ 'EternalQuestion', - [ [ ['{',garfield,'}'], - *, - [ '$OBJ'(claz_bracket_vector,[blue])]], -->,like]])) ). - -metta_defn_ES( - [ 'EternalQuestion', - [ [ ['{',garfield,'}'], - *, - [ '$OBJ'(claz_bracket_vector,[blue])]], -->,like]], - [ case, - [ match, - [ superpose, - ['&attentional_focus','&concepts']], - [ 'Concept', - [ [ ['{',garfield,'}'], - *, - [ '$OBJ'(claz_bracket_vector,[blue])]], -->,like], A,_,_], - A], - [ [B,B], - [ '%void%', - [ 'Event', - [ 'None', - [0.5,0.0]], - [eternal,[],0.0]]]]]). - -%;expected: [(Event (((({ garfield }) * ([ blue ])) --> like) (1.0 0.5692683291397822)) (eternal (Cons 7 (Cons 2 (Cons 1 (Cons 3 Nil)))) 0.0))] -%;Please notice that it has revised it with the prior derived result, as you can also see in the evidence trail 1,2,3 being included -:-metta_eval(['mettalog::vspace-main']). - -%;debug: -:-metta_eval(['CollapseCardinality',['get-atoms','&belief_events']]). - -metta_defn_ES( - [ 'CollapseCardinality', - ['get-atoms','&belief_events']], - [ 'TupleCount', - [ collapse, - [ 'CountElement', - ['get-atoms','&belief_events']]]]). - -metta_defn_ES( - [ 'CountElement', - ['get-atoms','&belief_events']], - [ case, - ['get-atoms','&belief_events'], - [ [ _,1]]]). - -%;[8] -:-metta_eval(['CollapseCardinality',['get-atoms','&attentional_focus']]). - -metta_defn_ES( - [ 'CollapseCardinality', - ['get-atoms','&attentional_focus']], - [ 'TupleCount', - [ collapse, - [ 'CountElement', - ['get-atoms','&attentional_focus']]]]). - -metta_defn_ES( - [ 'CountElement', - ['get-atoms','&attentional_focus']], - [ case, - ['get-atoms','&attentional_focus'], - [ [ _,1]]]). - -%;[8] -:-metta_eval(['CollapseCardinality',['get-atoms','&concepts']]). - -metta_defn_ES( - [ 'CollapseCardinality', - ['get-atoms','&concepts']], - [ 'TupleCount', - [ collapse, - [ 'CountElement', - ['get-atoms','&concepts']]]]). - -metta_defn_ES( - [ 'CountElement', - ['get-atoms','&concepts']], - [ case, - ['get-atoms','&concepts'], - [ [ _,1]]]). - -%;[100] -:-metta_eval(['mettalog::vspace-main']). - -% 17,439,387 inferences, 1.561 CPU in 1.572 seconds (99% CPU, 11172049 Lips) - diff --git a/.Attic/metta_lang/metta_testing.pl b/.Attic/metta_lang/metta_testing.pl index 686dd625c2c..ea78063dda2 100755 --- a/.Attic/metta_lang/metta_testing.pl +++ b/.Attic/metta_lang/metta_testing.pl @@ -126,22 +126,59 @@ symbolic_list_concat([_,R],'tests/',FilePath), file_name_extension(Base, _, R))), nop(format('

;; ~w

',[TestName,TestName])), - - if_t( (tee_file(TEE_FILE)->true;'TEE.ansi'=TEE_FILE), - (%atom_concat(TEE_FILE,'.UNITS',UNITS), - UNITS = '/tmp/SHARED.UNITS', + must_det_ll(( + (tee_file(TEE_FILE)->true;'TEE.ansi'=TEE_FILE), + (( %atom_concat(TEE_FILE,'.UNITS',UNITS), + shared_units(UNITS), open(UNITS, append, Stream,[encoding(utf8)]), once(getenv('HTML_FILE',HTML_OUT);sformat(HTML_OUT,'~w.metta.html',[Base])), - format(Stream,'| ~w | ~w |[~w](https://logicmoo.org/public/metta/reports/~w#~w) | ~@ | ~@ | ~@ |~n', + compute_html_out_per_test(HTML_OUT,TEE_FILE,TestName,HTML_OUT_PerTest), + get_last_call_duration(Duration), + format(Stream,'| ~w | ~w |[~w](https://logicmoo.org/public/metta/~w#~w) | ~@ | ~@ | ~@ | ~w | ~w |~n', [TestName,PASS_FAIL,TestName,HTML_OUT,TestName, - trim_gstring_bar_I(write_src_woi([P,C]),200), - trim_gstring_bar_I(write_src_woi(G1),100), - trim_gstring_bar_I(write_src_woi(G2),100)]),!, - close(Stream))). + trim_gstring_bar_I(write_src_woi([P,C]),400), + trim_gstring_bar_I(write_src_woi(G1),200), + trim_gstring_bar_I(write_src_woi(G2),200), + Duration, + HTML_OUT_PerTest]),!, + close(Stream))))). + +% Needs not to be absolute and not relative to CWD (since tests like all .metta files change their local CWD at least while "loading") +output_directory(OUTPUT_DIR):- getenv('METTALOG_OUTPUT',OUTPUT_DIR),!. +output_directory(OUTPUT_DIR):- getenv('OUTPUT_DIR',OUTPUT_DIR),!. + +shared_units(UNITS):- getenv('SHARED_UNITS',UNITS),!. % Needs not to be relative to CWD +shared_units(UNITS):- output_directory(OUTPUT_DIR),!,directory_file_path(OUTPUT_DIR,'SHARED.UNITS',UNITS). +shared_units(UNITS):- UNITS = '/tmp/SHARED.UNITS'. + +% currently in a shared file per TestCase class.. +% but we might make each test dump its stuffg to its own html file for easier spotting why test failed +compute_html_out_per_test(HTML_OUT,_TEE_FILE,_TestName,HTML_OUT_PerTest):- + HTML_OUT=HTML_OUT_PerTest. + +% Executes Goal and records the execution duration in '$last_call_duration'. +% The duration is recorded regardless of whether Goal succeeds or fails. +record_call_duration(Goal) :- + nb_setval('$last_call_duration', 120), + statistics(cputime, Start), % Get the start CPU time + ( call(Goal) % Call the Goal + *-> EndResult = true % If Goal succeeds, proceed + ; EndResult = false % If Goal fails, record it but proceed + ), + statistics(cputime, End), % Get the end CPU time + Duration is End - Start, % Calculate the CPU duration + nb_setval('$last_call_duration', Duration), % Set the global variable non-backtrackably + EndResult. % Preserve the result of the Goal + +% Helper to retrieve the last call duration stored in the global variable. +get_last_call_duration(Duration) :- + nb_getval('$last_call_duration', Duration),!. + trim_gstring_bar_I(Goal, MaxLen) :- wots(String0,Goal), - string_replace(String0,'|','I',String), + string_replace(String0,'|','I',String1), + string_replace(String1,'\n','\\n',String), atom_length(String, Len), ( Len =< MaxLen -> Trimmed = String @@ -151,7 +188,7 @@ ), write(Trimmed). -loonit_asserts1(TestSrc,Pre,G) :- _=nop(Pre),call(G), +loonit_asserts1(TestSrc,Pre,G) :- _=nop(Pre),record_call_duration(call(G)), give_pass_credit(TestSrc,Pre,G),!. /* diff --git a/.Attic/metta_lang/metta_toplevel.pl.Unused b/.Attic/metta_lang/metta_toplevel.pl.Unused deleted file mode 100755 index 93c5a8f7005..00000000000 --- a/.Attic/metta_lang/metta_toplevel.pl.Unused +++ /dev/null @@ -1,2155 +0,0 @@ -/* Part of SWI-Prolog - - Author: Jan Wielemaker - E-mail: J.Wielemaker@vu.nl - WWW: http://www.swi-prolog.org - Copyright (c) 1985-2021, University of Amsterdam - VU University Amsterdam - SWI-Prolog Solutions b.v. - All rights reserved. - - Redistribution and use in source and binary forms, with or without - modification, are permitted provided that the following conditions - are met: - - 1. Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - - 2. Redistributions in binary form must reproduce the above copyright - notice, this list of conditions and the following disclaimer in - the documentation and/or other materials provided with the - distribution. - - THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS - "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT - LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS - FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE - COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, - INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, - BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; - LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER - CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT - LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN - ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE - POSSIBILITY OF SUCH DAMAGE. -*/ -/* -:- module('metta_toplevel', - [ '$initialise'/0, % start Prolog - 'metta_toplevel'/0, % Prolog top-level (re-entrant) - '$compile'/0, % `-c' toplevel - '$config'/0, % --dump-runtime-variables toplevel - initialize/0, % Run program '$initialization' - version/0, % Write initial banner - version/1, % Add message to the banner - prolog/0, % user toplevel predicate - 'metta_query_loop'/0, % toplevel predicate - 'metta_execute_query'/3, % +Query, +Bindings, -Truth - residual_goals/1, % +Callable - ('$initialization')/1, % '$initialization' goal (directive) - '$thread_init'/0, % initialise thread - (thread_initialization)/1 % thread '$initialization' goal - ]). -*/ - - /******************************* - * VERSION BANNER * - *******************************/ - -:- dynamic - prolog:version_msg/1. - -%! version is det. -% -% Print the Prolog banner message and messages registered using -% version/1. - -version :- - print_message(banner, welcome). - -%! version(+Message) is det. -% -% Add message to version/0 -/* -:- multifile - system:term_expansion/2. - -system:term_expansion((:- version(Message)), - prolog:version_msg(Message)). - -version(Message) :- - ( prolog:version_msg(Message) - -> true - ; assertz(prolog:version_msg(Message)) - ). -*/ - - /******************************** - * INITIALISATION * - *********************************/ - -%! load_init_file is det. -% -% Load the user customization file. This can be done using ``swipl -f -% file`` or simply using ``swipl``. In the first case we search the -% file both directly and over the alias `user_app_config`. In the -% latter case we only use the alias. - -load_init_file :- - '$cmd_option_val'(init_file, OsFile), - !, - prolog_to_os_filename(File, OsFile), - load_init_file(File, explicit). -load_init_file :- - load_init_file('init.pl', implicit). - -%! loaded_init_file(?Base, ?AbsFile) -% -% Used by prolog_load_context/2 to confirm we are loading a script. - -:- dynamic - loaded_init_file/2. % already loaded init files - -load_init_file(none, _) :- !. -load_init_file(Base, _) :- - loaded_init_file(Base, _), - !. -load_init_file(InitFile, explicit) :- - exists_file(InitFile), - !, - ensure_loaded(user:InitFile). -load_init_file(Base, _) :- - absolute_file_name(user_app_config(Base), InitFile, - [ access(read), - file_errors(fail) - ]), - asserta(loaded_init_file(Base, InitFile)), - load_files(user:InitFile, - [ scope_settings(false) - ]). -load_init_file('init.pl', implicit) :- - ( current_prolog_flag(windows, true), - absolute_file_name(user_profile('swipl.ini'), InitFile, - [ access(read), - file_errors(fail) - ]) - ; expand_file_name('~/.swiplrc', [InitFile]), - exists_file(InitFile) - ), - !, - print_message(warning, backcomp(init_file_moved(InitFile))). -load_init_file(_, _). - -'$load_system_init_file' :- - loaded_init_file(system, _), - !. -'$load_system_init_file' :- - '$cmd_option_val'(system_init_file, Base), - Base \== none, - current_prolog_flag(home, Home), - file_name_extension(Base, rc, Name), - symbolic_list_concat([Home, '/', Name], File), - absolute_file_name(File, Path, - [ file_type(prolog), - access(read), - file_errors(fail) - ]), - asserta(loaded_init_file(system, Path)), - load_files(user:Path, - [ silent(true), - scope_settings(false) - ]), - !. -'$load_system_init_file'. - -'$load_script_file' :- - loaded_init_file(script, _), - !. -'$load_script_file' :- - '$cmd_option_val'(script_file, OsFiles), - load_script_files(OsFiles). - -load_script_files([]). -load_script_files([OsFile|More]) :- - prolog_to_os_filename(File, OsFile), - ( absolute_file_name(File, Path, - [ file_type(prolog), - access(read), - file_errors(fail) - ]) - -> asserta(loaded_init_file(script, Path)), - load_files(user:Path, []), - load_files(More) - ; throw(error(existence_error(script_file, File), _)) - ). - - - /******************************* - * AT_INITIALISATION * - *******************************/ - -:- meta_predicate - '$initialization'(0). - -:- '$iso'(('$initialization')/1). - -%! '$initialization'(:Goal) -% -% Runs Goal after loading the file in which this directive -% appears as well as after restoring a saved state. -% -% @see '$initialization'/2 -/* -'$initialization'(Goal) :- - Goal = _:G, - prolog:initialize_now(G, Use), - !, - print_message(warning, initialize_now(G, Use)), - initialization(Goal, now). -'$initialization'(Goal) :- - initialization(Goal, after_load). - -:- multifile - prolog:initialize_now/2, - prolog:message//1. - -prolog:initialize_now(load_foreign_library(_), - 'use :- use_foreign_library/1 instead'). -prolog:initialize_now(load_foreign_library(_,_), - 'use :- use_foreign_library/2 instead'). - -prolog:message(initialize_now(Goal, Use)) --> - [ 'Initialization goal ~p will be executed'-[Goal],nl, - 'immediately for backward compatibility reasons', nl, - '~w'-[Use] - ]. - -'$run_initialization' :- - '$run_initialization'(_, []), - '$thread_init'. - -%! initialize -% -% Run goals registered with `:- '$initialization'(Goal, program).`. Stop -% with an exception if a goal fails or raises an exception. - -initialize :- - forall('$init_goal'(when(program), Goal, Ctx), - run_initialize(Goal, Ctx)). - -run_initialize(Goal, Ctx) :- - ( catch(Goal, E, true), - ( var(E) - -> true - ; throw(error(initialization_error(E, Goal, Ctx), _)) - ) - ; throw(error(initialization_error(failed, Goal, Ctx), _)) - ). - -*/ - /******************************* - * THREAD INITIALIZATION * - *******************************/ -/* -:- meta_predicate - thread_initialization(0). -:- dynamic - '$at_thread_initialization'/1. - -%! thread_initialization(:Goal) -% -% Run Goal now and everytime a new thread is created. - -thread_initialization(Goal) :- - assert('$at_thread_initialization'(Goal)), - call(Goal), - !. - -'$thread_init' :- - ( '$at_thread_initialization'(Goal), - ( call(Goal) - -> fail - ; fail - ) - ; true - ). -*/ - - /******************************* - * FILE SEARCH PATH (-p) * - *******************************/ -/* -%! '$set_file_search_paths' is det. -% -% Process -p PathSpec options. - -'$set_file_search_paths' :- - '$cmd_option_val'(search_paths, Paths), - ( '$member'(Path, Paths), - atom_chars(Path, Chars), - ( phrase('$search_path'(Name, Aliases), Chars) - -> '$reverse'(Aliases, Aliases1), - forall('$member'(Alias, Aliases1), - asserta(user:file_search_path(Name, Alias))) - ; print_message(error, commandline_arg_type(p, Path)) - ), - fail ; true - ). - -'$search_path'(Name, Aliases) --> - '$string'(NameChars), - [=], - !, - {atom_chars(Name, NameChars)}, - '$search_aliases'(Aliases). - -'$search_aliases'([Alias|More]) --> - '$string'(AliasChars), - path_sep, - !, - { '$make_alias'(AliasChars, Alias) }, - '$search_aliases'(More). -'$search_aliases'([Alias]) --> - '$string'(AliasChars), - '$eos', - !, - { '$make_alias'(AliasChars, Alias) }. - -path_sep --> - { current_prolog_flag(windows, true) - }, - !, - [;]. -path_sep --> - [:]. - -'$string'([]) --> []. -'$string'([H|T]) --> [H], '$string'(T). - -'$eos'([], []). - -'$make_alias'(Chars, Alias) :- - catch(term_to_atom(Alias, Chars), _, fail), - ( atom(Alias) - ; functor(Alias, F, 1), - F \== / - ), - !. -'$make_alias'(Chars, Alias) :- - atom_chars(Alias, Chars). - -*/ - /******************************* - * LOADING ASSIOCIATED FILES * - *******************************/ - -%! argv_files(-Files) is det. -% -% Update the Prolog flag `argv`, extracting the leading script files. -/* -argv_files(Files) :- - current_prolog_flag(argv, Argv), - no_option_files(Argv, Argv1, Files, ScriptArgs), - ( ( ScriptArgs == true - ; Argv1 == [] - ) - -> ( Argv1 \== Argv - -> set_prolog_flag(argv, Argv1) - ; true - ) - ; '$usage', - halt(1) - ). - -no_option_files([--|Argv], Argv, [], true) :- !. -no_option_files([Opt|_], _, _, ScriptArgs) :- - ScriptArgs \== true, - sub_atom(Opt, 0, _, _, '-'), - !, - '$usage', - halt(1). -no_option_files([OsFile|Argv0], Argv, [File|T], ScriptArgs) :- - file_name_extension(_, Ext, OsFile), - user:prolog_file_type(Ext, prolog), - !, - ScriptArgs = true, - prolog_to_os_filename(File, OsFile), - no_option_files(Argv0, Argv, T, ScriptArgs). -no_option_files([OsScript|Argv], Argv, [Script], ScriptArgs) :- - ScriptArgs \== true, - !, - prolog_to_os_filename(Script, OsScript), - ( exists_file(Script) - -> true - ; '$existence_error'(file, Script) - ), - ScriptArgs = true. -no_option_files(Argv, Argv, [], _). - -clean_argv :- - ( current_prolog_flag(argv, [--|Argv]) - -> set_prolog_flag(argv, Argv) - ; true - ). - -%! associated_files(-Files) -% -% If SWI-Prolog is started as ., where is -% the extension registered for associated files, set the Prolog -% flag associated_file, switch to the directory holding the file -% and -if possible- adjust the window title. - -associated_files([]) :- - current_prolog_flag(saved_program_class, runtime), - !, - clean_argv. -associated_files(Files) :- - '$set_prolog_file_extension', - argv_files(Files), - ( Files = [File|_] - -> absolute_file_name(File, AbsFile), - set_prolog_flag(associated_file, AbsFile), - set_working_directory(File), - set_window_title(Files) - ; true - ). - -%! set_working_directory(+File) -% -% When opening as a GUI application, e.g., by opening a file from -% the Finder/Explorer/..., we typically want to change working -% directory to the location of the primary file. We currently -% detect that we are a GUI app by the Prolog flag =console_menu=, -% which is set by swipl-win[.exe]. - -set_working_directory(File) :- - current_prolog_flag(console_menu, true), - access_file(File, read), - !, - file_directory_name(File, Dir), - working_directory(_, Dir). -set_working_directory(_). - -set_window_title([File|More]) :- - current_predicate(system:window_title/2), - !, - ( More == [] - -> Extra = [] - ; Extra = ['...'] - ), - symbolic_list_concat(['SWI-Prolog --', File | Extra], ' ', Title), - system:window_title(_, Title). -set_window_title(_). - - -%! start_pldoc -% -% If the option =|--pldoc[=port]|= is given, load the PlDoc -% system. - -start_pldoc :- - '$cmd_option_val'(pldoc_server, Server), - ( Server == '' - -> call((doc_server(_), doc_browser)) - ; catch(atom_number(Server, Port), _, fail) - -> call(doc_server(Port)) - ; print_message(error, option_usage(pldoc)), - halt(1) - ). -start_pldoc. - - -%! load_associated_files(+Files) -% -% Load Prolog files specified from the commandline. - -load_associated_files(Files) :- - ( '$member'(File, Files), - load_files(user:File, [expand(false)]), - fail - ; true - ). - -hkey('HKEY_CURRENT_USER/Software/SWI/Prolog'). -hkey('HKEY_LOCAL_MACHINE/Software/SWI/Prolog'). - -'$set_prolog_file_extension' :- - current_prolog_flag(windows, true), - hkey(Key), - catch(win_registry_get_value(Key, fileExtension, Ext0), - _, fail), - !, - ( atom_concat('.', Ext, Ext0) - -> true - ; Ext = Ext0 - ), - ( user:prolog_file_type(Ext, prolog) - -> true - ; asserta(user:prolog_file_type(Ext, prolog)) - ). -'$set_prolog_file_extension'. - -*/ - /******************************** - * TOPLEVEL GOALS * - *********************************/ -/* -%! '$initialise' is semidet. -% -% Called from PL_initialise() to do the Prolog part of the -% '$initialization'. If an exception occurs, this is printed and -% '$initialise' fails. - -'$initialise' :- - catch(initialise_prolog, E, initialise_error(E)). - -initialise_error('$aborted') :- !. -initialise_error(E) :- - print_message(error, initialization_exception(E)), - fail. -*/ -initialise_prolog :- - '$clean_history', - apple_setup_app, - '$run_initialization', - '$load_system_init_file', - set_toplevel, - '$set_file_search_paths', - init_debug_flags, - start_pldoc, - opt_attach_packs, - load_init_file, - catch(setup_colors, E, print_message(warning, E)), - associated_files(Files), - '$load_script_file', - load_associated_files(Files), - '$cmd_option_val'(goals, Goals), - ( Goals == [], - \+ '$init_goal'(when(_), _, _) - -> version % default interactive run - ; run_init_goals(Goals), - ( load_only - -> version - ; run_program_init, - run_main_init - ) - ). - -:- if(current_prolog_flag(apple,true)). -apple_set_working_directory :- - ( expand_file_name('~', [Dir]), - exists_directory(Dir) - -> working_directory(_, Dir) - ; true - ). - -apple_set_locale :- - ( getenv('LC_CTYPE', 'UTF-8'), - apple_current_locale_identifier(LocaleID), - atom_concat(LocaleID, '.UTF-8', Locale), - catch(setlocale(ctype, _Old, Locale), _, fail) - -> setenv('LANG', Locale), - unsetenv('LC_CTYPE') - ; true - ). - -apple_setup_app :- - current_prolog_flag(apple, true), - current_prolog_flag(console_menu, true), % SWI-Prolog.app on MacOS - apple_set_working_directory, - apple_set_locale. -:- endif. -apple_setup_app. - -opt_attach_packs :- - current_prolog_flag(packs, true), - !, - attach_packs. -opt_attach_packs. - -set_toplevel :- - '$cmd_option_val'(toplevel, TopLevelAtom), - catch(term_to_atom(TopLevel, TopLevelAtom), E, - (print_message(error, E), - halt(1))), - create_prolog_flag(toplevel_goal, TopLevel, [type(term)]). - -load_only :- - current_prolog_flag(os_argv, OSArgv), - memberchk('-l', OSArgv), - current_prolog_flag(argv, Argv), - \+ memberchk('-l', Argv). - -%! run_init_goals(+Goals) is det. -% -% Run registered '$initialization' goals on order. If a goal fails, -% execution is halted. - -run_init_goals([]). -run_init_goals([H|T]) :- - run_init_goal(H), - run_init_goals(T). - -run_init_goal(Text) :- - catch(term_to_atom(Goal, Text), E, - ( print_message(error, init_goal_syntax(E, Text)), - halt(2) - )), - run_init_goal(Goal, Text). - -%! run_program_init is det. -% -% Run goals registered using - -run_program_init :- - forall('$init_goal'(when(program), Goal, Ctx), - run_init_goal(Goal, @(Goal,Ctx))). - -run_main_init :- - findall(Goal-Ctx, '$init_goal'(when(main), Goal, Ctx), Pairs), - '$last'(Pairs, Goal-Ctx), - !, - ( current_prolog_flag(toplevel_goal, default) - -> set_prolog_flag(toplevel_goal, halt) - ; true - ), - run_init_goal(Goal, @(Goal,Ctx)). -run_main_init. - -run_init_goal(Goal, Ctx) :- - ( catch_with_backtrace(user:Goal, E, true) - -> ( var(E) - -> true - ; print_message(error, init_goal_failed(E, Ctx)), - halt(2) - ) - ; ( current_prolog_flag(verbose, silent) - -> Level = silent - ; Level = error - ), - print_message(Level, init_goal_failed(failed, Ctx)), - halt(1) - ). - -%! init_debug_flags is det. -% -% Initialize the various Prolog flags that control the debugger and -% toplevel. - -init_debug_flags :- - once(print_predicate(_, [print], PrintOptions)), - Keep = [keep(true)], - create_prolog_flag(answer_write_options, PrintOptions, Keep), - create_prolog_flag(prompt_alternatives_on, determinism, Keep), - create_prolog_flag(toplevel_extra_white_line, true, Keep), - create_prolog_flag(toplevel_print_factorized, false, Keep), - create_prolog_flag(print_write_options, - [ portray(true), quoted(true), numbervars(true) ], - Keep), - create_prolog_flag(toplevel_residue_vars, false, Keep), - create_prolog_flag(toplevel_list_wfs_residual_program, true, Keep), - '$set_debugger_write_options'(print). - -%! setup_backtrace -% -% Initialise printing a backtrace. - -setup_backtrace :- - ( \+ current_prolog_flag(backtrace, false), - load_setup_file(library(prolog_stack)) - -> true - ; true - ). - -%! setup_colors is det. -% -% Setup interactive usage by enabling colored output. - -setup_colors :- - ( \+ current_prolog_flag(color_term, false), - stream_property(user_input, tty(true)), - stream_property(user_error, tty(true)), - stream_property(user_output, tty(true)), - \+ getenv('TERM', dumb), - load_setup_file(user:library(ansi_term)) - -> true - ; true - ). - -%! setup_history -% -% Enable per-directory persistent history. - -setup_history :- - ( \+ current_prolog_flag(save_history, false), - stream_property(user_input, tty(true)), - \+ current_prolog_flag(readline, false), - load_setup_file(library(prolog_history)) - -> prolog_history(enable) - ; true - ), - set_default_history, - '$load_history'. - -%! setup_readline -% -% Setup line editing. - -setup_readline :- - ( current_prolog_flag(readline, swipl_win) - -> true - ; stream_property(user_input, tty(true)), - current_prolog_flag(tty_control, true), - \+ getenv('TERM', dumb), - ( current_prolog_flag(readline, ReadLine) - -> true - ; ReadLine = true - ), - readline_library(ReadLine, Library), - load_setup_file(library(Library)) - -> set_prolog_flag(readline, Library) - ; set_prolog_flag(readline, false) - ). - -readline_library(true, Library) :- - !, - preferred_readline(Library). -readline_library(false, _) :- - !, - fail. -readline_library(Library, Library). - -preferred_readline(editline). -preferred_readline(readline). - -%! load_setup_file(+File) is semidet. -% -% Load a file and fail silently if the file does not exist. - -load_setup_file(File) :- - catch(load_files(File, - [ silent(true), - if(not_loaded) - ]), _, fail). - - -:- '$hide'('metta_toplevel'/0). % avoid in the GUI stacktrace - -%! 'metta_toplevel' -% -% Called from PL_toplevel() - -'metta_toplevel' :- - '$runtoplevel', - print_message(informational, halt). - -%! '$runtoplevel' -% -% Actually run the toplevel. The values `default` and `prolog` both -% start the interactive toplevel, where `prolog` implies the user gave -% =|-t prolog|=. -% -% @see prolog/0 is the default interactive toplevel - -'$runtoplevel' :- - current_prolog_flag(toplevel_goal, TopLevel0), - toplevel_goal(TopLevel0, TopLevel), - user:TopLevel. - -:- dynamic setup_done/0. -:- volatile setup_done/0. - -toplevel_goal(default, 'metta_query_loop') :- - !, - setup_interactive. -toplevel_goal(prolog, 'metta_query_loop') :- - !, - setup_interactive. -toplevel_goal(Goal, Goal). - -setup_interactive :- - setup_done, - !. -setup_interactive :- - asserta(setup_done), - catch(setup_backtrace, E, print_message(warning, E)), - catch(setup_readline, E, print_message(warning, E)), - catch(setup_history, E, print_message(warning, E)). - -%! '$compile' -% -% Toplevel called when invoked with -c option. - -'$compile' :- - ( catch('$compile_', E, (print_message(error, E), halt(1))) - -> true - ; print_message(error, error(goal_failed('$compile'), _)), - halt(1) - ), - halt. % set exit code - -'$compile_' :- - '$load_system_init_file', - catch(setup_colors, _, true), - '$set_file_search_paths', - init_debug_flags, - '$run_initialization', - opt_attach_packs, - use_module(library(qsave)), - qsave:qsave_toplevel. - -%! '$config' -% -% Toplevel when invoked with --dump-runtime-variables -/* -'$config' :- - '$load_system_init_file', - '$set_file_search_paths', - init_debug_flags, - '$run_initialization', - load_files(library(prolog_config)), - ( catch(prolog_dump_runtime_variables, E, - (print_message(error, E), halt(1))) - -> true - ; print_message(error, error(goal_failed(prolog_dump_runtime_variables),_)) - ). - -*/ - /******************************** - * USER INTERACTIVE LOOP * - *********************************/ - -%! prolog -% -% Run the Prolog toplevel. This is now the same as break/0, which -% pretends to be in a break-level if there is a parent -% environment. - -%prolog :- break. - -:- create_prolog_flag(toplevel_mode, backtracking, []). - -%! 'metta_query_loop' -% -% Run the normal Prolog query loop. Note that the query is not -% protected by catch/3. Dealing with unhandled exceptions is done -% by the C-function query_loop(). This ensures that unhandled -% exceptions are really unhandled (in Prolog). - -'metta_query_loop' :- - current_prolog_flag(toplevel_mode, recursive), - !, - break_level(Level), - read_expanded_query(Level, Query, Bindings), - ( Query == end_of_file - -> print_message(query, query(eof)) - ; '$call_no_catch'('metta_execute_query'(Query, Bindings, _)), - ( current_prolog_flag(toplevel_mode, recursive) - -> 'metta_query_loop' - ; '$switch_toplevel_mode'(backtracking), - 'metta_query_loop' % Maybe throw('$switch_toplevel_mode')? - ) - ). -'metta_query_loop' :- - break_level(BreakLev), - repeat, - read_expanded_query(BreakLev, Query, Bindings), - ( Query == end_of_file - -> !, print_message(query, query(eof)) - ; 'metta_execute_query'(Query, Bindings, _), - ( current_prolog_flag(toplevel_mode, recursive) - -> !, - '$switch_toplevel_mode'(recursive), - 'metta_query_loop' - ; fail - ) - ). - -break_level(BreakLev) :- - ( current_prolog_flag(break_level, BreakLev) - -> true - ; BreakLev = -1 - ). - -read_expanded_query(BreakLev, ExpandedQuery, ExpandedBindings) :- - '$current_typein_module'(TypeIn), - ( stream_property(user_input, tty(true)) - -> '$system_prompt'(TypeIn, BreakLev, Prompt), - prompt(Old, '| ') - ; Prompt = '', - prompt(Old, '') - ), - trim_stacks, - trim_heap, - repeat, - read_query(Prompt, Query, Bindings), - prompt(_, Old), - catch(call_expand_query(Query, ExpandedQuery, - Bindings, ExpandedBindings), - Error, - (print_message(error, Error), fail)), - !. - -%! read_s_term_with_history(-Term, +Options) -% -% Read a term guide by Options and maintain a history similar to most -% Unix shells. -% -% When read_history reads a term of the form $silent(Goal), it will -% call Goal and pretend it has not seen anything. This hook is used by -% the GNU-Emacs interface to for communication between GNU-EMACS and -% SWI-Prolog. - -read_s_term_with_history(Term, Options) :- - '$option'(prompt(Prompt), Options, '~! metta>'), - '$option'(input(Input), Options, user_input), - repeat, - prompt_history(Prompt), - read_query_line(Input, Raw), - read_history_(Raw, Term, Options), - !. - - -%! read_query(+Prompt, -Goal, -Bindings) is det. -% -% Read the next query. The first clause deals with the case where -% !-based history is enabled. The second is used if we have command -% line editing. - - -:- if(current_prolog_flag(emscripten, true)). -read_query(_Prompt, Goal, Bindings) :- - '$can_yield', - !, - await(goal, GoalString), - term_string(Goal, GoalString, [variable_names(Bindings)]). -:- endif. -read_query(Prompt, Goal, Bindings) :- - current_prolog_flag(history, N), - integer(N), N > 0, - !, - read_s_term_with_history( - Goal, - [ show(h), - help('!h'), - no_save([trace, end_of_file]), - prompt(Prompt), - variable_names(Bindings) - ]). -read_query(Prompt, Goal, Bindings) :- - remove_history_prompt(Prompt, Prompt1), - repeat, % over syntax errors - prompt1(Prompt1), - read_query_line(user_input, Line), - '$save_history_line'(Line), % save raw line (edit syntax errors) - '$current_typein_module'(TypeIn), - catch(read_s_term_as_atom(Line, Goal, - [ variable_names(Bindings), - module(TypeIn) - ]), E, - ( print_message(error, E), - fail - )), - !, - '$save_history_event'(Line). % save event (no syntax errors) - -%! read_query_line(+Input, -Line) is det. - -read_query_line(Input, Line) :- - stream_property(Input, error(true)), - !, - Line = end_of_file. -read_query_line(Input, Line) :- - catch(read_s_term_as_atom(Input, Line), Error, true), - save_debug_after_read, - ( var(Error) - -> true - ; catch(print_message(error, Error), _, true), - ( Error = error(syntax_error(_),_) - -> fail - ; throw(Error) - ) - ). - -%! read_s_term_as_atom(+Input, -Line) -% -% Read the next term as an atom and skip to the newline or a -% non-space character. - -read_s_term_as_atom(In, Line) :- - read_metta(In,Line), - ( Line == end_of_file - -> true - ; skip_to_nl(In) - ). -/* -read_s_term_as_atom(In, Line) :- - '$raw_read'(In, Line), - ( Line == end_of_file - -> true - ; skip_to_nl(In) - ). -*/ - -%! skip_to_nl(+Input) is det. -% -% Read input after the term. Skips white space and %... comment -% until the end of the line or a non-blank character. - -skip_to_nl(In) :- - repeat, - peek_char(In, C), - ( C == '%' - -> skip(In, '\n') - ; char_type(C, space) - -> get_char(In, _), - C == '\n' - ; true - ), - !. - -remove_history_prompt('', '') :- !. -remove_history_prompt(Prompt0, Prompt) :- - atom_chars(Prompt0, Chars0), - clean_history_prompt_chars(Chars0, Chars1), - delete_leading_blanks(Chars1, Chars), - atom_chars(Prompt, Chars). - -clean_history_prompt_chars([], []). -clean_history_prompt_chars(['~', !|T], T) :- !. -clean_history_prompt_chars([H|T0], [H|T]) :- - clean_history_prompt_chars(T0, T). - -delete_leading_blanks([' '|T0], T) :- - !, - delete_leading_blanks(T0, T). -delete_leading_blanks(L, L). - - -%! set_default_history -% -% Enable !-based numbered command history. This is enabled by default -% if we are not running under GNU-emacs and we do not have our own -% line editing. - -set_default_history :- - current_prolog_flag(history, _), - !. -set_default_history :- - ( ( \+ current_prolog_flag(readline, false) - ; current_prolog_flag(emacs_inferior_process, true) - ) - -> create_prolog_flag(history, 0, []) - ; create_prolog_flag(history, 25, []) - ). - - - /******************************* - * TOPLEVEL DEBUG * - *******************************/ - -%! save_debug_after_read -% -% Called right after the toplevel read to save the debug status if -% it was modified from the GUI thread using e.g. -% -% == -% thread_signal(main, gdebug) -% == -% -% @bug Ideally, the prompt would change if debug mode is enabled. -% That is hard to realise with all the different console -% interfaces supported by SWI-Prolog. - -save_debug_after_read :- - current_prolog_flag(debug, true), - !, - save_debug. -save_debug_after_read. - -save_debug :- - ( tracing, - notrace - -> Tracing = true - ; Tracing = false - ), - current_prolog_flag(debug, Debugging), - set_prolog_flag(debug, false), - create_prolog_flag(query_debug_settings, - debug(Debugging, Tracing), []). - -restore_debug :- - current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)), - set_prolog_flag(debug, Debugging), - ( Tracing == true - -> trace - ; true - ). - -%:- '$initialization'(create_prolog_flag(query_debug_settings, debug(false, false), [])). - - - /******************************** - * PROMPTING * - ********************************/ - -'$system_prompt'(Module, BrekLev, Prompt) :- - current_prolog_flag(toplevel_prompt, PAtom), - atom_codes(PAtom, P0), - ( Module \== user - -> '$substitute'('~m', [Module, ': '], P0, P1) - ; '$substitute'('~m', [], P0, P1) - ), - ( BrekLev > 0 - -> '$substitute'('~l', ['[', BrekLev, '] '], P1, P2) - ; '$substitute'('~l', [], P1, P2) - ), - current_prolog_flag(query_debug_settings, debug(Debugging, Tracing)), - ( Tracing == true - -> '$substitute'('~d', ['[trace] '], P2, P3) - ; Debugging == true - -> '$substitute'('~d', ['[debug] '], P2, P3) - ; '$substitute'('~d', [], P2, P3) - ), - atom_chars(Prompt, P3). - -'$substitute'(From, T, Old, New) :- - atom_codes(From, FromCodes), - phrase(subst_chars(T), T0), - '$append'(Pre, S0, Old), - '$append'(FromCodes, Post, S0) -> - '$append'(Pre, T0, S1), - '$append'(S1, Post, New), - !. -'$substitute'(_, _, Old, Old). - -subst_chars([]) --> - []. -subst_chars([H|T]) --> - { atomic(H), - !, - atom_codes(H, Codes) - }, - Codes, - subst_chars(T). -subst_chars([H|T]) --> - H, - subst_chars(T). - - - /******************************** - * EXECUTION * - ********************************/ - -%! 'metta_execute_query'(Goal, Bindings, -Truth) is det. -% -% Execute Goal using Bindings. - -'metta_execute_query'(Var, _, true) :- - var(Var), - !, - print_message(informational, var_query(Var)). -'metta_execute_query'(Goal, Bindings, Truth) :- - '$current_typein_module'(TypeIn), - '$dwim_correct_goal'(TypeIn:Goal, Bindings, Corrected), - !, - setup_call_cleanup( - '$set_source_module'(M0, TypeIn), - expand_goal(Corrected, Expanded), - '$set_source_module'(M0)), - print_message(silent, toplevel_goal(Expanded, Bindings)), - '$execute_goal2'(Expanded, Bindings, Truth). -'metta_execute_query'(_, _, false) :- - notrace, - print_message(query, query(no)). - -'$execute_goal2'(Goal, Bindings, true) :- - restore_debug, - '$current_typein_module'(TypeIn), - residue_vars(TypeIn:Goal, Vars, TypeIn:Delays, Chp), - deterministic(Det), - ( save_debug - ; restore_debug, fail - ), - flush_output(user_output), - ( Det == true - -> DetOrChp = true - ; DetOrChp = Chp - ), - call_expand_answer(Bindings, NewBindings), - ( \+ \+ write_bindings(NewBindings, Vars, Delays, DetOrChp) - -> ! - ). -'$execute_goal2'(_, _, false) :- - save_debug, - print_message(query, query(no)). - -residue_vars(Goal, Vars, Delays, Chp) :- - current_prolog_flag(toplevel_residue_vars, true), - !, - '$wfs_call'(call_residue_vars(stop_backtrace(Goal, Chp), Vars), Delays). -residue_vars(Goal, [], Delays, Chp) :- - '$wfs_call'(stop_backtrace(Goal, Chp), Delays). - -stop_backtrace(Goal, Chp) :- - toplevel_call(Goal), - prolog_current_choice(Chp). - -toplevel_call(Goal) :- - call(Goal), - no_lco. - -no_lco. - -%! write_bindings(+Bindings, +ResidueVars, +Delays, +DetOrChp) -%! is semidet. -% -% Write bindings resulting from a query. The flag -% prompt_alternatives_on determines whether the user is prompted -% for alternatives. =groundness= gives the classical behaviour, -% =determinism= is considered more adequate and informative. -% -% Succeeds if the user accepts the answer and fails otherwise. -% -% @arg ResidueVars are the residual constraints and provided if -% the prolog flag `toplevel_residue_vars` is set to -% `project`. - -write_bindings(Bindings, ResidueVars, Delays, DetOrChp) :- - '$current_typein_module'(TypeIn), - translate_bindings(Bindings, Bindings1, ResidueVars, TypeIn:Residuals), - omit_qualifier(Delays, TypeIn, Delays1), - name_vars(Bindings1, Residuals, Delays1), - write_bindings2(Bindings1, Residuals, Delays1, DetOrChp). - -write_bindings2([], Residuals, Delays, _) :- - current_prolog_flag(prompt_alternatives_on, groundness), - !, - print_message(query, query(yes(Delays, Residuals))). -write_bindings2(Bindings, Residuals, Delays, true) :- - current_prolog_flag(prompt_alternatives_on, determinism), - !, - print_message(query, query(yes(Bindings, Delays, Residuals))). -write_bindings2(Bindings, Residuals, Delays, Chp) :- - repeat, - print_message(query, query(more(Bindings, Delays, Residuals))), - get_respons(Action, Chp), - ( Action == redo - -> !, fail - ; Action == show_again - -> fail - ; !, - print_message(query, query(done)) - ). - -name_vars(Bindings, Residuals, Delays) :- - current_prolog_flag(toplevel_name_variables, true), - !, - '$term_multitons'(t(Bindings,Residuals,Delays), Vars), - name_vars_(Vars, Bindings, 0), - term_variables(t(Bindings,Residuals,Delays), SVars), - anon_vars(SVars). -name_vars(_Bindings, _Residuals, _Delays). - -name_vars_([], _, _). -name_vars_([H|T], Bindings, N) :- - name_var(Bindings, Name, N, N1), - H = '$VAR'(Name), - name_vars_(T, Bindings, N1). - -anon_vars([]). -anon_vars(['$VAR'('_')|T]) :- - anon_vars(T). - -name_var(Bindings, Name, N0, N) :- - between(N0, infinite, N1), - I is N1//26, - J is 0'A + N1 mod 26, %' - ( I == 0 - -> format(atom(Name), '_~c', [J]) - ; format(atom(Name), '_~c~d', [J, I]) - ), - ( current_prolog_flag(toplevel_print_anon, false) - -> true - ; \+ is_bound(Bindings, Name) - ), - !, - N is N1+1. - -is_bound([Vars=_|T], Name) :- - ( in_vars(Vars, Name) - -> true - ; is_bound(T, Name) - ). - -in_vars(Name, Name) :- !. -in_vars(Names, Name) :- - '$member'(Name, Names). - -%! residual_goals(:NonTerminal) -% -% Directive that registers NonTerminal as a collector for residual -% goals. -/* -:- multifile - residual_goal_collector/1. - -:- meta_predicate - residual_goals(2). - -residual_goals(NonTerminal) :- - throw(error(context_error(nodirective, residual_goals(NonTerminal)), _)). - -system:term_expansion((:- residual_goals(NonTerminal)), - 'metta_toplevel':residual_goal_collector(M2:Head)) :- - \+ current_prolog_flag(xref, true), - prolog_load_context(module, M), - strip_module(M:NonTerminal, M2, Head), - '$must_be'(callable, Head). - -%! prolog:residual_goals// is det. -% -% DCG that collects residual goals that are not associated with -% the answer through attributed variables. - -:- public prolog:residual_goals//0. - -prolog:residual_goals --> - { findall(NT, residual_goal_collector(NT), NTL) }, - collect_residual_goals(NTL). - -collect_residual_goals([]) --> []. -collect_residual_goals([H|T]) --> - ( call(H) -> [] ; [] ), - collect_residual_goals(T). -*/ - - -%! prolog:translate_bindings(+Bindings0, -Bindings, +ResidueVars, -%! +ResidualGoals, -Residuals) is det. -% -% Translate the raw variable bindings resulting from successfully -% completing a query into a binding list and list of residual -% goals suitable for human consumption. -% -% @arg Bindings is a list of binding(Vars,Value,Substitutions), -% where Vars is a list of variable names. E.g. -% binding(['A','B'],42,[])` means that both the variable -% A and B have the value 42. Values may contain terms -% '$VAR'(Name) to indicate sharing with a given variable. -% Value is always an acyclic term. If cycles appear in the -% answer, Substitutions contains a list of substitutions -% that restore the original term. -% -% @arg Residuals is a pair of two lists representing residual -% goals. The first element of the pair are residuals -% related to the query variables and the second are -% related that are disconnected from the query. -/* -:- public - prolog:translate_bindings/5. -:- meta_predicate - prolog:translate_bindings(+, -, +, +, :). - -prolog:translate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals) :- - translate_bindings(Bindings0, Bindings, ResVars, ResGoals, Residuals). -*/ -translate_bindings(Bindings0, Bindings, ResidueVars, Residuals) :- - prolog:residual_goals(ResidueGoals, []), - translate_bindings(Bindings0, Bindings, ResidueVars, ResidueGoals, - Residuals). - -translate_bindings(Bindings0, Bindings, [], [], _:[]-[]) :- - term_attvars(Bindings0, []), - !, - join_same_bindings(Bindings0, Bindings1), - factorize_bindings(Bindings1, Bindings2), - bind_vars(Bindings2, Bindings3), - filter_bindings(Bindings3, Bindings). -translate_bindings(Bindings0, Bindings, ResidueVars, ResGoals0, - TypeIn:Residuals-HiddenResiduals) :- - project_constraints(Bindings0, ResidueVars), - hidden_residuals(ResidueVars, Bindings0, HiddenResiduals0), - omit_qualifiers(HiddenResiduals0, TypeIn, HiddenResiduals), - copy_term(Bindings0+ResGoals0, Bindings1+ResGoals1, Residuals0), - '$append'(ResGoals1, Residuals0, Residuals1), - omit_qualifiers(Residuals1, TypeIn, Residuals), - join_same_bindings(Bindings1, Bindings2), - factorize_bindings(Bindings2, Bindings3), - bind_vars(Bindings3, Bindings4), - filter_bindings(Bindings4, Bindings). - -hidden_residuals(ResidueVars, Bindings, Goal) :- - term_attvars(ResidueVars, Remaining), - term_attvars(Bindings, QueryVars), - subtract_vars(Remaining, QueryVars, HiddenVars), - copy_term(HiddenVars, _, Goal). - -subtract_vars(All, Subtract, Remaining) :- - sort(All, AllSorted), - sort(Subtract, SubtractSorted), - ord_subtract(AllSorted, SubtractSorted, Remaining). - -ord_subtract([], _Not, []). -ord_subtract([H1|T1], L2, Diff) :- - diff21(L2, H1, T1, Diff). - -diff21([], H1, T1, [H1|T1]). -diff21([H2|T2], H1, T1, Diff) :- - compare(Order, H1, H2), - diff3(Order, H1, T1, H2, T2, Diff). - -diff12([], _H2, _T2, []). -diff12([H1|T1], H2, T2, Diff) :- - compare(Order, H1, H2), - diff3(Order, H1, T1, H2, T2, Diff). - -diff3(<, H1, T1, H2, T2, [H1|Diff]) :- - diff12(T1, H2, T2, Diff). -diff3(=, _H1, T1, _H2, T2, Diff) :- - ord_subtract(T1, T2, Diff). -diff3(>, H1, T1, _H2, T2, Diff) :- - diff21(T2, H1, T1, Diff). - - -%! project_constraints(+Bindings, +ResidueVars) is det. -% -% Call :project_attributes/2 if the Prolog flag -% `toplevel_residue_vars` is set to `project`. - -project_constraints(Bindings, ResidueVars) :- - !, - term_attvars(Bindings, AttVars), - phrase(attribute_modules(AttVars), Modules0), - sort(Modules0, Modules), - term_variables(Bindings, QueryVars), - project_attributes(Modules, QueryVars, ResidueVars). -project_constraints(_, _). - -project_attributes([], _, _). -project_attributes([M|T], QueryVars, ResidueVars) :- - ( current_predicate(M:project_attributes/2), - catch(M:project_attributes(QueryVars, ResidueVars), E, - print_message(error, E)) - -> true - ; true - ), - project_attributes(T, QueryVars, ResidueVars). - -attribute_modules([]) --> []. -attribute_modules([H|T]) --> - { get_attrs(H, Attrs) }, - attrs_modules(Attrs), - attribute_modules(T). - -attrs_modules([]) --> []. -attrs_modules(att(Module, _, More)) --> - [Module], - attrs_modules(More). - - -%! join_same_bindings(Bindings0, Bindings) -% -% Join variables that are bound to the same value. Note that we -% return the _last_ value. This is because the factorization may -% be different and ultimately the names will be printed as V1 = -% V2, ... VN = Value. Using the last, Value has the factorization -% of VN. - -join_same_bindings([], []). -join_same_bindings([Name=V0|T0], [[Name|Names]=V|T]) :- - take_same_bindings(T0, V0, V, Names, T1), - join_same_bindings(T1, T). - -take_same_bindings([], Val, Val, [], []). -take_same_bindings([Name=V1|T0], V0, V, [Name|Names], T) :- - V0 == V1, - !, - take_same_bindings(T0, V1, V, Names, T). -take_same_bindings([Pair|T0], V0, V, Names, [Pair|T]) :- - take_same_bindings(T0, V0, V, Names, T). - - -%! omit_qualifiers(+QGoals, +TypeIn, -Goals) is det. -% -% Omit unneeded module qualifiers from QGoals relative to the -% given module TypeIn. - - -omit_qualifiers([], _, []). -omit_qualifiers([Goal0|Goals0], TypeIn, [Goal|Goals]) :- - omit_qualifier(Goal0, TypeIn, Goal), - omit_qualifiers(Goals0, TypeIn, Goals). - -omit_qualifier(M:G0, TypeIn, G) :- - M == TypeIn, - !, - omit_meta_qualifiers(G0, TypeIn, G). -omit_qualifier(M:G0, TypeIn, G) :- - predicate_property(TypeIn:G0, imported_from(M)), - \+ predicate_property(G0, transparent), - !, - G0 = G. -omit_qualifier(_:G0, _, G) :- - predicate_property(G0, built_in), - \+ predicate_property(G0, transparent), - !, - G0 = G. -omit_qualifier(M:G0, _, M:G) :- - atom(M), - !, - omit_meta_qualifiers(G0, M, G). -omit_qualifier(G0, TypeIn, G) :- - omit_meta_qualifiers(G0, TypeIn, G). - -omit_meta_qualifiers(V, _, V) :- - var(V), - !. -omit_meta_qualifiers((QA,QB), TypeIn, (A,B)) :- - !, - omit_qualifier(QA, TypeIn, A), - omit_qualifier(QB, TypeIn, B). -omit_meta_qualifiers(tnot(QA), TypeIn, tnot(A)) :- - !, - omit_qualifier(QA, TypeIn, A). -omit_meta_qualifiers(freeze(V, QGoal), TypeIn, freeze(V, Goal)) :- - callable(QGoal), - !, - omit_qualifier(QGoal, TypeIn, Goal). -omit_meta_qualifiers(when(Cond, QGoal), TypeIn, when(Cond, Goal)) :- - callable(QGoal), - !, - omit_qualifier(QGoal, TypeIn, Goal). -omit_meta_qualifiers(G, _, G). - - -%! bind_vars(+BindingsIn, -Bindings) -% -% Bind variables to '$VAR'(Name), so they are printed by the names -% used in the query. Note that by binding in the reverse order, -% variables bound to one another come out in the natural order. - -bind_vars(Bindings0, Bindings) :- - bind_query_vars(Bindings0, Bindings, SNames), - bind_skel_vars(Bindings, Bindings, SNames, 1, _). - -bind_query_vars([], [], []). -bind_query_vars([binding(Names,Var,[Var2=Cycle])|T0], - [binding(Names,Cycle,[])|T], [Name|SNames]) :- - Var == Var2, % also implies var(Var) - !, - '$last'(Names, Name), - Var = '$VAR'(Name), - bind_query_vars(T0, T, SNames). -bind_query_vars([B|T0], [B|T], AllNames) :- - B = binding(Names,Var,Skel), - bind_query_vars(T0, T, SNames), - ( var(Var), \+ attvar(Var), Skel == [] - -> AllNames = [Name|SNames], - '$last'(Names, Name), - Var = '$VAR'(Name) - ; AllNames = SNames - ). - - - -bind_skel_vars([], _, _, N, N). -bind_skel_vars([binding(_,_,Skel)|T], Bindings, SNames, N0, N) :- - bind_one_skel_vars(Skel, Bindings, SNames, N0, N1), - bind_skel_vars(T, Bindings, SNames, N1, N). - -%! bind_one_skel_vars(+Subst, +Bindings, +VarName, +N0, -N) -% -% Give names to the factorized variables that do not have a name -% yet. This introduces names _S, avoiding duplicates. If a -% factorized variable shares with another binding, use the name of -% that variable. -% -% @tbd Consider the call below. We could remove either of the -% A = x(1). Which is best? -% -% == -% ?- A = x(1), B = a(A,A). -% A = x(1), -% B = a(A, A), % where -% A = x(1). -% == - -bind_one_skel_vars([], _, _, N, N). -bind_one_skel_vars([Var=Value|T], Bindings, Names, N0, N) :- - ( var(Var) - -> ( '$member'(binding(Names, VVal, []), Bindings), - same_term(Value, VVal) - -> '$last'(Names, VName), - Var = '$VAR'(VName), - N2 = N0 - ; between(N0, infinite, N1), - atom_concat('_S', N1, Name), - \+ memberchk(Name, Names), - !, - Var = '$VAR'(Name), - N2 is N1 + 1 - ) - ; N2 = N0 - ), - bind_one_skel_vars(T, Bindings, Names, N2, N). - - -%! factorize_bindings(+Bindings0, -Factorized) -% -% Factorize cycles and sharing in the bindings. - -factorize_bindings([], []). -factorize_bindings([Name=Value|T0], [binding(Name, Skel, Subst)|T]) :- - '$factorize_term'(Value, Skel, Subst0), - ( current_prolog_flag(toplevel_print_factorized, true) - -> Subst = Subst0 - ; only_cycles(Subst0, Subst) - ), - factorize_bindings(T0, T). - - -only_cycles([], []). -only_cycles([B|T0], List) :- - ( B = (Var=Value), - Var = Value, - acyclic_term(Var) - -> only_cycles(T0, List) - ; List = [B|T], - only_cycles(T0, T) - ). - - -%! filter_bindings(+Bindings0, -Bindings) -% -% Remove bindings that must not be printed. There are two of them: -% Variables whose name start with '_' and variables that are only -% bound to themselves (or, unbound). - -filter_bindings([], []). -filter_bindings([H0|T0], T) :- - hide_vars(H0, H), - ( ( arg(1, H, []) - ; self_bounded(H) - ) - -> filter_bindings(T0, T) - ; T = [H|T1], - filter_bindings(T0, T1) - ). - -hide_vars(binding(Names0, Skel, Subst), binding(Names, Skel, Subst)) :- - hide_names(Names0, Skel, Subst, Names). - -hide_names([], _, _, []). -hide_names([Name|T0], Skel, Subst, T) :- - ( sub_atom(Name, 0, _, _, '_'), - current_prolog_flag(toplevel_print_anon, false), - sub_atom(Name, 1, 1, _, Next), - char_type(Next, prolog_var_start) - -> true - ; Subst == [], - Skel == '$VAR'(Name) - ), - !, - hide_names(T0, Skel, Subst, T). -hide_names([Name|T0], Skel, Subst, [Name|T]) :- - hide_names(T0, Skel, Subst, T). - -self_bounded(binding([Name], Value, [])) :- - Value == '$VAR'(Name). - -%! get_respons(-Action, +Chp) -% -% Read the continuation entered by the user. - -:- if(current_prolog_flag(emscripten, true)). -get_respons(Action, _Chp) :- - '$can_yield', - !, - await(more, ActionS), - atom_string(Action, ActionS). -:- endif. -get_respons(Action, Chp) :- - repeat, - flush_output(user_output), - get_single_char(Char), - answer_respons(Char, Chp, Action), - ( Action == again - -> print_message(query, query(action)), - fail - ; ! - ). - -answer_respons(Char, _, again) :- - '$in_reply'(Char, '?h'), - !, - print_message(help, query(help)). -answer_respons(Char, _, redo) :- - '$in_reply'(Char, ';nrNR \t'), - !, - print_message(query, if_tty([ansi(bold, ';', [])])). -answer_respons(Char, _, redo) :- - '$in_reply'(Char, 'tT'), - !, - trace, - save_debug, - print_message(query, if_tty([ansi(bold, '; [trace]', [])])). -answer_respons(Char, _, continue) :- - '$in_reply'(Char, 'ca\n\ryY.'), - !, - print_message(query, if_tty([ansi(bold, '.', [])])). -answer_respons(0'b, _, show_again) :- %' - !, - break. -answer_respons(0'*, Chp, show_again) :- %' - !, - print_last_chpoint(Chp). -answer_respons(Char, _, show_again) :- - print_predicate(Char, Pred, Options), - !, - print_message(query, if_tty(['~w'-[Pred]])), - set_prolog_flag(answer_write_options, Options). -answer_respons(-1, _, show_again) :- - !, - print_message(query, halt('EOF')), - halt(0). -answer_respons(Char, _, again) :- - print_message(query, no_action(Char)). - -print_predicate(0'w, [write], [ quoted(true), %' - spacing(next_argument) - ]). -print_predicate(0'p, [print], [ quoted(true), %' - portray(true), - max_depth(10), - spacing(next_argument) - ]). - - -print_last_chpoint(Chp) :- - current_predicate(print_last_choice_point/0), - !, - print_last_chpoint_(Chp). -print_last_chpoint(Chp) :- - use_module(library(prolog_stack), [print_last_choicepoint/2]), - print_last_chpoint_(Chp). - -print_last_chpoint_(Chp) :- - print_last_choicepoint(Chp, [message_level(information)]). - - - /******************************* - * EXPANSION * - *******************************/ - -:- user:dynamic(expand_query/4). -:- user:multifile(expand_query/4). - -call_expand_query(Goal, Expanded, Bindings, ExpandedBindings) :- - user:expand_query(Goal, Expanded, Bindings, ExpandedBindings), - !. -call_expand_query(Goal, Expanded, Bindings, ExpandedBindings) :- - toplevel_variables:expand_query(Goal, Expanded, Bindings, ExpandedBindings), - !. -call_expand_query(Goal, Goal, Bindings, Bindings). - - -:- user:dynamic(expand_answer/2). -:- user:multifile(expand_answer/2). - -call_expand_answer(Goal, Expanded) :- - user:expand_answer(Goal, Expanded), - !. -call_expand_answer(Goal, Expanded) :- - toplevel_variables:expand_answer(Goal, Expanded), - !. -call_expand_answer(Goal, Goal). - - - -/* Part of SWI-Prolog - - Author: Jan Wielemaker - E-mail: J.Wielemaker@vu.nl - WWW: http://www.swi-prolog.org - Copyright (c) 1985-2020, University of Amsterdam - VU University Amsterdam - CWI Amsterdam - All rights reserved. - - Redistribution and use in source and binary forms, with or without - modification, are permitted provided that the following conditions - are met: - - 1. Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - - 2. Redistributions in binary form must reproduce the above copyright - notice, this list of conditions and the following disclaimer in - the documentation and/or other materials provided with the - distribution. - - THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS - "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT - LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS - FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE - COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, - INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, - BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; - LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER - CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT - LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN - ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE - POSSIBILITY OF SUCH DAMAGE. -*/ -/* -:- module('$history', - [ read_term_with_history/2, % -Term, +Line - '$save_history_line'/1, % +Line - '$clean_history'/0, - '$load_history'/0, - '$save_history_event'/1 - ]). - -%! read_term_with_history(-Term, +Options) -% -% Read a term guide by Options and maintain a history similar to most -% Unix shells. -% -% When read_history reads a term of the form $silent(Goal), it will -% call Goal and pretend it has not seen anything. This hook is used by -% the GNU-Emacs interface to for communication between GNU-EMACS and -% SWI-Prolog. - -read_term_with_history(Term, Options) :- - '$option'(prompt(Prompt), Options, '~! ?> '), - '$option'(input(Input), Options, user_input), - repeat, - prompt_history(Prompt), - read_query_line(Input, Raw), - read_history_(Raw, Term, Options), - !. -*/ -read_history_(Raw, _Term, Options) :- - '$option'(show(Raw), Options, history), - list_history, - !, - fail. -read_history_(Raw, _Term, Options) :- - '$option'(help(Raw), Options, '!help'), - '$option'(show(Show), Options, '!history'), - print_message(help, history(help(Show, Raw))), - !, - fail. -read_history_(Raw, Term, Options) :- - expand_history(Raw, Expanded, Changed), - '$save_history_line'(Expanded), - '$option'(module(Module), Options, Var), - ( Module == Var - -> '$current_typein_module'(Module) - ; true - ), - ( '$select'(variable_names(Bindings), Options, Options1) - -> true - ; Options1 = Options, - i(Bindings) % ignore - ), - catch(read_term_from_atom(Expanded, Term0, - [ module(Module), - variable_names(Bindings0) - | Options1 - ]), - E, - ( print_message(error, E), - fail - )), - ( var(Term0) - -> Term = Term0, - Bindings = Bindings0 - ; Term0 = '$silent'(Goal) - -> user:ignore(Goal), - read_term_with_history(Term, Options) - ; save_event(Expanded, Options), - ( Changed == true - -> print_message(query, history(expanded(Expanded))) - ; true - ), - Term = Term0, - Bindings = Bindings0 - ). - -i(_). - -% list_history -% Write history events to the current output stream. - -list_history :- - ( '$history'(Last, _) - -> true - ; Last = 0 - ), - history_depth_(Depth), - plus(First, Depth, Last), - findall(Nr/Event, - ( between(First, Last, Nr), - '$history'(Nr, Event) - ), - Events), - print_message(query, history(history(Events))). - -'$clean_history' :- - retractall('$history'(_,_)). - -%! '$load_history' is det. -% -% Load persistent history using a hook - -'$load_history' :- - '$clean_history', - current_prolog_flag(history, Depth), - Depth > 0, - catch(prolog:history(current_input, load), _, true), !. -'$load_history'. - - -%% prompt_history(+Prompt) -% -% Give prompt, substituting '~!' by the event number. - -prompt_history('') :- - !, - ttyflush. -prompt_history(Prompt) :- - ( '$history'(Last, _) - -> This is Last + 1 - ; This = 1 - ), - atom_codes(Prompt, SP), - atom_codes(This, ST), - ( atom_codes('~!', Repl), - substitute(Repl, ST, SP, String) - -> prompt1(String) - ; prompt1(Prompt) - ), - ttyflush. - -% substitute(+Old, +New, +String, -Substituted) -% substitute first occurence of Old in String by New - -substitute(Old, New, String, Substituted) :- - '$append'(Head, OldAndTail, String), - '$append'(Old, Tail, OldAndTail), - !, - '$append'(Head, New, HeadAndNew), - '$append'(HeadAndNew, Tail, Substituted), - !. - -%! '$save_history_line'(+Line) -% -% Add Line to the command line editing history. - -:- multifile - prolog:history_line/2. - -'$save_history_line'(end_of_file) :- !. -'$save_history_line'(Line) :- - format(string(CompleteLine), '~W~W', - [ Line, [partial(true)], - '.', [partial(true)] - ]), - catch(prolog:history(user_input, add(CompleteLine)), _, fail), - !. -'$save_history_line'(_). - -%! save_event(+Event, +Options) -% -% Save Event into the history system unless it appears in the -% option `no_save`. - -save_event(Event, Options) :- - '$option'(no_save(Dont), Options), - memberchk(Event, Dont), - !. -save_event(Event, _) :- - '$save_history_event'(Event). - -%! '$save_history_event'(+Event) is det. -% -% Save an input line as text into the !- based history. Event is one -% of -% -% * a *string*. The event is added with a next number at the end. -% * a *pair*. The event is added with the given sequence number. - -:- thread_local - '$history'/2. - -'$save_history_event'(Num-String) :- - integer(Num), string(String), - !, - asserta('$history'(Num, String)), - truncate_history(Num). -'$save_history_event'(Event) :- - to_string(Event, Event1), - !, - last_event(Num, String), - ( Event1 == String - -> true - ; New is Num + 1, - asserta('$history'(New, Event1)), - truncate_history(New) - ). -'$save_history_event'(Event) :- - '$type_error'(history_event, Event). - -last_event(Num, String) :- - '$history'(Num, String), - !. -last_event(0, ""). - -to_string(String, String) :- - string(String), - !. -to_string(Atom, String) :- - atom_string(Atom, String). - -truncate_history(New) :- - history_depth_(Depth), - remove_history(New, Depth). - -remove_history(New, Depth) :- - New - Depth =< 0, - !. -remove_history(New, Depth) :- - Remove is New - Depth, - retract('$history'(Remove, _)), - !. -remove_history(_, _). - -% history_depth_(-Depth) -% Define the depth to which to keep the history. - -history_depth_(N) :- - current_prolog_flag(history, N), - integer(N), - N > 0, - !. -history_depth_(25). - -% expand_history(+Raw, -Expanded) -% Expand Raw using the available history list. Expandations performed -% are: -% -% !match % Last event starting -% !n % Event nr. -% !! % last event -% -% Note: the first character after a '!' should be a letter or number to -% avoid problems with the cut. - -expand_history(Raw, Expanded, Changed) :- - atom_chars(Raw, RawString), - expand_history2(RawString, ExpandedString, Changed), - atom_chars(Expanded, ExpandedString), - !. - -expand_history2([!], [!], false) :- !. -expand_history2([!, C|Rest], [!|Expanded], Changed) :- - not_event_char(C), - !, - expand_history2([C|Rest], Expanded, Changed). -expand_history2([!|Rest], Expanded, true) :- - !, - match_event(Rest, Event, NewRest), - '$append'(Event, RestExpanded, Expanded), - !, - expand_history2(NewRest, RestExpanded, _). -expand_history2(['\''|In], ['\''|Out], Changed) :- - !, - skip_quoted(In, '\'', Out, Tin, Tout), - expand_history2(Tin, Tout, Changed). -expand_history2(['"'|In], ['"'|Out], Changed) :- - !, - skip_quoted(In, '"', Out, Tin, Tout), - expand_history2(Tin, Tout, Changed). -expand_history2([H|T], [H|R], Changed) :- - !, - expand_history2(T, R, Changed). -expand_history2([], [], false). - -skip_quoted([Q|T],Q,[Q|R], T, R) :- !. -skip_quoted([\,Q|T0],Q,[\,Q|T], In, Out) :- - !, - skip_quoted(T0, Q, T, In, Out). -skip_quoted([Q,Q|T0],Q,[Q,Q|T], In, Out) :- - !, - skip_quoted(T0, Q, T, In, Out). -skip_quoted([C|T0],Q,[C|T], In, Out) :- - !, - skip_quoted(T0, Q, T, In, Out). -skip_quoted([], _, [], [], []). - -% get_last_event(-String) -% return last event typed as a string - -get_last_event(Event) :- - '$history'(_, Atom), - atom_chars(Atom, Event), - !. -get_last_event(_) :- - print_message(query, history(no_event)), - fail. - -% match_event(+Spec, -Event, -Rest) -% Use Spec as a specification of and event and return the event as Event -% and what is left of Spec as Rest. - -match_event(Spec, Event, Rest) :- - find_event(Spec, Event, Rest), - !. -match_event(_, _, _) :- - print_message(query, history(no_event)), - fail. - -not_event_char(C) :- code_type(C, csym), !, fail. -not_event_char(!) :- !, fail. -not_event_char(_). - -find_event([!|Left], Event, Left) :- - !, - get_last_event(Event). -find_event([N|Rest], Event, Left) :- - code_type(N, digit), - !, - take_number([N|Rest], String, Left), - number_codes(Number, String), - '$history'(Number, Atom), - atom_chars(Atom, Event). -find_event(Spec, Event, Left) :- - take_string(Spec, String, Left), - matching_event(String, Event). - -take_string([C|Rest], [C|String], Left) :- - code_type(C, csym), - !, - take_string(Rest, String, Left). -take_string([C|Rest], [], [C|Rest]) :- !. -take_string([], [], []). - -take_number([C|Rest], [C|String], Left) :- - code_type(C, digit), - !, - take_string(Rest, String, Left). -take_number([C|Rest], [], [C|Rest]) :- !. -take_number([], [], []). - -% matching_event(+String, -Event) -% -% Return first event with prefix String as a Prolog string. - -matching_event(String, Event) :- - '$history'(_, AtomEvent), - atom_chars(AtomEvent, Event), - '$append'(String, _, Event), - !. - diff --git a/.Attic/metta_lang/metta_types.pl b/.Attic/metta_lang/metta_types.pl index eed02ea09f3..a94a7f93da8 100755 --- a/.Attic/metta_lang/metta_types.pl +++ b/.Attic/metta_lang/metta_types.pl @@ -583,6 +583,19 @@ is_seo_f('Concept'). is_seo_f(N):- number(N),!. +is_absorbed_return_type(Params,Var):- var(Var),!, \+ sub_var(Var,Params). +is_absorbed_return_type(_,'Bool'). +is_absorbed_return_type(_,[Ar]):- !, Ar == (->). +is_absorbed_return_type(_,'EmptyType'). +is_absorbed_return_type(_,'ReturnType'). +is_absorbed_return_type(_,X):- is_self_return(X). + +is_self_return('ErrorType'). + +is_non_absorbed_return_type(Params,Var):- + \+ is_absorbed_return_type(Params,Var). + + %is_user_defined_goal(Self,[H|_]):- is_user_defined_head(Eq,Self,H). is_user_defined_head(Other,H):- is_user_defined_head(=,Other,H). diff --git a/.Attic/metta_lang/stdlib.metta b/.Attic/metta_lang/stdlib.metta deleted file mode 100755 index 27015103010..00000000000 --- a/.Attic/metta_lang/stdlib.metta +++ /dev/null @@ -1,694 +0,0 @@ -(@doc = - (@desc "A symbol used to define reduction rules for expressions.") - (@params ( - (@param "Pattern to be matched against expression to be reduced") - (@param "Result of reduction or transformation of the first pattern"))) - (@return "Not reduced itself unless custom equalities over equalities are added") ) -(: = (-> $t $t Atom)) - -(@doc cons-atom - (@desc "Constructs an expression using two arguments") - (@params ( - (@param "Head of an expression") - (@param "Tail of an expression"))) - (@return "New expression consists of two input arguments")) - -(@doc println! - (@desc "Prints a line of text to the console") - (@params ( - (@param "Expression/atom to be printed out"))) - (@return "Unit atom")) - -(@doc format-args - (@desc "Fills {} symbols in the input expression with atoms from the second expression. E.g. (format-args (Probability of {} is {}%) (head 50)) gives [(Probability of head is 50%)]. Atoms in the second input value could be variables") - (@params ( - (@param "Expression with {} symbols to be replaced") - (@param "Atoms to be placed inside expression instead of {}"))) - (@return "Expression with replaced {} with atoms")) - -(@doc trace! - (@desc "Prints its first argument and returns second. Both arguments will be evaluated before processing") - (@params ( - (@param "Atom to print") - (@param "Atom to return"))) - (@return "Evaluated second input")) - -(@doc nop - (@desc "Outputs unit atom for any input") - (@params ( - (@param "Anything"))) - (@return "Unit atom")) - -(@doc let - (@desc "Let function is utilized to establish temporary variable bindings within an expression. It allows introducing variables (first argument), assign values to them (second argument), and then use these values within the scope of the let block") - (@params ( - (@param "Variable name (or several variables inside brackets ())") - (@param "Expression to be bound to variable (it is being reduced before bind)") - (@param "Expression which will be reduced and in which variable (first argument) could be used"))) - (@return "Result of third argument's evaluation")) - -(@doc let* - (@desc "Same as let, but first argument is a tuple containing tuples of variables and their bindings, e.g. (($v (+ 1 2)) ($v2 (* 5 6)))") - (@params ( - (@param "Tuple of tuples with variables and their bindings") - (@param "Expression which will be reduced and in which variable (first argument) could be used"))) - (@return "Result of second argument's evaluation")) - - -; TODO: Type is used here, but there is no definition for the -> type -; constructor for instance, thus in practice it matches because -> has -; %Undefined% type. We need to assign proper type to -> and other type -; constructors but it is not possible until we support vararg types. -(@doc is-function-type - (@desc "Function checks if input type is a function type") - (@params ( - (@param "Type notation"))) - (@return "True if input type notation is a function type, False - otherwise")) -(: is-function-type (-> Type Bool)) -(= (is-function-type $type) - (let $type-meta (get-metatype $type) - (case $type-meta ( - (Expression - (let $first (car-atom $type) - (if (== $first ->) True False) )) - ($_ False) )))) -(@doc if - (@desc "Replace itself by one of the arguments depending on condition.") - (@params ( - (@param "Boolean condition") - (@param "Result when condition is True") - (@param "Result when condition is False"))) - (@return "Second or third argument") ) -(: if (-> Bool Atom Atom $t)) -(= (if True $then $else) $then) -(= (if False $then $else) $else) - -(@doc ErrorType (@desc "Type of the atom which contains error")) -(: ErrorType Type) - -(@doc Error - (@desc "Error constructor") - (@params ( - (@param "Atom which contains error") - (@param "Error message, can be one of the reserved symbols: BadType, IncorrectNumberOfArguments"))) - (@return "Error atom")) -(: Error (-> Atom Atom ErrorType)) - -(@doc add-reduct - (@desc "Adds atom into the atomspace reducing it first") - (@params ( - (@param "Atomspace to add atom into") - (@param "Atom to add"))) - (@return "Unit atom")) -(: add-reduct (-> hyperon::space::DynSpace %Undefined% (->))) -(= (add-reduct $dst $atom) (add-atom $dst $atom)) - - -(@doc car-atom - (@desc "Extracts the first atom of an expression as a tuple") - (@params ( - (@param "Expression"))) - (@return "First atom of an expression")) - -(@doc cdr-atom - (@desc "Extracts the tail of an expression (all except first atom)") - (@params ( - (@param "Expression"))) - (@return "Tail of an expression")) -(@doc quote - (@desc "Prevents atom from being reduced") - (@params ( - (@param "Atom"))) - (@return "Quoted atom")) -(: quote (-> Atom Atom)) - -(@doc unify - (@desc "Matches two first arguments and returns third argument if they are matched and forth argument otherwise") - (@params ( - (@param "First atom to unify with") - (@param "Second atom to unify with") - (@param "Result if two atoms unified successfully") - (@param "Result otherwise"))) - (@return "Third argument when first two atoms are matched of forth one otherwise")) -(: unify (-> Atom Atom Atom Atom %Undefined%)) -(= (unify $a $a $then $else) $then) -(= (unify $a $b $then $else) - (case (unify-or-empty $a $b) ((Empty $else))) ) -(: unify-or-empty (-> Atom Atom Atom)) -(= (unify-or-empty $a $a) unified) -(= (unify-or-empty $a $b) (empty)) - -(@doc empty - (@desc "Cuts evaluation of the non-deterministic branch and removes it from the result") - (@params ()) - (@return "Nothing")) -(: empty (-> %Undefined%)) -(= (empty) (let a b never-happens)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Documentation formatting functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(@doc @doc - (@desc "Used for documentation purposes. Function documentation starts with @doc") - (@params ( - (@param "Function name") - (@param "Function description. Starts with @desc") - (@param "(Optional) parameters description starting with @params which should contain one or more @param symbols") - (@param "(Optional) description of what function will return. Starts with @return"))) - (@return "Function documentation using @doc-formal")) -(: @doc (-> Atom DocDescription DocInformal)) -(: @doc (-> Atom DocDescription DocParameters DocReturnInformal DocInformal)) - -(@doc @desc - (@desc "Used for documentation purposes. Description of function starts with @desc as a part of @doc") - (@params ( - (@param "String containing function description"))) - (@return "Function description")) -(: @desc (-> String DocDescription)) - -(@doc @param - (@desc "Used for documentation purposes. Description of function parameter starts with @param as a part of @params which is a part of @doc") - (@params ( - (@param "String containing parameter description"))) - (@return "Parameter description")) -(: @param (-> String DocParameterInformal)) -(: @param (-> DocType DocDescription DocParameter)) - -(@doc @return - (@desc "Used for documentation purposes. Description of function return value starts with @return as a part of @doc") - (@params ( - (@param "String containing return value description"))) - (@return "Return value description")) -(: @return (-> String DocReturnInformal)) -(: @return (-> DocType DocDescription DocReturn)) - -(@doc @doc-formal - (@desc "Used for documentation purposes. get-doc returns documentation starting with @doc-formal symbol. @doc-formal contains 6 or 4 parameters depending on the entity being described (functions being described using 6 parameters, atoms - 4 parameters)") - (@params ( - (@param "Function/Atom name for which documentation is to be displayed. Format (@item name)") - (@param "Contains (@kind function) or (@kind atom) depends on entity which documentation is displayed") - (@param "Contains type notation of function/atom") - (@param "Function/atom description") - (@param "(Functions only). Description of function parameters") - (@param "(Functions only). Description of function's return value"))) - (@return "Expression containing full documentation on function")) -(: @doc-formal (-> DocItem DocKindFunction DocType DocDescription DocParameters DocReturn DocFormal)) -(: @doc-formal (-> DocItem DocKindAtom DocType DocDescription DocFormal)) - -(@doc @item - (@desc "Used for documentation purposes. Converts atom/function's name to DocItem") - (@params ( - (@param "Atom/Function name to be documented"))) - (@return "(@item Atom) entity")) -(: @item (-> Atom DocItem)) - -(@doc (@kind function) - (@desc "Used for documentation purposes. Shows type of entity to be documented. (@kind function) in this case")) -(: (@kind function) DocKindFunction) - -(@doc (@kind atom) - (@desc "Used for documentation purposes. Shows type of entity to be documented. (@kind atom) in this case")) -(: (@kind atom) DocKindAtom) - -(@doc @type - (@desc "Used for documentation purposes. Converts atom/function's type to DocType") - (@params ( - (@param "Atom/Function type to be documented"))) - (@return "(@type Type) entity")) -(: @type (-> Type DocType)) - -(@doc @params - (@desc "Used for function documentation purposes. Contains several @param entities with description of each @param") - (@params ( - (@param "Several (@param ...) entities"))) - (@return "DocParameters containing description of all parameters of function in form of (@params ((@param ...) (@param ...) ...))")) -(: @params (-> Expression DocParameters)) - -(@doc get-doc - (@desc "Returns documentation for the given Atom/Function") - (@params ( - (@param "Atom/Function name for which documentation is needed"))) - (@return "Documentation for the given atom/function")) -(: get-doc (-> Atom Atom)) -(= (get-doc $atom) - (let $meta-type (get-metatype $atom) - (case $meta-type ( - (Expression (get-doc-atom $atom)) - ($_ (get-doc-single-atom $atom)) )))) - -(@doc get-doc-single-atom - (@desc "Function used by get-doc to get documentation on either function or atom. It checks if input name is the name of function or atom and calls correspondent function") - (@params ( - (@param "Atom/Function name for which documentation is needed"))) - (@return "Documentation for the given atom/function")) -(: get-doc-single-atom (-> Atom Atom)) -(= (get-doc-single-atom $atom) - (let $top-space (mod-space! top) - (let $type (get-type-space $top-space $atom) - (if (is-function-type $type) - (get-doc-function $atom $type) - (get-doc-atom $atom))))) - -(@doc get-doc-function - (@desc "Function used by get-doc-single-atom to get documentation on a function. It returns documentation on a function if it exists or default documentation with no description otherwise") - (@params ( - (@param "Function name for which documentation is needed") - (@param "Type notation for this function"))) - (@return "Documentation for the given function")) -(: get-doc-function (-> Atom Type Atom)) -(= (get-doc-function $name $type) - (let $top-space (mod-space! top) - (unify $top-space (@doc $name $desc (@params $params) $ret) - (let $type' (if (== $type %Undefined%) (undefined-doc-function-type $params) (cdr-atom $type)) - (let ($params' $ret') (get-doc-params $params $ret $type') - (@doc-formal (@item $name) (@kind function) (@type $type) $desc (@params $params') $ret'))) - (@doc-formal (@item $name) (@kind function) (@type $type) (@desc "No documentation")) ))) - -(@doc undefined-doc-function-type - (@desc "Function used by get-doc-single-atom in case of absence of function's type notation") - (@params ( - (@param "List of parameters for the function we want to get documentation for"))) - (@return "List of %Undefined% number of which depends on input list size. So for two parameters function will return (%Undefined% %Undefined% %Undefined%)")) -(: undefined-doc-function-type (-> Expression Type)) -(= (undefined-doc-function-type $params) - (if (== () $params) (%Undefined%) - (let $params-tail (cdr-atom $params) - (let $tail (undefined-doc-function-type $params-tail) - (cons-atom %Undefined% $tail) )))) - -(@doc get-doc-params - (@desc "Function used by get-doc-function to get function's parameters documentation (including return value)") - (@params ( - (@param "List of parameters in form of ((@param Description) (@param Description)...)") - (@param "Return value's description in form of (@return Description)") - (@param "Type notation without -> starting symbol e.g. (Atom Atom Atom)"))) - (@return "United list of params and return value each augmented with its type. E.g. (((@param (@type Atom) (@desc Description)) (@param (@type Atom) (@desc Description2))) (@return (@type Atom) (@desc Description)))")) -(: get-doc-params (-> Expression Atom Expression (Expression Atom))) -(= (get-doc-params $params $ret $types) - (let $head-type (car-atom $types) - (let $tail-types (cdr-atom $types) - (if (== () $params) - (let (@return $ret-desc) $ret - (() (@return (@type $head-type) (@desc $ret-desc))) ) - (let (@param $param-desc) (car-atom $params) - (let $tail-params (cdr-atom $params) - (let ($params' $result-ret) (get-doc-params $tail-params $ret $tail-types) - (let $result-params (cons-atom (@param (@type $head-type) (@desc $param-desc)) $params') - ($result-params $result-ret) )))))))) - -(@doc get-doc-atom - (@desc "Function used by get-doc (in case of input type Expression) and get-doc-single-atom (in case input value is not a function) to get documentation on input value") - (@params ( - (@param "Atom's name to get documentation for"))) - (@return "Documentation on input Atom")) -(: get-doc-atom (-> Atom Atom)) -(= (get-doc-atom $atom) - (let $top-space (mod-space! top) - (let $type (get-type-space $top-space $atom) - (unify $top-space (@doc $atom $desc) - (@doc-formal (@item $atom) (@kind atom) (@type $type) $desc) - (unify $top-space (@doc $atom $desc' (@params $params) $ret) - (get-doc-function $atom %Undefined%) - (@doc-formal (@item $atom) (@kind atom) (@type $type) (@desc "No documentation")) ))))) - -(@doc help! - (@desc "Function prints documentation for the input atom.") - (@params ( - (@param "Input to get documentation for"))) - (@return "Unit atom")) -(: help! (-> Atom (->))) -(= (help! $atom) - (case (get-doc $atom) ( - ((@doc-formal (@item $item) (@kind function) (@type $type) (@desc $descr) - (@params $params) - (@return (@type $ret-type) (@desc $ret-desc))) - (let () (println! (format-args "Function {}: {} {}" ($item $type $descr))) - (let () (println! (format-args "Parameters:" ())) - (let () (for-each-in-atom $params help-param!) - (let () (println! (format-args "Return: (type {}) {}" ($ret-type $ret-desc))) - () ))))) - ((@doc-formal (@item $item) (@kind function) (@type $type) (@desc $descr)) - (let () (println! (format-args "Function {} (type {}) {}" ($item $type $descr))) - () )) - ((@doc-formal (@item $item) (@kind atom) (@type $type) (@desc $descr)) - (let () (println! (format-args "Atom {}: {} {}" ($item $type $descr))) - () )) - ($other (Error $other "Cannot match @doc-formal structure") )))) - -(@doc help-param! - (@desc "Function used by function help! to output parameters using println!") - (@params ( - (@param "Parameters list"))) - (@return "Unit atom")) -(: help-param! (-> Atom (->))) -(= (help-param! $param) - (let (@param (@type $type) (@desc $desc)) $param - (println! (format-args " {} {}" ((type $type) $desc))) )) - -(@doc for-each-in-atom - (@desc "Applies function passed as a second argument to each atom inside first argument") - (@params ( - (@param "Expression to each atom in which function will be applied") - (@param "Function to apply"))) - (@return "Unit atom")) -(: for-each-in-atom (-> Expression Atom (->))) -(= (for-each-in-atom $expr $func) - (if (noreduce-eq $expr ()) - () - (let $head (car-atom $expr) - (let $tail (cdr-atom $expr) - (let $_ ($func $head) - (for-each-in-atom $tail $func) ))))) - -(@doc noreduce-eq - (@desc "Checks equality of two atoms without reducing them") - (@params ( - (@param "First atom") - (@param "Second atom"))) - (@return "True if not reduced atoms are equal, False - otherwise")) -(: noreduce-eq (-> Atom Atom Bool)) -(= (noreduce-eq $a $b) (== (quote $a) (quote $b))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Grounded function's documentation -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(@doc add-atom - (@desc "Adds atom into the atomspace without reducing it") - (@params ( - (@param "Atomspace to add atom into") - (@param "Atom to add"))) - (@return "Unit atom")) - -(@doc match - (@desc "Searches for all declared atoms corresponding to the given pattern (second argument) and produces the output pattern (third argument)") - (@params ( - (@param "A grounded atom referencing a Space") - (@param "Pattern atom to be matched") - (@param "Output pattern typically containing variables from the input pattern"))) - (@return "If match was successfull it outputs pattern (third argument) with filled variables (if any were present in pattern) using matched pattern (second argument). Nothing - otherwise")) - -(@doc bind! - (@desc "Registers a new token which is replaced with an atom during the parsing of the rest of the program") - (@params ( - (@param "Token name") - (@param "Atom, which is associated with the token after reduction"))) - (@return "Unit atom")) - -(@doc new-space - (@desc "Creates new Atomspace which could be used further in the program as a separate from &self Atomspace") - (@params ()) - (@return "Reference to a new space")) - -(@doc remove-atom - (@desc "Removes atom from the input Atomspace") - (@params ( - (@param "Reference to the space from which the Atom needs to be removed") - (@param "Atom to be removed"))) - (@return "Unit atom")) - -(@doc get-atoms - (@desc "Shows all atoms in the input Atomspace") - (@params ( - (@param "Reference to the space"))) - (@return "List of all atoms in the input space")) - -(@doc new-state - (@desc "Creates a new state atom wrapping its argument") - (@params ( - (@param "Atom to be wrapped"))) - (@return "Returns (State $value) where $value is an argument to a new-state")) - -(@doc change-state! - (@desc "Changes input state's wrapped atom to another value (second argument). E.g. (change-state! (State 5) 6) -> (State 6)") - (@params ( - (@param "State created by new-state function") - (@param "Atom which will replace wrapped atom in the input state"))) - (@return "State with replaced wrapped atom")) - -(@doc get-state - (@desc "Gets a state as an argument and returns its wrapped atom. E.g. (get-state (State 5)) -> 5") - (@params ( - (@param "State"))) - (@return "Atom wrapped by state")) - -(@doc get-metatype - (@desc "Returns metatype of the input atom") - (@params ( - (@param "Atom to get metatype for"))) - (@return "Metatype of input atom")) - -(@doc register-module! - (@desc "Takes a file system path (first argument) and loads the module into the runner") - (@params ( - (@param "File system path"))) - (@return "Unit atom")) - -(@doc mod-space! - (@desc "Returns the space of the module (first argument) and tries to load the module if it is not loaded into the module system") - (@params ( - (@param "Module name"))) - (@return "Space name")) - -(@doc print-mods! - (@desc "Prints all modules with their correspondent spaces") - (@params ()) - (@return "Unit atom")) - -(@doc sealed - (@desc "Replaces all occurrences of any var from var list (first argument) inside atom (second argument) by unique variable. Can be used to create a locally scoped variables") - (@params ( - (@param "Variable list e.g. ($x $y)") - (@param "Atom which uses those variables"))) - (@return "Second argument but with variables being replaced with unique variables")) - -(@doc assertEqual - (@desc "Compares (sets of) results of evaluation of two expressions") - (@params ( - (@param "First expression") - (@param "Second expression"))) - (@return "Unit atom if both expression after evaluation is equal, error - otherwise")) - -(@doc assertEqualToResult - (@desc "Same as assertEqual but it doesn't evaluate second argument. Second argument is considered as a set of values of the first argument's evaluation") - (@params ( - (@param "First expression (it will be evaluated)") - (@param "Second expression (it won't be evaluated)"))) - (@return "Unit atom if both expression after evaluation is equal, error - otherwise")) - -(@doc collapse - (@desc "Converts a nondeterministic result into a tuple") - (@params ( - (@param "Atom which will be evaluated"))) - (@return "Tuple")) - -(@doc capture - (@desc "Wraps an atom and capture the current space") - (@params ( - (@param "Function name which space need to be captured"))) - (@return "Function")) - -(@doc case - (@desc "Subsequently tests multiple pattern-matching conditions (second argument) for the given value (first argument)") - (@params ( - (@param "Atom (it will be evaluated)") - (@param "Tuple of pairs mapping condition patterns to results"))) - (@return "Result of evaluating of Atom bound to met condition")) - - - -(@doc superpose - (@desc "Turns a tuple (first argument) into a nondeterministic result") - (@params ( - (@param "Tuple to be converted"))) - (@return "Argument converted to nondeterministic result")) - -(@doc get-type - (@desc "Returns type notation of input atom") - (@params ( - (@param "Atom to get type for"))) - (@return "Type notation or %Undefined% if there is no type for input Atom")) - -(@doc get-type-space - (@desc "Returns type notation of input Atom (second argument) relative to a specified atomspace (first argument)") - (@params ( - (@param "Atomspace where type notation for input atom will be searched") - (@param "Atom to get type for"))) - (@return "Type notation or %Undefined% if there is no type for input Atom in provided atomspace")) - -(@doc import! - (@desc "Imports module using its relative path (second argument) and binds it to the token (first argument) which will represent imported atomspace. If first argument is &self then everything will be imported to current atomspace") - (@params ( - (@param "Symbol, which is turned into the token for accessing the imported module") - (@param "Module name"))) - (@return "Unit atom")) - -(@doc include - (@desc "Works just like import! but with &self as a first argument. So everything from input file will be included in the current atomspace and evaluated") - (@params ( - (@param "Name of metta script to import"))) - (@return "Unit atom")) - - -(@doc pragma! - (@desc "Changes global key's (first argument) value to a new one (second argument)") - (@params ( - (@param "Key's name") - (@param "New value"))) - (@return "Unit atom")) - - -; TODO: Segmentation fault (core dumped) when calling !(help &self) -;(@doc &self -; (@desc "Returns reference to the current atomspace") -; (@params ()) -; (@return "Reference to the current atomspace")) - -; TODO: get-doc/help! not working for + -(@doc + - (@desc "Sums two numbers") - (@params ( - (@param "Addend") - (@param "Augend"))) - (@return "Sum")) - -; TODO: get-doc/help! not working for - -(@doc - - (@desc "Subtracts second argument from first one") - (@params ( - (@param "Minuend") - (@param "Deductible"))) - (@return "Difference")) - -; TODO: get-doc/help! not working for * -(@doc * - (@desc "Multiplies two numbers") - (@params ( - (@param "Multiplier") - (@param "Multiplicand"))) - (@return "Product")) - -; TODO: get-doc/help! not working for / -(@doc / - (@desc "Divides first argument by second one") - (@params ( - (@param "Dividend") - (@param "Divisor"))) - (@return "Fraction")) - -; TODO: get-doc/help! not working for % -(@doc % - (@desc "Modulo operator. It returns remainder of dividing first argument by second argument") - (@params ( - (@param "Dividend") - (@param "Divisor"))) - (@return "Remainder")) - -; TODO: get-doc/help! not working for < -(@doc < - (@desc "Less than. Checks if first argument is less than second one") - (@params ( - (@param "First number") - (@param "Second number"))) - (@return "True if first argument is less than second, False - otherwise")) - -; TODO: get-doc/help! not working for > -(@doc > - (@desc "Greater than. Checks if first argument is greater than second one") - (@params ( - (@param "First number") - (@param "Second number"))) - (@return "True if first argument is greater than second, False - otherwise")) - -; TODO: get-doc/help! not working for <= -(@doc <= - (@desc "Less than or equal. Checks if first argument is less than or equal to second one") - (@params ( - (@param "First number") - (@param "Second number"))) - (@return "True if first argument is less than or equal to second, False - otherwise")) - -; TODO: get-doc/help! not working for >= -(@doc >= - (@desc "Greater than or equal. Checks if first argument is greater than or equal to second one") - (@params ( - (@param "First number") - (@param "Second number"))) - (@return "True if first argument is greater than or equal to second, False - otherwise")) - -; TODO: get-doc/help! not working for == -(@doc == - (@desc "Checks equality for two arguments of the same type") - (@params ( - (@param "First argument") - (@param "Second argument"))) - (@return "Returns True if two arguments are equal, False - otherwise. If arguments are of different type function returns Error currently")) - -; TODO: get-doc/help! not working for and -(@doc and - (@desc "Logical conjunction of two arguments") - (@params ( - (@param "First argument") - (@param "Second argument"))) - (@return "Returns True if both arguments are True, False - otherwise")) - -; TODO: get-doc/help! not working for or -(@doc or - (@desc "Logical disjunction of two arguments") - (@params ( - (@param "First argument") - (@param "Second argument"))) - (@return "True if any of input arguments is True, False - otherwise")) - -; TODO: get-doc/help! not working for not -(@doc not - (@desc "Negation") - (@params ( - (@param "Argument"))) - (@return "Negates boolean input argument (False -> True, True -> False)")) - -(@doc xor - (@desc "Exclusive disjunction of two arguments") - (@params ( - (@param "First argument") - (@param "Second argument"))) - (@return "Return values are the same as logical disjunction, but when both arguments are True xor will return False")) - -(@doc flip - (@desc "Produces random boolean value") - (@params ()) - (@return "Random boolean value")) - -(@doc unique - (@desc "Function takes non-deterministic input (first argument) and returns only unique entities. E.g. (unique (superpose (a b c d d))) -> [a, b, c, d]") - (@params ( - (@param "Non-deterministic set of values"))) - (@return "Unique values from input set")) - -(@doc union - (@desc "Function takes two non-deterministic inputs (first and second argument) and returns their union. E.g. (union (superpose (a b b c)) (superpose (b c c d))) -> [a, b, b, c, b, c, c, d]") - (@params ( - (@param "Non-deterministic set of values") - (@param "Another non-deterministic set of values"))) - (@return "Union of sets")) - -(@doc intersection - (@desc "Function takes two non-deterministic inputs (first and second argument) and returns their intersection. E.g. (intersection (superpose (a b c c)) (superpose (b c c c d))) -> [b, c, c]") - (@params ( - (@param "Non-deterministic set of values") - (@param "Another non-deterministic set of values"))) - (@return "Intersection of sets")) - -(@doc subtraction - (@desc "Function takes two non-deterministic inputs (first and second argument) and returns their subtraction. E.g. !(subtraction (superpose (a b b c)) (superpose (b c c d))) -> [a, b]") - (@params ( - (@param "Non-deterministic set of values") - (@param "Another non-deterministic set of values"))) - (@return "Subtraction of sets")) - -(@doc git-module! - (@desc "Provides access to module in a remote git repo, from within MeTTa code. Similar to `register-module!`, this op will bypass the catalog search") - (@params ( - (@param "URL to github repo"))) - (@return "Unit atom")) \ No newline at end of file diff --git a/.Attic/metta_lang/stdlib_mettalog.metta b/.Attic/metta_lang/stdlib_mettalog.metta index 838135aad46..ebbb6459698 100755 --- a/.Attic/metta_lang/stdlib_mettalog.metta +++ b/.Attic/metta_lang/stdlib_mettalog.metta @@ -1,3 +1,50 @@ +(: Any Type) +(: Atom Type) +(: Bool Type) +(: Expression Type) +(: Number Type) +(: hyperon::space::DynSpace Type) +(: ReturnType Type) +(: Symbol Type) +(: StateMonad Type) +(: Type Type) +(: %Undefined% Type) +(: Variable Type) +(: if-decons (-> Atom Variable Variable Atom Atom Atom)) +(: if-empty (-> Atom Atom Atom Atom)) +(: if-non-empty-expression (-> Atom Atom Atom Atom)) +(: if-not-reducible (-> Atom Atom Atom Atom)) +;(: apply (-> Atom Variable Atom Atom)) +;(: cons (-> Atom Atom Atom)) +;(: decons (-> Atom Atom)) +(: xor (-> Bool Bool Bool)) +(: return (-> Atom ReturnType)) +(: switch (-> %Undefined% Expression Atom)) +(: unify (-> Atom Atom Atom Atom %Undefined%)) +(: get-type0 (-> Atom Atom)) +(: get-ftype (-> Atom Atom)) +(: : %Undefined%) +(: function-arity (-> Symbol Number)) +(: predicate-arity (-> Symbol Number)) +(: pragma! (-> Atom Atom (->))) +(: = (-> Atom Atom %Undefined%)) +(: match (-> hyperon::space::DynSpace Atom Atom %Undefined%)) +(: case (-> Expression Atom Atom)) +(: combine (-> $_4082 $_4082 $_4082)) +(: import! (-> hyperon::space::DynSpace Atom (->))) +(: get-type (-> Atom Type)) +(: PredicateArity (-> Symbol Number)) +(: If (-> Bool Atom Atom Atom)) +(: If (-> Bool Atom Atom)) +(= (If True $_3800) $_3800) +(= (If False $_3710) (let $_3728 0 (let $_3728 1 $_3728))) +(= (If $_3632 $_3638 $_3644) (if $_3632 $_3638 $_3644)) +(PredicateArity PredicateArity 2) +(PredicateArity : 2) +(= (: $_3524 P1) (PredicateArity $_3524 1)) +(: : SrcPredicate) +(: If SrcFunction) + ; Public MeTTa (@doc = (@desc "A symbol used to define reduction rules for expressions.") @@ -8,7 +55,7 @@ (: = (-> $t $t Atom)) ;; Implemented from Interpreters -(: ALT= (-> Atom Atom Atom)) +(: = (-> Atom Atom Atom)) ; Public MeTTa (@doc ErrorType (@desc "Type of the atom which contains error")) @@ -664,6 +711,11 @@ ;; Public MeTTa? (:> hyperon::space::DynSpace Grounded) +(: stringToChars (-> String Expression)) +(: charsToString (-> Expression String)) +(: parse (-> String Atom)) +(: repr (-> Atom String)) + ;; Public MeTTa (@doc add-reduct (@desc "Prevents atom from being reduced") @@ -1055,7 +1107,9 @@ (@params ( (@param "Reference to the space"))) (@return "List of all atoms in the input space")) -(get-atoms (-> hyperon::space::DynSpace Atom)) + +(: get-atoms (-> hyperon::space::DynSpace Atom)) + ;; Implemented from Interpreters ;; Public MeTTa diff --git a/.Attic/metta_lang/stdlib_minimal.metta b/.Attic/metta_lang/stdlib_minimal.metta deleted file mode 100755 index a732581cebc..00000000000 --- a/.Attic/metta_lang/stdlib_minimal.metta +++ /dev/null @@ -1,1001 +0,0 @@ -(@doc = - (@desc "A symbol used to define reduction rules for expressions.") - (@params ( - (@param "Pattern to be matched against expression to be reduced") - (@param "Result of reduction or transformation of the first pattern") )) - (@return "Not reduced itself unless custom equalities over equalities are added") ) -(: = (-> $t $t Atom)) - -(@doc ErrorType (@desc "Type of the atom which contains error")) -(: ErrorType Type) - -(@doc Error - (@desc "Error constructor") - (@params ( - (@param "Atom which contains error") - (@param "Error message, can be one of the reserved symbols: BadType, IncorrectNumberOfArguments"))) - (@return "Instance of the error atom")) -(: Error (-> Atom Atom ErrorType)) - -(@doc return - (@desc "Returns value from the (function ...) expression") - (@params ( - (@param "Value to be returned"))) - (@return "Passed argument")) -(: return (-> $t $t)) - -(@doc function - (@desc "Evaluates the argument until it becomes (return ). Then (function (return )) is reduced to the .") - (@params ( - (@param "Atom to be evaluated"))) - (@return "Result of atom's evaluation")) -(: function (-> Atom Atom)) - -(@doc eval - (@desc "Evaluates input atom, makes one step of the evaluation") - (@params ( - (@param "Atom to be evaluated, can be reduced via equality expression (= ...) or by calling a grounded function"))) - (@return "Result of evaluation")) -(: eval (-> Atom Atom)) - -(@doc chain - (@desc "Evaluates first argument, binds it to the variable (second argument) and then evaluates third argument which contains (or not) mentioned variable") - (@params ( - (@param "Atom to be evaluated") - (@param "Variable") - (@param "Atom which will be evaluated at the end"))) - (@return "Result of evaluating third input argument")) -(: chain (-> Atom Variable Atom Atom)) - -(@doc unify - (@desc "Matches two first arguments and returns third argument if they are matched and forth argument otherwise") - (@params ( - (@param "First atom to unify with") - (@param "Second atom to unify with") - (@param "Result if two atoms unified successfully") - (@param "Result otherwise"))) - (@return "Third argument when first two atoms are matched of forth one otherwise")) -(: unify (-> Atom Atom Atom Atom Atom)) - -(@doc cons-atom - (@desc "Constructs an expression using two arguments") - (@params ( - (@param "Head of an expression") - (@param "Tail of an expression"))) - (@return "New expression consists of two input arguments")) -(: cons-atom (-> Atom Expression Expression)) - -(@doc decons-atom - (@desc "Works as a reverse to cons-atom function. It gets Expression as an input and returns it splitted to head and tail, e.g. (decons-atom (Cons X Nil)) -> (Cons (X Nil))") - (@params ( - (@param "Expression"))) - (@return "Deconsed expression")) -(: decons-atom (-> Expression Expression)) - -(@doc collapse-bind - (@desc "Evaluates the Atom (first argument) and returns an expression which contains all alternative evaluations in a form (Atom Bindings). Bindings are represented in a form of a grounded atom.") - (@params ( - (@param "Atom to be evaluated"))) - (@return "All alternative evaluations")) -(: collapse-bind (-> Atom Expression)) - -(@doc superpose-bind - (@desc "Complement to the collapse-bind. It takes result of collapse-bind (first argument) and returns only result atoms without bindings") - (@params ( - (@param "Expression in form (Atom Binding)"))) - (@return "Non-deterministic list of Atoms")) -(: superpose-bind (-> Expression Atom)) - -(@doc metta - (@desc "Run MeTTa interpreter on atom.") - (@params ( - (@param "Atom to be interpreted") - (@param "Type of input atom") - (@param "Atomspace where intepretation should take place"))) - (@return "Result of interpretation")) -(: metta (-> Atom Type Grounded Atom)) - -(@doc id - (@desc "Returns its argument") - (@params ( - (@param "Input argument"))) - (@return "Input argument")) -(: id (-> Atom Atom)) -(= (id $x) $x) - -(@doc atom-subst - (@desc "Substitutes variable passed as a second argument in the third argument by the first argument") - (@params ( - (@param "Value to use for replacement") - (@param "Variable to replace") - (@param "Template to replace variable by the value"))) - (@return "Template with substituted variable")) -(: atom-subst (-> Atom Variable Atom Atom)) -(= (atom-subst $atom $var $templ) - (function (chain (eval (id $atom)) $var (return $templ))) ) - -(@doc if-decons-expr - (@desc "Checks if first argument is non empty expression. If so gets tail and head from the first argument and returns forth argument using head and tail values. Returns fifth argument otherwise.") - (@params ( - (@param "Expression to be deconstructed") - (@param "Head variable") - (@param "Tail variable") - (@param "Template to return if first argument is a non-empty expression") - (@param "Default value to return otherwise"))) - (@return "Either template with head and tail replaced by values or default value")) -(: if-decons-expr (-> Expression Variable Variable Atom Atom Atom)) -(= (if-decons-expr $atom $head $tail $then $else) - (function (eval (if-equal $atom () - (return $else) - (chain (decons-atom $atom) $list - (unify $list ($head $tail) (return $then) (return $else)) ))))) - -(@doc if-error - (@desc "Checks if first argument is an error atom. Returns second argument if so or third argument otherwise.") - (@params ( - (@param "Atom to be checked for the error") - (@param "Value to return if first argument is an error") - (@param "Value to return otherwise"))) - (@return "Second or third argument")) -(: if-error (-> Atom Atom Atom Atom)) -(= (if-error $atom $then $else) - (function (chain (eval (get-metatype $atom)) $meta - (eval (if-equal $meta Expression - (eval (if-equal $atom () - (return $else) - (chain (decons-atom $atom) $list - (unify $list ($head $tail) - (eval (if-equal $head Error (return $then) (return $else))) - (return $else) )))) - (return $else) ))))) - -(@doc return-on-error - (@desc "Returns first argument if it is Empty or an error. Returns second argument otherwise.") - (@params ( - (@param "Previous evaluation result") - (@param "Atom for further evaluation"))) - (@return "Return previous result if it is an error or Empty or continue evaluation")) -(: return-on-error (-> Atom Atom Atom)) -(= (return-on-error $atom $then) - (function (eval (if-equal $atom Empty (return (return Empty)) - (eval (if-error $atom (return (return $atom)) - (return $then) )))))) - -; Difference between `switch` and `case` is a way how they interpret `Empty` -; result. `CaseOp` interprets first argument inside itself and then manually -; checks whether result is empty. `switch` is interpreted in a context of -; main interpreter. Minimal interpreter correctly passes `Empty` as an -; argument to the `switch` but when `switch` is called from MeTTa interpreter -; (for example user evaluates `!(switch (unify A B ok Empty) ...)` then -; emptiness of the first argument is checked by interpreter and it will -; break execution when `Empty` is returned. -(@doc switch - (@desc "Subsequently tests multiple pattern-matching conditions (second argument) for the given value (first argument)") - (@params ( - (@param "Atom to be matched with patterns") - (@param "Tuple of pairs mapping condition patterns to results"))) - (@return "Result which corresponds to the pattern which is matched with the passed atom first")) - - -(: switch (-> %Undefined% Expression Atom)) -(= (switch $atom $cases) - (function (chain (decons-atom $cases) $list - (chain (eval (switch-internal $atom $list)) $res - (chain (eval (if-equal $res NotReducible Empty $res)) $x (return $x)) )))) - -(@doc switch-internal - (@desc "This function is being called inside switch function to test one of the cases and it calls switch once again if current condition is not met") - (@params ( - (@param "Atom (it will be evaluated)") - (@param "Deconsed tuple of pairs mapping condition patterns to results"))) - (@return "Result of evaluating of Atom bound to met condition")) -(= (switch-internal $atom (($pattern $template) $tail)) - (function (unify $atom $pattern - (return $template) - (chain (eval (switch $atom $tail)) $ret (return $ret)) ))) - - - - -; TODO: Type is used here, but there is no definition for the -> type -; constructor for instance, thus in practice it matches because -> has -; %Undefined% type. We need to assign proper type to -> and other type -; constructors but it is not possible until we support vararg types. -(@doc is-function - (@desc "Function checks if input type is a function type") - (@params ( - (@param "Type atom"))) - (@return "True if type is a function type, False - otherwise")) -(: is-function (-> Type Bool)) -(= (is-function $type) - (function (chain (eval (get-metatype $type)) $meta - (eval (switch ($type $meta) ( - (($type Expression) - (eval (if-decons-expr $type $head $_tail - (unify $head -> (return True) (return False)) - (return (Error (is-function $type) "is-function non-empty expression as an argument")) ))) - (($type $meta) (return False)) - )))))) - -(@doc type-cast - (@desc "Casts atom passed as a first argument to the type passed as a second argument using space as a context") - (@params ( - (@param "Atom to be casted") - (@param "Type to cast atom to") - (@param "Context atomspace"))) - (@return "Atom if casting is successful, (Error ... BadType) otherwise")) -(= (type-cast $atom $type $space) - (function (chain (eval (get-metatype $atom)) $meta - (eval (if-equal $type $meta - (return $atom) - (chain (eval (collapse-bind (eval (get-type $atom $space)))) $collapsed - (chain (eval (map-atom $collapsed $pair (eval (first-from-pair $pair)))) $actual-types - (chain (eval (foldl-atom $actual-types False $a $b (eval (match-type-or $a $b $type)))) $is-some-comp - (eval (if $is-some-comp - (return $atom) - (return (Error $atom BadType)) )))))))))) - -(@doc match-types - (@desc "Checks if two types can be unified and returns third argument if so, fourth - otherwise") - (@params ( - (@param "First type") - (@param "Second type") - (@param "Atom to be returned if types can be unified") - (@param "Atom to be returned if types cannot be unified"))) - (@return "Third or fourth argument")) -(= (match-types $type1 $type2 $then $else) - (function (eval (if-equal $type1 %Undefined% - (return $then) - (eval (if-equal $type2 %Undefined% - (return $then) - (eval (if-equal $type1 Atom - (return $then) - (eval (if-equal $type2 Atom - (return $then) - (unify $type1 $type2 (return $then) (return $else)) )))))))))) - -(@doc first-from-pair - (@desc "Gets a pair as a first argument and returns first atom from pair") - (@params ( - (@param "Pair"))) - (@return "First atom from a pair")) -(= (first-from-pair $pair) - (function - (unify $pair ($first $second) - (return $first) - (return (Error (first-from-pair $pair) "incorrect pair format"))))) - -(@doc match-type-or - (@desc "Checks if two types (second and third arguments) can be unified and returns result of OR operation between first argument and type checking result") - (@params ( - (@param "Boolean value") - (@param "First type") - (@param "Second type"))) - (@return "True or False")) -(= (match-type-or $folded $next $type) - (function - (chain (eval (match-types $next $type True False)) $matched - (chain (eval (or $folded $matched)) $or (return $or)) ))) - -(@doc filter-atom - (@desc "Function takes list of atoms (first argument), variable (second argument) and filter predicate (third argument) and returns list with items which passed filter. E.g. (filter-atom (1 2 3 4) $v (eval (> $v 2))) will give (3 4)") - (@params ( - (@param "List of atoms") - (@param "Variable") - (@param "Filter predicate"))) - (@return "Filtered list")) -(: filter-atom (-> Expression Variable Atom Expression)) -(= (filter-atom $list $var $filter) - (function (eval (if-decons-expr $list $head $tail - (chain (eval (filter-atom $tail $var $filter)) $tail-filtered - (chain (eval (atom-subst $head $var $filter)) $filter-expr - (chain $filter-expr $is-filtered - (eval (if $is-filtered - (chain (cons-atom $head $tail-filtered) $res (return $res)) - (return $tail-filtered) ))))) - (return ()) )))) - -(@doc map-atom - (@desc "Function takes list of atoms (first argument), variable to be used inside (second variable) and an expression which will be evaluated for each atom in list (third argument). Expression should contain variable. So e.g. (map-atom (1 2 3 4) $v (eval (+ $v 1))) will give (2 3 4 5)") - (@params ( - (@param "List of atoms") - (@param "Variable name") - (@param "Template using variable"))) - (@return "Result of evaluating template for each atom in a list")) -(: map-atom (-> Expression Variable Atom Expression)) -(= (map-atom $list $var $map) - (function (eval (if-decons-expr $list $head $tail - (chain (eval (map-atom $tail $var $map)) $tail-mapped - (chain (eval (atom-subst $head $var $map)) $map-expr - (chain $map-expr $head-mapped - (chain (cons-atom $head-mapped $tail-mapped) $res (return $res)) ))) - (return ()) )))) - -(@doc foldl-atom - (@desc "Function takes list of values (first argument), initial value (second argument) and operation (fifth argument) and applies it consequently to the list of values, using init value as a start. It also takes two variables (third and fourth argument) to use them inside") - (@params ( - (@param "List of values") - (@param "Init value") - (@param "Variable") - (@param "Variable") - (@param "Operation"))) - (@return "Result of applying operation to the list of values")) -(: foldl-atom (-> Expression Atom Variable Variable Atom Atom)) -(= (foldl-atom $list $init $a $b $op) - (function (eval (if-decons-expr $list $head $tail - (chain (eval (atom-subst $init $a $op)) $op-init - (chain (eval (atom-subst $head $b $op-init)) $op-head - (chain $op-head $head-folded - (chain (eval (foldl-atom $tail $head-folded $a $b $op)) $res (return $res)) ))) - (return $init) )))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Standard library written in MeTTa ; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(@doc if-equal - (@desc "Checks if first two arguments are equal and evaluates third argument if equal, fourth argument - otherwise") - (@params ( - (@param "First argument") - (@param "Second argument") - (@param "Atom to be evaluated if arguments are equal") - (@param "Atom to be evaluated if arguments are not equal"))) - (@return "Evaluated third or fourth argument")) - - -(@doc if - (@desc "Replace itself by one of the arguments depending on condition.") - (@params ( - (@param "Boolean condition") - (@param "Result when condition is True") - (@param "Result when condition is False"))) - (@return "Second or third argument") ) -(: if (-> Bool Atom Atom $t)) -(= (if True $then $else) $then) -(= (if False $then $else) $else) - -; TODO: help! not working for operations which are defined in both Python and -; Rust standard library: or, and, not -(@doc or - (@desc "Logical disjunction of two arguments") - (@params ( - (@param "First argument") - (@param "Second argument"))) - (@return "True if any of input arguments is True, False - otherwise")) -(: or (-> Bool Bool Bool)) -(= (or False False) False) -(= (or False True) True) -(= (or True False) True) -(= (or True True) True) - -(@doc and - (@desc "Logical conjunction of two arguments") - (@params ( - (@param "First argument") - (@param "Second argument"))) - (@return "Returns True if both arguments are True, False - otherwise")) -(: and (-> Bool Bool Bool)) -(= (and False False) False) -(= (and False True) False) -(= (and True False) False) -(= (and True True) True) - -(@doc not - (@desc "Logical negation") - (@params ( - (@param "Argument"))) - (@return "Negates boolean input argument (False -> True, True -> False)")) -(: not (-> Bool Bool)) -(= (not True) False) -(= (not False) True) - -(@doc let - (@desc "Unify two first argument and apply result of the unification on third argument. Second argument is evaluated before unification.") - (@params ( - (@param "First atom to be unified") - (@param "Second atom to be unified") - (@param "Expression which will be evaluated if two first arguments can be unified"))) - (@return "Third argument or Empty")) -(: let (-> Atom %Undefined% Atom %Undefined%)) -(= (let $pattern $atom $template) - (unify $atom $pattern $template Empty)) - -(@doc let* - (@desc "Same as let but inputs list of pairs of atoms to be unified. For example (let* (($v1 (+ 1 2)) ($v2 (* 5 6))) (+ $v1 $v2))") - (@params ( - (@param "List of pairs, atoms in each pair to be unified") - (@param "Expression which will be evaluated if each pair can be unified"))) - (@return "Second argument or Empty")) -(: let* (-> Expression Atom %Undefined%)) -(= (let* $pairs $template) - (eval (if-decons-expr $pairs ($pattern $atom) $tail - (let $pattern $atom (let* $tail $template)) - $template ))) - -(@doc add-reduct - (@desc "Reduces atom (second argument) and adds it into the atomspace (first argument)") - (@params ( - (@param "Atomspace to add atom into") - (@param "Atom to add"))) - (@return "Unit atom")) -(: add-reduct (-> Grounded %Undefined% (->))) -(= (add-reduct $dst $atom) (add-atom $dst $atom)) - -(@doc car-atom - (@desc "Extracts the first atom of an expression as a tuple") - (@params ( - (@param "Expression"))) - (@return "First atom of an expression")) -(: car-atom (-> Expression Atom)) -(= (car-atom $atom) - (eval (if-decons-expr $atom $head $_ - $head - (Error (car-atom $atom) "car-atom expects a non-empty expression as an argument") ))) - -(@doc cdr-atom - (@desc "Extracts the tail of an expression (all except first atom)") - (@params ( - (@param "Expression"))) - (@return "Tail of an expression")) -(: cdr-atom (-> Expression Expression)) -(= (cdr-atom $atom) - (eval (if-decons-expr $atom $_ $tail - $tail - (Error (cdr-atom $atom) "cdr-atom expects a non-empty expression as an argument") ))) - -(@doc quote - (@desc "Prevents atom from being reduced") - (@params ( - (@param "Atom"))) - (@return "Quoted atom")) -(: quote (-> Atom Atom)) -(= (quote $atom) NotReducible) - -(@doc unquote - (@desc "Unquotes quoted atom, e.g. (unquote (quote $x)) returns $x") - (@params ( - (@param "Quoted atom"))) - (@return "Unquoted atom")) -(: unquote (-> %Undefined% %Undefined%)) -(= (unquote (quote $atom)) $atom) - -; TODO: there is no way to define operation which consumes any number of -; arguments and returns unit -(@doc nop - (@desc "Outputs unit atom") - (@params ()) - (@return "Unit atom")) -(= (nop) ()) -(= (nop $x) ()) - -; TODO: MINIMAL added for compatibility, remove after migration -(@doc empty - (@desc "Cuts evaluation of the non-deterministic branch and removes it from the result") - (@params ()) - (@return "Nothing")) -(= (empty) Empty) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Documentation formatting functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(@doc @doc - (@desc "Used for documentation purposes. Function documentation starts with @doc") - (@params ( - (@param "Function name") - (@param "Function description. Starts with @desc") - (@param "(Optional) parameters description starting with @params which should contain one or more @param symbols") - (@param "(Optional) description of what function will return. Starts with @return"))) - (@return "Function documentation using @doc-formal")) -(: @doc (-> Atom DocDescription DocInformal)) -(: @doc (-> Atom DocDescription DocParameters DocReturnInformal DocInformal)) - -(@doc @desc - (@desc "Used for documentation purposes. Description of function starts with @desc as a part of @doc") - (@params ( - (@param "String containing function description"))) - (@return "Function description")) -(: @desc (-> String DocDescription)) - -(@doc @param - (@desc "Used for documentation purposes. Description of function parameter starts with @param as a part of @params which is a part of @doc") - (@params ( - (@param "String containing parameter description"))) - (@return "Parameter description")) -(: @param (-> String DocParameterInformal)) -(: @param (-> DocType DocDescription DocParameter)) - -(@doc @return - (@desc "Used for documentation purposes. Description of function return value starts with @return as a part of @doc") - (@params ( - (@param "String containing return value description"))) - (@return "Return value description")) -(: @return (-> String DocReturnInformal)) -(: @return (-> DocType DocDescription DocReturn)) - -(@doc @doc-formal - (@desc "Used for documentation purposes. get-doc returns documentation starting with @doc-formal symbol. @doc-formal contains 6 or 4 parameters depending on the entity being described (functions being described using 6 parameters, atoms - 4 parameters)") - (@params ( - (@param "Function/Atom name for which documentation is to be displayed. Format (@item name)") - (@param "Contains (@kind function) or (@kind atom) depends on entity which documentation is displayed") - (@param "Contains type notation of function/atom") - (@param "Function/atom description") - (@param "(Functions only). Description of function parameters") - (@param "(Functions only). Description of function's return value"))) - (@return "Expression containing full documentation on function")) -(: @doc-formal (-> DocItem DocKindFunction DocType DocDescription DocParameters DocReturn DocFormal)) -(: @doc-formal (-> DocItem DocKindAtom DocType DocDescription DocFormal)) - -(@doc @item - (@desc "Used for documentation purposes. Converts atom/function's name to DocItem") - (@params ( - (@param "Atom/Function name to be documented"))) - (@return "(@item Atom) entity")) -(: @item (-> Atom DocItem)) - -; TODO: help! gives two outputs -;Atom (@kind function): (%Undefined% (-> Atom Atom)) Used for documentation purposes. Shows type of entity to be documented. (@kind function) in this case -;Atom (@kind function): DocKindFunction Used for documentation purposes. Shows type of entity to be documented. (@kind function) in this case -(@doc (@kind function) - (@desc "Used for documentation purposes. Shows type of entity to be documented. (@kind function) in this case")) -(: (@kind function) DocKindFunction) - -(@doc (@kind atom) - (@desc "Used for documentation purposes. Shows type of entity to be documented. (@kind atom) in this case")) -(: (@kind atom) DocKindAtom) - -(@doc @type - (@desc "Used for documentation purposes. Converts atom/function's type to DocType") - (@params ( - (@param "Atom/Function type to be documented"))) - (@return "(@type Type) entity")) -(: @type (-> Type DocType)) - -(@doc @params - (@desc "Used for function documentation purposes. Contains several @param entities with description of each @param") - (@params ( - (@param "Several (@param ...) entities"))) - (@return "DocParameters containing description of all parameters of function in form of (@params ((@param ...) (@param ...) ...))")) -(: @params (-> Expression DocParameters)) - -(@doc get-doc - (@desc "Returns documentation for the given Atom/Function") - (@params ( - (@param "Atom/Function name for which documentation is needed"))) - (@return "Documentation for the given atom/function")) -(: get-doc (-> Atom Atom)) -(= (get-doc $atom) - (let $meta-type (get-metatype $atom) - (case $meta-type ( - (Expression (get-doc-atom $atom)) - ($_ (get-doc-single-atom $atom)) )))) - -(@doc get-doc-single-atom - (@desc "Function used by get-doc to get documentation on either function or atom. It checks if input name is the name of function or atom and calls correspondent function") - (@params ( - (@param "Atom/Function name for which documentation is needed"))) - (@return "Documentation for the given atom/function")) -(: get-doc-single-atom (-> Atom Atom)) -(= (get-doc-single-atom $atom) - (let $top-space (mod-space! top) - (let $type (get-type-space $top-space $atom) - (if (is-function $type) - (get-doc-function $atom $type) - (get-doc-atom $atom) )))) - -(@doc get-doc-function - (@desc "Function used by get-doc-single-atom to get documentation on a function. It returns documentation on a function if it exists or default documentation with no description otherwise") - (@params ( - (@param "Function name for which documentation is needed") - (@param "Type notation for this function"))) - (@return "Documentation for the given function")) -(: get-doc-function (-> Atom Type Atom)) -(= (get-doc-function $name $type) - (let $top-space (mod-space! top) - (unify $top-space (@doc $name $desc (@params $params) $ret) - (let $type' (if (== $type %Undefined%) (undefined-doc-function-type $params) (cdr-atom $type)) - (let ($params' $ret') (get-doc-params $params $ret $type') - (@doc-formal (@item $name) (@kind function) (@type $type) $desc (@params $params') $ret'))) - (@doc-formal (@item $name) (@kind function) (@type $type) (@desc "No documentation")) ))) - -(@doc undefined-doc-function-type - (@desc "Function used by get-doc-single-atom in case of absence of function's type notation") - (@params ( - (@param "List of parameters for the function we want to get documentation for"))) - (@return "List of %Undefined% number of which depends on input list size. So for two parameters function will return (%Undefined% %Undefined% %Undefined%)")) -(: undefined-doc-function-type (-> Expression Type)) -(= (undefined-doc-function-type $params) - (if (== () $params) (%Undefined%) - (let $params-tail (cdr-atom $params) - (let $tail (undefined-doc-function-type $params-tail) - (cons-atom %Undefined% $tail) )))) - -(@doc get-doc-params - (@desc "Function used by get-doc-function to get function's parameters documentation (including return value)") - (@params ( - (@param "List of parameters in form of ((@param Description) (@param Description)...)") - (@param "Return value's description in form of (@return Description)") - (@param "Type notation without -> starting symbol e.g. (Atom Atom Atom)"))) - (@return "United list of params and return value each augmented with its type. E.g. (((@param (@type Atom) (@desc Description)) (@param (@type Atom) (@desc Description2))) (@return (@type Atom) (@desc Description)))")) -(: get-doc-params (-> Expression Atom Expression (Expression Atom))) -(= (get-doc-params $params $ret $types) - (let $head-type (car-atom $types) - (let $tail-types (cdr-atom $types) - (if (== () $params) - (let (@return $ret-desc) $ret - (() (@return (@type $head-type) (@desc $ret-desc))) ) - (let (@param $param-desc) (car-atom $params) - (let $tail-params (cdr-atom $params) - (let ($params' $result-ret) (get-doc-params $tail-params $ret $tail-types) - (let $result-params (cons-atom (@param (@type $head-type) (@desc $param-desc)) $params') - ($result-params $result-ret) )))))))) - -(@doc get-doc-atom - (@desc "Function used by get-doc (in case of input type Expression) and get-doc-single-atom (in case input value is not a function) to get documentation on input value") - (@params ( - (@param "Atom's name to get documentation for"))) - (@return "Documentation on input Atom")) -(: get-doc-atom (-> Atom Atom)) -(= (get-doc-atom $atom) - (let $top-space (mod-space! top) - (let $type (get-type-space $top-space $atom) - (unify $top-space (@doc $atom $desc) - (@doc-formal (@item $atom) (@kind atom) (@type $type) $desc) - (unify $top-space (@doc $atom $desc' (@params $params) $ret) - (get-doc-function $atom %Undefined%) - (@doc-formal (@item $atom) (@kind atom) (@type $type) (@desc "No documentation")) ))))) - -(@doc help! - (@desc "Function prints documentation for the input atom.") - (@params ( - (@param "Input to get documentation for"))) - (@return "Unit atom")) -(: help! (-> Atom (->))) -(= (help! $atom) - (case (get-doc $atom) ( - ((@doc-formal (@item $item) (@kind function) (@type $type) (@desc $descr) - (@params $params) - (@return (@type $ret-type) (@desc $ret-desc))) - (let () (println! (format-args "Function {}: {} {}" ($item $type $descr))) - (let () (println! (format-args "Parameters:" ())) - (let () (for-each-in-atom $params help-param!) - (let () (println! (format-args "Return: (type {}) {}" ($ret-type $ret-desc))) - () ))))) - ((@doc-formal (@item $item) (@kind function) (@type $type) (@desc $descr)) - (let () (println! (format-args "Function {} (type {}) {}" ($item $type $descr))) - () )) - ((@doc-formal (@item $item) (@kind atom) (@type $type) (@desc $descr)) - (let () (println! (format-args "Atom {}: {} {}" ($item $type $descr))) - () )) - ($other (Error $other "Cannot match @doc-formal structure") )))) - -(@doc help-param! - (@desc "Function used by function help! to output parameters using println!") - (@params ( - (@param "Parameters list"))) - (@return "Unit atom")) -(: help-param! (-> Atom (->))) -(= (help-param! $param) - (let (@param (@type $type) (@desc $desc)) $param - (println! (format-args " {} {}" ((type $type) $desc))) )) - -(@doc for-each-in-atom - (@desc "Applies function passed as a second argument to each atom inside first argument") - (@params ( - (@param "Expression to each atom in which function will be applied") - (@param "Function to apply"))) - (@return "Unit atom")) -(: for-each-in-atom (-> Expression Atom (->))) -(= (for-each-in-atom $expr $func) - (if (noreduce-eq $expr ()) - () - (let $head (car-atom $expr) - (let $tail (cdr-atom $expr) - (let $_ ($func $head) - (for-each-in-atom $tail $func) ))))) - -(@doc noreduce-eq - (@desc "Checks equality of two atoms without reducing them") - (@params ( - (@param "First atom") - (@param "Second atom"))) - (@return "True if not reduced atoms are equal, False - otherwise")) -(: noreduce-eq (-> Atom Atom Bool)) -(= (noreduce-eq $a $b) (== (quote $a) (quote $b))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Grounded function's documentation -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(@doc add-atom - (@desc "Adds atom into the atomspace without reducing it") - (@params ( - (@param "Atomspace to add atom into") - (@param "Atom to add"))) - (@return "Unit atom")) - -(@doc new-space - (@desc "Creates new Atomspace which could be used further in the program as a separate from &self Atomspace") - (@params ()) - (@return "Reference to a new space")) - -(@doc remove-atom - (@desc "Removes atom from the input Atomspace") - (@params ( - (@param "Reference to the space from which the Atom needs to be removed") - (@param "Atom to be removed"))) - (@return "Unit atom")) - -(@doc get-atoms - (@desc "Shows all atoms in the input Atomspace") - (@params ( - (@param "Reference to the space"))) - (@return "List of all atoms in the input space")) - -(@doc new-state - (@desc "Creates a new state atom wrapping its argument") - (@params ( - (@param "Atom to be wrapped"))) - (@return "Returns (State $value) where $value is an argument to a new-state")) - -(@doc change-state! - (@desc "Changes input state's wrapped atom to another value (second argument). E.g. (change-state! (State 5) 6) -> (State 6)") - (@params ( - (@param "State created by new-state function") - (@param "Atom which will replace wrapped atom in the input state"))) - (@return "State with replaced wrapped atom")) - -(@doc get-state - (@desc "Gets a state as an argument and returns its wrapped atom. E.g. (get-state (State 5)) -> 5") - (@params ( - (@param "State"))) - (@return "Atom wrapped by state")) - -(@doc get-type - (@desc "Returns type notation of input atom") - (@params ( - (@param "Atom to get type for"))) - (@return "Type notation or %Undefined% if there is no type for input Atom")) - -(@doc get-type-space - (@desc "Returns type notation of input Atom (second argument) relative to a specified atomspace (first argument)") - (@params ( - (@param "Atomspace where type notation for input atom will be searched") - (@param "Atom to get type for"))) - (@return "Type notation or %Undefined% if there is no type for input Atom in provided atomspace")) - -(@doc get-metatype - (@desc "Returns metatype of the input atom") - (@params ( - (@param "Atom to get metatype for"))) - (@return "Metatype of input atom")) - -(@doc match - (@desc "Searches for all declared atoms corresponding to the given pattern (second argument) inside space (first argument) and returns the output template (third argument)") - (@params ( - (@param "Atomspace to search pattern") - (@param "Pattern atom to be searched") - (@param "Output template typically containing variables from the input pattern"))) - (@return "If match was successfull it outputs template (third argument) with filled variables (if any were present in pattern) using matched pattern (second argument). Empty - otherwise")) - -(@doc register-module! - (@desc "Takes a file system path (first argument) and loads the module into the runner") - (@params ( - (@param "File system path"))) - (@return "Unit atom")) - -(@doc mod-space! - (@desc "Returns the space of the module (first argument) and tries to load the module if it is not loaded into the module system") - (@params ( - (@param "Module name"))) - (@return "Space name")) - -(@doc print-mods! - (@desc "Prints all modules with their correspondent spaces") - (@params ()) - (@return "Unit atom")) - -(@doc assertEqual - (@desc "Compares (sets of) results of evaluation of two expressions") - (@params ( - (@param "First expression") - (@param "Second expression"))) - (@return "Unit atom if both expression after evaluation is equal, error - otherwise")) - -(@doc assertEqualToResult - (@desc "Same as assertEqual but it doesn't evaluate second argument. Second argument is considered as a set of values of the first argument's evaluation") - (@params ( - (@param "First expression (it will be evaluated)") - (@param "Second expression (it won't be evaluated)"))) - (@return "Unit atom if both expression after evaluation is equal, error - otherwise")) - -(@doc collapse - (@desc "Converts a nondeterministic result into a tuple") - (@params ( - (@param "Atom which will be evaluated"))) - (@return "Tuple")) - -(@doc capture - (@desc "Wraps an atom and capture the current space") - (@params ( - (@param "Function name which space need to be captured"))) - (@return "Function")) - -(@doc case - (@desc "Subsequently tests multiple pattern-matching conditions (second argument) for the given value (first argument)") - (@params ( - (@param "Atom (it will be evaluated)") - (@param "Tuple of pairs mapping condition patterns to results"))) - (@return "Result of evaluating of Atom bound to met condition")) - - -(@doc superpose - (@desc "Turns a tuple (first argument) into a nondeterministic result") - (@params ( - (@param "Tuple to be converted"))) - (@return "Argument converted to nondeterministic result")) - - -(@doc pragma! - (@desc "Changes global key's (first argument) value to a new one (second argument)") - (@params ( - (@param "Key's name") - (@param "New value"))) - (@return "Unit atom")) - -(@doc import! - (@desc "Imports module using its relative path (second argument) and binds it to the token (first argument) which will represent imported atomspace. If first argument is &self then everything will be imported to current atomspace") - (@params ( - (@param "Symbol, which is turned into the token for accessing the imported module") - (@param "Module name"))) - (@return "Unit atom")) - -(@doc include - (@desc "Works just like import! but with &self as a first argument. So everything from input file will be included in the current atomspace and evaluated") - (@params ( - (@param "Name of metta script to import"))) - (@return "Unit atom")) - -(@doc bind! - (@desc "Registers a new token which is replaced with an atom during the parsing of the rest of the program") - (@params ( - (@param "Token name") - (@param "Atom, which is associated with the token after reduction"))) - (@return "Unit atom")) - -(@doc trace! - (@desc "Prints its first argument and returns second. Both arguments will be evaluated before processing") - (@params ( - (@param "Atom to print") - (@param "Atom to return"))) - (@return "Evaluated second input")) - -(@doc println! - (@desc "Prints a line of text to the console") - (@params ( - (@param "Expression/atom to be printed out"))) - (@return "Unit atom")) - -(@doc format-args - (@desc "Fills {} symbols in the input expression with atoms from the second expression. E.g. (format-args (Probability of {} is {}%) (head 50)) gives [(Probability of head is 50%)]. Atoms in the second input value could be variables") - (@params ( - (@param "Expression with {} symbols to be replaced") - (@param "Atoms to be placed inside expression instead of {}"))) - (@return "Expression with replaced {} with atoms")) - -(@doc sealed - (@desc "Replaces all occurrences of any var from var list (first argument) inside atom (second argument) by unique variable. Can be used to create a locally scoped variables") - (@params ( - (@param "Variable list e.g. ($x $y)") - (@param "Atom which uses those variables"))) - (@return "Second argument but with variables being replaced with unique variables")) - -; TODO: help! not working for &self (segmentation fault) -;(@doc &self -; (@desc "Returns reference to the current atomspace") -; (@params ()) -; (@return "Reference to the current atomspace")) - -; TODO: help! not working for operations which are defined in both Python and -; Rust standard library: +, -, *, /, %, <, >, <=, >=, == -(@doc + - (@desc "Sums two numbers") - (@params ( - (@param "Addend") - (@param "Augend"))) - (@return "Sum")) - -(@doc - - (@desc "Subtracts second argument from first one") - (@params ( - (@param "Minuend") - (@param "Deductible"))) - (@return "Difference")) - -(@doc * - (@desc "Multiplies two numbers") - (@params ( - (@param "Multiplier") - (@param "Multiplicand"))) - (@return "Product")) - -(@doc / - (@desc "Divides first argument by second one") - (@params ( - (@param "Dividend") - (@param "Divisor"))) - (@return "Fraction")) - -(@doc % - (@desc "Modulo operator. It returns remainder of dividing first argument by second argument") - (@params ( - (@param "Dividend") - (@param "Divisor"))) - (@return "Remainder")) - -(@doc < - (@desc "Less than. Checks if first argument is less than second one") - (@params ( - (@param "First number") - (@param "Second number"))) - (@return "True if first argument is less than second, False - otherwise")) - -(@doc > - (@desc "Greater than. Checks if first argument is greater than second one") - (@params ( - (@param "First number") - (@param "Second number"))) - (@return "True if first argument is greater than second, False - otherwise")) - -(@doc <= - (@desc "Less than or equal. Checks if first argument is less than or equal to second one") - (@params ( - (@param "First number") - (@param "Second number"))) - (@return "True if first argument is less than or equal to second, False - otherwise")) - -(@doc >= - (@desc "Greater than or equal. Checks if first argument is greater than or equal to second one") - (@params ( - (@param "First number") - (@param "Second number"))) - (@return "True if first argument is greater than or equal to second, False - otherwise")) - -(@doc == - (@desc "Checks equality for two arguments of the same type") - (@params ( - (@param "First argument") - (@param "Second argument"))) - (@return "Returns True if two arguments are equal, False - otherwise. If arguments are of different type function returns Error currently")) - -(@doc unique - (@desc "Function takes non-deterministic input (first argument) and returns only unique entities. E.g. (unique (superpose (a b c d d))) -> [a, b, c, d]") - (@params ( - (@param "Non-deterministic set of values"))) - (@return "Unique values from input set")) - -(@doc union - (@desc "Function takes two non-deterministic inputs (first and second argument) and returns their union. E.g. (union (superpose (a b b c)) (superpose (b c c d))) -> [a, b, b, c, b, c, c, d]") - (@params ( - (@param "Non-deterministic set of values") - (@param "Another non-deterministic set of values"))) - (@return "Union of sets")) - -(@doc intersection - (@desc "Function takes two non-deterministic inputs (first and second argument) and returns their intersection. E.g. (intersection (superpose (a b c c)) (superpose (b c c c d))) -> [b, c, c]") - (@params ( - (@param "Non-deterministic set of values") - (@param "Another non-deterministic set of values"))) - (@return "Intersection of sets")) - -(@doc subtraction - (@desc "Function takes two non-deterministic inputs (first and second argument) and returns their subtraction. E.g. !(subtraction (superpose (a b b c)) (superpose (b c c d))) -> [a, b]") - (@params ( - (@param "Non-deterministic set of values") - (@param "Another non-deterministic set of values"))) - (@return "Subtraction of sets")) - -(@doc git-module! - (@desc "Provides access to module in a remote git repo, from within MeTTa code. Similar to `register-module!`, this op will bypass the catalog search") - (@params ( - (@param "URL to github repo"))) - (@return "Unit atom")) diff --git a/.Attic/metta_lang/swi_flybase.pl b/.Attic/metta_lang/swi_flybase.pl deleted file mode 100755 index 12a4e619ce4..00000000000 --- a/.Attic/metta_lang/swi_flybase.pl +++ /dev/null @@ -1,2 +0,0 @@ - -:- ensure_loaded(flybase_main). \ No newline at end of file diff --git a/.Attic/rust-wam/metta_prelude.pl b/.Attic/rust-wam/metta_prelude.pl deleted file mode 100755 index f78038781bf..00000000000 --- a/.Attic/rust-wam/metta_prelude.pl +++ /dev/null @@ -1,242 +0,0 @@ -%;`$then`, `$else` should be of `Atom` type to avoid evaluation -%; and infinite cycle in inference -metta_type('&self',if,[ ->, 'Bool','Atom','Atom',_]). -metta_defn('&self',[if,'True',A,_],A). -metta_defn('&self',[if,'False',_,A],A). -metta_type('&self','Error',[->,'Atom','Atom','ErrorType']). -metta_defn('&self',['if-non-empty-expression',A,B,C],[ chain, - [ eval, - ['get-metatype',A]], - D, - [ eval, - [ 'if-equal', D,'Expression', - [ eval, - [ 'if-equal', A, [], C, B]], - C]]]). -metta_defn('&self',[ 'if-decons', A,B,C,D, - E],[ eval, - [ 'if-non-empty-expression', - A, - [ chain, - [decons,A], - F, - [ match, - F, - [B,C], D,E]], - E]]). -metta_defn('&self',['if-empty',A,B,C],[ eval, - [ 'if-equal', A,'Empty',B,C]]). -metta_defn('&self',['if-error',A,B,C],[ eval, - [ 'if-decons', A,D,_, - [ eval, - [ 'if-equal', D,'Error',B,C]], - C]]). -metta_defn('&self',['return-on-error',A,B],[ eval, - [ 'if-empty', A,'Empty', - [ eval, - ['if-error',A,A,B]]]]). -metta_defn('&self',[car,A],[ eval, - [ 'if-decons', A,B,_,B, - [ 'Error', - [car,A], - '$STRING'("car expects a non-empty expression as an argument")]]]). -metta_defn('&self',[switch,A,B],[ chain, - [decons,B], - C, - [ eval, - ['switch-internal',A,C]]]). -metta_defn('&self',[ 'switch-internal', - A, - [ [B,C], - D]],[ match, A,B,C, - [ eval, - [switch,A,D]]]). -metta_defn('&self',[subst,A,B,C],[ match, A,B,C, - [ 'Error', - [subst,A,B,C], - '$STRING'("subst expects a variable as a second argument")]]). -metta_defn('&self',[reduce,A,B,C],[ chain, - [eval,A], - D, - [ eval, - [ 'if-error', D,D, - [ eval, - [ 'if-empty', - D, - [ eval, - [subst,A,B,C]], - [ eval, - [reduce,D,B,C]]]]]]]). -metta_defn('&self',['type-cast',A,B,C],[ chain, - [ eval, - ['get-type',A,C]], - D, - [ eval, - [ switch, - [D,B], - [ [ ['%Undefined%',E], - A], - [ [E,'%Undefined%'], - A], - [ [B,E], - A], - [ E, - ['Error',A,'BadType']]]]]]). -metta_defn('&self',['is-function',A],[ chain, - [ eval, - ['get-metatype',A]], - B, - [ eval, - [ switch, - [A,B], - [ [ [C,'Expression'], - [ chain, - [ eval, - [car,A]], - D, - [ match, D,->,'True','False']]], - [C,'False']]]]]). -metta_defn('&self',[interpret,A,B,C],[ chain, - [ eval, - ['get-metatype',A]], - D, - [ eval, - [ switch, - [B,D], - [ [ ['Atom',_], - A], - [ [D,D], - A], - [ [E,'Variable'], - A], - [ [E,'Symbol'], - [ eval, - ['type-cast',A,B,C]]], - [ [E,'Grounded'], - [ eval, - ['type-cast',A,B,C]]], - [ [E,'Expression'], - [ eval, - ['interpret-expression',A,B,C]]]]]]]). -metta_defn('&self',['interpret-expression',A,B,C],[ eval, - [ 'if-decons', A,D,_, - [ chain, - [ eval, - ['get-type',D,C]], - E, - [ chain, - [ eval, - ['is-function',E]], - F, - [ match, F,'True', - [ chain, - [ eval, - ['interpret-func',A,E,C]], - G, - [ eval, - [call,G,B,C]]], - [ chain, - [ eval, - ['interpret-tuple',A,C]], - G, - [ eval, - [call,G,B,C]]]]]], - [ eval, - ['type-cast',A,B,C]]]]). -metta_defn('&self',['interpret-func',A,B,C],[ eval, - [ 'if-decons', A,D,E, - [ chain, - [ eval, - [interpret,D,B,C]], - F, - [ eval, - [ 'return-on-error', - F, - [ eval, - [ 'if-decons', B,_,G, - [ chain, - [ eval, - [ 'interpret-args', A,E,G, - C]], - H, - [ eval, - [ 'return-on-error', - H, - [cons,F,H]]]], - [ 'Error', B,'$STRING'("Function type expected")]]]]]], - [ 'Error', - A, - '$STRING'("Non-empty expression atom is expected")]]]). -metta_defn('&self',[ 'interpret-args', A,B,C,D],[ match, - B, - [], - [ match, - C, - [_], - [], - ['Error',A,'BadType']], - [ eval, - [ 'if-decons', B,E,F, - [ eval, - [ 'if-decons', C,G,H, - [ chain, - [ eval, - [interpret,E,G,D]], - I, - [ eval, - [ 'if-equal', I,E, - [ eval, - [ 'interpret-args-tail', A,I,F, - H,D]], - [ eval, - [ 'return-on-error', - I, - [ eval, - [ 'interpret-args-tail', A,I,F, - H,D]]]]]]], - ['Error',A,'BadType']]], - [ 'Error', - [ 'interpret-atom', A,B,C, - D], - '$STRING'("Non-empty expression atom is expected")]]]]). -%; check that head was changed otherwise Error or Empty in the head -%; can be just an argument which is passed by intention -metta_defn('&self',[ 'interpret-args-tail', A,B,C,D, - E],[ chain, - [ eval, - [ 'interpret-args', A,C,D,E]], - F, - [ eval, - [ 'return-on-error', - F, - [cons,B,F]]]]). -metta_defn('&self',['interpret-tuple',A,B],[ match, - A, - [], - A, - [ eval, - [ 'if-decons', A,C,D, - [ chain, - [ eval, - [interpret,C,'%Undefined%',B]], - E, - [ chain, - [ eval, - ['interpret-tuple',D,B]], - F, - [cons,E,F]]], - [ 'Error', - ['interpret-tuple',A,B], - '$STRING'("Non-empty expression atom is expected as an argument")]]]]). -metta_defn('&self',[call,A,B,C],[ chain, - [eval,A], - D, - [ eval, - [ 'if-empty', D,A, - [ eval, - [ 'if-error', D,D, - [ eval, - [interpret,D,B,C]]]]]]]). -% 1,264,919 inferences, 0.139 CPU in 0.140 seconds (99% CPU, 9074539 Lips) -% (= metta_prelude.metta 0) - diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index b70a5e2f36a..ca4b4c7fb48 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -26,22 +26,36 @@ jobs: with: python-version: '3.x' - - name: Install junit2html + - name: Install python packages run: | + pip install ansi2html + pip install hyperon pip install junit2html - - name: Make Shell Script Executable + - name: Make Install Script Executable + run: chmod +x INSTALL.sh + + - name: Run Install Script to install Mettalog + run: | + . ./INSTALL.sh --easy + echo $PATH >> $GITHUB_PATH + + - name: Make Test Script Executable run: chmod +x scripts/run_commit_tests.sh - - name: Run Shell Script to Generate Input File + - name: Run Test Script to Generate Input File continue-on-error: true run: | - ./scripts/run_commit_tests.sh + TIMESTAMP=$(date +"%Y-%m-%dT%H:%M:%S") + ./scripts/run_commit_tests.sh -t $TIMESTAMP + echo "TIMESTAMP=$(echo $TIMESTAMP)" >> $GITHUB_ENV + env: + TERM: xterm-256color - name: Run JUnit Report Generation Script continue-on-error: true run: | - python scripts/into_junit.py /tmp/SHARED.UNITS > junit.xml + python scripts/into_junit.py /tmp/SHARED.UNITS $TIMESTAMP > junit.xml - name: Convert JUnit XML to Standard HTML Report continue-on-error: true @@ -83,86 +97,60 @@ jobs: reporter: 'java-junit' fail-on-error: false - - name: Download Previous JUnit Results - continue-on-error: true - uses: actions/download-artifact@v4 - with: - name: junit-report - path: previous-junit.xml - - - name: Install ReportGenerator + - name: Provide Report Links run: | - dotnet tool install -g dotnet-reportgenerator-globaltool + echo "JUnit reports are available as artifacts." - - name: Compare JUnit Test Results with ReportGenerator + - name: Generate environment.properties run: | - reportgenerator -reports:"previous-junit.xml;junit.xml" -targetdir:"./comparison-report" -reporttypes:"HtmlSummary;HtmlChart" + python scripts/generate_allure_environment.py ${{ github.sha }} ${{ github.ref_name }} > environment.properties - - name: Upload JUnit Comparison Report - continue-on-error: true + - name: Upload environment.properties uses: actions/upload-artifact@v4 with: - name: junit-comparison-html-report - path: ./comparison-report - - - name: Install Allure - run: | - curl -sLo allure-2.17.2.tgz https://github.com/allure-framework/allure2/releases/download/2.17.2/allure-2.17.2.tgz - tar -zxvf allure-2.17.2.tgz - sudo mv allure-2.17.2 /opt/allure - sudo ln -s /opt/allure/bin/allure /usr/bin/allure + name: environment + path: environment.properties - - name: Prepare Allure Results Directory - run: | - mkdir -p ./allure-results - cp junit.xml ./allure-results/ - if [ -f "previous-junit.xml" ]; then - cp previous-junit.xml ./allure-results/ - fi + - name: Get Allure history + uses: actions/checkout@v4 + with: + ref: test-results + path: test-results - - name: Generate Allure Report - run: | - allure generate --clean --output ./allure-report ./allure-results + - name: Download JUnit XML Results + uses: actions/download-artifact@v4 + with: + name: junit-report + path: build/allure-results - - name: Upload Allure Report as Artifact - continue-on-error: true - uses: actions/upload-artifact@v4 + - name: Include environment properties + uses: actions/download-artifact@v4 with: - name: allure-html-report - path: ./allure-report + name: environment + path: build/allure-results - - name: Provide Report Links - run: | - echo "JUnit reports, Allure report, and test comparison reports are available as artifacts." + - name: Generate Allure Report + uses: simple-elf/allure-report-action@master + if: always() + id: allure-report + with: + allure_results: build/allure-results + gh_pages: test-results + allure_report: allure-report + allure_history: allure-history + keep_reports: 20 + + - name: Deploy report to Github Pages + if: always() + uses: peaceiris/actions-gh-pages@v4 + with: + github_token: ${{ secrets.GITHUB_TOKEN }} + personal_token: ${{ secrets.GITHUB_TOKEN }} + publish_branch: test-results + publish_dir: allure-history - name: Auto-Approve the Pull Request if: github.event_name == 'pull_request_target' - uses: hmarr/auto-approve-action@v3 - with: - github-token: ${{ secrets.GITHUB_TOKEN }} - - - name: Setup Pages - uses: actions/configure-pages@v4 - - - name: Upload Allure Report as Pages Artifact - uses: actions/upload-pages-artifact@v3 + uses: hmarr/auto-approve-action@v4 with: - path: ./allure-report - - deploy-allure-report: - runs-on: ubuntu-latest - needs: generate-reports - - permissions: - pages: write # Allow deployment to GitHub Pages - id-token: write - - environment: - # environment created automatically by GitHub - name: github-pages - url: ${{ steps.deployment.outputs.page_url }} - - steps: - - name: Deploy to GitHub Pages - id: deployment - uses: actions/deploy-pages@v4 \ No newline at end of file + github-token: ${{ secrets.GITHUB_TOKEN }} \ No newline at end of file diff --git a/.gitignore b/.gitignore index d4d5e44edac..debb77957d4 100755 --- a/.gitignore +++ b/.gitignore @@ -16,6 +16,9 @@ ftp.flybase.net/** *~ *.buffer.pl *.metta.pl +*.mine +venv/ +src/canary-*/ .* *.qlf *.datalog diff --git a/Compiler-project.vpj b/Compiler-project.vpj new file mode 100644 index 00000000000..24ca99d6c18 --- /dev/null +++ b/Compiler-project.vpj @@ -0,0 +1,922 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Dockerfile b/Dockerfile index ca85c9e394c..41be6bd8867 100644 --- a/Dockerfile +++ b/Dockerfile @@ -6,6 +6,7 @@ ARG DEBIAN_FRONTEND=noninteractive RUN apt update RUN apt install -y python3 python3-pip libpython3-dev git RUN apt install -y sudo git curl gcc cmake +RUN apt install -y python3-venv time wget vim bc # Create user ENV USER=user @@ -16,34 +17,6 @@ RUN chsh -s /bin/bash user ENV HOME=/home/${USER} WORKDIR ${HOME} -# Install hyperonpy - -# MeTTaLog is already taking enough time we will have a separate one for Rustr MeTTa -RUN curl --proto '=https' --tlsv1.2 -sSf https://sh.rustup.rs > /tmp/rustup.sh -RUN sh /tmp/rustup.sh -y && rm /tmp/rustup.sh -ENV PATH="${PATH}:/home/user/.cargo/bin" -RUN cargo install cbindgen - -RUN python3 -m pip install conan==1.60.2 pip==23.1.2 -ENV PATH="${PATH}:/home/user/.local/bin" -RUN conan profile new --detect default - -RUN git clone https://github.com/trueagi-io/hyperon-experimental.git -WORKDIR ${HOME}/hyperon-experimental -RUN mkdir build - -WORKDIR ${HOME}/hyperon-experimental/lib -RUN cargo build -RUN cargo test - -WORKDIR ${HOME}/hyperon-experimental/build -RUN cmake .. -RUN make -RUN make check - -WORKDIR ${HOME}/hyperon-experimental -RUN python3 -m pip install -e ./python[dev] - # Install MeTTaLog ENV METTALOG_DIR="${HOME}/metta-wam" @@ -52,11 +25,13 @@ ENV PATH="${PATH}:${METTALOG_DIR}" WORKDIR ${HOME} # RUN git clone https://github.com/trueagi-io/metta-wam.git -RUN mkdir -p ${METTALOG_DIR}" +RUN mkdir -p "${METTALOG_DIR}" WORKDIR ${METTALOG_DIR} # This COPY is in case we have made local changes # so we dont have to commit to Github to test them out COPY ./ ./ +# get rid of copied venv that is probably using a whole different python anyways +RUN rm -rf ./venv/ COPY ./INSTALL.sh ./INSTALL.sh RUN ./INSTALL.sh --easy diff --git a/INSTALL.sh b/INSTALL.sh index 269aa8576e8..6d072e82678 100755 --- a/INSTALL.sh +++ b/INSTALL.sh @@ -6,14 +6,12 @@ IS_SOURCED=$( [[ "${BASH_SOURCE[0]}" != "${0}" ]] && echo 1 || echo 0) if [ "$IS_SOURCED" -eq "0" ]; then SCRIPT=$(readlink -f "$0"); else SCRIPT=$(readlink -f "${BASH_SOURCE[0]}"); fi export MeTTa=$(realpath "$SCRIPT") export METTALOG_DIR=$(dirname "$MeTTa") -export PIP_BREAK_SYSTEM_PACKAGES=1 # cd "$METTALOG_DIR" || { echo "Failed to navigate to $METTALOG_DIR"; [[ "$IS_SOURCED" == "1" ]] && return 1 || exit 1; } -(cd $METTALOG_DIR ; git update-index --assume-unchanged .bash_history) || true +#(cd $METTALOG_DIR ; git update-index --assume-unchanged .bash_history) || true # Run this file with ./INSTALL.md # ``` -. ./scripts/ensure_venv # Function to prompt for user confirmation with 'N' as the default confirm_with_default() { @@ -37,7 +35,6 @@ confirm_with_default() { done } - # Function to prompt for input with a default value prompt_for_input() { read -e -i "$2" -p "$1" value @@ -74,23 +71,6 @@ do esac done -# Ask the user if easy_install is still '?' -if [ "$easy_install" == "?" ]; then - if confirm_with_default "Y" "Would you like to use easy installation mode?"; then - easy_install="Y" - else - easy_install="N" - fi -fi - -if [ -f /.dockerenv ]; then - inside_docker="-y" -else - inside_docker="" -fi - - -echo -e "${BLUE}Starting the installation process..${NC}." # Function to compare versions version_ge() { @@ -180,7 +160,7 @@ install_or_update_swipl() { #sudo apt-get remove -y swi-prolog??* #sudo apt-get install -y swi-prolog swi_prolog_version=$(swipl_version) - required_version="9.3.8" + required_version="9.3.9" if version_ge $swi_prolog_version $required_version; then echo -e "${GREEN}SWI-Prolog version $swi_prolog_version is installed and meets the required version $required_version or higher.${NC}" else @@ -196,6 +176,57 @@ install_or_update_swipl() { } +# Is a Docker VM Allow more System modifications +if [ -f /.dockerenv ] || grep -qa docker /proc/1/cgroup; then + export PIP_BREAK_SYSTEM_PACKAGES=1 + export ALLOW_MODIFY_SYSTEM=1 + INSTALL_TYPE=docker_vm + if [ "$easy_install" == "?" ]; then + easy_install="Y" + fi +else + INSTALL_TYPE=non_docker +fi + +echo "INSTALL_TYPE=$INSTALL_TYPE" + +# Is a Github VM +if [ -n "$GITHUB_ACTIONS" ]; then + + INSTALL_TYPE=github_vm + export PIP_BREAK_SYSTEM_PACKAGES=1 + export ALLOW_MODIFY_SYSTEM=1 + echo "INSTALL_TYPE=$INSTALL_TYPE" + + if [ "$easy_install" == "?" ]; then + easy_install="Y" + fi + sudo add-apt-repository ppa:swi-prolog/devel -y + sudo apt update + sudo apt install -y swi-prolog + #bsdutils: /usr/bin/script + sudo apt install -y time libedit-dev bsdutils + sudo apt install -y build-essential autoconf git cmake libpython3-dev libgmp-dev libssl-dev unixodbc-dev \ + libreadline-dev zlib1g-dev libarchive-dev libossp-uuid-dev libxext-dev \ + libice-dev libjpeg-dev libxinerama-dev libxft-dev libxpm-dev libxt-dev \ + pkg-config libdb-dev libpcre3-dev libyaml-dev libedit-dev + +fi + +# Ask the user if easy_install is still '?' +if [ "$easy_install" == "?" ]; then + if confirm_with_default "Y" "Would you like to use easy installation mode?"; then + easy_install="Y" + else + easy_install="N" + fi +fi + +echo -e "${BLUE}Starting the installation process..${NC}." + +. ./scripts/ensure_venv + + # Check if SWI-Prolog is installed with Janus if ! command -v swipl &> /dev/null || ! swipl -g "use_module(library(janus)), halt(0)." -t "halt(1)" 2>/dev/null; then if confirm_with_default "Y" "SWI-Prolog is not installed with Janus support. Would you like to install it?"; then @@ -206,7 +237,7 @@ if ! command -v swipl &> /dev/null || ! swipl -g "use_module(library(janus)), ha fi else swi_prolog_version=$(swipl_version) - required_version="9.3.8" + required_version="9.3.9" if version_ge $swi_prolog_version $required_version; then echo -e "${GREEN}SWI-Prolog version $swi_prolog_version is installed and meets the required version $required_version or higher.${NC}" else @@ -340,7 +371,7 @@ check_metalog_in_path() { # Call the function to perform the check and update check_metalog_in_path -which swipl +echo "SWIPL executable is: `which swipl`" echo -e "${GREEN}Installation and setup complete!${NC}." diff --git a/README.md b/README.md index 80ab4df1b2a..601e73001de 100755 --- a/README.md +++ b/README.md @@ -1,13 +1,17 @@ - # :rocket: An Implementation of MeTTa designed to run on the Warren Abstract Machine (WAM) -Info at [./docs/OVERVIEW.md](docs/OVERVIEW.md) in this repository. - -See [Tests](tests/) for MeTTa as well as [Results](reports/TEST_LINKS.md) +## Quick Links +- [Getting Started](#getting-started) + - [Installation](#installation) +- [Running MeTTaLog](#neckbeard-running-mettalog) + - [With Docker](#whale-running-mettalog-with-docker) +- [Test Reports](https://trueagi-io.github.io/metta-wam/) +- [Tests](tests/) and [Result Links](reports/TEST_LINKS.md) +- [Overview Documentation](./docs/OVERVIEW.md). -## :package: Getting Started +## Getting Started -### :toolbox: Installation +### :gear: Installation _Before you get started make sure `pip` and `venv` are working good._ @@ -15,126 +19,104 @@ Clone and set up MeTTaLog with the following commands: ``` git clone https://github.com/trueagi-io/metta-wam cd metta-wam -. scripts/ensure_venv # ensures we are running in a python venv -pip install ansi2html # needed for running tests -pip install hyperon # needed for running tests -pip install junit2html # needed for test report generation -chmod +x INSTALL.sh # Make sure the script is executable -. ./INSTALL.sh # Follow the default prompts - +source ./INSTALL.sh # Follow the default prompts ``` -The INSTALL.sh script handles the installation of essential components and updates: -#### Python Packages +#### The INSTALL.sh script handles the installation of essential components and updates: - Ensures Python's `pip` is installed or installs it. -- **Installs mettalog**: Allows Rust MeTTa use extra functionality found in mettalog -- **Installs mettalog-jupyter-kernal**: Work with metta files in Jupyter Notebooks -- **Installs metakernal**: (No relation!) but allows our Jypter Kernel to work -- **Checks** if SWI-Prolog is already installed. -- **Installs or Updates** to ensure version 9.1 or higher is present. +- **Installs or Updates SWI-Prolog** to ensure version 9.3.9 or higher is present. - **Installs janus**: A Python package that interfaces with SWI-Prolog. -- **Installs pyswip**: Another Python package that provides further integration +- **Installs pyswip**: Another Python package that provides further integration. +- **Installs hyperon**: Hyperon pip package needed for running compatibility tests. +- **Installs ansi2html**: Unit Test Visibility. +- **Installs junit2html**: Unit Test Reporting. +- **Installs mettalog-vspace**: Allows Rust MeTTa use extra functionality found in mettalog. +- **Installs mettalog-jupyter-kernel**: Work with metta files in Jupyter Notebooks. +- **Installs metakernel**: (No relation!) but allows our Jupyter Kernel to work. + **Note**: Running this script modifies software configurations and installs packages. Ensure you're prepared for these changes. -## :whale: Docker +## :whale: Running MeTTaLog with Docker -To build a docker image containing MeTTaLog readily available run the -following command +
+ This section guides you through using Docker to set up -```bash -docker build -t mettalog . -``` +Ensures that MeTTaLog is isolated from your local filesystem and operates in a controlled environment. + +### Building the Docker Image -You may then enter a corresponding containter with the following -command +To create a Docker image with MeTTaLog installed, use the following command: ```bash -docker run -it --entrypoint 'bash -i' mettalog +docker build -t mettalog . ``` -Once inside the container you may enter the MeTTaLog REPL with the -following command +This command constructs a Docker image named `mettalog` based on the Dockerfile in the current directory. -```bash -mettalog --repl -``` +### Interacting with MeTTaLog in Docker + +After building the image, you can run MeTTaLog inside a Docker container. This isolates it from your local filesystem, which means it won't have direct access to your local files unless explicitly configured to do so. -or run a metta script as follows +To start an interactive container with a bash shell, use: ```bash -mettalog myprg.metta +docker run -it mettalog bash -l ``` -or run/load a metta script and debug in the repl +Once inside the container, you have several options to interact with MeTTaLog. See [Running MeTTaLog](#neckbeard-running-mettalog). -```bash -mettalog myprg.metta --repl -``` +### Transferring Files to and from the Container +Docker allows you to copy files between the host and the container, which can be useful for moving scripts or data into the container before running them, or extracting results afterward. Refer to the Docker documentation on [copying files](https://docs.docker.com/engine/reference/commandline/container_cp/) for more details. -Docker has a rich functionality set. In particular it allows you to -[copy](https://docs.docker.com/engine/reference/commandline/container_cp/) -files back and forth between the host and the container. For more -information about Docker you may refer to its -[manuals](https://docs.docker.com/manuals/) and its [reference -documentation](https://docs.docker.com/reference/). +For comprehensive information about Docker's capabilities, consult the [Docker manuals](https://docs.docker.com/manuals/) and [reference documentation](https://docs.docker.com/reference/). +
-## :computer: Usage and Demos +## :neckbeard: Running MeTTaLog Interact directly with MeTTaLog through the REPL: ```bash mettalog --repl metta+> !(+ 1 1) -!(+ 1 1) - Deterministic: 2 ; Execution took 0.000105 secs. (105.29 microseconds) -metta+> +metta+>^D # Exit the REPL with `ctrl-D`. ``` -Exit the REPL with `ctrl-D`. -**To run a script:** +To run a script: ```bash -mettalog tests/baseline_compat/hyperon-experimental_scripts/b0_chaining_prelim.metta +mettalog tests/baseline_compat/metta-morph_tests/nalifier.metta ``` -**Note:** Remember, the `MeTTa` script's name is case-sensitive. Do not confuse it with `metta`, which refers to the MeTTa Interpreter written in Rust. - - - - - -** Launch Jupyter notebook: (in progress) ** - - Contains a Jupyter Kernel for MeTTa (allows runing of MeTTa scripts remotely) -``` -./scripts/start_jupyter.sh +To run a script and then enter the repl: +```bash +mettalog tests/baseline_compat/metta-morph_tests/nalifier.metta --repl ``` -### Running Tests Execute a unit test: ```bash -mettalog --test --clean tests/baseline_compat/hyperon-experimental_scripts/00_lang_case.metta -``` -The output is saved as an HTML file in the same directory. - -- Execute baseline sanity tests: +# The output is saved as an HTML file in the same directory. +mettalog --test tests/baseline_compat/metta-morph_tests/tests0.metta ``` -mettalog --test --clean ./tests/baseline-compat +Execute baseline sanity tests: +```bash +mettalog --test --clean ./tests/baseline_compat/ ``` -### Troubleshooting +## :toolbox: Troubleshooting -#### Some prolog commands not found +
+ Some prolog commands not found -If you already have a recent enough version of SWI-prolog installed, that will be used instead of mettalog installing its own. Some of the packages might not be installed, and mettalog might give an error such as: +If you already have a recent enough version of SWI-Prolog installed, that will be used instead of mettalog installing its own. Some of the packages might not be installed, and mettalog might give an error such as: ``` ERROR: save_history/0: Unknown procedure el_write_history/2 ``` -In that case, you need rebuild your SWI-prolog installation to include the missing packages. The most reliable way to do this is to make sure the following Debian/Ubuntu packages are installed using: +In that case, you need to rebuild your SWI-Prolog installation to include the missing packages. The most reliable way to do this is to make sure the following Debian/Ubuntu packages are installed using: ``` sudo apt install build-essential autoconf git cmake libpython3-dev libgmp-dev libssl-dev unixodbc-dev \ @@ -143,7 +125,7 @@ sudo apt install build-essential autoconf git cmake libpython3-dev libgmp-dev li pkg-config libdb-dev libpcre3-dev libyaml-dev libedit-dev ``` -then rebuild swi-prolog using the instructions from The [SWI-Prolog -- Installation on Linux, *BSD (Unix)](https://www.swi-prolog.org/build/unix.html). The main part of this (assuming that you are in the `swipl` or `swipl-devel` directory) is: +then rebuild SWI-Prolog using the instructions from the [SWI-Prolog -- Installation on Linux, *BSD (Unix)](https://www.swi-prolog.org/build/unix.html). The main part of this (assuming that you are in the `swipl` or `swipl-devel` directory) is: ``` cd build @@ -152,10 +134,12 @@ ninja ctest -j $(nproc) --output-on-failure ninja install ``` -If you installed swi-prolog as a package from your Linux distribition and run into issues, it is likely that you will need to `apt remove` it and then either -* build SWI-prolog from source making sure that all the operating system packages are installed first, or +If you installed SWI-Prolog as a package from your Linux distribution and run into issues, it is likely that you will need to `apt remove` it and then either +* build SWI-Prolog from source making sure that all the operating system packages are installed first, or * rerun the metta-wam `INSTALL.sh` script. +
+ ## :raised_hands: Acknowledgments Thanks to the Hyperon Experimental MeTTa, PySWIP teams, and Flybase for their contributions to this project. @@ -165,8 +149,8 @@ For queries or suggestions, please open an issue on our [GitHub Issues Page](htt ## :scroll: License MeTTaLog is distributed under the LGPL License, facilitating open collaboration and use. - -## :gear: Prerequisites for using MeTTaLog in Rust +
+ Prerequisites for using MeTTaLog in Rust - A build of [Hyperon Experimental](https://github.com/trueagi-io/hyperon-experimental) is required. ```bash @@ -185,7 +169,6 @@ MeTTaLog is distributed under the LGPL License, facilitating open collaboration ``` - ```shell metta> !(test_custom_v_space) @@ -206,7 +189,9 @@ Pass Test:(remove_atom on a missing atom should return false) ; (get-atoms &vspace_9) Pass Test:( [a, c] == [a, c] ) ; (add-atom &vspace_10 a) -; (add-atom &vspace_10 b) +; (add-atom &v + +space_10 b) ; (add-atom &vspace_10 c) ; (atom-replace &vspace_10 b d) ; (add-atom &vspace_10 d) @@ -234,9 +219,10 @@ Pass Test:( [ { $v <- B } ] == [{v: B}] ) Pass Test:(Values same: [[B]] == [[B]]) ``` +
- -## Python interaction +
+ Python interaction Module loading ; using the python default module resolver $PYTHONPATH @@ -259,7 +245,10 @@ Module loading (pyr! &self ../path/to/motto/test_llm_gate.py "run_tests" ((= verbose $verbose)))) ``` -## MeTTaLog Extras +
+ +
+ MeTTaLog Extras ``` ; For the compiler to know that the member function will be a predicate @@ -283,8 +272,6 @@ Module loading !(include! &self https://somewhere/test_llm_gate.metta) ``` - - ``` ; interfacing to Prolog (:> OptionsList (List (^ Expresson (Arity 2)))) @@ -314,8 +301,6 @@ clear ; mettalog --test --v=./src/canary --log --html tests/*baseline*/ \ --output=4-06-canary-wd-both --clean ``` - - Vs for diffing ``` @@ -327,8 +312,10 @@ clear ; mettalog --test --v=./src/canary --log --html --compile=false tests/base ``` +
-# Metta Functions Task List +
+ Metta Functions Task List | Function Name | Doc. (@doc) | Test Created | Impl. in Interpreter | Impl. in Transpiler | Arg Types Declared | |----------------|-------------|--------------|----------------------|---------------------|--------------------| @@ -336,5 +323,12 @@ clear ; mettalog --test --v=./src/canary --log --html --compile=false tests/base | `functionB` | - [ ] | - [ ] | - [ ] | - [ ] | - [ ] | | `functionC` | - [ ] | - [ ] | - [ ] | - [ ] | - [ ] | +
- +
+ Launch Jupyter notebook + - Contains a Jupyter Kernel for MeTTa (in-progress) +``` +./scripts/start_jupyter.sh +``` +
diff --git a/Test-files.vpj b/Test-files.vpj new file mode 100755 index 00000000000..eb1817ac708 --- /dev/null +++ b/Test-files.vpj @@ -0,0 +1,84 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/compiler-project.vpj b/compiler-project.vpj deleted file mode 100755 index 9ebf6ea11c6..00000000000 --- a/compiler-project.vpj +++ /dev/null @@ -1,125 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/hyperon-experimental.vpj b/hyperon-experimental.vpj new file mode 100644 index 00000000000..37d67fa9214 --- /dev/null +++ b/hyperon-experimental.vpj @@ -0,0 +1,63 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/hyperon-wam.vpj b/hyperon-wam.vpj index 03c0cd5b917..178ab3533d8 100755 --- a/hyperon-wam.vpj +++ b/hyperon-wam.vpj @@ -122,7 +122,7 @@ diff --git a/hyperon-wam.vpw b/hyperon-wam.vpw index 5a831624753..e527228365c 100755 --- a/hyperon-wam.vpw +++ b/hyperon-wam.vpw @@ -2,9 +2,8 @@ + - - diff --git a/library/graphml/tests/simple.graphml b/library/graphml/tests/simple.graphml new file mode 100644 index 00000000000..c3ce36c4c54 --- /dev/null +++ b/library/graphml/tests/simple.graphml @@ -0,0 +1,31 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/mettalog b/mettalog index f374667b18f..abf9631b2f3 100755 --- a/mettalog +++ b/mettalog @@ -18,7 +18,11 @@ compatio=false RC_OPTIONS=() TIMEOUT=0 verbose="${VERBOSE:-0}" # Use the VERBOSE environment variable or default to '0' (not verbose) -export OUTPUT_DIR="./" +OUTPUT_DIR="${METTALOG_OUTPUT}" + +cd $METTALOG_DIR +source ./scripts/ensure_venv +cd $RPWD use_docker=auto repl_flag=auto @@ -26,15 +30,82 @@ use_rc_file=~/.mettalogrc debug_this_script=false contains_halt=false dry_run=0 -#debug_this_script=true -stdout_is_to_file=false -if [ -t 1 ]; then - #echo "stdout is connected to a terminal" - stdout_is_to_file=false -else - #echo "stdout is being piped or redirected" - stdout_is_to_file=true -fi + +# Function to add a flag to a list +add_to_list() { + local flag=$1 + local -n options=$2 + if [[ -n "$flag" ]]; then + options+=("$flag") + fi +} + +# Function to set input, output, and error flags based on the I/O sources +set_io_flags() { + #local -n STDIO_OPTIONS=$1 + + # Handle stdin flags + if [ -p /dev/stdin ]; then + add_to_list "--stdin=pipe" STDIO_OPTIONS + elif [ -f /dev/stdin ]; then + local input_filename + input_filename=$(readlink /proc/self/fd/0) + add_to_list "--stdin=file" STDIO_OPTIONS + add_to_list "--input-filename=${input_filename}" STDIO_OPTIONS + else + add_to_list "--stdin=tty" STDIO_OPTIONS + fi + + # Handle stdout flags + if [ ! -t 1 ]; then + if [ -p /dev/stdout ]; then + add_to_list "--stdout=pipe" STDIO_OPTIONS + elif [ -f /dev/stdout ]; then + local output_filename + output_filename=$(readlink /proc/self/fd/1) + add_to_list "--stdout=file" STDIO_OPTIONS + add_to_list "--output-filename=${output_filename}" STDIO_OPTIONS + fi + else + add_to_list "--stdout=tty" STDIO_OPTIONS + fi + + # Handle stderr flags + if [ ! -t 2 ]; then + if [ -p /dev/stderr ]; then + add_to_list "--stderr=pipe" STDIO_OPTIONS + elif [ -f /dev/stderr ]; then + local error_filename + error_filename=$(readlink /proc/self/fd/2) + add_to_list "--stderr=file" STDIO_OPTIONS + add_to_list "--error-filename=${error_filename}" STDIO_OPTIONS + fi + else + add_to_list "--stderr=tty" STDIO_OPTIONS + fi +} + +# Initialize the STDIO_OPTIONS array +STDIO_OPTIONS=() + +# Set the input, output, and error flags +set_io_flags + +# Function to check if SWI-Prolog is installed +check_swipl_installed() { + if ! command -v swipl &> /dev/null; then + echo -e "\033[0;31mError: SWI-Prolog is not installed. Please install it and try again.\033[0m" + exit 1 + fi +} + +# Function to check if SWI-Prolog has Janus support (optional, based on your needs) +check_janus_support() { + if ! swipl -g "use_module(library(janus)), halt(0)." -t "halt(1)" 2>/dev/null; then + echo -e "\033[0;31mError: SWI-Prolog does not have Janus support. Please install Janus and try again.\033[0m" + python_flag=disable + fi +} # Capture original auto margins setting and terminal size @@ -168,7 +239,6 @@ do_DEBUG() { local screen_width=$(tput cols) local threshold=$((screen_width * 74 / 100)) - # Construct the debug message # Construct the debug message local msg="; ${YELLOW}DEBUG${NC} $*" @@ -422,6 +492,8 @@ fi PRE_METTALOG_OPTIONS=() SWI_FLAG_WITH_ARG=false python_flag=enable +# Optional: Check if SWI-Prolog has Janus support +check_janus_support LIST_OF_FILE_ARGS=() wants_print_help=0 @@ -542,14 +614,15 @@ function handle_args { #METTALOG_OPTIONS=("--timeout=$TIMEOUT" "${METTALOG_OPTIONS[@]}") #add_to_list "$arg" METTALOG_OPTIONS continue - elif [[ "$arg" =~ ^--python=(enable|false)$ ]]; then + elif [[ "$arg" =~ ^--python=(enable|disable|false)$ ]]; then python_flag="${BASH_REMATCH[1]}" - continue + continue elif [[ "$arg" == "--python" ]]; then python_flag=enable - continue + continue elif [[ "$arg" == "--no-python" ]]; then python_flag=false + continue elif [[ "$arg" == "--repl" ]]; then #add_to_list "$arg" METTALOG_OPTIONS_LAST repl_flag=true @@ -586,6 +659,7 @@ function handle_args { add_to_list "$arg" METTALOG_OPTIONS if [[ "$arg" =~ ^--output=(.*)$ ]]; then OUTPUT_DIR="${BASH_REMATCH[1]}" + export METTALOG_OUTPUT="${OUTPUT_DIR}" fi continue ;; @@ -861,30 +935,33 @@ if [[ -z "$reference_file" ]]; then fi if [[ -f "$reference_file" ]]; then - : # rm -f $reference_file + : # Placeholder in case something needs to be done here + # rm -f $reference_file fi if [[ -f "$reference_file" ]]; then - MLOG="$reference_file --" + MLOG="$reference_file" + if [[ "${#SWI_OPTIONS[@]}" -gt 0 ]]; then - MLOG="swipl -x $reference_file ${SWI_OPTIONS[*]} --" + MLOG="swipl -x $reference_file ${SWI_OPTIONS[*]}" fi if [[ "$never_compile" -eq 1 ]]; then - MLOG="swipl ${SWI_OPTIONS[*]} -l $INTERP_SRC_DIR/metta_interp.pl --" + MLOG="swipl ${SWI_OPTIONS[*]} $INTERP_SRC_DIR/metta_interp.pl" fi else - MLOG="swipl ${SWI_OPTIONS[*]} -l $INTERP_SRC_DIR/metta_interp.pl --" -fi - -if [[ "$stdout_is_to_file" == true ]]; then - add_to_list "--piped" METTALOG_OPTIONS + MLOG="swipl ${SWI_OPTIONS[*]} $INTERP_SRC_DIR/metta_interp.pl" fi #add_to_list "--log" METTALOG_OPTIONS #html_flag=enable #add_to_list "--html" METTALOG_OPTIONS -METTA_CMD="$MLOG --python=$python_flag ${PRE_METTALOG_OPTIONS[*]} ${METTALOG_OPTIONS[*]} ${METTALOG_OPTIONS_LAST[*]}" +STDIO_OPTIONS=() +set_io_flags STDIO_OPTIONS + +# Generate the final command +METTA_CMD="$MLOG -- --python=$python_flag -- ${PRE_METTALOG_OPTIONS[*]} ${METTALOG_OPTIONS[*]} ${METTALOG_OPTIONS_LAST[*]} ${STDIO_OPTIONS[*]}" + OS=$(uname) TIMEOUT_CMD="timeout" @@ -915,7 +992,7 @@ cleanup() { else METTA_CMD_EXIT_STATUS=${METTA_CMD_EXIT_STATUS:-$?} fi - DEBUG "Exit code of METTA_CMD: $METTA_CMD_EXIT_STATUS" + do_DEBUG "Exit code of METTA_CMD: $METTA_CMD_EXIT_STATUS" if [ ! -z "$TEE_FILE" ];then if [ ! -z "$HTML_OUT" ];then @@ -933,13 +1010,11 @@ cleanup() { } # Trap exit signal to execute cleanup function - -#DEBUG "TIMEOUT=$TIMEOUT" - +trap cleanup EXIT if [[ -n "$TIMEOUT" && "$TIMEOUT" -gt 0 ]]; then export TIMEOUT - METTA_CMD="$TIMEOUT_CMD --preserve-status --signal=SIGTERM --kill-after=5s $TIMEOUT ${METTA_CMD}" + METTA_CMD="$TIMEOUT_CMD --preserve-status --foreground --signal=SIGTERM --kill-after=5s $TIMEOUT ${METTA_CMD}" fi function escape_quotes { @@ -950,6 +1025,59 @@ function escape_quotes { cd "${RPWD}" set +e +# Function to execute the command with the appropriate redirections +execute_with_pipes() { + local input_redirection="" + local output_redirection="" + local error_redirection="" + + # Handle stdin redirection + if [[ "${STDIO_OPTIONS[*]}" =~ "--stdin=file" ]]; then + input_file=$(echo "${STDIO_OPTIONS[*]}" | grep -oP '(?<=--input-filename=)[^ ]+') + input_redirection="<\"$input_file\"" + elif [[ "${STDIO_OPTIONS[*]}" =~ "--stdin=pipe" ]]; then + # stdin is already a pipe, no action needed + : + else + # stdin is a tty, no redirection needed + : + fi + + # Handle stdout redirection + if [[ "${STDIO_OPTIONS[*]}" =~ "--stdout=file" ]]; then + output_file=$(echo "${STDIO_OPTIONS[*]}" | grep -oP '(?<=--output-filename=)[^ ]+') + output_redirection=">\"$output_file\"" + elif [[ "${STDIO_OPTIONS[*]}" =~ "--stdout=pipe" ]]; then + # stdout is already a pipe, no action needed + : + else + # stdout is a tty, no redirection needed + : + fi + + # Handle stderr redirection + if [[ "${STDIO_OPTIONS[*]}" =~ "--stderr=file" ]]; then + error_file=$(echo "${STDIO_OPTIONS[*]}" | grep -oP '(?<=--error-filename=)[^ ]+') + error_redirection="2>\"$error_file\"" + elif [[ "${STDIO_OPTIONS[*]}" =~ "--stderr=pipe" ]]; then + # stderr is already a pipe, no action needed + : + else + # stderr is a tty, no redirection needed + : + fi + + # Construct the full command with all necessary redirections + local full_command="eval \"$METTA_CMD\" $input_redirection $output_redirection $error_redirection" + + # Check if SWI-Prolog is installed + check_swipl_installed + + # Execute the command using IF_REALLY_DO + IF_REALLY_DO "$full_command" +} + + # Conditional to check if html_flag is enabled if [[ "$html_flag" == "enable" ]]; then # Generate a random filename for TEE_FILE with date,time,PID @@ -960,6 +1088,7 @@ if [[ "$html_flag" == "enable" ]]; then if [ ! -z "$HTML_OUT" ];then HTML_OUT=$(realpath --relative-to="$(pwd)" "$HTML_OUT") if [ ! -z "$OUTPUT_DIR" ] ;then + export METTALOG_OUTPUT="${OUTPUT_DIR}" HTML_OUT="${OUTPUT_DIR}/${HTML_OUT}" fi export HTML_FILE="${HTML_OUT}" @@ -967,38 +1096,36 @@ if [[ "$html_flag" == "enable" ]]; then export TYPESCRIPT=1 if [[ "$OS" == "Darwin" ]]; then # macOS - METTA_CMD="/usr/bin/script -q -f -a \"$TEE_FILE\" \"${METTA_CMD//\"/\\\"}\"" + METTA_CMD="/usr/bin/script -q -f -a \"$TEE_FILE\" -c \\\"$(printf '%q ' ${METTA_CMD[@]})\\\"" else # Assume Linux - METTA_CMD="/usr/bin/script -q -f --force -e -a \"$TEE_FILE\" -c \"${METTA_CMD//\"/\\\"}\"" - fi - - [[ "$wants_print_help" == "1" ]] && { print_help; } - DEBUG "" - DEBUG "Afterwhich ansi2html -u < $TEE_FILE > '$HTML_OUT'" - DEBUG "" - [[ -n "${EXIT_SCRIPT+x}" ]] && { [[ "$IS_SOURCED" == "1" ]] && return "$EXIT_SCRIPT" || exit "$EXIT_SCRIPT"; } - - #( - IF_REALLY_DO "touch '$TEE_FILE'" - IF_REALLY_DO "chmod 777 '$TEE_FILE'" - IF_REALLY_DO "cat /dev/null > '$TEE_FILE'" - #if [[ "$contains_halt" == "true" ]]; then - DEBUG "METTA_CMD: $METTA_CMD" - #fi - trap 'cleanup' EXIT - eval "$METTA_CMD" - echo $? > "$TEMP_EXIT_CODE_FILE" - #) + METTA_CMD="/usr/bin/script -q -f --force -e -a \"$TEE_FILE\" -c \\\"$(echo "${METTA_CMD}" | sed 's/"/\\"/g')\\\"" + fi + + [[ "$wants_print_help" == "1" ]] && { print_help; } + DEBUG "" + DEBUG "Afterwhich ansi2html -u < $TEE_FILE > '$HTML_OUT'" + DEBUG "" + [[ -n "${EXIT_SCRIPT+x}" ]] && { [[ "$IS_SOURCED" == "1" ]] && return "$EXIT_SCRIPT" || exit "$EXIT_SCRIPT"; } + + IF_REALLY_DO "touch '$TEE_FILE'" + IF_REALLY_DO "chmod 777 '$TEE_FILE'" + IF_REALLY_DO "cat /dev/null > '$TEE_FILE'" + if [[ "$contains_halt" == "true" ]]; then + do_DEBUG "METTA_CMD: $METTA_CMD" + fi + execute_with_pipes + echo $? > "$TEMP_EXIT_CODE_FILE" else - [[ "$wants_print_help" == "1" ]] && { print_help; [[ "$IS_SOURCED" == "1" ]] && return "$EXIT_SCRIPT" || exit "$EXIT_SCRIPT"; } - [[ -n "${EXIT_SCRIPT+x}" ]] && { [[ "$IS_SOURCED" == "1" ]] && return "$EXIT_SCRIPT" || exit "$EXIT_SCRIPT"; } - if [[ "$contains_halt" == "true" ]]; then - do_DEBUG "METTA_CMD: $METTA_CMD" - fi - #( - trap 'cleanup' EXIT - IF_REALLY_DO eval "$METTA_CMD" - IF_REALLY_DO "echo $? > '$TEMP_EXIT_CODE_FILE'" - #) + [[ "$wants_print_help" == "1" ]] && { print_help; [[ "$IS_SOURCED" == "1" ]] && return "$EXIT_SCRIPT" || exit "$EXIT_SCRIPT"; } + [[ -n "${EXIT_SCRIPT+x}" ]] && { [[ "$IS_SOURCED" == "1" ]] && return "$EXIT_SCRIPT" || exit "$EXIT_SCRIPT"; } + if [ ! -z "$OUTPUT_DIR" ] ;then + export METTALOG_OUTPUT="${OUTPUT_DIR}" + fi + if [[ "$contains_halt" == "true" ]]; then + do_DEBUG "METTA_CMD: $METTA_CMD" + fi + execute_with_pipes + IF_REALLY_DO "echo $? > '$TEMP_EXIT_CODE_FILE'" fi +cd "${RPWD}" diff --git a/scripts/cmd_as_test.sh b/scripts/cmd_as_test.sh new file mode 100644 index 00000000000..88906481b25 --- /dev/null +++ b/scripts/cmd_as_test.sh @@ -0,0 +1,75 @@ +#!/bin/bash + +local TEST_NAME="$1" # HTML output file +local LOGFILE="$3" # Test file +local EXTRA_INFO="$4" + +local TEST_CMD="$@" # The command to run (passed as a single string) + +# Start the timer +local START_TIME=$(date +%s) + +# Run the test command using eval to handle the single string properly +eval "$TEST_CMD" +local TEST_EXIT_CODE=$? + +# Stop the timer and calculate elapsed time +local END_TIME=$(date +%s) +local ELAPSED_TIME=$((END_TIME - START_TIME)) + +# Determine the test status based on the exit code +local DEBUG_MESSAGE +local PASS_OR_FAIL +local SHOULD_DELETE_HTML=0 + +if [ $TEST_EXIT_CODE -eq 0 ]; then + DEBUG_MESSAGE="${GREEN}Completed successfully (EXITCODE=$TEST_EXIT_CODE) $EXTRA_INFO: $TEST_CMD${NC}" + PASS_OR_FAIL="PASS" +elif [ $TEST_EXIT_CODE -eq 124 ]; then + DEBUG_MESSAGE="${RED}Killed (definitely due to timeout) (EXITCODE=$TEST_EXIT_CODE) after $EXTRA_INFO seconds: $TEST_CMD${NC}" + [ "$if_failures" -eq 1 ] && SHOULD_DELETE_HTML=1 + PASS_OR_FAIL="FAIL" +elif [ $TEST_EXIT_CODE -eq 134 ]; then + DEBUG_MESSAGE="${RED}Test aborted by user (EXITCODE=$TEST_EXIT_CODE) $EXTRA_INFO: $TEST_CMD${NC}" + SHOULD_DELETE_HTML=1 + PASS_OR_FAIL="FAIL" +elif [ $TEST_EXIT_CODE -eq 4 ]; then + DEBUG_MESSAGE="${RED}Stopping tests (EXITCODE=$TEST_EXIT_CODE) $EXTRA_INFO: $TEST_CMD${NC}" + SHOULD_DELETE_HTML=1 + PASS_OR_FAIL="FAIL" + exit 4 +elif [ $TEST_EXIT_CODE -ne 7 ]; then + DEBUG_MESSAGE="${YELLOW}Completed (EXITCODE=$TEST_EXIT_CODE) $EXTRA_INFO: $TEST_CMD${NC}" + PASS_OR_FAIL="FAIL" +else + DEBUG_MESSAGE="${GREEN}Completed successfully (EXITCODE=$TEST_EXIT_CODE) $EXTRA_INFO: $TEST_CMD${NC}" + PASS_OR_FAIL="PASS" +fi + +# Generate the HTML link +local HTML_LINK="file://$file_html#${TEST_NAME}" + +# Determine if the HTML file should be used as the logfile or a separate .log file should be created +if [ $SHOULD_DELETE_HTML -eq 1 ]; then + # Create a separate .log file since the HTML file is planned for deletion + LOGFILE="${file_html}.log" + cp "$file_html" "$LOGFILE" +else + # Use the HTML file as the logfile since it won't be deleted + LOGFILE="$file_html" +fi + +# Redirect debug messages to both the logfile and console +echo "$DEBUG_MESSAGE" | tee -a "$LOGFILE" + +# Write the line to /tmp/SHARED.UNITS +echo "| $TEST_NAME | $PASS_OR_FAIL | [$TEST_NAME]($HTML_LINK) | $TEST_CMD | $TEST_EXIT_CODE | 7 | $ELAPSED_TIME | $LOGFILE |" >> /tmp/SHARED.UNITS + +# Delete the HTML file if it was planned for deletion +if [ $SHOULD_DELETE_HTML -eq 1 ]; then + rm -f "$file_html" +fi + +return $TEST_EXIT_CODE + + diff --git a/scripts/ensure_venv b/scripts/ensure_venv index 9b94eb10deb..d33fd279305 100755 --- a/scripts/ensure_venv +++ b/scripts/ensure_venv @@ -1,18 +1,56 @@ #!/bin/bash -# Name of the virtual environment directory -VENV_DIR="venv" +# Ensure the script is being sourced +if [[ "${BASH_SOURCE[0]}" == "${0}" ]]; then + echo "Warning: This script should be sourced, not executed directly." >&2 + exit 1 # Exit the script if it's not being sourced +fi + +# Get the directory of the script +SCRIPT_DIR=$(dirname "$(realpath "${BASH_SOURCE[0]}")") +# Set VENV_DIR to one directory above the script's directory +PARENT_DIR=$(dirname "$SCRIPT_DIR") +VENV_DIR="$PARENT_DIR/venv" + +# Default verbosity level (0: quiet, 1: normal, 2: verbose) +VERBOSITY=1 + +# Parse command-line options +for arg in "$@"; do + case $arg in + -v|--verbose) + VERBOSITY=2 + ;; + -q|--quiet) + VERBOSITY=0 + ;; + *) + #echo "Usage: source $0 [-v|--verbose] [-q|--quiet]" >&2 + #exit 1 + ;; + esac +done + +# echo "VERBOSITY=$VERBOSITY" + +# Function to print messages based on verbosity level +log() { + local level="$1" + shift + if [ "$level" -le "$VERBOSITY" ]; then + echo "$@" >&2 + fi +} # Function to activate the virtual environment activate_venv() { - echo "Activating the virtual environment..." + log 2 "Activating the virtual environment: $(realpath $VENV_DIR)" source "$VENV_DIR/bin/activate" } # Function to check if we are inside a virtual environment is_inside_venv() { - if [[ "$VIRTUAL_ENV" != "" ]] - then + if [[ "$VIRTUAL_ENV" != "" ]]; then return 0 # True, script is running inside a virtual environment else return 1 # False, script is not running inside a virtual environment @@ -22,26 +60,46 @@ is_inside_venv() { # Function to create a virtual environment create_venv() { if [ ! -d "$VENV_DIR" ]; then - echo "Creating a virtual environment..." + log 1 "Creating a virtual environment: $VENV_DIR" python3 -m venv "$VENV_DIR" + # Assuming the script is run from a virtual environment with useful packages + if [ -n "$VIRTUAL_ENV" ] && [ -d "$VIRTUAL_ENV" ]; then + log 2 "Inheriting packages from existing environment: $VIRTUAL_ENV" + source "$VIRTUAL_ENV/bin/activate" + pip freeze > /tmp/requirements.txt + deactivate + activate_venv + pip install -r /tmp/requirements.txt + rm /tmp/requirements.txt + fi + if [ -f "requirements.txt" ]; then + : + #log 2 "Found local requirements.txt, installing packages..." + #pip install -r requirements.txt + fi else - echo "Virtual environment already exists." + log 2 "Virtual environment already exists: $VENV_DIR" fi } # Main logic of the script if is_inside_venv; then - echo "Script is running inside a virtual environment." + if [ "$VIRTUAL_ENV" != "$(realpath $VENV_DIR)" ]; then + log 1 "Reusing virtual environment: $VIRTUAL_ENV" + #log 1 "Expected virtual environment: $(realpath $VENV_DIR)" + else + log 2 "Script is running inside the expected virtual environment: $VENV_DIR" + fi else - echo "Script is not running inside a virtual environment." + log 2 "Script is not running inside a virtual environment." create_venv activate_venv # Relaunch the script inside the virtual environment - # echo "Relaunching the script inside the virtual environment..." - # exec "$0" "$@" + #log 2 "Relaunching the script inside the virtual environment..." + #exec "$0" "$@" fi # Place your script's main execution logic here -# echo "Executing the main script logic..." +#log 2 "Executing the main script logic..." diff --git a/scripts/generate_allure_environment.py b/scripts/generate_allure_environment.py new file mode 100644 index 00000000000..6e7f2809916 --- /dev/null +++ b/scripts/generate_allure_environment.py @@ -0,0 +1,10 @@ +import sys + +if __name__ == "__main__": + if len(sys.argv) != 3: + print("Usage: python scripts/generate_allure_environment.py ") + sys.exit(1) + + commit_SHA = sys.argv[1] + branch = sys.argv[2] + print("COMMIT_SHA = {}\nBRANCH = {}".format(commit_SHA, branch)) \ No newline at end of file diff --git a/scripts/generate_allure_executor.py b/scripts/generate_allure_executor.py new file mode 100644 index 00000000000..73bf4e63a4b --- /dev/null +++ b/scripts/generate_allure_executor.py @@ -0,0 +1,15 @@ +import sys, json + +if __name__ == "__main__": + if len(sys.argv) != 4: + print("Usage: python scripts/generate_allure_executor.py ") + sys.exit(1) + + server_url = sys.argv[1] + repo = sys.argv[2] + run_id = sys.argv[3] + data = { 'name':'GitHub Actions', 'type':'github' } + data['buildUrl'] = '{}/{}/actions/runs/{}'.format(server_url, repo, run_id) + data['buildName'] = 'GitHub Actions Run #{}'.format(run_id) + + print(json.dumps(data)) \ No newline at end of file diff --git a/scripts/into_junit.py b/scripts/into_junit.py index b08a9334a18..ca54182317c 100644 --- a/scripts/into_junit.py +++ b/scripts/into_junit.py @@ -2,10 +2,11 @@ import sys import re from collections import defaultdict +import datetime -def create_testcase_element(testclass, testname, stdout, identifier, got, expected, status, url): +def create_testcase_element(testclass, testname, stdout, identifier, got, expected, status, url, time): # Create the testcase XML element with the class and test name attributes - testcase = ET.Element("testcase", classname=testclass, name=testname) + testcase = ET.Element("testcase", classname=testclass, name=testname, time=time) test_res = f"Assertion: {stdout}\nExpected: {expected}\nActual: {got}" sys_out_text = f"Test Report\n\n{test_res}\n]]>" @@ -36,6 +37,7 @@ def parse_test_line(line): stdout = parts[4].strip() # The fifth field contains the assertion got = parts[5].strip() # The sixth field contains the actual result expected = parts[6].strip() # The seventh field contains the expected result + time = parts[7].strip() # The eighth field contains how long it took to run the test try: # Split the identifier into the package, class, and test names @@ -45,10 +47,11 @@ def parse_test_line(line): except ValueError as e: raise ValueError(f"Identifier does not contain the expected format: {full_identifier}. Error: {str(e)}") - return testpackage, testname, stdout, full_identifier, got, expected, status, url + return testpackage, testname, stdout, full_identifier, got, expected, status, url, time -def generate_junit_xml(input_file): - testsuites = ET.Element("testsuites") +def generate_junit_xml(input_file, timestamp): + dt = datetime.datetime.fromisoformat(timestamp) + timestamps_dict = {} packages_dict = defaultdict(list) # Dictionary to group test cases by their testpackage with open(input_file, 'r') as file: @@ -57,29 +60,41 @@ def generate_junit_xml(input_file): if line.startswith("|"): try: parts = re.split(r'\s*\|\s*(?![^()]*\))', line.strip()) - testpackage, testname, stdout, full_identifier, got, expected, status, url = parse_test_line(line) - testcase = create_testcase_element(testpackage, testname, stdout, full_identifier, got, expected, status, url) + testpackage, testname, stdout, full_identifier, got, expected, status, url, time = parse_test_line(line) + testcase = create_testcase_element(testpackage, testname, stdout, full_identifier, got, expected, status, url, time) + dt += datetime.timedelta(seconds=float(time)) + if testpackage not in timestamps_dict: + timestamps_dict[testpackage] = dt packages_dict[testpackage].append(testcase) print(f"Processing {testpackage}.{testname}: {status}", file=sys.stderr) except ValueError as e: print(f"Skipping line due to error: {e}\nLine: {line}\nParts: {parts}", file=sys.stderr) # Create a testsuite for each testpackage group + testsuites = ET.Element("testsuites", timestamp=timestamp) + testsuites_time = 0.0 for testpackage, testcases in packages_dict.items(): - testsuite = ET.Element("testsuite", name=testpackage) + testsuite_timestamp = timestamps_dict[testpackage].isoformat(timespec='seconds') + testsuite = ET.Element("testsuite", name=testpackage, timestamp=testsuite_timestamp) + testsuite_time = 0.0 for testcase in testcases: + testsuite_time += float(testcase.get('time')) testsuite.append(testcase) + testsuites_time += testsuite_time + testsuite.set('time', str(testsuite_time)) testsuites.append(testsuite) + testsuites.set('time', str(testsuites_time)) # Generate the XML tree and return it as a string tree = ET.ElementTree(testsuites) return ET.tostring(testsuites, encoding="utf-8", xml_declaration=True).decode("utf-8") if __name__ == "__main__": - if len(sys.argv) != 2: - print("Usage: python scripts/into_junit.py ") + if len(sys.argv) != 3: + print("Usage: python scripts/into_junit.py ") sys.exit(1) input_file = sys.argv[1] - junit_xml = generate_junit_xml(input_file) + timestamp = sys.argv[2] + junit_xml = generate_junit_xml(input_file, timestamp) print(junit_xml) diff --git a/scripts/run_commit_tests.sh b/scripts/run_commit_tests.sh index ae0e0a22c9f..6453719945d 100755 --- a/scripts/run_commit_tests.sh +++ b/scripts/run_commit_tests.sh @@ -1,8 +1,38 @@ #!/bin/bash -# This script generates the input file used by the Python script. -# Replace the following lines with the actual commands to generate the input file. +# parse arguments +while [[ $# -gt 0 ]]; do + case $1 in + -t|--timestamp) + timestamp="$2" + shift # past argument + shift # past value + ;; + *) + # Ignore unknown options + ;; + esac +done -#echo "| ANTI-REGRESSION.BC-COMP.01 | PASS |(https://example.com/test-report) | (assertEqualToResult (add-atom &kb (: axiom (nums 2 3)))) | (()) | (()) |" > /tmp/SHARED.UNITS -cat ./reports/SHARED.UNITS.PREV.md > /tmp/SHARED.UNITS -# You can add more lines or commands to generate additional input data +# generate the output directory with timestamp +if [ -z $timestamp ]; then + timestamp=$(date +"%Y-%m-%dT%H:%M:%S") +fi +output=./reports/tests_output/baseline-compat-$timestamp/ + +# run the tests +mkdir -p $output +export METTALOG_OUTPUT=$(realpath $output) +export SHARED_UNITS=$METTALOG_OUTPUT/SHARED.UNITS +touch $SHARED_UNITS +echo Running baseline_compat tests to $output with METTALOG_OUTPUT=$METTALOG_OUTPUT and SHARED_UNITS=$SHARED_UNITS +#cat ./reports/SHARED.UNITS.PREV.md > /tmp/SHARED.UNITS +cat /dev/null > /tmp/SHARED.UNITS +#mettalog --output=$output --test --clean tests/baseline_compat/anti-regression/comma_is_not_special.metta +mettalog --test --clean --output=$output tests/baseline_compat/module-system/ +# Stuff just generated +cat $SHARED_UNITS >> /tmp/SHARED.UNITS +# Tests ran locally by developer (temporary to see what a nightly with 1000+ tests looks like) +cat ./reports/SHARED.UNITS.PREV.md >> /tmp/SHARED.UNITS +# together +cat /tmp/SHARED.UNITS diff --git a/scripts/run_nightly_tests.sh b/scripts/run_nightly_tests.sh new file mode 100755 index 00000000000..0744fcdd23f --- /dev/null +++ b/scripts/run_nightly_tests.sh @@ -0,0 +1,136 @@ +#!/bin/bash + +# Initialize the array for rest of the arguments +rest_of_args=() + +# parse arguments +while [[ $# -gt 0 ]]; do + case $1 in + -t|--timestamp) + timestamp="$2" + shift # past argument + shift # past value + ;; + --clean) + clean=true + shift # past argument + ;; + *) + rest_of_args+=("$1") # store rest of arguments + shift + ;; + esac +done + +# Generate the output directory with timestamp +if [ -z "$timestamp" ]; then + timestamp=$(date +"%Y-%m-%d") +fi +output=./reports/BY_DATE/$timestamp +export METTALOG_OUTPUT=$(realpath $output) +export SHARED_UNITS=$METTALOG_OUTPUT/SHARED.UNITS + +mkdir -p $output +touch $SHARED_UNITS + +echo "Running nightly tests to $output ($METTALOG_OUTPUT) with SHARED_UNITS=$SHARED_UNITS" + +source ./scripts/ensure_venv + +# Check if 'ansi2html' is already installed +if ! python3 -m pip list | grep -q 'ansi2html'; then + # Install 'ansi2html' if it is not installed + python3 -m pip install ansi2html +fi + +# This function runs MettaLog tests with configurable output suppression +run_mettalog_tests() { + local max_time_per_test="$1" + local test_dir="$2" + shift 2 # Shift the first two arguments so the rest can be captured as additional arguments + local args=("$@") + local status=666 + + # Construct the command using an array to handle spaces and special characters properly + local cmd=(mettalog --output="$output" --test --timeout=$max_time_per_test "$test_dir") + cmd+=("${args[@]}") + cmd+=("${rest_of_args[@]}") + + # Optionally remove --clean from subsequent runs + if [ "$clean" == true ]; then + cmd+=("--clean") + clean=false # Reset or remove the clean option after using it + fi + + local SHOW_ALL_OUTPUT=true # Set to false normally, true for debugging + + if [ "$SHOW_ALL_OUTPUT" ]; then + # Execute the command and capture the status + "${cmd[@]}" + local status=$? + else + # Execute the command silently and filter output, capturing status + script -q -c "${cmd[*]}" /dev/null | tee >(grep -Ei --line-buffered '_CMD:|es[:] ' >&2) > /dev/null + local status=$? + fi + + if [ $status -eq 4 ]; then + echo "Something purposely interupted testing... results will not be written!" + # exit $status # exit this script + fi + + return $status +} + + +# Actual test calls and logic to manage test conditions +SKIP_LONG=0 + +# Construct the TEST_CMD string +#TEST_CMD="mettalog --output=$METTALOG_OUTPUT --timeout=$METTALOG_MAX_TIME --html --repl=false ${extra_args[*]} ${passed_along_to_mettalog[*]} \"$file\" --halt=true" + +# Call the function with the constructed command and other variables +#IF_REALLY_DO return run_single_timed_unit "$TEST_CMD" "$file_html" "$file" "Under $METTALOG_MAX_TIME seconds" + +# 23+ tests (~30 seconds) +run_mettalog_tests 40 tests/baseline_compat/module-system/ + +# 200+ tests (~4 minutes) +run_mettalog_tests 40 tests/baseline_compat/hyperon-experimental_scripts/ +run_mettalog_tests 40 tests/baseline_compat/hyperon-mettalog_sanity/ + +# 50+ tests (~2 minutes) +run_mettalog_tests 40 tests/baseline_compat/metta-morph_tests/ + +# Check if SKIP_LONG is not set to 1 +if [ "$SKIP_LONG" != "1" ]; then + + # 50+ tests (~2 minutes) + run_mettalog_tests 40 tests/baseline_compat/anti-regression/ + + # 400+ tests (~7 minutes) + run_mettalog_tests 40 tests/baseline_compat/ + + + run_mettalog_tests 40 tests/nars_interp/ + + run_mettalog_tests 40 tests/more-anti-regression/ + + run_mettalog_tests 40 tests/extended_compat/metta-examples/ + run_mettalog_tests 40 tests/extended_compat/ + + run_mettalog_tests 40 tests/direct_comp/ + run_mettalog_tests 40 tests/features/ + run_mettalog_tests 40 tests/performance/ + + # compiler based tests + #run_mettalog_tests 40 tests/compiler_baseline/ + #run_mettalog_tests 40 tests/nars_w_comp/ + # run_mettalog_tests 40 tests/python_compat/ +fi + +cat $SHARED_UNITS > /tmp/SHARED.UNITS + +# if ran locally on our systme we might want to commit these +cat /tmp/SHARED.UNITS > ./reports/SHARED.UNITS.PREV.md + diff --git a/scripts/test_in_metta.sh b/scripts/test_in_metta.sh index 8c58d7015cd..75fb189a4b3 100755 --- a/scripts/test_in_metta.sh +++ b/scripts/test_in_metta.sh @@ -1,7 +1,6 @@ #!/bin/bash SHOULD_EXIT=0 -SHARED_UNITS=/tmp/SHARED.UNITS DEBUG_WHY() { DEBUG "${GREEN}WHY: ${BOLD}${*}${NC}" @@ -15,6 +14,11 @@ process_file() { #local file=$(find_override_file "$1") local file="$1" + # Check if the file path contains a tilde + if [[ "$file" == *"~"* ]]; then + return 7 + fi + local absfile=$(readlink -f "$file") local extra_args="${@:2}" @@ -22,6 +26,8 @@ process_file() { export file_html="${METTALOG_OUTPUT}/${file}.html" + export METTALOG_OUTPUT="${METTALOG_OUTPUT}" + export HTML_OUT="${file}.html" DEBUG "===========================================================================" @@ -31,6 +37,10 @@ process_file() { DEBUG "Testing: $file" cd "$METTALOG_DIR" DEBUG "Output: $file_html" + # Check if the file path contains a tilde + if [[ "$absfile" == *"~"* ]]; then + DEBUG "${RED}Warn on tilda'd path?${NC}" + fi DEBUG "" DEBUG "" DEBUG "${BLUE}${BOLD}===========================================================================${NC}" @@ -156,20 +166,76 @@ process_file() { TEST_CMD="./mettalog '--output=$METTALOG_OUTPUT' --timeout=$METTALOG_MAX_TIME --html --repl=false ${extra_args[@]} ${passed_along_to_mettalog[@]} \"$file\" --halt=true" # DEBUG "${BOLD}$TEST_CMD${NC}" - IF_REALLY_DO "$TEST_CMD" - TEST_EXIT_CODE=$? + + EXTRA_INFO="Under $METTALOG_MAX_TIME seconds" + + # Start the timer + local START_TIME=$(date +%s) + + # Run the test command using eval to handle the single string properly + IF_REALLY_DO eval "$TEST_CMD" + local TEST_EXIT_CODE=$? + + # Stop the timer and calculate elapsed time + local END_TIME=$(date +%s) + local ELAPSED_TIME=$((END_TIME - START_TIME)) + + # Determine the test status based on the exit code + local DEBUG_MESSAGE + local PASS_OR_FAIL + local SHOULD_DELETE_HTML=0 if [ $TEST_EXIT_CODE -eq 124 ]; then - DEBUG "${RED}Killed (definitely due to timeout) (EXITCODE=$TEST_EXIT_CODE) after $METTALOG_MAX_TIME seconds: ${TEST_CMD}${NC}" - IF_REALLY_DO [ "$if_failures" -eq 1 ] && rm -f "$file_html" - elif [[ $TEST_EXIT_CODE -eq 4 ]] || [[ $TEST_EXIT_CODE -eq 134 ]]; then - DEBUG "${RED}Stopping tests (EXITCODE=$TEST_EXIT_CODE) under $METTALOG_MAX_TIME seconds: ${TEST_CMD}${NC}" - SHOULD_EXIT=1 + DEBUG_MESSAGE="${RED}Killed (definitely due to timeout) (EXITCODE=$TEST_EXIT_CODE) after $EXTRA_INFO seconds: $TEST_CMD${NC}" + [ "$if_failures" -eq 1 ] && SHOULD_DELETE_HTML=1 + PASS_OR_FAIL="FAIL" + elif [ $TEST_EXIT_CODE -eq 134 ]; then + DEBUG_MESSAGE="${RED}Test aborted by user (EXITCODE=$TEST_EXIT_CODE) $EXTRA_INFO: $TEST_CMD${NC}" + SHOULD_DELETE_HTML=1 + PASS_OR_FAIL="FAIL" + elif [ $TEST_EXIT_CODE -eq 4 ]; then + DEBUG_MESSAGE="${RED}Stopping tests (EXITCODE=$TEST_EXIT_CODE) $EXTRA_INFO: $TEST_CMD${NC}" + SHOULD_DELETE_HTML=1 + PASS_OR_FAIL="FAIL" + exit 4 elif [ $TEST_EXIT_CODE -ne 7 ]; then - DEBUG "${YELLOW}Completed (EXITCODE=$TEST_EXIT_CODE) under $METTALOG_MAX_TIME seconds: ${TEST_CMD}${NC}" + DEBUG_MESSAGE="${YELLOW}Completed (EXITCODE=$TEST_EXIT_CODE) $EXTRA_INFO: $TEST_CMD${NC}" + PASS_OR_FAIL="FAIL" else - DEBUG "${GREEN}Completed successfully (EXITCODE=$TEST_EXIT_CODE) under $METTALOG_MAX_TIME seconds: ${TEST_CMD}${NC}" + DEBUG_MESSAGE="${GREEN}Completed successfully (EXITCODE=$TEST_EXIT_CODE) $EXTRA_INFO: $TEST_CMD${NC}" + PASS_OR_FAIL="PASS" fi + + # Generate the test name in the format WHOLE-TESTS.ParentDirectory.File + local PARENT_DIR=$(basename "$(dirname "$file")") + local BASE_FILE=$(basename "$file" .metta) # Replace .metta with the correct file extension + local TEST_NAME="WHOLE-TESTS.$PARENT_DIR.$BASE_FILE" + + # Generate the HTML link + local HTML_LINK="file://$file_html#${TEST_NAME}" + + # Determine if the HTML file should be used as the logfile or a separate .log file should be created + local LOGFILE + if [ $SHOULD_DELETE_HTML -eq 1 ]; then + # Create a separate .log file since the HTML file is planned for deletion + LOGFILE="${file_html}.log" + cp "$file_html" "$LOGFILE" + else + # Use the HTML file as the logfile since it won't be deleted + LOGFILE="$file_html" + fi + + # Redirect debug messages to both the logfile and console + echo "$DEBUG_MESSAGE" | tee -a "$LOGFILE" + + # Write the line to "$SHARED_UNITS" + echo "| $TEST_NAME | $PASS_OR_FAIL | [$TEST_NAME]($HTML_LINK) | $TEST_CMD | $TEST_EXIT_CODE | 7 | $ELAPSED_TIME | $LOGFILE |" >> "${SHARED_UNITS}" + + # Delete the HTML file if it was planned for deletion + if [ $SHOULD_DELETE_HTML -eq 1 ]; then + rm -f "$file_html" + fi + return $TEST_EXIT_CODE #set -e fi @@ -184,12 +250,12 @@ IS_SOURCED=$( [[ "${BASH_SOURCE[0]}" != "${0}" ]] && echo 1 || echo 0) METTALOG_DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" && cd .. && pwd )" passed_along_to_mettalog=() -METTALOG_MAX_TIME=75 +METTALOG_MAX_TIME=45 SCRIPT_NAME=$(basename "$0") run_tests_auto_reply="" generate_report_auto_reply="" -METTALOG_OUTPUT="tests_output/testrun_$(date +%Y%m%d_%H%M%S)" +METTALOG_OUTPUT="reports/tests_output/testrun_$(date +%Y%m%d_%H%M%S)" fresh=0 clean=0 # 0 means don't clean, 1 means do clean if_failures=0 @@ -431,12 +497,13 @@ generate_final_MeTTaLog() { # Change to the script directory cd "$METTALOG_DIR" || exit 1 - python3 ./scripts/into_junit.py "${SHARED_UNITS}" > "$METTALOG_OUTPUT/junit.xml" - - junit2html "$METTALOG_OUTPUT/junit.xml" - junit2html "$METTALOG_OUTPUT/junit.xml" --summary-matrix - echo "saved to $METTALOG_OUTPUT/junit.xml.html" + if [ 1 -eq 0 ]; then + python3 ./scripts/into_junit.py "${SHARED_UNITS}" > "$METTALOG_OUTPUT/junit.xml" + junit2html "$METTALOG_OUTPUT/junit.xml" + junit2html "$METTALOG_OUTPUT/junit.xml" --summary-matrix + echo "saved to $METTALOG_OUTPUT/junit.xml.html" + fi # Calculate the number of passed and failed tests passed=$(grep -c "| PASS |" "${SHARED_UNITS}") @@ -615,7 +682,7 @@ while [ "$#" -gt 0 ]; do shift done -python3 -m pip install ansi2html +source ./scripts/ensure_venv extract_all_parent_directories @@ -637,6 +704,13 @@ if [ $show_help -eq 1 ]; then show_help fi +if [ -z "$SHARED_UNITS" ]; then + if [ -d "$METTALOG_OUTPUT" ]; then + export SHARED_UNITS=$(realpath $METTALOG_OUTPUT)/SHARED.UNITS + fi +fi +touch $SHARED_UNITS + # Delete HTML files if the clean flag is set if [ $clean -eq 1 ]; then delete_html_files @@ -661,9 +735,11 @@ INTERP_SRC_DIR="$(realpath "${INTERP_SRC_DIR}")" DEBUG "INTERP_SRC_DIR=$INTERP_SRC_DIR" DEBUG "METTALOG_OUTPUT=$METTALOG_OUTPUT" +DEBUG "SHARED_UNITS=$SHARED_UNITS" if [[ ! -f "${METTALOG_OUTPUT}/src/" ]]; then - cat /dev/null > "${SHARED_UNITS}" + : + #cat /dev/null > "${SHARED_UNITS}" fi mkdir -p "${METTALOG_OUTPUT}/src/"