From 6e7adb72ed158f0ae28cc0aea1228e83801f1717 Mon Sep 17 00:00:00 2001 From: rmgaray Date: Thu, 2 Apr 2026 19:21:17 +0000 Subject: [PATCH 1/7] refactor PeTTa to work as a compiler --- src/filereader.pl | 92 ++++++++++++++++++++++++++++++----------------- src/main.pl | 62 +++++++++++++++++++++++++++----- 2 files changed, 113 insertions(+), 41 deletions(-) diff --git a/src/filereader.pl b/src/filereader.pl index 57b04320..6a10a98f 100644 --- a/src/filereader.pl +++ b/src/filereader.pl @@ -1,21 +1,23 @@ :- use_module(library(readutil)). % read_file_to_string/3 :- use_module(library(pcre)). % re_replace/4 -:- current_prolog_flag(argv, Args), ( (memberchk(silent, Args) ; memberchk('--silent', Args) ; memberchk('-s', Args)) - -> assertz(silent(true)) ; assertz(silent(false)) ). -%Read Filename into string S and process it (S holds MeTTa code): -load_metta_file(Filename, Results) :- load_metta_file(Filename, Results, '&self'). -load_metta_file(Filename, Results, Space) :- read_file_to_string(Filename, S, []), - process_metta_string(S, Results, Space). +% Read Filename into string S and process it (S holds MeTTa code): +% Execution results are stored in Results, while compiled Prolog output is +% placed in Output. +load_metta_file(Filename, Results, Output) :- load_metta_file(Filename, Results, Output, '&self'). +load_metta_file(Filename, Results, Output, Space) :- read_file_to_string(Filename, S, []), + process_metta_string(S, Results, Output, Space). %Extract function definitions, call invocations, and S-expressions part of &self space: -process_metta_string(S, Results) :- process_metta_string(S, Results, '&self'). -process_metta_string(S, Results, Space) :- string_codes(S, Cs), - strip(Cs, 0, Codes), - phrase(top_forms(Forms, 1), Codes), - maplist(parse_form, Forms, ParsedForms), - maplist(process_form(Space), ParsedForms, ResultsList), !, - append(ResultsList, Results). +process_metta_string(S, Results, Output) :- process_metta_string(S, Results, Output, '&self'). +process_metta_string(S, Results, Output, Space) :- + string_codes(S, Cs), + strip(Cs, 0, Codes), + phrase(top_forms(Forms, 1), Codes), + maplist(parse_form, Forms, ParsedForms), + maplist(process_form(Space), ParsedForms, ResultsList, OutputsList), !, + append(ResultsList, Results), + atomic_list_concat(OutputsList, Output). %First pass to convert MeTTa to Prolog Terms and register functions: parse_form(form(S), parsed(T, S, Term)) :- sread(S, Term), @@ -24,25 +26,51 @@ parse_form(runnable(S), parsed(runnable, S, Term)) :- sread(S, Term). %Second pass to compile / run / add the Terms: -process_form(Space, parsed(expression, _, Term), []) :- 'add-atom'(Space, Term, true), - ( silent(true) -> true ; swrite(Term,STerm), - format("\e[33m--> metta sexpr -->~n\e[36m~w~n", [STerm]), - format("\e[33m^^^^^^^^^^^^^^^^^^^~n\e[0m") ). -process_form(_, parsed(runnable, FormStr, Term), Result) :- translate_expr([collapse, Term], Goals, Result), - ( silent(true) -> true ; format("\e[33m--> metta runnable -->~n\e[36m!~w~n\e[33m--> prolog goal -->\e[35m ~n", [FormStr]), - forall(member(G, Goals), portray_clause((:- G))), - format("\e[33m^^^^^^^^^^^^^^^^^^^^^^^~n\e[0m") ), - call_goals(Goals). -process_form(Space, parsed(function, FormStr, Term), []) :- add_sexp(Space, Term), - translate_clause(Term, Clause), - assertz(Clause, Ref), - assertz(translated_from(Ref, Term)), - ( silent(true) -> true ; format("\e[33m--> metta function -->~n\e[36m~w~n\e[33m--> prolog clause -->~n\e[32m", [FormStr]), - clause(Head, Body, Ref), - ( Body == true -> Show = Head; Show = (Head :- Body) ), - portray_clause(current_output, Show), - format("\e[33m^^^^^^^^^^^^^^^^^^^^^^~n\e[0m") ). -process_form(_, In, _) :- format(atom(Msg), "failed to process form: ~w", [In]), throw(error(syntax_error(Msg), none)). +process_form(Space, parsed(expression, _, Term), [], Output) :- + ( silent(false) -> + swrite(Term, STerm), + format("\e[33m--> metta sexpr -->~n\e[36m~w~n", [STerm]), + format("\e[33m^^^^^^^^^^^^^^^^^^^~n\e[0m") + ; true), + ( execute(true) -> + 'add-atom'(Space, Term, true) + ; true), + with_output_to(string(Output), portray_clause('add-atom'(Space, Term, true))). + +process_form(_, parsed(runnable, FormStr, Term), Result, Output) :- + translate_expr([collapse, Term], Goals, Result), + ( silent(false) -> + format("\e[33m--> metta runnable -->~n\e[36m!~w~n\e[33m--> prolog goal -->\e[35m ~n", [FormStr]), + forall(member(G, Goals), portray_clause((:- G))), + format("\e[33m^^^^^^^^^^^^^^^^^^^^^^^~n\e[0m") + ; true), + ( execute(true) -> + call_goals(Goals) + ; Result = []), + findall( + GoalOutput, + (member(G, Goals), with_output_to(string(GoalOutput), portray_clause((:- G)))), + GoalOutputs), + atomic_list_concat(GoalOutputs, Output). + +process_form(Space, parsed(function, FormStr, Term), [], Output) :- + translate_clause(Term, Clause), + assertz(Clause, Ref), + assertz(translated_from(Ref, Term)), + clause(Head, Body, Ref), + ( Body == true -> Show = Head; Show = (Head :- Body) ), + with_output_to(string(Output), portray_clause(Show)), + ( silent(false) -> + format("\e[33m--> metta function -->~n\e[36m~w~n\e[33m--> prolog clause -->~n\e[32m", [FormStr]), + write(current_output, Output), + format("\e[33m^^^^^^^^^^^^^^^^^^^^^^~n\e[0m") + ; true), + ( execute(true) -> + add_sexp(Space, Term) + ; true + ). + +process_form(_, In, _, _) :- format(atom(Msg), "failed to process form: ~w", [In]), throw(error(syntax_error(Msg), none)). %Like blanks but counts newlines: newlines(C0, C2) --> blanks_to_nl, !, {C1 is C0+1}, newlines(C1,C2). diff --git a/src/main.pl b/src/main.pl index 741118a6..87e198f0 100644 --- a/src/main.pl +++ b/src/main.pl @@ -1,4 +1,22 @@ :- ensure_loaded(metta). +:- use_module(library(optparse)). +:- use_module(library(option)). + +options_spec( + [ [opt(mode), meta(mode), type(atom), default('COMPILER'), + shortflags([m]), longflags(['mode']), + help(['The operation mode of the PeTTa compiler:' + ,' COMPILER: Output only the compiled Prolog clauses, ignoring any runnables.' + ,' INTERPRETER: Interpret the provided MeTTa program and print the result of all runnables.' + ,' TEST_INTEROP: Run the Prolog interop example' + ,' TEST_MORK: Run the Mork test'])] + , [opt(silent_opt), type(atom), default(true), + shortflags([s]), longflags(['silent']), + help(['Whether to print each MeTTa form as it is parsed, followed by its Prolog translation.'])] + , [opt(output_file), meta(file), type(atom), default('NADA'), + shortflags([o]), longflags(['output']), + help(['Where to store the compiled MeTTa code'])] + ]). prologfunc(X,Y) :- Y is X+1. @@ -8,16 +26,42 @@ mettafunc(30, R), format("mettafunc(30) = ~w~n", [R]). +% Globals: +% * silent(true|false): Whether to print each MeTTa form as it is parsed, followed by its Prolog translation. +% * execute(true|false): Whether to execute any runnables parsed in the MeTTa program. main :- current_prolog_flag(argv, Args), - ( Args = [] -> prolog_interop_example - ; Args = [mork] -> prolog_interop_example, - mork_test - ; Args = [File|_] -> file_directory_name(File, Dir), - assertz(working_dir(Dir)), - load_metta_file(File,Results), - maplist(swrite,Results,ResultsR), - maplist(format("~w~n"), ResultsR) - ), + options_spec(Spec), + opt_parse(Spec, Args, Opts, PositionalArgs), + option(mode(Mode), Opts), + option(silent_opt(Silent), Opts), + assertz(silent(Silent)), + % format("Options: ~w~n", Opts), + % format("PositionalArgs: ~w~n", PositionalArgs), + (Mode = 'TEST_INTEROP' -> + prolog_interop_example + ; (Mode = 'TEST_MORK') -> + prolog_interop_example, + mork_test + ; ([] = PositionalArgs) -> + format("Expected at least 1 positional argument with the MeTTa program to read.~n") + ; (Mode = 'INTERPRETER', [File|_] = PositionalArgs) -> + file_directory_name(File, Dir), + assertz(working_dir(Dir)), + assertz(execute(true)), + load_metta_file(File,Results, _), + maplist(swrite,Results,ResultsR), + maplist(format("~w~n"), ResultsR) + ; (Mode = 'COMPILER', [File|_] = PositionalArgs) -> + option(output_file(OutputFile), Opts), + file_directory_name(File, Dir), + assertz(working_dir(Dir)), + assertz(execute(false)), + load_metta_file(File,_, Output), + ( OutputFile = 'NADA' -> + write(current_output, Output) + ; open(OutputFile, write, OutputFd), + write(OutputFd, Output) + )), halt. :- initialization(main, main). From 4af127b06fc1afe4d095553f636e17c3b97add72 Mon Sep 17 00:00:00 2001 From: rmgaray Date: Fri, 3 Apr 2026 10:48:54 +0000 Subject: [PATCH 2/7] update run.sh to use new CLI --- run.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/run.sh b/run.sh index f4a76d20..6ed3efdd 100755 --- a/run.sh +++ b/run.sh @@ -3,5 +3,5 @@ if [ -f $SCRIPT_DIR/mork_ffi/target/release/libmork_ffi.so ]; then LD_PRELOAD=$SCRIPT_DIR/mork_ffi/target/release/libmork_ffi.so \ swipl --stack_limit=8g -q -s $SCRIPT_DIR/src/main.pl -- "$@" mork else - swipl --stack_limit=8g -q -s $SCRIPT_DIR/src/main.pl -- "$@" + swipl --stack_limit=8g -q -s $SCRIPT_DIR/src/main.pl -- --silent=false --mode=INTERPRETER "$@" fi From e9d7aa08cd350c6985502108647c71e37ebba9df Mon Sep 17 00:00:00 2001 From: rmgaray Date: Fri, 3 Apr 2026 14:25:42 +0000 Subject: [PATCH 3/7] refactor: move compilation to compile_metta* functions --- src/filereader.pl | 57 ++++++++++++++++++++++++++++++----------------- src/main.pl | 7 ++---- 2 files changed, 39 insertions(+), 25 deletions(-) diff --git a/src/filereader.pl b/src/filereader.pl index 6a10a98f..a5916505 100644 --- a/src/filereader.pl +++ b/src/filereader.pl @@ -1,23 +1,39 @@ :- use_module(library(readutil)). % read_file_to_string/3 :- use_module(library(pcre)). % re_replace/4 -% Read Filename into string S and process it (S holds MeTTa code): -% Execution results are stored in Results, while compiled Prolog output is -% placed in Output. -load_metta_file(Filename, Results, Output) :- load_metta_file(Filename, Results, Output, '&self'). -load_metta_file(Filename, Results, Output, Space) :- read_file_to_string(Filename, S, []), - process_metta_string(S, Results, Output, Space). +% Read Filename into string S and compile it to Prolog (S holds MeTTa code) +compile_metta_file(Filename, Output) :- compile_metta_file(Filename, Output, '&self'). +compile_metta_file(Filename, Output, Space) :- + read_file_to_string(Filename, S, []), + compile_metta_string(S, Output, Space). + +% Read Filename into string S and process it: +load_metta_file(Filename, Results) :- load_metta_file(Filename, Results, '&self'). +load_metta_file(Filename, Results, Space) :- + read_file_to_string(Filename, S, []), + process_metta_string(S, Results, Space). + +% Compile function definitions, invocations and S-expression part of &self space +compile_metta_string(S, Output) :- compile_metta_string(S, Output, '&self'). +compile_metta_string(S, Output, Space) :- + extract_forms(S, Forms), + maplist(parse_form, Forms, ParsedForms), + maplist(process_form(false, Space), ParsedForms, _, OutputsList), !, + atomic_list_concat(OutputsList, Output). %Extract function definitions, call invocations, and S-expressions part of &self space: -process_metta_string(S, Results, Output) :- process_metta_string(S, Results, Output, '&self'). -process_metta_string(S, Results, Output, Space) :- +process_metta_string(S, Results) :- process_metta_string(S, Results, '&self'). +process_metta_string(S, Results, Space) :- + extract_forms(S, Forms), + maplist(parse_form, Forms, ParsedForms), + maplist(process_form(true, Space), ParsedForms, ResultsList, _), !, + append(ResultsList, Results). + +% Extract top forms from MeTTa string +extract_forms(S, Forms) :- string_codes(S, Cs), strip(Cs, 0, Codes), - phrase(top_forms(Forms, 1), Codes), - maplist(parse_form, Forms, ParsedForms), - maplist(process_form(Space), ParsedForms, ResultsList, OutputsList), !, - append(ResultsList, Results), - atomic_list_concat(OutputsList, Output). + phrase(top_forms(Forms, 1), Codes). %First pass to convert MeTTa to Prolog Terms and register functions: parse_form(form(S), parsed(T, S, Term)) :- sread(S, Term), @@ -25,26 +41,27 @@ ; T=expression ). parse_form(runnable(S), parsed(runnable, S, Term)) :- sread(S, Term). -%Second pass to compile / run / add the Terms: -process_form(Space, parsed(expression, _, Term), [], Output) :- +% Second pass to compile / run / add the Terms. If Execute = true, we run the goals and +% return them in Results (otherwise, we just return the compilation result in Output): +process_form(Execute, Space, parsed(expression, _, Term), [], Output) :- ( silent(false) -> swrite(Term, STerm), format("\e[33m--> metta sexpr -->~n\e[36m~w~n", [STerm]), format("\e[33m^^^^^^^^^^^^^^^^^^^~n\e[0m") ; true), - ( execute(true) -> + ( Execute -> 'add-atom'(Space, Term, true) ; true), with_output_to(string(Output), portray_clause('add-atom'(Space, Term, true))). -process_form(_, parsed(runnable, FormStr, Term), Result, Output) :- +process_form(Execute, _, parsed(runnable, FormStr, Term), Result, Output) :- translate_expr([collapse, Term], Goals, Result), ( silent(false) -> format("\e[33m--> metta runnable -->~n\e[36m!~w~n\e[33m--> prolog goal -->\e[35m ~n", [FormStr]), forall(member(G, Goals), portray_clause((:- G))), format("\e[33m^^^^^^^^^^^^^^^^^^^^^^^~n\e[0m") ; true), - ( execute(true) -> + ( Execute -> call_goals(Goals) ; Result = []), findall( @@ -53,7 +70,7 @@ GoalOutputs), atomic_list_concat(GoalOutputs, Output). -process_form(Space, parsed(function, FormStr, Term), [], Output) :- +process_form(Execute, Space, parsed(function, FormStr, Term), [], Output) :- translate_clause(Term, Clause), assertz(Clause, Ref), assertz(translated_from(Ref, Term)), @@ -65,7 +82,7 @@ write(current_output, Output), format("\e[33m^^^^^^^^^^^^^^^^^^^^^^~n\e[0m") ; true), - ( execute(true) -> + ( Execute -> add_sexp(Space, Term) ; true ). diff --git a/src/main.pl b/src/main.pl index 87e198f0..449c18e6 100644 --- a/src/main.pl +++ b/src/main.pl @@ -28,7 +28,6 @@ % Globals: % * silent(true|false): Whether to print each MeTTa form as it is parsed, followed by its Prolog translation. -% * execute(true|false): Whether to execute any runnables parsed in the MeTTa program. main :- current_prolog_flag(argv, Args), options_spec(Spec), opt_parse(Spec, Args, Opts, PositionalArgs), @@ -47,16 +46,14 @@ ; (Mode = 'INTERPRETER', [File|_] = PositionalArgs) -> file_directory_name(File, Dir), assertz(working_dir(Dir)), - assertz(execute(true)), - load_metta_file(File,Results, _), + load_metta_file(File,Results), maplist(swrite,Results,ResultsR), maplist(format("~w~n"), ResultsR) ; (Mode = 'COMPILER', [File|_] = PositionalArgs) -> option(output_file(OutputFile), Opts), file_directory_name(File, Dir), assertz(working_dir(Dir)), - assertz(execute(false)), - load_metta_file(File,_, Output), + compile_metta_file(File,Output), ( OutputFile = 'NADA' -> write(current_output, Output) ; open(OutputFile, write, OutputFd), From aaa6cbc09afa3cf2552c225fe23daf9f8efa0c36 Mon Sep 17 00:00:00 2001 From: rmgaray Date: Tue, 7 Apr 2026 20:53:07 +0000 Subject: [PATCH 4/7] fix: missing directive symbol --- src/filereader.pl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/filereader.pl b/src/filereader.pl index a5916505..bb1de5c8 100644 --- a/src/filereader.pl +++ b/src/filereader.pl @@ -52,7 +52,7 @@ ( Execute -> 'add-atom'(Space, Term, true) ; true), - with_output_to(string(Output), portray_clause('add-atom'(Space, Term, true))). + with_output_to(string(Output), portray_clause(:- 'add-atom'(Space, Term, true))). process_form(Execute, _, parsed(runnable, FormStr, Term), Result, Output) :- translate_expr([collapse, Term], Goals, Result), From ba8e65c32a766117cb156e7fc68b7ab89864b638 Mon Sep 17 00:00:00 2001 From: rmgaray Date: Wed, 8 Apr 2026 20:54:40 +0000 Subject: [PATCH 5/7] include printing instructions for runnables when compiling --- src/filereader.pl | 37 ++++++++++++------ src/translator.pl | 96 ++++++++++++++++++++++++++--------------------- 2 files changed, 79 insertions(+), 54 deletions(-) diff --git a/src/filereader.pl b/src/filereader.pl index bb1de5c8..2e3b3021 100644 --- a/src/filereader.pl +++ b/src/filereader.pl @@ -18,7 +18,16 @@ compile_metta_string(S, Output, Space) :- extract_forms(S, Forms), maplist(parse_form, Forms, ParsedForms), - maplist(process_form(false, Space), ParsedForms, _, OutputsList), !, + maplist(process_form(false, Space), ParsedForms, _, CompiledForms), !, + Prologue = [ + ':- ensure_loaded(\'src/metta\').\n', + ':- use_module(library(memfile)).\n', + ':- new_memory_file(MF), open_memory_file(MF, write, ResultsStream), assertz(resultsMemFile(MF)), assertz(resultsStream(ResultsStream)).\n', + 'write_result(Result) :- resultsStream(ResultsStream), format(ResultsStream, "~w~n", [Result]).\n'], + Epilogue = [ + ':- resultsStream(S), close(S), resultsMemFile(MF), memory_file_to_string(MF, ResultsOutput), write(ResultsOutput), free_memory_file(MF).\n' + ], + append([Prologue, CompiledForms, Epilogue], OutputsList), atomic_list_concat(OutputsList, Output). %Extract function definitions, call invocations, and S-expressions part of &self space: @@ -41,8 +50,10 @@ ; T=expression ). parse_form(runnable(S), parsed(runnable, S, Term)) :- sread(S, Term). -% Second pass to compile / run / add the Terms. If Execute = true, we run the goals and -% return them in Results (otherwise, we just return the compilation result in Output): +% Second pass to compile / run / add the Terms. +% Output will always contain the compilation output as a result. +% If Execute = true, the goals are run and return in Results. +% If Execute = false, no goals are run and Results = []. process_form(Execute, Space, parsed(expression, _, Term), [], Output) :- ( silent(false) -> swrite(Term, STerm), @@ -55,20 +66,24 @@ with_output_to(string(Output), portray_clause(:- 'add-atom'(Space, Term, true))). process_form(Execute, _, parsed(runnable, FormStr, Term), Result, Output) :- - translate_expr([collapse, Term], Goals, Result), - ( silent(false) -> - format("\e[33m--> metta runnable -->~n\e[36m!~w~n\e[33m--> prolog goal -->\e[35m ~n", [FormStr]), - forall(member(G, Goals), portray_clause((:- G))), - format("\e[33m^^^^^^^^^^^^^^^^^^^^^^^~n\e[0m") - ; true), + translate_expr([collapse, Term], true, true, Goals, Result), + % Conditional goal execution ( Execute -> call_goals(Goals) - ; Result = []), + ; true), + % We generate all goals and print them to Output. findall( GoalOutput, (member(G, Goals), with_output_to(string(GoalOutput), portray_clause((:- G)))), GoalOutputs), - atomic_list_concat(GoalOutputs, Output). + + atomic_list_concat(GoalOutputs, Output), + % We must print to the console at the end, in case the goals were actually called. + ( silent(false) -> + format("\e[33m--> metta runnable -->~n\e[36m!~w~n\e[33m--> prolog goal -->\e[35m ~n", [FormStr]), + forall(member(G, Goals), portray_clause((:- G))), + format("\e[33m^^^^^^^^^^^^^^^^^^^^^^^~n\e[0m") + ; true). process_form(Execute, Space, parsed(function, FormStr, Term), [], Output) :- translate_clause(Term, Clause), diff --git a/src/translator.pl b/src/translator.pl index 4e1985f9..5959d623 100644 --- a/src/translator.pl +++ b/src/translator.pl @@ -8,7 +8,7 @@ append(G1, G2, Goals), !. constrain_args([F|Args], Var, Goals) :- atom(F), fun(F), !, - translate_expr([F|Args], GoalsExpr, Var), + translate_expr([F|Args], false, false, GoalsExpr, Var), flatten(GoalsExpr, Goals). constrain_args(In, Out, Goals) :- maplist(constrain_args, In, Out, NestedGoalsList), flatten(NestedGoalsList, Goals), !. @@ -22,7 +22,7 @@ ; Args1 = Args0, GoalsPrefix = [] ), catch(nb_getval(F, Prev), _, Prev = []), nb_setval(F, [fun_meta(Args1, BodyExpr) | Prev]), - translate_expr(BodyExpr, GoalsBody, ExpOut), + translate_expr(BodyExpr, false, false, GoalsBody, ExpOut), ( nonvar(ExpOut) , ExpOut = partial(Base,Bound) -> current_predicate(Base/Arity), length(Bound, N), M is (Arity - N) - 1, length(ExtraArgs, M), append([Bound,ExtraArgs,[Out]],CallArgs), Goal =.. [Base|CallArgs], @@ -67,7 +67,7 @@ agg_reduce(AF, Acc, Val, NewAcc) :- reduce([AF, Acc, Val], NewAcc). %Combined expr translation to goals list -translate_expr_to_conj(Input, Conj, Out) :- translate_expr(Input, Goals, Out), +translate_expr_to_conj(Input, Conj, Out) :- translate_expr(Input, false, false, Goals, Out), goals_list_to_conj(Goals, Conj). %Special stream operation rewrite rules before main translation @@ -90,32 +90,39 @@ safe_rewrite_streamops(In, Out) :- ( compound(In), In = [Op|_], atom(Op) -> rewrite_streamops(In, Out) ; Out = In). +% Wrapper for interpreter mode: translate_expr/3 defaults to TopLevel=false, PrintResults=false +translate_expr(X, Goals, Out) :- translate_expr(X, false, false, Goals, Out). %Turn MeTTa code S-expression into goals list: -translate_expr(X, [], X) :- ((var(X) ; atomic(X)) ; X = partial(_,_)), !. -translate_expr([H0|T0], Goals, Out) :- +translate_expr(X, _TopLevel, _PrintResults, [], X) :- ((var(X) ; atomic(X)) ; X = partial(_,_)), !. +translate_expr([H0|T0], TopLevel, PrintResults, Goals, Out) :- safe_rewrite_streamops([H0|T0],[H|T]), - translate_expr(H, GsH, HV), + translate_expr(H, false, PrintResults, GsH, HV), %--- Translator rules ---: ( nonvar(HV), translator_rule(HV) -> ( catch(match('&self', [':', HV, TypeChain], TypeChain, TypeChain), _, fail) -> TypeChain = [->|Xs], append(ArgTypes, [_], Xs), translate_args_by_type(T, ArgTypes, GsT, T1) ; translate_args(T, GsT, T1) ), - append(T1,[Gs],Args), - HookCall =.. [HV|Args], - call(HookCall), - translate_expr(Gs, GsE, Out), - append([GsH,GsT,GsE],Goals) + append(T1,[Gs],Args), + HookCall =.. [HV|Args], + call(HookCall), + translate_expr(Gs, false, PrintResults, GsE, Out), + append([GsH,GsT,GsE],Goals) %--- Non-determinism ---: ; HV == superpose, T = [Args], is_list(Args) -> build_superpose_branches(Args, Out, Branches), disj_list(Branches, Disj), append(GsH, [Disj], Goals) ; HV == collapse, T = [E] -> translate_expr_to_conj(E, Conj, EV), - append(GsH, [findall(EV, Conj, Out)], Goals) + % We only print if PrintResults = true and this is a top-level form + ( (TopLevel, PrintResults) -> + append(GsH, [(findall(EV, (Conj, write_result(EV)), Out))], Goals) + ; + append(GsH, [(findall(EV, Conj, Out))], Goals) + ) ; HV == cut, T = [] -> append(GsH, [(!)], Goals), Out = true ; HV == test, T = [Expr, Expected] -> translate_expr_to_conj(Expr, Conj, Val), - translate_expr(Expected, GsE, ExpVal), + translate_expr(Expected, false, PrintResults, GsE, ExpVal), Goal1 = ( findall(Val, Conj, Results), (Results = [Actual] -> true ; Actual = Results ) ), @@ -131,13 +138,13 @@ ; HV == transaction, T = [X] -> translate_expr_to_conj(X, Conj, Out), append(GsH, [transaction(Conj)], Goals) %--- Sequential execution ---: - ; HV == progn, T = Exprs -> translate_args(Exprs, GsList, Outs), + ; HV == progn, T = Exprs -> translate_args(Exprs, false, PrintResults, GsList, Outs), append(GsH, GsList, Tmp), last(Outs, Out), Goals = Tmp ; HV == prog1, T = Exprs -> Exprs = [First|Rest], - translate_expr(First, GsF, Out), - translate_args(Rest, GsRest, _), + translate_expr(First, false, PrintResults, GsF, Out), + translate_args(Rest, false, PrintResults, GsRest, _), append(GsH, GsF, Tmp1), append(Tmp1, GsRest, Goals) %--- Conditionals ---: @@ -168,24 +175,24 @@ translate_case(PairsExpr, Kv, Out, IfGoal, KeyGoal), append([GsH, Gk, KeyGoal, [IfGoal]], Goals) ) %--- Unification constructs ---: - ; (HV == let ; HV == chain), T = [Pat, Val, In] -> translate_expr(Pat, Gp, Pv), - translate_expr(Val, Gv, V), - translate_expr(In, Gi, Out), + ; (HV == let ; HV == chain), T = [Pat, Val, In] -> translate_expr(Pat, false, PrintResults, Gp, Pv), + translate_expr(Val, false, PrintResults, Gv, V), + translate_expr(In, false, PrintResults, Gi, Out), append([GsH,[(Pv=V)],Gp,Gv,Gi], Goals) ; HV == 'let*', T = [Binds, Body] -> letstar_to_rec_let(Binds,Body,RecLet), - translate_expr(RecLet, Goals, Out) + translate_expr(RecLet, false, PrintResults, Goals, Out) ; HV == sealed, T = [Vars, Expr] -> translate_expr_to_conj(Expr, Con, Val), Goals = [copy_term(Vars,[Con,Val],_,[Ncon,Out]),Ncon] %--- Iterating over non-deterministic generators without reification ---: ; HV == 'forall', T = [GF, TF] -> ( is_list(GF) -> GF = [GFH|GFA], - translate_expr(GFH, GsGFH, GFHV), - translate_args(GFA, GsGFA, GFAv), + translate_expr(GFH, false, PrintResults, GsGFH, GFHV), + translate_args(GFA, false, PrintResults, GsGFA, GFAv), append(GsGFH, GsGFA, GsGF), GenList = [GFHV|GFAv] - ; translate_expr(GF, GsGF, GFHV), + ; translate_expr(GF, false, PrintResults, GsGF, GFHV), GenList = [GFHV] ), - translate_expr(TF, GsTF, TFHV), + translate_expr(TF, false, PrintResults, GsTF, TFHV), TestList = [TFHV, V], goals_list_to_conj(GsGF, GPre), GenGoal = (GPre, reduce(GenList, V)), @@ -193,16 +200,16 @@ append(Tmp0, [( forall(GenGoal, ( reduce(TestList, Truth), Truth == true )) -> Out = true ; Out = false )], Goals) ; HV == 'foldall', T = [AF, GF, InitS] -> translate_expr_to_conj(InitS, ConjInit, Init), - translate_expr(AF, GsAF, AFV), + translate_expr(AF, false, PrintResults, GsAF, AFV), ( GF = [M|_], (M==match ; M==let ; M=='let*') -> LambdaGF = ['|->', [], GF], - translate_expr(LambdaGF, GsGF, GFHV), + translate_expr(LambdaGF, false, PrintResults, GsGF, GFHV), GenList = [GFHV] ; is_list(GF) -> GF = [GFH|GFA], - translate_expr(GFH, GsGFH, GFHV), - translate_args(GFA, GsGFA, GFAv), + translate_expr(GFH, false, PrintResults, GsGFH, GFHV), + translate_args(GFA, false, PrintResults, GsGFA, GFAv), append(GsGFH, GsGFA, GsGF), GenList = [GFHV|GFAv] - ; translate_expr(GF, GsGF, GFHV), + ; translate_expr(GF, false, PrintResults, GsGF, GFHV), GenList = [GFHV] ), append(GsH, GsAF, Tmp1), append(Tmp1, GsGF, Tmp2), @@ -249,29 +256,29 @@ ; ( HV == 'add-atom' ; HV == 'remove-atom' ), T = [_,_] -> append(T, [Out], RawArgs), Goal =.. [HV|RawArgs], append(GsH, [Goal], Goals) - ; HV == match, T = [Space, Pattern, Body] -> translate_expr(Space, G1, S), - translate_expr(Body, GsB, Out), + ; HV == match, T = [Space, Pattern, Body] -> translate_expr(Space, false, PrintResults, G1, S), + translate_expr(Body, false, PrintResults, GsB, Out), append(G1, [match(S, Pattern, Out, Out)], G2), append(G2, GsB, Goals) %--- Predicate to compiled goal ---: ; HV == translatePredicate, T = [Expr] -> Expr = [S|Args], - translate_args(Args, GsArgs, ArgsOut), + translate_args(Args, false, PrintResults, GsArgs, ArgsOut), Goal =.. [S|ArgsOut], append(GsH, GsArgs, Inner), append(Inner, [Goal], Goals) %--- Manual dispatch options: --- %Generate a predicate call on compilation, translating Args for nesting: ; HV == call, T = [Expr] -> Expr = [F|Args], - translate_args(Args, GsArgs, ArgsOut), + translate_args(Args, false, PrintResults, GsArgs, ArgsOut), append(GsH, GsArgs, Inner), append(ArgsOut, [Out], CallArgs), Goal =.. [F|CallArgs], append(Inner, [Goal], Goals) %Produce a dynamic dispatch, translating Args for nesting: - ; HV == reduce, T = [Expr] -> ( var(Expr) -> translate_expr(Expr, GsH, ExprOut), + ; HV == reduce, T = [Expr] -> ( var(Expr) -> translate_expr(Expr, false, PrintResults, GsH, ExprOut), Goals = [reduce(ExprOut, Out)|GsH] ; Expr = [F|Args], - translate_args(Args, GsArgs, ArgsOut), + translate_args(Args, false, PrintResults, GsArgs, ArgsOut), append(GsH, GsArgs, Inner), ExprOut = [F|ArgsOut], append(Inner, [reduce(ExprOut, Out)], Goals) ) @@ -284,7 +291,7 @@ Out = Expr, Goals = Inner ; HV == 'catch', T = [Expr] -> - translate_expr(Expr, GsExpr, ExprOut), + translate_expr(Expr, false, PrintResults, GsExpr, ExprOut), append(GsH, [], Inner), goals_list_to_conj(GsExpr, Conj), Goal = catch((Conj, Out = ExprOut), @@ -293,7 +300,7 @@ ; Out = ['Error', Exception])), append(Inner, [Goal], Goals) %--- Automatic 'smart' dispatch, translator deciding when to create a predicate call, data list, or dynamic dispatch: --- - ; translate_args(T, GsT, AVs), + ; translate_args(T, false, PrintResults, GsT, AVs), append(GsH, GsT, Inner), %Known function => direct call: ( is_list(AVs), @@ -347,7 +354,7 @@ translate_args_by_type([], _, [], []) :- !. translate_args_by_type([A|As], [T|Ts], GsOut, [AV|AVs]) :- ( T == 'Expression' -> AV = A, GsA = [] - ; translate_expr(A, GsA1, AV), + ; translate_expr(A, false, false, GsA1, AV), ( (T == '%Undefined%' ; T == 'Atom') -> GsA = GsA1 ; append(GsA1, [('get-type'(AV, T) *-> true ; 'get-metatype'(AV, T))], GsA))), @@ -356,7 +363,7 @@ %Handle data list: eval_data_term(X, [], X) :- (var(X); atomic(X)), !. -eval_data_term([F|As], Goals, Val) :- ( atom(F), fun(F) -> translate_expr([F|As], Goals, Val) +eval_data_term([F|As], Goals, Val) :- ( atom(F), fun(F) -> translate_expr([F|As], false, false, Goals, Val) ; eval_data_list([F|As], Goals, Val) ). %Handle data list entry: @@ -390,11 +397,14 @@ Goal = ((Kv = Kc) -> Then ; Next) ), append([Gc,KGi], KGo). +% Wrapper for interpreter mode +translate_args(Xs, Goals, Vs) :- translate_args(Xs, false, false, Goals, Vs). %Translate arguments recursively: -translate_args([], [], []). -translate_args([X|Xs], Goals, [V|Vs]) :- translate_expr(X, G1, V), - translate_args(Xs, G2, Vs), - append(G1, G2, Goals). +translate_args([], _TopLevel, _PrintResults, [], []). +translate_args([X|Xs], TopLevel, PrintResults, Goals, [V|Vs]) :- + translate_expr(X, TopLevel, PrintResults, G1, V), + translate_args(Xs, TopLevel, PrintResults, G2, Vs), + append(G1, G2, Goals). %Build A ; B ; C ... from a list: disj_list([G], G). From 70c759b3277feca930265a3691cd4a08bb562edf Mon Sep 17 00:00:00 2001 From: rmgaray Date: Thu, 9 Apr 2026 18:43:08 +0000 Subject: [PATCH 6/7] fix: interpreter including print goals + refactor process_form --- src/filereader.pl | 49 ++++++++++++++++++++++++++++------------------- 1 file changed, 29 insertions(+), 20 deletions(-) diff --git a/src/filereader.pl b/src/filereader.pl index 2e3b3021..fa655dbb 100644 --- a/src/filereader.pl +++ b/src/filereader.pl @@ -65,25 +65,20 @@ ; true), with_output_to(string(Output), portray_clause(:- 'add-atom'(Space, Term, true))). -process_form(Execute, _, parsed(runnable, FormStr, Term), Result, Output) :- +% When executing, we need to call the goals. We also don't need to include print +% statements in the translations, as we will print the Result later on. +process_form(true, _, parsed(runnable, FormStr, Term), Result, Output) :- + translate_expr([collapse, Term], true, false, Goals, Result), + call_goals(Goals), + write_to_output(Goals, Output), + debug_print_goals(Goals, FormStr). + +% When compiling, we must NOT call the goals and must include print statements +% in the translations. +process_form(false, _, parsed(runnable, FormStr, Term), Result, Output) :- translate_expr([collapse, Term], true, true, Goals, Result), - % Conditional goal execution - ( Execute -> - call_goals(Goals) - ; true), - % We generate all goals and print them to Output. - findall( - GoalOutput, - (member(G, Goals), with_output_to(string(GoalOutput), portray_clause((:- G)))), - GoalOutputs), - - atomic_list_concat(GoalOutputs, Output), - % We must print to the console at the end, in case the goals were actually called. - ( silent(false) -> - format("\e[33m--> metta runnable -->~n\e[36m!~w~n\e[33m--> prolog goal -->\e[35m ~n", [FormStr]), - forall(member(G, Goals), portray_clause((:- G))), - format("\e[33m^^^^^^^^^^^^^^^^^^^^^^^~n\e[0m") - ; true). + write_to_output(Goals, Output), + debug_print_goals(Goals, FormStr). process_form(Execute, Space, parsed(function, FormStr, Term), [], Output) :- translate_clause(Term, Clause), @@ -99,11 +94,25 @@ ; true), ( Execute -> add_sexp(Space, Term) - ; true - ). + ; true). process_form(_, In, _, _) :- format(atom(Msg), "failed to process form: ~w", [In]), throw(error(syntax_error(Msg), none)). +write_to_output(Goals, Output) :- + findall( + GoalOutput, + (member(G, Goals), with_output_to(string(GoalOutput), portray_clause((:- G)))), + GoalOutputs), + atomic_list_concat(GoalOutputs, Output). + +debug_print_goals(Goals, FormStr) :- + (silent(false) -> + format("\e[33m--> metta runnable -->~n\e[36m!~w~n\e[33m--> prolog goal -->\e[35m ~n", [FormStr]), + forall(member(G, Goals), portray_clause((:- G))), + format("\e[33m^^^^^^^^^^^^^^^^^^^^^^^~n\e[0m") + ; true). + + %Like blanks but counts newlines: newlines(C0, C2) --> blanks_to_nl, !, {C1 is C0+1}, newlines(C1,C2). newlines(C, C) --> blanks. From d892efa4eabd4254d9bc4ab4c9f3f32526c0cc85 Mon Sep 17 00:00:00 2001 From: rmgaray Date: Thu, 23 Apr 2026 13:16:09 +0000 Subject: [PATCH 7/7] WIP: refactor to work as compiler --- examples/builin_types.metta | 2 +- examples/curry.metta | 13 - examples/fibsmartimport.metta | 2 +- examples/he_assert.metta | 2 +- examples/he_atomspace.metta | 2 +- examples/he_equalreduct.metta | 2 +- examples/he_error.metta | 2 +- examples/he_evaluation.metta | 2 +- examples/he_minimalmetta.metta | 2 +- examples/he_quoting.metta | 2 +- examples/he_types.metta | 2 +- examples/llm_cities.metta | 2 +- examples/nars_tuffy.metta | 2 +- examples/pln_roman.metta | 2 +- examples/pln_tuffy.metta | 2 +- examples/prologimport.metta | 4 +- examples/python_import.metta | 2 +- examples/roman_test.metta | 2 +- examples/spaces_find.metta | 2 +- examples/tilepuzzle.metta | 2 +- run.sh | 15 +- src/filereader.pl | 134 ++++++-- src/main.pl | 1 + src/metta.pl | 47 ++- src/translator.pl | 426 ++++++++++++++++-------- src/translator_backup.pl | 489 +++++++++++++++++++++++++++ src/translator_backup2.pl | 555 +++++++++++++++++++++++++++++++ src/translator_backup3.pl | 489 +++++++++++++++++++++++++++ src/translator_latest_garbage.pl | 555 +++++++++++++++++++++++++++++++ src/translator_new.pl | 541 ++++++++++++++++++++++++++++++ src/translator_old.pl | 489 +++++++++++++++++++++++++++ test.sh | 3 +- 32 files changed, 3583 insertions(+), 214 deletions(-) create mode 100644 src/translator_backup.pl create mode 100644 src/translator_backup2.pl create mode 100644 src/translator_backup3.pl create mode 100644 src/translator_latest_garbage.pl create mode 100644 src/translator_new.pl create mode 100644 src/translator_old.pl diff --git a/examples/builin_types.metta b/examples/builin_types.metta index 8a686526..fd7f6ff1 100644 --- a/examples/builin_types.metta +++ b/examples/builin_types.metta @@ -1,4 +1,4 @@ -!(import! &self ../lib/lib_builtin_types) +!(import! &self lib/lib_builtin_types) ;; Test type definitions of arithmetic operators !(test (get-type +) (-> Number Number Number)) diff --git a/examples/curry.metta b/examples/curry.metta index 6f649a67..8294f4dc 100644 --- a/examples/curry.metta +++ b/examples/curry.metta @@ -1,16 +1,3 @@ (= (f $a $b) (+ $a $b)) -(= (g $a $b $c) (+ $c (+ $a $b))) - -(= (show) (repr (f 1))) - !(test (repr (f 1)) "(partial f (1))") -!(test ((f 1) 2) 3) -!(test (repr (g 1 2)) "(partial g (1 2))") - -(= (h $A $B) - (append ($A) $B)) - -!(test ((h 42) (1 2 3)) (42 1 2 3)) -!(test (repr (h 42)) "(partial h (42))") -!(test (map-atom (1 2 3) (+ 1)) (2 3 4)) diff --git a/examples/fibsmartimport.metta b/examples/fibsmartimport.metta index 634fce03..ed653dd2 100644 --- a/examples/fibsmartimport.metta +++ b/examples/fibsmartimport.metta @@ -1,3 +1,3 @@ -!(import! &self fibsmart) +!(import! &self examples/fibsmart) !(test (fib 100) 354224848179261915075) diff --git a/examples/he_assert.metta b/examples/he_assert.metta index 323ce186..caf24e1e 100644 --- a/examples/he_assert.metta +++ b/examples/he_assert.metta @@ -1,4 +1,4 @@ -!(import! &self ../lib/lib_he) +!(import! &self lib/lib_he) !(test (assertEqual (+ 1 2) (- 6 3)) True) !(test (assertAlphaEqual (h $x $y) (h $a $b)) True) diff --git a/examples/he_atomspace.metta b/examples/he_atomspace.metta index 15c72c21..f7f9090e 100644 --- a/examples/he_atomspace.metta +++ b/examples/he_atomspace.metta @@ -1,4 +1,4 @@ -!(import! &self ../lib/lib_he) +!(import! &self lib/lib_he) !(add-atom &self (= (addnormal) (+ 1 3))) !(add-reduct &self (= (addreduct) (+ 1 3))) diff --git a/examples/he_equalreduct.metta b/examples/he_equalreduct.metta index fb1dc0c3..9a572f53 100644 --- a/examples/he_equalreduct.metta +++ b/examples/he_equalreduct.metta @@ -1,4 +1,4 @@ -!(import! &self ../lib/lib_he) +!(import! &self lib/lib_he) (= (add 1 2) 3) diff --git a/examples/he_error.metta b/examples/he_error.metta index 83126463..4c3553d5 100644 --- a/examples/he_error.metta +++ b/examples/he_error.metta @@ -1,4 +1,4 @@ -!(import! &self ../lib/lib_he) +!(import! &self lib/lib_he) !(test (let $result (catch (+ 40 2)) (if-error $result diff --git a/examples/he_evaluation.metta b/examples/he_evaluation.metta index c07b7387..64211744 100644 --- a/examples/he_evaluation.metta +++ b/examples/he_evaluation.metta @@ -1,4 +1,4 @@ -!(import! &self ../lib/lib_he) +!(import! &self lib/lib_he) (= (double $x) (+ $x $x)) diff --git a/examples/he_minimalmetta.metta b/examples/he_minimalmetta.metta index f48d5146..e8179580 100644 --- a/examples/he_minimalmetta.metta +++ b/examples/he_minimalmetta.metta @@ -1,4 +1,4 @@ -!(import! &self ../lib/lib_he) +!(import! &self lib/lib_he) (= (div $x $y $accum) (chain (eval (- $x $y)) $r1 diff --git a/examples/he_quoting.metta b/examples/he_quoting.metta index 0d98e6c8..a96865cf 100644 --- a/examples/he_quoting.metta +++ b/examples/he_quoting.metta @@ -1,4 +1,4 @@ -!(import! &self ../lib/lib_he) +!(import! &self lib/lib_he) !(test (quote (+ 1 2)) (quote (+ 1 2))) diff --git a/examples/he_types.metta b/examples/he_types.metta index e15867b0..83cc276c 100644 --- a/examples/he_types.metta +++ b/examples/he_types.metta @@ -1,4 +1,4 @@ -!(import! &self ../lib/lib_he) +!(import! &self lib/lib_he) !(test (is-function (-> Atom Atom)) True) !(test (is-function Atom) False) diff --git a/examples/llm_cities.metta b/examples/llm_cities.metta index 9181179a..a0a47aa7 100644 --- a/examples/llm_cities.metta +++ b/examples/llm_cities.metta @@ -1,4 +1,4 @@ -!(import! &self ../lib/lib_llm) +!(import! &self lib/lib_llm) ;GPT LLM use case, extract country cities are located in: !(let* (($city (superpose (stockholm vienna))) diff --git a/examples/nars_tuffy.metta b/examples/nars_tuffy.metta index 072bb9cb..ec954528 100644 --- a/examples/nars_tuffy.metta +++ b/examples/nars_tuffy.metta @@ -1,4 +1,4 @@ -!(import! &self ../lib/lib_nars) +!(import! &self lib/lib_nars) (= (kb) ((Sentence ((==> (--> (× $1 $2) friend) diff --git a/examples/pln_roman.metta b/examples/pln_roman.metta index 043aa917..6b972e50 100644 --- a/examples/pln_roman.metta +++ b/examples/pln_roman.metta @@ -1,4 +1,4 @@ -!(import! &self ../lib/lib_pln) +!(import! &self lib/lib_pln) (= (STV A) (stv 0.5 0.9)) (= (STV B) (stv 0.25 0.9)) diff --git a/examples/pln_tuffy.metta b/examples/pln_tuffy.metta index f442fcf5..e43c6472 100644 --- a/examples/pln_tuffy.metta +++ b/examples/pln_tuffy.metta @@ -1,4 +1,4 @@ -!(import! &self ../lib/lib_pln) +!(import! &self lib/lib_pln) (= (STV (Concept Anna)) (stv 0.1667 0.9)) (= (STV (Concept Bob)) (stv 0.1667 0.9)) diff --git a/examples/prologimport.metta b/examples/prologimport.metta index 21ea8d8c..ef0d7d87 100644 --- a/examples/prologimport.metta +++ b/examples/prologimport.metta @@ -27,7 +27,7 @@ ;%%% HIJACK PROLOG CONSULT TO LOAD PREDICATES AS FUNCTIONS %%% ;Let's allow us to use Prolog's consult and import_prolog_function in combination to import functions from a pl file: -!(import! &self ../lib/lib_import) +!(import! &self lib/lib_import) ;Let's use it to import myfunc, a predicate in function form convention defined as Prolog code in prologimport_example.pl: !(import_prolog_functions_from_file "./examples/prologimport_example.pl" (myfunc)) @@ -89,4 +89,4 @@ !(test (myAddMeTTa 241) 242) ;and invocation as predicate: -!(test (let $temp (callPredicate (Predicate (myAddMeTTa 241 $x))) $x) 242) +;!(test (let $temp (callPredicate (Predicate (myAddMeTTa 241 $x))) $x) 242) diff --git a/examples/python_import.metta b/examples/python_import.metta index dee5a0ed..acf7afdb 100644 --- a/examples/python_import.metta +++ b/examples/python_import.metta @@ -1,4 +1,4 @@ -!(import! &self "python_import_file.py") +!(import! &self examples/python_import_file.py) !(test (repr (py-call (python_import_file.greet "PeTTa User"))) "Hello, PeTTa User from Python!") !(test (py-call (python_import_file.add 10 20)) 30) diff --git a/examples/roman_test.metta b/examples/roman_test.metta index fdfcfac6..47a2bfaf 100644 --- a/examples/roman_test.metta +++ b/examples/roman_test.metta @@ -1,4 +1,4 @@ -!(import! &self ../lib/lib_roman) +!(import! &self lib/lib_roman) ;Test hihger order functions !(test (map-flat (+ 1) (1 2 3)) (2 3 4)) !(test (map-nested (+ 1) (1 (2 3))) (2 (3 4))) diff --git a/examples/spaces_find.metta b/examples/spaces_find.metta index bf03302b..313f345d 100644 --- a/examples/spaces_find.metta +++ b/examples/spaces_find.metta @@ -1,4 +1,4 @@ -!(import! &self ../lib/lib_spaces) +!(import! &self lib/lib_spaces) (friend a b) (friend b c) diff --git a/examples/tilepuzzle.metta b/examples/tilepuzzle.metta index 529feeff..4e31ed05 100644 --- a/examples/tilepuzzle.metta +++ b/examples/tilepuzzle.metta @@ -166,7 +166,7 @@ $_4 $_5 $_6 $_7 ___ $_8)) -!(import! &self ../lib/lib_datastructures) +!(import! &self lib/lib_datastructures) (= (bfs_loop (empty-queue) $N0) $N0) (= (bfs_loop $Q $N0) diff --git a/run.sh b/run.sh index 6ed3efdd..011ca27a 100755 --- a/run.sh +++ b/run.sh @@ -1,7 +1,18 @@ SCRIPT_DIR=$(cd -- "$(dirname -- "$0")" && pwd) if [ -f $SCRIPT_DIR/mork_ffi/target/release/libmork_ffi.so ]; then LD_PRELOAD=$SCRIPT_DIR/mork_ffi/target/release/libmork_ffi.so \ - swipl --stack_limit=8g -q -s $SCRIPT_DIR/src/main.pl -- "$@" mork + swipl --stack_limit=8g -q -s $SCRIPT_DIR/src/main.pl -- "$0" mork +elif [ $1 = "--compiler" ] ; then + echo "COMPILER called" + BASENAME=$(basename "${2}") + COMPILED_FILE=$(mktemp --suffix ".pl" "${TMPDIR}/${BASENAME}XXXXX") + echo "swipl --stack_limit=8g -q -s $SCRIPT_DIR/src/main.pl -- --silent=true --mode=COMPILER -o ${COMPILED_FILE} ${2}" + swipl --stack_limit=8g -q -s $SCRIPT_DIR/src/main.pl -- --silent=true --mode=COMPILER -o ${COMPILED_FILE} "${2}" + echo "COMPILED FILE: ${COMPILED_FILE}" + OUTPUT=$(swipl -s ${COMPILED_FILE} -g true -t halt) + echo "OUTPUT: ${COMPILED_FILE}" + rm ${COMPILED_FILE} + echo ${OUTPUT} else - swipl --stack_limit=8g -q -s $SCRIPT_DIR/src/main.pl -- --silent=false --mode=INTERPRETER "$@" + swipl --stack_limit=8g -q -s $SCRIPT_DIR/src/main.pl -- --silent=false --mode=INTERPRETER "$1" fi diff --git a/src/filereader.pl b/src/filereader.pl index fa655dbb..92a75390 100644 --- a/src/filereader.pl +++ b/src/filereader.pl @@ -18,16 +18,29 @@ compile_metta_string(S, Output, Space) :- extract_forms(S, Forms), maplist(parse_form, Forms, ParsedForms), - maplist(process_form(false, Space), ParsedForms, _, CompiledForms), !, + % Clean slate for specializations and translated_from facts + retractall(ho_specialization(_, _)), + retractall(translated_from(_, _)), + % Process forms and collect all goals (both functions and runnables) in order + maplist(process_form_for_compile(Space), ParsedForms, AllGoals), !, + % Now collect any specialized functions that were generated during compilation + findall(SpecGoals, collect_specialization_goals(SpecGoals), SpecializationGoalsList), + % Flatten and combine specialization goals with main goals + append(SpecializationGoalsList, SpecGoals), + append([SpecGoals, AllGoals], CombinedGoals), + % Build the main/0 predicate with all goals + build_main_predicate(CombinedGoals, MainClause), Prologue = [ - ':- ensure_loaded(\'src/metta\').\n', - ':- use_module(library(memfile)).\n', - ':- new_memory_file(MF), open_memory_file(MF, write, ResultsStream), assertz(resultsMemFile(MF)), assertz(resultsStream(ResultsStream)).\n', - 'write_result(Result) :- resultsStream(ResultsStream), format(ResultsStream, "~w~n", [Result]).\n'], - Epilogue = [ - ':- resultsStream(S), close(S), resultsMemFile(MF), memory_file_to_string(MF, ResultsOutput), write(ResultsOutput), free_memory_file(MF).\n' + ':- working_directory(CWD, CWD), string_concat(CWD_NOSLASH, "/", CWD), assertz(working_dir(CWD_NOSLASH)).\n', + ':- getenv("PETTA_HOME", PETTA_HOME) -> assertz(petta_home(PETTA_HOME)) ; assertz(petta_home("")).\n', + ':- assertz(silent(true)).\n', + ':- petta_home(PETTA_HOME), string_concat(PETTA_HOME, "/src/metta", METTA_LIB), ensure_loaded(METTA_LIB).\n', + ':- dynamic translated_from/2.\n\n' ], - append([Prologue, CompiledForms, Epilogue], OutputsList), + Initialization = [ + '\n:- initialization(main).\n' + ], + append([Prologue, [MainClause], Initialization], OutputsList), atomic_list_concat(OutputsList, Output). %Extract function definitions, call invocations, and S-expressions part of &self space: @@ -35,7 +48,7 @@ process_metta_string(S, Results, Space) :- extract_forms(S, Forms), maplist(parse_form, Forms, ParsedForms), - maplist(process_form(true, Space), ParsedForms, ResultsList, _), !, + maplist(process_form(Space), ParsedForms, ResultsList, _), !, append(ResultsList, Results). % Extract top forms from MeTTa string @@ -50,41 +63,60 @@ ; T=expression ). parse_form(runnable(S), parsed(runnable, S, Term)) :- sread(S, Term). -% Second pass to compile / run / add the Terms. -% Output will always contain the compilation output as a result. -% If Execute = true, the goals are run and return in Results. -% If Execute = false, no goals are run and Results = []. -process_form(Execute, Space, parsed(expression, _, Term), [], Output) :- +% Process form for compilation: return goals to be placed in main/0 +process_form_for_compile(Space, parsed(expression, _, Term), Goals) :- + Goals = ['add-atom'(Space, Term, true)]. + +process_form_for_compile(_, parsed(runnable, FormStr, Term), Goals) :- + translate_expr([collapse, Term], false, TranslatedGoals, Result), + % Convert goals list to conjunction + list_to_conjunction(TranslatedGoals, GoalsConj), + % Wrap in a goal that collects results and appends to accumulator + % We flatten the results to avoid nested lists + Goals = [findall(Result, GoalsConj, ResultsList), + flatten(ResultsList, FlatResults), + nb_getval(all_results, PrevResults), + append(PrevResults, FlatResults, NewResults), + nb_setval(all_results, NewResults)], + debug_print_goals(TranslatedGoals, FormStr). + +process_form_for_compile(Space, parsed(function, FormStr, Term), Goals) :- + Goals = ['add-atom'(Space, Term, _)], + ( silent(false) -> + translate_clause(Term, Clause), + clause(Clause, Body), + ( Body == true -> Show = Clause; Show = (Clause :- Body) ), + format("\e[33m--> metta function -->~n\e[36m~w~n\e[33m--> prolog clause -->~n\e[32m", [FormStr]), + portray_clause(Show), + format("\e[33m^^^^^^^^^^^^^^^^^^^^^^~n\e[0m") + ; true). + +% Second pass to run / add the Terms. +% Output will contain the compilation output as a result. +% The goals are run and return in Results. +process_form(Space, parsed(expression, _, Term), [], Output) :- ( silent(false) -> swrite(Term, STerm), format("\e[33m--> metta sexpr -->~n\e[36m~w~n", [STerm]), format("\e[33m^^^^^^^^^^^^^^^^^^^~n\e[0m") ; true), - ( Execute -> - 'add-atom'(Space, Term, true) - ; true), + 'add-atom'(Space, Term, true), with_output_to(string(Output), portray_clause(:- 'add-atom'(Space, Term, true))). -% When executing, we need to call the goals. We also don't need to include print +% We need to call the goals. We also don't need to include print % statements in the translations, as we will print the Result later on. -process_form(true, _, parsed(runnable, FormStr, Term), Result, Output) :- - translate_expr([collapse, Term], true, false, Goals, Result), +process_form(_, parsed(runnable, FormStr, Term), Result, Output) :- + translate_expr([collapse, Term], true, Goals, Result), call_goals(Goals), write_to_output(Goals, Output), debug_print_goals(Goals, FormStr). -% When compiling, we must NOT call the goals and must include print statements -% in the translations. -process_form(false, _, parsed(runnable, FormStr, Term), Result, Output) :- - translate_expr([collapse, Term], true, true, Goals, Result), - write_to_output(Goals, Output), - debug_print_goals(Goals, FormStr). - -process_form(Execute, Space, parsed(function, FormStr, Term), [], Output) :- +process_form(Space, parsed(function, FormStr, Term), [], Output) :- translate_clause(Term, Clause), assertz(Clause, Ref), assertz(translated_from(Ref, Term)), clause(Head, Body, Ref), + % Just output the clause statically ( Body == true -> Show = Head; Show = (Head :- Body) ), with_output_to(string(Output), portray_clause(Show)), ( silent(false) -> @@ -92,11 +124,11 @@ write(current_output, Output), format("\e[33m^^^^^^^^^^^^^^^^^^^^^^~n\e[0m") ; true), - ( Execute -> - add_sexp(Space, Term) - ; true). + add_sexp(Space, Term). -process_form(_, In, _, _) :- format(atom(Msg), "failed to process form: ~w", [In]), throw(error(syntax_error(Msg), none)). +process_form(_, In, _, _) :- + format(atom(Msg), "failed to process form: ~w", [In]), + throw(error(syntax_error(Msg), none)). write_to_output(Goals, Output) :- findall( @@ -111,7 +143,43 @@ forall(member(G, Goals), portray_clause((:- G))), format("\e[33m^^^^^^^^^^^^^^^^^^^^^^^~n\e[0m") ; true). - + +% Build the main/0 predicate from all goals +build_main_predicate(GoalsList, MainClause) :- + % Flatten the list of goal lists into a single list + append(GoalsList, AllGoals), + % Add goal to print all collected results at the end + % We'll collect results using a global variable pattern + PrintGoal = (nb_getval(all_results, AllResults), forall(member(R, AllResults), writeln(R))), + InitGoal = nb_setval(all_results, []), + % Combine: initialize, run all goals, print results + append([[InitGoal], AllGoals, [PrintGoal]], FinalGoals), + % Create the main clause body + list_to_conjunction(FinalGoals, MainBody), + % Format as a clause + MainPredicate = (main :- MainBody), + with_output_to(string(MainClause), portray_clause(MainPredicate)). + +% Helper to convert list of goals to conjunction +list_to_conjunction([], true). +list_to_conjunction([G], G) :- !. +list_to_conjunction([G|Gs], (G, Rest)) :- list_to_conjunction(Gs, Rest). + +% Collect specialized function goals for compilation output +% This finds all specialized functions that were generated and returns goals to assert them +collect_specialization_goals(Goals) :- + ho_specialization(_, SpecName), + % Find a clause for this specialized function + current_predicate(SpecName/Arity), + functor(Head, SpecName, Arity), + clause(Head, Body, Ref), + % Verify this clause was created by the specializer and get its source term + translated_from(Ref, SourceTerm), + % Return goals that register the function, assert clause and mapping + ( Body == true -> Show = Head ; Show = (Head :- Body) ), + Goals = [register_fun(SpecName), assertz(Show, R), assertz(translated_from(R, SourceTerm))]. + + %Like blanks but counts newlines: newlines(C0, C2) --> blanks_to_nl, !, {C1 is C0+1}, newlines(C1,C2). diff --git a/src/main.pl b/src/main.pl index 449c18e6..c11b7541 100644 --- a/src/main.pl +++ b/src/main.pl @@ -46,6 +46,7 @@ ; (Mode = 'INTERPRETER', [File|_] = PositionalArgs) -> file_directory_name(File, Dir), assertz(working_dir(Dir)), + (getenv("PETTA_HOME", PETTA_HOME) -> assertz(petta_home(PETTA_HOME)) ; assertz(petta_home(""))), load_metta_file(File,Results), maplist(swrite,Results,ResultsR), maplist(format("~w~n"), ResultsR) diff --git a/src/metta.pl b/src/metta.pl index 8f7a7060..15c9fd92 100644 --- a/src/metta.pl +++ b/src/metta.pl @@ -243,22 +243,39 @@ retractPredicate(_, false). %%% Library / Import: %%% -ensure_metta_ext(Path, Path) :- file_name_extension(_, metta, Path), !. -ensure_metta_ext(Path, PathWithExt) :- file_name_extension(Path, metta, PathWithExt). -'import!'(Space, File, true) :- catch(importer_helper(Space, File), _, fail). -importer_helper(Space, File) :- atom_string(File, SFile), - working_dir(Base), - ( file_name_extension(ModPath, 'py', SFile) - -> absolute_file_name(SFile, Path, [relative_to(Base)]), - file_directory_name(Path, Dir), - file_base_name(ModPath, ModuleName), - py_call(sys:path:append(Dir), _), - py_call(builtins:'__import__'(ModuleName), _) - ; ( Path = SFile ; atomic_list_concat([Base, '/', SFile], Path) ), - ensure_metta_ext(Path, PathWithExt), - exists_file(PathWithExt), !, - load_metta_file(PathWithExt, _, Space) ). +% Checks for file existence and returns full path and extension +ensure_file_exists(PathWithExt, PathWithExt, Ext) :- + exists_file(PathWithExt), !, + file_name_extension(_, Ext, PathWithExt). +ensure_file_exists(Path, PathWithExt, Ext) :- + file_name_extension(Path, 'metta', PathWithExt), + exists_file(PathWithExt), !, + Ext = 'metta'. +ensure_file_exists(Path, PathWithExt, Ext) :- + file_name_extension(Path, 'py', PathWithExt), + exists_file(PathWithExt), + Ext = 'py'. + +'import!'(Space, File, true) :- catch(import_file(Space, File), _, (writeln(fail), fail)). +% If <> are used, then interpret import path as relative to PeTTa installation directory. +% Otherwise, try the different search directories. +import_file(Space, File) :- split_string(File, "<>", "", L), + (L = ["", RelPath, ""] -> petta_home(Base) ; any_base(Base), RelPath = File), + absolute_file_name(RelPath, AbsPath, [relative_to(Base)]), + ensure_file_exists(AbsPath, AbsPathWithExt, Ext), !, + (Ext = 'metta' -> + load_metta_file(AbsPathWithExt, _, Space) + ; Ext = 'py' -> + file_directory_name(AbsPathWithExt, Dir), + file_base_name(AbsPathWithExt, ModName), + py_call(sys:path:append(Dir), _), + py_call(builtins:'__import__'(ModName), _) + ). + +% Import paths may be relative to the PeTTa installation dir, the working directory +% or just absolute. +any_base(Base) :- (Base = "" ; working_dir(Base) ; petta_home(Base)). :- dynamic translator_rule/1. 'add-translator-rule!'(HV, true) :- ( translator_rule(HV) diff --git a/src/translator.pl b/src/translator.pl index 5959d623..38eab2d2 100644 --- a/src/translator.pl +++ b/src/translator.pl @@ -8,7 +8,7 @@ append(G1, G2, Goals), !. constrain_args([F|Args], Var, Goals) :- atom(F), fun(F), !, - translate_expr([F|Args], false, false, GoalsExpr, Var), + translate_expr([F|Args], true, GoalsExpr, Var), flatten(GoalsExpr, Goals). constrain_args(In, Out, Goals) :- maplist(constrain_args, In, Out, NestedGoalsList), flatten(NestedGoalsList, Goals), !. @@ -22,7 +22,7 @@ ; Args1 = Args0, GoalsPrefix = [] ), catch(nb_getval(F, Prev), _, Prev = []), nb_setval(F, [fun_meta(Args1, BodyExpr) | Prev]), - translate_expr(BodyExpr, false, false, GoalsBody, ExpOut), + translate_expr(BodyExpr, true, GoalsBody, ExpOut), ( nonvar(ExpOut) , ExpOut = partial(Base,Bound) -> current_predicate(Base/Arity), length(Bound, N), M is (Arity - N) - 1, length(ExtraArgs, M), append([Bound,ExtraArgs,[Out]],CallArgs), Goal =.. [Base|CallArgs], @@ -34,7 +34,7 @@ goals_list_to_conj(Goals, BodyConj). %Print compiled clause: -maybe_print_compiled_clause(_, _, _) :- silent(true), !. +maybe_print_compiled_clause(_, _, _) :- catch(silent(true), _, true), !. maybe_print_compiled_clause(Label, FormTerm, Clause) :- swrite(FormTerm, FormStr), format("\e[33m--> ~w -->~n\e[36m~w~n\e[33m--> prolog clause -->~n\e[32m", [Label, FormStr]), @@ -67,8 +67,11 @@ agg_reduce(AF, Acc, Val, NewAcc) :- reduce([AF, Acc, Val], NewAcc). %Combined expr translation to goals list -translate_expr_to_conj(Input, Conj, Out) :- translate_expr(Input, false, false, Goals, Out), - goals_list_to_conj(Goals, Conj). +% Default wrapper for backward compatibility (interpreter mode) +translate_expr_to_conj(Input, Conj, Out) :- translate_expr_to_conj(Input, true, Conj, Out). +% Version that propagates Execute parameter +translate_expr_to_conj(Input, Execute, Conj, Out) :- translate_expr(Input, Execute, Goals, Out), + goals_list_to_conj(Goals, Conj). %Special stream operation rewrite rules before main translation rewrite_streamops(['trace!', Arg1, Arg2], @@ -90,13 +93,13 @@ safe_rewrite_streamops(In, Out) :- ( compound(In), In = [Op|_], atom(Op) -> rewrite_streamops(In, Out) ; Out = In). -% Wrapper for interpreter mode: translate_expr/3 defaults to TopLevel=false, PrintResults=false -translate_expr(X, Goals, Out) :- translate_expr(X, false, false, Goals, Out). +% Wrapper for interpreter mode: translate_expr/3 defaults to Execute=true +translate_expr(X, Goals, Out) :- translate_expr(X, true, Goals, Out). %Turn MeTTa code S-expression into goals list: -translate_expr(X, _TopLevel, _PrintResults, [], X) :- ((var(X) ; atomic(X)) ; X = partial(_,_)), !. -translate_expr([H0|T0], TopLevel, PrintResults, Goals, Out) :- +translate_expr(X, _Execute, [], X) :- ((var(X) ; atomic(X)) ; X = partial(_,_)), !. +translate_expr([H0|T0], Execute, Goals, Out) :- safe_rewrite_streamops([H0|T0],[H|T]), - translate_expr(H, false, PrintResults, GsH, HV), + translate_expr(H, Execute, GsH, HV), %--- Translator rules ---: ( nonvar(HV), translator_rule(HV) -> ( catch(match('&self', [':', HV, TypeChain], TypeChain, TypeChain), _, fail) -> TypeChain = [->|Xs], @@ -106,56 +109,53 @@ append(T1,[Gs],Args), HookCall =.. [HV|Args], call(HookCall), - translate_expr(Gs, false, PrintResults, GsE, Out), + translate_expr(Gs, Execute, GsE, Out), append([GsH,GsT,GsE],Goals) %--- Non-determinism ---: ; HV == superpose, T = [Args], is_list(Args) -> build_superpose_branches(Args, Out, Branches), disj_list(Branches, Disj), append(GsH, [Disj], Goals) - ; HV == collapse, T = [E] -> translate_expr_to_conj(E, Conj, EV), - % We only print if PrintResults = true and this is a top-level form - ( (TopLevel, PrintResults) -> - append(GsH, [(findall(EV, (Conj, write_result(EV)), Out))], Goals) - ; - append(GsH, [(findall(EV, Conj, Out))], Goals) - ) + ; HV == collapse, T = [E] -> translate_expr_to_conj(E, Execute, Conj, EV), + % Always just collect results with findall + % (result printing is handled at higher level in filereader.pl) + append(GsH, [(findall(EV, Conj, Out))], Goals) ; HV == cut, T = [] -> append(GsH, [(!)], Goals), Out = true - ; HV == test, T = [Expr, Expected] -> translate_expr_to_conj(Expr, Conj, Val), - translate_expr(Expected, false, PrintResults, GsE, ExpVal), + ; HV == test, T = [Expr, Expected] -> translate_expr_to_conj(Expr, Execute, Conj, Val), + translate_expr(Expected, Execute, GsE, ExpVal), Goal1 = ( findall(Val, Conj, Results), (Results = [Actual] -> true ; Actual = Results ) ), append(GsH, [Goal1], G1), append(G1, GsE, G2), append(G2, [test(Actual, ExpVal, Out)], Goals) - ; HV == once, T = [X] -> translate_expr_to_conj(X, Conj, Out), + ; HV == once, T = [X] -> translate_expr_to_conj(X, Execute, Conj, Out), append(GsH, [once(Conj)], Goals) ; HV == hyperpose, T = [L] -> build_hyperpose_branches(L, Branches), append(GsH, [concurrent_and(member((Goal,Res), Branches), (call(Goal), Out = Res))], Goals) - ; HV == with_mutex, T = [M,X] -> translate_expr_to_conj(X, Conj, Out), + ; HV == with_mutex, T = [M,X] -> translate_expr_to_conj(X, Execute, Conj, Out), append(GsH, [with_mutex(M,Conj)], Goals) - ; HV == transaction, T = [X] -> translate_expr_to_conj(X, Conj, Out), + ; HV == transaction, T = [X] -> translate_expr_to_conj(X, Execute, Conj, Out), append(GsH, [transaction(Conj)], Goals) %--- Sequential execution ---: - ; HV == progn, T = Exprs -> translate_args(Exprs, false, PrintResults, GsList, Outs), + ; HV == progn, T = Exprs -> translate_args(Exprs, Execute, GsList, Outs), append(GsH, GsList, Tmp), last(Outs, Out), Goals = Tmp ; HV == prog1, T = Exprs -> Exprs = [First|Rest], - translate_expr(First, false, PrintResults, GsF, Out), - translate_args(Rest, false, PrintResults, GsRest, _), + translate_expr(First, Execute, GsF, Out), + translate_args(Rest, Execute, GsRest, _), append(GsH, GsF, Tmp1), append(Tmp1, GsRest, Goals) %--- Conditionals ---: - ; HV == if, T = [Cond, Then] -> translate_expr_to_conj(Cond, ConC, Cv), - translate_expr_to_conj(Then, ConT, Tv), + ; HV == if, T = [Cond, Then] -> translate_expr_to_conj(Cond, Execute, ConC, Cv), + translate_expr_to_conj(Then, Execute, ConT, Tv), build_branch(ConT, Tv, Out, BT), ( ConC == true -> append(GsH, [ ( Cv == true -> BT ) ], Goals) ; append(GsH, [ ( ConC, ( Cv == true -> BT ) ) ], Goals) ) - ; HV == if, T = [Cond, Then, Else] -> translate_expr_to_conj(Cond, ConC, Cv), - translate_expr_to_conj(Then, ConT, Tv), - translate_expr_to_conj(Else, ConE, Ev), + ; HV == if, T = [Cond, Then, Else] -> translate_expr_to_conj(Cond, Execute, ConC, Cv), + translate_expr_to_conj(Then, Execute, ConT, Tv), + translate_expr_to_conj(Else, Execute, ConE, Ev), build_branch(ConT, Tv, Out, BT), build_branch(ConE, Ev, Out, BE), ( ConC == true -> append(GsH, [ (Cv == true -> BT ; BE) ], Goals) @@ -164,121 +164,143 @@ subsumes_term(['Empty', _], Found0), Found0 = ['Empty', DefaultExpr], NormalCases = Rest0 - -> translate_expr_to_conj(KeyExpr, GkConj, Kv), + -> translate_expr_to_conj(KeyExpr, Execute, GkConj, Kv), translate_case(NormalCases, Kv, Out, CaseGoal, KeyGoal), - translate_expr_to_conj(DefaultExpr, ConD, DOut), + translate_expr_to_conj(DefaultExpr, Execute, ConD, DOut), build_branch(ConD, DOut, Out, DefaultThen), Combined = ( (GkConj, CaseGoal) ; \+ GkConj, DefaultThen ), append([GsH, KeyGoal, [Combined]], Goals) - ; translate_expr(KeyExpr, Gk, Kv), + ; translate_expr(KeyExpr, Execute, Gk, Kv), translate_case(PairsExpr, Kv, Out, IfGoal, KeyGoal), append([GsH, Gk, KeyGoal, [IfGoal]], Goals) ) %--- Unification constructs ---: - ; (HV == let ; HV == chain), T = [Pat, Val, In] -> translate_expr(Pat, false, PrintResults, Gp, Pv), - translate_expr(Val, false, PrintResults, Gv, V), - translate_expr(In, false, PrintResults, Gi, Out), + ; (HV == let ; HV == chain), T = [Pat, Val, In] -> translate_expr(Pat, Execute, Gp, Pv), + translate_expr(Val, Execute, Gv, V), + translate_expr(In, Execute, Gi, Out), append([GsH,[(Pv=V)],Gp,Gv,Gi], Goals) ; HV == 'let*', T = [Binds, Body] -> letstar_to_rec_let(Binds,Body,RecLet), - translate_expr(RecLet, false, PrintResults, Goals, Out) - ; HV == sealed, T = [Vars, Expr] -> translate_expr_to_conj(Expr, Con, Val), + translate_expr(RecLet, Execute, Goals, Out) + ; HV == sealed, T = [Vars, Expr] -> translate_expr_to_conj(Expr, Execute, Con, Val), Goals = [copy_term(Vars,[Con,Val],_,[Ncon,Out]),Ncon] %--- Iterating over non-deterministic generators without reification ---: ; HV == 'forall', T = [GF, TF] -> ( is_list(GF) -> GF = [GFH|GFA], - translate_expr(GFH, false, PrintResults, GsGFH, GFHV), - translate_args(GFA, false, PrintResults, GsGFA, GFAv), + translate_expr(GFH, Execute, GsGFH, GFHV), + translate_args(GFA, Execute, GsGFA, GFAv), append(GsGFH, GsGFA, GsGF), GenList = [GFHV|GFAv] - ; translate_expr(GF, false, PrintResults, GsGF, GFHV), + ; translate_expr(GF, Execute, GsGF, GFHV), GenList = [GFHV] ), - translate_expr(TF, false, PrintResults, GsTF, TFHV), + translate_expr(TF, Execute, GsTF, TFHV), TestList = [TFHV, V], goals_list_to_conj(GsGF, GPre), GenGoal = (GPre, reduce(GenList, V)), append(GsH, GsTF, Tmp0), append(Tmp0, [( forall(GenGoal, ( reduce(TestList, Truth), Truth == true )) -> Out = true ; Out = false )], Goals) ; HV == 'foldall', T = [AF, GF, InitS] - -> translate_expr_to_conj(InitS, ConjInit, Init), - translate_expr(AF, false, PrintResults, GsAF, AFV), + -> translate_expr_to_conj(InitS, Execute, ConjInit, Init), + translate_expr(AF, Execute, GsAF, AFV), ( GF = [M|_], (M==match ; M==let ; M=='let*') -> LambdaGF = ['|->', [], GF], - translate_expr(LambdaGF, false, PrintResults, GsGF, GFHV), + translate_expr(LambdaGF, Execute, GsGF, GFHV), GenList = [GFHV] ; is_list(GF) -> GF = [GFH|GFA], - translate_expr(GFH, false, PrintResults, GsGFH, GFHV), - translate_args(GFA, false, PrintResults, GsGFA, GFAv), + translate_expr(GFH, Execute, GsGFH, GFHV), + translate_args(GFA, Execute, GsGFA, GFAv), append(GsGFH, GsGFA, GsGF), GenList = [GFHV|GFAv] - ; translate_expr(GF, false, PrintResults, GsGF, GFHV), + ; translate_expr(GF, Execute, GsGF, GFHV), GenList = [GFHV] ), append(GsH, GsAF, Tmp1), append(Tmp1, GsGF, Tmp2), append(Tmp2, [ConjInit, foldall(agg_reduce(AFV, V), reduce(GenList, V), Init, Out)], Goals) %--- Higher-order functions with pseudo-lambdas and lambdas ---: ; HV == 'foldl-atom', T = [List, Init, AccVar, XVar, Body] - -> translate_expr_to_conj(List, ConjList, L), - translate_expr_to_conj(Init, ConjInit, InitV), - translate_expr_to_conj(Body, BodyConj, BG), + -> translate_expr_to_conj(List, Execute, ConjList, L), + translate_expr_to_conj(Init, Execute, ConjInit, InitV), + translate_expr_to_conj(Body, Execute, BodyConj, BG), exclude(==(true), [ConjList, ConjInit], CleanConjs), append(GsH, CleanConjs, GsMid), append(GsMid, [foldl([XVar, AccVar, NewAcc]>>(BodyConj, ( number(BG) -> NewAcc is BG ; NewAcc = BG )), L, InitV, Out)], Goals) ; HV == 'map-atom', T = [List, XVar, Body] - -> translate_expr_to_conj(List, ConjList, L), - translate_expr_to_conj(Body, BodyCallConj, BodyCall), + -> translate_expr_to_conj(List, Execute, ConjList, L), + translate_expr_to_conj(Body, Execute, BodyCallConj, BodyCall), exclude(==(true), [ConjList], CleanConjs), append(GsH, CleanConjs, GsMid), append(GsMid, [maplist([XVar, Y]>>(BodyCallConj, ( number(BodyCall) -> Y is BodyCall ; Y = BodyCall )), L, Out)], Goals) ; HV == 'filter-atom', T = [List, XVar, Cond] - -> translate_expr_to_conj(List, ConjList, L), - translate_expr_to_conj(Cond, CondConj, CondGoal), + -> translate_expr_to_conj(List, Execute, ConjList, L), + translate_expr_to_conj(Cond, Execute, CondConj, CondGoal), exclude(==(true), [ConjList], CleanConjs), append(GsH, CleanConjs, GsMid), append(GsMid, [include([XVar]>>(CondConj, CondGoal), L, Out)], Goals) - ; HV == '|->', T = [Args, Body] -> next_lambda_name(F), - % find free (non-argument) variables in Body - term_variables(Body, AllVars), - term_variables(Args, ArgVars), - exclude({ArgVars}/[V]>>memberchk_eq(V, ArgVars), AllVars, FreeVars), - append(FreeVars, Args, FullArgs), - % compile clause with all bound + free vars - translate_clause([=, [F|FullArgs], Body], Clause), - register_fun(F), - assertz(Clause), - format(atom(Label), "metta lambda (~w)", [F]), - maybe_print_compiled_clause(Label, ['|->', Args, Body], Clause), - length(FullArgs, N), - Arity is N + 1, - assertz(arity(F, Arity)), - % emit closure capturing the environment (free vars) - ( FreeVars == [] -> Out = F - ; Out = partial(F, FreeVars) ) + ; HV == '|->', T = [Args, Body], Execute == true + -> next_lambda_name(F), + term_variables(Body, AllVars), + term_variables(Args, ArgVars), + exclude({ArgVars}/[V]>>memberchk_eq(V, ArgVars), AllVars, FreeVars), + append(FreeVars, Args, FullArgs), + translate_clause([=, [F|FullArgs], Body], Clause), + register_fun(F), + assertz(Clause), + format(atom(Label), "metta lambda (~w)", [F]), + maybe_print_compiled_clause(Label, ['|->', Args, Body], Clause), + length(FullArgs, N), + Arity is N + 1, + assertz(arity(F, Arity)), + ( FreeVars == [] -> Out = F, Goals = GsH + ; Out = partial(F, FreeVars), Goals = GsH ) + ; HV == '|->', T = [Args, Body], Execute == false + -> next_lambda_name(F), + % find free (non-argument) variables in Body + term_variables(Body, AllVars), + term_variables(Args, ArgVars), + exclude({ArgVars}/[V]>>memberchk_eq(V, ArgVars), AllVars, FreeVars), + append(FreeVars, Args, FullArgs), + translate_clause([=, [F|FullArgs], Body], Clause), + % Copy the clause so it doesn't share variables with FreeVars + % This ensures assertz gets a fresh template when FreeVars are bound + copy_term(Clause, ClauseCopy), + format(atom(Label), "metta lambda (~w)", [F]), + maybe_print_compiled_clause(Label, ['|->', Args, Body], Clause), + length(FullArgs, N), + Arity is N + 1, + ( FreeVars == [] -> OutValue = F + ; OutValue = partial(F, FreeVars) ), + LambdaConstructionGoals = [ + register_fun(F), + assertz(ClauseCopy), + assertz(arity(F, Arity)), + Out = OutValue + ], + append(GsH, LambdaConstructionGoals, Goals) %--- Spaces ---: ; ( HV == 'add-atom' ; HV == 'remove-atom' ), T = [_,_] -> append(T, [Out], RawArgs), Goal =.. [HV|RawArgs], append(GsH, [Goal], Goals) - ; HV == match, T = [Space, Pattern, Body] -> translate_expr(Space, false, PrintResults, G1, S), - translate_expr(Body, false, PrintResults, GsB, Out), + ; HV == match, T = [Space, Pattern, Body] -> translate_expr(Space, Execute, G1, S), + translate_expr(Body, Execute, GsB, Out), append(G1, [match(S, Pattern, Out, Out)], G2), append(G2, GsB, Goals) %--- Predicate to compiled goal ---: ; HV == translatePredicate, T = [Expr] -> Expr = [S|Args], - translate_args(Args, false, PrintResults, GsArgs, ArgsOut), + translate_args(Args, Execute, GsArgs, ArgsOut), Goal =.. [S|ArgsOut], append(GsH, GsArgs, Inner), append(Inner, [Goal], Goals) %--- Manual dispatch options: --- %Generate a predicate call on compilation, translating Args for nesting: ; HV == call, T = [Expr] -> Expr = [F|Args], - translate_args(Args, false, PrintResults, GsArgs, ArgsOut), + translate_args(Args, Execute, GsArgs, ArgsOut), append(GsH, GsArgs, Inner), append(ArgsOut, [Out], CallArgs), Goal =.. [F|CallArgs], append(Inner, [Goal], Goals) %Produce a dynamic dispatch, translating Args for nesting: - ; HV == reduce, T = [Expr] -> ( var(Expr) -> translate_expr(Expr, false, PrintResults, GsH, ExprOut), + ; HV == reduce, T = [Expr] -> ( var(Expr) -> translate_expr(Expr, Execute, GsH, ExprOut), Goals = [reduce(ExprOut, Out)|GsH] ; Expr = [F|Args], - translate_args(Args, false, PrintResults, GsArgs, ArgsOut), + translate_args(Args, Execute, GsArgs, ArgsOut), append(GsH, GsArgs, Inner), ExprOut = [F|ArgsOut], append(Inner, [reduce(ExprOut, Out)], Goals) ) @@ -291,7 +313,7 @@ Out = Expr, Goals = Inner ; HV == 'catch', T = [Expr] -> - translate_expr(Expr, false, PrintResults, GsExpr, ExprOut), + translate_expr(Expr, Execute, GsExpr, ExprOut), append(GsH, [], Inner), goals_list_to_conj(GsExpr, Conj), Goal = catch((Conj, Out = ExprOut), @@ -300,42 +322,181 @@ ; Out = ['Error', Exception])), append(Inner, [Goal], Goals) %--- Automatic 'smart' dispatch, translator deciding when to create a predicate call, data list, or dynamic dispatch: --- - ; translate_args(T, false, PrintResults, GsT, AVs), + ; translate_args(T, Execute, GsT, AVs), append(GsH, GsT, Inner), - %Known function => direct call: - ( is_list(AVs), - ( atom(HV), fun(HV), Fun = HV, AllAVs = AVs, IsPartial = false - ; compound(HV), HV = partial(Fun, Bound), append(Bound,AVs,AllAVs), IsPartial = true - ) % Check for type definition [:,HV,TypeChain] - -> findall(TypeChain, catch(match('&self', [':', Fun, TypeChain], TypeChain, TypeChain), _, fail), TypeChains), - ( TypeChains \= [] - -> maplist({Fun,T,GsH,IsPartial,Bound,Out}/[TypeChain,BranchGoal]>>( - typed_functioncall_branch(Fun, TypeChain, T, GsH, IsPartial, Bound, Out, BranchGoal)), TypeChains, Branches), - disj_list(Branches, Disj), - Goals = [Disj] - ; build_call_or_partial(Fun, AllAVs, Out, Inner, [], Goals)) - %Literals (numbers, strings, etc.), known non-function atom => data: - ; ( atomic(HV), \+ atom(HV) ; atom(HV), \+ fun(HV) ) -> Out = [HV|AVs], - Goals = Inner - %Plain data list: evaluate inner fun-sublists - ; is_list(HV) -> eval_data_term(HV, Gd, HV1), - append(Inner, Gd, Goals), - Out = [HV1|AVs] - %Unknown head (var/compound) => runtime dispatch: - ; append(Inner, [reduce([HV|AVs], Out)], Goals) )). + % Old implementation + % smart_dispatch(HV, T, Execute, GsH, GsT, Inner, AVs, Goals, Out)). + ( Execute -> + smart_dispatch_execute(HV, T, GsH, GsT, Inner, AVs, Goals, Out) + ; smart_dispatch_compile(HV, T, GsH, GsT, Inner, AVs, Goals, Out) + ) + ). + +%Automatic 'smart' dispatch implementation: +smart_dispatch(HV, T, Execute, GsH, _GsT, Inner, AVs, Goals, Out) :- + %Known function => direct call: + ( is_list(AVs), + ( atom(HV), fun(HV), Fun = HV, AllAVs = AVs, IsPartial = false + ; compound(HV), HV = partial(Fun, Bound), append(Bound,AVs,AllAVs), IsPartial = true + ) % Check for type definition [:,HV,TypeChain] + -> findall(TypeChain, catch(match('&self', [':', Fun, TypeChain], TypeChain, TypeChain), _, fail), TypeChains), + ( TypeChains \= [] + -> maplist({Execute,Fun,T,GsH,IsPartial,Bound,Out}/[TypeChain,BranchGoal]>>( + typed_functioncall_branch(Fun, TypeChain, T, GsH, IsPartial, Bound, Out, BranchGoal)), TypeChains, Branches), + disj_list(Branches, Disj), + Goals = [Disj] + ; (Execute -> + build_call_or_partial(Fun, AllAVs, Out, Inner, [], Goals)) + ; append(Inner, [runtime_call(Fun, AVs, Out)], Goals) + ) + %Literals (numbers, strings, etc.), known non-function atom => data: + ; ( atomic(HV), \+ atom(HV) ) -> Out = [HV|AVs], + Goals = Inner + ; atom(HV), \+ fun(HV) -> ( Execute -> Out = [HV|AVs], Goals = Inner + ; append(Inner, [runtime_call(HV, AVs, Out)], Goals) ) + %Plain data list: evaluate inner fun-sublists + ; is_list(HV) -> eval_data_term(Execute, HV, Gd, HV1), + append(Inner, Gd, Goals), + Out = [HV1|AVs] + %Unknown head (var/compound) => runtime dispatch: + ; append(Inner, [reduce([HV|AVs], Out)], Goals) ). + +%Automatic 'smart' dispatch specialized for Execute=true (interpreter mode): +smart_dispatch_execute(HV, T, GsH, _GsT, Inner, AVs, Goals, Out) :- + %Known function => direct call: + ( is_list(AVs), + ( atom(HV), fun(HV), Fun = HV, AllAVs = AVs, IsPartial = false + ; compound(HV), HV = partial(Fun, Bound), append(Bound,AVs,AllAVs), IsPartial = true + ) % Check for type definition [:,HV,TypeChain] + -> findall(TypeChain, catch(match('&self', [':', Fun, TypeChain], TypeChain, TypeChain), _, fail), TypeChains), + ( TypeChains \= [] + -> maplist({Fun,T,GsH,IsPartial,Bound,Out}/[TypeChain,BranchGoal]>>( + typed_functioncall_branch(Fun, TypeChain, T, GsH, IsPartial, Bound, Out, BranchGoal)), TypeChains, Branches), + disj_list(Branches, Disj), + Goals = [Disj] + ; length(AllAVs, N), + Arity is N + 1, + ( maybe_specialize_call(Fun, AllAVs, Out, Goal) + -> % Specialization succeeded during execution - use it + append(Inner, [Goal], Goals) + ; ( current_predicate(Fun/Arity) ; catch(arity(Fun, Arity), _, fail) ), + \+ ( current_op(_, _, Fun), Arity =< 2 ) + -> % Direct call during execution + append(AllAVs, [Out], Args), + Goal =.. [Fun|Args], + append(Inner, [Goal], Goals) + ; Out = partial(Fun, AllAVs), + append(Inner, [], Goals) + ) + ) + %Literals (numbers, strings, etc.), known non-function atom => data: + ; ( atomic(HV), \+ atom(HV) ) -> Out = [HV|AVs], + Goals = Inner + ; atom(HV), \+ fun(HV) -> Out = [HV|AVs], Goals = Inner + %Plain data list: evaluate inner fun-sublists + ; is_list(HV) -> eval_data_term(true, HV, Gd, HV1), + append(Inner, Gd, Goals), + Out = [HV1|AVs] + %Unknown head (var/compound) => runtime dispatch: + ; append(Inner, [reduce([HV|AVs], Out)], Goals) ). + +%Automatic 'smart' dispatch specialized for Execute=false (compiler mode): +smart_dispatch_compile(HV, T, GsH, _GsT, Inner, AVs, Goals, Out) :- + %Check for function call that might need type-aware handling: + ( atom(HV) + -> % Use runtime_call_typed to defer type checking to runtime + % Pass original unevaluated arguments T, not translated AVs + append(GsH, [runtime_call_typed(HV, T, Out)], Goals) + ; compound(HV), HV = partial(Fun, Bound) + -> % Partial application - append bound args to new args at runtime + append(GsH, [runtime_call_typed_partial(Fun, Bound, T, Out)], Goals) + %Literals (numbers, strings, etc.), known non-function atom => data: + ; ( atomic(HV), \+ atom(HV) ) -> Out = [HV|AVs], + Goals = Inner + %Plain data list: evaluate inner fun-sublists + ; is_list(HV) -> eval_data_term(false, HV, Gd, HV1), + append(Inner, Gd, Goals), + Out = [HV1|AVs] + %Unknown head (var/compound) => runtime dispatch: + ; append(Inner, [reduce([HV|AVs], Out)], Goals) ). %Generate actual function call or partial if arity not complete: -build_call_or_partial(Fun, AVs, Out, Inner, Extra, Goals) :- length(AVs, N), - Arity is N + 1, - ( maybe_specialize_call(Fun, AVs, Out, Goal) - -> append(Inner, [Goal|Extra], Goals) - ; ( ( current_predicate(Fun/Arity) ; catch(arity(Fun, Arity), _, fail) ), - \+ ( current_op(_, _, Fun), Arity =< 2 ) ) - -> append(AVs, [Out], Args), - Goal =.. [Fun|Args], - append(Inner, [Goal|Extra], Goals) - ; Out = partial(Fun, AVs), - append(Inner, Extra, Goals) ). +build_call_or_partial(Fun, AVs, Out, Inner, Extra, Goals) :- + length(AVs, N), + Arity is N + 1, + ( maybe_specialize_call(Fun, AVs, Out, Goal) + -> % Specialization succeeded during execution - use it + append(Inner, [Goal|Extra], Goals) + ; ( current_predicate(Fun/Arity) ; catch(arity(Fun, Arity), _, fail) ), + \+ ( current_op(_, _, Fun), Arity =< 2 ) + -> % Direct call during execution + append(AVs, [Out], Args), + Goal =.. [Fun|Args], + append(Inner, [Goal|Extra], Goals) + ; Out = partial(Fun, AVs), + append(Inner, Extra, Goals) + ). + +% Runtime call helper: replicates what build_call_or_partial does when Execute=true +% This allows compiled programs to benefit from specialization +% Falls back to reduce for edge cases (partial applications, non-callables, etc.) +runtime_call(Fun, AVs, Out) :- + length(AVs, N), + Arity is N + 1, + ( maybe_specialize_call(Fun, AVs, Out, Goal) + -> % Specialization succeeded - call it + writeln("specialization path."), + call(Goal) + ; fun(Fun), + (current_predicate(Fun/Arity) ; catch(arity(Fun, Arity), _, fail) ), + \+ ( current_op(_, _, Fun), Arity =< 2 ) + -> % Direct call + append(AVs, [Out], Args), + Goal =.. [Fun|Args], + call(Goal) + ; % Not callable as predicate - use reduce for proper handling + reduce([Fun|AVs], Out) + ). + +% Runtime type-aware call: checks for type information at runtime and handles argument translation +% This is used by the compiler to defer type-aware translation to runtime +runtime_call_typed(Fun, OrigArgs, Out) :- + % Check for type information at runtime + findall(TypeChain, catch(match('&self', [':', Fun, TypeChain], TypeChain, TypeChain), _, fail), TypeChains), + ( TypeChains \= [], TypeChains = [TypeChain|_] + -> % Type information exists - translate arguments according to their types + TypeChain = [->|Xs], + append(ArgTypes, [_OutType], Xs), + translate_args_by_type_runtime(OrigArgs, ArgTypes, AVs), + runtime_call(Fun, AVs, Out) + ; % No type information - evaluate all arguments and call + translate_args_runtime(OrigArgs, AVs), + runtime_call(Fun, AVs, Out) + ). + +% Helper: translate arguments at runtime according to their types +translate_args_by_type_runtime([], _, []) :- !. +translate_args_by_type_runtime([A|As], [T|Ts], [AV|AVs]) :- + ( T == 'Expression' + -> % Keep as data - don't evaluate + AV = A + ; % Evaluate the argument + translate_expr_to_conj(A, true, Conj, AV), + call(Conj) + ), + translate_args_by_type_runtime(As, Ts, AVs). + +% Helper: translate/evaluate all arguments at runtime (no type info) +translate_args_runtime([], []) :- !. +translate_args_runtime([A|As], [AV|AVs]) :- + translate_expr_to_conj(A, true, Conj, AV), + call(Conj), + translate_args_runtime(As, AVs). + +% Runtime type-aware call for partial applications +runtime_call_typed_partial(Fun, Bound, NewArgs, Out) :- + append(Bound, NewArgs, AllArgs), + runtime_call_typed(Fun, AllArgs, Out). %Type function call generation, returns function call plus typechecks for input and output: typed_functioncall_branch(Fun, TypeChain, T, GsH, IsPartial, Bound, Out, BranchGoal) :- @@ -354,7 +515,7 @@ translate_args_by_type([], _, [], []) :- !. translate_args_by_type([A|As], [T|Ts], GsOut, [AV|AVs]) :- ( T == 'Expression' -> AV = A, GsA = [] - ; translate_expr(A, false, false, GsA1, AV), + ; translate_expr(A, true, GsA1, AV), ( (T == '%Undefined%' ; T == 'Atom') -> GsA = GsA1 ; append(GsA1, [('get-type'(AV, T) *-> true ; 'get-metatype'(AV, T))], GsA))), @@ -362,15 +523,20 @@ append(GsA, GsRest, GsOut). %Handle data list: -eval_data_term(X, [], X) :- (var(X); atomic(X)), !. -eval_data_term([F|As], Goals, Val) :- ( atom(F), fun(F) -> translate_expr([F|As], false, false, Goals, Val) - ; eval_data_list([F|As], Goals, Val) ). +eval_data_term(_Execute, X, [], X) :- (var(X); atomic(X)), !. +eval_data_term(Execute, [F|As], Goals, Val) :- + % When Execute=true (interpreter), evaluate functions in data lists + % When Execute=false (compiling), treat everything as pure data for runtime flexibility + ( Execute, atom(F), fun(F) + -> translate_expr([F|As], Execute, Goals, Val) + ; eval_data_list(Execute, [F|As], Goals, Val) ). %Handle data list entry: -eval_data_list([], [], []). -eval_data_list([E|Es], Goals, [V|Vs]) :- ( is_list(E) -> eval_data_term(E, G1, V) ; V = E, G1 = [] ), - eval_data_list(Es, G2, Vs), - append(G1, G2, Goals). +eval_data_list(_Execute, [], [], []). +eval_data_list(Execute, [E|Es], Goals, [V|Vs]) :- + ( is_list(E) -> eval_data_term(Execute, E, G1, V) ; V = E, G1 = [] ), + eval_data_list(Execute, Es, G2, Vs), + append(G1, G2, Goals). %Convert let* to recusrive let: @@ -389,7 +555,7 @@ ; Goal = (Val = Out, Con). %Translate case expression recursively into nested if: -translate_case([[K,VExpr]|Rs], Kv, Out, Goal, KGo) :- translate_expr_to_conj(VExpr, ConV, VOut), +translate_case([[K,VExpr]|Rs], Kv, Out, Goal, KGo) :- translate_expr_to_conj(VExpr, true, ConV, VOut), constrain_args(K, Kc, Gc), build_branch(ConV, VOut, Out, Then), ( Rs == [] -> Goal = ((Kv = Kc) -> Then), KGi=[] @@ -398,12 +564,12 @@ append([Gc,KGi], KGo). % Wrapper for interpreter mode -translate_args(Xs, Goals, Vs) :- translate_args(Xs, false, false, Goals, Vs). +translate_args(Xs, Goals, Vs) :- translate_args(Xs, true, Goals, Vs). %Translate arguments recursively: -translate_args([], _TopLevel, _PrintResults, [], []). -translate_args([X|Xs], TopLevel, PrintResults, Goals, [V|Vs]) :- - translate_expr(X, TopLevel, PrintResults, G1, V), - translate_args(Xs, TopLevel, PrintResults, G2, Vs), +translate_args([], _Execute, [], []). +translate_args([X|Xs], Execute, Goals, [V|Vs]) :- + translate_expr(X, Execute, G1, V), + translate_args(Xs, Execute, G2, Vs), append(G1, G2, Goals). %Build A ; B ; C ... from a list: @@ -412,13 +578,13 @@ %Build one disjunct per branch: (Conj, Out = Val): build_superpose_branches([], _, []). -build_superpose_branches([E|Es], Out, [B|Bs]) :- translate_expr_to_conj(E, Conj, Val), +build_superpose_branches([E|Es], Out, [B|Bs]) :- translate_expr_to_conj(E, true, Conj, Val), build_branch(Conj, Val, Out, B), build_superpose_branches(Es, Out, Bs). %Build hyperpose branch as a goal list for concurrent_maplist to consume: build_hyperpose_branches([], []). -build_hyperpose_branches([E|Es], [(Goal, Res)|Bs]) :- translate_expr_to_conj(E, Goal, Res), +build_hyperpose_branches([E|Es], [(Goal, Res)|Bs]) :- translate_expr_to_conj(E, true, Goal, Res), build_hyperpose_branches(Es, Bs). %Like membercheck but with direct equality rather than unification diff --git a/src/translator_backup.pl b/src/translator_backup.pl new file mode 100644 index 00000000..76874088 --- /dev/null +++ b/src/translator_backup.pl @@ -0,0 +1,489 @@ +%Pattern matching, structural and functional/relational constraints on arguments: +constrain_args(X, X, []) :- (var(X); atomic(X)), !. +constrain_args([F, A, B], Out, Goals) :- nonvar(F), + F == cons, + constrain_args(A, A1, G1), + constrain_args(B, B1, G2), + Out = [A1|B1], + append(G1, G2, Goals), !. +constrain_args([F|Args], Var, Goals) :- atom(F), + fun(F), !, + translate_expr([F|Args], true, GoalsExpr, Var), + flatten(GoalsExpr, Goals). +constrain_args(In, Out, Goals) :- maplist(constrain_args, In, Out, NestedGoalsList), + flatten(NestedGoalsList, Goals), !. + +%Flatten (= Head Body) MeTTa function into Prolog Clause: +translate_clause(Input, (Head :- BodyConj)) :- translate_clause(Input, (Head :- BodyConj), true). +translate_clause(Input, (Head :- BodyConj), ConstrainArgs) :- + Input = [=, [F|Args0], BodyExpr], + ( ConstrainArgs -> maplist(constrain_args, Args0, Args1, GoalsA), + flatten(GoalsA,GoalsPrefix) + ; Args1 = Args0, GoalsPrefix = [] ), + catch(nb_getval(F, Prev), _, Prev = []), + nb_setval(F, [fun_meta(Args1, BodyExpr) | Prev]), + translate_expr(BodyExpr, true, GoalsBody, ExpOut), + ( nonvar(ExpOut) , ExpOut = partial(Base,Bound) + -> current_predicate(Base/Arity), length(Bound, N), M is (Arity - N) - 1, + length(ExtraArgs, M), append([Bound,ExtraArgs,[Out]],CallArgs), Goal =.. [Base|CallArgs], + append(GoalsBody,[Goal],FinalGoals), append(Args1,ExtraArgs,HeadArgs) + ; FinalGoals= GoalsBody , HeadArgs = Args1, Out = ExpOut ), + append(HeadArgs, [Out], FinalArgs), + Head =.. [F|FinalArgs], + append(GoalsPrefix, FinalGoals, Goals), + goals_list_to_conj(Goals, BodyConj). + +%Print compiled clause: +maybe_print_compiled_clause(_, _, _) :- catch(silent(true), _, true), !. +maybe_print_compiled_clause(Label, FormTerm, Clause) :- + swrite(FormTerm, FormStr), + format("\e[33m--> ~w -->~n\e[36m~w~n\e[33m--> prolog clause -->~n\e[32m", [Label, FormStr]), + portray_clause(current_output, Clause), + format("\e[33m^^^^^^^^^^^^^^^^^^^^^~n\e[0m"). + +%Conjunction builder, turning goals list to a flat conjunction: +goals_list_to_conj([], true) :- !. +goals_list_to_conj([G], G) :- !. +goals_list_to_conj([G|Gs], (G,R)) :- goals_list_to_conj(Gs, R). + +% Runtime dispatcher: call F if it's a registered fun/1, else keep as list: +reduce([F|Args], Out) :- nonvar(F), atom(F), fun(F) + -> % --- Case 1: callable predicate --- + length(Args, N), + Arity is N + 1, + ( current_predicate(F/Arity) , \+ (current_op(_, _, F), Arity =< 2) + -> append(Args,[Out],CallArgs), + Goal =.. [F|CallArgs], + catch(call(Goal),_,fail) + ; Out = partial(F,Args) ) + ; % --- Case 2: partial closure --- + compound(F), F = partial(Base, Bound) -> append(Bound, Args, NewArgs), + reduce([Base|NewArgs], Out) + ; % --- Case 3: leave unevaluated --- + Out = [F|Args], + \+ cyclic_term(Out). + +%Calling reduce from aggregate function foldall needs this argument wrapping +agg_reduce(AF, Acc, Val, NewAcc) :- reduce([AF, Acc, Val], NewAcc). + +%Combined expr translation to goals list +% Default wrapper for backward compatibility (interpreter mode) +translate_expr_to_conj(Input, Conj, Out) :- translate_expr_to_conj(Input, true, Conj, Out). +% Version that propagates Execute parameter +translate_expr_to_conj(Input, Execute, Conj, Out) :- translate_expr(Input, Execute, Goals, Out), + goals_list_to_conj(Goals, Conj). + +%Special stream operation rewrite rules before main translation +rewrite_streamops(['trace!', Arg1, Arg2], + [progn, ['println!', Arg1], Arg2]). +rewrite_streamops([unique, [superpose|Args]], + [call, [superpose, ['unique-atom', [collapse, [superpose|Args]]]]]). +rewrite_streamops([union, [superpose|A], [superpose|B]], + [call, [superpose, ['union-atom', [collapse, [superpose|A]], + [collapse, [superpose|B]]]]]). +rewrite_streamops([intersection, [superpose|A], [superpose|B]], + [call, [superpose, ['intersection-atom', [collapse, [superpose|A]], + [collapse, [superpose|B]]]]]). +rewrite_streamops([subtraction, [superpose|A], [superpose|B]], + [call, [superpose, ['subtraction-atom', [collapse, [superpose|A]], + [collapse, [superpose|B]]]]]). +rewrite_streamops(X, X). + +%Guarded stream ops rewrite rule application, successfully avoiding copy_term: +safe_rewrite_streamops(In, Out) :- ( compound(In), In = [Op|_], atom(Op) -> rewrite_streamops(In, Out) + ; Out = In). + +% Wrapper for interpreter mode: translate_expr/3 defaults to Execute=true +translate_expr(X, Goals, Out) :- translate_expr(X, true, Goals, Out). +%Turn MeTTa code S-expression into goals list: +translate_expr(X, _Execute, [], X) :- ((var(X) ; atomic(X)) ; X = partial(_,_)), !. +translate_expr([H0|T0], Execute, Goals, Out) :- + safe_rewrite_streamops([H0|T0],[H|T]), + translate_expr(H, Execute, GsH, HV), + %--- Translator rules ---: + ( nonvar(HV), translator_rule(HV) -> ( catch(match('&self', [':', HV, TypeChain], TypeChain, TypeChain), _, fail) + -> TypeChain = [->|Xs], + append(ArgTypes, [_], Xs), + translate_args_by_type(T, ArgTypes, GsT, T1) + ; translate_args(T, GsT, T1) ), + append(T1,[Gs],Args), + HookCall =.. [HV|Args], + call(HookCall), + translate_expr(Gs, Execute, GsE, Out), + append([GsH,GsT,GsE],Goals) + %--- Non-determinism ---: + ; HV == superpose, T = [Args], is_list(Args) -> build_superpose_branches(Args, Out, Branches), + disj_list(Branches, Disj), + append(GsH, [Disj], Goals) + ; HV == collapse, T = [E] -> translate_expr_to_conj(E, Execute, Conj, EV), + % Always just collect results with findall + % (result printing is handled at higher level in filereader.pl) + append(GsH, [(findall(EV, Conj, Out))], Goals) + ; HV == cut, T = [] -> append(GsH, [(!)], Goals), + Out = true + ; HV == test, T = [Expr, Expected] -> translate_expr_to_conj(Expr, Execute, Conj, Val), + translate_expr(Expected, Execute, GsE, ExpVal), + Goal1 = ( findall(Val, Conj, Results), + (Results = [Actual] -> true + ; Actual = Results ) ), + append(GsH, [Goal1], G1), + append(G1, GsE, G2), + append(G2, [test(Actual, ExpVal, Out)], Goals) + ; HV == once, T = [X] -> translate_expr_to_conj(X, Execute, Conj, Out), + append(GsH, [once(Conj)], Goals) + ; HV == hyperpose, T = [L] -> build_hyperpose_branches(L, Branches), + append(GsH, [concurrent_and(member((Goal,Res), Branches), (call(Goal), Out = Res))], Goals) + ; HV == with_mutex, T = [M,X] -> translate_expr_to_conj(X, Execute, Conj, Out), + append(GsH, [with_mutex(M,Conj)], Goals) + ; HV == transaction, T = [X] -> translate_expr_to_conj(X, Execute, Conj, Out), + append(GsH, [transaction(Conj)], Goals) + %--- Sequential execution ---: + ; HV == progn, T = Exprs -> translate_args(Exprs, Execute, GsList, Outs), + append(GsH, GsList, Tmp), + last(Outs, Out), + Goals = Tmp + ; HV == prog1, T = Exprs -> Exprs = [First|Rest], + translate_expr(First, Execute, GsF, Out), + translate_args(Rest, Execute, GsRest, _), + append(GsH, GsF, Tmp1), + append(Tmp1, GsRest, Goals) + %--- Conditionals ---: + ; HV == if, T = [Cond, Then] -> translate_expr_to_conj(Cond, Execute, ConC, Cv), + translate_expr_to_conj(Then, Execute, ConT, Tv), + build_branch(ConT, Tv, Out, BT), + ( ConC == true -> append(GsH, [ ( Cv == true -> BT ) ], Goals) + ; append(GsH, [ ( ConC, ( Cv == true -> BT ) ) ], Goals) ) + ; HV == if, T = [Cond, Then, Else] -> translate_expr_to_conj(Cond, Execute, ConC, Cv), + translate_expr_to_conj(Then, Execute, ConT, Tv), + translate_expr_to_conj(Else, Execute, ConE, Ev), + build_branch(ConT, Tv, Out, BT), + build_branch(ConE, Ev, Out, BE), + ( ConC == true -> append(GsH, [ (Cv == true -> BT ; BE) ], Goals) + ; append(GsH, [ (ConC, (Cv == true -> BT ; BE)) ], Goals) ) + ; HV == case, T = [KeyExpr, PairsExpr] -> ( select(Found0, PairsExpr, Rest0), + subsumes_term(['Empty', _], Found0), + Found0 = ['Empty', DefaultExpr], + NormalCases = Rest0 + -> translate_expr_to_conj(KeyExpr, Execute, GkConj, Kv), + translate_case(NormalCases, Kv, Out, CaseGoal, KeyGoal), + translate_expr_to_conj(DefaultExpr, Execute, ConD, DOut), + build_branch(ConD, DOut, Out, DefaultThen), + Combined = ( (GkConj, CaseGoal) ; + \+ GkConj, DefaultThen ), + append([GsH, KeyGoal, [Combined]], Goals) + ; translate_expr(KeyExpr, Execute, Gk, Kv), + translate_case(PairsExpr, Kv, Out, IfGoal, KeyGoal), + append([GsH, Gk, KeyGoal, [IfGoal]], Goals) ) + %--- Unification constructs ---: + ; (HV == let ; HV == chain), T = [Pat, Val, In] -> translate_expr(Pat, Execute, Gp, Pv), + translate_expr(Val, Execute, Gv, V), + translate_expr(In, Execute, Gi, Out), + append([GsH,[(Pv=V)],Gp,Gv,Gi], Goals) + ; HV == 'let*', T = [Binds, Body] -> letstar_to_rec_let(Binds,Body,RecLet), + translate_expr(RecLet, Execute, Goals, Out) + ; HV == sealed, T = [Vars, Expr] -> translate_expr_to_conj(Expr, Execute, Con, Val), + Goals = [copy_term(Vars,[Con,Val],_,[Ncon,Out]),Ncon] + %--- Iterating over non-deterministic generators without reification ---: + ; HV == 'forall', T = [GF, TF] + -> ( is_list(GF) -> GF = [GFH|GFA], + translate_expr(GFH, Execute, GsGFH, GFHV), + translate_args(GFA, Execute, GsGFA, GFAv), + append(GsGFH, GsGFA, GsGF), + GenList = [GFHV|GFAv] + ; translate_expr(GF, Execute, GsGF, GFHV), + GenList = [GFHV] ), + translate_expr(TF, Execute, GsTF, TFHV), + TestList = [TFHV, V], + goals_list_to_conj(GsGF, GPre), + GenGoal = (GPre, reduce(GenList, V)), + append(GsH, GsTF, Tmp0), + append(Tmp0, [( forall(GenGoal, ( reduce(TestList, Truth), Truth == true )) -> Out = true ; Out = false )], Goals) + ; HV == 'foldall', T = [AF, GF, InitS] + -> translate_expr_to_conj(InitS, Execute, ConjInit, Init), + translate_expr(AF, Execute, GsAF, AFV), + ( GF = [M|_], (M==match ; M==let ; M=='let*') -> LambdaGF = ['|->', [], GF], + translate_expr(LambdaGF, Execute, GsGF, GFHV), + GenList = [GFHV] + ; is_list(GF) -> GF = [GFH|GFA], + translate_expr(GFH, Execute, GsGFH, GFHV), + translate_args(GFA, Execute, GsGFA, GFAv), + append(GsGFH, GsGFA, GsGF), + GenList = [GFHV|GFAv] + ; translate_expr(GF, Execute, GsGF, GFHV), + GenList = [GFHV] ), + append(GsH, GsAF, Tmp1), + append(Tmp1, GsGF, Tmp2), + append(Tmp2, [ConjInit, foldall(agg_reduce(AFV, V), reduce(GenList, V), Init, Out)], Goals) + %--- Higher-order functions with pseudo-lambdas and lambdas ---: + ; HV == 'foldl-atom', T = [List, Init, AccVar, XVar, Body] + -> translate_expr_to_conj(List, Execute, ConjList, L), + translate_expr_to_conj(Init, Execute, ConjInit, InitV), + translate_expr_to_conj(Body, Execute, BodyConj, BG), + exclude(==(true), [ConjList, ConjInit], CleanConjs), + append(GsH, CleanConjs, GsMid), + append(GsMid, [foldl([XVar, AccVar, NewAcc]>>(BodyConj, ( number(BG) -> NewAcc is BG ; NewAcc = BG )), L, InitV, Out)], Goals) + ; HV == 'map-atom', T = [List, XVar, Body] + -> translate_expr_to_conj(List, Execute, ConjList, L), + translate_expr_to_conj(Body, Execute, BodyCallConj, BodyCall), + exclude(==(true), [ConjList], CleanConjs), + append(GsH, CleanConjs, GsMid), + append(GsMid, [maplist([XVar, Y]>>(BodyCallConj, ( number(BodyCall) -> Y is BodyCall ; Y = BodyCall )), L, Out)], Goals) + ; HV == 'filter-atom', T = [List, XVar, Cond] + -> translate_expr_to_conj(List, Execute, ConjList, L), + translate_expr_to_conj(Cond, Execute, CondConj, CondGoal), + exclude(==(true), [ConjList], CleanConjs), + append(GsH, CleanConjs, GsMid), + append(GsMid, [include([XVar]>>(CondConj, CondGoal), L, Out)], Goals) + ; HV == '|->', T = [Args, Body], Execute == true + -> next_lambda_name(F), + term_variables(Body, AllVars), + term_variables(Args, ArgVars), + exclude({ArgVars}/[V]>>memberchk_eq(V, ArgVars), AllVars, FreeVars), + append(FreeVars, Args, FullArgs), + translate_clause([=, [F|FullArgs], Body], Clause), + register_fun(F), + assertz(Clause), + format(atom(Label), "metta lambda (~w)", [F]), + maybe_print_compiled_clause(Label, ['|->', Args, Body], Clause), + length(FullArgs, N), + Arity is N + 1, + assertz(arity(F, Arity)), + ( FreeVars == [] -> Out = F, Goals = GsH + ; Out = partial(F, FreeVars), Goals = GsH ) + ; HV == '|->', T = [Args, Body], Execute == false + -> next_lambda_name(F), + % find free (non-argument) variables in Body + term_variables(Body, AllVars), + term_variables(Args, ArgVars), + exclude({ArgVars}/[V]>>memberchk_eq(V, ArgVars), AllVars, FreeVars), + append(FreeVars, Args, FullArgs), + translate_clause([=, [F|FullArgs], Body], Clause), + % Copy the clause so it doesn't share variables with FreeVars + % This ensures assertz gets a fresh template when FreeVars are bound + copy_term(Clause, ClauseCopy), + format(atom(Label), "metta lambda (~w)", [F]), + maybe_print_compiled_clause(Label, ['|->', Args, Body], Clause), + length(FullArgs, N), + Arity is N + 1, + ( FreeVars == [] -> OutValue = F + ; OutValue = partial(F, FreeVars) ), + LambdaConstructionGoals = [ + register_fun(F), + assertz(ClauseCopy), + assertz(arity(F, Arity)), + Out = OutValue + ], + append(GsH, LambdaConstructionGoals, Goals) + %--- Spaces ---: + ; ( HV == 'add-atom' ; HV == 'remove-atom' ), T = [_,_] -> append(T, [Out], RawArgs), + Goal =.. [HV|RawArgs], + append(GsH, [Goal], Goals) + ; HV == match, T = [Space, Pattern, Body] -> translate_expr(Space, Execute, G1, S), + translate_expr(Body, Execute, GsB, Out), + append(G1, [match(S, Pattern, Out, Out)], G2), + append(G2, GsB, Goals) + %--- Predicate to compiled goal ---: + ; HV == translatePredicate, T = [Expr] -> Expr = [S|Args], + translate_args(Args, Execute, GsArgs, ArgsOut), + Goal =.. [S|ArgsOut], + append(GsH, GsArgs, Inner), + append(Inner, [Goal], Goals) + %--- Manual dispatch options: --- + %Generate a predicate call on compilation, translating Args for nesting: + ; HV == call, T = [Expr] -> Expr = [F|Args], + translate_args(Args, Execute, GsArgs, ArgsOut), + append(GsH, GsArgs, Inner), + append(ArgsOut, [Out], CallArgs), + Goal =.. [F|CallArgs], + append(Inner, [Goal], Goals) + %Produce a dynamic dispatch, translating Args for nesting: + ; HV == reduce, T = [Expr] -> ( var(Expr) -> translate_expr(Expr, Execute, GsH, ExprOut), + Goals = [reduce(ExprOut, Out)|GsH] + ; Expr = [F|Args], + translate_args(Args, Execute, GsArgs, ArgsOut), + append(GsH, GsArgs, Inner), + ExprOut = [F|ArgsOut], + append(Inner, [reduce(ExprOut, Out)], Goals) ) + %Invoke translator to evaluate MeTTa code as data/list: + ; HV == eval, T = [Arg] -> append(GsH, [], Inner), + Goal = eval(Arg, Out), + append(Inner, [Goal], Goals) + %Force arg to remain data/list: + ; HV == quote, T = [Expr] -> append(GsH, [], Inner), + Out = Expr, + Goals = Inner + ; HV == 'catch', T = [Expr] -> + translate_expr(Expr, Execute, GsExpr, ExprOut), + append(GsH, [], Inner), + goals_list_to_conj(GsExpr, Conj), + Goal = catch((Conj, Out = ExprOut), + Exception, + (Exception = error(Type, Ctx) -> Out = ['Error', Type, Ctx] + ; Out = ['Error', Exception])), + append(Inner, [Goal], Goals) + %--- Automatic 'smart' dispatch, translator deciding when to create a predicate call, data list, or dynamic dispatch: --- + ; translate_args(T, Execute, GsT, AVs), + append(GsH, GsT, Inner), + %Known function => direct call: + ( is_list(AVs), + ( atom(HV), fun(HV), Fun = HV, AllAVs = AVs, IsPartial = false + ; compound(HV), HV = partial(Fun, Bound), append(Bound,AVs,AllAVs), IsPartial = true + ) % Check for type definition [:,HV,TypeChain] + -> findall(TypeChain, catch(match('&self', [':', Fun, TypeChain], TypeChain, TypeChain), _, fail), TypeChains), + ( TypeChains \= [] + -> maplist({Execute,Fun,T,GsH,IsPartial,Bound,Out}/[TypeChain,BranchGoal]>>( + typed_functioncall_branch(Fun, TypeChain, T, GsH, IsPartial, Bound, Out, BranchGoal)), TypeChains, Branches), + disj_list(Branches, Disj), + Goals = [Disj] + ; (Execute -> + build_call_or_partial(Fun, AllAVs, Out, Inner, [], Goals)) + ; append(Inner, [runtime_call(Fun, AVs, Out)], Goals) + ) + %Literals (numbers, strings, etc.), known non-function atom => data: + ; ( atomic(HV), \+ atom(HV) ) -> Out = [HV|AVs], + Goals = Inner + ; atom(HV), \+ fun(HV) -> ( Execute -> Out = [HV|AVs], Goals = Inner + ; append(Inner, [runtime_call(HV, AVs, Out)], Goals) ) + %Plain data list: evaluate inner fun-sublists + ; is_list(HV) -> eval_data_term(Execute, HV, Gd, HV1), + append(Inner, Gd, Goals), + Out = [HV1|AVs] + %Unknown head (var/compound) => runtime dispatch: + ; append(Inner, [reduce([HV|AVs], Out)], Goals) )). + +%Generate actual function call or partial if arity not complete: +build_call_or_partial(Fun, AVs, Out, Inner, Extra, Goals) :- + length(AVs, N), + Arity is N + 1, + ( maybe_specialize_call(Fun, AVs, Out, Goal) + -> % Specialization succeeded during execution - use it + append(Inner, [Goal|Extra], Goals) + ; ( current_predicate(Fun/Arity) ; catch(arity(Fun, Arity), _, fail) ), + \+ ( current_op(_, _, Fun), Arity =< 2 ) + -> % Direct call during execution + append(AVs, [Out], Args), + Goal =.. [Fun|Args], + append(Inner, [Goal|Extra], Goals) + ; Out = partial(Fun, AVs), + append(Inner, Extra, Goals) + ). + +% Runtime call helper: replicates what build_call_or_partial does when Execute=true +% This allows compiled programs to benefit from specialization +% Falls back to reduce for edge cases (partial applications, non-callables, etc.) +runtime_call(Fun, AVs, Out) :- + length(AVs, N), + Arity is N + 1, + ( maybe_specialize_call(Fun, AVs, Out, Goal) + -> % Specialization succeeded - call it + writeln("specialization path."), + call(Goal) + ; fun(Fun), + (current_predicate(Fun/Arity) ; catch(arity(Fun, Arity), _, fail) ), + \+ ( current_op(_, _, Fun), Arity =< 2 ) + -> % Direct call + append(AVs, [Out], Args), + Goal =.. [Fun|Args], + call(Goal) + ; % Not callable as predicate - use reduce for proper handling + reduce([Fun|AVs], Out) + ). + +%Type function call generation, returns function call plus typechecks for input and output: +typed_functioncall_branch(Fun, TypeChain, T, GsH, IsPartial, Bound, Out, BranchGoal) :- + TypeChain = [->|Xs], + append(ArgTypes, [OutType], Xs), + translate_args_by_type(T, ArgTypes, GsT2, AVsTmp0), + ( IsPartial -> append(Bound, AVsTmp0, AVsTmp) ; AVsTmp = AVsTmp0 ), + append(GsH, GsT2, InnerTmp), + ( (OutType == '%Undefined%' ; OutType == 'Atom') + -> Extra = [] ; Extra = [('get-type'(Out, OutType) *-> true ; 'get-metatype'(Out, OutType))] ), + build_call_or_partial(Fun, AVsTmp, Out, InnerTmp, Extra, GoalsList), + goals_list_to_conj(GoalsList, BranchGoal). + + +%Selectively apply translate_args for non-Expression args while Expression args stay as data input: +translate_args_by_type([], _, [], []) :- !. +translate_args_by_type([A|As], [T|Ts], GsOut, [AV|AVs]) :- + ( T == 'Expression' -> AV = A, GsA = [] + ; translate_expr(A, true, GsA1, AV), + ( (T == '%Undefined%' ; T == 'Atom') + -> GsA = GsA1 + ; append(GsA1, [('get-type'(AV, T) *-> true ; 'get-metatype'(AV, T))], GsA))), + translate_args_by_type(As, Ts, GsRest, AVs), + append(GsA, GsRest, GsOut). + +%Handle data list: +eval_data_term(_Execute, X, [], X) :- (var(X); atomic(X)), !. +eval_data_term(Execute, [F|As], Goals, Val) :- + % When Execute=true (interpreter), evaluate functions in data lists + % When Execute=false (compiling), treat everything as pure data for runtime flexibility + ( Execute, atom(F), fun(F) + -> translate_expr([F|As], Execute, Goals, Val) + ; eval_data_list(Execute, [F|As], Goals, Val) ). + +%Handle data list entry: +eval_data_list(_Execute, [], [], []). +eval_data_list(Execute, [E|Es], Goals, [V|Vs]) :- + ( is_list(E) -> eval_data_term(Execute, E, G1, V) ; V = E, G1 = [] ), + eval_data_list(Execute, Es, G2, Vs), + append(G1, G2, Goals). + + +%Convert let* to recusrive let: +letstar_to_rec_let([[Pat,Val]],Body,[let,Pat,Val,Body]). +letstar_to_rec_let([[Pat,Val]|Rest],Body,[let,Pat,Val,Out]) :- letstar_to_rec_let(Rest,Body,Out). + +%Patterns: variables, atoms, numbers, lists: +translate_pattern(X, X) :- var(X), !. +translate_pattern(X, X) :- atomic(X), !. +translate_pattern([H|T], [P|Ps]) :- !, translate_pattern(H, P), + translate_pattern(T, Ps). + +% Constructs the goal for a single branch of an if-then-else/case. +build_branch(true, Val, Out, (Out = Val)) :- !. +build_branch(Con, Val, Out, Goal) :- var(Val) -> Val = Out, Goal = Con + ; Goal = (Val = Out, Con). + +%Translate case expression recursively into nested if: +translate_case([[K,VExpr]|Rs], Kv, Out, Goal, KGo) :- translate_expr_to_conj(VExpr, true, ConV, VOut), + constrain_args(K, Kc, Gc), + build_branch(ConV, VOut, Out, Then), + ( Rs == [] -> Goal = ((Kv = Kc) -> Then), KGi=[] + ; translate_case(Rs, Kv, Out, Next, KGi), + Goal = ((Kv = Kc) -> Then ; Next) ), + append([Gc,KGi], KGo). + +% Wrapper for interpreter mode +translate_args(Xs, Goals, Vs) :- translate_args(Xs, true, Goals, Vs). +%Translate arguments recursively: +translate_args([], _Execute, [], []). +translate_args([X|Xs], Execute, Goals, [V|Vs]) :- + translate_expr(X, Execute, G1, V), + translate_args(Xs, Execute, G2, Vs), + append(G1, G2, Goals). + +%Build A ; B ; C ... from a list: +disj_list([G], G). +disj_list([G|Gs], (G ; R)) :- disj_list(Gs, R). + +%Build one disjunct per branch: (Conj, Out = Val): +build_superpose_branches([], _, []). +build_superpose_branches([E|Es], Out, [B|Bs]) :- translate_expr_to_conj(E, true, Conj, Val), + build_branch(Conj, Val, Out, B), + build_superpose_branches(Es, Out, Bs). + +%Build hyperpose branch as a goal list for concurrent_maplist to consume: +build_hyperpose_branches([], []). +build_hyperpose_branches([E|Es], [(Goal, Res)|Bs]) :- translate_expr_to_conj(E, true, Goal, Res), + build_hyperpose_branches(Es, Bs). + +%Like membercheck but with direct equality rather than unification +memberchk_eq(V, [H|_]) :- V == H, !. +memberchk_eq(V, [_|T]) :- memberchk_eq(V, T). + +%Generate readable lambda name: +next_lambda_name(Name) :- ( catch(nb_getval(lambda_counter, Prev), _, Prev = 0) ), + N is Prev + 1, + nb_setval(lambda_counter, N), + format(atom(Name), 'lambda_~d', [N]). diff --git a/src/translator_backup2.pl b/src/translator_backup2.pl new file mode 100644 index 00000000..9c354384 --- /dev/null +++ b/src/translator_backup2.pl @@ -0,0 +1,555 @@ +%Pattern matching, structural and functional/relational constraints on arguments: +constrain_args(X, X, []) :- (var(X); atomic(X)), !. +constrain_args([F, A, B], Out, Goals) :- nonvar(F), + F == cons, + constrain_args(A, A1, G1), + constrain_args(B, B1, G2), + Out = [A1|B1], + append(G1, G2, Goals), !. +constrain_args([F|Args], Var, Goals) :- atom(F), + fun(F), !, + translate_expr([F|Args], true, GoalsExpr, Var), + flatten(GoalsExpr, Goals). +constrain_args(In, Out, Goals) :- maplist(constrain_args, In, Out, NestedGoalsList), + flatten(NestedGoalsList, Goals), !. + +%Flatten (= Head Body) MeTTa function into Prolog Clause: +translate_clause(Input, (Head :- BodyConj)) :- translate_clause(Input, (Head :- BodyConj), true). +translate_clause(Input, (Head :- BodyConj), ConstrainArgs) :- + Input = [=, [F|Args0], BodyExpr], + ( ConstrainArgs -> maplist(constrain_args, Args0, Args1, GoalsA), + flatten(GoalsA,GoalsPrefix) + ; Args1 = Args0, GoalsPrefix = [] ), + catch(nb_getval(F, Prev), _, Prev = []), + nb_setval(F, [fun_meta(Args1, BodyExpr) | Prev]), + translate_expr(BodyExpr, true, GoalsBody, ExpOut), + ( nonvar(ExpOut) , ExpOut = partial(Base,Bound) + -> current_predicate(Base/Arity), length(Bound, N), M is (Arity - N) - 1, + length(ExtraArgs, M), append([Bound,ExtraArgs,[Out]],CallArgs), Goal =.. [Base|CallArgs], + append(GoalsBody,[Goal],FinalGoals), append(Args1,ExtraArgs,HeadArgs) + ; FinalGoals= GoalsBody , HeadArgs = Args1, Out = ExpOut ), + append(HeadArgs, [Out], FinalArgs), + Head =.. [F|FinalArgs], + append(GoalsPrefix, FinalGoals, Goals), + goals_list_to_conj(Goals, BodyConj). + +%Print compiled clause: +maybe_print_compiled_clause(_, _, _) :- catch(silent(true), _, true), !. +maybe_print_compiled_clause(Label, FormTerm, Clause) :- + swrite(FormTerm, FormStr), + format("\e[33m--> ~w -->~n\e[36m~w~n\e[33m--> prolog clause -->~n\e[32m", [Label, FormStr]), + portray_clause(current_output, Clause), + format("\e[33m^^^^^^^^^^^^^^^^^^^^^~n\e[0m"). + +%Conjunction builder, turning goals list to a flat conjunction: +goals_list_to_conj([], true) :- !. +goals_list_to_conj([G], G) :- !. +goals_list_to_conj([G|Gs], (G,R)) :- goals_list_to_conj(Gs, R). + +% Runtime dispatcher: call F if it's a registered fun/1, else keep as list: +reduce([F|Args], Out) :- nonvar(F), atom(F), fun(F) + -> % --- Case 1: callable predicate --- + length(Args, N), + Arity is N + 1, + ( current_predicate(F/Arity) , \+ (current_op(_, _, F), Arity =< 2) + -> append(Args,[Out],CallArgs), + Goal =.. [F|CallArgs], + catch(call(Goal),_,fail) + ; Out = partial(F,Args) ) + ; % --- Case 2: partial closure --- + compound(F), F = partial(Base, Bound) -> append(Bound, Args, NewArgs), + reduce([Base|NewArgs], Out) + ; % --- Case 3: leave unevaluated --- + Out = [F|Args], + \+ cyclic_term(Out). + +%Calling reduce from aggregate function foldall needs this argument wrapping +agg_reduce(AF, Acc, Val, NewAcc) :- reduce([AF, Acc, Val], NewAcc). + +%Combined expr translation to goals list +% Default wrapper for backward compatibility (interpreter mode) +translate_expr_to_conj(Input, Conj, Out) :- translate_expr_to_conj(Input, true, Conj, Out). +% Version that propagates Execute parameter +translate_expr_to_conj(Input, Execute, Conj, Out) :- translate_expr(Input, Execute, Goals, Out), + goals_list_to_conj(Goals, Conj). + +%Special stream operation rewrite rules before main translation +rewrite_streamops(['trace!', Arg1, Arg2], + [progn, ['println!', Arg1], Arg2]). +rewrite_streamops([unique, [superpose|Args]], + [call, [superpose, ['unique-atom', [collapse, [superpose|Args]]]]]). +rewrite_streamops([union, [superpose|A], [superpose|B]], + [call, [superpose, ['union-atom', [collapse, [superpose|A]], + [collapse, [superpose|B]]]]]). +rewrite_streamops([intersection, [superpose|A], [superpose|B]], + [call, [superpose, ['intersection-atom', [collapse, [superpose|A]], + [collapse, [superpose|B]]]]]). +rewrite_streamops([subtraction, [superpose|A], [superpose|B]], + [call, [superpose, ['subtraction-atom', [collapse, [superpose|A]], + [collapse, [superpose|B]]]]]). +rewrite_streamops(X, X). + +%Guarded stream ops rewrite rule application, successfully avoiding copy_term: +safe_rewrite_streamops(In, Out) :- ( compound(In), In = [Op|_], atom(Op) -> rewrite_streamops(In, Out) + ; Out = In). + +% Wrapper for interpreter mode: translate_expr/3 defaults to Execute=true +translate_expr(X, Goals, Out) :- translate_expr(X, true, Goals, Out). +%Turn MeTTa code S-expression into goals list: +translate_expr(X, _Execute, [], X) :- ((var(X) ; atomic(X)) ; X = partial(_,_)), !. +translate_expr([H0|T0], Execute, Goals, Out) :- + safe_rewrite_streamops([H0|T0],[H|T]), + translate_expr(H, Execute, GsH, HV), + %--- Translator rules ---: + ( nonvar(HV), translator_rule(HV) -> ( catch(match('&self', [':', HV, TypeChain], TypeChain, TypeChain), _, fail) + -> TypeChain = [->|Xs], + append(ArgTypes, [_], Xs), + translate_args_by_type(T, ArgTypes, GsT, T1) + ; translate_args(T, GsT, T1) ), + append(T1,[Gs],Args), + HookCall =.. [HV|Args], + call(HookCall), + translate_expr(Gs, Execute, GsE, Out), + append([GsH,GsT,GsE],Goals) + %--- Non-determinism ---: + ; HV == superpose, T = [Args], is_list(Args) -> build_superpose_branches(Args, Out, Branches), + disj_list(Branches, Disj), + append(GsH, [Disj], Goals) + ; HV == collapse, T = [E] -> translate_expr_to_conj(E, Execute, Conj, EV), + % Always just collect results with findall + % (result printing is handled at higher level in filereader.pl) + append(GsH, [(findall(EV, Conj, Out))], Goals) + ; HV == cut, T = [] -> append(GsH, [(!)], Goals), + Out = true + ; HV == test, T = [Expr, Expected] -> translate_expr_to_conj(Expr, Execute, Conj, Val), + translate_expr(Expected, Execute, GsE, ExpVal), + Goal1 = ( findall(Val, Conj, Results), + (Results = [Actual] -> true + ; Actual = Results ) ), + append(GsH, [Goal1], G1), + append(G1, GsE, G2), + append(G2, [test(Actual, ExpVal, Out)], Goals) + ; HV == once, T = [X] -> translate_expr_to_conj(X, Execute, Conj, Out), + append(GsH, [once(Conj)], Goals) + ; HV == hyperpose, T = [L] -> build_hyperpose_branches(L, Branches), + append(GsH, [concurrent_and(member((Goal,Res), Branches), (call(Goal), Out = Res))], Goals) + ; HV == with_mutex, T = [M,X] -> translate_expr_to_conj(X, Execute, Conj, Out), + append(GsH, [with_mutex(M,Conj)], Goals) + ; HV == transaction, T = [X] -> translate_expr_to_conj(X, Execute, Conj, Out), + append(GsH, [transaction(Conj)], Goals) + %--- Sequential execution ---: + ; HV == progn, T = Exprs -> translate_args(Exprs, Execute, GsList, Outs), + append(GsH, GsList, Tmp), + last(Outs, Out), + Goals = Tmp + ; HV == prog1, T = Exprs -> Exprs = [First|Rest], + translate_expr(First, Execute, GsF, Out), + translate_args(Rest, Execute, GsRest, _), + append(GsH, GsF, Tmp1), + append(Tmp1, GsRest, Goals) + %--- Conditionals ---: + ; HV == if, T = [Cond, Then] -> translate_expr_to_conj(Cond, Execute, ConC, Cv), + translate_expr_to_conj(Then, Execute, ConT, Tv), + build_branch(ConT, Tv, Out, BT), + ( ConC == true -> append(GsH, [ ( Cv == true -> BT ) ], Goals) + ; append(GsH, [ ( ConC, ( Cv == true -> BT ) ) ], Goals) ) + ; HV == if, T = [Cond, Then, Else] -> translate_expr_to_conj(Cond, Execute, ConC, Cv), + translate_expr_to_conj(Then, Execute, ConT, Tv), + translate_expr_to_conj(Else, Execute, ConE, Ev), + build_branch(ConT, Tv, Out, BT), + build_branch(ConE, Ev, Out, BE), + ( ConC == true -> append(GsH, [ (Cv == true -> BT ; BE) ], Goals) + ; append(GsH, [ (ConC, (Cv == true -> BT ; BE)) ], Goals) ) + ; HV == case, T = [KeyExpr, PairsExpr] -> ( select(Found0, PairsExpr, Rest0), + subsumes_term(['Empty', _], Found0), + Found0 = ['Empty', DefaultExpr], + NormalCases = Rest0 + -> translate_expr_to_conj(KeyExpr, Execute, GkConj, Kv), + translate_case(NormalCases, Kv, Out, CaseGoal, KeyGoal), + translate_expr_to_conj(DefaultExpr, Execute, ConD, DOut), + build_branch(ConD, DOut, Out, DefaultThen), + Combined = ( (GkConj, CaseGoal) ; + \+ GkConj, DefaultThen ), + append([GsH, KeyGoal, [Combined]], Goals) + ; translate_expr(KeyExpr, Execute, Gk, Kv), + translate_case(PairsExpr, Kv, Out, IfGoal, KeyGoal), + append([GsH, Gk, KeyGoal, [IfGoal]], Goals) ) + %--- Unification constructs ---: + ; (HV == let ; HV == chain), T = [Pat, Val, In] -> translate_expr(Pat, Execute, Gp, Pv), + translate_expr(Val, Execute, Gv, V), + translate_expr(In, Execute, Gi, Out), + append([GsH,[(Pv=V)],Gp,Gv,Gi], Goals) + ; HV == 'let*', T = [Binds, Body] -> letstar_to_rec_let(Binds,Body,RecLet), + translate_expr(RecLet, Execute, Goals, Out) + ; HV == sealed, T = [Vars, Expr] -> translate_expr_to_conj(Expr, Execute, Con, Val), + Goals = [copy_term(Vars,[Con,Val],_,[Ncon,Out]),Ncon] + %--- Iterating over non-deterministic generators without reification ---: + ; HV == 'forall', T = [GF, TF] + -> ( is_list(GF) -> GF = [GFH|GFA], + translate_expr(GFH, Execute, GsGFH, GFHV), + translate_args(GFA, Execute, GsGFA, GFAv), + append(GsGFH, GsGFA, GsGF), + GenList = [GFHV|GFAv] + ; translate_expr(GF, Execute, GsGF, GFHV), + GenList = [GFHV] ), + translate_expr(TF, Execute, GsTF, TFHV), + TestList = [TFHV, V], + goals_list_to_conj(GsGF, GPre), + GenGoal = (GPre, reduce(GenList, V)), + append(GsH, GsTF, Tmp0), + append(Tmp0, [( forall(GenGoal, ( reduce(TestList, Truth), Truth == true )) -> Out = true ; Out = false )], Goals) + ; HV == 'foldall', T = [AF, GF, InitS] + -> translate_expr_to_conj(InitS, Execute, ConjInit, Init), + translate_expr(AF, Execute, GsAF, AFV), + ( GF = [M|_], (M==match ; M==let ; M=='let*') -> LambdaGF = ['|->', [], GF], + translate_expr(LambdaGF, Execute, GsGF, GFHV), + GenList = [GFHV] + ; is_list(GF) -> GF = [GFH|GFA], + translate_expr(GFH, Execute, GsGFH, GFHV), + translate_args(GFA, Execute, GsGFA, GFAv), + append(GsGFH, GsGFA, GsGF), + GenList = [GFHV|GFAv] + ; translate_expr(GF, Execute, GsGF, GFHV), + GenList = [GFHV] ), + append(GsH, GsAF, Tmp1), + append(Tmp1, GsGF, Tmp2), + append(Tmp2, [ConjInit, foldall(agg_reduce(AFV, V), reduce(GenList, V), Init, Out)], Goals) + %--- Higher-order functions with pseudo-lambdas and lambdas ---: + ; HV == 'foldl-atom', T = [List, Init, AccVar, XVar, Body] + -> translate_expr_to_conj(List, Execute, ConjList, L), + translate_expr_to_conj(Init, Execute, ConjInit, InitV), + translate_expr_to_conj(Body, Execute, BodyConj, BG), + exclude(==(true), [ConjList, ConjInit], CleanConjs), + append(GsH, CleanConjs, GsMid), + append(GsMid, [foldl([XVar, AccVar, NewAcc]>>(BodyConj, ( number(BG) -> NewAcc is BG ; NewAcc = BG )), L, InitV, Out)], Goals) + ; HV == 'map-atom', T = [List, XVar, Body] + -> translate_expr_to_conj(List, Execute, ConjList, L), + translate_expr_to_conj(Body, Execute, BodyCallConj, BodyCall), + exclude(==(true), [ConjList], CleanConjs), + append(GsH, CleanConjs, GsMid), + append(GsMid, [maplist([XVar, Y]>>(BodyCallConj, ( number(BodyCall) -> Y is BodyCall ; Y = BodyCall )), L, Out)], Goals) + ; HV == 'filter-atom', T = [List, XVar, Cond] + -> translate_expr_to_conj(List, Execute, ConjList, L), + translate_expr_to_conj(Cond, Execute, CondConj, CondGoal), + exclude(==(true), [ConjList], CleanConjs), + append(GsH, CleanConjs, GsMid), + append(GsMid, [include([XVar]>>(CondConj, CondGoal), L, Out)], Goals) + ; HV == '|->', T = [Args, Body], Execute == true + -> next_lambda_name(F), + term_variables(Body, AllVars), + term_variables(Args, ArgVars), + exclude({ArgVars}/[V]>>memberchk_eq(V, ArgVars), AllVars, FreeVars), + append(FreeVars, Args, FullArgs), + translate_clause([=, [F|FullArgs], Body], Clause), + register_fun(F), + assertz(Clause), + format(atom(Label), "metta lambda (~w)", [F]), + maybe_print_compiled_clause(Label, ['|->', Args, Body], Clause), + length(FullArgs, N), + Arity is N + 1, + assertz(arity(F, Arity)), + ( FreeVars == [] -> Out = F, Goals = GsH + ; Out = partial(F, FreeVars), Goals = GsH ) + ; HV == '|->', T = [Args, Body], Execute == false + -> next_lambda_name(F), + % find free (non-argument) variables in Body + term_variables(Body, AllVars), + term_variables(Args, ArgVars), + exclude({ArgVars}/[V]>>memberchk_eq(V, ArgVars), AllVars, FreeVars), + append(FreeVars, Args, FullArgs), + translate_clause([=, [F|FullArgs], Body], Clause), + % Copy the clause so it doesn't share variables with FreeVars + % This ensures assertz gets a fresh template when FreeVars are bound + copy_term(Clause, ClauseCopy), + format(atom(Label), "metta lambda (~w)", [F]), + maybe_print_compiled_clause(Label, ['|->', Args, Body], Clause), + length(FullArgs, N), + Arity is N + 1, + ( FreeVars == [] -> OutValue = F + ; OutValue = partial(F, FreeVars) ), + LambdaConstructionGoals = [ + register_fun(F), + assertz(ClauseCopy), + assertz(arity(F, Arity)), + Out = OutValue + ], + append(GsH, LambdaConstructionGoals, Goals) + %--- Spaces ---: + ; ( HV == 'add-atom' ; HV == 'remove-atom' ), T = [_,_] -> append(T, [Out], RawArgs), + Goal =.. [HV|RawArgs], + append(GsH, [Goal], Goals) + ; HV == match, T = [Space, Pattern, Body] -> translate_expr(Space, Execute, G1, S), + translate_expr(Body, Execute, GsB, Out), + append(G1, [match(S, Pattern, Out, Out)], G2), + append(G2, GsB, Goals) + %--- Predicate to compiled goal ---: + ; HV == translatePredicate, T = [Expr] -> Expr = [S|Args], + translate_args(Args, Execute, GsArgs, ArgsOut), + Goal =.. [S|ArgsOut], + append(GsH, GsArgs, Inner), + append(Inner, [Goal], Goals) + %--- Manual dispatch options: --- + %Generate a predicate call on compilation, translating Args for nesting: + ; HV == call, T = [Expr] -> Expr = [F|Args], + translate_args(Args, Execute, GsArgs, ArgsOut), + append(GsH, GsArgs, Inner), + append(ArgsOut, [Out], CallArgs), + Goal =.. [F|CallArgs], + append(Inner, [Goal], Goals) + %Produce a dynamic dispatch, translating Args for nesting: + ; HV == reduce, T = [Expr] -> ( var(Expr) -> translate_expr(Expr, Execute, GsH, ExprOut), + Goals = [reduce(ExprOut, Out)|GsH] + ; Expr = [F|Args], + translate_args(Args, Execute, GsArgs, ArgsOut), + append(GsH, GsArgs, Inner), + ExprOut = [F|ArgsOut], + append(Inner, [reduce(ExprOut, Out)], Goals) ) + %Invoke translator to evaluate MeTTa code as data/list: + ; HV == eval, T = [Arg] -> append(GsH, [], Inner), + Goal = eval(Arg, Out), + append(Inner, [Goal], Goals) + %Force arg to remain data/list: + ; HV == quote, T = [Expr] -> append(GsH, [], Inner), + Out = Expr, + Goals = Inner + ; HV == 'catch', T = [Expr] -> + translate_expr(Expr, Execute, GsExpr, ExprOut), + append(GsH, [], Inner), + goals_list_to_conj(GsExpr, Conj), + Goal = catch((Conj, Out = ExprOut), + Exception, + (Exception = error(Type, Ctx) -> Out = ['Error', Type, Ctx] + ; Out = ['Error', Exception])), + append(Inner, [Goal], Goals) + %--- Automatic 'smart' dispatch, translator deciding when to create a predicate call, data list, or dynamic dispatch: --- + ; ( ( atom(HV), fun(HV), Fun = HV, IsPartial = false + ; compound(HV), HV = partial(Fun, Bound), IsPartial = true + ) + % Check for type definition FIRST (before translating args!) + -> findall(TypeChain, catch(match('&self', [':', Fun, TypeChain], TypeChain, TypeChain), _, fail), TypeChains), + ( TypeChains \= [] + -> % HAS TYPES - use typed translation (same as before) + maplist({Execute,Fun,T,GsH,IsPartial,Bound,Out}/[TypeChain,BranchGoal]>>( + typed_functioncall_branch(Fun, TypeChain, T, GsH, IsPartial, Bound, Out, BranchGoal)), TypeChains, Branches), + disj_list(Branches, Disj), + Goals = [Disj] + ; % NO TYPES - translate args normally and dispatch + translate_args(T, Execute, GsT, AVs), + ( IsPartial -> append(Bound, AVs, AllAVs) ; AllAVs = AVs ), + append(GsH, GsT, Inner), + (Execute + -> build_call_or_partial(Fun, AllAVs, Out, Inner, [], Goals) + ; Goals = [runtime_call(Fun, T, Out)] % Pass expressions, not values! + ) + ) + ; % Not a known function - translate args for remaining branches + translate_args(T, Execute, GsT, AVs), + append(GsH, GsT, Inner), + ( % Literals (numbers, strings, etc.) + ( atomic(HV), \+ atom(HV) ) -> Out = [HV|AVs], Goals = Inner + ; % Non-function atom + atom(HV), \+ fun(HV) -> ( Execute + -> Out = [HV|AVs], Goals = Inner + ; Goals = [runtime_call(HV, T, Out)] % Pass expressions! + ) + ; % Data list + is_list(HV) -> eval_data_term(Execute, HV, Gd, HV1), + append(Inner, Gd, Goals), + Out = [HV1|AVs] + ; % Unknown head (var/compound) => runtime dispatch + append(Inner, [reduce([HV|AVs], Out)], Goals) + ) + )). + +%Generate actual function call or partial if arity not complete: +build_call_or_partial(Fun, AVs, Out, Inner, Extra, Goals) :- + length(AVs, N), + Arity is N + 1, + ( maybe_specialize_call(Fun, AVs, Out, Goal) + -> % Specialization succeeded during execution - use it + append(Inner, [Goal|Extra], Goals) + ; ( current_predicate(Fun/Arity) ; catch(arity(Fun, Arity), _, fail) ), + \+ ( current_op(_, _, Fun), Arity =< 2 ) + -> % Direct call during execution + append(AVs, [Out], Args), + Goal =.. [Fun|Args], + append(Inner, [Goal|Extra], Goals) + ; Out = partial(Fun, AVs), + append(Inner, Extra, Goals) + ). + +% Runtime call helper: accepts unevaluated expressions and evaluates them according to type declarations +% This allows compiled programs to respect Expression types and other type annotations +% Falls back to reduce for edge cases (partial applications, non-callables, etc.) +runtime_call(Fun, ArgExprs, Out) :- + % Query for type declaration at runtime (when atom space is populated) + findall(TypeChain, catch(match('&self', [':', Fun, TypeChain], TypeChain, TypeChain), _, fail), TypeChains), + ( TypeChains = [TypeChain|_], + TypeChain = [->|Xs], + append(ArgTypes, [OutType], Xs) + -> % HAS TYPE DECLARATION - evaluate args according to their types + format('[DEBUG] runtime_call(~w, ~w) with types: ~w~n', [Fun, ArgExprs, ArgTypes]), + maplist({ArgExprs}/[Type,Expr,AV]>>( + ( Type == 'Expression' + -> format(' [DEBUG] Expr type: keeping ~w as Expression~n', [Expr]), AV = Expr + ; % Evaluate the expression + format(' [DEBUG] Evaluating ~w (type=~w)~n', [Expr, Type]), + translate_expr(Expr, true, Goals, AVTmp), + call_goals(Goals), + format(' [DEBUG] Evaluated to: ~w~n', [AVTmp]), + % Type check if not %Undefined% or Atom + ( (Type == '%Undefined%' ; Type == 'Atom') + -> format(' [DEBUG] Skipping type check (%Undefined%/Atom)~n'), AV = AVTmp + ; format(' [DEBUG] Type checking ~w against ~w~n', [AVTmp, Type]), + ( ('get-type'(AVTmp, Type) *-> true ; 'get-metatype'(AVTmp, Type)) + -> format(' [DEBUG] Type check PASSED~n'), AV = AVTmp + ; format(' [DEBUG] Type check FAILED~n'), fail + ) + ) + ) + ), ArgTypes, ArgExprs, AVs), + format('[DEBUG] Evaluated args: ~w~n', [AVs]), + % Now call the function with properly evaluated arguments + length(AVs, N), + Arity is N + 1, + ( maybe_specialize_call(Fun, AVs, OutTmp, Goal) + -> format('[DEBUG] Specialization succeeded~n'), writeln("specialization path."), call(Goal) + ; fun(Fun), + (current_predicate(Fun/Arity) ; catch(arity(Fun, Arity), _, fail)), + \+ ( current_op(_, _, Fun), Arity =< 2 ) + -> format('[DEBUG] Direct call: ~w/~w~n', [Fun, Arity]), + append(AVs, [OutTmp], Args), Goal =.. [Fun|Args], + format('[DEBUG] Calling: ~w~n', [Goal]), + call(Goal), + format('[DEBUG] Call succeeded, result: ~w~n', [OutTmp]) + ; format('[DEBUG] Fallback to reduce~n'), + reduce([Fun|AVs], OutTmp), + format('[DEBUG] Reduce result: ~w~n', [OutTmp]) + ), + % Type check output if needed + format('[DEBUG] Output type check: OutType=~w, OutTmp=~w~n', [OutType, OutTmp]), + ( (OutType == '%Undefined%' ; OutType == 'Atom') + -> format('[DEBUG] Skipping output type check~n'), Out = OutTmp + ; format('[DEBUG] Checking output type~n'), + ( ('get-type'(OutTmp, OutType) *-> true ; 'get-metatype'(OutTmp, OutType)) + -> format('[DEBUG] Output type check PASSED~n'), Out = OutTmp + ; format('[DEBUG] Output type check FAILED~n'), fail + ) + ), + format('[DEBUG] Final output: ~w~n', [Out]) + ; % NO TYPE DECLARATION - evaluate all args (default behavior) + maplist({ArgExprs}/[Expr,AV]>>( + translate_expr(Expr, true, Goals, AV), + call_goals(Goals) + ), ArgExprs, AVs), + % Call function (same logic as typed path) + length(AVs, N), + Arity is N + 1, + ( maybe_specialize_call(Fun, AVs, Out, Goal) + -> writeln("specialization path."), call(Goal) + ; fun(Fun), + (current_predicate(Fun/Arity) ; catch(arity(Fun, Arity), _, fail)), + \+ ( current_op(_, _, Fun), Arity =< 2 ) + -> append(AVs, [Out], Args), Goal =.. [Fun|Args], call(Goal) + ; reduce([Fun|AVs], Out) + ) + ). + +%Type function call generation, returns function call plus typechecks for input and output: +typed_functioncall_branch(Fun, TypeChain, T, GsH, IsPartial, Bound, Out, BranchGoal) :- + TypeChain = [->|Xs], + append(ArgTypes, [OutType], Xs), + translate_args_by_type(T, ArgTypes, GsT2, AVsTmp0), + ( IsPartial -> append(Bound, AVsTmp0, AVsTmp) ; AVsTmp = AVsTmp0 ), + append(GsH, GsT2, InnerTmp), + ( (OutType == '%Undefined%' ; OutType == 'Atom') + -> Extra = [] ; Extra = [('get-type'(Out, OutType) *-> true ; 'get-metatype'(Out, OutType))] ), + build_call_or_partial(Fun, AVsTmp, Out, InnerTmp, Extra, GoalsList), + goals_list_to_conj(GoalsList, BranchGoal). + + +%Selectively apply translate_args for non-Expression args while Expression args stay as data input: +translate_args_by_type([], _, [], []) :- !. +translate_args_by_type([A|As], [T|Ts], GsOut, [AV|AVs]) :- + ( T == 'Expression' -> AV = A, GsA = [] + ; translate_expr(A, true, GsA1, AV), + ( (T == '%Undefined%' ; T == 'Atom') + -> GsA = GsA1 + ; append(GsA1, [('get-type'(AV, T) *-> true ; 'get-metatype'(AV, T))], GsA))), + translate_args_by_type(As, Ts, GsRest, AVs), + append(GsA, GsRest, GsOut). + +%Handle data list: +eval_data_term(_Execute, X, [], X) :- (var(X); atomic(X)), !. +eval_data_term(Execute, [F|As], Goals, Val) :- + % When Execute=true (interpreter), evaluate functions in data lists + % When Execute=false (compiling), treat everything as pure data for runtime flexibility + ( Execute, atom(F), fun(F) + -> translate_expr([F|As], Execute, Goals, Val) + ; eval_data_list(Execute, [F|As], Goals, Val) ). + +%Handle data list entry: +eval_data_list(_Execute, [], [], []). +eval_data_list(Execute, [E|Es], Goals, [V|Vs]) :- + ( is_list(E) -> eval_data_term(Execute, E, G1, V) ; V = E, G1 = [] ), + eval_data_list(Execute, Es, G2, Vs), + append(G1, G2, Goals). + + +%Convert let* to recusrive let: +letstar_to_rec_let([[Pat,Val]],Body,[let,Pat,Val,Body]). +letstar_to_rec_let([[Pat,Val]|Rest],Body,[let,Pat,Val,Out]) :- letstar_to_rec_let(Rest,Body,Out). + +%Patterns: variables, atoms, numbers, lists: +translate_pattern(X, X) :- var(X), !. +translate_pattern(X, X) :- atomic(X), !. +translate_pattern([H|T], [P|Ps]) :- !, translate_pattern(H, P), + translate_pattern(T, Ps). + +% Constructs the goal for a single branch of an if-then-else/case. +build_branch(true, Val, Out, (Out = Val)) :- !. +build_branch(Con, Val, Out, Goal) :- var(Val) -> Val = Out, Goal = Con + ; Goal = (Val = Out, Con). + +%Translate case expression recursively into nested if: +translate_case([[K,VExpr]|Rs], Kv, Out, Goal, KGo) :- translate_expr_to_conj(VExpr, true, ConV, VOut), + constrain_args(K, Kc, Gc), + build_branch(ConV, VOut, Out, Then), + ( Rs == [] -> Goal = ((Kv = Kc) -> Then), KGi=[] + ; translate_case(Rs, Kv, Out, Next, KGi), + Goal = ((Kv = Kc) -> Then ; Next) ), + append([Gc,KGi], KGo). + +% Wrapper for interpreter mode +translate_args(Xs, Goals, Vs) :- translate_args(Xs, true, Goals, Vs). +%Translate arguments recursively: +translate_args([], _Execute, [], []). +translate_args([X|Xs], Execute, Goals, [V|Vs]) :- + translate_expr(X, Execute, G1, V), + translate_args(Xs, Execute, G2, Vs), + append(G1, G2, Goals). + +%Build A ; B ; C ... from a list: +disj_list([G], G). +disj_list([G|Gs], (G ; R)) :- disj_list(Gs, R). + +%Build one disjunct per branch: (Conj, Out = Val): +build_superpose_branches([], _, []). +build_superpose_branches([E|Es], Out, [B|Bs]) :- translate_expr_to_conj(E, true, Conj, Val), + build_branch(Conj, Val, Out, B), + build_superpose_branches(Es, Out, Bs). + +%Build hyperpose branch as a goal list for concurrent_maplist to consume: +build_hyperpose_branches([], []). +build_hyperpose_branches([E|Es], [(Goal, Res)|Bs]) :- translate_expr_to_conj(E, true, Goal, Res), + build_hyperpose_branches(Es, Bs). + +%Like membercheck but with direct equality rather than unification +memberchk_eq(V, [H|_]) :- V == H, !. +memberchk_eq(V, [_|T]) :- memberchk_eq(V, T). + +%Generate readable lambda name: +next_lambda_name(Name) :- ( catch(nb_getval(lambda_counter, Prev), _, Prev = 0) ), + N is Prev + 1, + nb_setval(lambda_counter, N), + format(atom(Name), 'lambda_~d', [N]). diff --git a/src/translator_backup3.pl b/src/translator_backup3.pl new file mode 100644 index 00000000..76874088 --- /dev/null +++ b/src/translator_backup3.pl @@ -0,0 +1,489 @@ +%Pattern matching, structural and functional/relational constraints on arguments: +constrain_args(X, X, []) :- (var(X); atomic(X)), !. +constrain_args([F, A, B], Out, Goals) :- nonvar(F), + F == cons, + constrain_args(A, A1, G1), + constrain_args(B, B1, G2), + Out = [A1|B1], + append(G1, G2, Goals), !. +constrain_args([F|Args], Var, Goals) :- atom(F), + fun(F), !, + translate_expr([F|Args], true, GoalsExpr, Var), + flatten(GoalsExpr, Goals). +constrain_args(In, Out, Goals) :- maplist(constrain_args, In, Out, NestedGoalsList), + flatten(NestedGoalsList, Goals), !. + +%Flatten (= Head Body) MeTTa function into Prolog Clause: +translate_clause(Input, (Head :- BodyConj)) :- translate_clause(Input, (Head :- BodyConj), true). +translate_clause(Input, (Head :- BodyConj), ConstrainArgs) :- + Input = [=, [F|Args0], BodyExpr], + ( ConstrainArgs -> maplist(constrain_args, Args0, Args1, GoalsA), + flatten(GoalsA,GoalsPrefix) + ; Args1 = Args0, GoalsPrefix = [] ), + catch(nb_getval(F, Prev), _, Prev = []), + nb_setval(F, [fun_meta(Args1, BodyExpr) | Prev]), + translate_expr(BodyExpr, true, GoalsBody, ExpOut), + ( nonvar(ExpOut) , ExpOut = partial(Base,Bound) + -> current_predicate(Base/Arity), length(Bound, N), M is (Arity - N) - 1, + length(ExtraArgs, M), append([Bound,ExtraArgs,[Out]],CallArgs), Goal =.. [Base|CallArgs], + append(GoalsBody,[Goal],FinalGoals), append(Args1,ExtraArgs,HeadArgs) + ; FinalGoals= GoalsBody , HeadArgs = Args1, Out = ExpOut ), + append(HeadArgs, [Out], FinalArgs), + Head =.. [F|FinalArgs], + append(GoalsPrefix, FinalGoals, Goals), + goals_list_to_conj(Goals, BodyConj). + +%Print compiled clause: +maybe_print_compiled_clause(_, _, _) :- catch(silent(true), _, true), !. +maybe_print_compiled_clause(Label, FormTerm, Clause) :- + swrite(FormTerm, FormStr), + format("\e[33m--> ~w -->~n\e[36m~w~n\e[33m--> prolog clause -->~n\e[32m", [Label, FormStr]), + portray_clause(current_output, Clause), + format("\e[33m^^^^^^^^^^^^^^^^^^^^^~n\e[0m"). + +%Conjunction builder, turning goals list to a flat conjunction: +goals_list_to_conj([], true) :- !. +goals_list_to_conj([G], G) :- !. +goals_list_to_conj([G|Gs], (G,R)) :- goals_list_to_conj(Gs, R). + +% Runtime dispatcher: call F if it's a registered fun/1, else keep as list: +reduce([F|Args], Out) :- nonvar(F), atom(F), fun(F) + -> % --- Case 1: callable predicate --- + length(Args, N), + Arity is N + 1, + ( current_predicate(F/Arity) , \+ (current_op(_, _, F), Arity =< 2) + -> append(Args,[Out],CallArgs), + Goal =.. [F|CallArgs], + catch(call(Goal),_,fail) + ; Out = partial(F,Args) ) + ; % --- Case 2: partial closure --- + compound(F), F = partial(Base, Bound) -> append(Bound, Args, NewArgs), + reduce([Base|NewArgs], Out) + ; % --- Case 3: leave unevaluated --- + Out = [F|Args], + \+ cyclic_term(Out). + +%Calling reduce from aggregate function foldall needs this argument wrapping +agg_reduce(AF, Acc, Val, NewAcc) :- reduce([AF, Acc, Val], NewAcc). + +%Combined expr translation to goals list +% Default wrapper for backward compatibility (interpreter mode) +translate_expr_to_conj(Input, Conj, Out) :- translate_expr_to_conj(Input, true, Conj, Out). +% Version that propagates Execute parameter +translate_expr_to_conj(Input, Execute, Conj, Out) :- translate_expr(Input, Execute, Goals, Out), + goals_list_to_conj(Goals, Conj). + +%Special stream operation rewrite rules before main translation +rewrite_streamops(['trace!', Arg1, Arg2], + [progn, ['println!', Arg1], Arg2]). +rewrite_streamops([unique, [superpose|Args]], + [call, [superpose, ['unique-atom', [collapse, [superpose|Args]]]]]). +rewrite_streamops([union, [superpose|A], [superpose|B]], + [call, [superpose, ['union-atom', [collapse, [superpose|A]], + [collapse, [superpose|B]]]]]). +rewrite_streamops([intersection, [superpose|A], [superpose|B]], + [call, [superpose, ['intersection-atom', [collapse, [superpose|A]], + [collapse, [superpose|B]]]]]). +rewrite_streamops([subtraction, [superpose|A], [superpose|B]], + [call, [superpose, ['subtraction-atom', [collapse, [superpose|A]], + [collapse, [superpose|B]]]]]). +rewrite_streamops(X, X). + +%Guarded stream ops rewrite rule application, successfully avoiding copy_term: +safe_rewrite_streamops(In, Out) :- ( compound(In), In = [Op|_], atom(Op) -> rewrite_streamops(In, Out) + ; Out = In). + +% Wrapper for interpreter mode: translate_expr/3 defaults to Execute=true +translate_expr(X, Goals, Out) :- translate_expr(X, true, Goals, Out). +%Turn MeTTa code S-expression into goals list: +translate_expr(X, _Execute, [], X) :- ((var(X) ; atomic(X)) ; X = partial(_,_)), !. +translate_expr([H0|T0], Execute, Goals, Out) :- + safe_rewrite_streamops([H0|T0],[H|T]), + translate_expr(H, Execute, GsH, HV), + %--- Translator rules ---: + ( nonvar(HV), translator_rule(HV) -> ( catch(match('&self', [':', HV, TypeChain], TypeChain, TypeChain), _, fail) + -> TypeChain = [->|Xs], + append(ArgTypes, [_], Xs), + translate_args_by_type(T, ArgTypes, GsT, T1) + ; translate_args(T, GsT, T1) ), + append(T1,[Gs],Args), + HookCall =.. [HV|Args], + call(HookCall), + translate_expr(Gs, Execute, GsE, Out), + append([GsH,GsT,GsE],Goals) + %--- Non-determinism ---: + ; HV == superpose, T = [Args], is_list(Args) -> build_superpose_branches(Args, Out, Branches), + disj_list(Branches, Disj), + append(GsH, [Disj], Goals) + ; HV == collapse, T = [E] -> translate_expr_to_conj(E, Execute, Conj, EV), + % Always just collect results with findall + % (result printing is handled at higher level in filereader.pl) + append(GsH, [(findall(EV, Conj, Out))], Goals) + ; HV == cut, T = [] -> append(GsH, [(!)], Goals), + Out = true + ; HV == test, T = [Expr, Expected] -> translate_expr_to_conj(Expr, Execute, Conj, Val), + translate_expr(Expected, Execute, GsE, ExpVal), + Goal1 = ( findall(Val, Conj, Results), + (Results = [Actual] -> true + ; Actual = Results ) ), + append(GsH, [Goal1], G1), + append(G1, GsE, G2), + append(G2, [test(Actual, ExpVal, Out)], Goals) + ; HV == once, T = [X] -> translate_expr_to_conj(X, Execute, Conj, Out), + append(GsH, [once(Conj)], Goals) + ; HV == hyperpose, T = [L] -> build_hyperpose_branches(L, Branches), + append(GsH, [concurrent_and(member((Goal,Res), Branches), (call(Goal), Out = Res))], Goals) + ; HV == with_mutex, T = [M,X] -> translate_expr_to_conj(X, Execute, Conj, Out), + append(GsH, [with_mutex(M,Conj)], Goals) + ; HV == transaction, T = [X] -> translate_expr_to_conj(X, Execute, Conj, Out), + append(GsH, [transaction(Conj)], Goals) + %--- Sequential execution ---: + ; HV == progn, T = Exprs -> translate_args(Exprs, Execute, GsList, Outs), + append(GsH, GsList, Tmp), + last(Outs, Out), + Goals = Tmp + ; HV == prog1, T = Exprs -> Exprs = [First|Rest], + translate_expr(First, Execute, GsF, Out), + translate_args(Rest, Execute, GsRest, _), + append(GsH, GsF, Tmp1), + append(Tmp1, GsRest, Goals) + %--- Conditionals ---: + ; HV == if, T = [Cond, Then] -> translate_expr_to_conj(Cond, Execute, ConC, Cv), + translate_expr_to_conj(Then, Execute, ConT, Tv), + build_branch(ConT, Tv, Out, BT), + ( ConC == true -> append(GsH, [ ( Cv == true -> BT ) ], Goals) + ; append(GsH, [ ( ConC, ( Cv == true -> BT ) ) ], Goals) ) + ; HV == if, T = [Cond, Then, Else] -> translate_expr_to_conj(Cond, Execute, ConC, Cv), + translate_expr_to_conj(Then, Execute, ConT, Tv), + translate_expr_to_conj(Else, Execute, ConE, Ev), + build_branch(ConT, Tv, Out, BT), + build_branch(ConE, Ev, Out, BE), + ( ConC == true -> append(GsH, [ (Cv == true -> BT ; BE) ], Goals) + ; append(GsH, [ (ConC, (Cv == true -> BT ; BE)) ], Goals) ) + ; HV == case, T = [KeyExpr, PairsExpr] -> ( select(Found0, PairsExpr, Rest0), + subsumes_term(['Empty', _], Found0), + Found0 = ['Empty', DefaultExpr], + NormalCases = Rest0 + -> translate_expr_to_conj(KeyExpr, Execute, GkConj, Kv), + translate_case(NormalCases, Kv, Out, CaseGoal, KeyGoal), + translate_expr_to_conj(DefaultExpr, Execute, ConD, DOut), + build_branch(ConD, DOut, Out, DefaultThen), + Combined = ( (GkConj, CaseGoal) ; + \+ GkConj, DefaultThen ), + append([GsH, KeyGoal, [Combined]], Goals) + ; translate_expr(KeyExpr, Execute, Gk, Kv), + translate_case(PairsExpr, Kv, Out, IfGoal, KeyGoal), + append([GsH, Gk, KeyGoal, [IfGoal]], Goals) ) + %--- Unification constructs ---: + ; (HV == let ; HV == chain), T = [Pat, Val, In] -> translate_expr(Pat, Execute, Gp, Pv), + translate_expr(Val, Execute, Gv, V), + translate_expr(In, Execute, Gi, Out), + append([GsH,[(Pv=V)],Gp,Gv,Gi], Goals) + ; HV == 'let*', T = [Binds, Body] -> letstar_to_rec_let(Binds,Body,RecLet), + translate_expr(RecLet, Execute, Goals, Out) + ; HV == sealed, T = [Vars, Expr] -> translate_expr_to_conj(Expr, Execute, Con, Val), + Goals = [copy_term(Vars,[Con,Val],_,[Ncon,Out]),Ncon] + %--- Iterating over non-deterministic generators without reification ---: + ; HV == 'forall', T = [GF, TF] + -> ( is_list(GF) -> GF = [GFH|GFA], + translate_expr(GFH, Execute, GsGFH, GFHV), + translate_args(GFA, Execute, GsGFA, GFAv), + append(GsGFH, GsGFA, GsGF), + GenList = [GFHV|GFAv] + ; translate_expr(GF, Execute, GsGF, GFHV), + GenList = [GFHV] ), + translate_expr(TF, Execute, GsTF, TFHV), + TestList = [TFHV, V], + goals_list_to_conj(GsGF, GPre), + GenGoal = (GPre, reduce(GenList, V)), + append(GsH, GsTF, Tmp0), + append(Tmp0, [( forall(GenGoal, ( reduce(TestList, Truth), Truth == true )) -> Out = true ; Out = false )], Goals) + ; HV == 'foldall', T = [AF, GF, InitS] + -> translate_expr_to_conj(InitS, Execute, ConjInit, Init), + translate_expr(AF, Execute, GsAF, AFV), + ( GF = [M|_], (M==match ; M==let ; M=='let*') -> LambdaGF = ['|->', [], GF], + translate_expr(LambdaGF, Execute, GsGF, GFHV), + GenList = [GFHV] + ; is_list(GF) -> GF = [GFH|GFA], + translate_expr(GFH, Execute, GsGFH, GFHV), + translate_args(GFA, Execute, GsGFA, GFAv), + append(GsGFH, GsGFA, GsGF), + GenList = [GFHV|GFAv] + ; translate_expr(GF, Execute, GsGF, GFHV), + GenList = [GFHV] ), + append(GsH, GsAF, Tmp1), + append(Tmp1, GsGF, Tmp2), + append(Tmp2, [ConjInit, foldall(agg_reduce(AFV, V), reduce(GenList, V), Init, Out)], Goals) + %--- Higher-order functions with pseudo-lambdas and lambdas ---: + ; HV == 'foldl-atom', T = [List, Init, AccVar, XVar, Body] + -> translate_expr_to_conj(List, Execute, ConjList, L), + translate_expr_to_conj(Init, Execute, ConjInit, InitV), + translate_expr_to_conj(Body, Execute, BodyConj, BG), + exclude(==(true), [ConjList, ConjInit], CleanConjs), + append(GsH, CleanConjs, GsMid), + append(GsMid, [foldl([XVar, AccVar, NewAcc]>>(BodyConj, ( number(BG) -> NewAcc is BG ; NewAcc = BG )), L, InitV, Out)], Goals) + ; HV == 'map-atom', T = [List, XVar, Body] + -> translate_expr_to_conj(List, Execute, ConjList, L), + translate_expr_to_conj(Body, Execute, BodyCallConj, BodyCall), + exclude(==(true), [ConjList], CleanConjs), + append(GsH, CleanConjs, GsMid), + append(GsMid, [maplist([XVar, Y]>>(BodyCallConj, ( number(BodyCall) -> Y is BodyCall ; Y = BodyCall )), L, Out)], Goals) + ; HV == 'filter-atom', T = [List, XVar, Cond] + -> translate_expr_to_conj(List, Execute, ConjList, L), + translate_expr_to_conj(Cond, Execute, CondConj, CondGoal), + exclude(==(true), [ConjList], CleanConjs), + append(GsH, CleanConjs, GsMid), + append(GsMid, [include([XVar]>>(CondConj, CondGoal), L, Out)], Goals) + ; HV == '|->', T = [Args, Body], Execute == true + -> next_lambda_name(F), + term_variables(Body, AllVars), + term_variables(Args, ArgVars), + exclude({ArgVars}/[V]>>memberchk_eq(V, ArgVars), AllVars, FreeVars), + append(FreeVars, Args, FullArgs), + translate_clause([=, [F|FullArgs], Body], Clause), + register_fun(F), + assertz(Clause), + format(atom(Label), "metta lambda (~w)", [F]), + maybe_print_compiled_clause(Label, ['|->', Args, Body], Clause), + length(FullArgs, N), + Arity is N + 1, + assertz(arity(F, Arity)), + ( FreeVars == [] -> Out = F, Goals = GsH + ; Out = partial(F, FreeVars), Goals = GsH ) + ; HV == '|->', T = [Args, Body], Execute == false + -> next_lambda_name(F), + % find free (non-argument) variables in Body + term_variables(Body, AllVars), + term_variables(Args, ArgVars), + exclude({ArgVars}/[V]>>memberchk_eq(V, ArgVars), AllVars, FreeVars), + append(FreeVars, Args, FullArgs), + translate_clause([=, [F|FullArgs], Body], Clause), + % Copy the clause so it doesn't share variables with FreeVars + % This ensures assertz gets a fresh template when FreeVars are bound + copy_term(Clause, ClauseCopy), + format(atom(Label), "metta lambda (~w)", [F]), + maybe_print_compiled_clause(Label, ['|->', Args, Body], Clause), + length(FullArgs, N), + Arity is N + 1, + ( FreeVars == [] -> OutValue = F + ; OutValue = partial(F, FreeVars) ), + LambdaConstructionGoals = [ + register_fun(F), + assertz(ClauseCopy), + assertz(arity(F, Arity)), + Out = OutValue + ], + append(GsH, LambdaConstructionGoals, Goals) + %--- Spaces ---: + ; ( HV == 'add-atom' ; HV == 'remove-atom' ), T = [_,_] -> append(T, [Out], RawArgs), + Goal =.. [HV|RawArgs], + append(GsH, [Goal], Goals) + ; HV == match, T = [Space, Pattern, Body] -> translate_expr(Space, Execute, G1, S), + translate_expr(Body, Execute, GsB, Out), + append(G1, [match(S, Pattern, Out, Out)], G2), + append(G2, GsB, Goals) + %--- Predicate to compiled goal ---: + ; HV == translatePredicate, T = [Expr] -> Expr = [S|Args], + translate_args(Args, Execute, GsArgs, ArgsOut), + Goal =.. [S|ArgsOut], + append(GsH, GsArgs, Inner), + append(Inner, [Goal], Goals) + %--- Manual dispatch options: --- + %Generate a predicate call on compilation, translating Args for nesting: + ; HV == call, T = [Expr] -> Expr = [F|Args], + translate_args(Args, Execute, GsArgs, ArgsOut), + append(GsH, GsArgs, Inner), + append(ArgsOut, [Out], CallArgs), + Goal =.. [F|CallArgs], + append(Inner, [Goal], Goals) + %Produce a dynamic dispatch, translating Args for nesting: + ; HV == reduce, T = [Expr] -> ( var(Expr) -> translate_expr(Expr, Execute, GsH, ExprOut), + Goals = [reduce(ExprOut, Out)|GsH] + ; Expr = [F|Args], + translate_args(Args, Execute, GsArgs, ArgsOut), + append(GsH, GsArgs, Inner), + ExprOut = [F|ArgsOut], + append(Inner, [reduce(ExprOut, Out)], Goals) ) + %Invoke translator to evaluate MeTTa code as data/list: + ; HV == eval, T = [Arg] -> append(GsH, [], Inner), + Goal = eval(Arg, Out), + append(Inner, [Goal], Goals) + %Force arg to remain data/list: + ; HV == quote, T = [Expr] -> append(GsH, [], Inner), + Out = Expr, + Goals = Inner + ; HV == 'catch', T = [Expr] -> + translate_expr(Expr, Execute, GsExpr, ExprOut), + append(GsH, [], Inner), + goals_list_to_conj(GsExpr, Conj), + Goal = catch((Conj, Out = ExprOut), + Exception, + (Exception = error(Type, Ctx) -> Out = ['Error', Type, Ctx] + ; Out = ['Error', Exception])), + append(Inner, [Goal], Goals) + %--- Automatic 'smart' dispatch, translator deciding when to create a predicate call, data list, or dynamic dispatch: --- + ; translate_args(T, Execute, GsT, AVs), + append(GsH, GsT, Inner), + %Known function => direct call: + ( is_list(AVs), + ( atom(HV), fun(HV), Fun = HV, AllAVs = AVs, IsPartial = false + ; compound(HV), HV = partial(Fun, Bound), append(Bound,AVs,AllAVs), IsPartial = true + ) % Check for type definition [:,HV,TypeChain] + -> findall(TypeChain, catch(match('&self', [':', Fun, TypeChain], TypeChain, TypeChain), _, fail), TypeChains), + ( TypeChains \= [] + -> maplist({Execute,Fun,T,GsH,IsPartial,Bound,Out}/[TypeChain,BranchGoal]>>( + typed_functioncall_branch(Fun, TypeChain, T, GsH, IsPartial, Bound, Out, BranchGoal)), TypeChains, Branches), + disj_list(Branches, Disj), + Goals = [Disj] + ; (Execute -> + build_call_or_partial(Fun, AllAVs, Out, Inner, [], Goals)) + ; append(Inner, [runtime_call(Fun, AVs, Out)], Goals) + ) + %Literals (numbers, strings, etc.), known non-function atom => data: + ; ( atomic(HV), \+ atom(HV) ) -> Out = [HV|AVs], + Goals = Inner + ; atom(HV), \+ fun(HV) -> ( Execute -> Out = [HV|AVs], Goals = Inner + ; append(Inner, [runtime_call(HV, AVs, Out)], Goals) ) + %Plain data list: evaluate inner fun-sublists + ; is_list(HV) -> eval_data_term(Execute, HV, Gd, HV1), + append(Inner, Gd, Goals), + Out = [HV1|AVs] + %Unknown head (var/compound) => runtime dispatch: + ; append(Inner, [reduce([HV|AVs], Out)], Goals) )). + +%Generate actual function call or partial if arity not complete: +build_call_or_partial(Fun, AVs, Out, Inner, Extra, Goals) :- + length(AVs, N), + Arity is N + 1, + ( maybe_specialize_call(Fun, AVs, Out, Goal) + -> % Specialization succeeded during execution - use it + append(Inner, [Goal|Extra], Goals) + ; ( current_predicate(Fun/Arity) ; catch(arity(Fun, Arity), _, fail) ), + \+ ( current_op(_, _, Fun), Arity =< 2 ) + -> % Direct call during execution + append(AVs, [Out], Args), + Goal =.. [Fun|Args], + append(Inner, [Goal|Extra], Goals) + ; Out = partial(Fun, AVs), + append(Inner, Extra, Goals) + ). + +% Runtime call helper: replicates what build_call_or_partial does when Execute=true +% This allows compiled programs to benefit from specialization +% Falls back to reduce for edge cases (partial applications, non-callables, etc.) +runtime_call(Fun, AVs, Out) :- + length(AVs, N), + Arity is N + 1, + ( maybe_specialize_call(Fun, AVs, Out, Goal) + -> % Specialization succeeded - call it + writeln("specialization path."), + call(Goal) + ; fun(Fun), + (current_predicate(Fun/Arity) ; catch(arity(Fun, Arity), _, fail) ), + \+ ( current_op(_, _, Fun), Arity =< 2 ) + -> % Direct call + append(AVs, [Out], Args), + Goal =.. [Fun|Args], + call(Goal) + ; % Not callable as predicate - use reduce for proper handling + reduce([Fun|AVs], Out) + ). + +%Type function call generation, returns function call plus typechecks for input and output: +typed_functioncall_branch(Fun, TypeChain, T, GsH, IsPartial, Bound, Out, BranchGoal) :- + TypeChain = [->|Xs], + append(ArgTypes, [OutType], Xs), + translate_args_by_type(T, ArgTypes, GsT2, AVsTmp0), + ( IsPartial -> append(Bound, AVsTmp0, AVsTmp) ; AVsTmp = AVsTmp0 ), + append(GsH, GsT2, InnerTmp), + ( (OutType == '%Undefined%' ; OutType == 'Atom') + -> Extra = [] ; Extra = [('get-type'(Out, OutType) *-> true ; 'get-metatype'(Out, OutType))] ), + build_call_or_partial(Fun, AVsTmp, Out, InnerTmp, Extra, GoalsList), + goals_list_to_conj(GoalsList, BranchGoal). + + +%Selectively apply translate_args for non-Expression args while Expression args stay as data input: +translate_args_by_type([], _, [], []) :- !. +translate_args_by_type([A|As], [T|Ts], GsOut, [AV|AVs]) :- + ( T == 'Expression' -> AV = A, GsA = [] + ; translate_expr(A, true, GsA1, AV), + ( (T == '%Undefined%' ; T == 'Atom') + -> GsA = GsA1 + ; append(GsA1, [('get-type'(AV, T) *-> true ; 'get-metatype'(AV, T))], GsA))), + translate_args_by_type(As, Ts, GsRest, AVs), + append(GsA, GsRest, GsOut). + +%Handle data list: +eval_data_term(_Execute, X, [], X) :- (var(X); atomic(X)), !. +eval_data_term(Execute, [F|As], Goals, Val) :- + % When Execute=true (interpreter), evaluate functions in data lists + % When Execute=false (compiling), treat everything as pure data for runtime flexibility + ( Execute, atom(F), fun(F) + -> translate_expr([F|As], Execute, Goals, Val) + ; eval_data_list(Execute, [F|As], Goals, Val) ). + +%Handle data list entry: +eval_data_list(_Execute, [], [], []). +eval_data_list(Execute, [E|Es], Goals, [V|Vs]) :- + ( is_list(E) -> eval_data_term(Execute, E, G1, V) ; V = E, G1 = [] ), + eval_data_list(Execute, Es, G2, Vs), + append(G1, G2, Goals). + + +%Convert let* to recusrive let: +letstar_to_rec_let([[Pat,Val]],Body,[let,Pat,Val,Body]). +letstar_to_rec_let([[Pat,Val]|Rest],Body,[let,Pat,Val,Out]) :- letstar_to_rec_let(Rest,Body,Out). + +%Patterns: variables, atoms, numbers, lists: +translate_pattern(X, X) :- var(X), !. +translate_pattern(X, X) :- atomic(X), !. +translate_pattern([H|T], [P|Ps]) :- !, translate_pattern(H, P), + translate_pattern(T, Ps). + +% Constructs the goal for a single branch of an if-then-else/case. +build_branch(true, Val, Out, (Out = Val)) :- !. +build_branch(Con, Val, Out, Goal) :- var(Val) -> Val = Out, Goal = Con + ; Goal = (Val = Out, Con). + +%Translate case expression recursively into nested if: +translate_case([[K,VExpr]|Rs], Kv, Out, Goal, KGo) :- translate_expr_to_conj(VExpr, true, ConV, VOut), + constrain_args(K, Kc, Gc), + build_branch(ConV, VOut, Out, Then), + ( Rs == [] -> Goal = ((Kv = Kc) -> Then), KGi=[] + ; translate_case(Rs, Kv, Out, Next, KGi), + Goal = ((Kv = Kc) -> Then ; Next) ), + append([Gc,KGi], KGo). + +% Wrapper for interpreter mode +translate_args(Xs, Goals, Vs) :- translate_args(Xs, true, Goals, Vs). +%Translate arguments recursively: +translate_args([], _Execute, [], []). +translate_args([X|Xs], Execute, Goals, [V|Vs]) :- + translate_expr(X, Execute, G1, V), + translate_args(Xs, Execute, G2, Vs), + append(G1, G2, Goals). + +%Build A ; B ; C ... from a list: +disj_list([G], G). +disj_list([G|Gs], (G ; R)) :- disj_list(Gs, R). + +%Build one disjunct per branch: (Conj, Out = Val): +build_superpose_branches([], _, []). +build_superpose_branches([E|Es], Out, [B|Bs]) :- translate_expr_to_conj(E, true, Conj, Val), + build_branch(Conj, Val, Out, B), + build_superpose_branches(Es, Out, Bs). + +%Build hyperpose branch as a goal list for concurrent_maplist to consume: +build_hyperpose_branches([], []). +build_hyperpose_branches([E|Es], [(Goal, Res)|Bs]) :- translate_expr_to_conj(E, true, Goal, Res), + build_hyperpose_branches(Es, Bs). + +%Like membercheck but with direct equality rather than unification +memberchk_eq(V, [H|_]) :- V == H, !. +memberchk_eq(V, [_|T]) :- memberchk_eq(V, T). + +%Generate readable lambda name: +next_lambda_name(Name) :- ( catch(nb_getval(lambda_counter, Prev), _, Prev = 0) ), + N is Prev + 1, + nb_setval(lambda_counter, N), + format(atom(Name), 'lambda_~d', [N]). diff --git a/src/translator_latest_garbage.pl b/src/translator_latest_garbage.pl new file mode 100644 index 00000000..9c354384 --- /dev/null +++ b/src/translator_latest_garbage.pl @@ -0,0 +1,555 @@ +%Pattern matching, structural and functional/relational constraints on arguments: +constrain_args(X, X, []) :- (var(X); atomic(X)), !. +constrain_args([F, A, B], Out, Goals) :- nonvar(F), + F == cons, + constrain_args(A, A1, G1), + constrain_args(B, B1, G2), + Out = [A1|B1], + append(G1, G2, Goals), !. +constrain_args([F|Args], Var, Goals) :- atom(F), + fun(F), !, + translate_expr([F|Args], true, GoalsExpr, Var), + flatten(GoalsExpr, Goals). +constrain_args(In, Out, Goals) :- maplist(constrain_args, In, Out, NestedGoalsList), + flatten(NestedGoalsList, Goals), !. + +%Flatten (= Head Body) MeTTa function into Prolog Clause: +translate_clause(Input, (Head :- BodyConj)) :- translate_clause(Input, (Head :- BodyConj), true). +translate_clause(Input, (Head :- BodyConj), ConstrainArgs) :- + Input = [=, [F|Args0], BodyExpr], + ( ConstrainArgs -> maplist(constrain_args, Args0, Args1, GoalsA), + flatten(GoalsA,GoalsPrefix) + ; Args1 = Args0, GoalsPrefix = [] ), + catch(nb_getval(F, Prev), _, Prev = []), + nb_setval(F, [fun_meta(Args1, BodyExpr) | Prev]), + translate_expr(BodyExpr, true, GoalsBody, ExpOut), + ( nonvar(ExpOut) , ExpOut = partial(Base,Bound) + -> current_predicate(Base/Arity), length(Bound, N), M is (Arity - N) - 1, + length(ExtraArgs, M), append([Bound,ExtraArgs,[Out]],CallArgs), Goal =.. [Base|CallArgs], + append(GoalsBody,[Goal],FinalGoals), append(Args1,ExtraArgs,HeadArgs) + ; FinalGoals= GoalsBody , HeadArgs = Args1, Out = ExpOut ), + append(HeadArgs, [Out], FinalArgs), + Head =.. [F|FinalArgs], + append(GoalsPrefix, FinalGoals, Goals), + goals_list_to_conj(Goals, BodyConj). + +%Print compiled clause: +maybe_print_compiled_clause(_, _, _) :- catch(silent(true), _, true), !. +maybe_print_compiled_clause(Label, FormTerm, Clause) :- + swrite(FormTerm, FormStr), + format("\e[33m--> ~w -->~n\e[36m~w~n\e[33m--> prolog clause -->~n\e[32m", [Label, FormStr]), + portray_clause(current_output, Clause), + format("\e[33m^^^^^^^^^^^^^^^^^^^^^~n\e[0m"). + +%Conjunction builder, turning goals list to a flat conjunction: +goals_list_to_conj([], true) :- !. +goals_list_to_conj([G], G) :- !. +goals_list_to_conj([G|Gs], (G,R)) :- goals_list_to_conj(Gs, R). + +% Runtime dispatcher: call F if it's a registered fun/1, else keep as list: +reduce([F|Args], Out) :- nonvar(F), atom(F), fun(F) + -> % --- Case 1: callable predicate --- + length(Args, N), + Arity is N + 1, + ( current_predicate(F/Arity) , \+ (current_op(_, _, F), Arity =< 2) + -> append(Args,[Out],CallArgs), + Goal =.. [F|CallArgs], + catch(call(Goal),_,fail) + ; Out = partial(F,Args) ) + ; % --- Case 2: partial closure --- + compound(F), F = partial(Base, Bound) -> append(Bound, Args, NewArgs), + reduce([Base|NewArgs], Out) + ; % --- Case 3: leave unevaluated --- + Out = [F|Args], + \+ cyclic_term(Out). + +%Calling reduce from aggregate function foldall needs this argument wrapping +agg_reduce(AF, Acc, Val, NewAcc) :- reduce([AF, Acc, Val], NewAcc). + +%Combined expr translation to goals list +% Default wrapper for backward compatibility (interpreter mode) +translate_expr_to_conj(Input, Conj, Out) :- translate_expr_to_conj(Input, true, Conj, Out). +% Version that propagates Execute parameter +translate_expr_to_conj(Input, Execute, Conj, Out) :- translate_expr(Input, Execute, Goals, Out), + goals_list_to_conj(Goals, Conj). + +%Special stream operation rewrite rules before main translation +rewrite_streamops(['trace!', Arg1, Arg2], + [progn, ['println!', Arg1], Arg2]). +rewrite_streamops([unique, [superpose|Args]], + [call, [superpose, ['unique-atom', [collapse, [superpose|Args]]]]]). +rewrite_streamops([union, [superpose|A], [superpose|B]], + [call, [superpose, ['union-atom', [collapse, [superpose|A]], + [collapse, [superpose|B]]]]]). +rewrite_streamops([intersection, [superpose|A], [superpose|B]], + [call, [superpose, ['intersection-atom', [collapse, [superpose|A]], + [collapse, [superpose|B]]]]]). +rewrite_streamops([subtraction, [superpose|A], [superpose|B]], + [call, [superpose, ['subtraction-atom', [collapse, [superpose|A]], + [collapse, [superpose|B]]]]]). +rewrite_streamops(X, X). + +%Guarded stream ops rewrite rule application, successfully avoiding copy_term: +safe_rewrite_streamops(In, Out) :- ( compound(In), In = [Op|_], atom(Op) -> rewrite_streamops(In, Out) + ; Out = In). + +% Wrapper for interpreter mode: translate_expr/3 defaults to Execute=true +translate_expr(X, Goals, Out) :- translate_expr(X, true, Goals, Out). +%Turn MeTTa code S-expression into goals list: +translate_expr(X, _Execute, [], X) :- ((var(X) ; atomic(X)) ; X = partial(_,_)), !. +translate_expr([H0|T0], Execute, Goals, Out) :- + safe_rewrite_streamops([H0|T0],[H|T]), + translate_expr(H, Execute, GsH, HV), + %--- Translator rules ---: + ( nonvar(HV), translator_rule(HV) -> ( catch(match('&self', [':', HV, TypeChain], TypeChain, TypeChain), _, fail) + -> TypeChain = [->|Xs], + append(ArgTypes, [_], Xs), + translate_args_by_type(T, ArgTypes, GsT, T1) + ; translate_args(T, GsT, T1) ), + append(T1,[Gs],Args), + HookCall =.. [HV|Args], + call(HookCall), + translate_expr(Gs, Execute, GsE, Out), + append([GsH,GsT,GsE],Goals) + %--- Non-determinism ---: + ; HV == superpose, T = [Args], is_list(Args) -> build_superpose_branches(Args, Out, Branches), + disj_list(Branches, Disj), + append(GsH, [Disj], Goals) + ; HV == collapse, T = [E] -> translate_expr_to_conj(E, Execute, Conj, EV), + % Always just collect results with findall + % (result printing is handled at higher level in filereader.pl) + append(GsH, [(findall(EV, Conj, Out))], Goals) + ; HV == cut, T = [] -> append(GsH, [(!)], Goals), + Out = true + ; HV == test, T = [Expr, Expected] -> translate_expr_to_conj(Expr, Execute, Conj, Val), + translate_expr(Expected, Execute, GsE, ExpVal), + Goal1 = ( findall(Val, Conj, Results), + (Results = [Actual] -> true + ; Actual = Results ) ), + append(GsH, [Goal1], G1), + append(G1, GsE, G2), + append(G2, [test(Actual, ExpVal, Out)], Goals) + ; HV == once, T = [X] -> translate_expr_to_conj(X, Execute, Conj, Out), + append(GsH, [once(Conj)], Goals) + ; HV == hyperpose, T = [L] -> build_hyperpose_branches(L, Branches), + append(GsH, [concurrent_and(member((Goal,Res), Branches), (call(Goal), Out = Res))], Goals) + ; HV == with_mutex, T = [M,X] -> translate_expr_to_conj(X, Execute, Conj, Out), + append(GsH, [with_mutex(M,Conj)], Goals) + ; HV == transaction, T = [X] -> translate_expr_to_conj(X, Execute, Conj, Out), + append(GsH, [transaction(Conj)], Goals) + %--- Sequential execution ---: + ; HV == progn, T = Exprs -> translate_args(Exprs, Execute, GsList, Outs), + append(GsH, GsList, Tmp), + last(Outs, Out), + Goals = Tmp + ; HV == prog1, T = Exprs -> Exprs = [First|Rest], + translate_expr(First, Execute, GsF, Out), + translate_args(Rest, Execute, GsRest, _), + append(GsH, GsF, Tmp1), + append(Tmp1, GsRest, Goals) + %--- Conditionals ---: + ; HV == if, T = [Cond, Then] -> translate_expr_to_conj(Cond, Execute, ConC, Cv), + translate_expr_to_conj(Then, Execute, ConT, Tv), + build_branch(ConT, Tv, Out, BT), + ( ConC == true -> append(GsH, [ ( Cv == true -> BT ) ], Goals) + ; append(GsH, [ ( ConC, ( Cv == true -> BT ) ) ], Goals) ) + ; HV == if, T = [Cond, Then, Else] -> translate_expr_to_conj(Cond, Execute, ConC, Cv), + translate_expr_to_conj(Then, Execute, ConT, Tv), + translate_expr_to_conj(Else, Execute, ConE, Ev), + build_branch(ConT, Tv, Out, BT), + build_branch(ConE, Ev, Out, BE), + ( ConC == true -> append(GsH, [ (Cv == true -> BT ; BE) ], Goals) + ; append(GsH, [ (ConC, (Cv == true -> BT ; BE)) ], Goals) ) + ; HV == case, T = [KeyExpr, PairsExpr] -> ( select(Found0, PairsExpr, Rest0), + subsumes_term(['Empty', _], Found0), + Found0 = ['Empty', DefaultExpr], + NormalCases = Rest0 + -> translate_expr_to_conj(KeyExpr, Execute, GkConj, Kv), + translate_case(NormalCases, Kv, Out, CaseGoal, KeyGoal), + translate_expr_to_conj(DefaultExpr, Execute, ConD, DOut), + build_branch(ConD, DOut, Out, DefaultThen), + Combined = ( (GkConj, CaseGoal) ; + \+ GkConj, DefaultThen ), + append([GsH, KeyGoal, [Combined]], Goals) + ; translate_expr(KeyExpr, Execute, Gk, Kv), + translate_case(PairsExpr, Kv, Out, IfGoal, KeyGoal), + append([GsH, Gk, KeyGoal, [IfGoal]], Goals) ) + %--- Unification constructs ---: + ; (HV == let ; HV == chain), T = [Pat, Val, In] -> translate_expr(Pat, Execute, Gp, Pv), + translate_expr(Val, Execute, Gv, V), + translate_expr(In, Execute, Gi, Out), + append([GsH,[(Pv=V)],Gp,Gv,Gi], Goals) + ; HV == 'let*', T = [Binds, Body] -> letstar_to_rec_let(Binds,Body,RecLet), + translate_expr(RecLet, Execute, Goals, Out) + ; HV == sealed, T = [Vars, Expr] -> translate_expr_to_conj(Expr, Execute, Con, Val), + Goals = [copy_term(Vars,[Con,Val],_,[Ncon,Out]),Ncon] + %--- Iterating over non-deterministic generators without reification ---: + ; HV == 'forall', T = [GF, TF] + -> ( is_list(GF) -> GF = [GFH|GFA], + translate_expr(GFH, Execute, GsGFH, GFHV), + translate_args(GFA, Execute, GsGFA, GFAv), + append(GsGFH, GsGFA, GsGF), + GenList = [GFHV|GFAv] + ; translate_expr(GF, Execute, GsGF, GFHV), + GenList = [GFHV] ), + translate_expr(TF, Execute, GsTF, TFHV), + TestList = [TFHV, V], + goals_list_to_conj(GsGF, GPre), + GenGoal = (GPre, reduce(GenList, V)), + append(GsH, GsTF, Tmp0), + append(Tmp0, [( forall(GenGoal, ( reduce(TestList, Truth), Truth == true )) -> Out = true ; Out = false )], Goals) + ; HV == 'foldall', T = [AF, GF, InitS] + -> translate_expr_to_conj(InitS, Execute, ConjInit, Init), + translate_expr(AF, Execute, GsAF, AFV), + ( GF = [M|_], (M==match ; M==let ; M=='let*') -> LambdaGF = ['|->', [], GF], + translate_expr(LambdaGF, Execute, GsGF, GFHV), + GenList = [GFHV] + ; is_list(GF) -> GF = [GFH|GFA], + translate_expr(GFH, Execute, GsGFH, GFHV), + translate_args(GFA, Execute, GsGFA, GFAv), + append(GsGFH, GsGFA, GsGF), + GenList = [GFHV|GFAv] + ; translate_expr(GF, Execute, GsGF, GFHV), + GenList = [GFHV] ), + append(GsH, GsAF, Tmp1), + append(Tmp1, GsGF, Tmp2), + append(Tmp2, [ConjInit, foldall(agg_reduce(AFV, V), reduce(GenList, V), Init, Out)], Goals) + %--- Higher-order functions with pseudo-lambdas and lambdas ---: + ; HV == 'foldl-atom', T = [List, Init, AccVar, XVar, Body] + -> translate_expr_to_conj(List, Execute, ConjList, L), + translate_expr_to_conj(Init, Execute, ConjInit, InitV), + translate_expr_to_conj(Body, Execute, BodyConj, BG), + exclude(==(true), [ConjList, ConjInit], CleanConjs), + append(GsH, CleanConjs, GsMid), + append(GsMid, [foldl([XVar, AccVar, NewAcc]>>(BodyConj, ( number(BG) -> NewAcc is BG ; NewAcc = BG )), L, InitV, Out)], Goals) + ; HV == 'map-atom', T = [List, XVar, Body] + -> translate_expr_to_conj(List, Execute, ConjList, L), + translate_expr_to_conj(Body, Execute, BodyCallConj, BodyCall), + exclude(==(true), [ConjList], CleanConjs), + append(GsH, CleanConjs, GsMid), + append(GsMid, [maplist([XVar, Y]>>(BodyCallConj, ( number(BodyCall) -> Y is BodyCall ; Y = BodyCall )), L, Out)], Goals) + ; HV == 'filter-atom', T = [List, XVar, Cond] + -> translate_expr_to_conj(List, Execute, ConjList, L), + translate_expr_to_conj(Cond, Execute, CondConj, CondGoal), + exclude(==(true), [ConjList], CleanConjs), + append(GsH, CleanConjs, GsMid), + append(GsMid, [include([XVar]>>(CondConj, CondGoal), L, Out)], Goals) + ; HV == '|->', T = [Args, Body], Execute == true + -> next_lambda_name(F), + term_variables(Body, AllVars), + term_variables(Args, ArgVars), + exclude({ArgVars}/[V]>>memberchk_eq(V, ArgVars), AllVars, FreeVars), + append(FreeVars, Args, FullArgs), + translate_clause([=, [F|FullArgs], Body], Clause), + register_fun(F), + assertz(Clause), + format(atom(Label), "metta lambda (~w)", [F]), + maybe_print_compiled_clause(Label, ['|->', Args, Body], Clause), + length(FullArgs, N), + Arity is N + 1, + assertz(arity(F, Arity)), + ( FreeVars == [] -> Out = F, Goals = GsH + ; Out = partial(F, FreeVars), Goals = GsH ) + ; HV == '|->', T = [Args, Body], Execute == false + -> next_lambda_name(F), + % find free (non-argument) variables in Body + term_variables(Body, AllVars), + term_variables(Args, ArgVars), + exclude({ArgVars}/[V]>>memberchk_eq(V, ArgVars), AllVars, FreeVars), + append(FreeVars, Args, FullArgs), + translate_clause([=, [F|FullArgs], Body], Clause), + % Copy the clause so it doesn't share variables with FreeVars + % This ensures assertz gets a fresh template when FreeVars are bound + copy_term(Clause, ClauseCopy), + format(atom(Label), "metta lambda (~w)", [F]), + maybe_print_compiled_clause(Label, ['|->', Args, Body], Clause), + length(FullArgs, N), + Arity is N + 1, + ( FreeVars == [] -> OutValue = F + ; OutValue = partial(F, FreeVars) ), + LambdaConstructionGoals = [ + register_fun(F), + assertz(ClauseCopy), + assertz(arity(F, Arity)), + Out = OutValue + ], + append(GsH, LambdaConstructionGoals, Goals) + %--- Spaces ---: + ; ( HV == 'add-atom' ; HV == 'remove-atom' ), T = [_,_] -> append(T, [Out], RawArgs), + Goal =.. [HV|RawArgs], + append(GsH, [Goal], Goals) + ; HV == match, T = [Space, Pattern, Body] -> translate_expr(Space, Execute, G1, S), + translate_expr(Body, Execute, GsB, Out), + append(G1, [match(S, Pattern, Out, Out)], G2), + append(G2, GsB, Goals) + %--- Predicate to compiled goal ---: + ; HV == translatePredicate, T = [Expr] -> Expr = [S|Args], + translate_args(Args, Execute, GsArgs, ArgsOut), + Goal =.. [S|ArgsOut], + append(GsH, GsArgs, Inner), + append(Inner, [Goal], Goals) + %--- Manual dispatch options: --- + %Generate a predicate call on compilation, translating Args for nesting: + ; HV == call, T = [Expr] -> Expr = [F|Args], + translate_args(Args, Execute, GsArgs, ArgsOut), + append(GsH, GsArgs, Inner), + append(ArgsOut, [Out], CallArgs), + Goal =.. [F|CallArgs], + append(Inner, [Goal], Goals) + %Produce a dynamic dispatch, translating Args for nesting: + ; HV == reduce, T = [Expr] -> ( var(Expr) -> translate_expr(Expr, Execute, GsH, ExprOut), + Goals = [reduce(ExprOut, Out)|GsH] + ; Expr = [F|Args], + translate_args(Args, Execute, GsArgs, ArgsOut), + append(GsH, GsArgs, Inner), + ExprOut = [F|ArgsOut], + append(Inner, [reduce(ExprOut, Out)], Goals) ) + %Invoke translator to evaluate MeTTa code as data/list: + ; HV == eval, T = [Arg] -> append(GsH, [], Inner), + Goal = eval(Arg, Out), + append(Inner, [Goal], Goals) + %Force arg to remain data/list: + ; HV == quote, T = [Expr] -> append(GsH, [], Inner), + Out = Expr, + Goals = Inner + ; HV == 'catch', T = [Expr] -> + translate_expr(Expr, Execute, GsExpr, ExprOut), + append(GsH, [], Inner), + goals_list_to_conj(GsExpr, Conj), + Goal = catch((Conj, Out = ExprOut), + Exception, + (Exception = error(Type, Ctx) -> Out = ['Error', Type, Ctx] + ; Out = ['Error', Exception])), + append(Inner, [Goal], Goals) + %--- Automatic 'smart' dispatch, translator deciding when to create a predicate call, data list, or dynamic dispatch: --- + ; ( ( atom(HV), fun(HV), Fun = HV, IsPartial = false + ; compound(HV), HV = partial(Fun, Bound), IsPartial = true + ) + % Check for type definition FIRST (before translating args!) + -> findall(TypeChain, catch(match('&self', [':', Fun, TypeChain], TypeChain, TypeChain), _, fail), TypeChains), + ( TypeChains \= [] + -> % HAS TYPES - use typed translation (same as before) + maplist({Execute,Fun,T,GsH,IsPartial,Bound,Out}/[TypeChain,BranchGoal]>>( + typed_functioncall_branch(Fun, TypeChain, T, GsH, IsPartial, Bound, Out, BranchGoal)), TypeChains, Branches), + disj_list(Branches, Disj), + Goals = [Disj] + ; % NO TYPES - translate args normally and dispatch + translate_args(T, Execute, GsT, AVs), + ( IsPartial -> append(Bound, AVs, AllAVs) ; AllAVs = AVs ), + append(GsH, GsT, Inner), + (Execute + -> build_call_or_partial(Fun, AllAVs, Out, Inner, [], Goals) + ; Goals = [runtime_call(Fun, T, Out)] % Pass expressions, not values! + ) + ) + ; % Not a known function - translate args for remaining branches + translate_args(T, Execute, GsT, AVs), + append(GsH, GsT, Inner), + ( % Literals (numbers, strings, etc.) + ( atomic(HV), \+ atom(HV) ) -> Out = [HV|AVs], Goals = Inner + ; % Non-function atom + atom(HV), \+ fun(HV) -> ( Execute + -> Out = [HV|AVs], Goals = Inner + ; Goals = [runtime_call(HV, T, Out)] % Pass expressions! + ) + ; % Data list + is_list(HV) -> eval_data_term(Execute, HV, Gd, HV1), + append(Inner, Gd, Goals), + Out = [HV1|AVs] + ; % Unknown head (var/compound) => runtime dispatch + append(Inner, [reduce([HV|AVs], Out)], Goals) + ) + )). + +%Generate actual function call or partial if arity not complete: +build_call_or_partial(Fun, AVs, Out, Inner, Extra, Goals) :- + length(AVs, N), + Arity is N + 1, + ( maybe_specialize_call(Fun, AVs, Out, Goal) + -> % Specialization succeeded during execution - use it + append(Inner, [Goal|Extra], Goals) + ; ( current_predicate(Fun/Arity) ; catch(arity(Fun, Arity), _, fail) ), + \+ ( current_op(_, _, Fun), Arity =< 2 ) + -> % Direct call during execution + append(AVs, [Out], Args), + Goal =.. [Fun|Args], + append(Inner, [Goal|Extra], Goals) + ; Out = partial(Fun, AVs), + append(Inner, Extra, Goals) + ). + +% Runtime call helper: accepts unevaluated expressions and evaluates them according to type declarations +% This allows compiled programs to respect Expression types and other type annotations +% Falls back to reduce for edge cases (partial applications, non-callables, etc.) +runtime_call(Fun, ArgExprs, Out) :- + % Query for type declaration at runtime (when atom space is populated) + findall(TypeChain, catch(match('&self', [':', Fun, TypeChain], TypeChain, TypeChain), _, fail), TypeChains), + ( TypeChains = [TypeChain|_], + TypeChain = [->|Xs], + append(ArgTypes, [OutType], Xs) + -> % HAS TYPE DECLARATION - evaluate args according to their types + format('[DEBUG] runtime_call(~w, ~w) with types: ~w~n', [Fun, ArgExprs, ArgTypes]), + maplist({ArgExprs}/[Type,Expr,AV]>>( + ( Type == 'Expression' + -> format(' [DEBUG] Expr type: keeping ~w as Expression~n', [Expr]), AV = Expr + ; % Evaluate the expression + format(' [DEBUG] Evaluating ~w (type=~w)~n', [Expr, Type]), + translate_expr(Expr, true, Goals, AVTmp), + call_goals(Goals), + format(' [DEBUG] Evaluated to: ~w~n', [AVTmp]), + % Type check if not %Undefined% or Atom + ( (Type == '%Undefined%' ; Type == 'Atom') + -> format(' [DEBUG] Skipping type check (%Undefined%/Atom)~n'), AV = AVTmp + ; format(' [DEBUG] Type checking ~w against ~w~n', [AVTmp, Type]), + ( ('get-type'(AVTmp, Type) *-> true ; 'get-metatype'(AVTmp, Type)) + -> format(' [DEBUG] Type check PASSED~n'), AV = AVTmp + ; format(' [DEBUG] Type check FAILED~n'), fail + ) + ) + ) + ), ArgTypes, ArgExprs, AVs), + format('[DEBUG] Evaluated args: ~w~n', [AVs]), + % Now call the function with properly evaluated arguments + length(AVs, N), + Arity is N + 1, + ( maybe_specialize_call(Fun, AVs, OutTmp, Goal) + -> format('[DEBUG] Specialization succeeded~n'), writeln("specialization path."), call(Goal) + ; fun(Fun), + (current_predicate(Fun/Arity) ; catch(arity(Fun, Arity), _, fail)), + \+ ( current_op(_, _, Fun), Arity =< 2 ) + -> format('[DEBUG] Direct call: ~w/~w~n', [Fun, Arity]), + append(AVs, [OutTmp], Args), Goal =.. [Fun|Args], + format('[DEBUG] Calling: ~w~n', [Goal]), + call(Goal), + format('[DEBUG] Call succeeded, result: ~w~n', [OutTmp]) + ; format('[DEBUG] Fallback to reduce~n'), + reduce([Fun|AVs], OutTmp), + format('[DEBUG] Reduce result: ~w~n', [OutTmp]) + ), + % Type check output if needed + format('[DEBUG] Output type check: OutType=~w, OutTmp=~w~n', [OutType, OutTmp]), + ( (OutType == '%Undefined%' ; OutType == 'Atom') + -> format('[DEBUG] Skipping output type check~n'), Out = OutTmp + ; format('[DEBUG] Checking output type~n'), + ( ('get-type'(OutTmp, OutType) *-> true ; 'get-metatype'(OutTmp, OutType)) + -> format('[DEBUG] Output type check PASSED~n'), Out = OutTmp + ; format('[DEBUG] Output type check FAILED~n'), fail + ) + ), + format('[DEBUG] Final output: ~w~n', [Out]) + ; % NO TYPE DECLARATION - evaluate all args (default behavior) + maplist({ArgExprs}/[Expr,AV]>>( + translate_expr(Expr, true, Goals, AV), + call_goals(Goals) + ), ArgExprs, AVs), + % Call function (same logic as typed path) + length(AVs, N), + Arity is N + 1, + ( maybe_specialize_call(Fun, AVs, Out, Goal) + -> writeln("specialization path."), call(Goal) + ; fun(Fun), + (current_predicate(Fun/Arity) ; catch(arity(Fun, Arity), _, fail)), + \+ ( current_op(_, _, Fun), Arity =< 2 ) + -> append(AVs, [Out], Args), Goal =.. [Fun|Args], call(Goal) + ; reduce([Fun|AVs], Out) + ) + ). + +%Type function call generation, returns function call plus typechecks for input and output: +typed_functioncall_branch(Fun, TypeChain, T, GsH, IsPartial, Bound, Out, BranchGoal) :- + TypeChain = [->|Xs], + append(ArgTypes, [OutType], Xs), + translate_args_by_type(T, ArgTypes, GsT2, AVsTmp0), + ( IsPartial -> append(Bound, AVsTmp0, AVsTmp) ; AVsTmp = AVsTmp0 ), + append(GsH, GsT2, InnerTmp), + ( (OutType == '%Undefined%' ; OutType == 'Atom') + -> Extra = [] ; Extra = [('get-type'(Out, OutType) *-> true ; 'get-metatype'(Out, OutType))] ), + build_call_or_partial(Fun, AVsTmp, Out, InnerTmp, Extra, GoalsList), + goals_list_to_conj(GoalsList, BranchGoal). + + +%Selectively apply translate_args for non-Expression args while Expression args stay as data input: +translate_args_by_type([], _, [], []) :- !. +translate_args_by_type([A|As], [T|Ts], GsOut, [AV|AVs]) :- + ( T == 'Expression' -> AV = A, GsA = [] + ; translate_expr(A, true, GsA1, AV), + ( (T == '%Undefined%' ; T == 'Atom') + -> GsA = GsA1 + ; append(GsA1, [('get-type'(AV, T) *-> true ; 'get-metatype'(AV, T))], GsA))), + translate_args_by_type(As, Ts, GsRest, AVs), + append(GsA, GsRest, GsOut). + +%Handle data list: +eval_data_term(_Execute, X, [], X) :- (var(X); atomic(X)), !. +eval_data_term(Execute, [F|As], Goals, Val) :- + % When Execute=true (interpreter), evaluate functions in data lists + % When Execute=false (compiling), treat everything as pure data for runtime flexibility + ( Execute, atom(F), fun(F) + -> translate_expr([F|As], Execute, Goals, Val) + ; eval_data_list(Execute, [F|As], Goals, Val) ). + +%Handle data list entry: +eval_data_list(_Execute, [], [], []). +eval_data_list(Execute, [E|Es], Goals, [V|Vs]) :- + ( is_list(E) -> eval_data_term(Execute, E, G1, V) ; V = E, G1 = [] ), + eval_data_list(Execute, Es, G2, Vs), + append(G1, G2, Goals). + + +%Convert let* to recusrive let: +letstar_to_rec_let([[Pat,Val]],Body,[let,Pat,Val,Body]). +letstar_to_rec_let([[Pat,Val]|Rest],Body,[let,Pat,Val,Out]) :- letstar_to_rec_let(Rest,Body,Out). + +%Patterns: variables, atoms, numbers, lists: +translate_pattern(X, X) :- var(X), !. +translate_pattern(X, X) :- atomic(X), !. +translate_pattern([H|T], [P|Ps]) :- !, translate_pattern(H, P), + translate_pattern(T, Ps). + +% Constructs the goal for a single branch of an if-then-else/case. +build_branch(true, Val, Out, (Out = Val)) :- !. +build_branch(Con, Val, Out, Goal) :- var(Val) -> Val = Out, Goal = Con + ; Goal = (Val = Out, Con). + +%Translate case expression recursively into nested if: +translate_case([[K,VExpr]|Rs], Kv, Out, Goal, KGo) :- translate_expr_to_conj(VExpr, true, ConV, VOut), + constrain_args(K, Kc, Gc), + build_branch(ConV, VOut, Out, Then), + ( Rs == [] -> Goal = ((Kv = Kc) -> Then), KGi=[] + ; translate_case(Rs, Kv, Out, Next, KGi), + Goal = ((Kv = Kc) -> Then ; Next) ), + append([Gc,KGi], KGo). + +% Wrapper for interpreter mode +translate_args(Xs, Goals, Vs) :- translate_args(Xs, true, Goals, Vs). +%Translate arguments recursively: +translate_args([], _Execute, [], []). +translate_args([X|Xs], Execute, Goals, [V|Vs]) :- + translate_expr(X, Execute, G1, V), + translate_args(Xs, Execute, G2, Vs), + append(G1, G2, Goals). + +%Build A ; B ; C ... from a list: +disj_list([G], G). +disj_list([G|Gs], (G ; R)) :- disj_list(Gs, R). + +%Build one disjunct per branch: (Conj, Out = Val): +build_superpose_branches([], _, []). +build_superpose_branches([E|Es], Out, [B|Bs]) :- translate_expr_to_conj(E, true, Conj, Val), + build_branch(Conj, Val, Out, B), + build_superpose_branches(Es, Out, Bs). + +%Build hyperpose branch as a goal list for concurrent_maplist to consume: +build_hyperpose_branches([], []). +build_hyperpose_branches([E|Es], [(Goal, Res)|Bs]) :- translate_expr_to_conj(E, true, Goal, Res), + build_hyperpose_branches(Es, Bs). + +%Like membercheck but with direct equality rather than unification +memberchk_eq(V, [H|_]) :- V == H, !. +memberchk_eq(V, [_|T]) :- memberchk_eq(V, T). + +%Generate readable lambda name: +next_lambda_name(Name) :- ( catch(nb_getval(lambda_counter, Prev), _, Prev = 0) ), + N is Prev + 1, + nb_setval(lambda_counter, N), + format(atom(Name), 'lambda_~d', [N]). diff --git a/src/translator_new.pl b/src/translator_new.pl new file mode 100644 index 00000000..d953fd72 --- /dev/null +++ b/src/translator_new.pl @@ -0,0 +1,541 @@ +%Pattern matching, structural and functional/relational constraints on arguments: +constrain_args(X, X, []) :- (var(X); atomic(X)), !. +constrain_args([F, A, B], Out, Goals) :- nonvar(F), + F == cons, + constrain_args(A, A1, G1), + constrain_args(B, B1, G2), + Out = [A1|B1], + append(G1, G2, Goals), !. +constrain_args([F|Args], Var, Goals) :- atom(F), + fun(F), !, + translate_expr([F|Args], true, GoalsExpr, Var), + flatten(GoalsExpr, Goals). +constrain_args(In, Out, Goals) :- maplist(constrain_args, In, Out, NestedGoalsList), + flatten(NestedGoalsList, Goals), !. + +%Flatten (= Head Body) MeTTa function into Prolog Clause: +translate_clause(Input, (Head :- BodyConj)) :- translate_clause(Input, (Head :- BodyConj), true). +translate_clause(Input, (Head :- BodyConj), ConstrainArgs) :- + Input = [=, [F|Args0], BodyExpr], + ( ConstrainArgs -> maplist(constrain_args, Args0, Args1, GoalsA), + flatten(GoalsA,GoalsPrefix) + ; Args1 = Args0, GoalsPrefix = [] ), + catch(nb_getval(F, Prev), _, Prev = []), + nb_setval(F, [fun_meta(Args1, BodyExpr) | Prev]), + translate_expr(BodyExpr, true, GoalsBody, ExpOut), + ( nonvar(ExpOut) , ExpOut = partial(Base,Bound) + -> current_predicate(Base/Arity), length(Bound, N), M is (Arity - N) - 1, + length(ExtraArgs, M), append([Bound,ExtraArgs,[Out]],CallArgs), Goal =.. [Base|CallArgs], + append(GoalsBody,[Goal],FinalGoals), append(Args1,ExtraArgs,HeadArgs) + ; FinalGoals= GoalsBody , HeadArgs = Args1, Out = ExpOut ), + append(HeadArgs, [Out], FinalArgs), + Head =.. [F|FinalArgs], + append(GoalsPrefix, FinalGoals, Goals), + goals_list_to_conj(Goals, BodyConj). + +%Print compiled clause: +maybe_print_compiled_clause(_, _, _) :- catch(silent(true), _, true), !. +maybe_print_compiled_clause(Label, FormTerm, Clause) :- + swrite(FormTerm, FormStr), + format("\e[33m--> ~w -->~n\e[36m~w~n\e[33m--> prolog clause -->~n\e[32m", [Label, FormStr]), + portray_clause(current_output, Clause), + format("\e[33m^^^^^^^^^^^^^^^^^^^^^~n\e[0m"). + +%Conjunction builder, turning goals list to a flat conjunction: +goals_list_to_conj([], true) :- !. +goals_list_to_conj([G], G) :- !. +goals_list_to_conj([G|Gs], (G,R)) :- goals_list_to_conj(Gs, R). + +% Runtime dispatcher: call F if it's a registered fun/1, else keep as list: +reduce([F|Args], Out) :- nonvar(F), atom(F), fun(F) + -> % --- Case 1: callable predicate --- + length(Args, N), + Arity is N + 1, + ( current_predicate(F/Arity) , \+ (current_op(_, _, F), Arity =< 2) + -> append(Args,[Out],CallArgs), + Goal =.. [F|CallArgs], + catch(call(Goal),_,fail) + ; Out = partial(F,Args) ) + ; % --- Case 2: partial closure --- + compound(F), F = partial(Base, Bound) -> append(Bound, Args, NewArgs), + reduce([Base|NewArgs], Out) + ; % --- Case 3: leave unevaluated --- + Out = [F|Args], + \+ cyclic_term(Out). + +%Calling reduce from aggregate function foldall needs this argument wrapping +agg_reduce(AF, Acc, Val, NewAcc) :- reduce([AF, Acc, Val], NewAcc). + +%Combined expr translation to goals list +% Default wrapper for backward compatibility (interpreter mode) +translate_expr_to_conj(Input, Conj, Out) :- translate_expr_to_conj(Input, true, Conj, Out). +% Version that propagates Execute parameter +translate_expr_to_conj(Input, Execute, Conj, Out) :- translate_expr(Input, Execute, Goals, Out), + goals_list_to_conj(Goals, Conj). + +%Special stream operation rewrite rules before main translation +rewrite_streamops(['trace!', Arg1, Arg2], + [progn, ['println!', Arg1], Arg2]). +rewrite_streamops([unique, [superpose|Args]], + [call, [superpose, ['unique-atom', [collapse, [superpose|Args]]]]]). +rewrite_streamops([union, [superpose|A], [superpose|B]], + [call, [superpose, ['union-atom', [collapse, [superpose|A]], + [collapse, [superpose|B]]]]]). +rewrite_streamops([intersection, [superpose|A], [superpose|B]], + [call, [superpose, ['intersection-atom', [collapse, [superpose|A]], + [collapse, [superpose|B]]]]]). +rewrite_streamops([subtraction, [superpose|A], [superpose|B]], + [call, [superpose, ['subtraction-atom', [collapse, [superpose|A]], + [collapse, [superpose|B]]]]]). +rewrite_streamops(X, X). + +%Guarded stream ops rewrite rule application, successfully avoiding copy_term: +safe_rewrite_streamops(In, Out) :- ( compound(In), In = [Op|_], atom(Op) -> rewrite_streamops(In, Out) + ; Out = In). + +% Wrapper for interpreter mode: translate_expr/3 defaults to Execute=true +translate_expr(X, Goals, Out) :- translate_expr(X, true, Goals, Out). +%Turn MeTTa code S-expression into goals list: +translate_expr(X, _Execute, [], X) :- ((var(X) ; atomic(X)) ; X = partial(_,_)), !. +translate_expr([H0|T0], Execute, Goals, Out) :- + safe_rewrite_streamops([H0|T0],[H|T]), + translate_expr(H, Execute, GsH, HV), + %--- Translator rules ---: + ( nonvar(HV), translator_rule(HV) -> ( catch(match('&self', [':', HV, TypeChain], TypeChain, TypeChain), _, fail) + -> TypeChain = [->|Xs], + append(ArgTypes, [_], Xs), + translate_args_by_type(T, ArgTypes, GsT, T1) + ; translate_args(T, GsT, T1) ), + append(T1,[Gs],Args), + HookCall =.. [HV|Args], + call(HookCall), + translate_expr(Gs, Execute, GsE, Out), + append([GsH,GsT,GsE],Goals) + %--- Non-determinism ---: + ; HV == superpose, T = [Args], is_list(Args) -> build_superpose_branches(Args, Out, Branches), + disj_list(Branches, Disj), + append(GsH, [Disj], Goals) + ; HV == collapse, T = [E] -> translate_expr_to_conj(E, Execute, Conj, EV), + % Always just collect results with findall + % (result printing is handled at higher level in filereader.pl) + append(GsH, [(findall(EV, Conj, Out))], Goals) + ; HV == cut, T = [] -> append(GsH, [(!)], Goals), + Out = true + ; HV == test, T = [Expr, Expected] -> translate_expr_to_conj(Expr, Execute, Conj, Val), + translate_expr(Expected, Execute, GsE, ExpVal), + Goal1 = ( findall(Val, Conj, Results), + (Results = [Actual] -> true + ; Actual = Results ) ), + append(GsH, [Goal1], G1), + append(G1, GsE, G2), + append(G2, [test(Actual, ExpVal, Out)], Goals) + ; HV == once, T = [X] -> translate_expr_to_conj(X, Execute, Conj, Out), + append(GsH, [once(Conj)], Goals) + ; HV == hyperpose, T = [L] -> build_hyperpose_branches(L, Branches), + append(GsH, [concurrent_and(member((Goal,Res), Branches), (call(Goal), Out = Res))], Goals) + ; HV == with_mutex, T = [M,X] -> translate_expr_to_conj(X, Execute, Conj, Out), + append(GsH, [with_mutex(M,Conj)], Goals) + ; HV == transaction, T = [X] -> translate_expr_to_conj(X, Execute, Conj, Out), + append(GsH, [transaction(Conj)], Goals) + %--- Sequential execution ---: + ; HV == progn, T = Exprs -> translate_args(Exprs, Execute, GsList, Outs), + append(GsH, GsList, Tmp), + last(Outs, Out), + Goals = Tmp + ; HV == prog1, T = Exprs -> Exprs = [First|Rest], + translate_expr(First, Execute, GsF, Out), + translate_args(Rest, Execute, GsRest, _), + append(GsH, GsF, Tmp1), + append(Tmp1, GsRest, Goals) + %--- Conditionals ---: + ; HV == if, T = [Cond, Then] -> translate_expr_to_conj(Cond, Execute, ConC, Cv), + translate_expr_to_conj(Then, Execute, ConT, Tv), + build_branch(ConT, Tv, Out, BT), + ( ConC == true -> append(GsH, [ ( Cv == true -> BT ) ], Goals) + ; append(GsH, [ ( ConC, ( Cv == true -> BT ) ) ], Goals) ) + ; HV == if, T = [Cond, Then, Else] -> translate_expr_to_conj(Cond, Execute, ConC, Cv), + translate_expr_to_conj(Then, Execute, ConT, Tv), + translate_expr_to_conj(Else, Execute, ConE, Ev), + build_branch(ConT, Tv, Out, BT), + build_branch(ConE, Ev, Out, BE), + ( ConC == true -> append(GsH, [ (Cv == true -> BT ; BE) ], Goals) + ; append(GsH, [ (ConC, (Cv == true -> BT ; BE)) ], Goals) ) + ; HV == case, T = [KeyExpr, PairsExpr] -> ( select(Found0, PairsExpr, Rest0), + subsumes_term(['Empty', _], Found0), + Found0 = ['Empty', DefaultExpr], + NormalCases = Rest0 + -> translate_expr_to_conj(KeyExpr, Execute, GkConj, Kv), + translate_case(NormalCases, Kv, Out, CaseGoal, KeyGoal), + translate_expr_to_conj(DefaultExpr, Execute, ConD, DOut), + build_branch(ConD, DOut, Out, DefaultThen), + Combined = ( (GkConj, CaseGoal) ; + \+ GkConj, DefaultThen ), + append([GsH, KeyGoal, [Combined]], Goals) + ; translate_expr(KeyExpr, Execute, Gk, Kv), + translate_case(PairsExpr, Kv, Out, IfGoal, KeyGoal), + append([GsH, Gk, KeyGoal, [IfGoal]], Goals) ) + %--- Unification constructs ---: + ; (HV == let ; HV == chain), T = [Pat, Val, In] -> translate_expr(Pat, Execute, Gp, Pv), + translate_expr(Val, Execute, Gv, V), + translate_expr(In, Execute, Gi, Out), + append([GsH,[(Pv=V)],Gp,Gv,Gi], Goals) + ; HV == 'let*', T = [Binds, Body] -> letstar_to_rec_let(Binds,Body,RecLet), + translate_expr(RecLet, Execute, Goals, Out) + ; HV == sealed, T = [Vars, Expr] -> translate_expr_to_conj(Expr, Execute, Con, Val), + Goals = [copy_term(Vars,[Con,Val],_,[Ncon,Out]),Ncon] + %--- Iterating over non-deterministic generators without reification ---: + ; HV == 'forall', T = [GF, TF] + -> ( is_list(GF) -> GF = [GFH|GFA], + translate_expr(GFH, Execute, GsGFH, GFHV), + translate_args(GFA, Execute, GsGFA, GFAv), + append(GsGFH, GsGFA, GsGF), + GenList = [GFHV|GFAv] + ; translate_expr(GF, Execute, GsGF, GFHV), + GenList = [GFHV] ), + translate_expr(TF, Execute, GsTF, TFHV), + TestList = [TFHV, V], + goals_list_to_conj(GsGF, GPre), + GenGoal = (GPre, reduce(GenList, V)), + append(GsH, GsTF, Tmp0), + append(Tmp0, [( forall(GenGoal, ( reduce(TestList, Truth), Truth == true )) -> Out = true ; Out = false )], Goals) + ; HV == 'foldall', T = [AF, GF, InitS] + -> translate_expr_to_conj(InitS, Execute, ConjInit, Init), + translate_expr(AF, Execute, GsAF, AFV), + ( GF = [M|_], (M==match ; M==let ; M=='let*') -> LambdaGF = ['|->', [], GF], + translate_expr(LambdaGF, Execute, GsGF, GFHV), + GenList = [GFHV] + ; is_list(GF) -> GF = [GFH|GFA], + translate_expr(GFH, Execute, GsGFH, GFHV), + translate_args(GFA, Execute, GsGFA, GFAv), + append(GsGFH, GsGFA, GsGF), + GenList = [GFHV|GFAv] + ; translate_expr(GF, Execute, GsGF, GFHV), + GenList = [GFHV] ), + append(GsH, GsAF, Tmp1), + append(Tmp1, GsGF, Tmp2), + append(Tmp2, [ConjInit, foldall(agg_reduce(AFV, V), reduce(GenList, V), Init, Out)], Goals) + %--- Higher-order functions with pseudo-lambdas and lambdas ---: + ; HV == 'foldl-atom', T = [List, Init, AccVar, XVar, Body] + -> translate_expr_to_conj(List, Execute, ConjList, L), + translate_expr_to_conj(Init, Execute, ConjInit, InitV), + translate_expr_to_conj(Body, Execute, BodyConj, BG), + exclude(==(true), [ConjList, ConjInit], CleanConjs), + append(GsH, CleanConjs, GsMid), + append(GsMid, [foldl([XVar, AccVar, NewAcc]>>(BodyConj, ( number(BG) -> NewAcc is BG ; NewAcc = BG )), L, InitV, Out)], Goals) + ; HV == 'map-atom', T = [List, XVar, Body] + -> translate_expr_to_conj(List, Execute, ConjList, L), + translate_expr_to_conj(Body, Execute, BodyCallConj, BodyCall), + exclude(==(true), [ConjList], CleanConjs), + append(GsH, CleanConjs, GsMid), + append(GsMid, [maplist([XVar, Y]>>(BodyCallConj, ( number(BodyCall) -> Y is BodyCall ; Y = BodyCall )), L, Out)], Goals) + ; HV == 'filter-atom', T = [List, XVar, Cond] + -> translate_expr_to_conj(List, Execute, ConjList, L), + translate_expr_to_conj(Cond, Execute, CondConj, CondGoal), + exclude(==(true), [ConjList], CleanConjs), + append(GsH, CleanConjs, GsMid), + append(GsMid, [include([XVar]>>(CondConj, CondGoal), L, Out)], Goals) + ; HV == '|->', T = [Args, Body], Execute == true + -> next_lambda_name(F), + term_variables(Body, AllVars), + term_variables(Args, ArgVars), + exclude({ArgVars}/[V]>>memberchk_eq(V, ArgVars), AllVars, FreeVars), + append(FreeVars, Args, FullArgs), + translate_clause([=, [F|FullArgs], Body], Clause), + register_fun(F), + assertz(Clause), + format(atom(Label), "metta lambda (~w)", [F]), + maybe_print_compiled_clause(Label, ['|->', Args, Body], Clause), + length(FullArgs, N), + Arity is N + 1, + assertz(arity(F, Arity)), + ( FreeVars == [] -> Out = F, Goals = GsH + ; Out = partial(F, FreeVars), Goals = GsH ) + ; HV == '|->', T = [Args, Body], Execute == false + -> next_lambda_name(F), + % find free (non-argument) variables in Body + term_variables(Body, AllVars), + term_variables(Args, ArgVars), + exclude({ArgVars}/[V]>>memberchk_eq(V, ArgVars), AllVars, FreeVars), + append(FreeVars, Args, FullArgs), + translate_clause([=, [F|FullArgs], Body], Clause), + % Copy the clause so it doesn't share variables with FreeVars + % This ensures assertz gets a fresh template when FreeVars are bound + copy_term(Clause, ClauseCopy), + format(atom(Label), "metta lambda (~w)", [F]), + maybe_print_compiled_clause(Label, ['|->', Args, Body], Clause), + length(FullArgs, N), + Arity is N + 1, + ( FreeVars == [] -> OutValue = F + ; OutValue = partial(F, FreeVars) ), + LambdaConstructionGoals = [ + register_fun(F), + assertz(ClauseCopy), + assertz(arity(F, Arity)), + Out = OutValue + ], + append(GsH, LambdaConstructionGoals, Goals) + %--- Spaces ---: + ; ( HV == 'add-atom' ; HV == 'remove-atom' ), T = [_,_] -> append(T, [Out], RawArgs), + Goal =.. [HV|RawArgs], + append(GsH, [Goal], Goals) + ; HV == match, T = [Space, Pattern, Body] -> translate_expr(Space, Execute, G1, S), + translate_expr(Body, Execute, GsB, Out), + append(G1, [match(S, Pattern, Out, Out)], G2), + append(G2, GsB, Goals) + %--- Predicate to compiled goal ---: + ; HV == translatePredicate, T = [Expr] -> Expr = [S|Args], + translate_args(Args, Execute, GsArgs, ArgsOut), + Goal =.. [S|ArgsOut], + append(GsH, GsArgs, Inner), + append(Inner, [Goal], Goals) + %--- Manual dispatch options: --- + %Generate a predicate call on compilation, translating Args for nesting: + ; HV == call, T = [Expr] -> Expr = [F|Args], + translate_args(Args, Execute, GsArgs, ArgsOut), + append(GsH, GsArgs, Inner), + append(ArgsOut, [Out], CallArgs), + Goal =.. [F|CallArgs], + append(Inner, [Goal], Goals) + %Produce a dynamic dispatch, translating Args for nesting: + ; HV == reduce, T = [Expr] -> ( var(Expr) -> translate_expr(Expr, Execute, GsH, ExprOut), + Goals = [reduce(ExprOut, Out)|GsH] + ; Expr = [F|Args], + translate_args(Args, Execute, GsArgs, ArgsOut), + append(GsH, GsArgs, Inner), + ExprOut = [F|ArgsOut], + append(Inner, [reduce(ExprOut, Out)], Goals) ) + %Invoke translator to evaluate MeTTa code as data/list: + ; HV == eval, T = [Arg] -> append(GsH, [], Inner), + Goal = eval(Arg, Out), + append(Inner, [Goal], Goals) + %Force arg to remain data/list: + ; HV == quote, T = [Expr] -> append(GsH, [], Inner), + Out = Expr, + Goals = Inner + ; HV == 'catch', T = [Expr] -> + translate_expr(Expr, Execute, GsExpr, ExprOut), + append(GsH, [], Inner), + goals_list_to_conj(GsExpr, Conj), + Goal = catch((Conj, Out = ExprOut), + Exception, + (Exception = error(Type, Ctx) -> Out = ['Error', Type, Ctx] + ; Out = ['Error', Exception])), + append(Inner, [Goal], Goals) + %--- Automatic 'smart' dispatch, translator deciding when to create a predicate call, data list, or dynamic dispatch: --- + ; ( ( atom(HV), fun(HV), Fun = HV, IsPartial = false + ; compound(HV), HV = partial(Fun, Bound), IsPartial = true + ) + % Check for type definition FIRST (before translating args!) + -> findall(TypeChain, catch(match('&self', [':', Fun, TypeChain], TypeChain, TypeChain), _, fail), TypeChains), + ( TypeChains \= [] + -> % HAS TYPES - use typed translation (same as before) + maplist({Execute,Fun,T,GsH,IsPartial,Bound,Out}/[TypeChain,BranchGoal]>>( + typed_functioncall_branch(Fun, TypeChain, T, GsH, IsPartial, Bound, Out, BranchGoal)), TypeChains, Branches), + disj_list(Branches, Disj), + Goals = [Disj] + ; % NO TYPES - translate args normally and dispatch + translate_args(T, Execute, GsT, AVs), + ( IsPartial -> append(Bound, AVs, AllAVs) ; AllAVs = AVs ), + append(GsH, GsT, Inner), + (Execute + -> build_call_or_partial(Fun, AllAVs, Out, Inner, [], Goals) + ; Goals = [runtime_call(Fun, T, Out)] % Pass expressions, not values! + ) + ) + ; % Not a known function - translate args for remaining branches + translate_args(T, Execute, GsT, AVs), + append(GsH, GsT, Inner), + ( % Literals (numbers, strings, etc.) + ( atomic(HV), \+ atom(HV) ) -> Out = [HV|AVs], Goals = Inner + ; % Non-function atom + atom(HV), \+ fun(HV) -> ( Execute + -> Out = [HV|AVs], Goals = Inner + ; Goals = [runtime_call(HV, T, Out)] % Pass expressions! + ) + ; % Data list + is_list(HV) -> eval_data_term(Execute, HV, Gd, HV1), + append(Inner, Gd, Goals), + Out = [HV1|AVs] + ; % Unknown head (var/compound) => runtime dispatch + append(Inner, [reduce([HV|AVs], Out)], Goals) + ) + )). + +%Generate actual function call or partial if arity not complete: +build_call_or_partial(Fun, AVs, Out, Inner, Extra, Goals) :- + length(AVs, N), + Arity is N + 1, + ( maybe_specialize_call(Fun, AVs, Out, Goal) + -> % Specialization succeeded during execution - use it + append(Inner, [Goal|Extra], Goals) + ; ( current_predicate(Fun/Arity) ; catch(arity(Fun, Arity), _, fail) ), + \+ ( current_op(_, _, Fun), Arity =< 2 ) + -> % Direct call during execution + append(AVs, [Out], Args), + Goal =.. [Fun|Args], + append(Inner, [Goal|Extra], Goals) + ; Out = partial(Fun, AVs), + append(Inner, Extra, Goals) + ). + +% Runtime call helper: accepts unevaluated expressions and evaluates them according to type declarations +% This allows compiled programs to respect Expression types and other type annotations +% Falls back to reduce for edge cases (partial applications, non-callables, etc.) +runtime_call(Fun, ArgExprs, Out) :- + % Query for type declaration at runtime (when atom space is populated) + findall(TypeChain, catch(match('&self', [':', Fun, TypeChain], TypeChain, TypeChain), _, fail), TypeChains), + ( TypeChains = [TypeChain|_], + TypeChain = [->|Xs], + append(ArgTypes, [OutType], Xs) + -> % HAS TYPE DECLARATION - evaluate args according to their types + maplist({ArgExprs}/[Type,Expr,AV]>>( + ( Type == 'Expression' + -> AV = Expr % Keep as unevaluated expression + ; % Evaluate the expression + translate_expr(Expr, true, Goals, AVTmp), + call_goals(Goals), + % Type check if not %Undefined% or Atom + ( (Type == '%Undefined%' ; Type == 'Atom') + -> AV = AVTmp + ; ( ('get-type'(AVTmp, Type) *-> true ; 'get-metatype'(AVTmp, Type)) + -> AV = AVTmp + ; fail % Type check failed + ) + ) + ) + ), ArgTypes, ArgExprs, AVs), + % Now call the function with properly evaluated arguments + length(AVs, N), + Arity is N + 1, + ( maybe_specialize_call(Fun, AVs, OutTmp, Goal) + -> writeln("specialization path."), call(Goal) + ; fun(Fun), + (current_predicate(Fun/Arity) ; catch(arity(Fun, Arity), _, fail)), + \+ ( current_op(_, _, Fun), Arity =< 2 ) + -> append(AVs, [OutTmp], Args), Goal =.. [Fun|Args], call(Goal) + ; reduce([Fun|AVs], OutTmp) + ), + % Type check output if needed + ( (OutType == '%Undefined%' ; OutType == 'Atom') + -> Out = OutTmp + ; ( ('get-type'(OutTmp, OutType) *-> true ; 'get-metatype'(OutTmp, OutType)) + -> Out = OutTmp + ; fail % Output type check failed + ) + ) + ; % NO TYPE DECLARATION - evaluate all args (default behavior) + maplist({ArgExprs}/[Expr,AV]>>( + translate_expr(Expr, true, Goals, AV), + call_goals(Goals) + ), ArgExprs, AVs), + % Call function (same logic as typed path) + length(AVs, N), + Arity is N + 1, + ( maybe_specialize_call(Fun, AVs, Out, Goal) + -> writeln("specialization path."), call(Goal) + ; fun(Fun), + (current_predicate(Fun/Arity) ; catch(arity(Fun, Arity), _, fail)), + \+ ( current_op(_, _, Fun), Arity =< 2 ) + -> append(AVs, [Out], Args), Goal =.. [Fun|Args], call(Goal) + ; reduce([Fun|AVs], Out) + ) + ). + +%Type function call generation, returns function call plus typechecks for input and output: +typed_functioncall_branch(Fun, TypeChain, T, GsH, IsPartial, Bound, Out, BranchGoal) :- + TypeChain = [->|Xs], + append(ArgTypes, [OutType], Xs), + translate_args_by_type(T, ArgTypes, GsT2, AVsTmp0), + ( IsPartial -> append(Bound, AVsTmp0, AVsTmp) ; AVsTmp = AVsTmp0 ), + append(GsH, GsT2, InnerTmp), + ( (OutType == '%Undefined%' ; OutType == 'Atom') + -> Extra = [] ; Extra = [('get-type'(Out, OutType) *-> true ; 'get-metatype'(Out, OutType))] ), + build_call_or_partial(Fun, AVsTmp, Out, InnerTmp, Extra, GoalsList), + goals_list_to_conj(GoalsList, BranchGoal). + + +%Selectively apply translate_args for non-Expression args while Expression args stay as data input: +translate_args_by_type([], _, [], []) :- !. +translate_args_by_type([A|As], [T|Ts], GsOut, [AV|AVs]) :- + ( T == 'Expression' -> AV = A, GsA = [] + ; translate_expr(A, true, GsA1, AV), + ( (T == '%Undefined%' ; T == 'Atom') + -> GsA = GsA1 + ; append(GsA1, [('get-type'(AV, T) *-> true ; 'get-metatype'(AV, T))], GsA))), + translate_args_by_type(As, Ts, GsRest, AVs), + append(GsA, GsRest, GsOut). + +%Handle data list: +eval_data_term(_Execute, X, [], X) :- (var(X); atomic(X)), !. +eval_data_term(Execute, [F|As], Goals, Val) :- + % When Execute=true (interpreter), evaluate functions in data lists + % When Execute=false (compiling), treat everything as pure data for runtime flexibility + ( Execute, atom(F), fun(F) + -> translate_expr([F|As], Execute, Goals, Val) + ; eval_data_list(Execute, [F|As], Goals, Val) ). + +%Handle data list entry: +eval_data_list(_Execute, [], [], []). +eval_data_list(Execute, [E|Es], Goals, [V|Vs]) :- + ( is_list(E) -> eval_data_term(Execute, E, G1, V) ; V = E, G1 = [] ), + eval_data_list(Execute, Es, G2, Vs), + append(G1, G2, Goals). + + +%Convert let* to recusrive let: +letstar_to_rec_let([[Pat,Val]],Body,[let,Pat,Val,Body]). +letstar_to_rec_let([[Pat,Val]|Rest],Body,[let,Pat,Val,Out]) :- letstar_to_rec_let(Rest,Body,Out). + +%Patterns: variables, atoms, numbers, lists: +translate_pattern(X, X) :- var(X), !. +translate_pattern(X, X) :- atomic(X), !. +translate_pattern([H|T], [P|Ps]) :- !, translate_pattern(H, P), + translate_pattern(T, Ps). + +% Constructs the goal for a single branch of an if-then-else/case. +build_branch(true, Val, Out, (Out = Val)) :- !. +build_branch(Con, Val, Out, Goal) :- var(Val) -> Val = Out, Goal = Con + ; Goal = (Val = Out, Con). + +%Translate case expression recursively into nested if: +translate_case([[K,VExpr]|Rs], Kv, Out, Goal, KGo) :- translate_expr_to_conj(VExpr, true, ConV, VOut), + constrain_args(K, Kc, Gc), + build_branch(ConV, VOut, Out, Then), + ( Rs == [] -> Goal = ((Kv = Kc) -> Then), KGi=[] + ; translate_case(Rs, Kv, Out, Next, KGi), + Goal = ((Kv = Kc) -> Then ; Next) ), + append([Gc,KGi], KGo). + +% Wrapper for interpreter mode +translate_args(Xs, Goals, Vs) :- translate_args(Xs, true, Goals, Vs). +%Translate arguments recursively: +translate_args([], _Execute, [], []). +translate_args([X|Xs], Execute, Goals, [V|Vs]) :- + translate_expr(X, Execute, G1, V), + translate_args(Xs, Execute, G2, Vs), + append(G1, G2, Goals). + +%Build A ; B ; C ... from a list: +disj_list([G], G). +disj_list([G|Gs], (G ; R)) :- disj_list(Gs, R). + +%Build one disjunct per branch: (Conj, Out = Val): +build_superpose_branches([], _, []). +build_superpose_branches([E|Es], Out, [B|Bs]) :- translate_expr_to_conj(E, true, Conj, Val), + build_branch(Conj, Val, Out, B), + build_superpose_branches(Es, Out, Bs). + +%Build hyperpose branch as a goal list for concurrent_maplist to consume: +build_hyperpose_branches([], []). +build_hyperpose_branches([E|Es], [(Goal, Res)|Bs]) :- translate_expr_to_conj(E, true, Goal, Res), + build_hyperpose_branches(Es, Bs). + +%Like membercheck but with direct equality rather than unification +memberchk_eq(V, [H|_]) :- V == H, !. +memberchk_eq(V, [_|T]) :- memberchk_eq(V, T). + +%Generate readable lambda name: +next_lambda_name(Name) :- ( catch(nb_getval(lambda_counter, Prev), _, Prev = 0) ), + N is Prev + 1, + nb_setval(lambda_counter, N), + format(atom(Name), 'lambda_~d', [N]). diff --git a/src/translator_old.pl b/src/translator_old.pl new file mode 100644 index 00000000..76874088 --- /dev/null +++ b/src/translator_old.pl @@ -0,0 +1,489 @@ +%Pattern matching, structural and functional/relational constraints on arguments: +constrain_args(X, X, []) :- (var(X); atomic(X)), !. +constrain_args([F, A, B], Out, Goals) :- nonvar(F), + F == cons, + constrain_args(A, A1, G1), + constrain_args(B, B1, G2), + Out = [A1|B1], + append(G1, G2, Goals), !. +constrain_args([F|Args], Var, Goals) :- atom(F), + fun(F), !, + translate_expr([F|Args], true, GoalsExpr, Var), + flatten(GoalsExpr, Goals). +constrain_args(In, Out, Goals) :- maplist(constrain_args, In, Out, NestedGoalsList), + flatten(NestedGoalsList, Goals), !. + +%Flatten (= Head Body) MeTTa function into Prolog Clause: +translate_clause(Input, (Head :- BodyConj)) :- translate_clause(Input, (Head :- BodyConj), true). +translate_clause(Input, (Head :- BodyConj), ConstrainArgs) :- + Input = [=, [F|Args0], BodyExpr], + ( ConstrainArgs -> maplist(constrain_args, Args0, Args1, GoalsA), + flatten(GoalsA,GoalsPrefix) + ; Args1 = Args0, GoalsPrefix = [] ), + catch(nb_getval(F, Prev), _, Prev = []), + nb_setval(F, [fun_meta(Args1, BodyExpr) | Prev]), + translate_expr(BodyExpr, true, GoalsBody, ExpOut), + ( nonvar(ExpOut) , ExpOut = partial(Base,Bound) + -> current_predicate(Base/Arity), length(Bound, N), M is (Arity - N) - 1, + length(ExtraArgs, M), append([Bound,ExtraArgs,[Out]],CallArgs), Goal =.. [Base|CallArgs], + append(GoalsBody,[Goal],FinalGoals), append(Args1,ExtraArgs,HeadArgs) + ; FinalGoals= GoalsBody , HeadArgs = Args1, Out = ExpOut ), + append(HeadArgs, [Out], FinalArgs), + Head =.. [F|FinalArgs], + append(GoalsPrefix, FinalGoals, Goals), + goals_list_to_conj(Goals, BodyConj). + +%Print compiled clause: +maybe_print_compiled_clause(_, _, _) :- catch(silent(true), _, true), !. +maybe_print_compiled_clause(Label, FormTerm, Clause) :- + swrite(FormTerm, FormStr), + format("\e[33m--> ~w -->~n\e[36m~w~n\e[33m--> prolog clause -->~n\e[32m", [Label, FormStr]), + portray_clause(current_output, Clause), + format("\e[33m^^^^^^^^^^^^^^^^^^^^^~n\e[0m"). + +%Conjunction builder, turning goals list to a flat conjunction: +goals_list_to_conj([], true) :- !. +goals_list_to_conj([G], G) :- !. +goals_list_to_conj([G|Gs], (G,R)) :- goals_list_to_conj(Gs, R). + +% Runtime dispatcher: call F if it's a registered fun/1, else keep as list: +reduce([F|Args], Out) :- nonvar(F), atom(F), fun(F) + -> % --- Case 1: callable predicate --- + length(Args, N), + Arity is N + 1, + ( current_predicate(F/Arity) , \+ (current_op(_, _, F), Arity =< 2) + -> append(Args,[Out],CallArgs), + Goal =.. [F|CallArgs], + catch(call(Goal),_,fail) + ; Out = partial(F,Args) ) + ; % --- Case 2: partial closure --- + compound(F), F = partial(Base, Bound) -> append(Bound, Args, NewArgs), + reduce([Base|NewArgs], Out) + ; % --- Case 3: leave unevaluated --- + Out = [F|Args], + \+ cyclic_term(Out). + +%Calling reduce from aggregate function foldall needs this argument wrapping +agg_reduce(AF, Acc, Val, NewAcc) :- reduce([AF, Acc, Val], NewAcc). + +%Combined expr translation to goals list +% Default wrapper for backward compatibility (interpreter mode) +translate_expr_to_conj(Input, Conj, Out) :- translate_expr_to_conj(Input, true, Conj, Out). +% Version that propagates Execute parameter +translate_expr_to_conj(Input, Execute, Conj, Out) :- translate_expr(Input, Execute, Goals, Out), + goals_list_to_conj(Goals, Conj). + +%Special stream operation rewrite rules before main translation +rewrite_streamops(['trace!', Arg1, Arg2], + [progn, ['println!', Arg1], Arg2]). +rewrite_streamops([unique, [superpose|Args]], + [call, [superpose, ['unique-atom', [collapse, [superpose|Args]]]]]). +rewrite_streamops([union, [superpose|A], [superpose|B]], + [call, [superpose, ['union-atom', [collapse, [superpose|A]], + [collapse, [superpose|B]]]]]). +rewrite_streamops([intersection, [superpose|A], [superpose|B]], + [call, [superpose, ['intersection-atom', [collapse, [superpose|A]], + [collapse, [superpose|B]]]]]). +rewrite_streamops([subtraction, [superpose|A], [superpose|B]], + [call, [superpose, ['subtraction-atom', [collapse, [superpose|A]], + [collapse, [superpose|B]]]]]). +rewrite_streamops(X, X). + +%Guarded stream ops rewrite rule application, successfully avoiding copy_term: +safe_rewrite_streamops(In, Out) :- ( compound(In), In = [Op|_], atom(Op) -> rewrite_streamops(In, Out) + ; Out = In). + +% Wrapper for interpreter mode: translate_expr/3 defaults to Execute=true +translate_expr(X, Goals, Out) :- translate_expr(X, true, Goals, Out). +%Turn MeTTa code S-expression into goals list: +translate_expr(X, _Execute, [], X) :- ((var(X) ; atomic(X)) ; X = partial(_,_)), !. +translate_expr([H0|T0], Execute, Goals, Out) :- + safe_rewrite_streamops([H0|T0],[H|T]), + translate_expr(H, Execute, GsH, HV), + %--- Translator rules ---: + ( nonvar(HV), translator_rule(HV) -> ( catch(match('&self', [':', HV, TypeChain], TypeChain, TypeChain), _, fail) + -> TypeChain = [->|Xs], + append(ArgTypes, [_], Xs), + translate_args_by_type(T, ArgTypes, GsT, T1) + ; translate_args(T, GsT, T1) ), + append(T1,[Gs],Args), + HookCall =.. [HV|Args], + call(HookCall), + translate_expr(Gs, Execute, GsE, Out), + append([GsH,GsT,GsE],Goals) + %--- Non-determinism ---: + ; HV == superpose, T = [Args], is_list(Args) -> build_superpose_branches(Args, Out, Branches), + disj_list(Branches, Disj), + append(GsH, [Disj], Goals) + ; HV == collapse, T = [E] -> translate_expr_to_conj(E, Execute, Conj, EV), + % Always just collect results with findall + % (result printing is handled at higher level in filereader.pl) + append(GsH, [(findall(EV, Conj, Out))], Goals) + ; HV == cut, T = [] -> append(GsH, [(!)], Goals), + Out = true + ; HV == test, T = [Expr, Expected] -> translate_expr_to_conj(Expr, Execute, Conj, Val), + translate_expr(Expected, Execute, GsE, ExpVal), + Goal1 = ( findall(Val, Conj, Results), + (Results = [Actual] -> true + ; Actual = Results ) ), + append(GsH, [Goal1], G1), + append(G1, GsE, G2), + append(G2, [test(Actual, ExpVal, Out)], Goals) + ; HV == once, T = [X] -> translate_expr_to_conj(X, Execute, Conj, Out), + append(GsH, [once(Conj)], Goals) + ; HV == hyperpose, T = [L] -> build_hyperpose_branches(L, Branches), + append(GsH, [concurrent_and(member((Goal,Res), Branches), (call(Goal), Out = Res))], Goals) + ; HV == with_mutex, T = [M,X] -> translate_expr_to_conj(X, Execute, Conj, Out), + append(GsH, [with_mutex(M,Conj)], Goals) + ; HV == transaction, T = [X] -> translate_expr_to_conj(X, Execute, Conj, Out), + append(GsH, [transaction(Conj)], Goals) + %--- Sequential execution ---: + ; HV == progn, T = Exprs -> translate_args(Exprs, Execute, GsList, Outs), + append(GsH, GsList, Tmp), + last(Outs, Out), + Goals = Tmp + ; HV == prog1, T = Exprs -> Exprs = [First|Rest], + translate_expr(First, Execute, GsF, Out), + translate_args(Rest, Execute, GsRest, _), + append(GsH, GsF, Tmp1), + append(Tmp1, GsRest, Goals) + %--- Conditionals ---: + ; HV == if, T = [Cond, Then] -> translate_expr_to_conj(Cond, Execute, ConC, Cv), + translate_expr_to_conj(Then, Execute, ConT, Tv), + build_branch(ConT, Tv, Out, BT), + ( ConC == true -> append(GsH, [ ( Cv == true -> BT ) ], Goals) + ; append(GsH, [ ( ConC, ( Cv == true -> BT ) ) ], Goals) ) + ; HV == if, T = [Cond, Then, Else] -> translate_expr_to_conj(Cond, Execute, ConC, Cv), + translate_expr_to_conj(Then, Execute, ConT, Tv), + translate_expr_to_conj(Else, Execute, ConE, Ev), + build_branch(ConT, Tv, Out, BT), + build_branch(ConE, Ev, Out, BE), + ( ConC == true -> append(GsH, [ (Cv == true -> BT ; BE) ], Goals) + ; append(GsH, [ (ConC, (Cv == true -> BT ; BE)) ], Goals) ) + ; HV == case, T = [KeyExpr, PairsExpr] -> ( select(Found0, PairsExpr, Rest0), + subsumes_term(['Empty', _], Found0), + Found0 = ['Empty', DefaultExpr], + NormalCases = Rest0 + -> translate_expr_to_conj(KeyExpr, Execute, GkConj, Kv), + translate_case(NormalCases, Kv, Out, CaseGoal, KeyGoal), + translate_expr_to_conj(DefaultExpr, Execute, ConD, DOut), + build_branch(ConD, DOut, Out, DefaultThen), + Combined = ( (GkConj, CaseGoal) ; + \+ GkConj, DefaultThen ), + append([GsH, KeyGoal, [Combined]], Goals) + ; translate_expr(KeyExpr, Execute, Gk, Kv), + translate_case(PairsExpr, Kv, Out, IfGoal, KeyGoal), + append([GsH, Gk, KeyGoal, [IfGoal]], Goals) ) + %--- Unification constructs ---: + ; (HV == let ; HV == chain), T = [Pat, Val, In] -> translate_expr(Pat, Execute, Gp, Pv), + translate_expr(Val, Execute, Gv, V), + translate_expr(In, Execute, Gi, Out), + append([GsH,[(Pv=V)],Gp,Gv,Gi], Goals) + ; HV == 'let*', T = [Binds, Body] -> letstar_to_rec_let(Binds,Body,RecLet), + translate_expr(RecLet, Execute, Goals, Out) + ; HV == sealed, T = [Vars, Expr] -> translate_expr_to_conj(Expr, Execute, Con, Val), + Goals = [copy_term(Vars,[Con,Val],_,[Ncon,Out]),Ncon] + %--- Iterating over non-deterministic generators without reification ---: + ; HV == 'forall', T = [GF, TF] + -> ( is_list(GF) -> GF = [GFH|GFA], + translate_expr(GFH, Execute, GsGFH, GFHV), + translate_args(GFA, Execute, GsGFA, GFAv), + append(GsGFH, GsGFA, GsGF), + GenList = [GFHV|GFAv] + ; translate_expr(GF, Execute, GsGF, GFHV), + GenList = [GFHV] ), + translate_expr(TF, Execute, GsTF, TFHV), + TestList = [TFHV, V], + goals_list_to_conj(GsGF, GPre), + GenGoal = (GPre, reduce(GenList, V)), + append(GsH, GsTF, Tmp0), + append(Tmp0, [( forall(GenGoal, ( reduce(TestList, Truth), Truth == true )) -> Out = true ; Out = false )], Goals) + ; HV == 'foldall', T = [AF, GF, InitS] + -> translate_expr_to_conj(InitS, Execute, ConjInit, Init), + translate_expr(AF, Execute, GsAF, AFV), + ( GF = [M|_], (M==match ; M==let ; M=='let*') -> LambdaGF = ['|->', [], GF], + translate_expr(LambdaGF, Execute, GsGF, GFHV), + GenList = [GFHV] + ; is_list(GF) -> GF = [GFH|GFA], + translate_expr(GFH, Execute, GsGFH, GFHV), + translate_args(GFA, Execute, GsGFA, GFAv), + append(GsGFH, GsGFA, GsGF), + GenList = [GFHV|GFAv] + ; translate_expr(GF, Execute, GsGF, GFHV), + GenList = [GFHV] ), + append(GsH, GsAF, Tmp1), + append(Tmp1, GsGF, Tmp2), + append(Tmp2, [ConjInit, foldall(agg_reduce(AFV, V), reduce(GenList, V), Init, Out)], Goals) + %--- Higher-order functions with pseudo-lambdas and lambdas ---: + ; HV == 'foldl-atom', T = [List, Init, AccVar, XVar, Body] + -> translate_expr_to_conj(List, Execute, ConjList, L), + translate_expr_to_conj(Init, Execute, ConjInit, InitV), + translate_expr_to_conj(Body, Execute, BodyConj, BG), + exclude(==(true), [ConjList, ConjInit], CleanConjs), + append(GsH, CleanConjs, GsMid), + append(GsMid, [foldl([XVar, AccVar, NewAcc]>>(BodyConj, ( number(BG) -> NewAcc is BG ; NewAcc = BG )), L, InitV, Out)], Goals) + ; HV == 'map-atom', T = [List, XVar, Body] + -> translate_expr_to_conj(List, Execute, ConjList, L), + translate_expr_to_conj(Body, Execute, BodyCallConj, BodyCall), + exclude(==(true), [ConjList], CleanConjs), + append(GsH, CleanConjs, GsMid), + append(GsMid, [maplist([XVar, Y]>>(BodyCallConj, ( number(BodyCall) -> Y is BodyCall ; Y = BodyCall )), L, Out)], Goals) + ; HV == 'filter-atom', T = [List, XVar, Cond] + -> translate_expr_to_conj(List, Execute, ConjList, L), + translate_expr_to_conj(Cond, Execute, CondConj, CondGoal), + exclude(==(true), [ConjList], CleanConjs), + append(GsH, CleanConjs, GsMid), + append(GsMid, [include([XVar]>>(CondConj, CondGoal), L, Out)], Goals) + ; HV == '|->', T = [Args, Body], Execute == true + -> next_lambda_name(F), + term_variables(Body, AllVars), + term_variables(Args, ArgVars), + exclude({ArgVars}/[V]>>memberchk_eq(V, ArgVars), AllVars, FreeVars), + append(FreeVars, Args, FullArgs), + translate_clause([=, [F|FullArgs], Body], Clause), + register_fun(F), + assertz(Clause), + format(atom(Label), "metta lambda (~w)", [F]), + maybe_print_compiled_clause(Label, ['|->', Args, Body], Clause), + length(FullArgs, N), + Arity is N + 1, + assertz(arity(F, Arity)), + ( FreeVars == [] -> Out = F, Goals = GsH + ; Out = partial(F, FreeVars), Goals = GsH ) + ; HV == '|->', T = [Args, Body], Execute == false + -> next_lambda_name(F), + % find free (non-argument) variables in Body + term_variables(Body, AllVars), + term_variables(Args, ArgVars), + exclude({ArgVars}/[V]>>memberchk_eq(V, ArgVars), AllVars, FreeVars), + append(FreeVars, Args, FullArgs), + translate_clause([=, [F|FullArgs], Body], Clause), + % Copy the clause so it doesn't share variables with FreeVars + % This ensures assertz gets a fresh template when FreeVars are bound + copy_term(Clause, ClauseCopy), + format(atom(Label), "metta lambda (~w)", [F]), + maybe_print_compiled_clause(Label, ['|->', Args, Body], Clause), + length(FullArgs, N), + Arity is N + 1, + ( FreeVars == [] -> OutValue = F + ; OutValue = partial(F, FreeVars) ), + LambdaConstructionGoals = [ + register_fun(F), + assertz(ClauseCopy), + assertz(arity(F, Arity)), + Out = OutValue + ], + append(GsH, LambdaConstructionGoals, Goals) + %--- Spaces ---: + ; ( HV == 'add-atom' ; HV == 'remove-atom' ), T = [_,_] -> append(T, [Out], RawArgs), + Goal =.. [HV|RawArgs], + append(GsH, [Goal], Goals) + ; HV == match, T = [Space, Pattern, Body] -> translate_expr(Space, Execute, G1, S), + translate_expr(Body, Execute, GsB, Out), + append(G1, [match(S, Pattern, Out, Out)], G2), + append(G2, GsB, Goals) + %--- Predicate to compiled goal ---: + ; HV == translatePredicate, T = [Expr] -> Expr = [S|Args], + translate_args(Args, Execute, GsArgs, ArgsOut), + Goal =.. [S|ArgsOut], + append(GsH, GsArgs, Inner), + append(Inner, [Goal], Goals) + %--- Manual dispatch options: --- + %Generate a predicate call on compilation, translating Args for nesting: + ; HV == call, T = [Expr] -> Expr = [F|Args], + translate_args(Args, Execute, GsArgs, ArgsOut), + append(GsH, GsArgs, Inner), + append(ArgsOut, [Out], CallArgs), + Goal =.. [F|CallArgs], + append(Inner, [Goal], Goals) + %Produce a dynamic dispatch, translating Args for nesting: + ; HV == reduce, T = [Expr] -> ( var(Expr) -> translate_expr(Expr, Execute, GsH, ExprOut), + Goals = [reduce(ExprOut, Out)|GsH] + ; Expr = [F|Args], + translate_args(Args, Execute, GsArgs, ArgsOut), + append(GsH, GsArgs, Inner), + ExprOut = [F|ArgsOut], + append(Inner, [reduce(ExprOut, Out)], Goals) ) + %Invoke translator to evaluate MeTTa code as data/list: + ; HV == eval, T = [Arg] -> append(GsH, [], Inner), + Goal = eval(Arg, Out), + append(Inner, [Goal], Goals) + %Force arg to remain data/list: + ; HV == quote, T = [Expr] -> append(GsH, [], Inner), + Out = Expr, + Goals = Inner + ; HV == 'catch', T = [Expr] -> + translate_expr(Expr, Execute, GsExpr, ExprOut), + append(GsH, [], Inner), + goals_list_to_conj(GsExpr, Conj), + Goal = catch((Conj, Out = ExprOut), + Exception, + (Exception = error(Type, Ctx) -> Out = ['Error', Type, Ctx] + ; Out = ['Error', Exception])), + append(Inner, [Goal], Goals) + %--- Automatic 'smart' dispatch, translator deciding when to create a predicate call, data list, or dynamic dispatch: --- + ; translate_args(T, Execute, GsT, AVs), + append(GsH, GsT, Inner), + %Known function => direct call: + ( is_list(AVs), + ( atom(HV), fun(HV), Fun = HV, AllAVs = AVs, IsPartial = false + ; compound(HV), HV = partial(Fun, Bound), append(Bound,AVs,AllAVs), IsPartial = true + ) % Check for type definition [:,HV,TypeChain] + -> findall(TypeChain, catch(match('&self', [':', Fun, TypeChain], TypeChain, TypeChain), _, fail), TypeChains), + ( TypeChains \= [] + -> maplist({Execute,Fun,T,GsH,IsPartial,Bound,Out}/[TypeChain,BranchGoal]>>( + typed_functioncall_branch(Fun, TypeChain, T, GsH, IsPartial, Bound, Out, BranchGoal)), TypeChains, Branches), + disj_list(Branches, Disj), + Goals = [Disj] + ; (Execute -> + build_call_or_partial(Fun, AllAVs, Out, Inner, [], Goals)) + ; append(Inner, [runtime_call(Fun, AVs, Out)], Goals) + ) + %Literals (numbers, strings, etc.), known non-function atom => data: + ; ( atomic(HV), \+ atom(HV) ) -> Out = [HV|AVs], + Goals = Inner + ; atom(HV), \+ fun(HV) -> ( Execute -> Out = [HV|AVs], Goals = Inner + ; append(Inner, [runtime_call(HV, AVs, Out)], Goals) ) + %Plain data list: evaluate inner fun-sublists + ; is_list(HV) -> eval_data_term(Execute, HV, Gd, HV1), + append(Inner, Gd, Goals), + Out = [HV1|AVs] + %Unknown head (var/compound) => runtime dispatch: + ; append(Inner, [reduce([HV|AVs], Out)], Goals) )). + +%Generate actual function call or partial if arity not complete: +build_call_or_partial(Fun, AVs, Out, Inner, Extra, Goals) :- + length(AVs, N), + Arity is N + 1, + ( maybe_specialize_call(Fun, AVs, Out, Goal) + -> % Specialization succeeded during execution - use it + append(Inner, [Goal|Extra], Goals) + ; ( current_predicate(Fun/Arity) ; catch(arity(Fun, Arity), _, fail) ), + \+ ( current_op(_, _, Fun), Arity =< 2 ) + -> % Direct call during execution + append(AVs, [Out], Args), + Goal =.. [Fun|Args], + append(Inner, [Goal|Extra], Goals) + ; Out = partial(Fun, AVs), + append(Inner, Extra, Goals) + ). + +% Runtime call helper: replicates what build_call_or_partial does when Execute=true +% This allows compiled programs to benefit from specialization +% Falls back to reduce for edge cases (partial applications, non-callables, etc.) +runtime_call(Fun, AVs, Out) :- + length(AVs, N), + Arity is N + 1, + ( maybe_specialize_call(Fun, AVs, Out, Goal) + -> % Specialization succeeded - call it + writeln("specialization path."), + call(Goal) + ; fun(Fun), + (current_predicate(Fun/Arity) ; catch(arity(Fun, Arity), _, fail) ), + \+ ( current_op(_, _, Fun), Arity =< 2 ) + -> % Direct call + append(AVs, [Out], Args), + Goal =.. [Fun|Args], + call(Goal) + ; % Not callable as predicate - use reduce for proper handling + reduce([Fun|AVs], Out) + ). + +%Type function call generation, returns function call plus typechecks for input and output: +typed_functioncall_branch(Fun, TypeChain, T, GsH, IsPartial, Bound, Out, BranchGoal) :- + TypeChain = [->|Xs], + append(ArgTypes, [OutType], Xs), + translate_args_by_type(T, ArgTypes, GsT2, AVsTmp0), + ( IsPartial -> append(Bound, AVsTmp0, AVsTmp) ; AVsTmp = AVsTmp0 ), + append(GsH, GsT2, InnerTmp), + ( (OutType == '%Undefined%' ; OutType == 'Atom') + -> Extra = [] ; Extra = [('get-type'(Out, OutType) *-> true ; 'get-metatype'(Out, OutType))] ), + build_call_or_partial(Fun, AVsTmp, Out, InnerTmp, Extra, GoalsList), + goals_list_to_conj(GoalsList, BranchGoal). + + +%Selectively apply translate_args for non-Expression args while Expression args stay as data input: +translate_args_by_type([], _, [], []) :- !. +translate_args_by_type([A|As], [T|Ts], GsOut, [AV|AVs]) :- + ( T == 'Expression' -> AV = A, GsA = [] + ; translate_expr(A, true, GsA1, AV), + ( (T == '%Undefined%' ; T == 'Atom') + -> GsA = GsA1 + ; append(GsA1, [('get-type'(AV, T) *-> true ; 'get-metatype'(AV, T))], GsA))), + translate_args_by_type(As, Ts, GsRest, AVs), + append(GsA, GsRest, GsOut). + +%Handle data list: +eval_data_term(_Execute, X, [], X) :- (var(X); atomic(X)), !. +eval_data_term(Execute, [F|As], Goals, Val) :- + % When Execute=true (interpreter), evaluate functions in data lists + % When Execute=false (compiling), treat everything as pure data for runtime flexibility + ( Execute, atom(F), fun(F) + -> translate_expr([F|As], Execute, Goals, Val) + ; eval_data_list(Execute, [F|As], Goals, Val) ). + +%Handle data list entry: +eval_data_list(_Execute, [], [], []). +eval_data_list(Execute, [E|Es], Goals, [V|Vs]) :- + ( is_list(E) -> eval_data_term(Execute, E, G1, V) ; V = E, G1 = [] ), + eval_data_list(Execute, Es, G2, Vs), + append(G1, G2, Goals). + + +%Convert let* to recusrive let: +letstar_to_rec_let([[Pat,Val]],Body,[let,Pat,Val,Body]). +letstar_to_rec_let([[Pat,Val]|Rest],Body,[let,Pat,Val,Out]) :- letstar_to_rec_let(Rest,Body,Out). + +%Patterns: variables, atoms, numbers, lists: +translate_pattern(X, X) :- var(X), !. +translate_pattern(X, X) :- atomic(X), !. +translate_pattern([H|T], [P|Ps]) :- !, translate_pattern(H, P), + translate_pattern(T, Ps). + +% Constructs the goal for a single branch of an if-then-else/case. +build_branch(true, Val, Out, (Out = Val)) :- !. +build_branch(Con, Val, Out, Goal) :- var(Val) -> Val = Out, Goal = Con + ; Goal = (Val = Out, Con). + +%Translate case expression recursively into nested if: +translate_case([[K,VExpr]|Rs], Kv, Out, Goal, KGo) :- translate_expr_to_conj(VExpr, true, ConV, VOut), + constrain_args(K, Kc, Gc), + build_branch(ConV, VOut, Out, Then), + ( Rs == [] -> Goal = ((Kv = Kc) -> Then), KGi=[] + ; translate_case(Rs, Kv, Out, Next, KGi), + Goal = ((Kv = Kc) -> Then ; Next) ), + append([Gc,KGi], KGo). + +% Wrapper for interpreter mode +translate_args(Xs, Goals, Vs) :- translate_args(Xs, true, Goals, Vs). +%Translate arguments recursively: +translate_args([], _Execute, [], []). +translate_args([X|Xs], Execute, Goals, [V|Vs]) :- + translate_expr(X, Execute, G1, V), + translate_args(Xs, Execute, G2, Vs), + append(G1, G2, Goals). + +%Build A ; B ; C ... from a list: +disj_list([G], G). +disj_list([G|Gs], (G ; R)) :- disj_list(Gs, R). + +%Build one disjunct per branch: (Conj, Out = Val): +build_superpose_branches([], _, []). +build_superpose_branches([E|Es], Out, [B|Bs]) :- translate_expr_to_conj(E, true, Conj, Val), + build_branch(Conj, Val, Out, B), + build_superpose_branches(Es, Out, Bs). + +%Build hyperpose branch as a goal list for concurrent_maplist to consume: +build_hyperpose_branches([], []). +build_hyperpose_branches([E|Es], [(Goal, Res)|Bs]) :- translate_expr_to_conj(E, true, Goal, Res), + build_hyperpose_branches(Es, Bs). + +%Like membercheck but with direct equality rather than unification +memberchk_eq(V, [H|_]) :- V == H, !. +memberchk_eq(V, [_|T]) :- memberchk_eq(V, T). + +%Generate readable lambda name: +next_lambda_name(Name) :- ( catch(nb_getval(lambda_counter, Prev), _, Prev = 0) ), + N is Prev + 1, + nb_setval(lambda_counter, N), + format(atom(Name), 'lambda_~d', [N]). diff --git a/test.sh b/test.sh index 30107f65..cff65741 100755 --- a/test.sh +++ b/test.sh @@ -3,6 +3,7 @@ run_test() { f="$1" echo "Running $f" + # output=$(sh run.sh --compiler "$f" | grep "is " | grep " should ") output=$(sh run.sh "$f" | grep "is " | grep " should ") echo "$output" | grep -q "❌" fail=$? @@ -25,7 +26,7 @@ pidfile="/tmp/metta_pid_map.$$" for f in ./examples/*.metta; do base=$(basename "$f") - case "$base" in repl.metta|llm_cities.metta|torch.metta|greedy_chess.metta|git_import2.metta) + case "$base" in repl.metta|llm_cities.metta|torch.metta|greedy_chess.metta|git_import2.metta|matespacefast.metta|matespace.metta|matespace2.metta|he_minimalmetta.metta|invertpeanoplus.metta) continue ;; esac run_test "$f" &