From ab050daf675f5ff1c844df83dd4a19ea6d687f67 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Tue, 17 Dec 2024 21:07:06 -0800 Subject: [PATCH 01/42] mettalog --limit-result-count=5 --initial-result-count=2 --log --- prolog/metta_lang/metta_interp.pl | 28 ++- prolog/metta_lang/metta_repl.pl | 371 ++++++++++++++++-------------- 2 files changed, 215 insertions(+), 184 deletions(-) diff --git a/prolog/metta_lang/metta_interp.pl b/prolog/metta_lang/metta_interp.pl index 70cf69efc70..55c6e77d96d 100755 --- a/prolog/metta_lang/metta_interp.pl +++ b/prolog/metta_lang/metta_interp.pl @@ -403,8 +403,7 @@ % Resource Limits option_value_name_default_type_help('stack-max', 500, [inf,1000,10_000], "Maximum stack depth allowed during execution", 'Resource Limits'). -all_option_value_name_default_type_help('maximum-result-count', inf, [inf,1,2,3,10], "Set the maximum number of results, infinite by default", 'Miscellaneous'). -option_value_name_default_type_help('limit', inf, [inf,1,2,3,10], "Set the maximum number of results, infinite by default", 'Miscellaneous'). +all_option_value_name_default_type_help('limit-result-count', inf, [inf,1,2,3,10], "Set the maximum number of results, infinite by default", 'Miscellaneous'). option_value_name_default_type_help('initial-result-count', 10, [inf,10], "For MeTTaLog log mode: print the first 10 answers without waiting for user", 'Miscellaneous'). % Miscellaneous @@ -562,7 +561,8 @@ set_option_value_interp(N,V):- %(different_from(N,V)->Note=true;Note=false), Note = true, - fbugio(Note,set_option_value(N,V)),set_option_value(N,V), + %fbugio(Note,set_option_value(N,V)), + set_option_value(N,V), ignore(forall(on_set_value(Note,N,V),true)). on_set_value(Note,N,'True'):- on_set_value(Note,N,true). @@ -648,8 +648,10 @@ ). null_io(G):- null_user_output(Out), !, with_output_to(Out,G). -user_io(G):- current_prolog_flag(mettalog_rt, true), !, original_user_error(Out), ttyflush, !, with_output_to(Out,G), flush_output(Out), ttyflush. -user_io(G):- original_user_output(Out), ttyflush, !, with_output_to(Out,G), flush_output(Out), ttyflush. + +user_io(G):- notrace(user_io_0(G)). +user_io_0(G):- current_prolog_flag(mettalog_rt, true), !, original_user_error(Out), ttyflush, !, with_output_to(Out,G), flush_output(Out), ttyflush. +user_io_0(G):- original_user_output(Out), ttyflush, !, with_output_to(Out,G), flush_output(Out), ttyflush. user_err(G):- original_user_error(Out), !, with_output_to(Out,G). with_output_to_s(Out,G):- current_output(COut), redo_call_cleanup(set_prolog_IO(user_input, Out,user_error), G, @@ -669,8 +671,10 @@ % If output is not suspended, it captures the output based on the streams involved. % % @arg G The goal to be executed. -in_answer_io(_):- nb_current(suspend_answers,true),!. -in_answer_io(G) :- + +in_answer_io(G):- notrace((in_answer_io_0(G))). +in_answer_io_0(_):- nb_current(suspend_answers,true),!. +in_answer_io_0(G) :- % Get the answer_output stream answer_output(AnswerOut), % Get the current output stream @@ -1098,7 +1102,7 @@ cmdline_load_metta(Phase,Self,[M|Rest]):- m_opt(M,Opt), is_cmd_option(Opt,M,TF), - fbug(is_cmd_option(Phase,Opt,M,TF)), + %fbug(is_cmd_option(Phase,Opt,M,TF)), set_option_value_interp(Opt,TF), !, %set_tty_color_term(true), cmdline_load_metta(Phase,Self,Rest). @@ -1764,7 +1768,7 @@ call_for_term_variables(TermV,Term,NamedVarsList,X), must_be(nonvar,Term), copy_term(NamedVarsList,Was), Output = NamedVarsList, - user:interactively_do_metta_exec(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut). + user:u_do_metta_exec(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut). do_metta(_File,Load,Self,Src,Out):- Load\==exec, !, if_t(into_simple_op(Load,Src,OP),pfcAdd_Now('next-operation'(OP))), @@ -1793,10 +1797,12 @@ do_metta_exec(From,Self,TermV,FOut):- Output = X, %format("########################X0 ~w ~w ~w\n",[Self,TermV,FOut]), - (catch(((output_language(metta,write_exec(TermV)), + (catch((( + % Show exec from file(_) + if_t(From=file(_),output_language(metta,write_exec(TermV))), notrace(into_metta_callable(Self,TermV,Term,X,NamedVarsList,Was)),!, %format("########################X1 ~w ~w ~w ~w\n",[Term,X,NamedVarsList,Output]), - user:interactively_do_metta_exec(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut))), + user:u_do_metta_exec(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut))), give_up(Why),pp_m(red,gave_up(Why)))). %format("########################X2 ~w ~w ~w\n",[Self,TermV,FOut]). diff --git a/prolog/metta_lang/metta_repl.pl b/prolog/metta_lang/metta_repl.pl index 05810794eb5..861e2ba1a19 100755 --- a/prolog/metta_lang/metta_repl.pl +++ b/prolog/metta_lang/metta_repl.pl @@ -216,7 +216,7 @@ % Set the option 'doing_repl' to true. with_option('doing_repl', true, % Set the 'repl' option to true and then start repl2. - with_option(repl, true, repl2)). + with_option(repl, true, repl2)). %! repl2 is nondet. % The main loop of the REPL, responsible for managing history, garbage collection, and catching any errors. @@ -233,9 +233,9 @@ % Begin an infinite loop using repeat to keep REPL active. repeat, % Reset internal caches for better performance. - reset_caches, + notrace((reset_caches, % Force garbage collection to free memory. - garbage_collect, + garbage_collect)), % Execute repl3 and catch any errors that occur during execution. ignore(catch((ignore(catch(once(repl3), restart_reading, true))), % If an error occurs, print the reason and continue the loop. @@ -276,7 +276,7 @@ notrace(prompt(Was, Was)), setup_call_cleanup( % Set the terminal prompt without tracing. - set_metta_prompt, + notrace(set_metta_prompt), % Flush the terminal and call repl4 to handle input. ((ttyflush, repl4, ttyflush)), % After execution, restore the previous terminal prompt. @@ -300,7 +300,7 @@ % repl4 :- % Reset the evaluation number to ensure expressions are counted properly. - ((reset_eval_num, + notrace((reset_eval_num, % Write the result of the previous evaluation (if any) to the output. write_answer_output, % The following command to reset terminal settings is commented out for now. @@ -314,16 +314,21 @@ % Check for any directives embedded in the expression and process them. (ignore(check_has_directive(Expr))), % Get the current self reference and reading mode for the REPL. - current_self(Self), current_read_mode(repl, Mode), + current_self(Self), current_read_mode(repl, Mode))), % Output the read expression for debugging purposes, if applicable. - nop(writeqln(repl_read(Expr))),!, + %nop(writeqln(repl_read(Expr))),!, % Evaluate the expression using the `do_metta/5` predicate. ignore(once((do_metta(repl_true, Mode, Self, Expr, O)))),!, % Optionally write the result of the evaluation to the source. - nop((write_src(O), nl)), + notrace((nop((write_src(O), nl)), % Throw `restart_reading` to restart the REPL input process after execution. nop(notrace(throw(restart_reading))))),!. +cls:- shell(clear). + +:- dynamic(metta_trace_restore/1). +store_metta_trace:- ignore((\+ metta_trace_restore(_), get_trace_reset(W),assert(metta_trace_restore(W)))),notrace. +restore_metta_trace:- notrace,ignore((retract(metta_trace_restore(W)),call(W))). %! check_has_directive(+V) is nondet. % @@ -1056,8 +1061,8 @@ % For each clause of reset_cache, run the body in rtrace mode to handle errors. forall(clause(reset_cache, Body), forall(rtrace_on_error(Body), true)). -%! interactively_do_metta_exec(+From, +Self, +TermV, +Term, +X, +NamedVarsList, +Was, -Output, -FOut) is det. -% Executes a metta command interactively, handling potential errors and caching. +%! u_do_metta_exec(+From, +Self, +TermV, +Term, +X, +NamedVarsList, +Was, -Output, -FOut) is det. +% Executes a metta command (maybe interactively), handling potential errors and caching. % Resets caches and evaluates the execution command, catching any errors that occur. % % @arg From is the source of the interaction (e.g., REPL, file). @@ -1071,22 +1076,22 @@ % @arg FOut is the final output, after additional processing. % % @example -% ?- interactively_do_metta_exec(repl, self, TermV, my_term, X, NamedVarsList, Was, Output, FOut). +% ?- u_do_metta_exec(repl, self, TermV, my_term, X, NamedVarsList, Was, Output, FOut). % Output = ..., FOut = ... -interactively_do_metta_exec(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut) :- +u_do_metta_exec(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut) :- % Reset internal caches before executing the command. reset_caches, % Attempt to execute the command interactively, catching any errors. - catch(interactively_do_metta_exec00(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut), + catch(u_do_metta_exec00(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut), Error, % If an error occurs, log it along with the source and the term. write_src(error(Error,From,TermV))). each_pair_list(A-B,A,B). -%! interactively_do_metta_exec00(+From, +Self, +TermV, +Term, +X, +NamedVarsList, +Was, -Output, -FOut) is det. +%! u_do_metta_exec00(+From, +Self, +TermV, +Term, +X, +NamedVarsList, +Was, -Output, -FOut) is det. % A helper function that handles the core logic of the interactive metta execution, catching potential aborts. -% This is the next layer in the call stack after interactively_do_metta_exec/9. +% This is the next layer in the call stack after u_do_metta_exec/9. % % @arg From is the source of the interaction. % @arg Self is the current context or environment. @@ -1097,17 +1102,17 @@ % @arg Was is the previous state before execution. % @arg Output is the output generated from the execution. % @arg FOut is the final output, after additional processing. -interactively_do_metta_exec00(file(lsp(From)),Self,TermV,Term,X,NamedVarsList,Was,OutputL,FOutL):- fail, nonvar(From), !, - findall(Output-FOut,interactively_do_metta_exec01(repl_true,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut),List), +u_do_metta_exec00(file(lsp(From)),Self,TermV,Term,X,NamedVarsList,Was,OutputL,FOutL):- fail, nonvar(From), !, + findall(Output-FOut,u_do_metta_exec01(repl_true,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut),List), maplist(each_pair_list,List,OutputL,FOutL). -interactively_do_metta_exec00(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut) :- +u_do_metta_exec00(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut) :- % Attempt the actual execution and catch any '$aborted' exceptions. - catch(interactively_do_metta_exec01(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut), + catch(u_do_metta_exec01(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut), % Handle the '$aborted' exception by logging it. '$aborted', fbug(aborted(From,TermV))). -%! interactively_do_metta_exec01(+From, +Self, +_TermV, +Term, -X, +NamedVarsList, +Was, -VOutput, +FOut) is det. +%! u_do_metta_exec01(+From, +Self, +_TermV, +Term, -X, +NamedVarsList, +Was, -VOutput, +FOut) is det. % % Executes a term in a controlled interactive environment, handling history, skipping, and timing of results. % This predicate manages evaluation in an interactive session, possibly skipping certain executions based on file source and other conditions. @@ -1123,175 +1128,195 @@ % @arg FOut is the final output to be printed. % % @example -% ?- interactively_do_metta_exec01(file("example"), self, _, term(likes), Result, NamedVarsList, Was, Output, Final). +% ?- u_do_metta_exec01(file("example"), self, _, term(likes), Result, NamedVarsList, Was, Output, Final). % Result = likes(X,Y), % Output = "Execution Time: 1.5s", % Final = 'Completed Successfully'. % % @see reset_eval_num/0 for resetting evaluation counters, notrace/1 to suppress trace during execution, and lazy_findall/3 for lazy evaluation. +:- discontiguous u_do_metta_exec01/9. + % Handles interactive execution of mettalog commands, but skips execution if From is a file and results are hidden. -interactively_do_metta_exec01(file(_), Self, _TermV, Term, X, _NamedVarsList, _Was, _Output, _FOut) :- - % Checks if the term should hide results when sourced from a file - file_hides_results(Term), !, - % Evaluate arguments and return the result - eval_args(Self, Term, X). - -% Reset evaluation counter -interactively_do_metta_exec01(From,Self,TermV,Term,X,NamedVarsList,Was,VOutput,FOut):- - %format("%%%%%%%%%%%%%%%%%%%%%%%%%2 ~w\n",[Term]), - notrace(( +u_do_metta_exec01(file(_), Self, _TermV, Term, X, _NamedVarsList, _Was, _Output, _FOut) :- + notrace(file_hides_results(Term)), !, % Checks if the term should hide results when sourced from a file + eval_args(Self, Term, X). % Evaluate arguments and return the result + +u_do_metta_exec01(From,Self,TermV,Term,X,NamedVarsList,Was,VOutput,FOut):- + notrace((flag(result_num,_,0), % Reset result number flag + reset_eval_num, % Reset evaluation counters for a fresh start + inside_assert(Term,BaseEval))), % Convert the current term into a base evaluation + (notrace(skip_do_metta_exec(From,Self,TermV,BaseEval,Term,X,NamedVarsList,Was,VOutput,FOut))-> true; + u_do_metta_exec02(From,Self,TermV,BaseEval,Term,X,NamedVarsList,Was,VOutput,FOut)). + +% --exec=skip +skip_do_metta_exec(From,Self,TermV,BaseEval,_Term,X,NamedVarsList,_Was,_VOutput,_FOut):- + option_value('exec',skip), From = file(_Filename), + \+ always_exec(BaseEval), \+ always_exec(TermV), + color_g_mesg('#da70d6', (write('; SKIPPING: '), write_src_woi(TermV))), + prolog_only(if_t((TermV\=@=BaseEval),color_g_mesg('#da70d6', (write('\n% Thus: '), writeq(eval_H(500,Self,BaseEval,X)),writeln('.'))))), + \+ \+ maybe_add_history(Self, BaseEval, NamedVarsList). + +maybe_add_history(Self, BaseEval, NamedVarsList) :- + % Prepare evaluation for the base term + PL=eval(Self,BaseEval,X), + user:maplist(name_vars, NamedVarsList), + user:name_vars('OUT' = X), + if_t(\+ option_value(doing_repl,true), + if_t(\+ option_value(repl,true), + if_t(option_value(prolog,true), add_history_pl(PL)))), + if_t(option_value(repl,true), add_history_src(exec(BaseEval))), + + % Debug output in interactive mode, showing evaluated terms and results + prolog_only((color_g_mesg('#da70d6', (write('% DEBUG: '), writeq(PL), writeln('.'))))). - % Reset result number flag - flag(result_num,_,0), - % Reset evaluation counters for a fresh start - reset_eval_num, +u_do_metta_exec02(From,Self,TermV,BaseEval,Term,_X,NamedVarsList,Was,VOutput,FOut):- + notrace(( + if_t(is_interactive(From), \+ \+ maybe_add_history(Self, BaseEval, NamedVarsList)), + % Was --exec=skip but this is the type of directive we'd do anyways + if_t((From = file(_), option_value('exec',skip)), color_g_mesg('#da7036', (write('\n; Always-Exec: '), write_src_woi(TermV)))), % Initialize the result variable, with FOut to hold the final output Result = res(FOut), + % If compatible, determine the evaluation mode (either 'leap' or 'each') + (is_compatio -> option_else(answer,Leap,leap) ; option_else(answer,Leap, each)), + + % Set options for maximum and initial result counts, infinite results if needed + option_else('limit-result-count',MaxResults,inf), + option_else('initial-result-count',InitialResults,10), + + % Control variable initialized with max result count and leap control + Control = contrl(InitialResults,MaxResults,Leap), + + GgGgGgGgGgG = ( + % Execute Term and capture the result + (( (Term),deterministic(Complete), % record if top-level metta evaluation is completed + % Transform output for display and store it in the result + notrace((xform_out(VOutput,Output), nb_setarg(1,Result,Output)))))), + + % Placeholder for a previous result, starting with 'Empty' Prev = prev_result('Empty'), - % Assert the current term into a base evaluation - inside_assert(Term,BaseEval), + % Print formatted answer output + in_answer_io(format('~n[')))),!, - % If compatible, determine the evaluation mode (either 'leap' or 'each') - (is_compatio -> option_else(answer,Leap,leap) ; option_else(answer,Leap,each)), - - % Set options for maximum and initial result counts, infinite results if needed - option_else('maximum-result-count',MaxResults,inf), - option_else('initial-result-count',LeashResults,10), - - % Control variable initialized with max result count and leap control - Control = contrl(MaxResults,Leap), - Skipping = _, - - % Commented code for interactive control, previously enabled for file skipping - /* previously: if From = file(_Filename), option_value('exec',skip), \+ always_exec(BaseEval) */ - (((From = file(_Filename), option_value('exec',skip), \+ notrace(always_exec(BaseEval);always_exec(TermV)))) - -> ( - % Skip execution if conditions are met - GgGgGgGgGgG = (skip(Term),deterministic(Complete)), - % Mark as skipped - Skipping = 1,!, - color_g_mesg('#da70d6', (write('; SKIPPING: '), write_src_woi(TermV))), - prolog_only(if_t((TermV\=@=BaseEval),color_g_mesg('#da70d6', (write('\n% Thus: '), writeq(eval_H(500,Self,BaseEval,X)),writeln('.'))))), - true - ) - ; % Otherwise, execute the goal interactively - ( if_t((From = file(_), option_value('exec',skip)), - color_g_mesg('#da7036', (write('\n; Always-Exec: '), write_src_woi(TermV)))), - GgGgGgGgGgG = ( - % Execute Term and capture the result - (( (Term),deterministic(Complete), - % Transform output for display and store it in the result - xform_out(VOutput,Output), nb_setarg(1,Result,Output))))), - !, % Ensure the top-level metta evaluation is completed + % Interactive looping with possible timing and stepping control + ( + forall_interactive( + From, WasInteractive,Complete, %may_rtrace + timed_call(GgGgGgGgGgG,Seconds), - % Prepare evaluation for the base term - PL=eval(Self,BaseEval,X), + ((( - % Apply mappings and assignments, track result history if necessary - ( % with_indents(true, - \+ \+ (user:maplist(name_vars,NamedVarsList), - user:name_vars('OUT'=X), - /* previously: add_history_src(exec(BaseEval)) */ - /* previously: if_t(TermV\=BaseEval,color_g_mesg('#fa90f6', (write('; '), with_indents(false,write_src(exec(BaseEval)))))) */ + %(Complete==true->!;true), - % Handle interactive result output or non-interactive result history - if_t((is_interactive(From);Skipping==1), - ( - if_t( \+ option_value(doing_repl,true), - if_t( \+ option_value(repl,true), - if_t( option_value(prolog,true), add_history_pl(PL)))), - if_t(option_value(repl,true), add_history_src(exec(BaseEval))))), + ((print_result_output(WasInteractive,Complete,ResNum,Prev,NamedVarsList,Control,Result,Seconds,Was,Output,Stepping))), - % Debug output in interactive mode, showing evaluated terms and results - prolog_only((color_g_mesg('#da70d6', (write('% DEBUG: '), writeq(PL),writeln('.'))))), - true))))), + (ResNum >= MaxResults -> ! ; true), - % Print formatted answer output - in_answer_io(format('~n[')),!, - % Interactive looping with possible timing and stepping control - (forall_interactive( - From, WasInteractive,Complete, %may_rtrace - (timed_call(GgGgGgGgGgG,Seconds)), - ((((((Complete==true->!;true), - %repeat, - set_option_value(interactive,WasInteractive), - Control = contrl(Max,DoLeap), - nb_setarg(1,Result,Output), - current_input(CI), - read_pending_codes(CI,_,[]), - flag(result_num,R,R+1), - flag(result_num,ResNum,ResNum), - reset_eval_num, - %not_compatio(format('~N')), maybe more space between answers? - - user_io(( - in_answer_io(if_t((Prev\=@=prev_result('Empty')),write(', '))), - nb_setarg(1,Prev,Output))), - - - output_language(answers,(if_t(ResNum=(old_not_compatio(format('~N~nDeterministic: ', [])), !); %or Nondet - /* previously: handle deterministic result output */ - (Complete==true -> (old_not_compatio(format('~N~nResult(~w): ',[ResNum])),! ); - old_not_compatio(format('~N~nN(~w):',[ResNum]))))), - ignore((( - if_t( \+ symbolic(Output), not_compatio(nop(nl))), - %if_t(ResNum==1,in_answer_io(format('~N['))), - % user_io - (with_indents(is_mettalog, - color_g_mesg_ok(yellow, - \+ \+ - (maybe_name_vars(NamedVarsList), - old_not_compatio(write_bsrc(Output)), - true)))) )) ))))), - in_answer_io(write_asrc((Output))), - - % not_compatio(extra_answer_padding(format('~N'))), % Just in case, add some virt space between answers - - ((Complete \== true, WasInteractive, DoLeap \== leap, - LeashResults > ResNum, ResNum < Max) -> Stepping = true ; Stepping = false), - - %if_debugging(time,with_output_to(user_error,give_time('Execution',Seconds))), - if_t((Stepping==true;Complete==true),if_trace(time,color_g_mesg_ok(yellow,(user_io(give_time('Execution',Seconds)))))), - %with_output_to(user_error,give_time('Execution',Seconds)), - %user_io(give_time('Execution',Seconds)), - %not_compatio(give_time('Execution',Seconds), - color_g_mesg(green, - ignore((NamedVarsList \=@= Was ->(not_compatio(( - reverse(NamedVarsList,NamedVarsListR), - maplist(print_var,NamedVarsListR), nop(nl)))) ; true))))), - ( - (Stepping==true) -> - (old_not_compatio(format("~npress ';' for more solutions ")),get_single_char_key(C), - old_not_compatio((writeq(key=C),nl)), + Cut = _, + Next = _, + ((Stepping==true) -> + (repeat, + old_not_compatio(format("~npress ';' for more solutions ")),get_single_char_key(C), + old_not_compatio((writeq(key=C),nl)), (C=='b' -> (once(repl),fail) ; - (C=='m' -> make ; - (C=='t' -> (nop(set_debug(eval,true)),rtrace) ; - (C=='T' -> (set_debug(eval,true)); - (C==';' -> true ; - (C==esc('[A',[27,91,65]) -> nb_setarg(2, Control, leap) ; - (C=='L' -> nb_setarg(1, Control, ResNum) ; - (C=='l' -> nb_setarg(2, Control, leap) ; - (((C=='\n');(C=='\r')) -> (!,fail); - (!,fail)))))))))))); - - (Complete\==true, \+ WasInteractive, Control = contrl(Max,leap)) -> true ; - (((Complete==true ->! ; true))))), not_compatio(extra_answer_padding(format('~N~n'))))) - *-> (ignore(Result = res(FOut)),ignore(Output = (FOut))) - ; (flag(result_num,ResNum,ResNum),(ResNum==0-> - (in_answer_io(nop(write('['))),old_not_compatio(format('~N~n~n')),!,true);true))), - in_answer_io((write(']'),if_t(\+is_mettalog,nl))), + (C=='B' -> (once(prolog),fail) ; + (C=='a' -> (notrace(abort),fail) ; + (C=='e' -> (notrace(halt(5)),fail) ; + (C=='m' -> (make,fail) ; + (C=='c' -> (trace,Next=true) ; + (C==' ' -> (trace,Next=true) ; + (C=='t' -> (nop(set_debug(eval,true)),rtrace,Next=true) ; + (C=='T' -> (set_debug(eval,true),Next=true); + (C=='?' -> (print_debug_help,fail)) ; + (C==';' -> Next=true ; + (C==esc('[A',[27,91,65]) -> (Cut=true,Next=false) ; + (C==esc('[B',[27,91,66]) -> (nb_setarg(3, Control, leap),Cut=false,Next=true) ; + (C=='L' -> nb_setarg(2, Control, ResNum) ; + (C=='l' -> (nb_setarg(3, Control, leap),Next=true) ; + (((C=='\n');(C=='\r')) -> (Cut=true,Next=false); + (C=='g' -> write_src(exec(TermV)); + (C=='s' -> (Cut=true,Next=false); + (true -> (write('Unknown Char'),fail))))))))))))))))))), + (nonvar(Next);nonvar(Cut))) ; true), + + ((Complete==true;Cut==true) ->! ; true), + (nonvar(Next)->Next==true; true), + ((flag(result_num,ResNum,ResNum),ResNum >= MaxResults) -> (!,fail) ; true) + /*(Complete\==true, \+ WasInteractive, Control = contrl(_,_,leap)) -> true ; + + )), + not_compatio(extra_answer_padding(format('~N~n'))) + )*/ + + ))) + ) *-> % Each forall_interactive + (((flag(result_num,ResNum,ResNum),ResNum >= MaxResults) -> ! ; true),ignore(Result = res(FOut)),ignore(Output = (FOut))) + ; % Last forall_interactive + (flag(result_num,ResNum,ResNum),(ResNum==0-> (old_not_compatio(format('~N;; no-results ;; ~n~n')),!,true);true)) + + ), + + in_answer_io((write(']'),if_t(\+is_mettalog,nl))), flag(need_prompt,_,1), ignore(Result = res(FOut)). +print_result_output(WasInteractive,Complete,ResNum,Prev,NamedVarsList,Control,Result,Seconds,Was,Output,Stepping):- + set_option_value(interactive,WasInteractive), + Control = contrl(LeashResults,Max,DoLeap), + assertion(LeashResults==inf;number(LeashResults)), + assertion(Max==inf;number(Max)), + nb_setarg(1,Result,Output), + current_input(CI), read_pending_codes(CI,_,[]), + flag(result_num,R,R+1), + flag(result_num,ResNum,ResNum), + reset_eval_num, + %not_compatio(format('~N')), maybe more space between answers? + + user_io(( + in_answer_io(if_t((Prev\=@=prev_result('Empty')),write(', '))), + nb_setarg(1,Prev,Output))), + + + output_language(answers,(if_t(ResNum=(old_not_compatio(format('~N~nDeterministic: ', [])), !); %or Nondet + /* previously: handle deterministic result output */ + (Complete==true -> (old_not_compatio(format('~N~nR(~w): ',[ResNum])),! ); + old_not_compatio(format('~N~nN(~w): ',[ResNum]))))), + ignore((( + if_t( \+ symbolic(Output), not_compatio(nop(nl))), + %if_t(ResNum==1,in_answer_io(format('~N['))), + % user_io + (with_indents(is_mettalog, + color_g_mesg_ok(yellow, + \+ \+ + (maybe_name_vars(NamedVarsList), + old_not_compatio(write_bsrc(Output)), + true)))) )) ))))), + + in_answer_io(write_asrc((Output))), + + + ((Complete \== true, WasInteractive, DoLeap \== leap, + LeashResults =< ResNum, ResNum < Max) -> Stepping = true ; Stepping = false), + + %if_debugging(time,with_output_to(user_error,give_time('Execution',Seconds))), + if_t((Stepping==true;Complete==true),if_trace(time,color_g_mesg_ok(yellow,(user_io(give_time('Execution',Seconds)))))), + + color_g_mesg(green, + ignore((NamedVarsList \=@= Was ->(not_compatio(( + reverse(NamedVarsList,NamedVarsListR), + maplist(print_var,NamedVarsListR), nop(nl)))) ; true))). + + + + old_not_compatio(G):- call(G),ttyflush. %! maybe_assign(+N_V) is det. @@ -1404,7 +1429,7 @@ % Execute the goal. Goal, % If the goal is complete, quietly execute 'After', otherwise negate 'After'. - (Complete == true -> (quietly(After), !) ; (quietly(\+ After))). + (Complete == true -> (quietly(After), !) ; ( \+ quietly(After))). %! print_var(+Name, +Var) is det. % @@ -2314,28 +2339,28 @@ % % ?- print_help. % -print_help :- +print_debug_help :- % Print each available debugger command with its description. writeln('Debugger commands:'), writeln('(;) next - Retry with next solution.'), writeln('(g) goal - Show the current goal.'), - writeln('(u) up - Finish this goal without interruption.'), + %writeln('(u) up - Finish this goal without interruption.'), writeln('(s) skip - Skip to the next solution.'), writeln('(c) creep or - Proceed step by step.'), writeln('(l) leap - Leap over (the debugging).'), - writeln('(f) fail - Force the current goal to fail.'), - writeln('(B) back - Go back to the previous step.'), + %writeln('(f) fail - Force the current goal to fail.'), + %writeln('(B) back - Go back to the previous step.'), writeln('(t) trace - Toggle tracing on or off.'), writeln('(e) exit - Exit the debugger.'), writeln('(a) abort - Abort the current operation.'), writeln('(b) break - Break to a new sub-REPL.'), - writeln('(h) help - Display this help message.'), - writeln('(A) alternatives - Show alternative solutions.'), + writeln('(?) help - Display this help message.'), + %writeln('(A) alternatives - Show alternative solutions.'), writeln('(m) make - Recompile/Update the current running code.'), - writeln('(C) compile - Compile a fresh executable (based on the running state).'), - writeln('(E) error msg - Show the latest error messages.'), - writeln('(r) retry - Retry the previous command.'), - writeln('(I) info - Show information about the current state.'), + %writeln('(C) compile - Compile a fresh executable (based on the running state).'), + %writeln('(E) error msg - Show the latest error messages.'), + %writeln('(r) retry - Retry the previous command.'), + %writeln('(I) info - Show information about the current state.'), !. From 0f67497971b3aa8c29e92bb624a1a12f464067de Mon Sep 17 00:00:00 2001 From: logicmoo Date: Tue, 17 Dec 2024 21:07:42 -0800 Subject: [PATCH 02/42] properly parse numeric options --- prolog/metta_lang/swi_support.pl | 1 + 1 file changed, 1 insertion(+) diff --git a/prolog/metta_lang/swi_support.pl b/prolog/metta_lang/swi_support.pl index ba11db40559..6cdcfdf3c6d 100755 --- a/prolog/metta_lang/swi_support.pl +++ b/prolog/metta_lang/swi_support.pl @@ -343,6 +343,7 @@ \+ atom(NA), !. p2mE(false, 'False'). % Convert false to 'False'. p2mE(true, 'True'). % Convert true to 'True'. +p2mE(E, N):- atom(E), atom_number(E, NN),!,NN=N. p2mE(E, E). % Leave other values unchanged. %! set_option_value(+Name, +Value) is det. From 2ce94f303f78300f995d952530ecda336ee876d5 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Tue, 17 Dec 2024 21:08:24 -0800 Subject: [PATCH 03/42] == should be an eval_20 --- prolog/metta_lang/metta_eval.pl | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/prolog/metta_lang/metta_eval.pl b/prolog/metta_lang/metta_eval.pl index 1682ba0859f..de8842695f3 100755 --- a/prolog/metta_lang/metta_eval.pl +++ b/prolog/metta_lang/metta_eval.pl @@ -2226,11 +2226,11 @@ ((((eval_selfless(Eq,RetType,Depth,Self,LESS,Res),fake_notrace(LESS\==Res))))),!. eval_40(Eq,RetType,Depth,Self,['+',N1,N2],N):- number(N1),!, - eval_args(Eq,RetType,Depth,Self,N2,N2Res), fake_notrace(catch_err(N is N1+N2Res,_E,(set_last_error(['Error',N2Res,'Number']),fail))). + skip_eval_args(Eq,RetType,Depth,Self,N2,N2Res), fake_notrace(catch_err(N is N1+N2Res,_E,(set_last_error(['Error',N2Res,'Number']),fail))). eval_40(Eq,RetType,Depth,Self,['-',N1,N2],N):- number(N1),!, - eval_args(Eq,RetType,Depth,Self,N2,N2Res), fake_notrace(catch_err(N is N1-N2Res,_E,(set_last_error(['Error',N2Res,'Number']),fail))). + skip_eval_args(Eq,RetType,Depth,Self,N2,N2Res), fake_notrace(catch_err(N is N1-N2Res,_E,(set_last_error(['Error',N2Res,'Number']),fail))). eval_40(Eq,RetType,Depth,Self,['*',N1,N2],N):- number(N1),!, - eval_args(Eq,RetType,Depth,Self,N2,N2Res), fake_notrace(catch_err(N is N1*N2Res,_E,(set_last_error(['Error',N2Res,'Number']),fail))). + skip_eval_args(Eq,RetType,Depth,Self,N2,N2Res), fake_notrace(catch_err(N is N1*N2Res,_E,(set_last_error(['Error',N2Res,'Number']),fail))). eval_20(_Eq,_RetType,_Depth,_Self,['rust',Bang,PredDecl],Res):- Bang == '!', !, rust_metta_run(exec(PredDecl),Res), nop(write_src(res(Res))). @@ -2240,6 +2240,9 @@ rust_metta_run((PredDecl),Res), nop(write_src(res(Res))). +%skip_eval_args(Eq,RetType,Depth,Self,LESS,Res):- eval_args(Eq,RetType,Depth,Self,LESS,Res). +skip_eval_args(_Eq,_RetType,_Depth,_Self,LESS,Res):- LESS=Res. + %eval_20(_Eq,_RetType,_Depth,_Self,['py-list',Arg],Res):- !, must_det_ll((py_list(Arg,Res))). eval_20(_Eq,_RetType,_Depth,_Self,['py-dict',Arg],Res):- !, must_det_ll((py_dict(Arg,Res))). eval_20(_Eq,_RetType,_Depth,_Self,['py-tuple',Arg],Res):- !, @@ -2267,11 +2270,11 @@ */ %eval_40(Eq,RetType,_Dpth,_Slf,['==',X,Y],Res):- !, subst_args(Eq,RetType,_Dpth,_Slf,['==',X,Y],Res). -eval_40(Eq,RetType,Depth,Self,[EQ, X,Y],Res):- EQ=='==', using_all_spaces, !, +eval_20(Eq,RetType,Depth,Self,[EQ, X,Y],Res):- EQ=='==', using_all_spaces, !, suggest_type(RetType,'Bool'), as_tf(eval_until_unify(Eq,_SharedType,Depth,Self,X,Y),Res). -eval_40(Eq,RetType,_Depth,_Self,[EQ,X,Y],TF):- EQ=='==', !, +eval_20(Eq,RetType,_Depth,_Self,[EQ,X,Y],TF):- EQ=='==', !, suggest_type(RetType,'Bool'), !, as_tf(eval_until_unify(Eq,_SharedType, X, Y), TF). %eq_unify(Eq,_SharedType,Depth,Self, X, Y, Res). From 90d36660182ccf80fc746e8a7e3bb5000ad64914 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Tue, 17 Dec 2024 23:22:36 -0800 Subject: [PATCH 04/42] ./scripts/run_commit_tests.sh -t --show-all --- scripts/ci_workflow.sh | 2 +- scripts/run_commit_tests.sh | 15 ++++++++++----- 2 files changed, 11 insertions(+), 6 deletions(-) diff --git a/scripts/ci_workflow.sh b/scripts/ci_workflow.sh index 68240c8aab5..fcff2acea3e 100755 --- a/scripts/ci_workflow.sh +++ b/scripts/ci_workflow.sh @@ -204,7 +204,7 @@ run_tests() { if [ "$JOB_TYPE" == "nightly" ]; then ./scripts/run_nightly_tests.sh -t "$TIMESTAMP" else - ./scripts/run_commit_tests.sh -t "$TIMESTAMP" + ./scripts/run_commit_tests.sh -t "$TIMESTAMP" --show-all fi } diff --git a/scripts/run_commit_tests.sh b/scripts/run_commit_tests.sh index 157e76db889..ae5e2c217b8 100755 --- a/scripts/run_commit_tests.sh +++ b/scripts/run_commit_tests.sh @@ -130,14 +130,19 @@ run_mettalog_tests() { # Execute command based on output mode if [ "$SHOW_ALL_OUTPUT" = true ]; then - # Execute the command and show all output - ${cmd[@]} - status=$? + # Execute the command silently and filter output + # The grep pattern matches important test output while filtering noise + script -q -c "${cmd[*]}" /dev/null | \ + tee >( + grep -v 'HIDDEN_PASSWORDS' >&2 + ) + status=$? + else # Execute the command silently and filter output # The grep pattern matches important test output while filtering noise script -q -c "${cmd[*]}" /dev/null | \ - tee >(grep -Ei --line-buffered '_CMD:|h3 id|loonit_|^| |warning|es[:] ' >&2) > /dev/null + tee >(grep -Ei --line-buffered '_CMD:|h3 id|loonit_|warning|es[:] ' >&2) > /dev/null status=$? fi @@ -159,7 +164,7 @@ cat /dev/null > /tmp/SHARED.UNITS # 23+ tests (~30 seconds) run_mettalog_tests 40 tests/baseline_compat/module-system/ -#SHOW_ALL_OUTPUT=true # Set to false normally, true for debugging +#SHOW_ALL_OUTPUT=true # Set to false normally, true for debugging # 200+ tests (~4 minutes) run_mettalog_tests 40 tests/baseline_compat/hyperon-experimental_scripts/ From 335e5a402e7d826b573b4200af2dd9e616542074 Mon Sep 17 00:00:00 2001 From: Mike Archbold Date: Tue, 17 Dec 2024 23:27:29 -0800 Subject: [PATCH 05/42] save progress to date --- examples/games/GreedyChess.metta | 995 +++++++++++++++++-------------- 1 file changed, 541 insertions(+), 454 deletions(-) diff --git a/examples/games/GreedyChess.metta b/examples/games/GreedyChess.metta index 7454fd426c9..1bb89a8cbd2 100644 --- a/examples/games/GreedyChess.metta +++ b/examples/games/GreedyChess.metta @@ -1,13 +1,13 @@ -; WORK IN PROGRESS +; WORK IN PROGRESS, DOES NOT RUN ; #(convert_to_metta_file dbd $10000 dbd.pl dbd.metta) -(= (piece) k) -(= (piece) q) -(= (piece) r) -(= (piece) b) -(= (piece) n) -(= (piece) p) +(piece k) +(piece q) +(piece r) +(piece b) +(piece n) +(piece p) (hpiece k) (hpiece q) @@ -32,452 +32,539 @@ (cord 7) (cord 8) +; Type definitions +(: console-messages (-> Expression Atom)) ; The state is an expression type, stored as an atom. +(: board-state (-> Expression Atom)) ; The state is an expression type, stored as an atom. -(= (chess) - (dynamic (/ guimessage 4)) (or (abolish board 1) True) (or (abolish guimessage 1) True) (or (abolish guimessage 2) True) (or (abolish guimessage 3) True) (or (abolish guimessage 4) True) #(add-atom &self #(guimessage chess game started)) #(add-atom &self #(board ((1 1 s r) (1 2 s p) (1 3) (1 4) (1 5) (1 6) (1 7 g p) (1 8 g r) (2 1 s n) (2 2 s p) (2 3) (2 4) (2 5) (2 6) (2 7 g p) (2 8 g n) (3 1 s b) (3 2 s p) (3 3) (3 4) (3 5) (3 6) (3 7 g p) (3 8 g b) (4 1 s q) (4 2 s p) (4 3) (4 4) (4 5) (4 6) (4 7 g p) (4 8 g q) (5 1 s k) (5 2 s p) (5 3) (5 4) (5 5) (5 6) (5 7 g p) (5 8 g k) (6 1 s b) (6 2 s p) (6 3) (6 4) (6 5) (6 6) (6 7 g p) (6 8 g b) (7 1 s n) (7 2 s p) (7 3) (7 4) (7 5) (7 6) (7 7 g p) (7 8 g n) (8 1 s r) (8 2 s p) (8 3) (8 4) (8 5) (8 6) (8 7 g p) (8 8 g r)))) (set_prolog_flag toplevel_print_options #( :: ((quoted True) (portray True)) )) (welcome) (set-det)) - - -(= (welcome) (write 'Deep Blue Dummy Chess -- Copyright 2001 Mike Archbold') (nl) (write 'This program is intended as a Prolog exercise') (nl) (nl) (board $A) (b $A) (write '******* I N S T R U C T I O N S ********') (nl) (write '- Your pieces are marked with an asterisk') (nl) (write '- Please take note of the following simple commands:') (nl) (nl) (write '-------- C o m m a n d s -----------') (nl) (write '1) TO MOVE YOUR PIECE USE (example) -> ?- m(1,2,1,3).') (nl) (write ' Result: YOUR pawn in 1,2 moved to location 1,3. Standard x/y.') (nl) (write '2) TO MOVE DEEP BLUE DUMMY type -> ?- g.') (nl) (write '3) To reset, type -> ?- r.') (nl) (write '4) Display commands, type -> ?- c.') (nl) (write '5) Display current board type -> ?- d.') (nl) (write 'ALL COMMANDS MUST BE TERMINATED WITH A PERIOD AND NO SPACES.') (nl) (write 'You may now enter your move (m) command') (nl)) - - -(= (r) - (chess)) - - -(= (c) (write '-------- C o m m a n d s -----------') (nl) (write '1) TO MOVE YOUR PIECE USE (example) -> ?- m(1,2,1,3).') (nl) (write ' Result: YOUR piece in 1,2 moved to location 1,3. Standard x/y.') (nl) (write '2) TO MOVE DEEP BLUE DUMMY type -> ?- g.') (nl) (write '3) To reset, type -> ?- r.') (nl) (write '4) Display commands, type -> ?- c.') (nl) (write '5) Display current board type -> ?- d.') (nl) (write 'ALL COMMANDS MUST BE TERMINATED WITH A PERIOD!') (nl)) - - -(= (m $A $B $C $D) (guimessage checkmate $E $F) (write 'Game over.') (nl) (set-det)) -(= (m $A $B $C $D) (board $E) (concat_lists #( :: (#( :: ($A) ) #( :: ($B) )) ) $F) (concat_lists #( :: (#( :: ($C) ) #( :: ($D) )) ) $G) (\= $F $G) (return_entire_box $F $H $E) (return_entire_box $G $I $E) (or (len $I 2) (not (samecolor $H $I))) (set-det) (clear_route $H $I $E) (move_piece $H $I $E $J) (xy_box $K #( :: (s k) ) $J) (not (take_dest $K g $J)) (move_piece $H $I $E $L) (= $M $E) #(remove-atom &self #(board $E)) #(add-atom &self #(board $L)) (b $L) (printmove $H $I $M) (set-det) (examine_king $L g s) (garbage_collect) (trim_stacks) (set-det)) - - -(= (d) (board $A) (b $A) (set-det)) - - -(= (b $A) (write 1 2 3 4 5 6 7 8) (nl) (write -------------------------) (nl) (write_box 1 8 $A)) - - -(= (write_box $A 0 $B) (nl) (write -------------------------) (nl) (write 1 2 3 4 5 6 7 8) (nl) (nl) (nl) (nl)) -(= (write_box $A $B $C) (= $A 1) (return_entire_box #( :: ($A $B) ) $D $C) (len $D 2) (write $B) (write | ) (is $E (+ $A 1)) (write_box $E $B $C)) -(= (write_box $A $B $C) (< $A 8) (return_entire_box #( :: ($A $B) ) $D $C) (len $D 2) (write | ) (is $E (+ $A 1)) (write_box $E $B $C)) -(= (write_box $A $B $C) (= $A 8) (return_entire_box #( :: ($A $B) ) $D $C) (len $D 2) (write |) (write | ) (write $B) (is $E (- $B 1)) (or (, (> $B 1) (nl) (write -------------------------) (nl)) True) (write_box 1 $E $C)) -(= (write_box $A $B $C) (< $A 8) (return_entire_box #( :: ($A $B) ) $D $C) (len $D 4) (nth1 3 $D g) (nth1 4 $D $E) (or (, (= $A 1) (write $B) (write |)) (write |)) (write ' ') (write $E) (is $F (+ $A 1)) (write_box $F $B $C)) -(= (write_box $A $B $C) (< $A 8) (return_entire_box #( :: ($A $B) ) $D $C) (len $D 4) (nth1 3 $D s) (nth1 4 $D $E) (or (, (= $A 1) (write $B) (write |)) (write |)) (write *) (write $E) (is $F (+ $A 1)) (write_box $F $B $C)) -(= (write_box $A $B $C) (= $A 8) (return_entire_box #( :: ($A $B) ) $D $C) (len $D 4) (nth1 3 $D g) (nth1 4 $D $E) (write |) (write ' ') (write $E) (write | ) (write $B) (is $F (- $B 1)) (= $G 1) (or (, (> $F 0) (nl) (write -------------------------) (nl)) True) (write_box $G $F $C)) -(= (write_box $A $B $C) (= $A 8) (return_entire_box #( :: ($A $B) ) $D $C) (len $D 4) (nth1 3 $D s) (nth1 4 $D $E) (write |) (write *) (write $E) (write | ) (write $B) (is $F (- $B 1)) (= $G 1) (or (, (> $F 0) (nl) (write -------------------------) (nl)) True) (write_box $G $F $C)) - - -(= (g) (guimessage checkmate $A $B) (write 'Game over.') (nl) (set-det)) -(= (g) (board $A) (attemptcheckmate $B $A $C $D) #(remove-atom &self #(board $A)) #(add-atom &self #(board $B)) (b $B) (write 'Checkmate! Deep Blue Dummy Wins!') (nl) #(add-atom &self #(guimessage checkmate s g)) (printmove $C $D $A) (set-det)) -(= (g) (board $A) (playdefenseR $B $A $C $D) #(remove-atom &self #(board $A)) #(add-atom &self #(board $B)) (b $B) (examine_king $B s g) (printmove $C $D $A) (set-det)) -(= (g) (board $A) (takehighestopen $B $A $C $D) #(remove-atom &self #(board $A)) #(add-atom &self #(board $B)) (b $B) (examine_king $B s g) (printmove $C $D $A) (set-det)) -(= (g) (board $A) (movetoposition $B $A $C $D) #(remove-atom &self #(board $A)) #(add-atom &self #(board $B)) (b $B) (examine_king $B s g) (printmove $C $D $A) (set-det)) -(= (g) (board $A) (takehighestopenpawn $B $A $C $D) #(remove-atom &self #(board $A)) #(add-atom &self #(board $B)) (b $B) (examine_king $B s g) (printmove $C $D $A) (set-det)) -(= (g) (board $A) (random_move_empty_sq $B $A $C $D) #(remove-atom &self #(board $A)) #(add-atom &self #(board $B)) (b $B) (printmove $C $D $A) (set-det)) - - -(= (kingnotincheck $A) (xy_box $B #( :: (g k) ) $A) (not (take_dest $B s $A))) - - -(= (attemptcheckmate $A $B $C $D) (xy_box $E #( :: (s k) ) $B) (buildgold $B $F) (set-det) (rpiece $G) (cord $H) (cord $I) (member #( :: ($H $I g $G) ) $F) (= $C - #( :: - ($H $I g $G) )) (positiontotake $E $C $D $B) (move_piece $C $D $B $A) (nth1 1 $D $J) (nth1 2 $D $K) (return_entire_box #( :: ($J $K) ) $L $A) (threatOK1 $A s g #( :: ($L) )) (threatOK2 $A s g) (threatOK3 $A s g) (kingnotincheck $A)) - - -(= (playdefenseR $A $B $C $D) (returnrandominteger $E 3) (set-det) (or (== $E 1) (== $E 2)) (playdefense $A $B $C $D)) -; /* /* newer code start */ /* see if anybody can check the silver king first... if possible do next rule (long) */ attemptcheckmate(Newboard,Listofboxes,Goldbox,Destbox) :- /* find silver king */ xy_box(Kingbox,[s,k],Listofboxes), /* return list of all gold pieces */ buildgold(Listofboxes,Currentgoldpieces), /* no gold can align to check king, sequential check. */ rpiece(Piece), cord(X), cord(Y), member([X,Y,g,Piece],Currentgoldpieces), positiontotake(Kingbox,[X,Y,g,Piece],Destbox,Listofboxes), !, /* don't try the exhaustive search if it doesn't seem likely to work... */ deepattemptcheckmate(Newboard,Listofboxes,Goldbox,Destbox). /* move from -Goldbox to -Destbox for checkmate, return -Newboard */ deepattemptcheckmate(Newboard,Listofboxes,Goldbox,Destbox) :- /* find silver king */ xy_box(Kingbox,[s,k],Listofboxes), /* return list of all gold pieces */ buildgold(Listofboxes,Currentgoldpieces), !, /* find *** -Goldbox AND -Destbox *** which can check Kingbox */ findgoldcheck(Currentgoldpieces,Listofboxes,Newboard,Goldbox,Destbox,Kingbox). findgoldcheck([],_,_,_,_,_) :- !, fail. findgoldcheck([Goldbox|_],Listofboxes,Newboard,Goldbox,Destbox,Kingbox) :- /* see if Goldbox can be moved into position to take Kingbox */ positiontotake(Kingbox,Goldbox,Destbox,Listofboxes), move_piece(Goldbox,Destbox,Listofboxes,Newboard), nth1(1,Destbox,X), nth1(2,Destbox,Y), return_entire_box([X,Y],EntireBox,Newboard), threatOK1(Newboard,s,g,[EntireBox]), /*can your piece be taken? */ threatOK2(Newboard,s,g), /* can king move out of the way ?? */ threatOK3(Newboard,s,g). /* can a piece block threat? */ findgoldcheck([_|Currentgoldpieces],Listofboxes,Newboard,Goldbox,Destbox,Kingbox) :- findgoldcheck(Currentgoldpieces,Listofboxes,Newboard,Goldbox,Destbox,Kingbox). /* newer code end */ */ - - -(= (playdefense $A $B $C $D) (buildgold $B $E) (checkgold $E $B Nil) (set-det) (fail)) -(= (playdefense $A $B $C $D) (buildgold $B $E) (checkgold $E $B $F) (piece $G) (member #( :: ($H $I g $G) ) $F) (= $J - #( :: - ($H $I g $G) )) (hpiece $K) (xy_box $L #( :: (s $K) ) $B) (return_entire_box $L $D $B) (clear_route $D $J $B) (findgoldhigh $E $B $C $L) (move_piece $C $D $B $A) (or (not (take_dest $L s $A)) (or (nth1 4 $C p) (guimessage check g s))) (kingnotincheck $A)) -(= (playdefense $A $B $C $D) (buildgold $B $E) (checkgold $E $B $F) (piece $G) (member #( :: ($H $I g $G) ) $F) (= $C - #( :: - ($H $I g $G) )) (hpiece $J) (xy_box $K #( :: (s $J) ) $B) (positiontotake $K $C $D $B) (move_piece $C $D $B $A) (not (take_dest $D s $A)) (kingnotincheck $A)) -(= (playdefense $A $B $C $D) (buildgold $B $E) (checkgold $E $B $F) (lookforempty $B $G) (set-det) (piece $H) (member #( :: ($I $J g $H) ) $F) (= $C - #( :: - ($I $J g $H) )) (member #( :: ($K $L) ) $G) (= $D - #( :: - ($K $L) )) (clear_route $C $D $B) (move_piece $C $D $B $A) (not (take_dest $D s $A)) (kingnotincheck $A)) - - -(= (movetoposition $A $B $C $D) (returnrandominteger $E 2) (set-det) (== $E 1) (buildgold $B $F) (checkeachgold $F $A $B $C $D)) -(= (movetoposition $Newboard $Listofboxes $Goldbox $Destbox) (buildgold $Listofboxes $Currentgoldpieces) (checkeachgold $Currentgoldpieces $Newboard $Listofboxes $Goldbox $Destbox)) - - -(= (checkeachgold Nil $A $B $C $D) (set-det) (fail)) -(= (checkeachgold #(Cons $A $B) $C $D $A $E) (piece $F) (xy_box $G #( :: (s $F) ) $D) (positiontotake $G $A $E $D) (move_piece $A $E $D $C) (not (take_dest $E s $C)) (kingnotincheck $C)) -(= (checkeachgold #(Cons $A $B) $C $D $E $F) - (checkeachgold $B $C $D $E $F)) - - -(= (random_move_empty_sq $A $B $C $D) - (or - (, - (buildgold $B $E) - (checkgold $E $B $F) - (lookforempty $B $G) - (buildrandomgold $B $H) - (sort $H $I) - (findgoldmove $I $G $B $C $D) - (move_piece $C $D $B $A) - (kingnotincheck $A) - (not (take_dest $D s $A)) - (buildgold $A $J) - (checkgold $J $A $K) - (length $F $L) - (delete $K - #( :: - ($M $N g p) ) $O) - (length $O $P) - (=< $P $L)) - (guimessage check g s))) - - -(= (takehighestopen $A $B $C $D) (buildgold $B $E) (checkgold $E $B $F) (set-det) (piece $G) (xy_box $H #( :: (s $G) ) $B) (findgoldhigh $E $B $C $H) (return_entire_box $H $D $B) (move_piece $C $D $B $A) (not (take_dest $H s $A)) (kingnotincheck $A)) - - -(= (takehighestopenpawn $A $B $C $D) (returnrandominteger $E 3) (set-det) (or (== $E 1) (== $E 2)) (buildgold $B $F) (checkgold $F $B $G) (set-det) (piece $H) (\= $H p) (xy_box $I #( :: (s $H) ) $B) (findgoldhigh $F $B #( :: ($J $K g p) ) $I) (= $C - #( :: - ($J $K g p) )) (return_entire_box $I $D $B) (move_piece $C $D $B $A) (kingnotincheck $A)) - - -(= (checkgold Nil $A Nil) - (set-det)) -; /* takehighestopenpawn(A, B, C, D) :- write('?????'). */ -(= (checkgold #(Cons $A $B) $C #(Cons $A $D)) (take_dest $A s $C) (checkgold $B $C $D) (set-det)) -(= (checkgold #(Cons $A $B) $C $D) (not (take_dest $A s $C)) (checkgold $B $C $D) (set-det)) - - -#( = #(lookforempty () ()) True ) -(= (lookforempty #(Cons $A $B) #(Cons $A $C)) (len $A 2) (lookforempty $B $C)) -(= (lookforempty #(Cons $A $B) $C) - (lookforempty $B $C)) - - -#( = #(buildrandomgold () ()) True ) -(= (buildrandomgold #(Cons $A $B) #(Cons $C $D)) (len $A 4) (nth1 3 $A g) (returnrandominteger $E 99) (is $F $E) (concat_lists #( :: (#( :: ($F) ) #( :: ($A) )) ) $C) (buildrandomgold $B $D)) -(= (buildrandomgold #(Cons $A $B) $C) - (buildrandomgold $B $C)) - - -(= (buildgold Nil Nil) - (set-det)) -(= (buildgold #(Cons $A $B) #(Cons $A $C)) (len $A 4) (nth1 3 $A g) (buildgold $B $C) (set-det)) -(= (buildgold #(Cons $A $B) $C) (buildgold $B $C) (set-det)) - - -(= (findgoldmove #(Cons $A $B) $C $D $E $F) (= #( :: ($G $E) ) $A) (returnrandominteger $H 8) (is $I $H) (returnrandominteger $J 8) (is $K $J) (set-det) (findgolddest $E $D $C $F $I $K)) - - -(= (findgolddest $A $B $C $D $E $F) (= $D - #( :: - ($E $F) )) (member $D $C) (clear_route $A $D $B)) - - -#( = #(findgoldhigh () $A $B $C) (empty) ) -(= (findgoldhigh #(Cons $A $B) $C $A $D) - (clear_route $A $D $C)) -(= (findgoldhigh #(Cons $A $B) $C $D $E) - (findgoldhigh $B $C $D $E)) - - -(= (take_dest $A $B $C) (takingboxes $B $C $D) (set-det) (list_clear_route $C $A $D $E) (set-det) (\== $E Nil)) - - -(= (return_entire_box $A $B #(Cons $C $D)) (nth1 1 $C $E) (nth1 2 $C $F) (concat_lists #( :: (#( :: ($E) ) #( :: ($F) )) ) $G) (== $G $A) (= $B $C) (set-det)) -(= (return_entire_box $A $B #(Cons $C $D)) (return_entire_box $A $B $D) (set-det)) - - -(= (xy_box $A #( :: ($B $C) ) #(Cons $D $E)) (len $D 4) (nth1 3 $D $F) (nth1 4 $D $G) (== $B $F) (== $C $G) (nth1 1 $D $H) (nth1 2 $D $I) (concat_lists #( :: (#( :: ($H) ) #( :: ($I) )) ) $A)) -(= (xy_box $A $B #(Cons $C $D)) - (xy_box $A $B $D)) - - -(= (samecolor $A $B) (nth1 3 $A $C) (nth1 3 $B $D) (set-det) (== $C $D)) - - -(= (clear_route #( :: ($A $B $C k) ) #(Cons $D #(Cons $E $F)) $G) (or (= $D $A) (or (is $D (+ $A 1)) (is $D (- $A 1)))) (or (= $E $B) (or (is $E (+ $B 1)) (is $E (- $B 1))))) -(= (clear_route #( :: ($A $B $C n) ) #(Cons $D #(Cons $E $F)) $G) (or (is $E (+ $B 2)) (is $E (- $B 2))) (or (is $D (+ $A 1)) (is $D (- $A 1)))) -(= (clear_route #( :: ($A $B $C n) ) #(Cons $D #(Cons $E $F)) $G) (or (is $E (+ $B 1)) (is $E (- $B 1))) (or (is $D (+ $A 2)) (is $D (- $A 2)))) -(= (clear_route #( :: ($A $B $C q) ) #(Cons $D #(Cons $E $F)) $G) - (clear_route - #( :: - ($A $B $C r) ) - #(Cons $D - #(Cons $E $F)) $G)) -(= (clear_route #( :: ($A $B $C q) ) #(Cons $D #(Cons $E $F)) $G) - (clear_route - #( :: - ($A $B $C b) ) - #(Cons $D - #(Cons $E $F)) $G)) -(= (clear_route #( :: ($A $B g p) ) #(Cons $C #(Cons $D $E)) $F) (= $A $C) (= $B 2) (is $G (- $B 1)) (return_entire_box #( :: ($A $G) ) $H $F) (len $H 2) (is $D (- $B 2)) (return_entire_box #( :: ($C $D) ) $I $F) (len $I 2)) -(= (clear_route #( :: ($A $B g p) ) #(Cons $C #(Cons $D $E)) $F) (= $A $C) (is $D (- $B 1)) (return_entire_box #( :: ($C $D) ) $G $F) (len $G 2)) -(= (clear_route #( :: ($A $B g p) ) #(Cons $C #(Cons $D $E)) $F) (return_entire_box #( :: ($C $D) ) $G $F) (len $G 4) (is $C (+ $A 1)) (is $D (- $B 1))) -(= (clear_route #( :: ($A $B g p) ) #(Cons $C #(Cons $D $E)) $F) (return_entire_box #( :: ($C $D) ) $G $F) (len $G 4) (is $C (- $A 1)) (is $D (- $B 1))) -(= (clear_route #( :: ($A $B s p) ) #(Cons $C #(Cons $D $E)) $F) (= $A $C) (is $D (+ $B 1)) (return_entire_box #( :: ($C $D) ) $G $F) (len $G 2)) -(= (clear_route #( :: ($A $B s p) ) #(Cons $C #(Cons $D $E)) $F) (= $A $C) (= $B 2) (is $G (+ $B 1)) (return_entire_box #( :: ($A $G) ) $H $F) (len $H 2) (is $D (+ $B 2)) (return_entire_box #( :: ($C $D) ) $I $F) (len $I 2)) -(= (clear_route #( :: ($A $B s p) ) #(Cons $C #(Cons $D $E)) $F) (return_entire_box #( :: ($C $D) ) $G $F) (len $G 4) (is $C (+ $A 1)) (is $D (+ $B 1))) -(= (clear_route #( :: ($A $B s p) ) #(Cons $C #(Cons $D $E)) $F) (return_entire_box #( :: ($C $D) ) $G $F) (len $G 4) (is $C (- $A 1)) (is $D (+ $B 1))) -(= (clear_route #( :: ($A $B $C r) ) #(Cons $D #(Cons $E $F)) $G) (= $A $D) (> $E $B) (is $H (- $E 1)) (is $I (+ $B 1)) (checkclearup $A $I $H $G)) -(= (clear_route #( :: ($A $B $C r) ) #(Cons $D #(Cons $E $F)) $G) (= $A $D) (< $E $B) (is $H (+ $E 1)) (is $I (- $B 1)) (checkcleardown $A $I $H $G)) -(= (clear_route #( :: ($A $B $C r) ) #(Cons $D #(Cons $E $F)) $G) (< $A $D) (= $E $B) (is $H (- $D 1)) (is $I (+ $A 1)) (checkclearright $B $I $H $G)) -(= (clear_route #( :: ($A $B $C r) ) #(Cons $D #(Cons $E $F)) $G) (> $A $D) (= $E $B) (is $H (+ $D 1)) (is $I (- $A 1)) (checkclearleft $B $I $H $G)) -(= (clear_route #( :: ($A $B $C b) ) #(Cons $D #(Cons $E $F)) $G) - (or - (, - (is $D - (+ $A 1)) - (is $E - (+ $B 1))) - (, - (> $D $A) - (> $E $B) - (is $H - (+ $A 1)) - (is $I - (- $D 1)) - (is $J - (+ $B 1)) - (is $K - (- $E 1)) - (checkclearupBUR $H $J $I $K $G)))) -(= (clear_route #( :: ($A $B $C b) ) #(Cons $D #(Cons $E $F)) $G) - (or - (, - (is $D - (+ $A 1)) - (is $E - (- $B 1))) - (, - (> $D $A) - (< $E $B) - (is $H - (+ $A 1)) - (is $I - (- $D 1)) - (is $J - (- $B 1)) - (is $K - (+ $E 1)) - (checkclearupBDR $H $J $I $K $G)))) -(= (clear_route #( :: ($A $B $C b) ) #(Cons $D #(Cons $E $F)) $G) - (or - (, - (is $D - (- $A 1)) - (is $E - (+ $B 1))) - (, - (< $D $A) - (> $E $B) - (is $H - (- $A 1)) - (is $I - (+ $D 1)) - (is $J - (+ $B 1)) - (is $K - (- $E 1)) - (checkclearupBUL $H $J $I $K $G)))) -(= (clear_route #( :: ($A $B $C b) ) #(Cons $D #(Cons $E $F)) $G) - (or - (, - (is $D - (- $A 1)) - (is $E - (- $B 1))) - (, - (< $D $A) - (< $E $B) - (is $H - (- $A 1)) - (is $I - (+ $D 1)) - (is $J - (- $B 1)) - (is $K - (+ $E 1)) - (checkclearupBDL $H $J $I $K $G)))) - - -(= (checkclearup $A $B $C $D) - (> $B $C)) -(= (checkclearup $A $B $C $D) (return_entire_box #( :: ($A $B) ) $E $D) (len $E 2) (is $F (+ $B 1)) (checkclearup $A $F $C $D)) - -(= (checkclearleft $A $B $C $D) - (< $B $C)) -(= (checkclearleft $A $B $C $D) (return_entire_box #( :: ($B $A) ) $E $D) (len $E 2) (is $F (- $B 1)) (checkclearleft $A $F $C $D)) - -(= (checkclearright $A $B $C $D) - (> $B $C)) -(= (checkclearright $A $B $C $D) (return_entire_box #( :: ($B $A) ) $E $D) (len $E 2) (is $F (+ $B 1)) (checkclearright $A $F $C $D)) - -(= (checkcleardown $A $B $C $D) - (< $B $C)) -(= (checkcleardown $A $B $C $D) (return_entire_box #( :: ($A $B) ) $E $D) (len $E 2) (is $F (- $B 1)) (checkcleardown $A $F $C $D)) - - -(= (checkclearupBUR $A $B $C $D $E) (== $A $C) (== $B $D) (return_entire_box #( :: ($A $B) ) $F $E) (len $F 2)) -(= (checkclearupBUR $A $B $C $D $E) (return_entire_box #( :: ($A $B) ) $F $E) (len $F 2) (is $G (+ $A 1)) (is $H (+ $B 1)) (checkclearupBUR $G $H $C $D $E)) - -(= (checkclearupBDR $A $B $C $D $E) (== $A $C) (== $B $D) (return_entire_box #( :: ($A $B) ) $F $E) (len $F 2)) -(= (checkclearupBDR $A $B $C $D $E) (return_entire_box #( :: ($A $B) ) $F $E) (len $F 2) (is $G (+ $A 1)) (is $H (- $B 1)) (checkclearupBDR $G $H $C $D $E)) - -(= (checkclearupBUL $A $B $C $D $E) (== $A $C) (== $B $D) (return_entire_box #( :: ($A $B) ) $F $E) (len $F 2)) -(= (checkclearupBUL $A $B $C $D $E) (return_entire_box #( :: ($A $B) ) $F $E) (len $F 2) (is $G (- $A 1)) (is $H (+ $B 1)) (checkclearupBUL $G $H $C $D $E)) - -(= (checkclearupBDL $A $B $C $D $E) (== $A $C) (== $B $D) (return_entire_box #( :: ($A $B) ) $F $E) (len $F 2)) -(= (checkclearupBDL $A $B $C $D $E) (return_entire_box #( :: ($A $B) ) $F $E) (len $F 2) (is $G (- $A 1)) (is $H (- $B 1)) (checkclearupBDL $G $H $C $D $E)) - - -(= (move_piece $A $B $C $D) (nth1 3 $A $E) (nth1 4 $A $F) (sort $C $G) (sort #( :: ($A $B) ) $H) (removelists $H $G $I) (nth1 1 $A $J) (nth1 2 $A $K) (= $L - #( :: - ($J $K) )) (nth1 1 $B $M) (nth1 2 $B $N) (= $O - #( :: - ($M $N $E $F) )) (sort #(Cons $L #(Cons $O $I)) $D) (set-det)) - - -(= (printmove $A $B $C) (nth1 1 $A $D) (nth1 2 $A $E) (nth1 3 $A $F) (nth1 4 $A $G) (nth1 1 $B $H) (nth1 2 $B $I) (or (, (len $B 4) (return_entire_box #( :: ($H $I) ) $J $C) (nth1 4 $J $K)) (= $K nil)) (or (, (== $F g) (write 'DBD moves from:') (write $D) (write and2) (write $E) (write ' to: ') (write $H) (write and2) (write $I)) (, (== $F s) (write 'YOU move from:') (write $D) (write and2) (write $E) (write ' to: ') (write $H) (write and2) (write $I))) #(add-atom &self #(guimessage move $A $B $K)) (or (, (\= $K nil) (nl) (write 'Piece captured!! -> ') (write $K) (nl)) nl) (write 'Type c. for commands you can use.')) - - -(= (examine_king $A $B $C) (cantakepiece $A $B k $C $D) (\= $D Nil) (threatOK1 $A $B $C $D) (threatOK2 $A $B $C) (threatOK3 $A $B $C) (write Checkmate!) (nl) #(add-atom &self #(guimessage checkmate $B $C))) -(= (examine_king $A $B $C) (cantakepiece $A $B k $C $D) (\= $D Nil) (write Check!) (nl) #(add-atom &self #(guimessage check $B $C))) -#( = #(examine_king $A $B $C) True ) - - -(= (threatOK1 $A $B $C $D) (seekopponents $A $B $D $E) (== $E Nil) (set-det)) -(= (threatOK1 $A $B $C $D) (seekopponents $A $B $D $E) (checkthreat $E $A) (set-det)) - - -(= (checkthreat Nil $A) - (set-det)) -(= (checkthreat #(Cons $A $B) $C) (checkeachthreat $A $C) (set-det) (checkthreat $B $C) (set-det)) - - -#( = #(checkeachthreat () $A) True ) -(= (checkeachthreat #(Cons $A #(Cons $B $C)) $D) (nth1 3 $A $E) (nth1 3 $B $F) (move_piece $A $B $D $G) (xy_box $H #( :: ($E k) ) $G) (set-det) (checkking $H $F $G) (checkeachthreat $C $D)) - - -(= (checkking $A $B $C) - (take_dest $A $B $C)) - - -(= (threatOK2 $A $B $C) (lookforempty $A $D) (xy_box $E #( :: ($B k) ) $A) (return_entire_box $E $F $A) (set-det) (not (king_can_move $F $C $D $A))) - - -(= (king_can_move $A $B #(Cons $C $D) $E) (clear_route $A $C $E) (move_piece $A $C $E $F) (not (take_dest $C $B $F))) -(= (king_can_move $A $B #(Cons $C $D) $E) (not (clear_route $A $C $E)) (fail)) -(= (king_can_move $A $B #(Cons $C $D) $E) (clear_route $A $C $E) (move_piece $A $C $E $F) (take_dest $C $B $F) (fail)) -(= (king_can_move $A $B #(Cons $C $D) $E) - (king_can_move $A $B $D $E)) -(= (king_can_move $A $B Nil $C) (set-det) (fail)) - - -(= (threatOK3 $A $B $C) (set-det) (not (opponentblock $A $B $C))) - - -(= (opponentblock $A $B $C) (xy_box $D #( :: ($B k) ) $A) (rpiece $E) (\== $E k) (xy_box $F #( :: ($B $E) ) $A) (return_entire_box $F $G $A) (cord $H) (cord $I) (return_entire_box #( :: ($H $I) ) $J $A) (or (not (samecolor $G $J)) (len $J 2)) (clear_route $G $J $A) (move_piece $G $J $A $K) (not (take_dest $D $C $K)) (set-det)) - - -(= (seekopponents $A $B $C $D) (buildopponent $A $B $E) (set-det) (takingpieces $E $C $A $F) (set-det) (delete $F Nil $D) (set-det)) - - -#( = #(takingpieces () $A $B ()) True ) -(= (takingpieces #(Cons $A $B) $C $D #(Cons $E $F)) (checkopponent $A $C $D $E) (set-det) (takingpieces $B $C $D $F)) -(= (takingpieces #(Cons $A $B) $C $D $E) - (takingpieces $B $C $D $E)) - - -#( = #(checkopponent $A () $B ()) True ) -(= (checkopponent $A #(Cons $B $C) $D #(Cons $A #(Cons $B $E))) (clear_route $A $B $D) (checkopponent $A $C $D $E)) -(= (checkopponent $A #(Cons $B $C) $D $E) - (checkopponent $A $C $D $E)) - - -(= (takeyourpiece #(Cons Nil $A) $B) - (takeyourpiece $A $C $B)) -(= (takeyourpiece #(Cons Nil $A) $B) - (takeyourpiece $A $C $B)) - - -#( = #(buildopponent () $A ()) True ) -(= (buildopponent #(Cons $A $B) $C #(Cons $A $D)) (len $A 4) (nth1 3 $A $C) (buildopponent $B $C $D)) -(= (buildopponent #(Cons $A $B) $C $D) - (buildopponent $B $C $D)) - - -#( = #(seekopponent () $A $B $C ()) True ) -(= (seekopponent #(Cons $A $B) $C $D $E $A) (len $A 4) (nth1 3 $A $C) (takeyourpiece $D $A $E)) -(= (seekopponent #(Cons $A $B) $C $D $E $F) - (seekopponent $B $C $D $E $F)) - - -#( = #(takeyourpiece () $A $B) (empty) ) -(= (takeyourpiece #(Cons $A $B) $C $D) - (clear_route $C $A $D)) - - -(= (cantakepiece $A $B $C $D $E) (takingboxes $D $A $F) (set-det) (xy_box $G #( :: ($B $C) ) $A) (list_clear_route $A $G $F $E)) - - -#( = #(takingboxes $A () ()) True ) -(= (takingboxes $A #(Cons $B $C) #(Cons $B $D)) (nth1 3 $B $A) (takingboxes $A $C $D)) -(= (takingboxes $A #(Cons $B $C) $D) - (takingboxes $A $C $D)) - - -#( = #(list_clear_route $A $B () ()) True ) -(= (list_clear_route $A $B #(Cons $C $D) #(Cons $C $E)) (clear_route $C $B $A) (list_clear_route $A $B $D $E)) -(= (list_clear_route $A $B #(Cons $C $D) $E) - (list_clear_route $A $B $D $E)) - - -(= (positiontotake #(Cons $A #(Cons $B $C)) $D $E $F) (cord $G) (cord $H) (return_entire_box #( :: ($G $H) ) $E $F) (or (not (samecolor $D $E)) (len $E 2)) (clear_route $D $E $F) (nth1 3 $D $I) (nth1 4 $D $J) (= $K - #( :: - ($G $H $I $J) )) (clear_route $K #( :: ($A $B) ) $F)) - - -#( = #(concat_lists () ()) True ) -; /************* USER ROUTINES ************/ -(= (concat_lists #(Cons Nil $A) $B) - (concat_lists $A $B)) -(= (concat_lists #(Cons #(Cons $A $B) $C) #(Cons $A $D)) - (concat_lists - #(Cons $B $C) $D)) - - -#( = #(nth 0 ($A -(= (nth $A #(Cons $B $C) $B) - (= $A 1)) -(= (nth $A #(Cons $B $C) $D) (is $E (- $A 1)) (nth $E $C $D)) - - -(= (nth1 $Index $_ $_) (< $Index 1) (fail) (set-det)) -; /* copied from dbd2 */ -(= (nth1 1 #(Cons $Element $Rest) $Element) - (set-det)) -(= (nth1 $I #(Cons $First $List1) $Element) (is $Index (- $I 1)) (nth1 $Index $List1 $Element)) - - -#( = #(removelists () $A $A) True ) -; /* apparently swipl used: nth1(A, B, C):-integer(A), !, D is A-1, nth0_det(D, B, C). nth1(A, B, C):-var(A), !, nth_gen(B, C, 1, A). */ -(= (removelists #(Cons $A $B) #(Cons $A $C) $D) - (removelists $B $C $D)) -(= (removelists $A #(Cons $B $C) #(Cons $B $D)) - (removelists $A $C $D)) - - -(= (len Nil 0) - (set-det)) -(= (len #( :: ($A) ) 1) (atomic $A) (set-det)) -(= (len #(Cons $A $B) $C) (atomic $A) (len $B $D) (is $C (+ $D 1))) - - -(= (returnrandominteger $A $B) - (is $A - (+ - (random $B) 1))) +; Initialization +!(add-atom &self (console-messages (initializing))) +; Create the chess board atom with decisions based on console messages which contains game state. +(= (chess) + (match &self (console-messages $msg) + ; if first invocation, just create board + (if (== (initializing) $msg) ; then + (; remove the 'initializing' message + (remove-atom &self (console-messages $msg)) + ; create the board for the first time + (add-atom &self + (board-state ((1 1 s r) (1 2 s p) (1 3) (1 4) (1 5) (1 6) (1 7 g p) (1 8 g r) (2 1 s n) (2 2 s p) (2 3) (2 4) (2 5) (2 6) (2 7 g p) (2 8 g n) (3 1 s b) (3 2 s p) (3 3) (3 4) (3 5) (3 6) (3 7 g p) (3 8 g b) (4 1 s q) (4 2 s p) (4 3) (4 4) (4 5) (4 6) (4 7 g p) (4 8 g q) (5 1 s k) (5 2 s p) (5 3) (5 4) (5 5) (5 6) (5 7 g p) (5 8 g k) (6 1 s b) (6 2 s p) (6 3) (6 4) (6 5) (6 6) (6 7 g p) (6 8 g b) (7 1 s n) (7 2 s p) (7 3) (7 4) (7 5) (7 6) (7 7 g p) (7 8 g n) (8 1 s r) (8 2 s p) (8 3) (8 4) (8 5) (8 6) (8 7 g p) (8 8 g r))) + ) + ; indicate game has passed the initializing state + (add-atom &self (console-messages (started))) + ; display welcome messages and board + (welcome) + ) + ; elif there has already been one game played + (if (== (started) $msg) ; then + (; remove the old chess board + (match &self (board-state $old_board) (remove-atom &self (board-state $old_board))) + ; re-create a new board + (add-atom &self + (board-state ((1 1 s r) (1 2 s p) (1 3) (1 4) (1 5) (1 6) (1 7 g p) (1 8 g r) (2 1 s n) (2 2 s p) (2 3) (2 4) (2 5) (2 6) (2 7 g p) (2 8 g n) (3 1 s b) (3 2 s p) (3 3) (3 4) (3 5) (3 6) (3 7 g p) (3 8 g b) (4 1 s q) (4 2 s p) (4 3) (4 4) (4 5) (4 6) (4 7 g p) (4 8 g q) (5 1 s k) (5 2 s p) (5 3) (5 4) (5 5) (5 6) (5 7 g p) (5 8 g k) (6 1 s b) (6 2 s p) (6 3) (6 4) (6 5) (6 6) (6 7 g p) (6 8 g b) (7 1 s n) (7 2 s p) (7 3) (7 4) (7 5) (7 6) (7 7 g p) (7 8 g n) (8 1 s r) (8 2 s p) (8 3) (8 4) (8 5) (8 6) (8 7 g p) (8 8 g r))) + ) + ; LATER ON, REMOVE THE OLD CONSOLE-MESSAGES! + ; + ; display welcome messages and board + (welcome) + ) + (; else if + empty))))) + +(= (welcome) + ((writeln! " ") (writeln! " ") (writeln! " ") (writeln! " ") + (writeln! 'M E T T A G R E E D Y C H E S S') + (writeln! " ") + (writeln! 'This program is intended as a MeTTa exercise.') + ; board(A), b(A), + (writeln! '******* I N S T R U C T I O N S ********') + (writeln! " ") + (writeln! '- Your pieces are marked with an asterisk') + (writeln! '- Please take note of the following simple commands:') + (writeln! '-------- C o m m a n d s -----------') + (writeln! '1) TO MOVE YOUR PIECE USE (example) -> (m 1 2 1 3)') + (writeln! ' Result: YOUR pawn in 1,2 moved to location 1,3 based on standard cartesian x/y.') + (writeln! '2) Move MeTTa Greedy Chess -> (g)') + (writeln! '3) Reset -> (r)') + (writeln! '4) Commands List -> (c)') + (writeln! '5) Display Board -> (d)') + (writeln! 'You may now enter your move (m x1 y1 x2 y2) command!'))) + +!(chess) +;!(match &self (console-messages $msg) (println! $msg)) +;!(match &self (board-state $board) (println! $board)) + +;(board-state (. . . . . . . . .)) + +;(: display-board (-> Atom)) +;(= (display-board) +; ( +; (match &self (board $list) +; $list)) +; ) + +; (println! (format-args "\n +; {} | {} | {} \n +; --------- \n +; {} | {} | {} \n +; --------- \n +; {} | {} | {} \n +; " $list)))) ; Formats the board as a 3x3 grid for display. + + +;; (add-atom &self (board ((1 1 s r) (1 2 s p)))) +; +;(: chess (-> board-state Atom)) + + + ; (dynamic (/ guimessage 4)) (or (abolish board 1) True) (or (abolish guimessage 1) True) (or (abolish ;guimessage 2) True) (or (abolish guimessage 3) True) (or (abolish guimessage 4) True) #(add-atom &self #;(guimessage chess game started)) #(add-atom &self #(board ((1 1 s r) (1 2 s p) (1 3) (1 4) (1 5) (1 6) (1 7 ;g p) (1 8 g r) (2 1 s n) (2 2 s p) (2 3) (2 4) (2 5) (2 6) (2 7 g p) (2 8 g n) (3 1 s b) (3 2 s p) (3 3) (3 ;4) (3 5) (3 6) (3 7 g p) (3 8 g b) (4 1 s q) (4 2 s p) (4 3) (4 4) (4 5) (4 6) (4 7 g p) (4 8 g q) (5 1 s k) ;(5 2 s p) (5 3) (5 4) (5 5) (5 6) (5 7 g p) (5 8 g k) (6 1 s b) (6 2 s p) (6 3) (6 4) (6 5) (6 6) (6 7 g p) ;(6 8 g b) (7 1 s n) (7 2 s p) (7 3) (7 4) (7 5) (7 6) (7 7 g p) (7 8 g n) (8 1 s r) (8 2 s p) (8 3) (8 4) (8 ;5) (8 6) (8 7 g p) (8 8 g r)))) (set_prolog_flag toplevel_print_options #( :: ((quoted True) (portray ;True)) )) (welcome) (set-det)) + + +;(= (welcome) (write 'Deep Blue Dummy Chess -- Copyright 2001 Mike Archbold') (nl) (write 'This program is ;intended as a Prolog exercise') (nl) (nl) (board $A) (b $A) (write '******* I N S T R U C T I O N S ********') ;(nl) (write '- Your pieces are marked with an asterisk') (nl) (write '- Please take note of the following ;simple commands:') (nl) (nl) (write '-------- C o m m a n d s -----------') (nl) (write '1) TO MOVE YOUR PIECE ;USE (example) -> ?- m(1,2,1,3).') (nl) (write ' Result: YOUR pawn in 1,2 moved to location 1,3. Standard x/;y.') (nl) (write '2) TO MOVE DEEP BLUE DUMMY type -> ?- g.') (nl) (write '3) To reset, ;type -> ?- r.') (nl) (write '4) Display commands, type -> ?- c.') (nl) (write ;'5) Display current board type -> ?- d.') (nl) (write 'ALL COMMANDS MUST BE TERMINATED WITH A PERIOD ;AND NO SPACES.') (nl) (write 'You may now enter your move (m) command') (nl)) + +;!(display-board) + +; +; +;(= (r) +; (chess)) +; +; +;(= (c) (write '-------- C o m m a n d s -----------') (nl) (write '1) TO MOVE YOUR PIECE USE (example) -> ?- m;(1,2,1,3).') (nl) (write ' Result: YOUR piece in 1,2 moved to location 1,3. Standard x/y.') (nl) (write '2) ;TO MOVE DEEP BLUE DUMMY type -> ?- g.') (nl) (write '3) To reset, type -> ?- r.') (nl) ;(write '4) Display commands, type -> ?- c.') (nl) (write '5) Display current board type -> ?;- d.') (nl) (write 'ALL COMMANDS MUST BE TERMINATED WITH A PERIOD!') (nl)) +; +; +;(= (m $A $B $C $D) (guimessage checkmate $E $F) (write 'Game over.') (nl) (set-det)) +;(= (m $A $B $C $D) (board $E) (concat_lists #( :: (#( :: ($A) ) #( :: ($B) )) ) $F) (concat_lists #( :: (#( :: ;($C) ) #( :: ($D) )) ) $G) (\= $F $G) (return_entire_box $F $H $E) (return_entire_box $G $I $E) (or (len $I 2) ;(not (samecolor $H $I))) (set-det) (clear_route $H $I $E) (move_piece $H $I $E $J) (xy_box $K #( :: (s k) ) ;$J) (not (take_dest $K g $J)) (move_piece $H $I $E $L) (= $M $E) #(remove-atom &self #(board $E)) #(add-atom &;self #(board $L)) (b $L) (printmove $H $I $M) (set-det) (examine_king $L g s) (garbage_collect) (trim_stacks) ;(set-det)) +; +; +;(= (d) (board $A) (b $A) (set-det)) +; +; +;(= (b $A) (write 1 2 3 4 5 6 7 8) (nl) (write -------------------------) (nl) (write_box 1 8 $A)) +; +; +;(= (write_box $A 0 $B) (nl) (write -------------------------) (nl) (write 1 2 3 4 5 6 7 8) (nl) ;(nl) (nl) (nl)) +;(= (write_box $A $B $C) (= $A 1) (return_entire_box #( :: ($A $B) ) $D $C) (len $D 2) (write $B) (write | ) ;(is $E (+ $A 1)) (write_box $E $B $C)) +;(= (write_box $A $B $C) (< $A 8) (return_entire_box #( :: ($A $B) ) $D $C) (len $D 2) (write | ) (is $E (+ $A ;1)) (write_box $E $B $C)) +;(= (write_box $A $B $C) (= $A 8) (return_entire_box #( :: ($A $B) ) $D $C) (len $D 2) (write |) (write | ) ;(write $B) (is $E (- $B 1)) (or (, (> $B 1) (nl) (write -------------------------) (nl)) True) (write_box 1 ;$E $C)) +;(= (write_box $A $B $C) (< $A 8) (return_entire_box #( :: ($A $B) ) $D $C) (len $D 4) (nth1 3 $D g) (nth1 4 $D ;$E) (or (, (= $A 1) (write $B) (write |)) (write |)) (write ' ') (write $E) (is $F (+ $A 1)) (write_box $F ;$B $C)) +;(= (write_box $A $B $C) (< $A 8) (return_entire_box #( :: ($A $B) ) $D $C) (len $D 4) (nth1 3 $D s) (nth1 4 $D ;$E) (or (, (= $A 1) (write $B) (write |)) (write |)) (write *) (write $E) (is $F (+ $A 1)) (write_box $F $B ;$C)) +;(= (write_box $A $B $C) (= $A 8) (return_entire_box #( :: ($A $B) ) $D $C) (len $D 4) (nth1 3 $D g) (nth1 4 ;$D $E) (write |) (write ' ') (write $E) (write | ) (write $B) (is $F (- $B 1)) (= $G 1) (or (, (> $F 0) (nl) ;(write -------------------------) (nl)) True) (write_box $G $F $C)) +;(= (write_box $A $B $C) (= $A 8) (return_entire_box #( :: ($A $B) ) $D $C) (len $D 4) (nth1 3 $D s) (nth1 4 ;$D $E) (write |) (write *) (write $E) (write | ) (write $B) (is $F (- $B 1)) (= $G 1) (or (, (> $F 0) (nl) ;(write -------------------------) (nl)) True) (write_box $G $F $C)) +; +; +;(= (g) (guimessage checkmate $A $B) (write 'Game over.') (nl) (set-det)) +;(= (g) (board $A) (attemptcheckmate $B $A $C $D) #(remove-atom &self #(board $A)) #(add-atom &self #(board ;$B)) (b $B) (write 'Checkmate! Deep Blue Dummy Wins!') (nl) #(add-atom &self #(guimessage checkmate s g)) ;(printmove $C $D $A) (set-det)) +;(= (g) (board $A) (playdefenseR $B $A $C $D) #(remove-atom &self #(board $A)) #(add-atom &self #(board $B)) (b ;$B) (examine_king $B s g) (printmove $C $D $A) (set-det)) +;(= (g) (board $A) (takehighestopen $B $A $C $D) #(remove-atom &self #(board $A)) #(add-atom &self #(board $B)) ;(b $B) (examine_king $B s g) (printmove $C $D $A) (set-det)) +;(= (g) (board $A) (movetoposition $B $A $C $D) #(remove-atom &self #(board $A)) #(add-atom &self #(board $B)) ;(b $B) (examine_king $B s g) (printmove $C $D $A) (set-det)) +;(= (g) (board $A) (takehighestopenpawn $B $A $C $D) #(remove-atom &self #(board $A)) #(add-atom &self #(board ;$B)) (b $B) (examine_king $B s g) (printmove $C $D $A) (set-det)) +;(= (g) (board $A) (random_move_empty_sq $B $A $C $D) #(remove-atom &self #(board $A)) #(add-atom &self #(board ;$B)) (b $B) (printmove $C $D $A) (set-det)) +; +; +;(= (kingnotincheck $A) (xy_box $B #( :: (g k) ) $A) (not (take_dest $B s $A))) +; +; +;(= (attemptcheckmate $A $B $C $D) (xy_box $E #( :: (s k) ) $B) (buildgold $B $F) (set-det) (rpiece $G) (cord ;$H) (cord $I) (member #( :: ($H $I g $G) ) $F) (= $C +; #( :: +; ($H $I g $G) )) (positiontotake $E $C $D $B) (move_piece $C $D $B $A) (nth1 1 $D $J) (nth1 2 $D $K) ;(return_entire_box #( :: ($J $K) ) $L $A) (threatOK1 $A s g #( :: ($L) )) (threatOK2 $A s g) (threatOK3 $A ;s g) (kingnotincheck $A)) +; +; +;(= (playdefenseR $A $B $C $D) (returnrandominteger $E 3) (set-det) (or (== $E 1) (== $E 2)) (playdefense $A $B ;$C $D)) +;; /* /* newer code start */ /* see if anybody can check the silver king first... if possible do next rule ;(long) */ attemptcheckmate(Newboard,Listofboxes,Goldbox,Destbox) :- /* find silver king */ xy_box(Kingbox,[s,;k],Listofboxes), /* return list of all gold pieces */ buildgold(Listofboxes,Currentgoldpieces), /* no gold can ;align to check king, sequential check. */ rpiece(Piece), cord(X), cord(Y), member([X,Y,g,Piece],;Currentgoldpieces), positiontotake(Kingbox,[X,Y,g,Piece],Destbox,Listofboxes), !, /* don't try the exhaustive ;search if it doesn't seem likely to work... */ deepattemptcheckmate(Newboard,Listofboxes,Goldbox,Destbox). /* ;move from -Goldbox to -Destbox for checkmate, return -Newboard */ deepattemptcheckmate(Newboard,Listofboxes,;Goldbox,Destbox) :- /* find silver king */ xy_box(Kingbox,[s,k],Listofboxes), /* return list of all gold ;pieces */ buildgold(Listofboxes,Currentgoldpieces), !, /* find *** -Goldbox AND -Destbox *** which can check ;Kingbox */ findgoldcheck(Currentgoldpieces,Listofboxes,Newboard,Goldbox,Destbox,Kingbox). findgoldcheck([],_,_,;_,_,_) :- !, fail. findgoldcheck([Goldbox|_],Listofboxes,Newboard,Goldbox,Destbox,Kingbox) :- /* see if ;Goldbox can be moved into position to take Kingbox */ positiontotake(Kingbox,Goldbox,Destbox,Listofboxes), ;move_piece(Goldbox,Destbox,Listofboxes,Newboard), nth1(1,Destbox,X), nth1(2,Destbox,Y), return_entire_box([X,;Y],EntireBox,Newboard), threatOK1(Newboard,s,g,[EntireBox]), /*can your piece be taken? */ threatOK2(Newboard,;s,g), /* can king move out of the way ?? */ threatOK3(Newboard,s,g). /* can a piece block threat? */ ;findgoldcheck([_|Currentgoldpieces],Listofboxes,Newboard,Goldbox,Destbox,Kingbox) :- findgoldcheck;(Currentgoldpieces,Listofboxes,Newboard,Goldbox,Destbox,Kingbox). /* newer code end */ */ +; +; +;(= (playdefense $A $B $C $D) (buildgold $B $E) (checkgold $E $B Nil) (set-det) (fail)) +;(= (playdefense $A $B $C $D) (buildgold $B $E) (checkgold $E $B $F) (piece $G) (member #( :: ($H $I g $G) ) ;$F) (= $J +; #( :: +; ($H $I g $G) )) (hpiece $K) (xy_box $L #( :: (s $K) ) $B) (return_entire_box $L $D $B) (clear_route $D $J ;$B) (findgoldhigh $E $B $C $L) (move_piece $C $D $B $A) (or (not (take_dest $L s $A)) (or (nth1 4 $C p) ;(guimessage check g s))) (kingnotincheck $A)) +;(= (playdefense $A $B $C $D) (buildgold $B $E) (checkgold $E $B $F) (piece $G) (member #( :: ($H $I g $G) ) ;$F) (= $C +; #( :: +; ($H $I g $G) )) (hpiece $J) (xy_box $K #( :: (s $J) ) $B) (positiontotake $K $C $D $B) (move_piece $C $D ;$B $A) (not (take_dest $D s $A)) (kingnotincheck $A)) +;(= (playdefense $A $B $C $D) (buildgold $B $E) (checkgold $E $B $F) (lookforempty $B $G) (set-det) (piece $H) ;(member #( :: ($I $J g $H) ) $F) (= $C +; #( :: +; ($I $J g $H) )) (member #( :: ($K $L) ) $G) (= $D +; #( :: +; ($K $L) )) (clear_route $C $D $B) (move_piece $C $D $B $A) (not (take_dest $D s $A)) (kingnotincheck $A)) +; +; +;(= (movetoposition $A $B $C $D) (returnrandominteger $E 2) (set-det) (== $E 1) (buildgold $B $F) ;(checkeachgold $F $A $B $C $D)) +;(= (movetoposition $Newboard $Listofboxes $Goldbox $Destbox) (buildgold $Listofboxes $Currentgoldpieces) ;(checkeachgold $Currentgoldpieces $Newboard $Listofboxes $Goldbox $Destbox)) +; +; +;(= (checkeachgold Nil $A $B $C $D) (set-det) (fail)) +;(= (checkeachgold #(Cons $A $B) $C $D $A $E) (piece $F) (xy_box $G #( :: (s $F) ) $D) (positiontotake $G $A $E ;$D) (move_piece $A $E $D $C) (not (take_dest $E s $C)) (kingnotincheck $C)) +;(= (checkeachgold #(Cons $A $B) $C $D $E $F) +; (checkeachgold $B $C $D $E $F)) +; +; +;(= (random_move_empty_sq $A $B $C $D) +; (or +; (, +; (buildgold $B $E) +; (checkgold $E $B $F) +; (lookforempty $B $G) +; (buildrandomgold $B $H) +; (sort $H $I) +; (findgoldmove $I $G $B $C $D) +; (move_piece $C $D $B $A) +; (kingnotincheck $A) +; (not (take_dest $D s $A)) +; (buildgold $A $J) +; (checkgold $J $A $K) +; (length $F $L) +; (delete $K +; #( :: +; ($M $N g p) ) $O) +; (length $O $P) +; (=< $P $L)) +; (guimessage check g s))) +; +; +;(= (takehighestopen $A $B $C $D) (buildgold $B $E) (checkgold $E $B $F) (set-det) (piece $G) (xy_box $H #( :: ;(s $G) ) $B) (findgoldhigh $E $B $C $H) (return_entire_box $H $D $B) (move_piece $C $D $B $A) (not (take_dest ;$H s $A)) (kingnotincheck $A)) +; +; +;(= (takehighestopenpawn $A $B $C $D) (returnrandominteger $E 3) (set-det) (or (== $E 1) (== $E 2)) (buildgold ;$B $F) (checkgold $F $B $G) (set-det) (piece $H) (\= $H p) (xy_box $I #( :: (s $H) ) $B) (findgoldhigh $F $B #;( :: ($J $K g p) ) $I) (= $C +; #( :: +; ($J $K g p) )) (return_entire_box $I $D $B) (move_piece $C $D $B $A) (kingnotincheck $A)) +; +; +;(= (checkgold Nil $A Nil) +; (set-det)) +;; /* takehighestopenpawn(A, B, C, D) :- write('?????'). */ +;(= (checkgold #(Cons $A $B) $C #(Cons $A $D)) (take_dest $A s $C) (checkgold $B $C $D) (set-det)) +;(= (checkgold #(Cons $A $B) $C $D) (not (take_dest $A s $C)) (checkgold $B $C $D) (set-det)) +; +; +;#( = #(lookforempty () ()) True ) +;(= (lookforempty #(Cons $A $B) #(Cons $A $C)) (len $A 2) (lookforempty $B $C)) +;(= (lookforempty #(Cons $A $B) $C) +; (lookforempty $B $C)) +; +; +;#( = #(buildrandomgold () ()) True ) +;(= (buildrandomgold #(Cons $A $B) #(Cons $C $D)) (len $A 4) (nth1 3 $A g) (returnrandominteger $E 99) (is $F ;$E) (concat_lists #( :: (#( :: ($F) ) #( :: ($A) )) ) $C) (buildrandomgold $B $D)) +;(= (buildrandomgold #(Cons $A $B) $C) +; (buildrandomgold $B $C)) +; +; +;(= (buildgold Nil Nil) +; (set-det)) +;(= (buildgold #(Cons $A $B) #(Cons $A $C)) (len $A 4) (nth1 3 $A g) (buildgold $B $C) (set-det)) +;(= (buildgold #(Cons $A $B) $C) (buildgold $B $C) (set-det)) +; +; +;(= (findgoldmove #(Cons $A $B) $C $D $E $F) (= #( :: ($G $E) ) $A) (returnrandominteger $H 8) (is $I $H) ;(returnrandominteger $J 8) (is $K $J) (set-det) (findgolddest $E $D $C $F $I $K)) +; +; +;(= (findgolddest $A $B $C $D $E $F) (= $D +; #( :: +; ($E $F) )) (member $D $C) (clear_route $A $D $B)) +; +; +;#( = #(findgoldhigh () $A $B $C) (empty) ) +;(= (findgoldhigh #(Cons $A $B) $C $A $D) +; (clear_route $A $D $C)) +;(= (findgoldhigh #(Cons $A $B) $C $D $E) +; (findgoldhigh $B $C $D $E)) +; +; +;(= (take_dest $A $B $C) (takingboxes $B $C $D) (set-det) (list_clear_route $C $A $D $E) (set-det) (\== $E Nil)) +; +; +;(= (return_entire_box $A $B #(Cons $C $D)) (nth1 1 $C $E) (nth1 2 $C $F) (concat_lists #( :: (#( :: ($E) ) #( ;:: ($F) )) ) $G) (== $G $A) (= $B $C) (set-det)) +;(= (return_entire_box $A $B #(Cons $C $D)) (return_entire_box $A $B $D) (set-det)) +; +; +;(= (xy_box $A #( :: ($B $C) ) #(Cons $D $E)) (len $D 4) (nth1 3 $D $F) (nth1 4 $D $G) (== $B $F) (== $C $G) ;(nth1 1 $D $H) (nth1 2 $D $I) (concat_lists #( :: (#( :: ($H) ) #( :: ($I) )) ) $A)) +;(= (xy_box $A $B #(Cons $C $D)) +; (xy_box $A $B $D)) +; +; +;(= (samecolor $A $B) (nth1 3 $A $C) (nth1 3 $B $D) (set-det) (== $C $D)) +; +; +;(= (clear_route #( :: ($A $B $C k) ) #(Cons $D #(Cons $E $F)) $G) (or (= $D $A) (or (is $D (+ $A 1)) (is $D ;(- $A 1)))) (or (= $E $B) (or (is $E (+ $B 1)) (is $E (- $B 1))))) +;(= (clear_route #( :: ($A $B $C n) ) #(Cons $D #(Cons $E $F)) $G) (or (is $E (+ $B 2)) (is $E (- $B 2))) (or ;(is $D (+ $A 1)) (is $D (- $A 1)))) +;(= (clear_route #( :: ($A $B $C n) ) #(Cons $D #(Cons $E $F)) $G) (or (is $E (+ $B 1)) (is $E (- $B 1))) (or ;(is $D (+ $A 2)) (is $D (- $A 2)))) +;(= (clear_route #( :: ($A $B $C q) ) #(Cons $D #(Cons $E $F)) $G) +; (clear_route +; #( :: +; ($A $B $C r) ) +; #(Cons $D +; #(Cons $E $F)) $G)) +;(= (clear_route #( :: ($A $B $C q) ) #(Cons $D #(Cons $E $F)) $G) +; (clear_route +; #( :: +; ($A $B $C b) ) +; #(Cons $D +; #(Cons $E $F)) $G)) +;(= (clear_route #( :: ($A $B g p) ) #(Cons $C #(Cons $D $E)) $F) (= $A $C) (= $B 2) (is $G (- $B 1)) ;(return_entire_box #( :: ($A $G) ) $H $F) (len $H 2) (is $D (- $B 2)) (return_entire_box #( :: ($C $D) ) $I ;$F) (len $I 2)) +;(= (clear_route #( :: ($A $B g p) ) #(Cons $C #(Cons $D $E)) $F) (= $A $C) (is $D (- $B 1)) ;(return_entire_box #( :: ($C $D) ) $G $F) (len $G 2)) +;(= (clear_route #( :: ($A $B g p) ) #(Cons $C #(Cons $D $E)) $F) (return_entire_box #( :: ($C $D) ) $G $F) ;(len $G 4) (is $C (+ $A 1)) (is $D (- $B 1))) +;(= (clear_route #( :: ($A $B g p) ) #(Cons $C #(Cons $D $E)) $F) (return_entire_box #( :: ($C $D) ) $G $F) ;(len $G 4) (is $C (- $A 1)) (is $D (- $B 1))) +;(= (clear_route #( :: ($A $B s p) ) #(Cons $C #(Cons $D $E)) $F) (= $A $C) (is $D (+ $B 1)) ;(return_entire_box #( :: ($C $D) ) $G $F) (len $G 2)) +;(= (clear_route #( :: ($A $B s p) ) #(Cons $C #(Cons $D $E)) $F) (= $A $C) (= $B 2) (is $G (+ $B 1)) ;(return_entire_box #( :: ($A $G) ) $H $F) (len $H 2) (is $D (+ $B 2)) (return_entire_box #( :: ($C $D) ) $I ;$F) (len $I 2)) +;(= (clear_route #( :: ($A $B s p) ) #(Cons $C #(Cons $D $E)) $F) (return_entire_box #( :: ($C $D) ) $G $F) ;(len $G 4) (is $C (+ $A 1)) (is $D (+ $B 1))) +;(= (clear_route #( :: ($A $B s p) ) #(Cons $C #(Cons $D $E)) $F) (return_entire_box #( :: ($C $D) ) $G $F) ;(len $G 4) (is $C (- $A 1)) (is $D (+ $B 1))) +;(= (clear_route #( :: ($A $B $C r) ) #(Cons $D #(Cons $E $F)) $G) (= $A $D) (> $E $B) (is $H (- $E 1)) (is $I ;(+ $B 1)) (checkclearup $A $I $H $G)) +;(= (clear_route #( :: ($A $B $C r) ) #(Cons $D #(Cons $E $F)) $G) (= $A $D) (< $E $B) (is $H (+ $E 1)) (is $I ;(- $B 1)) (checkcleardown $A $I $H $G)) +;(= (clear_route #( :: ($A $B $C r) ) #(Cons $D #(Cons $E $F)) $G) (< $A $D) (= $E $B) (is $H (- $D 1)) (is $I ;(+ $A 1)) (checkclearright $B $I $H $G)) +;(= (clear_route #( :: ($A $B $C r) ) #(Cons $D #(Cons $E $F)) $G) (> $A $D) (= $E $B) (is $H (+ $D 1)) (is $I ;(- $A 1)) (checkclearleft $B $I $H $G)) +;(= (clear_route #( :: ($A $B $C b) ) #(Cons $D #(Cons $E $F)) $G) +; (or +; (, +; (is $D +; (+ $A 1)) +; (is $E +; (+ $B 1))) +; (, +; (> $D $A) +; (> $E $B) +; (is $H +; (+ $A 1)) +; (is $I +; (- $D 1)) +; (is $J +; (+ $B 1)) +; (is $K +; (- $E 1)) +; (checkclearupBUR $H $J $I $K $G)))) +;(= (clear_route #( :: ($A $B $C b) ) #(Cons $D #(Cons $E $F)) $G) +; (or +; (, +; (is $D +; (+ $A 1)) +; (is $E +; (- $B 1))) +; (, +; (> $D $A) +; (< $E $B) +; (is $H +; (+ $A 1)) +; (is $I +; (- $D 1)) +; (is $J +; (- $B 1)) +; (is $K +; (+ $E 1)) +; (checkclearupBDR $H $J $I $K $G)))) +;(= (clear_route #( :: ($A $B $C b) ) #(Cons $D #(Cons $E $F)) $G) +; (or +; (, +; (is $D +; (- $A 1)) +; (is $E +; (+ $B 1))) +; (, +; (< $D $A) +; (> $E $B) +; (is $H +; (- $A 1)) +; (is $I +; (+ $D 1)) +; (is $J +; (+ $B 1)) +; (is $K +; (- $E 1)) +; (checkclearupBUL $H $J $I $K $G)))) +;(= (clear_route #( :: ($A $B $C b) ) #(Cons $D #(Cons $E $F)) $G) +; (or +; (, +; (is $D +; (- $A 1)) +; (is $E +; (- $B 1))) +; (, +; (< $D $A) +; (< $E $B) +; (is $H +; (- $A 1)) +; (is $I +; (+ $D 1)) +; (is $J +; (- $B 1)) +; (is $K +; (+ $E 1)) +; (checkclearupBDL $H $J $I $K $G)))) +; +; +;(= (checkclearup $A $B $C $D) +; (> $B $C)) +;(= (checkclearup $A $B $C $D) (return_entire_box #( :: ($A $B) ) $E $D) (len $E 2) (is $F (+ $B 1)) ;(checkclearup $A $F $C $D)) +; +;(= (checkclearleft $A $B $C $D) +; (< $B $C)) +;(= (checkclearleft $A $B $C $D) (return_entire_box #( :: ($B $A) ) $E $D) (len $E 2) (is $F (- $B 1)) ;(checkclearleft $A $F $C $D)) +; +;(= (checkclearright $A $B $C $D) +; (> $B $C)) +;(= (checkclearright $A $B $C $D) (return_entire_box #( :: ($B $A) ) $E $D) (len $E 2) (is $F (+ $B 1)) ;(checkclearright $A $F $C $D)) +; +;(= (checkcleardown $A $B $C $D) +; (< $B $C)) +;(= (checkcleardown $A $B $C $D) (return_entire_box #( :: ($A $B) ) $E $D) (len $E 2) (is $F (- $B 1)) ;(checkcleardown $A $F $C $D)) +; +; +;(= (checkclearupBUR $A $B $C $D $E) (== $A $C) (== $B $D) (return_entire_box #( :: ($A $B) ) $F $E) (len $F 2)) +;(= (checkclearupBUR $A $B $C $D $E) (return_entire_box #( :: ($A $B) ) $F $E) (len $F 2) (is $G (+ $A 1)) (is ;$H (+ $B 1)) (checkclearupBUR $G $H $C $D $E)) +; +;(= (checkclearupBDR $A $B $C $D $E) (== $A $C) (== $B $D) (return_entire_box #( :: ($A $B) ) $F $E) (len $F 2)) +;(= (checkclearupBDR $A $B $C $D $E) (return_entire_box #( :: ($A $B) ) $F $E) (len $F 2) (is $G (+ $A 1)) (is ;$H (- $B 1)) (checkclearupBDR $G $H $C $D $E)) +; +;(= (checkclearupBUL $A $B $C $D $E) (== $A $C) (== $B $D) (return_entire_box #( :: ($A $B) ) $F $E) (len $F 2)) +;(= (checkclearupBUL $A $B $C $D $E) (return_entire_box #( :: ($A $B) ) $F $E) (len $F 2) (is $G (- $A 1)) (is ;$H (+ $B 1)) (checkclearupBUL $G $H $C $D $E)) +; +;(= (checkclearupBDL $A $B $C $D $E) (== $A $C) (== $B $D) (return_entire_box #( :: ($A $B) ) $F $E) (len $F 2)) +;(= (checkclearupBDL $A $B $C $D $E) (return_entire_box #( :: ($A $B) ) $F $E) (len $F 2) (is $G (- $A 1)) (is ;$H (- $B 1)) (checkclearupBDL $G $H $C $D $E)) +; +; +;(= (move_piece $A $B $C $D) (nth1 3 $A $E) (nth1 4 $A $F) (sort $C $G) (sort #( :: ($A $B) ) $H) (removelists ;$H $G $I) (nth1 1 $A $J) (nth1 2 $A $K) (= $L +; #( :: +; ($J $K) )) (nth1 1 $B $M) (nth1 2 $B $N) (= $O +; #( :: +; ($M $N $E $F) )) (sort #(Cons $L #(Cons $O $I)) $D) (set-det)) +; +; +;(= (printmove $A $B $C) (nth1 1 $A $D) (nth1 2 $A $E) (nth1 3 $A $F) (nth1 4 $A $G) (nth1 1 $B $H) (nth1 2 $B ;$I) (or (, (len $B 4) (return_entire_box #( :: ($H $I) ) $J $C) (nth1 4 $J $K)) (= $K nil)) (or (, (== $F g) ;(write 'DBD moves from:') (write $D) (write and2) (write $E) (write ' to: ') (write $H) (write and2) (write ;$I)) (, (== $F s) (write 'YOU move from:') (write $D) (write and2) (write $E) (write ' to: ') (write $H) ;(write and2) (write $I))) #(add-atom &self #(guimessage move $A $B $K)) (or (, (\= $K nil) (nl) (write 'Piece ;captured!! -> ') (write $K) (nl)) nl) (write 'Type c. for commands you can use.')) +; +; +;(= (examine_king $A $B $C) (cantakepiece $A $B k $C $D) (\= $D Nil) (threatOK1 $A $B $C $D) (threatOK2 $A $B ;$C) (threatOK3 $A $B $C) (write Checkmate!) (nl) #(add-atom &self #(guimessage checkmate $B $C))) +;(= (examine_king $A $B $C) (cantakepiece $A $B k $C $D) (\= $D Nil) (write Check!) (nl) #(add-atom &self #;(guimessage check $B $C))) +;#( = #(examine_king $A $B $C) True ) +; +; +;(= (threatOK1 $A $B $C $D) (seekopponents $A $B $D $E) (== $E Nil) (set-det)) +;(= (threatOK1 $A $B $C $D) (seekopponents $A $B $D $E) (checkthreat $E $A) (set-det)) +; +; +;(= (checkthreat Nil $A) +; (set-det)) +;(= (checkthreat #(Cons $A $B) $C) (checkeachthreat $A $C) (set-det) (checkthreat $B $C) (set-det)) +; +; +;#( = #(checkeachthreat () $A) True ) +;(= (checkeachthreat #(Cons $A #(Cons $B $C)) $D) (nth1 3 $A $E) (nth1 3 $B $F) (move_piece $A $B $D $G) ;(xy_box $H #( :: ($E k) ) $G) (set-det) (checkking $H $F $G) (checkeachthreat $C $D)) +; +; +;(= (checkking $A $B $C) +; (take_dest $A $B $C)) +; +; +;(= (threatOK2 $A $B $C) (lookforempty $A $D) (xy_box $E #( :: ($B k) ) $A) (return_entire_box $E $F $A) ;(set-det) (not (king_can_move $F $C $D $A))) +; +; +;(= (king_can_move $A $B #(Cons $C $D) $E) (clear_route $A $C $E) (move_piece $A $C $E $F) (not (take_dest $C ;$B $F))) +;(= (king_can_move $A $B #(Cons $C $D) $E) (not (clear_route $A $C $E)) (fail)) +;(= (king_can_move $A $B #(Cons $C $D) $E) (clear_route $A $C $E) (move_piece $A $C $E $F) (take_dest $C $B $F) ;(fail)) +;(= (king_can_move $A $B #(Cons $C $D) $E) +; (king_can_move $A $B $D $E)) +;(= (king_can_move $A $B Nil $C) (set-det) (fail)) +; +; +;(= (threatOK3 $A $B $C) (set-det) (not (opponentblock $A $B $C))) +; +; +;(= (opponentblock $A $B $C) (xy_box $D #( :: ($B k) ) $A) (rpiece $E) (\== $E k) (xy_box $F #( :: ($B $E) ) ;$A) (return_entire_box $F $G $A) (cord $H) (cord $I) (return_entire_box #( :: ($H $I) ) $J $A) (or (not ;(samecolor $G $J)) (len $J 2)) (clear_route $G $J $A) (move_piece $G $J $A $K) (not (take_dest $D $C $K)) ;(set-det)) +; +; +;(= (seekopponents $A $B $C $D) (buildopponent $A $B $E) (set-det) (takingpieces $E $C $A $F) (set-det) (delete ;$F Nil $D) (set-det)) +; +; +;#( = #(takingpieces () $A $B ()) True ) +;(= (takingpieces #(Cons $A $B) $C $D #(Cons $E $F)) (checkopponent $A $C $D $E) (set-det) (takingpieces $B $C ;$D $F)) +;(= (takingpieces #(Cons $A $B) $C $D $E) +; (takingpieces $B $C $D $E)) +; +; +;#( = #(checkopponent $A () $B ()) True ) +;(= (checkopponent $A #(Cons $B $C) $D #(Cons $A #(Cons $B $E))) (clear_route $A $B $D) (checkopponent $A $C $D ;$E)) +;(= (checkopponent $A #(Cons $B $C) $D $E) +; (checkopponent $A $C $D $E)) +; +; +;(= (takeyourpiece #(Cons Nil $A) $B) +; (takeyourpiece $A $C $B)) +;(= (takeyourpiece #(Cons Nil $A) $B) +; (takeyourpiece $A $C $B)) +; +; +;#( = #(buildopponent () $A ()) True ) +;(= (buildopponent #(Cons $A $B) $C #(Cons $A $D)) (len $A 4) (nth1 3 $A $C) (buildopponent $B $C $D)) +;(= (buildopponent #(Cons $A $B) $C $D) +; (buildopponent $B $C $D)) +; +; +;#( = #(seekopponent () $A $B $C ()) True ) +;(= (seekopponent #(Cons $A $B) $C $D $E $A) (len $A 4) (nth1 3 $A $C) (takeyourpiece $D $A $E)) +;(= (seekopponent #(Cons $A $B) $C $D $E $F) +; (seekopponent $B $C $D $E $F)) +; +; +;#( = #(takeyourpiece () $A $B) (empty) ) +;(= (takeyourpiece #(Cons $A $B) $C $D) +; (clear_route $C $A $D)) +; +; +;(= (cantakepiece $A $B $C $D $E) (takingboxes $D $A $F) (set-det) (xy_box $G #( :: ($B $C) ) $A) ;(list_clear_route $A $G $F $E)) +; +; +;#( = #(takingboxes $A () ()) True ) +;(= (takingboxes $A #(Cons $B $C) #(Cons $B $D)) (nth1 3 $B $A) (takingboxes $A $C $D)) +;(= (takingboxes $A #(Cons $B $C) $D) +; (takingboxes $A $C $D)) +; +; +;#( = #(list_clear_route $A $B () ()) True ) +;(= (list_clear_route $A $B #(Cons $C $D) #(Cons $C $E)) (clear_route $C $B $A) (list_clear_route $A $B $D $E)) +;(= (list_clear_route $A $B #(Cons $C $D) $E) +; (list_clear_route $A $B $D $E)) +; +; +;(= (positiontotake #(Cons $A #(Cons $B $C)) $D $E $F) (cord $G) (cord $H) (return_entire_box #( :: ($G $H) ) ;$E $F) (or (not (samecolor $D $E)) (len $E 2)) (clear_route $D $E $F) (nth1 3 $D $I) (nth1 4 $D $J) (= $K +; #( :: +; ($G $H $I $J) )) (clear_route $K #( :: ($A $B) ) $F)) +; +; +;#( = #(concat_lists () ()) True ) +;; /************* USER ROUTINES ************/ +;(= (concat_lists #(Cons Nil $A) $B) +; (concat_lists $A $B)) +;(= (concat_lists #(Cons #(Cons $A $B) $C) #(Cons $A $D)) +; (concat_lists +; #(Cons $B $C) $D)) +; +; +;#( = #(nth 0 ($A +;(= (nth $A #(Cons $B $C) $B) +; (= $A 1)) +;(= (nth $A #(Cons $B $C) $D) (is $E (- $A 1)) (nth $E $C $D)) +; +; +;(= (nth1 $Index $_ $_) (< $Index 1) (fail) (set-det)) +;; /* copied from dbd2 */ +;(= (nth1 1 #(Cons $Element $Rest) $Element) +; (set-det)) +;(= (nth1 $I #(Cons $First $List1) $Element) (is $Index (- $I 1)) (nth1 $Index $List1 $Element)) +; +; +;#( = #(removelists () $A $A) True ) +;; /* apparently swipl used: nth1(A, B, C):-integer(A), !, D is A-1, nth0_det(D, B, C). nth1(A, B, C):-var(A), ;!, nth_gen(B, C, 1, A). */ +;(= (removelists #(Cons $A $B) #(Cons $A $C) $D) +; (removelists $B $C $D)) +;(= (removelists $A #(Cons $B $C) #(Cons $B $D)) +; (removelists $A $C $D)) +; +; +;(= (len Nil 0) +; (set-det)) +;(= (len #( :: ($A) ) 1) (atomic $A) (set-det)) +;(= (len #(Cons $A $B) $C) (atomic $A) (len $B $D) (is $C (+ $D 1))) +; +; +;(= (returnrandominteger $A $B) +; (is $A +; (+ +; (random $B) 1))) +; +; \ No newline at end of file From 522389f2b419969f6a5e0eb4d073e219890ec62e Mon Sep 17 00:00:00 2001 From: Mike Archbold Date: Tue, 17 Dec 2024 23:28:43 -0800 Subject: [PATCH 06/42] save progress to date --- examples/games/GreedyChess.metta | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/examples/games/GreedyChess.metta b/examples/games/GreedyChess.metta index 1bb89a8cbd2..5515b0bd0b9 100644 --- a/examples/games/GreedyChess.metta +++ b/examples/games/GreedyChess.metta @@ -1,4 +1,4 @@ -; WORK IN PROGRESS, DOES NOT RUN +; WORK IN PROGRESS, Will start but not play yet! ; #(convert_to_metta_file dbd $10000 dbd.pl dbd.metta) From ea98cb451ea3d30955d304abc36be505b7b25b6d Mon Sep 17 00:00:00 2001 From: logicmoo Date: Tue, 17 Dec 2024 23:31:23 -0800 Subject: [PATCH 07/42] metta_atom_deduced --- prolog/metta_lang/metta_interp.pl | 6 +++--- prolog/metta_lang/metta_loader.pl | 10 +++++----- prolog/metta_lang/metta_repl.pl | 5 +++-- prolog/metta_lang/metta_types.pl | 4 ++-- 4 files changed, 13 insertions(+), 12 deletions(-) diff --git a/prolog/metta_lang/metta_interp.pl b/prolog/metta_lang/metta_interp.pl index 55c6e77d96d..3b62fa5b6f4 100755 --- a/prolog/metta_lang/metta_interp.pl +++ b/prolog/metta_lang/metta_interp.pl @@ -1400,10 +1400,10 @@ :- dynamic(metta_atom_asserted/2). :- multifile(metta_atom_asserted/2). -:- dynamic(metta_atom_asserted_deduced/2). -:- multifile(metta_atom_asserted_deduced/2). +:- dynamic(metta_atom_deduced/2). +:- multifile(metta_atom_deduced/2). metta_atom_asserted(X,Y):- - metta_atom_asserted_deduced(X,Y), + metta_atom_deduced(X,Y), \+ clause(metta_atom_asserted(X,Y),true). diff --git a/prolog/metta_lang/metta_loader.pl b/prolog/metta_lang/metta_loader.pl index da2a37dabde..58067038dbe 100755 --- a/prolog/metta_lang/metta_loader.pl +++ b/prolog/metta_lang/metta_loader.pl @@ -3647,11 +3647,11 @@ forall(metta_type('&corelib', Symb, Def), gen_interp_stubs('&corelib', Symb, Def)). -% Dynamic and multifile declaration for metta_atom_asserted_deduced/2. -:- dynamic(metta_atom_asserted_deduced/2). -:- multifile(metta_atom_asserted_deduced/2). +% Dynamic and multifile declaration for metta_atom_deduced/2. +:- dynamic(metta_atom_deduced/2). +:- multifile(metta_atom_deduced/2). -%! metta_atom_asserted_deduced(+Source, +Term) is nondet. +%! metta_atom_deduced(+Source, +Term) is nondet. % % Determines if a `Term` is part of the core library, logging the term if so. % @@ -3661,7 +3661,7 @@ % @arg Source The source of the term, expected to be `&corelib`. % @arg Term The term to verify. % -metta_atom_asserted_deduced('&corelib', Term) :- fail, +metta_atom_deduced('&corelib', Term) :- fail, % Log terms matching core library types. %\+ did_generate_interpreter_stubs, metta_atom_corelib_types(Term), diff --git a/prolog/metta_lang/metta_repl.pl b/prolog/metta_lang/metta_repl.pl index 861e2ba1a19..454f5747871 100755 --- a/prolog/metta_lang/metta_repl.pl +++ b/prolog/metta_lang/metta_repl.pl @@ -1239,7 +1239,7 @@ (C==esc('[B',[27,91,66]) -> (nb_setarg(3, Control, leap),Cut=false,Next=true) ; (C=='L' -> nb_setarg(2, Control, ResNum) ; (C=='l' -> (nb_setarg(3, Control, leap),Next=true) ; - (((C=='\n');(C=='\r')) -> (Cut=true,Next=false); + (((C=='\n');(C=='\r')) -> (Cut=false,nb_setarg(3, Control, leap),Next=true); (C=='g' -> write_src(exec(TermV)); (C=='s' -> (Cut=true,Next=false); (true -> (write('Unknown Char'),fail))))))))))))))))))), @@ -1258,7 +1258,7 @@ ) *-> % Each forall_interactive (((flag(result_num,ResNum,ResNum),ResNum >= MaxResults) -> ! ; true),ignore(Result = res(FOut)),ignore(Output = (FOut))) ; % Last forall_interactive - (flag(result_num,ResNum,ResNum),(ResNum==0-> (old_not_compatio(format('~N;; no-results ;; ~n~n')),!,true);true)) + (flag(result_num,ResNum,ResNum),(ResNum==0-> (old_not_compatio(format('~N;; no-results ;; ~n')),!,true);true)) ), @@ -1317,6 +1317,7 @@ +%old_not_compatio(_G):- \+ is_testing, !. old_not_compatio(G):- call(G),ttyflush. %! maybe_assign(+N_V) is det. diff --git a/prolog/metta_lang/metta_types.pl b/prolog/metta_lang/metta_types.pl index 00176c54cf8..9235a11d44a 100755 --- a/prolog/metta_lang/metta_types.pl +++ b/prolog/metta_lang/metta_types.pl @@ -441,7 +441,7 @@ % Ensure no repeated types using no_repeats_var/1. no_repeats_var(NoRepeatType), % Retrieve the type of the value. - get_type_each(Depth, Self, Val, Type), + get_type_each(Depth, Self, Val, Type), Type\=='', % Ensure the type matches the expected no-repeat type. NoRepeatType = Type, Type = TypeO, @@ -1311,7 +1311,7 @@ % ignored_args_conform(Depth, Self, A, L) :- % If either Args or List is not a conz structure, succeed without further checks. - (\+ iz_conz(Args); \+ iz_conz(List)), !. + (\+ iz_conz(A); \+ iz_conz(L)), !. ignored_args_conform(Depth, Self, A, L) :- % Check if each argument conforms to its corresponding expected type. maplist(ignored_arg_conform(Depth, Self), A, L). From 89666524560c00d06d3597d04772c9783379630e Mon Sep 17 00:00:00 2001 From: Mike Archbold Date: Tue, 17 Dec 2024 23:36:37 -0800 Subject: [PATCH 08/42] save progress to date --- examples/games/GreedyChess.metta | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/examples/games/GreedyChess.metta b/examples/games/GreedyChess.metta index 5515b0bd0b9..07a7c0b1631 100644 --- a/examples/games/GreedyChess.metta +++ b/examples/games/GreedyChess.metta @@ -82,13 +82,13 @@ (writeln! '- Your pieces are marked with an asterisk') (writeln! '- Please take note of the following simple commands:') (writeln! '-------- C o m m a n d s -----------') - (writeln! '1) TO MOVE YOUR PIECE USE (example) -> (m 1 2 1 3)') + (writeln! '1) TO MOVE YOUR PIECE USE (example) -> !(m 1 2 1 3)') (writeln! ' Result: YOUR pawn in 1,2 moved to location 1,3 based on standard cartesian x/y.') - (writeln! '2) Move MeTTa Greedy Chess -> (g)') - (writeln! '3) Reset -> (r)') - (writeln! '4) Commands List -> (c)') - (writeln! '5) Display Board -> (d)') - (writeln! 'You may now enter your move (m x1 y1 x2 y2) command!'))) + (writeln! '2) Move MeTTa Greedy Chess -> !(g)') + (writeln! '3) Reset -> !(r)') + (writeln! '4) Commands List -> !(c)') + (writeln! '5) Display Board -> !(d)') + (writeln! 'You may now enter your move !(m x1 y1 x2 y2) command.'))) !(chess) ;!(match &self (console-messages $msg) (println! $msg)) From 86c4b72a1118f17e3d25e0c848323bc4472cc68e Mon Sep 17 00:00:00 2001 From: Mike Archbold Date: Wed, 18 Dec 2024 09:52:30 -0800 Subject: [PATCH 09/42] add comments --- .../loaders/graphml/ext_loader_graphml.pl | 1544 +++++++++++++---- 1 file changed, 1209 insertions(+), 335 deletions(-) diff --git a/libraries/loaders/graphml/ext_loader_graphml.pl b/libraries/loaders/graphml/ext_loader_graphml.pl index 4d67e52cb13..9c17a0ce503 100644 --- a/libraries/loaders/graphml/ext_loader_graphml.pl +++ b/libraries/loaders/graphml/ext_loader_graphml.pl @@ -1,3 +1,65 @@ +/* + * Project: MeTTaLog - A MeTTa to Prolog Transpiler/Interpreter + * Description: This file is part of the source code for a transpiler designed to convert + * MeTTa language programs into Prolog, utilizing the SWI-Prolog compiler for + * optimizing and transforming function/logic programs. It handles different + * logical constructs and performs conversions between functions and predicates. + * + * Author: Douglas R. Miles + * Contact: logicmoo@gmail.com / dmiles@logicmoo.org + * License: LGPL + * Repository: https://github.com/trueagi-io/metta-wam + * https://github.com/logicmoo/hyperon-wam + * Created Date: 8/23/2023 + * Last Modified: $LastChangedDate$ # You will replace this with Git automation + * + * Usage: This file is a part of the transpiler that transforms MeTTa programs into Prolog. For details + * on how to contribute or use this project, please refer to the repository README or the project documentation. + * + * Contribution: Contributions are welcome! For contributing guidelines, please check the CONTRIBUTING.md + * file in the repository. + * + * Notes: + * - Ensure you have SWI-Prolog installed and properly configured to use this transpiler. + * - This project is under active development, and we welcome feedback and contributions. + * + * Acknowledgments: Special thanks to all contributors and the open source community for their support and contributions. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the + * distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS + * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT + * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS + * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE + * COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, + * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; + * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER + * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN + * ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + * POSSIBILITY OF SUCH DAMAGE. + */ + +%********************************************************************************************* +% PROGRAM FUNCTION: parse and process GraphML files to extract graph structures, particularly +% nodes and edges, with their associated attributes like labels, descriptions, and relationships. +%********************************************************************************************* + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% IMPORTANT: DO NOT DELETE COMMENTED-OUT CODE AS IT MAY BE UN-COMMENTED AND USED +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + /** read_graphml - Read graph information from a yEd graphml file * @@ -8,77 +70,232 @@ * @author Carlos Lang-Sanou */ - :- module(read_graphml, [read_graphml/2, - rgml/0,rgml2/0, - load_graphml/2, - load_fb_graphml/2]). - - - -% ============================== -% GFF/GTF/GFF3 Reader -% ============================== - -load_fb_graphml(Fn,Filename):- - track_load_into_file(Filename, - must_det_ll(( - fbug(load_fb_graphml(Fn,Filename)), - directory_file_path(Directory, BaseName, Filename), - file_name_extension(Id, _, BaseName), - Type = 'SequenceFile', - assert_OBO(id_type(Id,Type)), - assert_OBO(pathname(Id,Filename)),!, - assert_OBO(basename(Id,BaseName)),!, - assert_OBO(directory(Id,Directory)),!, - read_graphml(Filename,In), - load_fb_graphml_read(Id,In)))). - - -load_fb_graphml_read(Id,In):- is_list(In),!,maplist(load_fb_graphml_read(Id),In). -load_fb_graphml_read(Id,In):- In=..[P|InL],Save=..[P,Id|InL],assert_OBO(Save),writeln(Save). - -s_list_assert(S,List,Assert):- - must_det_ll((into_name_values(List,Ns,Vs), - atomic_list_concat([S|Ns],'_',Pred), - Assert=..[Pred|Vs])). - -fix_value(X,Y):- \+ callable(X),X=Y. -fix_value([X],Y):- !, fix_value(X,Y). -fix_value(X,Y):- is_list(X),!,maplist(fix_value,X,Y). -fix_value(X,Y):- \+ atom(X),!,X=Y. -fix_value(X,Y):- atom_number(X,Y),!. -fix_value(X,X). - -elements_are_kv(Data,element(Data,[id=Key],LValue),Key=Value):- fix_value(LValue,Value). -elements_are_kv(Data,element(Data,[key=Key],LValue),Key=Value):- fix_value(LValue,Value). -%elements_are_kv(S2,Content,List2):- maplist(elements_are_kv(S2),Content,List2). - -restructure_graphml(Term_list,Terms):- is_list(Term_list),!,maplist(restructure_graphml,Term_list,Terms). -restructure_graphml(element(S,List,[]),Assert):- List \==[], s_list_assert(S,List,Assert). -restructure_graphml(element(graphml,_,Term_list),Terms):-!,restructure_graphml(Term_list,Terms). -restructure_graphml(element(graph,[id='G'|_],Term_list),Terms):-!,restructure_graphml(Term_list,Terms). -restructure_graphml(element(S,[ source=B,target=E],Term_list),Assert):- S == edge, - %atomic_list_concat([B,E],'_',Id), - maplist(elements_are_kv(data),Term_list,NVList), - findall(edge_prop(B,E,N,V),(member(N=V,NVList), \+ member(V,['false','None'])),Assert). -restructure_graphml(element(S,[id=Id],Term_list),Assert):- S == node, - maplist(elements_are_kv(data),Term_list,NVList), - findall(node_prop(Id,N,V),(member(N=V,NVList), \+ member(V,['false','None'])),Assert). -restructure_graphml(IO,IO). + :- module(read_graphml, [ + read_graphml/2, % Reads a GraphML file and extracts graph terms + rgml/0, % Example loader for specific GraphML files + rgml2/0, % Example loader for another GraphML pattern + load_graphml/2, % General loader for GraphML files + load_fb_graphml/2 % Loader for GraphML files with specific FB processing +]). + +%! load_fb_graphml(+KB, +Filename) is det. +% +% Loads a GraphML file and processes its content to assert graph data into the Prolog database. +% This predicate links the graph data with a specific knowledge base identifier. +% +% @arg KB A knowledge base identifier to associate with the graph data. +% @arg Filename The full path to the GraphML file to be processed. +% +% @example +% % Load the GraphML file 'example.graphml' with knowledge base ID 'graph1'. +% ?- load_fb_graphml(graph1, 'data/example.graphml'). +% +load_fb_graphml(Fn, Filename) :- + % Track file loading and ensure logical consistency using must_det_ll. + track_load_into_file(Filename, + must_det_ll(( + % Log the loading operation for debugging. + fbug(load_fb_graphml(Fn, Filename)), + % Decompose the file path into directory, base name, and file ID. + directory_file_path(Directory, BaseName, Filename), + file_name_extension(Id, _, BaseName), + % Define the file type as 'SequenceFile' for graph data. + Type = 'SequenceFile', + % Assert metadata about the file into the Prolog database. + assert_OBO(id_type(Id, Type)), + assert_OBO(pathname(Id, Filename)), !, + assert_OBO(basename(Id, BaseName)), !, + assert_OBO(directory(Id, Directory)), !, + % Parse the GraphML file to extract its content as terms. + read_graphml(Filename, In), + % Process the parsed GraphML terms and assert them into the database. + load_fb_graphml_read(Id, In) + ))). + +%! load_fb_graphml_read(+Id, +Input) is det. +% +% Processes the GraphML input and asserts it into the Prolog database. +% This predicate recursively processes lists of GraphML terms or individual terms. +% +% @arg Id Identifier used as a prefix for asserting terms. +% @arg Input Input GraphML term or a list of terms to be processed. +% +% @example +% ?- load_fb_graphml_read(my_id, [element1, element2]). +% +% % This will process and assert terms prefixed with 'my_id'. +% +load_fb_graphml_read(Id, In) :- + is_list(In), !, + % Recursively process each element in the list. + maplist(load_fb_graphml_read(Id), In). +load_fb_graphml_read(Id, In) :- + % Convert input into a term with Id as the first argument. + In =.. [P | InL], + Save =.. [P, Id | InL], + % Assert the term into the OBO database. + assert_OBO(Save), + % Print the asserted term for debugging purposes. + writeln(Save). + +%! s_list_assert(+Prefix, +List, -Assert) is det. +% +% Converts a list of name-value pairs into a Prolog term with a prefixed predicate. +% This predicate is useful for restructuring and asserting GraphML data. +% +% @arg Prefix The prefix used as the functor name for the resulting term. +% @arg List A list of name-value pairs. +% @arg Assert The resulting Prolog term to be asserted. +% +% @example +% ?- s_list_assert(node, [id=1, label='Node A'], Term). +% Term = node_id_label(1, 'Node A'). +% +s_list_assert(S, List, Assert) :- + must_det_ll(( + % Convert list into names and values. + into_name_values(List, Ns, Vs), + % Concatenate prefix and names to form the predicate name. + atomic_list_concat([S | Ns], '_', Pred), + % Create a term with the predicate name and values. + Assert =.. [Pred | Vs] + )). + +%! fix_value(+Input, -Output) is det. +% +% Normalizes values from the GraphML input into usable Prolog terms. +% Handles atoms, lists, and numeric conversions. +% +% @arg Input The input value to be normalized. +% @arg Output The resulting normalized value. +% +% @example +% ?- fix_value('123', X). +% X = 123. +% +% ?- fix_value([abc], Y). +% Y = abc. +% +fix_value(X, Y) :- + \+ callable(X), X = Y. +fix_value([X], Y) :- !, + % If the input is a list with a single element, normalize the element. + fix_value(X, Y). +fix_value(X, Y) :- + % If the input is a list, normalize each element. + is_list(X), !,maplist(fix_value, X, Y). +fix_value(X, Y) :- + % If the input is not an atom, keep it as is. + \+ atom(X), !,X = Y. +fix_value(X, Y) :- + % Convert atoms that represent numbers into numbers. + atom_number(X, Y), !. +fix_value(X, X). + +%! elements_are_kv(+Data, +Element, -KeyValue) is det. +% +% Extracts key-value pairs from GraphML `data` elements. +% Handles both `id` and `key` attributes as identifiers for the key-value pairs. +% +% @arg Data The tag or data type to be matched. +% @arg Element A Prolog term representing an XML/SGML element. +% @arg KeyValue The resulting key-value pair in the form `Key=Value`. +% +% @example +% ?- elements_are_kv(data, element(data, [id=my_id], ['Some Value']), KeyValue). +% KeyValue = my_id='Some Value'. +% +% ?- elements_are_kv(data, element(data, [key=key_123], ['123']), KeyValue). +% KeyValue = key_123=123. +% +elements_are_kv(Data, element(Data, [id=Key], LValue), Key=Value) :- + % Normalize the value extracted from the data element. + fix_value(LValue, Value). +elements_are_kv(Data, element(Data, [key=Key], LValue), Key=Value) :- + % Normalize the value when 'key' is used as an attribute. + fix_value(LValue, Value). +% elements_are_kv(S2, Content, List2) :- +% % Uncomment this line if recursive processing of content elements is needed. +% % Map each sub-element and extract key-value pairs recursively. +% maplist(elements_are_kv(S2), Content, List2). + +%! restructure_graphml(+Input, -Output) is det. +% +% Restructures GraphML terms into a more manageable format. +% Processes nodes and edges from a GraphML file, extracting relevant attributes +% and creating a simplified representation. +% +% @arg Input The input GraphML term or list of terms to be restructured. +% @arg Output The resulting list of simplified GraphML terms. +% +% @example +% % Example input structure for nodes and edges: +% ?- restructure_graphml([element(node, [id=node1], []), +% element(edge, [source=node1, target=node2], [element(data, [key=label], ['A'])])], Output). +% Output = [node_prop(node1, label, 'A')]. +% +restructure_graphml(Term_list, Terms) :- + % If the input is a list, recursively process each element in the list. + is_list(Term_list), !, + maplist(restructure_graphml, Term_list, Terms). +restructure_graphml(element(S, List, []), Assert) :- + % Process an empty element with a list of attributes. + List \== [], % Ensure the list is not empty. + s_list_assert(S, List, Assert). % Convert the attributes into a Prolog term. +restructure_graphml(element(graphml, _, Term_list), Terms) :- + % Entry point for a GraphML document. Process the inner terms. + !, restructure_graphml(Term_list, Terms). +restructure_graphml(element(graph, [id='G' | _], Term_list), Terms) :- + % Process the main 'graph' element (with id='G'). + !, restructure_graphml(Term_list, Terms). +restructure_graphml(element(S, [source=B, target=E], Term_list), Assert) :- + % Process 'edge' elements. + S == edge, % Ensure this is an 'edge' element. + %atomic_list_concat([B,E],'_',Id), + maplist(elements_are_kv(data), Term_list, NVList), + % Extract key-value pairs, filtering out irrelevant values. + findall(edge_prop(B, E, N, V), + (member(N=V, NVList), \+ member(V, ['false', 'None'])), + Assert). +restructure_graphml(element(S, [id=Id], Term_list), Assert) :- + % Process 'node' elements. + S == node, % Ensure this is a 'node' element. + maplist(elements_are_kv(data), Term_list, NVList), + % Extract key-value pairs, filtering out irrelevant values. + findall(node_prop(Id, N, V), + (member(N=V, NVList), \+ member(V, ['false', 'None'])), + Assert). +restructure_graphml(IO, IO). % Default case: return the input unchanged. %! read_graphml(+File_basename:atom, -Term_list:list) is det -% Read the file File_basename.graphml and produce the corresponding list of terms % -% @arg File_basename base-name filename without its file extension -% @arg Term_list list of corresponding terms for the graph. -read_graphml(Graphfile, Term_list):- - file_name_extension(Base_name, '.graphml', Graphfile), !, read_graphml(Base_name, Term_list). -read_graphml(Id, Terms):- +% Reads a GraphML file and produces a corresponding list of terms. +% This predicate processes GraphML data using SWI-Prolog's XML parser. +% It handles different ways of reading the input, including direct structure loading +% and custom SGML parsing. +% +% @arg File_basename The base name of the input file, without the '.graphml' extension. +% @arg Term_list The resulting list of terms extracted from the GraphML file. +% +% @example +% % Read a GraphML file and output the parsed terms: +% ?- read_graphml('example', Terms). +% Terms = [node_prop(...), edge_prop(...), ...]. +% +read_graphml(Graphfile, Term_list) :- + % If the file has a '.graphml' extension, strip it and reprocess. + file_name_extension(Base_name, '.graphml', Graphfile), !, + read_graphml(Base_name, Term_list). +read_graphml(Id, Terms) :- + % Load the structure of the '.graphml' file directly. file_name_extension(Id, '.graphml', Graphfile), !, - load_structure(Graphfile,Term_list, - [dialect(xml),space(remove),case_preserving_attributes(false)]), - restructure_graphml(Term_list,Terms). - + load_structure(Graphfile, Term_list, [ + dialect(xml), % Use XML dialect. + space(remove), % Remove spaces from parsed content. + case_preserving_attributes(false) % Normalize attribute names to lowercase. + ]), + % Restructure the parsed terms into a usable format. + restructure_graphml(Term_list, Terms). read_graphml(Id, Term_list) :- file_name_extension(Id, '.graphml', Graphfile), !, %load_html(Graphfile, [Graphml], []), !, graphml_term_list(Graphml, Term_list). @@ -100,145 +317,458 @@ findall(feature_data(A,B,C), feature_data(A,B,C),Term_list). - - - :- dynamic(feature_data/3). -on_end('graphml', _) :- !, - finish_feature_data,!, - listing(feature_data(_,_,_)), - retractall(feature_data(_,_,_)), - sleep(0.1),!. -%on_end(Tag, _Parser):- current_tag(Is), Is = Tag, !, pop_tag(Tag), finish_tag(Tag). -on_end(_, _). +%! on_end(+Tag, +Parser) is det. +% +% Handles the end of parsing specific tags in the GraphML file. +% This predicate performs final processing when the 'graphml' tag is encountered. +% For other tags, it does nothing. +% +% @arg Tag The current XML/SGML tag being closed. +% @arg Parser The SGML parser in use (not explicitly needed here). +% +on_end('graphml', _) :- + % When parsing ends for the 'graphml' tag, finalize feature data. + !,finish_feature_data,!, + % Print all the asserted feature data for debugging. + listing(feature_data(_, _, _)), + % Clean up by retracting all feature_data terms. + retractall(feature_data(_, _, _)), + % Introduce a small delay to ensure synchronization or debugging visibility. + sleep(0.1), + !. -on_begin('chado', _, _) :- !. -on_begin('graphml', _, _) :- !. -on_begin('feature', _, _Parser) :- !. -%on_begin(Tag, _Attr, _Parser):- push_tag(Tag),fail. +%on_end(Tag, _Parser):- +% current_tag(Is), Is = Tag, !, pop_tag(Tag), finish_tag(Tag). -on_begin(Tag,Attr,Parser):- read_element(Parser, Content, Reset),!, - (store_feature(Tag,Attr,Content)->true;(set_sgml_parser(Parser,position(Reset)),fail)). -on_begin(Tag,Attr,Parser):- read_element(Parser, Content, Reset),!, - (try_begin(Tag,Attr,Content)->true;(set_sgml_parser(Parser,position(Reset)),fail)). +on_end(_, _). +% Default case: Do nothing for other tags. -on_begin(Any, _, Parser) :- read_element(Parser,Content,_),nl,print(Any=Content),nl. +%! on_begin(+Tag, +Attributes, +Parser) is det. +% +% Handles the beginning of parsing specific tags in the GraphML file. +% This predicate processes tags like 'graphml', 'chado', and 'feature' specifically, +% while attempting to handle other tags with additional logic. +% +% @arg Tag The current XML/SGML tag being processed. +% @arg Attributes List of attributes associated with the tag. +% @arg Parser The SGML parser being used. +% +on_begin('chado', _, _) :- !. +% Do nothing for the 'chado' tag. +on_begin('graphml', _, _) :- !. +% Do nothing for the 'graphml' tag itself; handled in on_end. +on_begin('feature', _, _Parser) :- !. +% Do nothing when encountering a 'feature' tag. +%on_begin(Tag, _Attr, _Parser):- +% push_tag(Tag), fail. on_begin(Tag, Attr, Parser) :- - sgml_parse(Parser, - [ document(Content), - parse(content) - ]), - FD = feature_data(Tag, Attr, Content), - print(FD),nl, - assertz(FD). - - -current_tag(Tag):- once(clause(current_tag_stack(Was),true,_Ref);Was=[]),append(_New,[Tag],Was),!. + % Read the content of the current element and store the reset position. + read_element(Parser, Content, Reset), + !, + % Attempt to store the feature data. If it fails, reset the parser position. + (store_feature(Tag, Attr, Content) + -> true + ; (set_sgml_parser(Parser, position(Reset)), fail)). +on_begin(Tag, Attr, Parser) :- + % Read the element's content and reset position if needed. + read_element(Parser, Content, Reset), + !, + % Attempt to process the beginning of the tag. + (try_begin(Tag, Attr, Content) + -> true + ; (set_sgml_parser(Parser, position(Reset)), fail)). +on_begin(Any, _, Parser) :- + % Debugging: Print unexpected tag content. + read_element(Parser, Content, _), + nl, print(Any = Content), nl. +on_begin(Tag, Attr, Parser) :- + % Parse the content of the current element and assert it as feature data. + sgml_parse(Parser, [ + document(Content), + parse(content) + ]), + % Construct the feature_data term and assert it into the database. + FD = feature_data(Tag, Attr, Content), + print(FD), nl, + assertz(FD). + + +%! current_tag(-Tag) is det. +% +% Retrieves the current tag at the top of the tag stack. +% If no tags are on the stack, it defaults to 'none'. +% +% @arg Tag The tag currently at the top of the stack or `none` if empty. +current_tag(Tag) :- + once(clause(current_tag_stack(Was), true, _Ref) ; Was = []), + append(_New, [Tag], Was), !. current_tag(none). -parent_tag(Tag):- once(clause(current_tag_stack(Was),true,_Ref);Was=[]),append(_New,[Tag,_],Was),!. -parent_tag(none). - -pop_tag(Tag):- - once(clause(current_tag_stack(Was),true,Ref);Was=[]),append(New,[Tag],Was), - it_t(nonvar(Ref),erase(Ref)), assert(current_tag_stack(New)),!. -push_tag(Tag):- - once(retract(current_tag_stack(Was));Was=[]),append(Was,[Tag],New),assert(current_tag_stack(New)). -finish_tag(_Tag). - -peek_element(Parser, Content):- - call_cleanup( - read_element(Parser, Content, Pos), - set_sgml_parser(Parser,position(Pos))). - -read_element(Parser, Content, Pos):- - - get_sgml_parser(Parser,source(S)), - stream_property(S,position(Pos)), - sgml_parse(Parser, - [ document(Content), - parse(content) - ]),!. +%! parent_tag(-Tag) is det. +% +% Retrieves the parent tag, which is the second-to-last tag on the stack. +% If no parent tags exist, it defaults to 'none'. +% +% @arg Tag The parent tag on the stack or `none` if empty. +parent_tag(Tag) :- + once(clause(current_tag_stack(Was), true, _Ref) ; Was = []), + append(_New, [Tag, _], Was), !. +parent_tag(none). -try_begin(Tag,Attr, element(T,A,L)):-!, - append(Attr,A,AttrA), try_begin(Tag=T,AttrA,L). +%! pop_tag(+Tag) is det. +% +% Removes the given tag from the top of the tag stack. +% If the stack exists, it erases the current stack and reasserts a new one without the tag. +% +% @arg Tag The tag to be removed from the stack. +pop_tag(Tag) :- + once(clause(current_tag_stack(Was), true, Ref) ; Was = []), + append(New, [Tag], Was), + it_t(nonvar(Ref), erase(Ref)), % Remove the old clause. + assert(current_tag_stack(New)), !. + +%! push_tag(+Tag) is det. +% +% Adds a new tag to the top of the tag stack. +% +% @arg Tag The tag to be pushed onto the stack. +push_tag(Tag) :- + once(retract(current_tag_stack(Was)) ; Was = []), + append(Was, [Tag], New), + assert(current_tag_stack(New)). -try_begin(Tag,Attr,List):- is_list(List), - absorb_type_ids(Tag,Attr,List),!. +%! finish_tag(+Tag) is det. +% +% Placeholder predicate for finalizing operations on a tag. +% Currently does nothing but can be extended as needed. +% +% @arg Tag The tag to finalize. +finish_tag(_Tag). -try_begin(Tag,Attr,V):- process_feature_data(Tag, Attr, V). +%! peek_element(+Parser, -Content) is det. +% +% Reads an element from the parser stream without consuming it. +% This is achieved by resetting the parser position after reading. +% +% @arg Parser The SGML parser being used. +% @arg Content The content read from the parser. +peek_element(Parser, Content) :- + call_cleanup( + read_element(Parser, Content, Pos), % Read content and store the current position. + set_sgml_parser(Parser, position(Pos)) % Reset the parser position after reading. + ). +%! read_element(+Parser, -Content, -Pos) is det. +% +% Reads content from the current SGML parser stream and captures its position. +% +% @arg Parser The SGML parser being used. +% @arg Content The parsed content. +% @arg Pos The current position in the stream. +read_element(Parser, Content, Pos) :- + % Retrieve the stream source from the parser. + get_sgml_parser(Parser, source(S)), + % Capture the current position in the stream. + stream_property(S, position(Pos)), + % Parse the content as an SGML/XML document. + sgml_parse(Parser, [ + document(Content), + parse(content) + ]), !. + +%! try_begin(+Tag, +Attributes, +Content) is det. +% +% Processes the beginning of an SGML/XML element during parsing. +% Handles nested structures, lists, and individual values to extract or process feature data. +% +% @arg Tag The current tag being processed. +% @arg Attributes The list of attributes associated with the tag. +% @arg Content The content within the tag, which can be a list, an element, or a single value. +% +% @example +% ?- try_begin('node', [id=1], element(data, [key=label], ['Node A'])). +% % Processes the nested element and extracts feature data. +% +try_begin(Tag, Attr, element(T, A, L)) :- + % If the content is an element, combine the current attributes with the new attributes (A). + !, + append(Attr, A, AttrA), + % Recursively call try_begin with the updated attributes and nested content (L). + try_begin(Tag = T, AttrA, L). +try_begin(Tag, Attr, List) :- + % If the content is a list, process it to absorb type IDs or nested content. + is_list(List), + absorb_type_ids(Tag, Attr, List), !. +try_begin(Tag, Attr, V) :- + % If the content is a single value, process it as feature data. + process_feature_data(Tag, Attr, V). %try_begin(Tag,Attr, element(T,A,L)):- - % %absorb_type_ids(Tag,Attr, element(T,A,L)), - % maplist(try_begin(T,A),L). - - -absorb_type_ids(Tag,Attr,Elements):- - select(element(type_id,[],C),Elements, Rest), - get_content([cv,name],C,TypeName),!, - must_det_ll((get_content([cvterm,name],C,Name), - maplist(get_element_value_each,Rest,Values), - maplist(process_feature_data(ntv(Tag,TypeName,Name),Attr),Values))),!. - - + % % Placeholder for processing nested elements with absorb_type_ids. + % % absorb_type_ids(Tag,Attr, element(T,A,L)), + % % maplist(try_begin(T,A),L). -absorb_type_ids(_Tag,Attr,Elements):- - select(element(type_id,[],C),Elements, Rest), - must_det_ll((get_content([cvterm,name],C,Name), - maplist(get_element_value_each,Rest,Values), - maplist(process_feature_data(nv(Name),Attr),Values))),!. - -store_feature(Tag,Attr,Content):- cvt_element(element(Tag,Attr,Content),Val), +%! absorb_type_ids(+Tag, +Attributes, +Elements) is det. +% +% Extracts and processes type IDs and associated content from a list of elements. +% This predicate handles nested `type_id` structures to retrieve type names and values, +% and calls `process_feature_data/3` to process the extracted information. +% +% @arg Tag The parent tag being processed. +% @arg Attributes The list of attributes associated with the tag. +% @arg Elements A list of elements containing a `type_id` to be processed. +% +% @example +% ?- absorb_type_ids(tag, [id=1], [element(type_id, [], [element(cvterm, [], ['Name'])]), Other]). +% +absorb_type_ids(Tag, Attr, Elements) :- + % Select an element of type 'type_id' from the list. + select(element(type_id, [], C), Elements, Rest), + % Extract the type name using the 'cv' and 'name' hierarchy. + get_content([cv, name], C, TypeName), !, + must_det_ll(( + % Extract the name using the 'cvterm' and 'name' hierarchy. + get_content([cvterm, name], C, Name), + % Process the remaining elements to extract their values. + maplist(get_element_value_each, Rest, Values), + % Process each value as feature data with the Tag, TypeName, and Name. + maplist(process_feature_data(ntv(Tag, TypeName, Name), Attr), Values) + )), !. + +%! absorb_type_ids(+Tag, +Attributes, +Elements) is det. +% +% Processes `type_id` elements where only `cvterm` names are available. +% This version does not require `cv` content and processes values directly. +% +% @arg Tag The parent tag being ignored (set as `_`). +% @arg Attributes The list of attributes associated with the tag. +% @arg Elements A list of elements containing `type_id` to be processed. +% +absorb_type_ids(_Tag, Attr, Elements) :- + % Select an element of type 'type_id'. + select(element(type_id, [], C), Elements, Rest), + must_det_ll(( + % Extract the name using the 'cvterm' and 'name' hierarchy. + get_content([cvterm, name], C, Name), + % Process the remaining elements to extract their values. + maplist(get_element_value_each, Rest, Values), + % Process each value as feature data with the Tag and Name. + maplist(process_feature_data(nv(Name), Attr), Values) + )), !. + +%! store_feature(+Tag, +Attributes, +Content) is det. +% +% Converts and stores a feature represented by a tag, attributes, and content. +% This predicate converts an XML/SGML element into a Prolog term and asserts it. +% +% @arg Tag The tag representing the feature. +% @arg Attributes The list of attributes associated with the feature. +% @arg Content The content to be stored. +% +store_feature(Tag, Attr, Content) :- + % Convert the input element into a Prolog term. + cvt_element(element(Tag, Attr, Content), Val), + % Assert the feature data into the database. assert(feature_data(Tag, Attr, Val)). +%! skip_over(+ElementType) is semidet. +% +% Succeeds if the given element type is one of the elements to be skipped. +% These elements are ignored during processing. +% +% @arg ElementType The element type to be checked. +% skip_over(cvterm). skip_over(cv). skip_over(pub). + +%! skip_over_s(+ElementType) is semidet. +% +% Succeeds if the given element type matches an extended list of elements to be skipped. +% This includes specific types such as `dbxref_id`, `library_id`, and related entries. +% +% @arg ElementType The element type to be checked. +% skip_over_s(featureprop). skip_over_s(featureprop_pub). -skip_over_s(E):- - member(E,[dbxref_id, dbxref, - db_id, library_id, library, library_feature]). -skip_over_s(X):- skip_over(X). - -cvt_element(List,Val):- is_list(List),!,maplist(cvt_element,List,Val). -cvt_element(element(Tag,[],[element(CVTerm,[],L)]), TagVal):- skip_over_s(CVTerm), !, - cvt_element(element(Tag,[],L),TagVal). -cvt_element(element(CVTerm,[],[Atomic]),Val):-skip_over_s(CVTerm),!,cvt_element(Atomic,Val). -cvt_element(element(CVTerm,[],Atomic),Val):-skip_over(CVTerm),!,cvt_element(Atomic,Val). -cvt_element(element(Tag,[],[element(T,A,L)]),Tag=Val):- !, cvt_element(element(T,A,L),Val). -cvt_element(element(Tag,[],[Atomic]),Tag=Atomic):-!. -cvt_element(element(Tag,[],List),Tag=Val):- !, cvt_element(List,Val). -cvt_element(Val,Val). - - -get_content([],R,R):-!. -get_content([S|Tags],L,R):- is_list(L),member(E,L),get_content([S|Tags],E,R),!. -get_content([S|Tags],element(S,_,L),R):- get_content(Tags,L,R),!. -get_content( STags,element(_,_,L),R):- member(C,L),get_content(STags,C,R),!. - -get_element_value_each(element(R,[],List),Out):- - \+ \+ member(element(_,_,_),List), - try_begin(R,[],List), - get_element_value(element(R,[],List),Out). -get_element_value_each(R,Out):- get_element_value(R,Out),!. - -get_element_value([L],R):-!,get_element_value(L,R). -get_element_value(element(T,[],[L]),T=R):- get_element_value(L,R),!. -get_element_value(element(T,[],L),T=R):- is_list(L),!,maplist(get_element_value,L,R). -get_element_value(L,V):- is_list(L),!,maplist(get_element_value,L,V). -get_element_value(L,v(L)). - -finish_feature_data:- - forall(feature_data(Tag, Attr, Content), - once(process_feature_data(Tag, Attr, Content))), - writeln('===================================='). +skip_over_s(E) :- + % Check if the element belongs to a predefined list of skip types. + member(E, [dbxref_id, dbxref, + db_id, library_id, library, library_feature]). +skip_over_s(X) :- + % Use `skip_over/1` for additional checks. + skip_over(X). + +%! cvt_element(+Input, -Output) is det. +% +% Converts an XML/SGML element into a simplified Prolog representation. +% This predicate processes nested elements, skips certain types of content, +% and extracts atomic values when possible. +% +% @arg Input The input to be converted, which can be an element, list, or atomic value. +% @arg Output The resulting simplified Prolog representation of the input. +% +% @example +% % Convert an element containing a nested structure. +% ?- cvt_element(element(tag, [], [element(subtag, [], ['Value'])]), Result). +% Result = tag=subtag='Value'. +% +% % Convert a list of elements. +% ?- cvt_element([element(tag, [], ['A']), element(tag, [], ['B'])], Result). +% Result = [tag='A', tag='B']. +% +cvt_element(List, Val) :- + % If the input is a list, process each element recursively. + is_list(List), !,maplist(cvt_element, List, Val). +cvt_element(element(Tag, [], [element(CVTerm, [], L)]), TagVal) :- + % Skip over specific terms (e.g., featureprop, dbxref) and process nested content. + skip_over_s(CVTerm), !,cvt_element(element(Tag, [], L), TagVal). +cvt_element(element(CVTerm, [], [Atomic]), Val) :- + % Skip over certain terms and extract an atomic value. + skip_over_s(CVTerm), !,cvt_element(Atomic, Val). +cvt_element(element(CVTerm, [], Atomic), Val) :- + % Skip over specific tags and directly process the atomic content. + skip_over(CVTerm), !,cvt_element(Atomic, Val). +cvt_element(element(Tag, [], [element(T, A, L)]), Tag = Val) :- + % Process a nested element with its tag, attributes, and list of values. + !,cvt_element(element(T, A, L), Val). +cvt_element(element(Tag, [], [Atomic]), Tag = Atomic) :- + % Process a single atomic value within an element. + !. +cvt_element(element(Tag, [], List), Tag = Val) :- + % Process a list of nested elements and extract their values. + !,cvt_element(List, Val). +cvt_element(Val, Val). +% Default case: return the input value as is. +%! get_content(+Tags, +Input, -Result) is det. +% +% Recursively extracts content from nested elements based on a sequence of tags. +% The predicate searches through lists and elements to match the desired tags. +% +% @arg Tags A list of tag names to follow in sequence. +% @arg Input The current list or element being inspected. +% @arg Result The extracted content matching the tag sequence. +% +% @example +% ?- get_content([cv, name], element(cv, [], [element(name, [], ['Value'])]), Result). +% Result = 'Value'. +% +get_content([], R, R) :- !. % Base case: no tags left, unify with the current result. +get_content([S | Tags], L, R) :- + % If the input is a list, check each element recursively. + is_list(L), + member(E, L), + get_content([S | Tags], E, R), !. +get_content([S | Tags], element(S, _, L), R) :- + % If the current element matches the tag, process its content. + get_content(Tags, L, R), !. +get_content(STags, element(_, _, L), R) :- + % Fallback case: check the content of other elements for matching tags. + member(C, L), + get_content(STags, C, R), !. + +%! get_element_value_each(+Element, -Output) is det. +% +% Processes an element to extract its value. If the element contains sub-elements, +% it triggers `try_begin/3` for additional processing. +% +% @arg Element The XML/SGML element to process. +% @arg Output The extracted value or term. +% +% @example +% ?- get_element_value_each(element(node, [], [element(name, [], ['A'])]), Output). +% Output = node=name='A'. +% +get_element_value_each(element(R, [], List), Out) :- + % If the list contains nested elements, trigger try_begin and extract value. + \+ \+ member(element(_, _, _), List), % Double negation ensures safe checking. + try_begin(R, [], List), + get_element_value(element(R, [], List), Out). +get_element_value_each(R, Out) :- + % Directly process the input if it doesn't contain nested elements. + get_element_value(R, Out), !. + +%! get_element_value(+Input, -Output) is det. +% +% Extracts values from an element or list of elements. +% Handles both atomic values and nested elements recursively. +% +% @arg Input The input element, list, or atomic value. +% @arg Output The extracted or normalized value. +% +% @example +% ?- get_element_value(element(tag, [], ['A']), Output). +% Output = tag='A'. +% +% ?- get_element_value([element(tag, [], ['A']), element(tag, [], ['B'])], Output). +% Output = [tag='A', tag='B']. +% +get_element_value([L], R) :- + % If input is a list with one element, process it recursively. + !, get_element_value(L, R). +get_element_value(element(T, [], [L]), T = R) :- + % If the element contains a single value, bind it to the tag. + get_element_value(L, R), !. +get_element_value(element(T, [], L), T = R) :- + % If the element contains a list, process each nested element. + is_list(L), !, + maplist(get_element_value, L, R). +get_element_value(L, V) :- + % If input is a list, process each element. + is_list(L), !, + maplist(get_element_value, L, V). +get_element_value(L, v(L)). % Default case: wrap the value into `v/1`. + +%! finish_feature_data is det. +% +% Finalizes feature data processing by iterating over all stored `feature_data/3` terms. +% Calls `process_feature_data/3` on each term and clears the feature data store. +% +% @example +% % Assuming feature_data(node, [id=1], 'A') is asserted: +% ?- finish_feature_data. +% ==================================== +% +finish_feature_data :- + forall( + feature_data(Tag, Attr, Content), + once(process_feature_data(Tag, Attr, Content)) + ), + writeln('===================================='). +%! sub_prop(?Name) is semidet. +% +% Succeeds if the input is a predefined sub-property name. +% Used to identify valid sub-properties when processing elements. +% +% @arg Name A valid property name (e.g., `name`, `value`). +% sub_prop(name). sub_prop(value). +%! process_feature_data(+Tag, +Attributes, +Content) is det. +% +% Processes feature data by analyzing its tag, attributes, and content. +% This predicate handles various cases such as atomic values, lists, and nested elements. +% It dynamically constructs and asserts Prolog terms based on the input. +% +% @arg Tag The tag or prefix for the feature data. +% @arg Attributes A list of name-value pairs representing attributes. +% @arg Content The content associated with the feature, which can be a list, +% an atomic value, or a nested element. +% +% @example +% ?- process_feature_data(node, [id=1], [value='NodeA']). +% node_id_value(1, 'NodeA'). +% +% ?- process_feature_data(node, [name='example'], []). +% node_name('example'). +% +% @note Commented-out clauses are preserved for potential future logic changes. +% + %process_feature_data(_,_,_). %process_feature_data(featureprop, Attr, element(T,A,B)):-!, @@ -246,289 +776,633 @@ %process_feature_data(Tag, Attr, Content):- is_list(Content),!, % maplist(process_feature_data(_, Attr), Content). + %process_feature_data(Tag, Attr, element(T,A,B)):- !, % process_feature_data(T, Attr, B). %process_feature_data(Tag, Attr, element(cvterm,A,B)):- !, % sub_prop(T), % append(Attr,A,AttrA), % process_feature_data(Tag, AttrA, B). - -process_feature_data(S, List, [Value]):- \+ compound(Value),!, - append(List,[value=Value],VList), - process_feature_data(S, VList, []). - - -process_feature_data(S, List, Nil):- Nil == [], List \==[], - must_det_ll((into_name_values(List,Ns,Vs), - atomic_list_concat([S|Ns],'_',Pred), - Assert=..[Pred|Vs],!, - afd(Assert))),!. - - - -process_feature_data(S1, List1, Content):- fail, Content\==[], is_list(Content), - maplist(elements_are_kv(S2),Content,List2), - atomic_list_concat([S1,S2],'_',SS), - append(List1,List2,List),!, - process_feature_data(SS, List, []). - -process_feature_data(S, List, Ele):- - Ele = element(S2,List2, Nil), - List==List2, S2==S, !, - process_feature_data(S, List, Nil). - -process_feature_data(S, [N=V], Content):- is_list(Content), member(element(_,_,_),Content),!, - process_feature_data(S, [N=V], []), - process_feature_data(V, [], Content). - -process_feature_data(S1, List1, Ele):- fail, - Ele = element(S2, List2, Nil), - S2\==S1, !, atomic_list_concat([S1,S2],'_',SS), - append(List1,List2,List), +process_feature_data(S, List, [Value]) :- + % Process a non-compound value by appending it to the attribute list. + \+ compound(Value), !, + append(List, [value=Value], VList), + process_feature_data(S, VList, []). +process_feature_data(S, List, Nil) :- + % Process an empty content list by dynamically constructing a term. + Nil == [], List \== [], + must_det_ll(( + % Convert attributes into names and values. + into_name_values(List, Ns, Vs), + % Concatenate tag and names into a predicate name. + atomic_list_concat([S | Ns], '_', Pred), + % Construct the term dynamically and assert it. + Assert =.. [Pred | Vs], !, + afd(Assert) + )), !. +process_feature_data(S1, List1, Content) :- + % Fail-safe clause for list-based content with nested key-value pairs. + fail, Content \== [], is_list(Content), + maplist(elements_are_kv(S2), Content, List2), + atomic_list_concat([S1, S2], '_', SS), + append(List1, List2, List), !, + process_feature_data(SS, List, []). +process_feature_data(S, List, Ele) :- + % Process an element where the attributes match the list. + Ele = element(S2, List2, Nil), + List == List2, S2 == S, !, + process_feature_data(S, List, Nil). +process_feature_data(S, [N=V], Content) :- + % Process nested content that contains additional elements. + is_list(Content), member(element(_, _, _), Content), !, + process_feature_data(S, [N=V], []), + process_feature_data(V, [], Content). +process_feature_data(S1, List1, Ele) :- + % Fail-safe clause for mismatched tags in nested elements. + fail, + Ele = element(S2, List2, Nil), + S2 \== S1, !, + atomic_list_concat([S1, S2], '_', SS), + append(List1, List2, List), %process_feature_data(S1, List1, []), process_feature_data(SS, List, Nil). +process_feature_data(Tag, Attr, Content) :- + % Process a list of elements containing further nested content. + is_list(Content), member(element(_, _, _), Content), + maplist(process_feature_data(Tag, Attr), Content). +process_feature_data(T, A, B) :- + % Debugging clause: Print the current tag, attributes, and content with a slight delay. + print(tab(T, A, B)), nl, sleep(0.1). -process_feature_data(Tag, Attr, Content):- is_list(Content), member(element(_,_,_),Content), - maplist(process_feature_data(Tag, Attr), Content). - - -process_feature_data(T, A, B):- print(tab(T,A,B)),nl,sleep(0.1). - - - - -afd(Assert):- wdmsg(Assert). - -into_name_values([],[],[]):-!. -into_name_values([N=V|List],[FN|Ns],[FV|Vs]):- - fix_name(N,FN),fix_value(V,FV),into_name_values(List,Ns,Vs). - -fix_name(N,FN):- \+ atom(N),!,FN=N. -fix_name(N,FN):- atom_concat('attr.',FFN,N),!,fix_name(FFN,FN). -%fix_name(N,FN):- atom_concat('v_',FFN,N),!,fix_name(FFN,FN). -%fix_name(N,FN):- atom_concat('n_',FFN,N),!,fix_name(FFN,FN). -%fix_name(N,FN):- atom_concat('e_',FFN,N),!,fix_name(FFN,FN). -fix_name(N,FN):- atom_concat('_',FFN,N),!,fix_name(FFN,FN). -fix_name(N,N). - -rgml:- load_graphml('CKG_N','tests/performance/knowledge_graphs/graphml_csv/cml/ckg_neighbors_cml_graph_n15612_e21425.graphml'). -rgml2:- load_graphml('&self','library/graphml/tests/*.graphml'). - -load_graphml(KB,Paths):- atom(Paths),expand_file_name(Paths,List),List\==[Paths],!,maplist(load_graphml(KB),List). -load_graphml(KB,Paths):- is_list(Paths),!,maplist(load_graphml(KB),Paths). -load_graphml(KB,Paths):- read_graphml(Paths,To),!,load_fb_graphml_read(KB,To). +%! afd(+Assert) is det. +% +% Writes a debug message for the given term. +% +% @arg Assert The term to be printed for debugging. +% +afd(Assert) :- + wdmsg(Assert). +%! into_name_values(+Pairs, -Names, -Values) is det. +% +% Splits a list of name-value pairs into separate lists of normalized names and values. +% +% @arg Pairs A list of name-value pairs (e.g., [name=val, attr.key=123]). +% @arg Names The resulting list of normalized names. +% @arg Values The resulting list of corresponding values. +% +% @example +% ?- into_name_values([name=val, attr.key=123], Ns, Vs). +% Ns = [name, key], Vs = [val, 123]. +% +into_name_values([], [], []) :- !. % Base case: empty input results in empty outputs. +into_name_values([N=V | List], [FN | Ns], [FV | Vs]) :- + % Normalize the name and value, then recurse on the remaining pairs. + fix_name(N, FN), + fix_value(V, FV), + into_name_values(List, Ns, Vs). + +%! fix_name(+Name, -FixedName) is det. +% +% Normalizes a name by removing certain prefixes (e.g., `attr.`, `_`). +% +% @arg Name The original name (atom or non-atom). +% @arg FixedName The normalized name. +% +% @example +% ?- fix_name('attr.name', FN). +% FN = name. +% ?- fix_name('_key', FN). +% FN = key. +% +fix_name(N, FN) :- + \+ atom(N), !, FN = N. % If the name is not an atom, return it unchanged. +fix_name(N, FN) :- + atom_concat('attr.', FFN, N), !, fix_name(FFN, FN). % Remove 'attr.' prefix. +%fix_name(N, FN):- atom_concat('v_', FFN, N),!, fix_name(FFN, FN). +%fix_name(N, FN):- atom_concat('n_', FFN, N),!, fix_name(FFN, FN). +%fix_name(N, FN):- atom_concat('e_', FFN, N),!, fix_name(FFN, FN). +fix_name(N, FN) :- + atom_concat('_', FFN, N), !, fix_name(FFN, FN). % Remove leading '_'. +fix_name(N, N). % Default case: return the name unchanged. + +%! rgml is det. +% +% Loads a specific GraphML file for testing and performance analysis. +% +% This predicate uses a predefined path to a knowledge graph stored as GraphML. +% +% @example +% ?- rgml. +% +rgml :- + load_graphml('CKG_N', 'tests/performance/knowledge_graphs/graphml_csv/cml/ckg_neighbors_cml_graph_n15612_e21425.graphml'). +%! rgml2 is det. +% +% Loads multiple GraphML files for testing purposes. +% +% This predicate uses wildcard paths to load multiple GraphML files. +% +% @example +% ?- rgml2. +% +rgml2 :- load_graphml('&self', 'library/graphml/tests/*.graphml'). +%! load_graphml(+KB, +Paths) is det. +% +% Loads GraphML files from the specified paths and processes them into the database. +% Supports single files, wildcard patterns, and lists of file paths. +% +% @arg KB A knowledge base or identifier for processing. +% @arg Paths The file path, wildcard, or list of file paths to load. +% +% @example +% ?- load_graphml(kb_name, 'path/to/file.graphml'). +% ?- load_graphml(kb_name, '*.graphml'). +% +load_graphml(KB, Paths) :- + % If Paths is an atom with wildcards, expand it into a list of file names. + atom(Paths),expand_file_name(Paths, List),List \== [Paths], !,maplist(load_graphml(KB), List). +load_graphml(KB, Paths) :- + % If Paths is already a list, process each file in the list. + is_list(Paths), !,maplist(load_graphml(KB), Paths). +load_graphml(KB, Paths) :- + % Otherwise, read the GraphML file and process its content. + read_graphml(Paths, To), !,load_fb_graphml_read(KB, To). %! dump_graph(+File_basename:atom) is det -% Read the file File_basename.graphml and write the parsed structure into File_basename.pl % -% @arg File_basename base-name filename without its file extension +% Read the file File_basename.graphml and write the parsed structure into File_basename.pl +% +% Reads a GraphML file, parses its structure, and writes the parsed representation +% into a corresponding Prolog file. The output file has the same base name with +% the `.pl` extension. +% +% @arg File_basename The base name of the GraphML file (without the `.graphml` extension). +% +% @example +% % Given a file 'example.graphml', this writes 'example.pl' with the parsed content: +% ?- dump_graph('example'). +% +% @note +% The parsed GraphML structure is printed in Prolog's canonical form into the `.pl` file. +% dump_graph(Base_name) :- + % Generate the full path to the GraphML file by appending the extension. atomic_list_concat([Base_name, '.graphml'], Graphfile), + % Generate the full path to the output Prolog file. atomic_list_concat([Base_name, '.pl'], PLfile), + % Load the GraphML file into memory as an HTML/XML structure. load_html(Graphfile, Graphml, []), + % Open the Prolog output file for writing. open(PLfile, write, Out), - print_term(Graphml, [output(Out)]), - writeln(Out, '.'), - flush_output(Out), + % Write the GraphML structure to the file in a readable Prolog term format. + print_term(Graphml, [output(Out)]), + % Ensure the output is terminated properly with a period. + writeln(Out, '.'), + % Flush the output buffer to ensure all data is written to disk. + flush_output(Out), + % Close the output file to finalize writing. close(Out). - %! run(+File_basename:atom) is det -% Read the file File_basename.graphml and print the corresponding list of terms % -% @arg File_basename base-name filename without its file extension +% Reads a GraphML file, parses its structure, and prints the corresponding list of terms. +% This is useful for debugging or examining the parsed representation of the GraphML file. +% +% @arg File_basename The base name of the GraphML file (without the `.graphml` extension). +% +% @example +% % Read and print the content of 'example.graphml': +% ?- run('example'). +% [node_prop(node1, label, 'Node A'), edge_prop(node1, node2, label, 'Edge A')]. +% run(Base_name) :- + % Parse the GraphML file into a list of terms. read_graphml(Base_name, Term_list), + % Print the parsed terms in a readable format. print_term(Term_list, []), !. - -%! new_node(Node_dict) is det. -% defines the structure of a node dict +%! new_node(-Node_dict) is det. +% +% Defines the structure of a node dictionary. +% Nodes are represented as `node{id, label, description}` where: +% - `id` is the node identifier. +% - `label` is the human-readable label for the node. +% - `description` provides additional descriptive text. +% +% @arg Node_dict A dictionary structure representing a node. +% +% @example +% ?- new_node(Node). +% Node = node{id:_, label:_, description:_}. +% new_node(node{id:_, label:_, description:_}). -%! new_edge(Edge_dict) is det. -% defines the structure of an edge dict +%! new_edge(-Edge_dict) is det. +% +% Defines the structure of an edge dictionary. +% Edges are represented as `edge{id, source_id, target_id, label}` where: +% - `id` is the edge identifier. +% - `source_id` is the ID of the source node. +% - `target_id` is the ID of the target node. +% - `label` is the label describing the edge. +% +% @arg Edge_dict A dictionary structure representing an edge. +% +% @example +% ?- new_edge(Edge). +% Edge = edge{id:_, source_id:_, target_id:_, label:_}. +% new_edge(edge{id:_, source_id:_, target_id:_, label:_}). - %! graphml_term_list(++Graph_element:term, -Term_list:list) is det -% Term_list is the list of terms for Graph_element % -% @arg Graph_element term of the form element(graphml, _Graphml_prop_list, Element_list) -% @arg Term_list list of corresponding list of terms for the given graph. -graphml_term_list( element(graphml, _Graphml_prop_list, Element_list), Term_list ) :- +% Term_list is the list of terms for Graph_element. +% +% Converts a GraphML element into a list of Prolog terms. +% This predicate extracts nodes and edges from a GraphML structure, processes them, +% and generates a corresponding list of simplified terms. +% +% @arg Graph_element A term representing the entire GraphML document. +% It has the structure `element(graphml, _, Element_list)`, where: +% - `Element_list` contains the graph and its components. +% @arg Term_list A list of terms representing the nodes and edges in the graph. +% +% @example +% % Example input structure: +% ?- graphml_term_list(element(graphml, [], [ +% element(graph, [], [ +% element(node, [id=node1], []), +% element(edge, [source=node1, target=node2], []) +% ]) +% ]), Terms). +% Terms = [node(...), edge(...)]. +% +graphml_term_list(element(graphml, _Graphml_prop_list, Element_list), Term_list) :- + % Extract the keys (attribute mappings) from the GraphML elements. keys(Element_list, Key_list), + % Find the 'graph' element containing the nodes and edges. memberchk(element(graph, _Graph_prop_list, Graph_element_list), Element_list), + % Process the graph's element list to extract terms for nodes and edges. element_list_term_list(Graph_element_list, Key_list, Term_list). - %! element_list_term_list(++Element_list:list, ++Attr_key_list:list, -Term_list:list) is det -% Term_list is the list of terms that corresponds to Element_list -% given the list of attribute keys Attr_key_list % -% @arg Element_list list of graph elements -% @arg Attr_key_list list of key(From, Attr, Key) -% @arg Term_list list of terms extracted from the Element_list +% Term_list is the list of terms that corresponds to Element_list given the list of attribute keys Attr_key_list. +% +% Converts a list of GraphML elements into a list of Prolog terms. +% This predicate processes each element in `Element_list`, using the provided +% attribute keys in `Attr_key_list` to extract relevant node or edge terms. +% +% @arg Element_list A list of graph elements (e.g., nodes and edges). +% @arg Attr_key_list A list of key mappings in the form `key(From, Attr, Key)`. +% These keys map attributes like labels and descriptions to GraphML elements. +% @arg Term_list The resulting list of Prolog terms representing nodes and edges. +% +% @example +% % Example input: +% ?- element_list_term_list( +% [element(node, [id=node1], []), element(edge, [source=node1, target=node2], [])], +% [key(node, label, key_label), key(edge, label, key_edge_label)], +% Terms). +% Terms = [node(id=node1), edge(source=node1, target=node2)]. +% element_list_term_list(Element_list, Attr_key_list, Term_list) :- + % Use findall/3 to collect terms for all elements in Element_list. findall( Term, ( + % For each element in Element_list, process it into a term. member(Element, Element_list), graph_element_term(Element, Attr_key_list, Term) ), Term_list ). - %! graph_element_term( ++Element:term, ++Attr_key_list:list, -Term ) is det -% Term is the term that corresponds to Element. % -% @arg Element graph element -% @arg Attr_key_list list of element attribute keys of the form key(From, Attr, Key) -% @arg Term term corresponding to Element - -% node(Node_id:atom, Node_label:string, Node_description:string) +% Term is the term that corresponds to Element. +% +% Converts a GraphML element into a corresponding Prolog term. +% This predicate processes both `node` and `edge` elements. For nodes, +% it extracts the `id`, `label`, and `description` attributes. +% +% @arg Element A GraphML element, such as `node` or `edge`, represented as a Prolog term. +% @arg Attr_key_list A list of keys used to map attributes within the GraphML structure. +% Keys are of the form `key(From, Attr, Key)`, where: +% - `From` specifies the type (e.g., `node` or `edge`). +% - `Attr` is the attribute name. +% - `Key` is the unique identifier for the attribute. +% @arg Term The resulting Prolog term representing the element. +% +% @example +% % Example input and output for a node element: +% ?- graph_element_term( +% element(node, [id=node1], []), +% [key(node, description, key_desc), key(node, label, key_label)], +% Term +% ). +% Term = node{id=node1, label='', description=''}. +% graph_element_term( - element(node, Node_props, Node_elements), - Attr_key_list, - Node -) :- !, + element(node, Node_props, Node_elements), % Match a 'node' element. + Attr_key_list, % List of keys for mapping attributes. + Node % Output term. +) :- + !, % Cut to ensure this clause handles only 'node' elements. + % Extract the node ID from the properties. memberchk(id=Node_id, Node_props), + % Extract the node description using helper predicate. node_description(Node_elements, Node_description, Attr_key_list), + % Extract the node label using helper predicate. node_label(Node_elements, Node_label, Attr_key_list), + % Initialize a new node dictionary structure. new_node(Node), - Node.id = Node_id, Node.label = Node_label, Node.description = Node_description. - - + % Assign extracted values to the node dictionary. + Node.id = Node_id, + Node.label = Node_label, + Node.description = Node_description. % edge(Edge_id:atom, Source_id:atom, Target_id:atom, Edge_label:string) graph_element_term( - element(edge, Edge_props, Edge_elements), - Attr_key_list, - Edge -) :- !, + element(edge, Edge_props, Edge_elements), % Match an 'edge' element. + Attr_key_list, % List of attribute keys for mapping labels. + Edge % Output term. +) :- + !, % Cut to ensure this clause handles only 'edge' elements. + % Extract the edge ID from the properties. memberchk(id=Edge_id, Edge_props), + % Extract the source node ID from the properties. memberchk(source=Source_id, Edge_props), + % Extract the target node ID from the properties. memberchk(target=Target_id, Edge_props), + % Extract the edge label using a helper predicate. edge_label(Edge_elements, Edge_label, Attr_key_list), + % Initialize a new edge dictionary structure. new_edge(Edge), - Edge.id = Edge_id, Edge.source_id = Source_id, Edge.target_id = Target_id, Edge.label = Edge_label. - + % Assign extracted values to the edge dictionary. + Edge.id = Edge_id, + Edge.source_id = Source_id, + Edge.target_id = Target_id, + Edge.label = Edge_label. %! node_description(++Node_element_list:list, -Node_description:string, ++Attr_key_list) is det -% Node_description is the node description found in Node_element_list -% where Attr_key_list is used to % -% @arg Node_element_list list of elements describing the node -% @arg Node_description description for the node -% @arg Attr_key_list list of attribute keys to be used for reference +% Extracts the description of a node from a list of node elements. +% The description is identified using the attribute key provided in `Attr_key_list`. +% If no description is found, it defaults to an empty string. +% +% @arg Node_element_list A list of elements describing the node (parsed GraphML content). +% @arg Node_description The resulting description for the node as a string. +% @arg Attr_key_list A list of keys mapping attributes in the form `key(From, Attr, Key)`. +% +% @example +% % Example input with a description key in the attribute list: +% ?- node_description( +% [element(data, [key=key_desc], ['Node description'])], +% Desc, +% [key(node, description, key_desc)] +% ). +% Desc = 'Node description'. +% +% % Example input where no description is present: +% ?- node_description([], Desc, [key(node, description, key_desc)]). +% Desc = "". +% node_description(Node_element_list, Node_description, Attr_key_list) :- + % Find the description key for nodes in the attribute key list. memberchk(key(node, description, Key_node_description), Attr_key_list), - data(Key_node_description, Node_element_list, [Node_description]), !. - -node_description(_, "", _). - + % Search for the data element corresponding to the description key and extract its value. + data(Key_node_description, Node_element_list, [Node_description]), + !. % Succeed once the description is found. +node_description(_, "", _). % Default case: if no description is found, return an empty string. %! node_label(++Node_element_list:list, -Node_label:string, ++Attr_key_list:list) is det -% Node_label is the node label found in Node_element_list -% where Attr_key_list is used to % -% @arg Node_element_list list of elements describing the node -% @arg Node_label label for the node -% @arg Attr_key_list list of attribute keys to be used for reference +% Node_label is the node label found in Node_element_list. +% +% Extracts the label of a node from a list of node elements. +% The label is identified using the attribute key provided in `Attr_key_list`. +% If no label is found, it defaults to an empty string. +% +% @arg Node_element_list A list of elements describing the node (parsed GraphML content). +% @arg Node_label The resulting label for the node as a string. +% @arg Attr_key_list A list of keys mapping attributes in the form `key(From, Attr, Key)`. +% +% @example +% % Example input with a nodegraphics key and NodeLabel element: +% ?- node_label( +% [element(data, [key=key_nodegraphics], [ +% element('y:ImageNode', [], [ +% element('y:NodeLabel', [], ['Node Label']) +% ]) +% ])], +% Label, +% [key(node, nodegraphics, key_nodegraphics)] +% ). +% Label = 'Node Label'. +% +% % Example input where no label is present: +% ?- node_label([], Label, [key(node, nodegraphics, key_nodegraphics)]). +% Label = "". +% node_label(Node_element_list, Node_label, Attr_key_list) :- + % Find the 'nodegraphics' key for nodes in the attribute key list. memberchk(key(node, nodegraphics, Key_nodegraphics), Attr_key_list), ( + % Retrieve the 'nodegraphics' data element for the key. data(Key_nodegraphics, Node_element_list, Nodegraphics_elements), - member(element('y:ImageNode', _Image_props, Image_elements ), Nodegraphics_elements), + % Search for the 'y:ImageNode' element containing graphics definitions. + member(element('y:ImageNode', _Image_props, Image_elements), Nodegraphics_elements), + % Extract the 'y:NodeLabel' content as the node label. member(element('y:NodeLabel', _Label_props, [Node_label]), Image_elements) ; + % Default case: if no label is found, set Node_label to an empty string. Node_label = "" ), !. -%! edge_label(Edge_element_list, Edge_label, Attr_key_list). -% Edge_label is the edge label found in Edge_element_list -% where Attr_key_list is used to +%! edge_label(+Edge_element_list, -Edge_label, +Attr_key_list) is det. +% +% Edge_label is the edge label found in Edge_element_list. +% +% Extracts the label of an edge from a list of edge elements. +% The label is identified using the attribute key provided in `Attr_key_list`. +% If no label is found, it defaults to an empty string. +% +% @arg Edge_element_list A list of elements describing the edge (parsed GraphML content). +% @arg Edge_label The resulting label for the edge as a string. +% @arg Attr_key_list A list of keys mapping attributes in the form `key(From, Attr, Key)`. +% +% @example +% % Example input with an edgegraphics key and EdgeLabel element: +% ?- edge_label( +% [element(data, [key=key_edgegraphics], [ +% element('y:PolyLineEdge', [], [ +% element('y:EdgeLabel', [], ['Edge Label']) +% ]) +% ])], +% Label, +% [key(edge, edgegraphics, key_edgegraphics)] +% ). +% Label = 'Edge Label'. +% +% % Example input where no label is present: +% ?- edge_label([], Label, [key(edge, edgegraphics, key_edgegraphics)]). +% Label = ''. % -% @arg Edge_element_list list of elements describing the node -% @arg Edge_label label for the node -% @arg Attr_key_list list of attribute keys to be used for reference edge_label(Edge_element_list, Edge_label, Attr_key_list) :- + % Find the 'edgegraphics' key for edges in the attribute key list. memberchk(key(edge, edgegraphics, Key_edgegraphics), Attr_key_list), ( + % Retrieve the 'edgegraphics' data element for the key. data(Key_edgegraphics, Edge_element_list, Edgegraphics_elements), + % Locate a graphic element type containing edge graphics. member(element(_Graphic_type, _Graphic_type_props, Graphic_type_elements), Edgegraphics_elements), + % Extract the 'y:EdgeLabel' content from the edge graphics. member(element('y:EdgeLabel', _Label_props, Label_elements), Graphic_type_elements), + % Extract the label content and normalize spacing. member(Edge_label_1, Label_elements), - normalize_space(atom(Edge_label),Edge_label_1) + normalize_space(atom(Edge_label), Edge_label_1) ; + % Default case: if no label is found, set Edge_label to an empty string. Edge_label = '' ), !. - %! data(+Key_id:atom, ++Element_list:list, -Sub_element_list:list) is nondet -% Sub_element_list is the list of sub_elements -% of an element within Element_list -% of type 'data' and key=Key_id % -% @arg Key_id of the data searched for -% @arg Element_list list of elements among which to search for a data element -% @arg Sub_element_list content of the data element in Element_list with the given Key_id +% Sub_element_list is the list of sub_elements. +% +% Finds the content of a `data` element with a specific key from a list of elements. +% This predicate searches through `Element_list` for elements of type `data` +% that have a `key` attribute matching `Key_id`, and unifies their content with `Sub_element_list`. +% +% @arg Key_id The key identifier (atom) used to locate the desired `data` element. +% @arg Element_list A list of elements (typically parsed GraphML or XML terms). +% @arg Sub_element_list The content of the matching `data` element, represented as a list of sub-elements. +% +% @example +% % Example input where a data element has a key 'key1' and associated content: +% ?- data(key1, [element(data, [key=key1], ['Some Content'])], Content). +% Content = ['Some Content']. +% +% % Example where no matching data element exists: +% ?- data(key2, [element(data, [key=key1], ['Some Content'])], Content). +% false. +% data(Key_id, Element_list, Sub_element_list) :- + % Search for an element of type 'data' in the list of elements. member(element(data, Props, Sub_element_list), Element_list), + % Ensure that the 'data' element has a 'key' attribute matching Key_id. member(key=Key_id, Props). - -%! element_attribute(?Element_type, ?Attr_name) is nondet -% Attr_name is the name of an attribute of interest for elements of type Element_type +%! element_attribute(?Element_type, ?Attr_name) is nondet. +% +% Attr_name is the name of an attribute of interest for elements of type Element_type. +% +% Defines attributes of interest for specific types of GraphML elements. +% This predicate associates `Element_type` (e.g., `node` or `edge`) with +% relevant attributes (`Attr_name`) such as graphics or descriptions. +% +% @arg Element_type The type of the element, e.g., `node` or `edge`. +% @arg Attr_name The name of the attribute associated with the element type. +% +% @example +% % Find all attributes for a node element: +% ?- element_attribute(node, Attr). +% Attr = nodegraphics ; +% Attr = description. +% +% % Check if a specific attribute belongs to an edge: +% ?- element_attribute(edge, edgegraphics). +% true. +% +% % Attempt an invalid query: +% ?- element_attribute(edge, label). +% false. % -% @arg Element_type type of element -% @arg Attr_name name of the attribute element_attribute(node, nodegraphics). element_attribute(node, description). element_attribute(edge, edgegraphics). element_attribute(edge, description). - %! keys(++Element_list:list, -Key_list:list) is det -% Key_list is the list of terms of form key(element_type, attribute_name, key_id), -% corresponding to elements in Element_list which define key_ids % -% @arg Element_list list of elements to pull keys from -% @arg Key_list list of terms of the form key(element_type, attribute_name, key_id) +% Key_list is the list of terms of form key(element_type, attribute_name, key_id), +% corresponding to elements in Element_list which define key_ids. +% +% Extracts a list of keys defined in a GraphML document. +% For each relevant element type (e.g., `node` or `edge`) and attribute name +% (e.g., `nodegraphics` or `description`), it identifies corresponding `key_id`s +% and constructs terms of the form `key(Element_type, Attribute_name, Key_id)`. +% +% @arg Element_list A list of GraphML elements to analyze for key definitions. +% @arg Key_list The resulting list of key terms in the format: +% `key(Element_type, Attribute_name, Key_id)`. +% +% @example +% % Example input with GraphML key definitions: +% ?- keys([ +% element(key, [for=node, 'attr.name'=description, id=k1], []), +% element(key, [for=edge, 'attr.name'=edgegraphics, id=k2], []) +% ], Keys). +% Keys = [key(node, description, k1), key(edge, edgegraphics, k2)]. +% keys(Elements, Keys) :- + % Use findall/3 to collect all matching key terms. findall( - key(For, Attr, Key_id), + key(For, Attr, Key_id), % Define the term structure to collect. ( + % Ensure the element type (For) and attribute name (Attr) are valid. element_attribute(For, Attr), + % Retrieve the key_id corresponding to the element type and attribute name. key(Elements, For, Attr, Key_id) ), Keys ). - %! key(++Element_list:list, +Element_type:atom, +Attr_name:atom, -Key_id:atom) is det -% Key_id is used for the Attr_name of the Element_type. % -% @arg Element_list list of graphml elements -% @arg Element_type type of element -% @arg Attr_name name of the attribute -% @arg Key_id used for the corresponding Element_type and Attr_name +% Key_id is used for the Attr_name of the Element_type. +% +% Extracts the `Key_id` corresponding to a specific `Element_type` and `Attr_name` +% from a list of GraphML `key` elements. The `key` elements provide metadata for +% nodes or edges, such as attributes and their corresponding identifiers. +% +% @arg Element_list A list of GraphML elements to search for key definitions. +% @arg Element_type The type of element to match (e.g., `node` or `edge`). +% @arg Attr_name The name of the attribute to locate (e.g., `description` or `nodegraphics`). +% @arg Key_id The key ID (atom) associated with the given `Element_type` and `Attr_name`. +% +% @example +% % Example input where keys for nodes and edges are defined: +% ?- key([ +% element(key, [for=node, 'attr.name'=description, id=k1], []), +% element(key, [for=edge, 'yfiles.type'=edgegraphics, id=k2], []) +% ], node, description, Key_id). +% Key_id = k1. +% +% % Example with edge and edgegraphics: +% ?- key([ +% element(key, [for=edge, 'yfiles.type'=edgegraphics, id=k2], []) +% ], edge, edgegraphics, Key_id). +% Key_id = k2. +% key(Element_list, Element_type, Attr_name, Key_id) :- + % Find a 'key' element in the list of elements. member(element(key, Key_props, _), Element_list), + % Ensure the 'for' attribute matches the given Element_type. member(for=Element_type, Key_props), + % Check if the attribute matches either 'attr.name' or 'yfiles.type'. ( member('attr.name'=Attr_name, Key_props) ; member('yfiles.type'=Attr_name, Key_props) ), + % Extract the ID of the key. member(id=Key_id, Key_props), - !. - + !. % Cut to ensure only the first matching key is returned. % :- rgml. - From f658a384320806e0591a3ce54a400fd1b18f83a7 Mon Sep 17 00:00:00 2001 From: AdrickTench Date: Wed, 18 Dec 2024 16:36:18 -0600 Subject: [PATCH 10/42] doc for type-check symbol --- prolog/metta_lang/stdlib_mettalog.metta | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/prolog/metta_lang/stdlib_mettalog.metta b/prolog/metta_lang/stdlib_mettalog.metta index 3bfb94a1a90..45bb95eb2ba 100644 --- a/prolog/metta_lang/stdlib_mettalog.metta +++ b/prolog/metta_lang/stdlib_mettalog.metta @@ -97,8 +97,11 @@ (= (If False $then) (let $n 0 (let $n 1 $n))) (= (If $cond $then $else) (if $cond $then $else)) -(iz predicate-arity MeTTaLog) +(@doc type-check + (@desc "The value of type-check determines MeTTa's type-checking behavior. Set via pragma!. When set to auto (i.e. !(pragma! type-check auto)), types are checked immediately on adding an expression to the space. By default, when unset (or set to anything other than auto), types are checked only on evaluation. For example !(+ 1 \"2\") would trigger a type violation, but (= (foo $x) (+ $x \"2\")) would not, unless type-check is set to auto, in which case both would trigger type violations.")) +(: type-check Symbol) +(iz predicate-arity MeTTaLog) (@doc predicate-arity (@desc "Specifies the arity (number of arguments) for a given predicate, allowing it to be queriable in the system's match framework. This is particularly useful for enabling built-in functions, such as `size-atom`, to be used as predicates in declarative contexts and run in reverse to compute inputs based on outputs. From dfbc560f8fc628e2d92441e32af93c638612093c Mon Sep 17 00:00:00 2001 From: logicmoo Date: Wed, 18 Dec 2024 23:09:44 -0800 Subject: [PATCH 11/42] return_only_first_type :- fail --- prolog/metta_lang/metta_types.pl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/prolog/metta_lang/metta_types.pl b/prolog/metta_lang/metta_types.pl index 9235a11d44a..60cc59dd6e8 100755 --- a/prolog/metta_lang/metta_types.pl +++ b/prolog/metta_lang/metta_types.pl @@ -452,7 +452,7 @@ % % Succeeds if only the first matching type should be returned. % -return_only_first_type :- +return_only_first_type :- fail, % Check if the flag is set to true. true_flag. From b347967acbbd05ed37851aee673e968218ff684d Mon Sep 17 00:00:00 2001 From: logicmoo Date: Wed, 18 Dec 2024 23:10:47 -0800 Subject: [PATCH 12/42] gettign ready to use top instead of self --- prolog/metta_lang/metta_interp.pl | 20 +++++++++++++++----- 1 file changed, 15 insertions(+), 5 deletions(-) diff --git a/prolog/metta_lang/metta_interp.pl b/prolog/metta_lang/metta_interp.pl index 3b62fa5b6f4..b2fe793540c 100755 --- a/prolog/metta_lang/metta_interp.pl +++ b/prolog/metta_lang/metta_interp.pl @@ -1439,26 +1439,36 @@ % \+ \+ metta_atom_asserted('&corelib',[=,[F|_]|_]), write_src_uo([H,A|T]). -/* -should_inherit_op_from_corelib('='). + +is_code_inheritor(KB):- current_self(KB). % code runing from a KB can see corlib +%should_inherit_op_from_corelib('='). should_inherit_op_from_corelib(':'). should_inherit_op_from_corelib('@doc'). %should_inherit_op_from_corelib(_). -*/ + metta_atom_asserted('&self','&corelib'). metta_atom_asserted('&self','&stdlib'). +metta_atom_asserted('top','&corelib'). +metta_atom_asserted('top','&stdlib'). metta_atom_asserted('&stdlib','&corelib'). metta_atom_asserted('&flybase','&corelib'). metta_atom_asserted('&catalog','&corelib'). metta_atom_asserted('&catalog','&stdlib'). -/* +maybe_resolve_space_dag(Var,[XX]):- var(Var),!, \+ attvar(Var), freeze(XX,space_to_ctx(XX,Var)). +maybe_resolve_space_dag('&self',[Self]):- current_self(Self). +in_dag(X,XX):- is_list(X),!,member(XX,X). +in_dag(X,X). + +space_to_ctx(Top,Var):- nonvar(Top),current_self(Top),!,Var='&self'. +space_to_ctx(Top,Var):- 'mod-space'(Top,Var). + 'mod-space'(top,'&self'). 'mod-space'(catalog,'&catalog'). 'mod-space'(corelib,'&corelib'). 'mod-space'(stdlib,'&stdlib'). 'mod-space'(Top,'&self'):- Top == self. -*/ + not_metta_atom_corelib(A,N):- A \== '&corelib' , metta_atom('&corelib',N). %metta_atom_asserted_fallback( KB,Atom):- metta_atom_stdlib(KB,Atom) From 574f0766904c8b19ddb96e534a8a18eb66843ed4 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Wed, 18 Dec 2024 23:11:15 -0800 Subject: [PATCH 13/42] Implemented NotReducable --- prolog/metta_lang/metta_eval.pl | 77 +++++++++++++++++---------------- 1 file changed, 39 insertions(+), 38 deletions(-) diff --git a/prolog/metta_lang/metta_eval.pl b/prolog/metta_lang/metta_eval.pl index de8842695f3..f34644a4249 100755 --- a/prolog/metta_lang/metta_eval.pl +++ b/prolog/metta_lang/metta_eval.pl @@ -169,8 +169,19 @@ eval_true(X):- eval_args(X,Y), once(var(Y) ; \+ is_False(Y)). eval(Depth,Self,X,Y):- eval('=',_,Depth,Self,X,Y). -eval(Eq,RetType,Depth,Self,X,Y):- - catch_metta_return(eval_args(Eq,RetType,Depth,Self,X,Y),Y). +eval(Eq,RetType,Depth,Self,X,O):- + eval_reducable(Eq,RetType,Depth,Self,X,eval_args(Eq,RetType,Depth,Self,X,Y),Y,O). + + +eval_reducable(Eq,RetType,Depth,Self,X,G,Y,O):- catch_metta_return(G,Y), return_x_g_y(Eq,RetType,Depth,Self,X,X,Y,O). + +return_x_g_y(_Eq,_RetType,_Depth,_Self,X,_,Y,R):- Y == 'NotReducable',!,R=X. +return_x_g_y(Eq,RetType,Depth, Self,X,M,Y,R):- M\=@=Y, !, eval_args(Eq,RetType,Depth,Self,Y,Z), return_x_g_y(Eq,RetType,Depth,Self,X,Y,Z,R). +return_x_g_y(_Eq,_RetType,_Depth,_Self,_X,_M,R,R). + +catch_metta_return(G,Y):- + catch(G,metta_return(Y),ignore(retract(thrown_metta_return(Y)))). + %:- set_prolog_flag(gc,false). /* @@ -227,8 +238,7 @@ eval_ret(Eq,RetType,Depth,Self,X,Y):- eval_00(Eq,RetType,Depth,Self,X,Y), is_returned(Y). -catch_metta_return(G,Y):- - catch(G,metta_return(Y),ignore(retract(thrown_metta_return(Y)))). + allow_repeats_eval_(_):- !. allow_repeats_eval_(_):- option_value(no_repeats,false),!. @@ -243,7 +253,7 @@ eval_00(Eq,RetType,Depth,Self,X,YO):- eval_01(Eq,RetType,Depth,Self,X,YO). eval_01(Eq,RetType,Depth,Self,X,YO):- - X\==[empty], % speed up n-queens x60 + % X\==[empty], % speed up n-queens x60 but breaks other things if_t((Depth<1, trace_on_overflow), debug(metta(eval_args))), notrace((Depth2 is Depth-1, copy_term(X, XX))), @@ -253,7 +263,7 @@ ;eval_01(Eq,RetType,Depth2,Self,M,Y)), eval_02(Eq,RetType,Depth2,Self,Y,YO))). -eval_02(Eq,RetType,Depth2,Self,Y,YO):- Y\==[empty], % speed up n-queens x60 +eval_02(Eq,RetType,Depth2,Self,Y,YO):- % Y\==[empty], % speed up n-queens x60 but breaks other things once(if_or_else((subst_args_here(Eq,RetType,Depth2,Self,Y,YO)), if_or_else((fail,finish_eval(Eq,RetType,Depth2,Self,Y,YO)), Y=YO))). @@ -268,7 +278,8 @@ % % this next one at least causes no failures and 5x speedup subst_args_here(_Eq,_RetType,_Depth2,_Self,Y,YO):- wont_need_subst(Y),!, Y=YO. subst_args_here(Eq,RetType,Depth2,Self,Y,YO):- - subst_args(Eq,RetType,Depth2,Self,Y,YO), + %subst_args(Eq,RetType,Depth2,Self,Y,YO), + Y =YO, notrace(if_t_else((wont_need_subst(Y),Y\=@=YO), (write_src_uo(needed_subst_args(Y,YO)),bt,sleep(1.0)), nop(write_src_uo(unneeded_subst_args(Y))))). @@ -1249,15 +1260,13 @@ eval_20(Eq,RetType,Depth,Self,['if',Cond,Then,Else],Res):- !, - eval_args(Eq,'Bool',Depth,Self,Cond,TF), - (is_True(TF) - -> eval_args(Eq,RetType,Depth,Self,Then,Res) + (eval_args_true(Eq,'Bool',Depth,Self,Cond) + *-> eval_args(Eq,RetType,Depth,Self,Then,Res) ; eval_args(Eq,RetType,Depth,Self,Else,Res)). eval_20(Eq,RetType,Depth,Self,['If',Cond,Then,Else],Res):- !, - eval_args(Eq,'Bool',Depth,Self,Cond,TF), - (is_True(TF) - -> eval_args(Eq,RetType,Depth,Self,Then,Res) + (eval_args_true(Eq,'Bool',Depth,Self,Cond) + *-> eval_args(Eq,RetType,Depth,Self,Then,Res) ; eval_args(Eq,RetType,Depth,Self,Else,Res)). eval_20(Eq,RetType,Depth,Self,['If',Cond,Then],Res):- !, @@ -1971,9 +1980,9 @@ (!,write_src(E),fail))),!. -empty('Empty'). -','(A,B,(AA,BB)):- eval_args(A,AA),eval_args(B,BB). -':'(A,B,[':',A,B]). +%empty('Empty'). +%','(A,B,(AA,BB)):- eval_args(A,AA),eval_args(B,BB). +%':'(A,B,[':',A,B]). '<'(A,B,TFO):- as_tf(A'(A,B,TFO):- as_tf(Atrue;S=[]. bagof_eval(_Eq,_RetType,_Dpth,_Slf,X,L):- self_eval(X),!,L=[X]. bagof_eval(_Eq,_RetType,_Dpth,_Slf,X,L):- typed_list(X,_Type,L),!. bagof_eval(Eq,RetType,Depth,Self,Funcall,L):- - bagof_ne(E, - catch_metta_return(eval_args(Eq,RetType,Depth,Self,Funcall,E),E),L). + bagof_ne(E,eval(Eq,RetType,Depth,Self,Funcall,E),L). setof_eval(Depth,Self,Funcall,L):- setof_eval('=',_RT,Depth,Self,Funcall,L). setof_eval(Eq,RetType,Depth,Self,Funcall,S):- findall_eval(Eq,RetType,Depth,Self,Funcall,L), @@ -2858,7 +2859,7 @@ ((eval_args(Eq,RetType,Depth,Self,Funcall,E)) *-> is_returned(E);(fail,E=Funcall)). -is_returned(E):- notrace( \+ is_empty(E)). +is_returned(E):- notrace( \+ is_empty(E)), nop(assertion(E \== 'NotReducable')). is_empty(E):- notrace(( nonvar(E), sub_var('Empty',E))),!. From 370cfcdc909c11a169333791fc04c4a8a6ad4240 Mon Sep 17 00:00:00 2001 From: Mike Archbold Date: Wed, 18 Dec 2024 23:29:39 -0800 Subject: [PATCH 14/42] display basic board --- examples/games/GreedyChess.metta | 157 +++++++++++++++++-------------- 1 file changed, 88 insertions(+), 69 deletions(-) diff --git a/examples/games/GreedyChess.metta b/examples/games/GreedyChess.metta index 07a7c0b1631..a83dc9fdd18 100644 --- a/examples/games/GreedyChess.metta +++ b/examples/games/GreedyChess.metta @@ -48,7 +48,14 @@ (remove-atom &self (console-messages $msg)) ; create the board for the first time (add-atom &self - (board-state ((1 1 s r) (1 2 s p) (1 3) (1 4) (1 5) (1 6) (1 7 g p) (1 8 g r) (2 1 s n) (2 2 s p) (2 3) (2 4) (2 5) (2 6) (2 7 g p) (2 8 g n) (3 1 s b) (3 2 s p) (3 3) (3 4) (3 5) (3 6) (3 7 g p) (3 8 g b) (4 1 s q) (4 2 s p) (4 3) (4 4) (4 5) (4 6) (4 7 g p) (4 8 g q) (5 1 s k) (5 2 s p) (5 3) (5 4) (5 5) (5 6) (5 7 g p) (5 8 g k) (6 1 s b) (6 2 s p) (6 3) (6 4) (6 5) (6 6) (6 7 g p) (6 8 g b) (7 1 s n) (7 2 s p) (7 3) (7 4) (7 5) (7 6) (7 7 g p) (7 8 g n) (8 1 s r) (8 2 s p) (8 3) (8 4) (8 5) (8 6) (8 7 g p) (8 8 g r))) + (board-state ((1 8 g r) (2 8 g n) (3 8 g b) (4 8 g q) (5 8 g k) (6 8 g b) (7 8 g n) (8 8 g r) + (1 7 g p) (2 7 g p) (3 7 g p) (4 7 g p) (5 7 g p) (6 7 g p) (7 7 g p) (8 7 g p) + (1 6) (2 6) (3 6) (4 6) (5 6) (6 6) (7 6) (8 6) + (1 5) (2 5) (3 5) (4 5) (5 5) (6 5) (7 5) (8 5) + (1 4) (2 4) (3 4) (4 4) (5 4) (6 4) (7 4) (8 4) + (1 3) (2 3) (3 3) (4 3) (5 3) (6 3) (7 3) (8 3) + (1 2 s p) (2 2 s p) (3 2 s p) (4 2 s p) (5 2 s p) (6 2 s p) (7 2 s p) (8 2 s p) + (1 1 s r) (2 1 s n) (3 1 s b) (4 1 s q) (5 1 s k) (6 1 s b) (7 1 s n) (8 1 s r))) ) ; indicate game has passed the initializing state (add-atom &self (console-messages (started))) @@ -60,8 +67,15 @@ (; remove the old chess board (match &self (board-state $old_board) (remove-atom &self (board-state $old_board))) ; re-create a new board - (add-atom &self - (board-state ((1 1 s r) (1 2 s p) (1 3) (1 4) (1 5) (1 6) (1 7 g p) (1 8 g r) (2 1 s n) (2 2 s p) (2 3) (2 4) (2 5) (2 6) (2 7 g p) (2 8 g n) (3 1 s b) (3 2 s p) (3 3) (3 4) (3 5) (3 6) (3 7 g p) (3 8 g b) (4 1 s q) (4 2 s p) (4 3) (4 4) (4 5) (4 6) (4 7 g p) (4 8 g q) (5 1 s k) (5 2 s p) (5 3) (5 4) (5 5) (5 6) (5 7 g p) (5 8 g k) (6 1 s b) (6 2 s p) (6 3) (6 4) (6 5) (6 6) (6 7 g p) (6 8 g b) (7 1 s n) (7 2 s p) (7 3) (7 4) (7 5) (7 6) (7 7 g p) (7 8 g n) (8 1 s r) (8 2 s p) (8 3) (8 4) (8 5) (8 6) (8 7 g p) (8 8 g r))) + (add-atom &self + (board-state ((1 8 g r) (2 8 g n) (3 8 g b) (4 8 g q) (5 8 g k) (6 8 g b) (7 8 g n) (8 8 g r) + (1 7 g p) (2 7 g p) (3 7 g p) (4 7 g p) (5 7 g p) (6 7 g p) (7 7 g p) (8 7 g p) + (1 6) (2 6) (3 6) (4 6) (5 6) (6 6) (7 6) (8 6) + (1 5) (2 5) (3 5) (4 5) (5 5) (6 5) (7 5) (8 5) + (1 4) (2 4) (3 4) (4 4) (5 4) (6 4) (7 4) (8 4) + (1 3) (2 3) (3 3) (4 3) (5 3) (6 3) (7 3) (8 3) + (1 2 s p) (2 2 s p) (3 2 s p) (4 2 s p) (5 2 s p) (6 2 s p) (7 2 s p) (8 2 s p) + (1 1 s r) (2 1 s n) (3 1 s b) (4 1 s q) (5 1 s k) (6 1 s b) (7 1 s n) (8 1 s r))) ) ; LATER ON, REMOVE THE OLD CONSOLE-MESSAGES! ; @@ -72,62 +86,29 @@ empty))))) (= (welcome) - ((writeln! " ") (writeln! " ") (writeln! " ") (writeln! " ") - (writeln! 'M E T T A G R E E D Y C H E S S') - (writeln! " ") - (writeln! 'This program is intended as a MeTTa exercise.') - ; board(A), b(A), - (writeln! '******* I N S T R U C T I O N S ********') - (writeln! " ") - (writeln! '- Your pieces are marked with an asterisk') - (writeln! '- Please take note of the following simple commands:') - (writeln! '-------- C o m m a n d s -----------') - (writeln! '1) TO MOVE YOUR PIECE USE (example) -> !(m 1 2 1 3)') - (writeln! ' Result: YOUR pawn in 1,2 moved to location 1,3 based on standard cartesian x/y.') - (writeln! '2) Move MeTTa Greedy Chess -> !(g)') - (writeln! '3) Reset -> !(r)') - (writeln! '4) Commands List -> !(c)') - (writeln! '5) Display Board -> !(d)') - (writeln! 'You may now enter your move !(m x1 y1 x2 y2) command.'))) - -!(chess) -;!(match &self (console-messages $msg) (println! $msg)) -;!(match &self (board-state $board) (println! $board)) - -;(board-state (. . . . . . . . .)) - -;(: display-board (-> Atom)) -;(= (display-board) -; ( -; (match &self (board $list) -; $list)) -; ) - -; (println! (format-args "\n -; {} | {} | {} \n -; --------- \n -; {} | {} | {} \n -; --------- \n -; {} | {} | {} \n -; " $list)))) ; Formats the board as a 3x3 grid for display. - - -;; (add-atom &self (board ((1 1 s r) (1 2 s p)))) -; -;(: chess (-> board-state Atom)) - - - ; (dynamic (/ guimessage 4)) (or (abolish board 1) True) (or (abolish guimessage 1) True) (or (abolish ;guimessage 2) True) (or (abolish guimessage 3) True) (or (abolish guimessage 4) True) #(add-atom &self #;(guimessage chess game started)) #(add-atom &self #(board ((1 1 s r) (1 2 s p) (1 3) (1 4) (1 5) (1 6) (1 7 ;g p) (1 8 g r) (2 1 s n) (2 2 s p) (2 3) (2 4) (2 5) (2 6) (2 7 g p) (2 8 g n) (3 1 s b) (3 2 s p) (3 3) (3 ;4) (3 5) (3 6) (3 7 g p) (3 8 g b) (4 1 s q) (4 2 s p) (4 3) (4 4) (4 5) (4 6) (4 7 g p) (4 8 g q) (5 1 s k) ;(5 2 s p) (5 3) (5 4) (5 5) (5 6) (5 7 g p) (5 8 g k) (6 1 s b) (6 2 s p) (6 3) (6 4) (6 5) (6 6) (6 7 g p) ;(6 8 g b) (7 1 s n) (7 2 s p) (7 3) (7 4) (7 5) (7 6) (7 7 g p) (7 8 g n) (8 1 s r) (8 2 s p) (8 3) (8 4) (8 ;5) (8 6) (8 7 g p) (8 8 g r)))) (set_prolog_flag toplevel_print_options #( :: ((quoted True) (portray ;True)) )) (welcome) (set-det)) - - -;(= (welcome) (write 'Deep Blue Dummy Chess -- Copyright 2001 Mike Archbold') (nl) (write 'This program is ;intended as a Prolog exercise') (nl) (nl) (board $A) (b $A) (write '******* I N S T R U C T I O N S ********') ;(nl) (write '- Your pieces are marked with an asterisk') (nl) (write '- Please take note of the following ;simple commands:') (nl) (nl) (write '-------- C o m m a n d s -----------') (nl) (write '1) TO MOVE YOUR PIECE ;USE (example) -> ?- m(1,2,1,3).') (nl) (write ' Result: YOUR pawn in 1,2 moved to location 1,3. Standard x/;y.') (nl) (write '2) TO MOVE DEEP BLUE DUMMY type -> ?- g.') (nl) (write '3) To reset, ;type -> ?- r.') (nl) (write '4) Display commands, type -> ?- c.') (nl) (write ;'5) Display current board type -> ?- d.') (nl) (write 'ALL COMMANDS MUST BE TERMINATED WITH A PERIOD ;AND NO SPACES.') (nl) (write 'You may now enter your move (m) command') (nl)) + ; write welcome banner to console and call display_board to print the pieces + ((println! " ") (println! " ") (println! " ") (println! " ") + (println! (format-args 'M E T T A G R E E D Y C H E S S' (empty))) + (println! " ") + (println! (format-args 'This program is a MeTTa exercise which takes the best immediate move without planning far ahead.' + (empty))) + (display_board (match &self (board-state $board) $board)) + (println! (format-args '******* I N S T R U C T I O N S ********' (empty))) + (println! " ") + (println! (format-args '- Your pieces are marked with an asterisk.' (empty))) + (println! (format-args '- Please take note of the following simple commands:' (empty))) + (println! (format-args '-------- C o m m a n d s -----------' (empty))) + (println! (format-args '1) TO MOVE YOUR PIECE USE (example) -> !(m 1 2 1 3)' (empty))) + (println! (format-args ' Result: YOUR pawn in 1,2 moved to location 1,3 based on standard cartesian x/y.' (empty))) + (println! (format-args '2) Move MeTTa Greedy Chess -> !(g)' (empty))) + (println! (format-args '3) Reset -> !(r)' (empty))) + (println! (format-args '4) Commands List -> !(c)' (empty))) + (println! (format-args '5) Display Board -> !(d)' (empty))) + (println! (format-args 'You may now enter your move !(m x1 y1 x2 y2) command.' (empty))))) -;!(display-board) -; -; -;(= (r) -; (chess)) +(= (r) + (chess)) ; ; ;(= (c) (write '-------- C o m m a n d s -----------') (nl) (write '1) TO MOVE YOUR PIECE USE (example) -> ?- m;(1,2,1,3).') (nl) (write ' Result: YOUR piece in 1,2 moved to location 1,3. Standard x/y.') (nl) (write '2) ;TO MOVE DEEP BLUE DUMMY type -> ?- g.') (nl) (write '3) To reset, type -> ?- r.') (nl) ;(write '4) Display commands, type -> ?- c.') (nl) (write '5) Display current board type -> ?;- d.') (nl) (write 'ALL COMMANDS MUST BE TERMINATED WITH A PERIOD!') (nl)) @@ -140,17 +121,51 @@ ;(= (d) (board $A) (b $A) (set-det)) ; ; -;(= (b $A) (write 1 2 3 4 5 6 7 8) (nl) (write -------------------------) (nl) (write_box 1 8 $A)) -; -; -;(= (write_box $A 0 $B) (nl) (write -------------------------) (nl) (write 1 2 3 4 5 6 7 8) (nl) ;(nl) (nl) (nl)) -;(= (write_box $A $B $C) (= $A 1) (return_entire_box #( :: ($A $B) ) $D $C) (len $D 2) (write $B) (write | ) ;(is $E (+ $A 1)) (write_box $E $B $C)) -;(= (write_box $A $B $C) (< $A 8) (return_entire_box #( :: ($A $B) ) $D $C) (len $D 2) (write | ) (is $E (+ $A ;1)) (write_box $E $B $C)) -;(= (write_box $A $B $C) (= $A 8) (return_entire_box #( :: ($A $B) ) $D $C) (len $D 2) (write |) (write | ) ;(write $B) (is $E (- $B 1)) (or (, (> $B 1) (nl) (write -------------------------) (nl)) True) (write_box 1 ;$E $C)) -;(= (write_box $A $B $C) (< $A 8) (return_entire_box #( :: ($A $B) ) $D $C) (len $D 4) (nth1 3 $D g) (nth1 4 $D ;$E) (or (, (= $A 1) (write $B) (write |)) (write |)) (write ' ') (write $E) (is $F (+ $A 1)) (write_box $F ;$B $C)) -;(= (write_box $A $B $C) (< $A 8) (return_entire_box #( :: ($A $B) ) $D $C) (len $D 4) (nth1 3 $D s) (nth1 4 $D ;$E) (or (, (= $A 1) (write $B) (write |)) (write |)) (write *) (write $E) (is $F (+ $A 1)) (write_box $F $B ;$C)) -;(= (write_box $A $B $C) (= $A 8) (return_entire_box #( :: ($A $B) ) $D $C) (len $D 4) (nth1 3 $D g) (nth1 4 ;$D $E) (write |) (write ' ') (write $E) (write | ) (write $B) (is $F (- $B 1)) (= $G 1) (or (, (> $F 0) (nl) ;(write -------------------------) (nl)) True) (write_box $G $F $C)) -;(= (write_box $A $B $C) (= $A 8) (return_entire_box #( :: ($A $B) ) $D $C) (len $D 4) (nth1 3 $D s) (nth1 4 ;$D $E) (write |) (write *) (write $E) (write | ) (write $B) (is $F (- $B 1)) (= $G 1) (or (, (> $F 0) (nl) ;(write -------------------------) (nl)) True) (write_box $G $F $C)) +(: identify_piece (-> list string)) +(= (identify_piece $p) + (if (== (size-atom $p) 2) + " " + "*k" + ) +) + +; Input the board ($brd), output a list of board with an identifier for each piece, eg., human king is "*k." +(: display_filter (-> list list)) +(= (display_filter $brd) + (if (== (size-atom $brd) 1) + ; if on last piece + ((identify_piece $brd)) + ; otherwise convert all pieces to shorter description for display. + (let $i (display_filter (cdr-atom $brd)) (cons-atom (identify_piece (car-atom $brd)) $i)))) + +(= (display_board $board) + ( + (let $a (display_filter $board ) ()) + + (println! (format-args "\n + | {} | {} | {} | {} | {} | {} | {} | {} |\n + ---------------------------------------- \n + | {} | {} | {} | {} | {} | {} | {} | {} |\n + ---------------------------------------- \n + | {} | {} | {} | {} | {} | {} | {} | {} |\n + ---------------------------------------- \n + | {} | {} | {} | {} | {} | {} | {} | {} |\n + ---------------------------------------- \n + | {} | {} | {} | {} | {} | {} | {} | {} |\n + ---------------------------------------- \n + | {} | {} | {} | {} | {} | {} | {} | {} |\n + ---------------------------------------- \n + | {} | {} | {} | {} | {} | {} | {} | {} |\n + ---------------------------------------- \n + | {} | {} | {} | {} | {} | {} | {} | {} |\n + ---------------------------------------- \n + " + ;("r " "n " "b " " " " " "*b")) + $a) + ) ; Formats the board as a 3x3 grid for display. + ) +) + ; ; ;(= (g) (guimessage checkmate $A $B) (write 'Game over.') (nl) (set-det)) @@ -567,4 +582,8 @@ ; (+ ; (random $B) 1))) ; -; \ No newline at end of file +; + + + +!(chess) \ No newline at end of file From 7a7470acef1febd666a85a01990270ef61efcab5 Mon Sep 17 00:00:00 2001 From: StassaP Date: Thu, 19 Dec 2024 23:46:45 +0000 Subject: [PATCH 15/42] Compilation dierectives to avoid editline/readline errors on windows. * On linux, swipl uses one of two libraries to manage command line input: library(editline) or library(readline). Those libraries are not found under windows (library(editline) depends on libedit which is not compiled for windows) and SWI-Prolog uses a different mechanism to manage command line input. Mettalog expects one of the two libraries to be loaded and that causes errors to be raised at startup, on windows. The current commit avoids loading the two missing libraries and allows mettalog to be loaded without errors on windows. --- prolog/metta_lang/metta_repl.pl | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/prolog/metta_lang/metta_repl.pl b/prolog/metta_lang/metta_repl.pl index 454f5747871..50ad62bb0fb 100755 --- a/prolog/metta_lang/metta_repl.pl +++ b/prolog/metta_lang/metta_repl.pl @@ -152,6 +152,10 @@ % ?- save_history. % true. % +:- if(is_win64). +% Dummy to avoid errors on windows. +save_history. +:- else. save_history :- % Get the current input stream. current_input(Input), @@ -163,6 +167,7 @@ ; % Otherwise, do nothing. true). +:- endif. %! load_and_trim_history is det. % Loads and trims the REPL history if needed, and installs readline support. @@ -2038,12 +2043,16 @@ % This installs readline/editline support, allowing for line editing and history during input. :- dynamic(is_installed_readline_editline/1). :- volatile(is_installed_readline_editline/1). + +:- if(is_win64). +:-else. install_readline_editline :- % Get the current input stream. current_input(Input), % Install readline support for the current input. install_readline(Input), !. +:- endif. %! el_wrap_metta(+Input) is det. % From 9202a903c9fb8ff2e76ed78c2e3b907bdaea4228 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Thu, 19 Dec 2024 20:46:59 -0800 Subject: [PATCH 16/42] allow format-args to pring variables --- prolog/metta_lang/metta_eval.pl | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/prolog/metta_lang/metta_eval.pl b/prolog/metta_lang/metta_eval.pl index f34644a4249..17b72a5b63e 100755 --- a/prolog/metta_lang/metta_eval.pl +++ b/prolog/metta_lang/metta_eval.pl @@ -278,8 +278,8 @@ % % this next one at least causes no failures and 5x speedup subst_args_here(_Eq,_RetType,_Depth2,_Self,Y,YO):- wont_need_subst(Y),!, Y=YO. subst_args_here(Eq,RetType,Depth2,Self,Y,YO):- - %subst_args(Eq,RetType,Depth2,Self,Y,YO), - Y =YO, + subst_args(Eq,RetType,Depth2,Self,Y,YO), + %Y =YO, notrace(if_t_else((wont_need_subst(Y),Y\=@=YO), (write_src_uo(needed_subst_args(Y,YO)),bt,sleep(1.0)), nop(write_src_uo(unneeded_subst_args(Y))))). @@ -1547,9 +1547,12 @@ % Placeholder to deal with formatting {:} later format_args_get_format(FormatRest, FormatRest, _). -format_args_write(Arg,_) :- string(Arg), !, write(Arg). -format_args_write('#\\'(Arg),_) :- !, write(Arg). -format_args_write(Arg,_) :- write_src_woi(Arg). +format_args_write(Arg,_) :- \+ compound(Arg), !, format_arg(Arg). +format_args_write('#\\'(Char),_) :- !, format_arg(Char). +format_args_write(Arg,_) :- format_arg(Arg). + +format_arg(Arg) :- string(Arg), !, write(Arg). +format_arg(Arg):- \+ \+ write_src_woi(Arg). format_nth_args([], _, _). format_nth_args(['{','{'|FormatRest], Iterator, Args) :- !, put('{'), format_nth_args(FormatRest, Iterator, Args). % escaped From dd47500b6debfaf76e86f396b9a737cd76ddbe2e Mon Sep 17 00:00:00 2001 From: logicmoo Date: Thu, 19 Dec 2024 21:11:03 -0800 Subject: [PATCH 17/42] dont squash varnames to print variables --- prolog/metta_lang/metta_printer.pl | 34 +++++++++++++++++------------- 1 file changed, 19 insertions(+), 15 deletions(-) diff --git a/prolog/metta_lang/metta_printer.pl b/prolog/metta_lang/metta_printer.pl index 55ec7e8201a..9cae0c5d96b 100755 --- a/prolog/metta_lang/metta_printer.pl +++ b/prolog/metta_lang/metta_printer.pl @@ -148,7 +148,7 @@ % If Term is a list, apply list-specific formatting. is_list(Term), !, writeln('---------------------'), - numbervars(Term, 666, _, [attvar(bind)]), % Bind variables for display. + numbervars(Term, 666, _, [attvar(skip)]), % Bind variables for display. write((Msg)), write(':'), nl, write_src(Term), nl. ppct(Msg, Term) :- @@ -162,14 +162,14 @@ Term = (_ = _), !, writeln('---------------------'), write((Msg)), write(':'), nl, - numbervars(Term, 444, _, [attvar(bind)]), + numbervars(Term, 444, _, [attvar(skip)]), write_src(Term), nl. ppct(Msg, Term) :- % For clauses with specific formatting needs, include variable numbering and tree display. Term = (_ :- _), !, writeln('---------------------'), write((Msg)), write(':'), nl, - numbervars(Term, 222, _, [attvar(bind)]), + numbervars(Term, 222, _, [attvar(skip)]), print_tree(Term), nl. %! pp_metta(+P) is det. @@ -190,7 +190,8 @@ % pp_metta(P) :- % Standardize variable names in P for readability. - pretty_numbervars(P, PP), + %pretty_numbervars(P, PP), + P=PP, % Pretty-print PP with the `concepts=false` option. with_option(concepts=false, pp_fb(PP)). @@ -238,6 +239,8 @@ % Run the primary source-printing predicate within `run_pl_source/1`. run_pl_source(print_pl_source0(P)). +pnotrace(G):- quietly(G). + %! run_pl_source(+G) is det. % % Executes a goal `G` safely, catching any errors and attempting a retry with tracing if needed. @@ -273,13 +276,13 @@ % print_pl_source0(_) :- % Do not print if compatibility mode is enabled. - notrace(is_compatio), !. + pnotrace(is_compatio), !. print_pl_source0(_) :- % Do not print if silent loading mode is enabled. - notrace(silent_loading), !. + pnotrace(silent_loading), !. print_pl_source0(P) :- % Check if P was just printed (avoid redundant printing). - notrace((just_printed(PP), PP =@= P)), !. + pnotrace((just_printed(PP), PP =@= P)), !. print_pl_source0((A :- B)) :- % For rules (A :- B), display using portray_clause for readability. !,portray_clause((A :- B)). @@ -517,7 +520,7 @@ var(V), !, write_dvar(V), !. is_final_write('$VAR'(S)) :- % For '$VAR' structures, write the variable name S. - !, write_dvar(S), !. + !, write_dvar(S), !. is_final_write('#\\'(S)) :- % For special character format `#\S`, write S in single quotes. !, format("'~w'", [S]). @@ -710,30 +713,31 @@ % Writes the source of a term `V` with indentation enabled. % % This predicate sets indentation mode on by calling `with_indents/2` with `true`, -% and then writes the source of `V` using `write_src/1`. The use of `notrace/1` +% and then writes the source of `V` using `write_src/1`. The use of `pnotrace/1` % ensures that tracing is disabled during this operation. % % @arg V The term whose source is to be written with indentation. % write_src_wi(V) :- % Enable indentation and write the source of V. - notrace((with_indents(true, write_src(V)))). + pnotrace((with_indents(true, write_src(V)))). %! write_src(+V) is det. % % Writes the source of a term `V` after guessing Metta variables. % % This predicate first tries to identify variables in `V` using `guess_metta_vars/1` -% and then formats `V` for output using `pp_sex/1`. The `notrace/1` wrapper +% and then formats `V` for output using `pp_sex/1`. The `pnotrace/1` wrapper % ensures tracing is turned off. % % @arg V The term to be written as source. % write_src(V) :- % Guess variables in V and pretty-print using `pp_sex/1`. - \+ \+ notrace((src_vars(V, I), pp_sex(I))), !. + \+ \+ pnotrace((src_vars(V, I), pp_sex(I))), !. print_compounds_special:- true. +src_vars(V,I):- var(V),!,I=V. src_vars(V,I):- %ignore(guess_metta_vars(V)), ignore(guess_varnames(V,I)), ignore(numbervars(V,10000,_,[singleton(true),attvar(skip)])). @@ -743,14 +747,14 @@ % Writes the source of a term `Term` with indentation disabled. % % This predicate calls `with_indents/2` with `false` to disable indentation, -% and then writes `Term` using `write_src/1`. The `notrace/1` wrapper ensures +% and then writes `Term` using `write_src/1`. The `pnotrace/1` wrapper ensures % that tracing is disabled. % % @arg Term The term to be written without indentation. % write_src_woi(Term) :- % Disable indentation and write the source of Term. - notrace((with_indents(false, write_src(Term)))). + pnotrace((with_indents(false, write_src(Term)))). %! write_src_woi_nl(+X) is det. % @@ -764,7 +768,7 @@ % write_src_woi_nl(X) :- % Guess variables in X, add newlines, and write without indentation. - \+ \+ notrace(( + \+ \+ pnotrace(( format('~N'), write_src_woi(X), format('~N') )). From 6e669d2e59d4f0e7949a5e5d205983f94e736d65 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Thu, 19 Dec 2024 21:11:28 -0800 Subject: [PATCH 18/42] allow testing with --top-self --- prolog/metta_lang/metta_eval.pl | 2 +- prolog/metta_lang/metta_interp.pl | 40 ++++++++++++++++++------------- prolog/metta_lang/metta_space.pl | 2 ++ prolog/metta_lang/metta_subst.pl | 2 +- 4 files changed, 28 insertions(+), 18 deletions(-) diff --git a/prolog/metta_lang/metta_eval.pl b/prolog/metta_lang/metta_eval.pl index 17b72a5b63e..cf378f7a3de 100755 --- a/prolog/metta_lang/metta_eval.pl +++ b/prolog/metta_lang/metta_eval.pl @@ -150,7 +150,7 @@ % is_metta_declaration([F|T]):- is_list(T), is_user_defined_head([F]),!. % Sets the current self space to '&self'. This is likely used to track the current context or scope during the evaluation of Metta code. -:- nb_setval(self_space, '&self'). +%:- nb_setval(self_space, '&self'). %current_self(Space):- nb_current(self_space,Space). diff --git a/prolog/metta_lang/metta_interp.pl b/prolog/metta_lang/metta_interp.pl index b2fe793540c..b156745dfd2 100755 --- a/prolog/metta_lang/metta_interp.pl +++ b/prolog/metta_lang/metta_interp.pl @@ -368,8 +368,12 @@ :- use_module(library(shell)). %:- use_module(library(tabling)). -:- nb_setval(self_space, '&self'). -current_self(Self):- ((nb_current(self_space,Self),Self\==[])->true;Self='&self'). +use_top_self :- \+ fast_option_value('top-self', false). +top_self('&top'):- use_top_self,!. +top_self('&self'). + +%:- top_self(Self), nb_setval(self_space, '&self'), +current_self(Self):- ((nb_current(self_space,Self),Self\==[])->true;top_self(Self)). :- nb_setval(repl_mode, '+'). @@ -410,7 +414,8 @@ option_value_name_default_type_help('answer-format', 'show', ['rust', 'silent', 'detailed'], "Control how results are displayed", 'Output and Logging'). option_value_name_default_type_help('repeats', true, [true, false], "false to avoid repeated results", 'Miscellaneous'). option_value_name_default_type_help('time', true, [false, true], "Enable or disable timing for operations (in Rust compatibility mode, this is false)", 'Miscellaneous'). -option_value_name_default_type_help('vn', auto, [auto, true, false], "Enable or disable, (auto = enable but not if it breaks stuff) EXPERIMENTAL BUG-FIX where variable names are preserved (see https://github.com/trueagi-io/metta-wam/issues/221)", 'Miscellaneous'). +option_value_name_default_type_help('vn', true, [true, auto, false], "Enable or disable, (auto = enable but not if it breaks stuff) EXPERIMENTAL BUG-FIX where variable names are preserved (see https://github.com/trueagi-io/metta-wam/issues/221)", 'Miscellaneous'). +option_value_name_default_type_help('top-self', false, [false, true, auto], "Do not pretend &self==top", 'Miscellaneous'). % Testing and Validation option_value_name_default_type_help('synth-unit-tests', false, [false, true], "Synthesize unit tests", 'Testing and Validation'). @@ -1419,22 +1424,23 @@ metta_atom(Space, Atom):- typed_list(Space,_,L),!, member(Atom,L). metta_atom(KB, [F, A| List]):- KB=='&flybase',fb_pred_nr(F, Len),current_predicate(F/Len), length([A|List],Len),apply(F,[A|List]). %metta_atom(KB,Atom):- KB=='&corelib',!, metta_atom_corelib(Atom). +metta_atom(X,Y):- use_top_self,maybe_resolve_space_dag(X,XX),!,in_dag(XX,XXX),XXX\==X,metta_atom(XXX,Y). metta_atom(KB,Atom):- metta_atom_in_file( KB,Atom). metta_atom(KB,Atom):- metta_atom_asserted( KB,Atom). %metta_atom(KB,Atom):- KB == '&corelib', !, metta_atom_asserted('&self',Atom). -metta_atom(KB,Atom):- KB \== '&corelib', using_all_spaces,!, metta_atom('&corelib',Atom). +%metta_atom(KB,Atom):- KB \== '&corelib', using_all_spaces,!, metta_atom('&corelib',Atom). %metta_atom(KB,Atom):- KB \== '&corelib', !, metta_atom('&corelib',Atom). -metta_atom(KB,Atom):- KB \== '&corelib', !, +metta_atom(KB,Atom):- KB \== '&corelib', !, % is_code_inheritor(KB), \+ \+ (metta_atom_asserted(KB,'&corelib'), should_inherit_from_corelib(Atom)), !, metta_atom('&corelib',Atom). should_inherit_from_corelib(_):- using_all_spaces,!. -should_inherit_from_corelib([H,A|_]):- H == ':',!,nonvar(A). -should_inherit_from_corelib([H|_]):- H == '@doc', !. +should_inherit_from_corelib([H,A|_]):- nonvar(A), should_inherit_op_from_corelib(H),!,nonvar(A). +%should_inherit_from_corelib([H|_]):- H == '@doc', !. should_inherit_from_corelib([H,A|T]):- fail, - H == '=',write_src_uo(try([H,A|T])),!,is_list(A), - A=[F|_],nonvar(F), F \==':', + H == '=',write_src_uo(try([H,A|T])),!, + A=[F|_],nonvar(F), F \==':',is_list(A), \+ metta_atom_asserted('&self',[:,F|_]), % \+ \+ metta_atom_asserted('&corelib',[=,[F|_]|_]), write_src_uo([H,A|T]). @@ -1446,12 +1452,13 @@ should_inherit_op_from_corelib('@doc'). %should_inherit_op_from_corelib(_). -metta_atom_asserted('&self','&corelib'). -metta_atom_asserted('&self','&stdlib'). -metta_atom_asserted('top','&corelib'). -metta_atom_asserted('top','&stdlib'). +%metta_atom_asserted('&self','&corelib'). +%metta_atom_asserted('&self','&stdlib'). +metta_atom_asserted(Top,'&corelib'):- top_self(Top). +metta_atom_asserted(Top,'&stdlib'):- top_self(Top). metta_atom_asserted('&stdlib','&corelib'). metta_atom_asserted('&flybase','&corelib'). +metta_atom_asserted('&flybase','&stdlib'). metta_atom_asserted('&catalog','&corelib'). metta_atom_asserted('&catalog','&stdlib'). @@ -1461,13 +1468,14 @@ in_dag(X,X). space_to_ctx(Top,Var):- nonvar(Top),current_self(Top),!,Var='&self'. -space_to_ctx(Top,Var):- 'mod-space'(Top,Var). +space_to_ctx(Top,Var):- 'mod-space'(Top,Var),!. +space_to_ctx(Var,Var). -'mod-space'(top,'&self'). +'mod-space'(top,'&top'). 'mod-space'(catalog,'&catalog'). 'mod-space'(corelib,'&corelib'). 'mod-space'(stdlib,'&stdlib'). -'mod-space'(Top,'&self'):- Top == self. +'mod-space'(Top,'&self'):- current_self(Top). not_metta_atom_corelib(A,N):- A \== '&corelib' , metta_atom('&corelib',N). diff --git a/prolog/metta_lang/metta_space.pl b/prolog/metta_lang/metta_space.pl index a3cc1efe46c..22620f640d9 100755 --- a/prolog/metta_lang/metta_space.pl +++ b/prolog/metta_lang/metta_space.pl @@ -693,6 +693,8 @@ was_asserted_space('&stdlib'). was_asserted_space('&corelib'). was_asserted_space('&flybase'). +was_asserted_space('&top'). +was_asserted_space('&catalog'). /* was_asserted_space('&attentional_focus'). was_asserted_space('&belief_events'). diff --git a/prolog/metta_lang/metta_subst.pl b/prolog/metta_lang/metta_subst.pl index 59b13682fd4..3d1b7162251 100755 --- a/prolog/metta_lang/metta_subst.pl +++ b/prolog/metta_lang/metta_subst.pl @@ -65,7 +65,7 @@ self_subst('True'). self_subst('False'). self_subst('F'). %' -:- nb_setval(self_space, '&self'). % ' +%:- nb_setval(self_space, '&self'). % ' substs_to(XX,Y):- Y==XX,!. substs_to(XX,Y):- Y=='True',!, is_True(XX),!. %' From 9292572e5fd3ece2712ba055440d516e44dd7363 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Sat, 21 Dec 2024 13:35:38 -0800 Subject: [PATCH 19/42] (github.repository == 'logicmoo/metta-testsuite') || (github.repository == 'logicmoo/metta-wam') || (github.event_name != 'schedule') --- .github/workflows/ci.yml | 36 ++++++++++++++++++------------------ 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 61b9e06f938..e1a947017fb 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -23,7 +23,7 @@ jobs: generate-reports: runs-on: ubuntu-latest - if: (github.repository == 'logicmoo/metta-testsuite') || (github.event_name != 'schedule') + if: (github.repository == 'logicmoo/metta-testsuite') || github.repository == 'logicmoo/metta-wam') || (github.event_name != 'schedule') env: JOB_TYPE: ${{ github.event_name == 'schedule' && 'nightly' || 'ci' }} @@ -33,23 +33,6 @@ jobs: - name: Checkout repository uses: actions/checkout@v4 - # Clone the metta-testsuite development branch - - name: Clone metta-testsuite development branch - run: | - git clone --branch development --depth 1 https://github.com/logicmoo/metta-testsuite.git metta-testsuite - - # Copy the tests/* directory from metta-testsuite - - name: Copy tests from metta-testsuite - run: | - rm -rf tests - mkdir -p tests/ - cp -r metta-testsuite/tests/* tests/ - rm -rf reports - mkdir -p reports/ - cp -r metta-testsuite/reports/* reports/ - mkdir -p test-scripts/ - cp -r metta-testsuite/test-scripts/* test-scripts/ - - name: Ensure just-results branch exists env: GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} @@ -84,6 +67,23 @@ jobs: echo "No previous test results found." fi + # Clone the metta-testsuite development branch + - name: Clone metta-testsuite development branch + run: | + git clone --branch development --depth 1 https://github.com/logicmoo/metta-testsuite.git metta-testsuite + + # Copy the tests/* directory from metta-testsuite + - name: Copy tests from metta-testsuite + run: | + rm -rf tests + mkdir -p tests/ + cp -r metta-testsuite/tests/* tests/ + rm -rf reports + mkdir -p reports/ + cp -r metta-testsuite/reports/* reports/ + mkdir -p test-scripts/ + cp -r metta-testsuite/test-scripts/* test-scripts/ + - name: Make Install Script Executable run: chmod +x INSTALL.sh From 8f6ce4f7add7a055ccfe21799455c7f77fcd2f7a Mon Sep 17 00:00:00 2001 From: logicmoo Date: Sat, 21 Dec 2024 13:56:50 -0800 Subject: [PATCH 20/42] fixed some typos --- README.md | 26 +++++++++++++++----------- 1 file changed, 15 insertions(+), 11 deletions(-) diff --git a/README.md b/README.md index 781f42bd810..0416f0b92fe 100755 --- a/README.md +++ b/README.md @@ -5,12 +5,16 @@ - [Installation](#installation) - [Running MeTTaLog](#neckbeard-running-mettalog) - [With Docker](#whale-running-mettalog-with-docker) -- [Test Reports](https://logicmoo.github.io/metta-testsuite/) -- [Tests](tests/) and [Result Links](reports/TEST_LINKS.md) -- [Overview Documentation](./docs/OVERVIEW.md). +- [Continuous Reports](https://logicmoo.github.io/metta-testsuite/ci/) +- [Nightly Reports](https://logicmoo.github.io/metta-wam/nightly/) +- [More Reports](https://logicmoo.github.io/metta-wam) +- [Tests](https://github.com/logicmoo/metta-testsuite/blob/development/tests/) and [Result Links](https://github.com/logicmoo/metta-testsuite/blob/development/reports/TEST_LINKS.md) +- [Testing Readme](https://github.com/logicmoo/metta-testsuite/blob/development/tests/README.md) and [Result Links](https://github.com/logicmoo/metta-testsuite/blob/development/reports/TEST_LINKS.md) +- [Overview Documentation](https://github.com/trueagi-io/metta-wam/blob/master/docs/OVERVIEW.md). Repos: -- [https://github.com/trueagi-io/metta-wam/](https://github.com/trueagi-io/metta-wam/) Interpeter/Compiler +- [https://github.com/trueagi-io/metta-wam/](https://github.com/trueagi-io/metta-wam/) Install Interpeter/Compiler +- [https://github.com/logicmoo/metta-wam/](https://github.com/logicmoo/metta-wam/) Interpeter/Compiler Nightly - [https://github.com/logicmoo/metta-testsuite/](https://github.com/logicmoo/metta-testsuite/) Test Suite @@ -92,30 +96,30 @@ metta+>^D # Exit the REPL with `ctrl-D`. To run a script: ```bash -mettalog exmaples/puzzles/nalifier.metta +mettalog examples/puzzles/nalifier.metta ``` To run a script and then enter the repl: ```bash -mettalog exmaples/puzzles//nalifier.metta --repl +mettalog examples/puzzles/fish_riddle_1_no_states.metta --repl metta+>!(query &self (because blue house keeps parrots the $who is the fish owner)) [(Succeed ((quote (because blue house keeps parrots the brit is the fish owner))))] -metta+> +metta+>!(halt! 7) ``` ## Unit tests -One exmaple is provided in this repository +One examples is provided in this repository ```bash -mettalog --test exmaples/tests/unit_test_example.metta +mettalog --test examples/tests/unit_test_example.metta # The output is saved as an HTML file in the same directory. ``` -The rest are in a large REPO @ +The rest of the tests are in a large REPO @ ```bash git clone https://github.com/logicmoo/metta-testsuite/ -ln -s metta-testsuite/tests/ ./tests +ls ./tests/ # this is a symlink that was already made with # ln -s metta-testsuite/tests/ ./tests ``` Run a single test From 923eb5991710a4e871604aa85e5d9d38861dc259 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Sat, 21 Dec 2024 14:12:02 -0800 Subject: [PATCH 21/42] scripts/into_junit.py --- README.md | 7 +++---- scripts/into_junit.py | 3 ++- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/README.md b/README.md index 0416f0b92fe..d5c73bb09bf 100755 --- a/README.md +++ b/README.md @@ -5,10 +5,9 @@ - [Installation](#installation) - [Running MeTTaLog](#neckbeard-running-mettalog) - [With Docker](#whale-running-mettalog-with-docker) -- [Continuous Reports](https://logicmoo.github.io/metta-testsuite/ci/) -- [Nightly Reports](https://logicmoo.github.io/metta-wam/nightly/) -- [More Reports](https://logicmoo.github.io/metta-wam) -- [Tests](https://github.com/logicmoo/metta-testsuite/blob/development/tests/) and [Result Links](https://github.com/logicmoo/metta-testsuite/blob/development/reports/TEST_LINKS.md) +- Continuous Reports [https://logicmoo.github.io/metta-testsuite/ci/](https://logicmoo.github.io/metta-testsuite/ci/) +- Nightly Reports [https://logicmoo.github.io/metta-wam/nightly/](https://logicmoo.github.io/metta-wam/nightly/) +- More Reports [https://logicmoo.github.io/metta-wam](https://logicmoo.github.io/metta-wam) - [Testing Readme](https://github.com/logicmoo/metta-testsuite/blob/development/tests/README.md) and [Result Links](https://github.com/logicmoo/metta-testsuite/blob/development/reports/TEST_LINKS.md) - [Overview Documentation](https://github.com/trueagi-io/metta-wam/blob/master/docs/OVERVIEW.md). diff --git a/scripts/into_junit.py b/scripts/into_junit.py index eb9056f8e51..0deabd31a21 100644 --- a/scripts/into_junit.py +++ b/scripts/into_junit.py @@ -17,7 +17,8 @@ def create_testcase_element(testclass, testname, stdout, identifier, got, expect testcase = ET.Element("testcase", classname=testclass, name=testname, time=time) test_res = f"Assertion: {stdout}\nExpected: {expected}\nActual: {got}" - url = url.replace("/./","/").replace("//","/").replace(":/","://") + url = url.replace("/./","/").replace("//","/").replace(":/","://") + url = url.replace("github.io/metta-wam/","github.io/metta-testsuite/") if testclass != 'WHOLE-TESTS': testfile = testfile_name(url) failcount = failcounts_dict[testfile] From 8f098266f2ec170164da07791da506987af5ff06 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Sat, 21 Dec 2024 14:23:00 -0800 Subject: [PATCH 22/42] Windows Install - Comming Soon --- README.md | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/README.md b/README.md index d5c73bb09bf..f139a768812 100755 --- a/README.md +++ b/README.md @@ -1,6 +1,9 @@ # :rocket: An Implementation of MeTTa designed to run on the Warren Abstract Machine (WAM) ## Quick Links +- [https://github.com/trueagi-io/metta-wam/](https://github.com/trueagi-io/metta-wam/) Install MeTTaLog +- [https://github.com/logicmoo/metta-wam/](https://github.com/logicmoo/metta-wam/) Interpeter/Compiler Devel +- [https://github.com/logicmoo/metta-testsuite/](https://github.com/logicmoo/metta-testsuite/) Testing Suite - [Getting Started](#getting-started) - [Installation](#installation) - [Running MeTTaLog](#neckbeard-running-mettalog) @@ -11,11 +14,6 @@ - [Testing Readme](https://github.com/logicmoo/metta-testsuite/blob/development/tests/README.md) and [Result Links](https://github.com/logicmoo/metta-testsuite/blob/development/reports/TEST_LINKS.md) - [Overview Documentation](https://github.com/trueagi-io/metta-wam/blob/master/docs/OVERVIEW.md). -Repos: -- [https://github.com/trueagi-io/metta-wam/](https://github.com/trueagi-io/metta-wam/) Install Interpeter/Compiler -- [https://github.com/logicmoo/metta-wam/](https://github.com/logicmoo/metta-wam/) Interpeter/Compiler Nightly -- [https://github.com/logicmoo/metta-testsuite/](https://github.com/logicmoo/metta-testsuite/) Test Suite - ## Getting Started @@ -23,11 +21,13 @@ Repos: _Before you get started make sure `pip` and `venv` are working good._ + +Linux/WSL/OS X Clone and set up MeTTaLog with the following commands: ``` git clone https://github.com/trueagi-io/metta-wam cd metta-wam -source ./INSTALL.sh # Follow the default prompts +source ./INSTALL.sh --allow-system-modifications # Follow the default prompts ``` #### The INSTALL.sh script handles the installation of essential components and updates: - Ensures Python's `pip` is installed or installs it. @@ -43,6 +43,9 @@ source ./INSTALL.sh # Follow the default prompts **Note**: Running this script modifies software configurations and installs packages. Ensure you're prepared for these changes. +Windows Install - Comming Soon + + ## :whale: Running MeTTaLog with Docker
From 4678f1fc012abca12e184a5a39da40e97f9eb319 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Sat, 21 Dec 2024 14:26:56 -0800 Subject: [PATCH 23/42] Fixed: The workflow is not valid. .github/workflows/ci.yml (Line: 26, Col: 9): Unexpected symbol: ')'. --- .github/workflows/ci.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index e1a947017fb..723548092fb 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -23,7 +23,7 @@ jobs: generate-reports: runs-on: ubuntu-latest - if: (github.repository == 'logicmoo/metta-testsuite') || github.repository == 'logicmoo/metta-wam') || (github.event_name != 'schedule') + if: (github.repository == 'logicmoo/metta-testsuite') || (github.repository == 'logicmoo/metta-wam') || (github.event_name != 'schedule') env: JOB_TYPE: ${{ github.event_name == 'schedule' && 'nightly' || 'ci' }} @@ -276,7 +276,7 @@ jobs: allure_report: allure-report allure_history: allure-history subfolder: ${{ env.SUBFOLDER }} - keep_reports: 120 + keep_reports: 1200 env: SUBFOLDER: ${{ env.JOB_TYPE }} From e2b99e57550256ecb6dd46606328733da5a7d1ab Mon Sep 17 00:00:00 2001 From: logicmoo Date: Sat, 21 Dec 2024 14:54:12 -0800 Subject: [PATCH 24/42] into_top_self --- prolog/metta_lang/metta_interp.pl | 103 +++++++++++++++++++++++++---- prolog/metta_lang/metta_loader.pl | 4 +- prolog/metta_lang/metta_parser.pl | 8 +-- prolog/metta_lang/metta_printer.pl | 11 ++- prolog/metta_lang/metta_repl.pl | 71 ++------------------ prolog/metta_lang/metta_space.pl | 51 +++++++++----- 6 files changed, 145 insertions(+), 103 deletions(-) diff --git a/prolog/metta_lang/metta_interp.pl b/prolog/metta_lang/metta_interp.pl index b156745dfd2..4f3817b26e4 100755 --- a/prolog/metta_lang/metta_interp.pl +++ b/prolog/metta_lang/metta_interp.pl @@ -1415,6 +1415,11 @@ %get_metta_atom(Eq,KB, [F|List]):- KB='&flybase',fb_pred(F, Len), length(List,Len),apply(F,List). +maybe_into_top_self(WSelf, Self):- use_top_self,WSelf=='&self',current_self(Self),Self\==WSelf,!. +into_top_self(WSelf, Self):- maybe_into_top_self(WSelf, Self),!. +into_top_self(Self, Self). + + get_metta_atom_from(KB,Atom):- metta_atom(KB,Atom). get_metta_atom(Eq,Space, Atom):- metta_atom(Space, Atom), \+ (Atom =[EQ,_,_], EQ==Eq). @@ -1424,7 +1429,10 @@ metta_atom(Space, Atom):- typed_list(Space,_,L),!, member(Atom,L). metta_atom(KB, [F, A| List]):- KB=='&flybase',fb_pred_nr(F, Len),current_predicate(F/Len), length([A|List],Len),apply(F,[A|List]). %metta_atom(KB,Atom):- KB=='&corelib',!, metta_atom_corelib(Atom). -metta_atom(X,Y):- use_top_self,maybe_resolve_space_dag(X,XX),!,in_dag(XX,XXX),XXX\==X,metta_atom(XXX,Y). +%metta_atom(X,Y):- use_top_self,maybe_resolve_space_dag(X,XX),!,in_dag(XX,XXX),XXX\==X,metta_atom(XXX,Y). + +metta_atom(X,Y):- maybe_into_top_self(X, TopSelf),!,metta_atom(TopSelf,Y). +%metta_atom(X,Y):- var(X),use_top_self,current_self(TopSelf),metta_atom(TopSelf,Y),X='&self'. metta_atom(KB,Atom):- metta_atom_in_file( KB,Atom). metta_atom(KB,Atom):- metta_atom_asserted( KB,Atom). @@ -1774,24 +1782,29 @@ ignore(( symbolic(Cmt),symbolic_list_concat([_,Src],'MeTTaLog: ',Cmt),!,atom_string(Src,SrcCode),do_metta(mettalog_only(From),Load,Self,SrcCode,Out))),!. do_metta(From,How,Self,Src,Out):- string(Src),!, - normalize_space(string(TaxM),Src), - convert_tax(How,Self,TaxM,Expr,NewHow),!, + must_det_ll((normalize_space(string(TaxM),Src), + convert_tax(How,Self,TaxM,Expr,NewHow))), do_metta(From,NewHow,Self,Expr,Out). do_metta(From,_,Self,exec(Expr),Out):- !, do_metta(From,exec,Self,Expr,Out). + + +% Prolog CALL do_metta(From,_,Self, call(Expr),Out):- !, do_metta(From,call,Self,Expr,Out). do_metta(From,_,Self, ':-'(Expr),Out):- !, do_metta(From,call,Self,Expr,Out). do_metta(From,call,Self,TermV,FOut):- !, if_t(into_simple_op(call,TermV,OP),pfcAdd_Now('next-operation'(OP))), call_for_term_variables(TermV,Term,NamedVarsList,X), must_be(nonvar,Term), copy_term(NamedVarsList,Was), - Output = NamedVarsList, - user:u_do_metta_exec(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut). + Output = X, + user:u_do_metta_exec(From,Self,call(TermV),Term,X,NamedVarsList,Was,Output,FOut). +% Non Exec do_metta(_File,Load,Self,Src,Out):- Load\==exec, !, if_t(into_simple_op(Load,Src,OP),pfcAdd_Now('next-operation'(OP))), dont_give_up(as_tf(asserted_do_metta(Self,Load,Src),Out)). +% Doing Exec do_metta(file(Filename),exec,Self,TermV,Out):- must_det_ll((inc_exec_num(Filename), get_exec_num(Filename,Nth), @@ -1831,13 +1844,79 @@ o_s(S,S). into_simple_op(Load,[Op|O],op(Load,Op,S)):- o_s(O,S),!. -call_for_term_variables(TermV,catch_red(show_failure(Term)),NamedVarsList,X):- - term_variables(TermV, AllVars), call_for_term_variables4v(TermV,AllVars,Term,NamedVarsList,X),!, - must_be(callable,Term). -call_for_term_variables(TermV,catch_red(show_failure(Term)),NamedVarsList,X):- - get_term_variables(TermV, DCAllVars, Singletons, NonSingletons), - call_for_term_variables5(TermV, DCAllVars, Singletons, NonSingletons, Term,NamedVarsList,X),!, - must_be(callable,Term). + +%! call_for_term_variables(+Term, +X, -Result, -NamedVarsList, +TF) is det. +% Handles the term `Term` and determines the term variable list and final result. +% This version handles the case when the term has no variables and converts it to a truth-functional form. +% +% @arg Term The input term to be analyzed. +% @arg X The list of variables found within the term. It can be empty or contain one variable. +% @arg Result The final result, either as the original term or transformed into a truth-functional form. +% @arg NamedVarsList The list of named variables associated with the term. +% @arg TF The truth-functional form when the term has no variables. +% +% @example +% % Example with no variables: +% ?- call_for_term_variables(foo, Result, Vars, TF). +% Result = as_tf(foo, TF), +% Vars = []. +% +call_for_term_variables(TermV,catch_red(show_failure(TermR)),NewNamedVarsList,X):- + subst_vars(TermV,Term,NamedVarsList), + wwdmsg(subst_vars(TermV,Term,NamedVarsList)), + term_variables(Term, AllVars), + %get_global_varnames(VNs), append(NamedVarsList,VNs,All), nb_setval('$variable_names',All), wdmsg(term_variables(Term, AllVars)=All), + term_singletons(Term, Singletons),term_dont_cares(Term, DontCares), + + wwdmsg((term_singletons(Term, Singletons),term_dont_cares(Term, DontCares))), + include(not_in_eq(Singletons), AllVars, NonSingletons), + wwdmsg([dc=DontCares, sv=Singletons, ns=NonSingletons]), !, + include(not_in_eq(DontCares), NonSingletons, CNonSingletons), + include(not_in_eq(DontCares), Singletons, CSingletons), + wwdmsg([dc=DontCares, csv=CSingletons, cns=CNonSingletons]),!, + maplist(maplist(into_named_vars), + [DontCares, CSingletons, CNonSingletons], + [DontCaresN, CSingletonsN, CNonSingletonsN]), + wwdmsg([dc_nv=DontCaresN, sv_nv=CSingletonsN, ns_nv=CNonSingletonsN]), + call_for_term_variables5(Term, DontCaresN, CNonSingletonsN, CSingletonsN, TermR, NamedVarsList, NewNamedVarsList, X),!, + wwdmsg(call_for_term_variables5(orig=Term, all=DontCaresN, singles=CSingletonsN, shared=CNonSingletonsN, call=TermR, nvl=NamedVarsList, nvlo=NewNamedVarsList, output=X)). + +wwdmsg(_). +% If the term is ground, return the as_tf form. +%call_for_term_variables5(Term,_,_,_,as_tf(Term,Ret),VL,['$RetVal'=Ret|VL],[==,['call!',Term],Ret]) :- ground(Term), !. +% If the term is ground, create a call_nth with the term. +call_for_term_variables5(Term,_,_,_,call_nth(Term,Count),VL,['Count'=Count|VL],Ret) :- Ret=Term. + + +into_metta_callable(_Self,CALL,Term,X,NamedVarsList,Was):- fail, + % wdmsg(mc(CALL)), + CALL= call(TermV), + \+ never_compile(TermV), + must_det_ll(((( + term_variables(TermV,Res), + % ignore(Res = '$VAR'('ExecRes')), + RealRes = Res, + TermV=ExecGoal, + %format("~w ~w\n",[Res,ExecGoal]), + subst_vars(Res+ExecGoal,Res+Term,NamedVarsList), + copy_term_g(NamedVarsList,Was), + term_variables(Term,Vars), + + + Call = do_metta_runtime(Res, ExecGoal), + output_language(prolog, notrace((color_g_mesg('#114411', print_pl_source(:- Call ))))), + %nl,writeq(Term),nl, + ((\+ \+ + (( + %numbervars(v(TermV,Term,NamedVarsList,Vars),999,_,[attvar(skip)]), + %nb_current(variable_names,NamedVarsList), + %nl,print(subst_vars(Term,NamedVarsList,Vars)), + nop(nl))))), + nop(maplist(verbose_unify,Vars)), + %NamedVarsList=[_=RealRealRes|_], + %var(RealRes), + X = RealRes)))),!. + into_metta_callable(_Self,TermV,Term,X,NamedVarsList,Was):- \+ never_compile(TermV), diff --git a/prolog/metta_lang/metta_loader.pl b/prolog/metta_lang/metta_loader.pl index 58067038dbe..60b9d6ea3c1 100755 --- a/prolog/metta_lang/metta_loader.pl +++ b/prolog/metta_lang/metta_loader.pl @@ -883,9 +883,11 @@ % If Filename is not a valid symbol or file does not exist, handle wildcards for includes. (\+ symbol(Filename); \+ exists_file(Filename)),!, must_det_ll(with_wild_path(include_metta(Self), Filename)),!. -include_metta1(Self, RelFilename):- + +include_metta1(WSelf, RelFilename):- % Ensure RelFilename is a valid symbol and exists as a file. must_det_ll(( + into_top_self(WSelf, Self), symbol(RelFilename), exists_file(RelFilename),!, % Convert the relative filename to an absolute path. diff --git a/prolog/metta_lang/metta_parser.pl b/prolog/metta_lang/metta_parser.pl index 46bc199afac..2dae77f8111 100644 --- a/prolog/metta_lang/metta_parser.pl +++ b/prolog/metta_lang/metta_parser.pl @@ -921,9 +921,9 @@ at_end_of_stream(Stream), !, Clause = end_of_file. read_prolog_syntax(Stream, Clause) :- % Handle errors while reading a clause. - catch(read_prolog_syntax_0(Stream, Clause), E, + catch(read_prolog_syntax_unsafe(Stream, Clause), E, throw_stream_error(Stream,E)), !. -read_prolog_syntax_0(Stream, Term) :- +read_prolog_syntax_unsafe(Stream, Term) :- % Set options for reading the clause with metadata. Options = [ variable_names(Bindings), term_position(Pos), @@ -937,12 +937,12 @@ -> true ; % Store term position and variable names. b_setval('$term_position', Pos), - b_setval('$variable_names', Bindings), + nb_setval('$variable_names', Bindings), % Display information about the term. maplist(star_vars,Bindings), nop(display_term_info(Stream, Term, Bindings, Pos, RawLayout, Comments))). -star_vars(N=V):- ignore('$'(N) = V). +star_vars(N=V):- ignore('$VAR'(N) = V). %! maybe_name_vars(+List) is det. % diff --git a/prolog/metta_lang/metta_printer.pl b/prolog/metta_lang/metta_printer.pl index 9cae0c5d96b..466b3702aef 100755 --- a/prolog/metta_lang/metta_printer.pl +++ b/prolog/metta_lang/metta_printer.pl @@ -739,9 +739,14 @@ print_compounds_special:- true. src_vars(V,I):- var(V),!,I=V. src_vars(V,I):- %ignore(guess_metta_vars(V)), - ignore(guess_varnames(V,I)), - ignore(numbervars(V,10000,_,[singleton(true),attvar(skip)])). - + pre_guess_varnames(V,II),ignore(II=V), + guess_varnames(II,I), + nop(ignore(numbervars(I,10000,_,[singleton(true),attvar(skip)]))). +pre_guess_varnames(V,I):- \+ compound(V),!,I=V. +pre_guess_varnames(V,I):- functor(V,F,A),functor(II,F,A), metta_file_buffer(_, _, _, II, Vs, _,_), Vs\==[], I=@=II, I=II, V=I,maybe_name_vars(Vs),!. +pre_guess_varnames(V,I):- is_list(V),!,maplist(pre_guess_varnames,V,I). +pre_guess_varnames(C,I):- compound_name_arguments(C,F,V),!,maplist(pre_guess_varnames,V,VV),compound_name_arguments(I,F,VV),!. +pre_guess_varnames(V,V). %! write_src_woi(+Term) is det. % % Writes the source of a term `Term` with indentation disabled. diff --git a/prolog/metta_lang/metta_repl.pl b/prolog/metta_lang/metta_repl.pl index 50ad62bb0fb..d91ebe034d3 100755 --- a/prolog/metta_lang/metta_repl.pl +++ b/prolog/metta_lang/metta_repl.pl @@ -425,31 +425,6 @@ % If the input stream is not provided, do nothing. read_pending_white_codes(_). -%! call_for_term_variables4v(+Term, +X, -Result, -NamedVarsList, +TF) is det. -% Handles the term `Term` and determines the term variable list and final result. -% This version handles the case when the term has no variables and converts it to a truth-functional form. -% -% @arg Term The input term to be analyzed. -% @arg X The list of variables found within the term. It can be empty or contain one variable. -% @arg Result The final result, either as the original term or transformed into a truth-functional form. -% @arg NamedVarsList The list of named variables associated with the term. -% @arg TF The truth-functional form when the term has no variables. -% -% @example -% % Example with no variables: -% ?- call_for_term_variables4v(foo, [], Result, Vars, true). -% Result = as_tf(foo, true), -% Vars = []. -% -call_for_term_variables4v(Term, [], as_tf(Term, TF), NamedVarsList, TF) :- - % Get global variable names for the term. - get_global_varnames(NamedVarsList), - % Succeed if no variables are present. - !. -% Handles the case when the term has one variable and passes the term as-is. -call_for_term_variables4v(Term, [X], Term, NamedVarsList, X) :- - % Get global variable names for the term. - get_global_varnames(NamedVarsList). %! balanced_parentheses(+Str) is semidet. % Checks if parentheses are balanced in a string or list of characters `Str`. @@ -609,9 +584,10 @@ % repl_read_next(NewAccumulated, Expr) :- % Concatenate the input with '.' and try to interpret it as an atom. - symbol_concat(Atom,'.',NewAccumulated), + symbol_concat(_Atom,'.',NewAccumulated), % Attempt to read the term from the atom, handle errors and retry if necessary. - catch_err((read_term_from_atom(Atom, Term, []), Expr = call(Term)), E, + open_string(NewAccumulated,Stream), + catch_err((read_prolog_syntax_unsafe(Stream, Term), Expr = call(Term)), E, (((fail, write('Syntax error: '), writeq(E), nl, repl_read_next(Expr))))), !. % Previously commented: repl_read_next(Str, Expr):- ((clause(t_l:s_reader_info(Expr),_,Ref),erase(Ref))). @@ -786,45 +762,6 @@ % Directive to set a global variable for variable names. :- nb_setval(variable_names, []). -%! call_for_term_variables5(+Term, +DC, +Vars1, +Vars2, -CallTerm, -DCVars, -TF) is det. -% -% Processes term variables and generates a call structure based on the provided term, -% handling cases with ground terms, single variables, and multiple variables. -% -% @arg Term The input term to process. -% @arg DC The direct constraints or variables list (can be empty). -% @arg Vars1 The first set of variables (e.g., `[Var=Value]` format). -% @arg Vars2 The second set of variables. -% @arg CallTerm The generated term call (e.g., `call_nth/2` or `as_tf/2`). -% @arg DCVars The combined list of variables or constraints. -% @arg TF The variable or value associated with the call. -% -% @example Handling a ground term: -% ?- call_for_term_variables5(hello, [], [], [], CallTerm, DCVars, TF). -% CallTerm = as_tf(hello, TF), -% DCVars = [], -% TF = _. -% -% @example Single variable case: -% ?- call_for_term_variables5(hello, [], [], [X=_], CallTerm, DCVars, TF). -% CallTerm = call_nth(hello, Count), -% DCVars = ['Count' = Count], -% TF = X. -% - % If the term is ground, return the as_tf form. -call_for_term_variables5(Term,[],[],[],as_tf(Term,TF),[],TF) :- ground(Term), !. - % If the term is ground, create a call_nth with the term. -call_for_term_variables5(Term,DC,[],[],call_nth(Term,TF),DC,TF) :- ground(Term), !. -% If there is one variable, set the term to call_nth. -call_for_term_variables5(Term,_,[],[_=Var],call_nth(Term,Count),['Count'=Count],Var). -% Similar case when the variable is reversed in arguments. -call_for_term_variables5(Term,_,[_=Var],[],call_nth(Term,Count),['Count'=Count],Var). -% If both term variables and equal variable are present, pass them along. -call_for_term_variables5(Term,_,Vars,[_=Var],Term,Vars,Var). -% Same case but with the variables reversed. -call_for_term_variables5(Term,_,[_=Var],Vars,Term,Vars,Var). -% Handle case with more than one variable, generating a call_nth. -call_for_term_variables5(Term,_,SVars,Vars,call_nth(Term,Count),[Vars,SVars],Count). %! is_interactive(+From) is nondet. % @@ -2045,6 +1982,8 @@ :- volatile(is_installed_readline_editline/1). :- if(is_win64). +% dummy for on windows +install_readline_editline. :-else. install_readline_editline :- % Get the current input stream. diff --git a/prolog/metta_lang/metta_space.pl b/prolog/metta_lang/metta_space.pl index 22620f640d9..9d1a65eba2a 100755 --- a/prolog/metta_lang/metta_space.pl +++ b/prolog/metta_lang/metta_space.pl @@ -377,7 +377,8 @@ % @example Clear all atoms from a space: % ?- 'clear-atoms'('my_space'). % -'clear-atoms'(SpaceNameOrInstance) :- +'clear-atoms'(DynSpace) :- + into_top_self(DynSpace, SpaceNameOrInstance), % Log the operation of clearing atoms from the specified space. dout(space, ['clear-atoms', SpaceNameOrInstance]), % Retrieve the appropriate method for clearing the space based on its type. @@ -404,7 +405,8 @@ % @example Add an atom to a space: % ?- 'add-atom'('my_space', my_atom). % -'add-atom'(SpaceNameOrInstance, Atom) :- +'add-atom'(DynSpace, Atom) :- + into_top_self(DynSpace, SpaceNameOrInstance), % Retrieve the method for adding an atom based on the space type. ((space_type_method(Type, add_atom, Method), % Ensure the space type matches by calling the type predicate. @@ -447,7 +449,8 @@ % @example Remove an atom from a space: % ?- 'remove-atom'('my_space', my_atom). % -'remove-atom'(SpaceNameOrInstance, Atom) :- +'remove-atom'(DynSpace, Atom) :- + into_top_self(DynSpace, SpaceNameOrInstance), % Log the operation of removing an atom from the specified space. dout(space, ['remove-atom', SpaceNameOrInstance, Atom]), % Retrieve the method for removing an atom based on the space type. @@ -494,7 +497,8 @@ % @example Replace an atom in a space: % ?- 'replace-atom'('my_space', old_atom, new_atom). % -'replace-atom'(SpaceNameOrInstance, Atom, New) :- +'replace-atom'(DynSpace, Atom, New) :- + into_top_self(DynSpace, SpaceNameOrInstance), dout(space, ['replace-atom', SpaceNameOrInstance, Atom, New]), space_type_method(Type, replace_atom, Method), call(Type, SpaceNameOrInstance), @@ -536,7 +540,8 @@ % ?- 'atom-count'(env, Count). % Count = 10. % -'atom-count'(SpaceNameOrInstance, Count) :- +'atom-count'(DynSpace, Count) :- + into_top_self(DynSpace, SpaceNameOrInstance), dout(space, ['atom-count', SpaceNameOrInstance]), space_type_method(Type, atom_count, Method), call(Type, SpaceNameOrInstance), !, @@ -568,7 +573,8 @@ % ?- get-atoms('env1', Atoms). % Atoms = [atomA, atomB, atomC]. % -'get-atoms'(SpaceNameOrInstance, AtomsL) :- +'get-atoms'(DynSpace, AtomsL) :- + into_top_self(DynSpace, SpaceNameOrInstance), % Output a debug message indicating the 'get-atoms' request to the space. dout(space, ['get-atoms', SpaceNameOrInstance]), % Determine the method for retrieving atoms based on the space type. @@ -598,7 +604,8 @@ % @example Iterate over atoms in a space: % ?- 'atoms_iter'('my_space', Iter). % -'atoms_iter'(SpaceNameOrInstance, Iter) :- +'atoms_iter'(DynSpace, Iter) :- + into_top_self(DynSpace, SpaceNameOrInstance), dout(space, ['atoms_iter', SpaceNameOrInstance]), space_type_method(Type, atoms_iter, Method), call(Type, SpaceNameOrInstance), @@ -621,7 +628,8 @@ % @example Match atoms in a space: % ?- 'atoms_match'('my_space', Atoms, my_template, else_clause). % -'atoms_match'(SpaceNameOrInstance, Atoms, Template, Else) :- +'atoms_match'(DynSpace, Atoms, Template, Else) :- + into_top_self(DynSpace, SpaceNameOrInstance), space_type_method(Type, atoms_match, Method), call(Type, SpaceNameOrInstance), !, @@ -642,7 +650,8 @@ % @example Query a space for an atom: % ?- 'space_query'('my_space', query_atom, Result). % -'space_query'(SpaceNameOrInstance, QueryAtom, Result) :- +'space_query'(DynSpace, QueryAtom, Result) :- + into_top_self(DynSpace, SpaceNameOrInstance), space_type_method(Type, query, Method), call(Type, SpaceNameOrInstance), !, @@ -663,7 +672,8 @@ % ?- subst_pattern_template('example_space', some_pattern, Template). % Template = [substituted_atom1, substituted_atom2]. % -subst_pattern_template(SpaceNameOrInstance, Pattern, Template) :- +subst_pattern_template(DynSpace, Pattern, Template) :- + into_top_self(DynSpace, SpaceNameOrInstance), % Log the operation for traceability. dout(space, [subst_pattern_template, SpaceNameOrInstance, Pattern, Template]), % Match and substitute atoms in the given space according to the pattern. @@ -689,7 +699,7 @@ % ?- was_asserted_space('&self'). % true. % -was_asserted_space('&self'). +was_asserted_space('&self'):- current_self(X), (X=='&self'->true;was_asserted_space(X)). was_asserted_space('&stdlib'). was_asserted_space('&corelib'). was_asserted_space('&flybase'). @@ -1338,9 +1348,12 @@ % % Get the atom count for a loaded context. % ?- atom_count_provider(some_context, Count). % -atom_count_provider(Self, Count) :- + + +atom_count_provider(SpaceNameOrInstance, Count) :- + into_top_self(SpaceNameOrInstance, DynSpace), % Check if the context has been loaded into a knowledge base (KB). - user:loaded_into_kb(Self, Filename), + user:loaded_into_kb(DynSpace, Filename), % Retrieve the associated predicate for the given filename. once(user:asserted_metta_pred(Mangle, Filename)), % Derive a related predicate from the original. @@ -1357,8 +1370,9 @@ predicate_property(Data, number_of_rules(RC)), % Calculate the atom count as the difference between clauses and rules. Count is CC - RC. -atom_count_provider(KB, Count) :- +atom_count_provider(SpaceNameOrInstance, Count) :- must_det_ll(( + into_top_self(SpaceNameOrInstance, KB), % Predicate for asserted atoms. AMA = metta_atom_asserted, % Declare the predicate with arity 2. @@ -1408,7 +1422,8 @@ % % Iterate over atoms in 'example_kb' and retrieve them. % ?- metta_assertdb_iter('example_kb', Atom). % -metta_assertdb_iter(KB, Atoms) :- +metta_assertdb_iter(SpaceNameOrInstance, Atoms) :- + into_top_self(SpaceNameOrInstance, KB), % Dynamically construct the predicate for the given KB. MP =.. [metta_atom, KB, Atoms], % Call the constructed predicate to retrieve atoms. @@ -1429,7 +1444,8 @@ % % Execute a query against the KB and bind variables. % ?- metta_iter_bind('example_kb', my_query(X), Vars, ['X']). % -metta_iter_bind(KB, Query, Vars, VarNames) :- +metta_iter_bind(SpaceNameOrInstance, Query, Vars, VarNames) :- + into_top_self(SpaceNameOrInstance, KB), % Extract all variables from the query. term_variables(Query, QVars), % Align the provided variable names with the query variables. @@ -1462,7 +1478,8 @@ % % Query the KB and retrieve bound variables. % ?- space_query_vars('example_kb', my_query(X), Vars). % -space_query_vars(KB, Query, Vars) :- +space_query_vars(SpaceNameOrInstance, Query, Vars) :- + into_top_self(SpaceNameOrInstance, KB), % Check if the knowledge base is an asserted space. is_asserted_space(KB), !, % Declare the predicate for asserted atoms with arity 2. From 28e5f28b693a6d88a162dc216a31ec9ced9c227e Mon Sep 17 00:00:00 2001 From: logicmoo Date: Sat, 21 Dec 2024 14:58:05 -0800 Subject: [PATCH 25/42] revert to 1cde39d33ea5524491797daf8dca0082115c75fc --- .Attic/metta_lang/metta_compiler.pl | 2481 ++++++++++++------- .Attic/metta_lang/metta_compiler_lib.pl | 47 +- .Attic/metta_lang/metta_debug.pl | 2890 +---------------------- .Attic/metta_lang/metta_eval.pl | 310 ++- .Attic/metta_lang/metta_interp.pl | 214 +- .Attic/metta_lang/metta_loader.pl | 34 +- .Attic/metta_lang/metta_parser.pl | 165 +- .Attic/metta_lang/metta_printer.pl | 49 +- .Attic/metta_lang/metta_python.pl | 2 +- .Attic/metta_lang/metta_repl.pl | 518 ++-- .Attic/metta_lang/metta_space.pl | 58 +- .Attic/metta_lang/metta_subst.pl | 2 +- .Attic/metta_lang/metta_testing.pl | 45 +- .Attic/metta_lang/metta_types.pl | 43 +- .Attic/metta_lang/metta_utils.pl | 13 +- .Attic/metta_lang/stdlib_mettalog.metta | 52 +- .Attic/metta_lang/swi_support.pl | 1 + prolog/metta_lang/metta_eval.pl | 15 +- prolog/metta_lang/metta_interp.pl | 141 +- prolog/metta_lang/metta_loader.pl | 4 +- prolog/metta_lang/metta_parser.pl | 8 +- prolog/metta_lang/metta_printer.pl | 45 +- prolog/metta_lang/metta_repl.pl | 80 +- prolog/metta_lang/metta_space.pl | 53 +- prolog/metta_lang/metta_subst.pl | 2 +- prolog/metta_lang/stdlib_mettalog.metta | 5 +- 26 files changed, 2949 insertions(+), 4328 deletions(-) diff --git a/.Attic/metta_lang/metta_compiler.pl b/.Attic/metta_lang/metta_compiler.pl index 8c2db2549ad..746c7a2f18e 100755 --- a/.Attic/metta_lang/metta_compiler.pl +++ b/.Attic/metta_lang/metta_compiler.pl @@ -91,14 +91,42 @@ % ======================================= %:- set_option_value(encoding,utf8). -:- initialization(mutex_create(transpiler_mutex_lock)). +mutex_create_once(MutexId):- mutex_property(Was,status(_)),MutexId==Was,!. +mutex_create_once(MutexId):- mutex_create(MutexId),!. + +:- initialization(mutex_create_once(transpiler_mutex_lock)). :- at_halt(mutex_destroy(transpiler_mutex_lock)). %transpile_prefix(''). -transpile_prefix('mc__'). +transpile_impl_prefix('mi__'). +:- dynamic(is_transpile_impl_prefix/2). +transpile_impl_prefix(F,Fn):- is_transpile_impl_prefix(F,Fn)*->true;(transpile_impl_prefix(Prefix),atom_concat(Prefix,F,Fn),asserta(is_transpile_impl_prefix(F,Fn))). + +transpile_call_prefix('mc__'). +:- dynamic(is_transpile_call_prefix/2). +transpile_call_prefix(F,Fn):- is_transpile_call_prefix(F,Fn)*->true;(transpile_call_prefix(Prefix),atom_concat(Prefix,F,Fn),asserta(is_transpile_call_prefix(F,Fn))). + +transpiler_enable_interpreter_calls. +%transpiler_enable_interpreter_calls :- fail. + +transpiler_show_debug_messages. +%transpiler_show_debug_messages :- fail. -%enable_interpreter_calls. -enable_interpreter_calls :- fail. +:- dynamic(transpiler_stub_created/3). +% just so the transpiler_stub_created predicate always exists +transpiler_stub_created(space,dummy,0). + +:- dynamic(transpiler_depends_on/4). +% just so the transpiler_depends_on predicate always exists +transpiler_depends_on(dummy,0,dummy,0). + +:- dynamic(transpiler_clause_store/8). +% just so the transpiler_clause_store predicate always exists +% transpiler_clause_store(f,arity,types,rettype,lazy,retlazy,head,body) +transpiler_clause_store(dummy,0,[],'Any',[],eager,dummy,dummy). + +as_p1(is_p1(_,Code,Ret),Ret):- !, call(Code). +as_p1(is_p1(Code,Ret),Ret):- !, call(Code). % Meta-predicate that ensures that for every instance where G1 holds, G2 also holds. :- meta_predicate(for_all(0,0)). @@ -109,14 +137,18 @@ compound_non_cons(B):- compound(B), \+ B = [_|_]. iz_conz(B):- compound(B), B=[_|_]. -'=~'(A,B):- compound_non_cons(B),!,into_list_args(B,BB),!,'=~'(A,BB). -'=~'(B,A):- compound_non_cons(B),!,into_list_args(B,BB),!,'=~'(A,BB). -'=~'(A,B):- iz_conz(A),iz_conz(B),!,A=B. -'=~'(A,B):- var(A),iz_conz(B),!,A=B. -'=~'(A,B):- iz_conz(A),var(B),!,A=B. -'=~'(A,B):- compound_non_cons(A),var(B),!,A=..B. -'=~'(A,B):- compound_non_cons(B),!,A=B. -'=~'(A,B):- '=..'(A,B). +'=~'(A,B):- notrace('=~0'(A,B)). + +'=~0'(A,B):- compound_non_cons(B),!,into_list_args(B,BB),!,'=~'(A,BB). +'=~0'(B,A):- compound_non_cons(B),!,into_list_args(B,BB),!,'=~'(A,BB). +'=~0'(A,B):- iz_conz(A),iz_conz(B),!,A=B. +'=~0'(A,B):- var(A),iz_conz(B),!,A=B. +'=~0'(A,B):- iz_conz(A),var(B),!,A=B. +'=~0'(A,B):- compound_non_cons(A),var(B),!,A=..B. +'=~0'(A,B):- compound_non_cons(B),!,A=B. +'=~0'(A,B):- '=..'(A,B). + +x_assign(X,X). %into_list_args(A,AA):- is_ftVar(A),AA=A. %into_list_args(C,[C]):- \+ compound(C),!. @@ -137,11 +169,47 @@ strip_m(M:BB,BB):- nonvar(BB),nonvar(M),!. strip_m(BB,BB). +cname_var(Sym,Src):- gensym(Sym,SrcV), ignore(Src='$VAR'(SrcV)), + debug_var(SrcV,Src). + +de_eval(eval(X),X):- compound(X),!. + +call1(G):- call(G). +call2(G):- call(G). +call3(G):- call(G). +call4(G):- call(G). +call5(G):- call(G). + +trace_break:- trace,break. + +:- if(debugging(metta(compiler_bugs))). +:- set_prolog_flag(gc,false). +:- endif. + +call_fr(G,Result,FA):- current_predicate(FA),!,call(G,Result). +call_fr(G,Result,_):- Result=G. + + +% !(compile-body! (+ 1 $x) ) +% !(compile-body! (assertEqualToResult (Add (S (S Z)) (S (S (S Z)))) ((S (S (S (S (S Z))))))) ) +compile_body(Body, Output):- + must_det_ll(( + term_variables(Body,BodyVars), + maplist(cname_var('In_'),BodyVars), + compile_for_exec(Ret, Body, Code), + Output = is_p1(Body,Code,Ret), + cname_var('Out_',Ret), + guess_varnames(Code,PrintCode), + print_tree_nl(out(Ret):-(PrintCode)))). + % ?- compile_for_exec(RetResult, is(pi+pi), Converted). -compile_for_exec(Res,I,O):- +compile_for_exec(Res,I,OO):- %ignore(Res='$VAR'('RetResult')),` - compile_for_exec0(Res,I,O),!. + must_det_ll(( + compile_for_exec0(Res,I,O), + ast_to_prolog(no_caller,O,OO))),!. + compile_for_exec0(Res,I,eval_args(I,Res)):- is_ftVar(I),!. compile_for_exec0(Res,(:- I),O):- !, compile_for_exec0(Res,I,O). @@ -158,28 +226,124 @@ %compile_for_exec0(Res,I,O):- f2p(exec(),Res,I,O). compile_for_exec1(AsBodyFn, Converted) :- + must_det_ll(( Converted = (HeadC :- NextBodyC), % Create a rule with Head as the converted AsFunction and NextBody as the converted AsBodyFn - f2p([exec0],HResult,AsBodyFn,NextBody), + f2p([exec0],[],HResult,eager,AsBodyFn,NextBody), %optimize_head_and_body(x_assign([exec0],HResult),NextBody,HeadC,NextBodyB), - ast_to_prolog_aux([],[native(exec0),HResult],HeadC), - ast_to_prolog([],NextBody,NextBodyC). - -compile_for_assert(HeadIs, AsBodyFn, Converted) :- - HeadIs=[FnName|Args], + ast_to_prolog(no_caller,fn_native(exec0,[HResult]),HeadC), + %ast_to_prolog(Caller,[[native(trace)]|NextBody],NextBodyC). + ast_to_prolog(HeadC,NextBody,NextBodyC))),!. + +arrange_lazy_args(N,Y,N-Y). + +get_operator_typedef_props(X,FnName,Largs,Types,RetType) :- + get_operator_typedef(X,FnName,Largs,Types,RetType),!. +get_operator_typedef_props(_,_,Largs,Types,'Any') :- + length(Types,Largs), + maplist(=('Any'), Types). + +member_var(X, [H|T]) :- X == H ; member_var(X, T). + +intersect_var([],_,[]). +intersect_var([H|T],X,Y) :- + intersect_var(T,X,Y0), + (member_var(H,X) -> Y=[H|Y0] ; Y=Y0). + +union_var([],X,X). +union_var([H|T],X,Y) :- + union_var(T,X,Y0), + (member_var(H,X) -> Y=Y0 ; Y=[H|Y0]). + +determine_eager_vars(lazy,lazy,A,[]) :- fullvar(A),!. +determine_eager_vars(eager,eager,A,[A]) :- fullvar(A),!. +determine_eager_vars(Lin,Lout,[if,If,Then,Else],EagerVars) :- !, + determine_eager_vars(eager,_,If,EagerVarsIf), + determine_eager_vars(Lin,LoutThen,Then,EagerVarsThen), + determine_eager_vars(Lin,LoutElse,Else,EagerVarsElse), + intersect_var(EagerVarsThen,EagerVarsElse,EagerVars0), + union_var(EagerVarsIf,EagerVars0,EagerVars), + (LoutThen=eager,LoutElse=eager -> Lout=eager ; Lout=lazy). +determine_eager_vars(Lin,Lout,[let,V,Vbind,Body],EagerVars) :- !, + determine_eager_vars(eager,eager,Vbind,EagerVarsVbind), + determine_eager_vars(Lin,Lout,Body,EagerVarsBody), + union_var([V],EagerVarsVbind,EagerVars0), + union_var(EagerVars0,EagerVarsBody,EagerVars). +determine_eager_vars(Lin,Lout,['let*',[],Body],EagerVars) :- !,determine_eager_vars(Lin,Lout,Body,EagerVars). +determine_eager_vars(Lin,Lout,['let*',[[V,Vbind]|T],Body],EagerVars) :- !, + determine_eager_vars(eager,eager,Vbind,EagerVarsVbind), + determine_eager_vars(Lin,Lout,['let*',T,Body],EagerVarsBody), + union_var([V],EagerVarsVbind,EagerVars0), + union_var(EagerVars0,EagerVarsBody,EagerVars). +determine_eager_vars(_,RetLazy,[Fn|Args],EagerVars) :- atom(Fn),!, length(Args,LenArgs), LenArgsPlus1 is LenArgs+1, + (transpiler_clause_store(Fn,LenArgsPlus1,_,_,ArgsLazy0,RetLazy0,_,_) -> + ArgsLazy=ArgsLazy0, + RetLazy=RetLazy0 + ; + RetLazy=eager, + length(ArgsLazy, LenArgs), + maplist(=(eager), ArgsLazy)), + maplist(determine_eager_vars,ArgsLazy,_,Args,EagerVars0), + foldl(union_var,EagerVars0,[],EagerVars). +determine_eager_vars(_,eager,A,EagerVars) :- is_list(A),!, + maplist(determine_eager_vars(eager),_,A,EagerVars0),foldl(union_var,EagerVars0,[],EagerVars). +determine_eager_vars(_,eager,_,[]). + +set_eager_or_lazy(Vlist,V,R) :- (member_var(V,Vlist) -> R=eager ; R=lazy). + +combine_lazy_types_props(lazy,_-lazy,lazy):-!. +combine_lazy_types_props(_,_,eager). + +ensure_callee_site(Space,Fn,Arity):-transpiler_stub_created(Space,Fn,Arity),!. +ensure_callee_site(Space,Fn,Arity):- + must_det_ll(( + assertz(transpiler_stub_created(Space,Fn,Arity)), + transpile_call_prefix(Fn,CFn), + %trace, +((current_predicate(CFn/Arity) -> true ; + must_det_ll((( functor(CallP,CFn,Arity), + CallP=..[CFn|Args], + transpile_impl_prefix(Fn,IFn), CallI=..[IFn|Args], + %dynamic(IFn/Arity), + append(InArgs,[OutArg],Args), + Clause= (CallP:-((pred_uses_impl(Fn,Arity),CallI)*->true;(mc_fallback_unimpl(Fn,Arity,InArgs,OutArg)))), + output_prolog(Clause), + create_and_consult_temp_file(Space,CFn/Arity,[Clause])))))))),!. + +% !(compile-for-assert (plus1 $x) (+ 1 $x) ) +compile_for_assert(HeadIs, AsBodyFn, Converted) :- + must_det_ll(( + %leash(-all), + %trace, + current_self(Space), + as_functor_args(HeadIs,FnName,LenArgs,Args), + LenArgsPlus1 is LenArgs+1, + %fail, %AsFunction = HeadIs, must_det_ll(( Converted = (HeadC :- NextBodyC), % Create a rule with Head as the converted AsFunction and NextBody as the converted AsBodyFn - %leash(-all),trace, - f2p(HeadIs,HResult,AsBodyFn,NextBody), + get_operator_typedef_props(_,FnName,LenArgs,Types0,RetType0), + maplist(arg_eval_props,Types0,TypeProps), + arg_eval_props(RetType0,RetProps), + determine_eager_vars(lazy,ResultEager,AsBodyFn,EagerArgList), + maplist(set_eager_or_lazy(EagerArgList),Args,EagerLazyList), + maplist(combine_lazy_types_props,EagerLazyList,TypeProps,FinalLazyArgs), + combine_lazy_types_props(ResultEager,RetProps,FinalLazyRet), + %format("\n##################################Eager args ~q ~q ~q\n\n",[EagerArgList,FinalLazyArgs,FinalLazyRet]), + %maplist(determine_eager(AsBodyFn),Args,) + assertz(transpiler_clause_store(FnName,LenArgsPlus1,Types0,RetType0,FinalLazyArgs,FinalLazyRet,HeadIs,AsBodyFn)), + maplist(arrange_lazy_args,Args,FinalLazyArgs,LazyArgsList), + %leash(-all), + %trace, + f2p(HeadIs,LazyArgsList,HResult,FinalLazyRet,AsBodyFn,NextBody), - %format("HeadIs:~w HResult:~w AsBodyFn:~w NextBody:~w\n",[HeadIs,HResult,AsBodyFn,NextBody]), + %format("HeadIs:~q HResult:~q AsBodyFn:~q NextBody:~q\n",[HeadIs,HResult,AsBodyFn,NextBody]), %format("HERE\n"), %trace, %(var(HResult) -> (Result = HResult, HHead = Head) ; % funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head)), - ast_to_prolog_aux([FnName/LenArgsPlus1],[assign,HResult,[call(FnName)|Args]],HeadC), + ast_to_prolog(no_caller,fn_impl(FnName,Args,HResult),HeadC), output_language( ast, (( \+ \+ (( no_conflict_numbervars(HeadC + NextBody), @@ -188,19 +352,26 @@ true))))), - ast_to_prolog([FnName/LenArgsPlus1],NextBody,NextBodyC), - output_language(prolog, (print_pl_source(Converted))), - true - )). + must_det_ll((ast_to_prolog(caller(FnName,LenArgsPlus1),NextBody,NextBodyC), + output_prolog(Converted))), + add_assertion(Space,Converted), + asserta_if_new(pred_uses_impl(FnName,LenArgsPlus1)), + ensure_callee_site(Space,FnName,LenArgsPlus1), + true)))). +output_prolog(Converted:-B):- !, %'#707084' + color_g_mesg(cyan,output_language(prolog, (print_pl_source(Converted:-B)))). +output_prolog(Converted):- !, %'#707084' + color_g_mesg(cyan,output_language(prolog, (print_pl_source(Converted:-true)))). + no_conflict_numbervars(Term):- findall(N,(sub_term(E,Term),compound(E), '$VAR'(N)=E, integer(N)),NL),!, max_list([-1|NL],Max),Start is Max + 1,!, numbervars(Term,Start,_,[attvar(skip),singletons(true)]). %compile_for_assert(HeadIs, AsBodyFn, Converted) :- -% format("compile_for_assert: ~w ~w\n",[HeadIs, AsBodyFn]), +% format("compile_for_assert: ~q ~q\n",[HeadIs, AsBodyFn]), % HeadIs=[FnName|Args], % length(Args,LenArgs), % LenArgsPlus1 is LenArgs+1, @@ -215,11 +386,11 @@ % f2p(HeadIs,Result,AsBodyFn,NextBody), % %RetResult = Converted, % %RetResult = _, -% format("000000 ~w xxx ~w 000000\n\n",[Head,NextBody]), +% format("000000 ~q xxx ~q 000000\n\n",[Head,NextBody]), % optimize_head_and_body(Head,NextBody,HeadC,NextBodyB), -% format("111111 ~w xxx ~w 111111\n\n",[HeadC,NextBodyB]), -% ast_to_prolog([FnName/LenArgsPlus1],NextBodyB,NextBodyC), -% format("222222 ~w 222222\n\n",[NextBodyC]), +% format("111111 ~q xxx ~q 111111\n\n",[HeadC,NextBodyB]), +% ast_to_prolog(Caller,[FnName/LenArgsPlus1],NextBodyB,NextBodyC), +% format("222222 ~q 222222\n\n",[NextBodyC]), % %fbug([convert(Convert),head_preconds_into_body(HeadC:-NextBodyC)]), % %if_t(((Head:-NextBody)\=@=(HeadC:-NextBodyC)),fbug(was(Head:-NextBody))), % nop(ignore(Result = '$VAR'('HeadRes'))))),!. @@ -248,14 +419,14 @@ functs_to_preds0(I,OO):- sexpr_s2p(I, M), - f2p(_,_,M,O), + f2p(_,vs(_),_,_Evaluated,M,O), expand_to_hb(O,H,B), head_preconds_into_body(H,B,HH,BB),!, OO = ':-'(HH,BB). optimize_head_and_body(Head,Body,HeadNewest,BodyNewest):- label_body_singles(Head,Body), - color_g_mesg('#404064',print_pl_source(( Head :- Body))), + color_g_mesg('#707084',print_pl_source(( Head :- Body))), (merge_and_optimize_head_and_body(Head,Body,HeadNew,BodyNew), % iterate to a fixed point (((Head,Body)=@=(HeadNew,BodyNew)) @@ -376,46 +547,144 @@ get_decl_type(N,DT):- attvar(N),get_atts(N,AV),sub_term(DT,AV),atom(DT). -ast_to_prolog(DontStub,A,Result) :- - maplist(ast_to_prolog_aux(DontStub),A,B), - combine_code_list(B,Result). - -fullvar(V) :- var(V). +fullvar(V) :- var(V), !. fullvar('$VAR'(_)). -ast_to_prolog_aux(_,A,A) :- fullvar(A),!. -ast_to_prolog_aux(DontStub,list(A),B) :- !,maplist(ast_to_prolog_aux(DontStub),A,B). -ast_to_prolog_aux(DontStub,[prolog_if,If,Then,Else],R) :- !, - ast_to_prolog(DontStub,If,If2), - ast_to_prolog(DontStub,Then,Then2), - ast_to_prolog(DontStub,Else,Else2), +prefix_impl_preds(Prefix,F,A):- prefix_impl_preds_pp(Prefix,F,A). +prefix_impl_preds('mc__',F,A):- is_transpile_call_prefix(F,Fn),current_predicate(Fn/A), \+ prefix_impl_preds_pp(_,F,A). +prefix_impl_preds('mi__',F,A):- is_transpile_impl_prefix(F,Fn),current_predicate(Fn/A), \+ prefix_impl_preds_pp(_,F,A). + +prefix_impl_preds_pp(Prefix,F,A):- predicate_property('mc__:'(_,_,_),file(File)),predicate_property(Preds,file(File)),functor(Preds,Fn,A), + ((transpile_impl_prefix(Prefix);transpile_call_prefix(Prefix)),atom_concat(Prefix,F,Fn)). + +maplist_and_conj(_,A,B):- fullvar(A),!,B=A. +maplist_and_conj(_,A,B):- \+ compound(A),!,B=A. +maplist_and_conj(P2,(A,AA),[B|BB]):- !, maplist_and_conj(P2,A,B), maplist_and_conj(P2,AA,BB). +maplist_and_conj(P2,[A|AA],[B|BB]):- !, call(P2,A,B), maplist_and_conj(P2,AA,BB). +maplist_and_conj(P2,A,B):- call(P2,A,B), !. + +notice_callee(Caller,Callee):- + ignore(( + extract_caller(Caller,CallerInt,CallerSz), + extract_caller(Callee,F,LArgs1),!, + notice_callee(CallerInt,CallerSz,F,LArgs1))). + +notice_callee(CallerInt,CallerSz,F,LArgs1):- + ignore(( + CallerInt \== no_caller, + F \== exec0, + CallerInt \== exec0, + \+ (transpiler_depends_on(CallerInt,CallerSzU,F,LArgs1U), CallerSzU=@=CallerSz, LArgs1U=@=LArgs1), + assertz(transpiler_depends_on(CallerInt,CallerSz,F,LArgs1)), + (transpiler_show_debug_messages -> format("; Asserting: transpiler_depends_on(~q,~q,~q,~q)\n",[CallerInt,CallerSz,F,LArgs1]) -> true), + ignore((current_self(Space),ensure_callee_site(Space,CallerInt,CallerSz))), + output_prolog(transpiler_depends_on(CallerInt,CallerSz,F,LArgs1)) )), + ignore(( + current_self(Space),ensure_callee_site(Space,F,LArgs1))). + +extract_caller(Var,_,_):- fullvar(Var),!,fail. +extract_caller([H|Args],F,CallerSzP1):- !, extract_caller(fn_eval(H,Args,_),F,CallerSzP1). +extract_caller(fn_impl(F,Args,_),F,CallerSzP1):- !, extract_caller(fn_eval(F,Args,_),F,CallerSzP1). +extract_caller(fn_eval(F,Args,_),F,CallerSzP1):- is_list(Args), !, length(Args,CallerSz),CallerSzP1 is CallerSz+1. +extract_caller(fn_eval(F,Args,_),F,CallerSzP1):- !, \+ is_list(Args), !, CallerSzP1= _. +extract_caller(fn_native(F,Args),F,CallerSz):- !, length(Args,CallerSz). +extract_caller(caller(CallerInt,CallerSz),CallerInt,CallerSz):-!. +extract_caller((CallerInt/CallerSz),CallerInt,CallerSz):-!. +extract_caller(H:-_,CallerInt,CallerSz):- !, extract_caller(H,CallerInt,CallerSz). +extract_caller([=,H,_],CallerInt,CallerSz):- !, extract_caller(H,CallerInt,CallerSz). +extract_caller(P,F,A):- \+ callable(P),!, F=P,A=0. +extract_caller(P,F,A):- \+ is_list(P), functor(P,F,A). + +ast_to_prolog(Caller,A,Result) :- + must_det_ll((ast_to_prolog_aux(Caller,A,Result))). + + +ast_to_prolog_aux(_Caller,A,A) :-fullvar(A),!. +%ast_to_prolog_aux(Caller,[],true). +ast_to_prolog_aux(_Caller,H,H):- \+ compound(H),!. +ast_to_prolog_aux(Caller,assign(A,X0),(A=X1)) :- !, ast_to_prolog_aux(Caller,X0,X1),!. +ast_to_prolog_aux(_Caller,'#\\'(A),A). + +% Roy's API +ast_to_prolog_aux(Caller,[assign,[call(F)|Args0],A],R):- ast_to_prolog_aux(Caller,fn_eval(F,Args0,A),R). +ast_to_prolog_aux(Caller,[native(F)|Args0],R):- ast_to_prolog_aux(Caller,fn_native(F,Args0),R). +ast_to_prolog_aux(Caller,[is_p1,Src,Code0,R],is_p1(Src,Code1,R)) :- !,ast_to_prolog(Caller,Code0,Code1). + + +ast_to_prolog_aux(Caller, if_or_else(If,Else),R):- ast_to_prolog_aux(Caller, (If*->true;Else),R). +ast_to_prolog_aux(Caller, Smack,R):- + compound(Smack), + Smack=..[NSF, _,_AnyRet, Six66,_Self, FArgs,Ret], + (NSF = eval_args;NSF = eval_20), + \+ atom_concat(find,_,NSF), + \+ atom_concat(_,e,NSF), + Six66 == 666, + ast_to_prolog_aux(Caller,eval(FArgs,Ret),R). +ast_to_prolog_aux(Caller, eval([F|Args],Ret),R):- atom(F),is_list(Args), + ast_to_prolog_aux(Caller,fn_eval(F,Args,Ret),R), !. + +ast_to_prolog_aux(Caller,(A),B) :- is_list(A),!,maplist(ast_to_prolog_aux(Caller),A,B). +ast_to_prolog_aux(Caller,[A],O) :- !, ast_to_prolog_aux(Caller,A,O). +ast_to_prolog_aux(Caller,list(A),B) :- is_list(A),!,maplist(ast_to_prolog_aux(Caller),A,B). +ast_to_prolog_aux(Caller,[prolog_if,If,Then,Else],R) :- !, + ast_to_prolog(Caller,If,If2), + ast_to_prolog(Caller,Then,Then2), + ast_to_prolog(Caller,Else,Else2), R=((If2) *-> (Then2);(Else2)). -ast_to_prolog_aux(DontStub,[native(F)|Args0],A) :- !, - maplist(ast_to_prolog_aux(DontStub),Args0,Args1), - A=..[F|Args1]. -ast_to_prolog_aux(DontStub,[assign,A,[call(F)|Args0]],R) :- (fullvar(A);\+ compound(A)),atom(F),!, - maplist(ast_to_prolog_aux(DontStub),Args0,Args1), - transpile_prefix(Prefix), - atom_concat(Prefix,F,Fp), - length(Args0,LArgs), - LArgs1 is LArgs+1, - append(Args1,[A],Args2), - R=..[Fp|Args2], - ((current_predicate(Fp/LArgs1);member(F/LArgs1,DontStub)) -> - true - ; check_supporting_predicates('&self',F/LArgs1)). -ast_to_prolog_aux(DontStub,[assign,A,X0],(A=X1)) :- ast_to_prolog_aux(DontStub,X0,X1),!. -%ast_to_prolog_aux(_,x_assign(A,B),R) :- (fullvar(A);\+ compound(A)),!,R=(A=B). -%ast_to_prolog_aux(DontStub,x_assign(A,B),R) :- var(B),\+ var(A),!, -% ast_to_prolog_aux(DontStub,x_assign(B,A),R). -%ast_to_prolog_aux(DontStub,A,B) :- -% compound(A), -% A=..A0,!, -% maplist(ast_to_prolog_aux(DontStub),A0,B0), -% B=..B0. -ast_to_prolog_aux(_,'#\\'(A),A). +ast_to_prolog_aux(Caller,(If*->Then;Else),R) :- !, + ast_to_prolog(Caller,If,If2), + ast_to_prolog(Caller,Then,Then2), + ast_to_prolog(Caller,Else,Else2), + R=((If2) *-> (Then2);(Else2)). +ast_to_prolog_aux(Caller,fn_native(F,Args0),A) :- !, + %maplist(ast_to_prolog_aux(Caller),Args0,Args1), + F=..[Fn|Pre], % allow compound natives + append(Pre,Args0,ArgsNow), + A=..[Fn|ArgsNow], + notice_callee(Caller,A). + + + + + +ast_to_prolog_aux(Caller,fn_eval(F,Args00,A),R) :- atom(F), (fullvar(A); \+ compound(A)),!, + maybe_lazy_list(Caller,F,1,Args00,Args0), + transpile_call_prefix(F,Fp), + append(Args0,[A],Args1), + notice_callee(Caller,fn_eval(F,Args00,A)), + R=..[Fp|Args1]. +ast_to_prolog_aux(Caller,fn_impl(F,Args00,A),R) :- atom(F), (fullvar(A); \+ compound(A)),!, + maybe_lazy_list(Caller,F,1,Args00,Args0), + transpile_impl_prefix(F,Fp), + append(Args0,[A],Args1), + notice_callee(Caller,fn_impl(F,Args00,A)), + R=..[Fp|Args1]. +ast_to_prolog_aux(Caller,(True,T),R) :- True == true, ast_to_prolog_aux(Caller,T,R). +ast_to_prolog_aux(Caller,(T,True),R) :- True == true, ast_to_prolog_aux(Caller,T,R). +ast_to_prolog_aux(Caller,(H;T),(HH;TT)) :- ast_to_prolog_aux(Caller,H,HH),ast_to_prolog_aux(Caller,T,TT). +ast_to_prolog_aux(Caller,(H,T),(HH,TT)) :- ast_to_prolog_aux(Caller,H,HH),ast_to_prolog_aux(Caller,T,TT). +%ast_to_prolog_aux(Caller,[H],HH) :- ast_to_prolog_aux(Caller,H,HH). +%ast_to_prolog_aux(Caller,[H|T],(HH,TT)) :- ast_to_prolog_aux(Caller,H,HH),ast_to_prolog_aux(Caller,T,TT). +ast_to_prolog_aux(Caller,do_metta_runtime(T,G),do_metta_runtime(T,GGG)) :- !, ast_to_prolog_aux(Caller,G,GG),combine_code(GG,GGG). +ast_to_prolog_aux(Caller,loonit_assert_source_tf(T,G),loonit_assert_source_tf(T,GG)) :- !, ast_to_prolog_aux(Caller,G,GG). +ast_to_prolog_aux(Caller,findall(T,G,L),findall(T,GG,L)) :- !, ast_to_prolog_aux(Caller,G,GG). +ast_to_prolog_aux(Caller,FArgs,NewFArgs):- compound(FArgs),!, + compound_name_arguments(FArgs, Name, Args), + maplist(ast_to_prolog_aux(Caller),Args,NewArgs), + compound_name_arguments(NewCompound, Name, NewArgs),NewFArgs=NewCompound. ast_to_prolog_aux(_,A,A). +maybe_lazy_list(_,_,_,[],[]):-!. +maybe_lazy_list(Caller,F,N,[Arg|Args],[ArgO|ArgsO]):- maybe_argo(Caller,F,N,Arg,ArgO), + N2 is N +1, + maybe_lazy_list(Caller,F,N2,Args,ArgsO). + +maybe_argo(_Caller,_F,_N,Arg,Arg):- is_list(Arg),!. +maybe_argo(_Caller,_F,_N,Arg,Arg):- \+ compound(Arg),!. +maybe_argo(Caller,_F,_N,Arg,ArgO):- ast_to_prolog_aux(Caller,Arg,ArgO). + + +/* combine_code_list(A,R) :- !, combine_code_list_aux(A,R0), (R0=[] -> R=true @@ -428,8 +697,9 @@ combine_code_list_aux([true|T],R) :- !,combine_code_list_aux(T,R). combine_code_list_aux([H|T],R) :- H=..[','|H0],!,append(H0,T,T0),combine_code_list_aux(T0,R). combine_code_list_aux([H|T],[H|R]) :- combine_code_list_aux(T,R). +*/ - +/* check_supporting_predicates(Space,F/A) :- % already exists transpile_prefix(Prefix), atom_concat(Prefix,F,Fp), @@ -439,9 +709,11 @@ H=..[Fp|AtomList0], Am1 is A-1, findall(Atom1, (between(1, Am1, I1), Atom1='$VAR'(I1)), AtomList1), - B=..[u_assign,[F|AtomList1],'$VAR'(A)], - (enable_interpreter_calls -> G=true;G=fail), - create_and_consult_temp_file(Space,Fp/A,[H:-(format("; % ######### warning: using stub for:~w\n",[F]),G,B)]))). + B=fn_eval(F,AtomList1,'$VAR'(A)), + % (transpiler_enable_interpreter_calls -> G=true;G=fail), + assertz(transpiler_stub_created(F/A)), + create_and_consult_temp_file(Space,Fp/A,[H:-(format("; % ######### warning: using stub for:~q\n",[F]),trace,transpiler_enable_interpreter_calls,B)]))). +*/ % Predicate to create a temporary file and write the tabled predicate create_and_consult_temp_file(Space,F/A, PredClauses) :- @@ -449,12 +721,12 @@ % Generate a unique temporary memory buffer tmp_file_stream(text, TempFileName, TempFileStream), % Write the tabled predicate to the temporary file - format(TempFileStream, ':- multifile((~q)/~w).~n', [metta_compiled_predicate, 3]), - format(TempFileStream, ':- dynamic((~q)/~w).~n', [metta_compiled_predicate, 3]), + format(TempFileStream, ':- multifile((~q)/~q).~n', [metta_compiled_predicate, 3]), + format(TempFileStream, ':- dynamic((~q)/~q).~n', [metta_compiled_predicate, 3]), format(TempFileStream, '~N~q.~n',[metta_compiled_predicate(Space,F,A)]), - format(TempFileStream, ':- multifile((~q)/~w).~n', [F, A]), - format(TempFileStream, ':- dynamic((~q)/~w).~n', [F, A]), + format(TempFileStream, ':- multifile((~q)/~q).~n', [F, A]), + format(TempFileStream, ':- dynamic((~q)/~q).~n', [F, A]), %if_t( \+ option_value('tabling',false), if_t(option_value('tabling','True'),format(TempFileStream,':- ~q.~n',[table(F/A)])), maplist(write_clause(TempFileStream), PredClauses), @@ -463,7 +735,7 @@ % Consult the temporary file % abolish(F/A), /*'&self':*/ - % sformat(CAT,'cat ~w',[TempFileName]), shell(CAT), + % sformat(CAT,'cat ~q',[TempFileName]), shell(CAT), consult(TempFileName), % listing(F/A), @@ -530,422 +802,998 @@ u_assign_c(FList,R):- compound(FList), !, FList=~R. quietlY(G):- call(G). +unshebang(S,US):- symbol(S),(symbol_concat(US,'!',S)->true;US=S). -:- discontiguous f2p/4. +compile_maplist_p2(_,[],[],true). +compile_maplist_p2(P2,[Var|Args],[Res|NewArgs],PreCode):- \+ fullvar(Var), call(P2,Var,Res), !, + compile_maplist_p2(P2,Args,NewArgs,PreCode). +compile_maplist_p2(P2,[Var|Args],[Res|NewArgs],TheCode):- + compile_maplist_p2(P2,Args,NewArgs,PreCode), + combine_code(fn_native(P2,[Var,Res]),PreCode,TheCode). + + +var_prop_lookup(_,[],eager). +var_prop_lookup(X,[H-R|T],S) :- + X == H,S=R; % Test if X and H are the same variable + var_prop_lookup(X,T,S). % Recursively check the tail of the list + +:- discontiguous f2p/6. + +f2p(_HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- % must_det_ll(is_var_set(LazyVars)), + (is_ftVar(Convert);number(Convert)),!, % Check if Convert is a variable + var_prop_lookup(Convert,LazyVars,L), + lazy_impedance_match(L,ResultLazy,Convert,[],RetResult,Converted). -f2p(_HeadIs,Convert, Convert, []) :- - (is_ftVar(Convert);number(Convert)),!.% Check if Convert is a variable +f2p(_HeadIs, _LazyVars, RetResult, ResultLazy, Orig, Converted) :- Orig = '#\\'(Convert), + (ResultLazy=eager -> + RetResult=Convert, + Converted=true + ; Converted=assign(RetResult,is_p1(Orig,true,Convert))). -f2p(_HeadIs, X, '#\\'(X), []). +% If Convert is a number or an atom, it is considered as already converted. +f2p(_HeadIs, _LazyVars, RetResult, ResultLazy, Convert, Converted) :- % HeadIs\=@=Convert, + once(number(Convert); atomic(Convert); data_term(Convert)), % Check if Convert is a number or an atom + (ResultLazy=eager -> C2=Convert ; C2=is_p1(Convert,true,Convert)), + Converted= true, RetResult =C2, + % For OVER-REACHING categorization of dataobjs % + % wdmsg(data_term(Convert)), + %trace_break, + !. % Set RetResult to Convert as it is already in predicate form % If Convert is a number or an atom, it is considered as already converted. -f2p(_HeadIs,RetResult, Convert, Converted) :- % HeadIs\=@=Convert, - Converted=[[assign,RetResult,Convert]], +f2p(_HeadIs, _LazyVars, RetResult, ResultLazy, Convert, Converted) :- % HeadIs\=@=Convert, once(number(Convert); atom(Convert); data_term(Convert)), % Check if Convert is a number or an atom + (ResultLazy=eager -> C2=Convert ; C2=is_p1(Convert,true,Convert)), + Converted=assign(RetResult,C2), % For OVER-REACHING categorization of dataobjs % % wdmsg(data_term(Convert)), %trace_break, !. % Set RetResult to Convert as it is already in predicate form -f2p(HeadIs,RetResult,Convert, Converted):- +f2p(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted):- Convert=[Fn|_], atom(Fn), - compile_flow_control(HeadIs,RetResult,Convert, Converted),!. + compile_flow_control(HeadIs,LazyVars,RetResult,ResultLazy, Convert, Converted),!. -f2p(HeadIs,RetResult, Convert, Converted) :- HeadIs\=@=Convert, +% !(compile-body! (call-fn! compile_body (call-p writeln "666")) +f2p(HeadIs, _LazyVars, RetResult, ResultLazy, Convert, Converted) :- HeadIs\=@=Convert, + Convert=[Fn,Native|Args],atom(Fn),unshebang(Fn,'call-p'),!, + must_det_ll(( + compile_maplist_p2(as_prolog,Args,NewArgs,PreCode), + %RetResult = 'True', + compile_maplist_p2(from_prolog_args(ResultLazy),NewArgs,Args,PostCode), + combine_code((PreCode,fn_native(Native,NewArgs),assign(RetResult,'True')),PostCode,Converted))). + +% !(compile-body! (call-fn length $list)) +f2p(HeadIs, _LazyVars, RetResult, ResultLazy, Convert, Converted) :- HeadIs\=@=Convert, + Convert=[Fn,Native|Args],atom(Fn),unshebang(Fn,'call-fn'),!, + compile_maplist_p2(as_prolog,Args,NewArgs,PreCode), + append(NewArgs,[Result],CallArgs), + compile_maplist_p2(from_prolog_args(maybe(ResultLazy)),[Result],[RetResult],PostCode), + combine_code(PreCode,(fn_native(Native,CallArgs),PostCode),Converted). + +% !(compile-body! (call-fn-nth 0 wots version)) +f2p(HeadIs, _LazyVars, RetResult, ResultLazy, Convert, Converted) :- HeadIs\=@=Convert, + Convert=[Fn,Nth,Native|SIn],atom(Fn),unshebang(Fn,'call-fn-nth'),integer(Nth),!, + compile_maplist_p2(as_prolog,SIn,S,PreCode), + length(Left,Nth), + append(Left,Right,S), + append(Left,[R|Right],Args),!, + compile_maplist_p2(from_prolog_args(maybe(ResultLazy)),[R],[RetResult],PostCode), + combine_code(PreCode,(fn_native(Native,Args),PostCode),Converted). + +% !(compile-body! (length-p (a b c d) 4)) +% !(compile-body! (format! "~q ~q ~q" (a b c))) +f2p(HeadIs, _LazyVars, RetResult, ResultLazy, Convert, Converted) :- HeadIs\=@=Convert, + is_host_predicate(Convert,Native,_Len),!,Convert=[_|Args], + compile_maplist_p2(as_prolog,Args,NewArgs,PreCode), + %RetResult = 'True', + compile_maplist_p2(from_prolog_args(maybe(ResultLazy)),NewArgs,Args,PostCode), + combine_code(PreCode,(fn_native(Native,NewArgs),(assign(RetResult,'True'),PostCode)),Converted). + +% !(compile-body! (length-fn (a b c d))) +f2p(HeadIs, _LazyVars, RetResult, ResultLazy, Convert, Converted) :- HeadIs\=@=Convert, + Convert=[Fn|Args], + is_host_function([Fn|Args],Native,_Len),!, + compile_maplist_p2(as_prolog,Args,NewArgs,PreCode), + append(NewArgs,[Result],CallArgs), + compile_maplist_p2(from_prolog_args(maybe(ResultLazy)),[Result],[RetResult],PostCode), + combine_code(PreCode,(fn_native(Native,CallArgs),PostCode),Converted). + +f2p(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- HeadIs\=@=Convert, Convert=[Fn|_], \+ atom(Fn), Args = Convert, - maplist(f2p(HeadIs),NewArgs, Args, NewCodes), - append(NewCodes,CombinedNewCode), - Code=[assign,RetResult,list(NewArgs)], - append(CombinedNewCode,[Code],Converted). + length(Args, N), + % create an eval-args list. TODO FIXME revisit this after working out how lists handle evaluation + length(EvalArgs, N), + maplist(=(ResultLazy), EvalArgs), + maplist(f2p_skip_atom(HeadIs, LazyVars),NewArgs, EvalArgs, Args, NewCodes), + combine_code(NewCodes,assign(RetResult0,list(NewArgs)),Converted0), + lazy_impedance_match(eager,ResultLazy,RetResult0,Converted0,RetResult,Converted). + +update_laziness(X-_,Y,X-Y). + +f2p(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted):- + Convert=[Fn|_], + atom(Fn), + compile_flow_control1(HeadIs,LazyVars,RetResult,ResultLazy, Convert, Converted),!. +f2p(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted):- fail, + Convert=[Fn|_], + atom(Fn), + compile_flow_control2(HeadIs,LazyVars,RetResult,ResultLazy, Convert, Converted),!. -f2p(HeadIs,RetResult, Convert, Converted) :- HeadIs\=@=Convert, +f2p(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- HeadIs\=@=Convert, Convert=[Fn|Args], atom(Fn),!, length(Args,Largs), - get_operator_typedef(_,Fn,Largs,Types,_RetType), - maplist(is_arg_eval,Types,EvalArgs), - %, - maplist(do_arg_eval(HeadIs),Args,EvalArgs,NewArgs,NewCodes), - append(NewCodes,CombinedNewCode), - %into_x_assign([Fn|NewArgs],RetResult,Code), - Code=[assign,RetResult,[call(Fn)|NewArgs]], - append(CombinedNewCode,[Code],Converted). - %combine_code_list(CombinedNewCode1,Converted). - -% temporary placeholder -is_arg_eval('Number',yes) :- !. -is_arg_eval('Bool',yes) :- !. -is_arg_eval('Any',yes) :- !. -is_arg_eval('Atom',yes) :- !. -is_arg_eval(_,no). - -do_arg_eval(_,Arg,no,Arg,[]). -do_arg_eval(HeadIs,Arg,yes,NewArg,Code) :- f2p(HeadIs,NewArg,Arg,Code). - -% The catch-all If no specific case is matched, consider Convert as already converted. -%f2p(_HeadIs,_RetResult,x_assign(Convert,Res), x_assign(Convert,Res)):- !. -%f2p(_HeadIs,RetResult,Convert, Code):- into_x_assign(Convert,RetResult,Code). - -f2p(HeadIs,list(Convert), Convert, []) :- HeadIs\=@=Convert, - is_list(Convert). + LenArgsPlus1 is Largs+1, + (transpiler_clause_store(Fn,LenArgsPlus1,_,_,ArgsLazy0,RetLazy0,_,_) -> + UpToDateArgsLazy=ArgsLazy0, + RetLazy=RetLazy0 + ; + RetLazy=eager, + length(UpToDateArgsLazy, Largs), + maplist(=(eager), UpToDateArgsLazy)), + % get the evaluation/laziness based on the types, but then update from the actual signature using 'update_laziness' + get_operator_typedef_props(_,Fn,Largs,Types0,_RetType0), + maplist(arg_eval_props,Types0,EvalArgs0), + maplist(update_laziness,EvalArgs0,UpToDateArgsLazy,EvalArgs), + maplist(do_arg_eval(HeadIs,LazyVars),Args,EvalArgs,NewArgs,NewCodes), + combine_code(NewCodes,CombinedNewCode), + combine_code(CombinedNewCode,fn_eval(Fn,NewArgs,RetResult0),Converted0), + lazy_impedance_match(RetLazy,ResultLazy,RetResult0,Converted0,RetResult,Converted). +f2p(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted):- fail, + Convert=[Fn|_], + atom(Fn), + compile_flow_control3(HeadIs,LazyVars,RetResult,ResultLazy, Convert, Converted),!. -f2p(HeadIs,_RetResult,Convert,_Code):- - format("Error in f2p ~w ~w\n",[HeadIs,Convert]), - throw(0). -:- discontiguous(compile_flow_control/4). +% The catch-all If no specific case is matched, consider Convert as already converted. +%f2p(_HeadIs, LazyVars, _RetResult, ResultLazy, x_assign(Convert,Res), x_assign(Convert,Res)):- !. +%f2p(_HeadIs, LazyVars, RetResult, ResultLazy, Convert, Code):- into_x_assign(Convert,RetResult,Code). + +%f2p(HeadIs, LazyVars, list(Convert), ResultLazy, Convert, []) :- trace,HeadIs\=@=Convert, +% is_list(Convert),!. +f2p(HeadIs, LazyVars, list(Converted), _ResultLazy, Convert, Codes) :- % HeadIs\=@=Convert, + is_list(Convert),!, + length(Convert, N), + % create an eval-args list. TODO FIXME revisit this after working out how lists handle evaluation + length(EvalArgs, N), + maplist(=(eager), EvalArgs), + maplist(f2p_skip_atom(HeadIs, LazyVars),Converted,EvalArgs,Convert,Allcodes), + combine_code(Allcodes,true,Codes). + +f2p_skip_atom(_HeadIs, _LazyVars,Converted, _EvalArgs, Convert,true):- + \+ compound(Convert), !, Converted = Convert. +f2p_skip_atom(HeadIs, LazyVars,Converted,EvalArgs,Convert,Allcodes):- + f2p(HeadIs, LazyVars,Converted,EvalArgs,Convert,Allcodes). + + +f2p(HeadIs,LazyVars,_RetResult,EvalArgs,Convert,_Code):- + format("Error in f2p ~q ~q ~q ~q\n",[HeadIs,LazyVars,Convert,EvalArgs]), + trace,throw(0). + +lazy_impedance_match(_,_,RetResult0,Converted0,RetResult0,Converted0):-!. +lazy_impedance_match(L,L,RetResult0,Converted0,RetResult0,Converted0). +lazy_impedance_match(lazy,eager,RetResult0,Converted0,RetResult,Converted) :- + combine_code(Converted0,fn_native(as_p1,[RetResult0,RetResult]),Converted). +lazy_impedance_match(eager,lazy,RetResult0,Converted0,RetResult,Converted) :- + combine_code(Converted0,assign(RetResult,is_p1(Converted0,true,RetResult0)),Converted). + + +arg_eval_props('Number',doeval-eager) :- !. +arg_eval_props('Bool',doeval-eager) :- !. +arg_eval_props('LazyBool',doeval-lazy) :- !. +arg_eval_props('Any',doeval-eager) :- !. +arg_eval_props('Expression',noeval-lazy) :- !. +arg_eval_props('Atom',noeval-lazy) :- !. +arg_eval_props('Evaluatable',doeval-lazy) :- !. +arg_eval_props(_,doeval-eager). + +%do_arg_eval(HeadIs,LazyVars,Arg,_DOELaz,NewArg,Code):- must_det_ll(is_var_set(LazyVars)),fail. +do_arg_eval(_,_,Arg,noeval-_,Arg,true). +do_arg_eval(HeadIs,LazyVars,Arg,doeval-lazy,is_p1(Arg,SubCode,SubArg),Code) :- + f2p(HeadIs,LazyVars,SubArg,eager,Arg,SubCode), + Code=true. +do_arg_eval(HeadIs,LazyVars,Arg,doeval-eager,NewArg,Code) :- f2p(HeadIs,LazyVars,NewArg,eager,Arg,Code). + +:- discontiguous(compile_flow_control/6). +:- discontiguous(compile_flow_control3/6). +:- discontiguous(compile_flow_control2/6). +:- discontiguous(compile_flow_control1/6). + + + + +in_type_set(Set,Type):- Set==Type,!. +in_type_set(Set,Type):- compound(Set),arg(_,Set,Arg),in_type_set(Arg,Type). + +b_put_set(Set,Type):- functor(Set,_,Arg),!,b_put_nset(Set,Arg,Type). +b_put_nset(Set,_,Type):- in_type_set(Set,Type),!. +b_put_nset(Set,N,Type):- arg(N,Set,Arg), + (compound(Arg)->b_put_set(Arg,Type);b_setarg(N,Set,[Type|Arg])). + +is_type_set(Set):-compound(Set),Set=ts(_). +is_var_set(Set):- compound(Set),Set=vs(_). +foc_var(Cond,vs([Var-Set|LazyVars]),TypeSet):-!, + (var(Set)->(Cond=Var,TypeSet=Set,TypeSet=ts([])); + (Var==Cond -> TypeSet = Set ; + (nonvar(LazyVars) -> foc_var(Cond,vs(LazyVars),TypeSet); + (TypeSet=ts([]),LazyVars=[Var-TypeSet|_])))). +foc_var(Cond,Set,TSet):-add_type(Set,[Cond-TSet]),ignore(TSet=ts(List)),ignore(List=[]). + +add_type(Cond,Type,LazyVars):-is_var_set(LazyVars),!,must_det_ll((foc_var(Cond,LazyVars,TypeSet),!,add_type(TypeSet,Type))). +add_type(Cond,Type,_LazyVars):- add_type(Cond,Type),!. + +add_type(Cond,Type):-attvar(Cond),get_attr(Cond,ti,TypeSet),!,must_det_ll(add_type(TypeSet,Type)). +add_type(Cond,Type):-var(Cond),!,must_det_ll(put_attr(Cond,ti,ts(Type))),!. +add_type(Cond,Type):-is_type_set(Cond),!,must_det_ll(b_put_set(Cond,Type)),!. +add_type(Cond,Type):-is_var_set(Cond),!,must_det_ll(b_put_set(Cond,Type)),!. +add_type(Cond,Type):- dmsg(unable_to_add_type(Cond,Type)). add_assignment(A,B,CodeOld,CodeNew) :- (fullvar(A),var(B) -> B=A,CodeNew=CodeOld ; var(A),fullvar(B) -> A=B,CodeNew=CodeOld - ; append(CodeOld,[[assign,A,B]],CodeNew)). + ; combine_code(CodeOld,[assign(A,B)],CodeNew)). -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- - Convert = ['if',Cond,Then,Else],!, - %Test = is_True(CondResult), - f2p(HeadIs,CondResult,Cond,CondCode), - append(CondCode,[[native(is_True),CondResult]],If), - compile_test_then_else(RetResult,If,Then,Else,Converted). +compile_flow_control(_HeadIs,_LazyVars,_RetResult,_LazyEval,Convert,_):- \+ compound(Convert),!,fail. +compile_flow_control(_HeadIs,_LazyVars,_RetResult,_LazyEval,Convert,_):- compound_name_arity(Convert,_,0),!,fail. -compile_test_then_else(RetResult,If,Then,Else,Converted):- - f2p(HeadIs,ThenResult,Then,ThenCode), - f2p(HeadIs,ElseResult,Else,ElseCode), +compile_flow_control(HeadIs,LazyVars,RetResult,LazyEval,Convert, Converted) :- % must_det_ll(is_var_set(LazyVars)), + Convert =~ ['if',Cond,Then,Else],!, + %Test = is_True(CondResult), + %add_type(CondResult,'Bool',LazyVars), + %add_type(Cond,'Bool',LazyVars), + f2p(HeadIs,LazyVars,CondResult,eager,Cond,CondCode), + combine_code(CondCode,fn_native(is_True,[CondResult]),If), + compile_test_then_else(RetResult,LazyVars,LazyEval,If,Then,Else,Converted). + +compile_test_then_else(RetResult,LazyVars,LazyEval,If,Then,Else,Converted):- + f2p(HeadIs,LazyVars,ThenResult,LazyEval,Then,ThenCode), + f2p(HeadIs,LazyVars,ElseResult,LazyEval,Else,ElseCode), % cannnot use add_assignment here as might not want to unify ThenResult and ElseResult - append(ThenCode,[[assign,RetResult,ThenResult]],T), - append(ElseCode,[[assign,RetResult,ElseResult]],E), - Converted=[[prolog_if,If,T,E]]. + combine_code(ThenCode,assign(RetResult,ThenResult),T), + combine_code(ElseCode,assign(RetResult,ElseResult),E), + Converted=(If*->T;E). -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), - Convert = ['let',Var,Value1,Body],!, - f2p(HeadIs,ResValue1,Value1,CodeForValue1), +compile_flow_control(HeadIs,LazyVars,RetResult,LazyEval,Convert, Converted) :- % dif_functors(HeadIs,Convert), + Convert =~ ['let',Var,Value1,Body],!, + f2p(HeadIs,LazyVars,ResValue1,eager,Value1,CodeForValue1), add_assignment(Var,ResValue1,CodeForValue1,CodeForValue2), - f2p(HeadIs,RetResult,Body,BodyCode), - append(CodeForValue2,BodyCode,Converted). + f2p(HeadIs,LazyVars,RetResult,LazyEval,Body,BodyCode), + combine_code(CodeForValue2,BodyCode,Converted). -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- %dif_functors(HeadIs,Convert), +compile_flow_control(HeadIs,LazyVars,RetResult,LazyEval,Convert, Converted) :- %dif_functors(HeadIs,Convert), Convert =~ ['let*',Bindings,Body],!, must_det_ll(( - maplist(compile_let_star(HeadIs),Bindings,CodeList), - append(CodeList,Code), - f2p(HeadIs,RetResult,Body,BodyCode), - append(Code,BodyCode,Converted))). + maplist(compile_let_star(HeadIs,LazyVars),Bindings,CodeList), + combine_code(CodeList,Code), + f2p(HeadIs,LazyVars,RetResult,LazyEval,Body,BodyCode), + combine_code(Code,BodyCode,Converted))). -compile_let_star(HeadIs,[Var,Value1],Code) :- - f2p(HeadIs,ResValue1,Value1,CodeForValue1), +compile_let_star(HeadIs,LazyVars,[Var,Value1],Code) :- + f2p(HeadIs,LazyVars,ResValue1,eager,Value1,CodeForValue1), add_assignment(Var,ResValue1,CodeForValue1,Code). -unnumbervars_clause(Cl,ClU):- - copy_term_nat(Cl,AC),unnumbervars(AC,UA),copy_term_nat(UA,ClU). -% =============================== -% Compile in memory buffer -% =============================== -is_clause_asserted(AC):- unnumbervars_clause(AC,UAC), - expand_to_hb(UAC,H,B), - H=..[Fh|Args], - transpile_prefix(Prefix), - atom_concat(Prefix,Fh,FPrefixed), - H2=..[FPrefixed|Args], - clause(H2,B,Ref),clause(HH,BB,Ref), - strip_m(HH,HHH),HHH=@=H2, - strip_m(BB,BBB),BBB=@=B,!. +:- op(700,xfx, =~). +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, (Code1,Eval1Result=Result,Converted)) :- % dif_functors(HeadIs,Convert), + Convert =~ chain(Eval1,Result,Eval2),!, + f2p(HeadIs, LazyVars, Eval1Result, ResultLazy, Eval1,Code1), + f2p(HeadIs, LazyVars, RetResult, ResultLazy, Eval2,Converted). -%get_clause_pred(UAC,F,A):- expand_to_hb(UAC,H,_),strip_m(H,HH),functor(HH,F,A). +compile_flow_control2(HeadIs, LazyVars, ResValue2, ResultLazy, Convert, (CodeForValue1,Converted)) :- % dif_functors(HeadIs,Convert), + Convert =~ ['eval-in-space',Value1,Value2], + f2p(HeadIs, LazyVars, ResValue1, ResultLazy, Value1,CodeForValue1), + f2p(HeadIs, LazyVars, ResValue2, ResultLazy, Value2,CodeForValue2), + Converted = with_space(ResValue1,CodeForValue2). +/* +compile_flow_control2(_HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- % dif_functors(HeadIs,Convert), + Convert =~ ['bind!',Var,Value],is_ftVar(Value),!, + Converted = eval_args(['bind!',Var,Value],RetResult). +compile_flow_control2(_HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- % dif_functors(HeadIs,Convert), + Convert =~ ['bind!',Var,Value], Value =~ ['new-space'],!, + Converted = eval_args(['bind!',Var,Value],RetResult). -% :- dynamic(needs_tabled/2). +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- % dif_functors(HeadIs,Convert), + Convert =~ ['bind!',Var,Value], + f2p(HeadIs, LazyVars, ValueResult, ResultLazy, Value,ValueCode), + Converted = (ValueCode,eval_args(['bind!',Var,ValueResult],RetResult)). -add_assertion(Space,List):- is_list(List),!, - maplist(add_assertion(Space),List). -add_assertion(Space,AC):- unnumbervars_clause(AC,UAC), add_assertion1(Space,UAC). -add_assertion1(_,AC):- /*'&self':*/is_clause_asserted(AC),!. -%add_assertion1(_,AC):- get_clause_pred(AC,F,A), \+ needs_tabled(F,A), !, pfcAdd(/*'&self':*/AC),!. +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- % dif_functors(HeadIs,Convert), + once(Convert =~ if(Cond,Then,Else);Convert =~ 'if'(Cond,Then,Else)), + !,Test = is_True(CondResult), + f2p(HeadIs, LazyVars, CondResult, ResultLazy, Cond,CondCode), + compile_test_then_else(RetResult,LazyVars,ResultLazy,(CondCode,Test),Then,Else,Converted). -add_assertion1(Space,ACC) :- - must_det_ll(( - copy_term(ACC,AC,_), - expand_to_hb(AC,H,_), - as_functor_args(H,F,A), as_functor_args(HH,F,A), - with_mutex(transpiler_mutex_lock,( - % assert(AC), - % Get the current clauses of my_predicate/1 - findall(HH:-B,clause(/*'&self':*/HH,B),Prev), - copy_term(Prev,CPrev,_), - % Create a temporary file and add the new assertion along with existing clauses - append(CPrev,[AC],NewList), - cl_list_to_set(NewList,Set), - length(Set,N), - if_t(N=2, - (Set=[X,Y], - numbervars(X), - numbervars(Y), - nl,display(X), - nl,display(Y), - nl)), - %wdmsg(list_to_set(F/A,N)), - abolish(/*'&self':*/F/A), - create_and_consult_temp_file(Space,F/A, Set) - )) -)). +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- % dif_functors(HeadIs,Convert), + Convert =~ 'if-error'(Value,Then,Else),!,Test = is_Error(ValueResult), + f2p(HeadIs, LazyVars, ValueResult, ResultLazy, Value,ValueCode), + compile_test_then_else(RetResult,LazyVars,ResultLazy,(ValueCode,Test),Then,Else,Converted). -as_functor_args(AsPred,F,A):- as_functor_args(AsPred,F,A,_ArgsL),!. +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- % dif_functors(HeadIs,Convert), + Convert =~ 'if-empty'(Value,Then,Else),!,Test = is_Empty(ValueResult), + f2p(HeadIs, LazyVars, ValueResult, ResultLazy, Value,ValueCode), + compile_test_then_else(RetResult,LazyVars,ResultLazy,(ValueCode,Test),Then,Else,Converted). -as_functor_args(AsPred,F,A,ArgsL):-var(AsPred),!, - (is_list(ArgsL);(integer(A),A>=0)),!, - length(ArgsL,A), - (symbol(F)-> - AsPred =..[F|ArgsL] - ; - (AsPred = [F|ArgsL])). +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- % dif_functors(HeadIs,Convert), + (Convert =~ 'if-non-empty-expression'(Value,Then,Else)),!, + (Test = ( \+ is_Empty(ValueResult))), + f2p(HeadIs, LazyVars, ValueResult, ResultLazy, Value,ValueCode), + compile_test_then_else(RetResult,LazyVars,ResultLazy,(ValueCode,Test),Then,Else,Converted). -%as_functor_args(AsPred,_,_,_Args):- is_ftVar(AsPred),!,fail. -as_functor_args(AsPred,F,A,ArgsL):- \+ iz_conz(AsPred), - AsPred=..List,!, as_functor_args(List,F,A,ArgsL),!. -%as_functor_args([Eq,R,Stuff],F,A,ArgsL):- (Eq == '='), -% into_list_args(Stuff,List),append(List,[R],AsPred),!, -% as_functor_args(AsPred,F,A,ArgsL). -as_functor_args([F|ArgsL],F,A,ArgsL):- length(ArgsL,A),!. +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- % dif_functors(HeadIs,Convert), + Convert =~ ['if-equals',Value1,Value2,Then,Else],!,Test = equal_enough(ResValue1,ResValue2), + f2p(HeadIs, LazyVars, ResValue1, ResultLazy, Value1,CodeForValue1), + f2p(HeadIs, LazyVars, ResValue2, ResultLazy, Value2,CodeForValue2), + compile_test_then_else(RetResult,LazyVars,ResultLazy,(CodeForValue1,CodeForValue2,Test),Then,Else,Converted). +*/ +compile_flow_control1(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- + Convert =~ ['assertEqual',Value1,Value2],!, + cname_var('Src_',Src), + cname_var('FA_',ResValue1), + cname_var('FA_',ResValue2), + cname_var('FARL_',L1), + cname_var('FARL_',L2), + f2p(HeadIs, LazyVars, ResValue1, ResultLazy, Value1,CodeForValue1), + f2p(HeadIs, LazyVars, ResValue2, ResultLazy, Value2,CodeForValue2), + Converted = + (Src = Convert, + loonit_assert_source_tf(Src, + (findall(ResValue1,CodeForValue1,L1), + findall(ResValue2,CodeForValue2,L2)), + equal_enough(L1,L2),RetResult)). -cl_list_to_set([A|List],Set):- - member(B,List),same_clause(A,B),!, - cl_list_to_set(List,Set). -cl_list_to_set([New|List],[New|Set]):-!, - cl_list_to_set(List,Set). -cl_list_to_set([A,B],[A]):- same_clause(A,B),!. -cl_list_to_set(List,Set):- list_to_set(List,Set). -same_clause(A,B):- A==B,!. -same_clause(A,B):- A=@=B,!. -same_clause(A,B):- unnumbervars_clause(A,AA),unnumbervars_clause(B,BB),same_clause1(AA,BB). -same_clause1(A,B):- A=@=B. -same_clause1(A,B):- expand_to_hb(A,AH,AB),expand_to_hb(B,BH,BB),AB=@=BB, AH=@=BH,!. +compile_flow_control1(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- + Convert =~ ['assertEqualToResult',Value1,Value2],!, + f2p(HeadIs, LazyVars, ResValue1, ResultLazy, Value1,CodeForValue1), + ast_to_prolog(HeadIs,CodeForValue1,Prolog), -%clause('is-closed'(X),OO1,Ref),clause('is-closed'(X),OO2,Ref2),Ref2\==Ref, OO1=@=OO2. + Converted = loonit_assert_source_tf(Convert, + findall(ResValue1,Prolog,L1), + equal_enough(L1,Value2),RetResult). -end_of_file. +compile_flow_control2(_HeadIs, _LazyVars, RetResult, _ResultLazy, Convert, Converted) :- + Convert =~ 'add-atom'(Where,What), !, + =(What,WhatP), + Converted = as_tf('add-atom'(Where,WhatP),RetResult). +compile_flow_control2(_HeadIs, _LazyVars, RetResult, _ResultLazy, Convert, Converted) :- + Convert =~ 'add-atom'(Where,What,RetResult), !, + =(What,WhatP), + Converted = as_tf('add-atom'(Where,WhatP),RetResult). +compile_flow_control2(_HeadIs, _LazyVars, RetResult, _ResultLazy, Convert, (Converted)) :- + Convert =~ ['superpose',ValueL],is_ftVar(ValueL), + %maybe_unlistify(UValueL,ValueL,URetResult,RetResult), + Converted = eval_args(['superpose',ValueL],RetResult), + cname_var('MeTTa_SP_',ValueL). +compile_flow_control2(HeadIs, _LazyVars, RetResult, _ResultLazy, Convert, (Converted)) :- + Convert =~ ['superpose',ValueL],is_list(ValueL), + %maybe_unlistify(UValueL,ValueL,URetResult,RetResult), + cname_var('SP_Ret',RetResult), + maplist(f2p_assign(HeadIs,RetResult),ValueL,CodeForValueL), + list_to_disjuncts(CodeForValueL,Converted),!. +maybe_unlistify([UValueL],ValueL,RetResult,[URetResult]):- fail, is_list(UValueL),!, + maybe_unlistify(UValueL,ValueL,RetResult,URetResult). +maybe_unlistify(ValueL,ValueL,RetResult,RetResult). +list_to_disjuncts([],false). +list_to_disjuncts([A],A):- !. +list_to_disjuncts([A|L],(A;D)):- list_to_disjuncts(L,D). +%f2p_assign(_HeadIs,V,Value,is_True(V)):- Value=='True'. +f2p_assign(_HeadIs,ValueR,Value,ValueR=Value):- \+ compound(Value),!. +f2p_assign(_HeadIs,ValueR,Value,ValueR=Value):- is_ftVar(Value),!. +f2p_assign(HeadIs,ValueResult,Value,Converted):- + f2p(HeadIs, _LazyVars, ValueResultR, _ResultLazy, Value,CodeForValue), + %into_equals(ValueResultR,ValueResult,ValueResultRValueResult), + ValueResultRValueResult = (ValueResultR=ValueResult), + combine_code(CodeForValue,ValueResultRValueResult,Converted). -compile_head_variablization(Head, NewHead, HeadCode) :- - must_det_ll(( - as_functor_args(Head,Functor,A,Args), - % Find non-singleton variables in Args - fix_non_singletons(Args, NewArgs, Conditions), - list_to_conjunction(Conditions,HeadCode), - as_functor_args(NewHead,Functor,A,NewArgs))). +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert,Converted) :- + Convert =~ ['println!',Value],!, + Converted = (ValueCode,eval_args(['println!',ValueResult], RetResult)), + f2p(HeadIs, LazyVars, ValueResult, ResultLazy, Value,ValueCode). -fix_non_singletons(Args, NewArgs, [Code|Conditions]) :- - sub_term_loc(Var, Args, Loc1), is_ftVar(Var), - sub_term_loc_replaced(==(Var), _Var2, Args, Loc2, ReplVar2, NewArgsM), - Loc1 \=@= Loc2, - Code = same(ReplVar2,Var), -fix_non_singletons(NewArgsM, NewArgs, Conditions). -fix_non_singletons(Args, Args, []):-!. -sub_term_loc(A,A,self). -sub_term_loc(E,Args,e(N,nth1)+Loc):- is_list(Args),!, nth1(N,Args,ST),sub_term_loc(E,ST,Loc). -sub_term_loc(E,Args,e(N,arg)+Loc):- compound(Args),arg(N,Args,ST),sub_term_loc(E,ST,Loc). +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- + Convert =~ ['case',Value,PNil],[]==PNil,!,Converted = (ValueCode,RetResult=[]), + f2p(HeadIs, LazyVars, _ValueResult, ResultLazy, Value,ValueCode). -sub_term_loc_replaced(P1,E,Args,LOC,Var,NewArgs):- is_list(Args), !, sub_term_loc_l(nth1,P1,E,Args,LOC,Var,NewArgs). -sub_term_loc_replaced(P1,E,FArgs,LOC,Var,NewFArgs):- compound(FArgs), \+ is_ftVar(FArgs),!, - compound_name_arguments(FArgs, Name, Args), - sub_term_loc_l(arg,P1,E,Args,LOC,Var,NewArgs), - compound_name_arguments(NewCompound, Name, NewArgs),NewFArgs=NewCompound. - sub_term_loc_replaced(P1,A,A,self,Var,Var):- call(P1,A). +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, (ValueCode, Converted)) :- + Convert =~ ['case',Value|Options], \+ is_ftVar(Value),!, + cname_var('CASE_EVAL_',ValueResult), + compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, ['case',ValueResult|Options], Converted), + f2p(HeadIs, LazyVars, ValueResult, ResultLazy, Value,ValueCode). -sub_term_loc_l(Nth,P1,E,Args,e(N,Nth)+Loc,Var,NewArgs):- - reverse(Args,RevArgs), - append(Left,[ST|Right],RevArgs), - sub_term_loc_replaced(P1,E,ST,Loc,Var,ReplaceST), - append(Left,[ReplaceST|Right],RevNewArgs), - reverse(RevNewArgs,NewArgs), - length([_|Right], N). +compile_flow_control2(HeadIs, _LazyVars, RetResult, _ResultLazy, Convert, Converted) :- + Convert =~ ['case',Value,Options],!, + must_det_ll(( + maplist(compile_case_bodies(HeadIs),Options,Cases), + Converted = + (( AllCases = Cases, + once((member(caseStruct(MatchVar,MatchCode,BodyResult,BodyCode),AllCases), + (MatchCode,unify_enough(Value,MatchVar)))), + (BodyCode), + BodyResult=RetResult)))). + +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- + Convert =~ ['case',Value,[Opt|Options]],nonvar(Opt),!, + must_det_ll(( + compile_case_bodies(HeadIs,Opt,caseStruct(Value,If,RetResult,Then)), + Converted = ( If -> Then ; Else ), + ConvertCases =~ ['case',Value,Options], + compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, ConvertCases,Else))). + + +/* +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- + Convert =~ ['case',Value,Options],!, + must_det_ll(( + maplist(compile_case_bodies(HeadIs),Options,Cases), + Converted = + (( AllCases = Cases, + once((member(caseStruct(MatchVar,MatchCode,BodyResult,BodyCode),AllCases), + (MatchCode,unify_enough(Value,MatchVar)))), + (BodyCode), + BodyResult=RetResult)))). + +compile_flow_control2(HeadIs, LazyVars, _, ResultLazy, Convert, Converted) :- + Convert =~ ['case',Value,Options,RetResult],!, + must_det_ll(( + f2p(HeadIs, LazyVars, ValueResult, ResultLazy, Value,ValueCode), + maplist(compile_case_bodies(HeadIs),Options,Cases), + Converted = + (( AllCases = Cases, + call(ValueCode), + once((member(caseStruct(MatchVar,MatchCode,BodyResult,BodyCode),AllCases), + both_of(ValueResult,MatchCode,unify_enough(ValueResult,MatchVar)))), + call(BodyCode), + BodyResult=RetResult)))). + + +both_of(Var,G1,G2):- nonvar(Var),!,call(G2),call(G1). +both_of(_Var,G1,G2):- call(G1),call(G2). + +*/ + +compile_case_bodies(HeadIs,[Match,Body],caseStruct(_,true,BodyResult,BodyCode)):- Match == '%void%',!, + f2p(HeadIs, _LazyVars, BodyResult, _ResultLazy, Body,BodyCode). +compile_case_bodies(HeadIs,[Match,Body],caseStruct(MatchResult,If,BodyResult,BodyCode)):- !, + f2p(HeadIs, LazyVars, MatchResultV, ResultLazy, Match,MatchCode), + combine_code(MatchCode,unify_enough(MatchResult,MatchResultV),If), + f2p(HeadIs, LazyVars, BodyResult, ResultLazy, Body,BodyCode). +compile_case_bodies(HeadIs,MatchBody,CS):- compound(MatchBody), MatchBody =~ MB,compile_case_bodies(HeadIs,MB,CS). + +compile_flow_control4(HeadIs, LazyVars, RetResult, ResultLazy, Convert,CodeForValueConverted) :- + % TODO: Plus seems an odd name for a variable - get an idea why? + Convert =~ [Plus,N,Value], atom(Plus), + transpile_call_prefix(Plus,PrefixPlus), + current_predicate(PrefixPlus/3), number(N), + \+ number(Value), \+ is_ftVar(Value),!, + f2p(HeadIs, LazyVars, ValueResult, ResultLazy, Value,CodeForValue),!, + Converted =.. [PrefixPlus,N,ValueResult,RetResult], + combine_code(CodeForValue,Converted,CodeForValueConverted). + +compound_equals(COL1,COL2):- COL1=@=COL2,!,COL1=COL2. +compound_equals(COL1,COL2):- compound_equals1(COL1,COL2). +compound_equals1(COL1,COL2):- is_ftVar(COL1),!,is_ftVar(COL2),ignore(COL1=COL2),!. +compound_equals1(COL1,COL2):- compound(COL1),!,compound(COL2), COL1=COL2. + +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- + Convert =~ ['superpose',COL],compound_equals(COL,'collapse'(Value1)), + f2p(HeadIs, LazyVars, ResValue1, ResultLazy, Value1,CodeForValue1), + Converted = (findall(ResValue1,CodeForValue1,Gathered),member(RetResult,Gathered)). + +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- + Convert =~ ['collapse',Value1],!, + f2p(HeadIs, LazyVars, ResValue1, ResultLazy, Value1,CodeForValue1), + Converted = (findall(ResValue1,CodeForValue1,RetResult)). + +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- + Convert =~ ['compose',Value1],!, + Convert2 =~ ['collapse',Value1],!, + compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert2, Converted). + +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- % dif_functors(HeadIs,Convert), + Convert =~ ['unify',Value1,Value2,Then,Else],!,Test = metta_unify(ResValue1,ResValue2), + f2p(HeadIs, LazyVars, ResValue1, ResultLazy, Value1,CodeForValue1), + f2p(HeadIs, LazyVars, ResValue2, ResultLazy, Value2,CodeForValue2), + compile_test_then_else(RetResult,LazyVars,ResultLazy,(CodeForValue1,CodeForValue2,Test),Then,Else,Converted). + + +/* +% match(Space,f(1)=Y,Y) +compile_flow_control2(HeadIs, LazyVars, Y, ResultLazy, Convert,Converted) :- dif_functors(HeadIs,Convert), + Convert=~ match(Space,AsFunctionY,YY), + nonvar(AsFunctionY),( AsFunctionY =~ (AsFunction=Y)), nonvar(AsFunction), + !, Y==YY, + f2p(HeadIs, LazyVars, Y, ResultLazy, AsFunction,Converted),!. +*/ +compile_flow_control2(HeadIs, LazyVars, Atom, ResultLazy, Convert,Converted) :- + Convert=~ match(Space,Q,T),Q==T,Atom=Q,!, + compile_flow_control2(HeadIs, LazyVars, Atom, ResultLazy, 'get-atoms'(Space),Converted). + +compile_flow_control2(_HeadIs, _LazyVars, Match, _ResultLazy, Convert,Converted) :- + Convert=~ 'get-atoms'(Space), + Converted = metta_atom_iter(Space,Match). + +compile_flow_control2(HeadIs, _LazyVars, AtomsVar, _ResultLazy, Convert,Converted) :- + Convert=~ 'get-atoms'(Space), AtomsVar = Pattern, + compile_pattern(HeadIs,Space,Pattern,Converted). + +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert,Converted) :- dif_functors(HeadIs,Convert), + Convert =~ 'match'(Space,Pattern,Template),!, + f2p(HeadIs, LazyVars, RetResult, ResultLazy, Template,TemplateCode), + compile_pattern(HeadIs,Space,Pattern,SpacePatternCode), + combine_code(SpacePatternCode,TemplateCode,Converted). + +compile_pattern(_HeadIs,Space,Match,SpaceMatchCode):- + SpaceMatchCode = metta_atom_iter(Space,Match). + +metta_atom_iter(Space,Match):- + metta_atom_iter('=',10,Space,Space,Match). + + + +make_with_space(Space,MatchCode,MatchCode):- Space=='&self',!. +make_with_space(Space,MatchCode,with_space(Space,MatchCode)):- Space\=='&self'. + +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- dif_functors(HeadIs,Convert), + Convert =~ 'match'(_Space,Match,Template),!, + must_det_ll(( + f2p(HeadIs, LazyVars, _, ResultLazy, Match,MatchCode), + into_equals(RetResult,Template,TemplateCode), + combine_code(MatchCode,TemplateCode,Converted))). + +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- dif_functors(HeadIs,Convert), + Convert =~ ['if-decons',Atom,Head,Tail,Then,Else],!,Test = unify_cons(AtomResult,ResHead,ResTail), + f2p(HeadIs, LazyVars, AtomResult, ResultLazy, Atom,AtomCode), + f2p(HeadIs, LazyVars, ResHead, ResultLazy, Head,CodeForHead), + f2p(HeadIs, LazyVars, ResTail, ResultLazy, Tail,CodeForTail), + compile_test_then_else(RetResult,LazyVars,ResultLazy,(AtomCode,CodeForHead,CodeForTail,Test),Then,Else,Converted). + + + +compile_flow_control1(_HeadIs, _LazyVars, RetResult, _ResultLazy, Convert,is_True(RetResult)) :- is_compiled_and(AND), + Convert =~ [AND],!. + +compile_flow_control1(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- is_compiled_and(AND), + Convert =~ [AND,Body],!, + f2p(HeadIs, LazyVars, RetResult, ResultLazy, Body,BodyCode), + compile_test_then_else(RetResult,LazyVars,ResultLazy,BodyCode,'True','False',Converted). + +compile_flow_control1(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- is_compiled_and(AND), + Convert =~ [AND,Body1,Body2],!, + f2p(HeadIs, LazyVars, B1Res, ResultLazy, Body1,Body1Code), + f2p(HeadIs, LazyVars, RetResult, ResultLazy, Body2,Body2Code), + into_equals(B1Res,'True',AE), + Converted = (Body1Code,AE,Body2Code),!. + + +compile_flow_control1(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- is_compiled_and(AND), + Convert =~ [AND,Body1,Body2],!, + f2p(HeadIs, LazyVars, B1Res, ResultLazy, Body1,Body1Code), + f2p(HeadIs, LazyVars, _, ResultLazy, Body2,Body2Code), + into_equals(B1Res,'True',AE), + compile_test_then_else(RetResult,LazyVars,ResultLazy,(Body1Code,AE,Body2Code),'True','False',Converted). + +compile_flow_control1(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- is_compiled_and(AND), + Convert =~ [AND,Body1,Body2|BodyMore],!, + And2 =~ [AND,Body2|BodyMore], + Next =~ [AND,Body1,And2], + compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Next, Converted). + +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, sequential(Convert), Converted) :- !, + compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, transpose(Convert), Converted). + +compile_flow_control2(HeadIs, _LazyVars, RetResult, _ResultLazy, transpose(Convert), Converted,Code) :- !, + maplist(each_result(HeadIs,RetResult),Convert, Converted), + list_to_disjuncts(Converted,Code). + + +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- % dif_functors(HeadIs,Convert), + Convert =~ if(Cond,Then),!, + f2p(HeadIs, LazyVars, CondResult, ResultLazy, Cond,CondCode), + f2p(HeadIs, LazyVars, RetResult, ResultLazy, Then,ThenCode), + Converted = ((CondCode,is_True(CondResult)),ThenCode). + +each_result(HeadIs,RetResult,Convert,Converted):- + f2p(HeadIs, _LazyVars, OneResult, _ResultLazy, Convert,Code1), + into_equals(OneResult,RetResult,Code2), + combine_code(Code1,Code2,Converted). + +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Converter, Converted):- de_eval(Converter,Convert),!, + compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted). + +compile_flow_control2(HeadIs, LazyVars, _Result, ResultLazy, Convert, Converted) :- fail, + functor(Convert,Func,PA), + functional_predicate_arg(Func,PA,Nth), + Convert =~ [Func|PredArgs], + nth1(Nth,PredArgs,Result,FuncArgs), + RetResult = Result, + AsFunct =~ [Func|FuncArgs], + compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, AsFunct, Converted). + +dif_functors(HeadIs,_):- var(HeadIs),!,fail. +dif_functors(HeadIs,_):- \+ compound(HeadIs),!. +dif_functors(HeadIs,Convert):- compound(HeadIs),compound(Convert), + compound_name_arity(HeadIs,F,A),compound_name_arity(Convert,F,A). + +is_compiled_and(AND):- member(AND,[ (','), ('and'), ('and-seq')]). + +flowc. + + +unnumbervars_clause(Cl,ClU):- + copy_term_nat(Cl,AC),unnumbervars(AC,UA),copy_term_nat(UA,ClU). +% =============================== +% Compile in memory buffer +% =============================== +is_clause_asserted(AC):- unnumbervars_clause(AC,UAC), + expand_to_hb(UAC,H,B), + H=..[Fh|Args], + transpile_impl_prefix(Fh,FPrefixed), + H2=..[FPrefixed|Args], + clause(H2,B,Ref),clause(HH,BB,Ref), + strip_m(HH,HHH),HHH=@=H2, + strip_m(BB,BBB),BBB=@=B,!. + +%get_clause_pred(UAC,F,A):- expand_to_hb(UAC,H,_),strip_m(H,HH),functor(HH,F,A). + + +% :- dynamic(needs_tabled/2). + +add_assertion(Space,List):- is_list(List),!, + maplist(add_assertion(Space),List). +add_assertion(Space,AC):- unnumbervars_clause(AC,UAC), add_assertion1(Space,UAC). +add_assertion1(_,AC):- /*'&self':*/is_clause_asserted(AC),!. +%add_assertion1(_,AC):- get_clause_pred(AC,F,A), \+ needs_tabled(F,A), !, pfcAdd(/*'&self':*/AC),!. + +add_assertion1(Space,ACC) :- + must_det_ll(( + copy_term(ACC,AC,_), + expand_to_hb(AC,H,_), + as_functor_args(H,F,A), as_functor_args(HH,F,A), + with_mutex(transpiler_mutex_lock,( + % assert(AC), + % Get the current clauses of my_predicate/1 + findall(HH:-B,clause(/*'&self':*/HH,B),Prev), + copy_term(Prev,CPrev,_), + % Create a temporary file and add the new assertion along with existing clauses + append(CPrev,[AC],NewList), + cl_list_to_set(NewList,Set), + length(Set,N), + if_t(N=2, + (Set=[X,Y], + numbervars(X), + numbervars(Y), + nl,display(X), + nl,display(Y), + nl)), + %wdmsg(list_to_set(F/A,N)), + abolish(/*'&self':*/F/A), + create_and_consult_temp_file(Space,F/A, Set) + )) +)). + +as_functor_args(AsPred,F,A):- as_functor_args(AsPred,F,A,_ArgsL),!. + +as_functor_args(AsPred,F,A,ArgsL):-var(AsPred),!, + (is_list(ArgsL);(integer(A),A>=0)),!, + length(ArgsL,A), + (symbol(F)-> + AsPred =..[F|ArgsL] + ; + (AsPred = [F|ArgsL])). + +%as_functor_args(AsPred,_,_,_Args):- is_ftVar(AsPred),!,fail. +as_functor_args(AsPred,F,A,ArgsL):- \+ iz_conz(AsPred), + AsPred=..List,!, as_functor_args(List,F,A,ArgsL),!. +%as_functor_args([Eq,R,Stuff],F,A,ArgsL):- (Eq == '='), +% into_list_args(Stuff,List),append(List,[R],AsPred),!, +% as_functor_args(AsPred,F,A,ArgsL). +as_functor_args([F|ArgsL],F,A,ArgsL):- length(ArgsL,A),!. + +cl_list_to_set([A|List],Set):- + member(B,List),same_clause(A,B),!, + cl_list_to_set(List,Set). +cl_list_to_set([New|List],[New|Set]):-!, + cl_list_to_set(List,Set). +cl_list_to_set([A,B],[A]):- same_clause(A,B),!. +cl_list_to_set(List,Set):- list_to_set(List,Set). + +same_clause(A,B):- A==B,!. +same_clause(A,B):- A=@=B,!. +same_clause(A,B):- unnumbervars_clause(A,AA),unnumbervars_clause(B,BB),same_clause1(AA,BB). +same_clause1(A,B):- A=@=B. +same_clause1(A,B):- expand_to_hb(A,AH,AB),expand_to_hb(B,BH,BB),AB=@=BB, AH=@=BH,!. + +%clause('is-closed'(X),OO1,Ref),clause('is-closed'(X),OO2,Ref2),Ref2\==Ref, OO1=@=OO2. % Convert a list of conditions into a conjunction +list_to_conjunction(C,[CJ]):- \+ is_list(C), !, C = CJ. list_to_conjunction([], true). list_to_conjunction([Cond], Cond). +list_to_conjunction([H|T], RestConj) :- H == true, !, list_to_conjunction(T, RestConj). list_to_conjunction([H|T], (H, RestConj)) :- - list_to_conjunction(T, RestConj). + list_to_conjunction(T, RestConj). + +% Utility: Combine and flatten a single term into a conjunction +combine_code(Term, Conjunction) :- + flatten_term(Term, FlatList), + list_to_conjunction(FlatList, Conjunction). + +% combine_code/3: Combines Guard and Body into a flat conjunction +combine_code(Guard, Body, Combined) :- + combine_code(Guard, FlatGuard), % Flatten Guard + combine_code(Body, FlatBody), % Flatten Body + combine_flattened(FlatGuard, FlatBody, Combined). + +% Combine two flattened terms intelligently +combine_flattened(true, Body, Body) :- !. +combine_flattened(Guard, true, Guard) :- !. +combine_flattened(Guard, Body, (Guard, Body)). + +% Flatten terms into a flat list +flatten_term(C, CJ):- C==[],!,CJ=C. +flatten_term(C, [CJ]):- \+ compound(C), !, C = CJ. +flatten_term((A, B), FlatList) :- !, % If Term is a conjunction, flatten both sides + flatten_term(A, FlatA), + flatten_term(B, FlatB), + append(FlatA, FlatB, FlatList). +flatten_term(List, FlatList) :- is_list(List), + !, % If Term is a list, recursively flatten its elements + maplist(flatten_term, List, NestedLists), + append(NestedLists, FlatList). +flatten_term([A | B ], FlatList) :- !, % If Term is a conjunction, flatten both sides + flatten_term(A, FlatA), + flatten_term(B, FlatB), + append(FlatA, FlatB, FlatList). +flatten_term(Term, [Term]). % Base case: single term, wrap it in a list + + +fn_eval(Fn,Args,Res):- is_list(Args),symbol(Fn),transpile_call_prefix(Fn,Pred),Pre=..[Pred|Args], + catch(call(Pre,Res),error(existence_error(procedure,_/_),_),Res=[Fn|Args]). + +fn_native(Fn,Args):- apply(Fn,Args). +%fn_eval(Fn,Args,[Fn|Args]). + +assign(X,list(Y)):- is_list(Y),!,X=Y. +assign(X,X). + + + + + + + + + + + + + + + end_of_file. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + end_of_file. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + end_of_file. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + end_of_file. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + end_of_file. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + end_of_file. + + + + + + + + + + + + -/* -as_functor_args(AsPred,F,A,ArgsL):- nonvar(AsPred),!,into_list_args(AsPred,[F|ArgsL]), length(ArgsL,A). -as_functor_args(AsPred,F,A,ArgsL):- - nonvar(F),length(ArgsL,A),AsPred = [F|ArgsL]. -*/ -compile_for_assert(HeadIs, AsBodyFn, Converted) :- (AsBodyFn =@= HeadIs ; AsBodyFn == []), !,/*trace,*/ compile_head_for_assert(HeadIs,Converted). -% If Convert is of the form (AsFunction=AsBodyFn), we perform conversion to obtain the equivalent predicate. -compile_for_assert(Head, AsBodyFn, Converted) :- - once(compile_head_variablization(Head, HeadC, CodeForHeadArgs)), - \+(atomic(CodeForHeadArgs)), !, - compile_for_assert(HeadC, - (CodeForHeadArgs,AsBodyFn), Converted). -compile_for_assert(HeadIs, AsBodyFn, Converted) :- is_ftVar(AsBodyFn), /*trace,*/ - AsFunction = HeadIs,!, - must_det_ll(( - Converted = (HeadC :- BodyC), % Create a rule with Head as the converted AsFunction and NextBody as the converted AsBodyFn - %funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head), - f2p(HeadIs,HResult,AsFunction,HHead), - (var(HResult) -> (Result = HResult, HHead = Head) ; - funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head)), - NextBody = x_assign(AsBodyFn,Result), - optimize_head_and_body(Head,NextBody,HeadC,BodyC), - nop(ignore(Result = '$VAR'('HeadRes'))))),!. -% PLACEHOLDER -% If Convert is of the form (AsFunction=AsBodyFn), we perform conversion to obtain the equivalent predicate. -compile_for_assert(HeadIs, AsBodyFn, Converted) :- - AsFunction = HeadIs, Converted = (HeadCC :- BodyCC), - funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head), - compile_head_args(Head,HeadC,CodeForHeadArgs), - f2p(HeadIs,Result,AsBodyFn,NextBody), - combine_code(CodeForHeadArgs,NextBody,BodyC),!, - optimize_head_and_body(HeadC,BodyC,HeadCC,BodyCC),!. -% =============================== -% COMPILER / OPTIMIZER -% Scryer Compiler vs PySWIP ASM Compiler -% -% PySWIP is 222 times faster per join -% =============================== -% Conversion is possible between a function and a predicate of arity when the result is at the nth arg -:- dynamic decl_functional_predicate_arg/3. -% Converion is possible between a function and predicate is tricky -functional_predicate_arg_tricky(is, 2, 1). % E.g. eval_args(is(+(1,2)),Result) converts to is(Result,+(1,2)). -% Defining standard mappings for some common functions/predicates -decl_functional_predicate_arg(append, 3, 3). -decl_functional_predicate_arg(+, 3, 3). -decl_functional_predicate_arg(pi, 1, 1). -decl_functional_predicate_arg('Empty', 1, 1). -decl_functional_predicate_arg(call,4,4). -decl_functional_predicate_arg(eval_args, 2, 2). -decl_functional_predicate_arg(edge, 2, 2). -decl_functional_predicate_arg('==', 2, 2). -decl_functional_predicate_arg('is-same', 2, 2). -decl_functional_predicate_arg(assertTrue, 2, 2). -decl_functional_predicate_arg(case, 3, 3). -decl_functional_predicate_arg(assertFalse, 2, 2). -decl_functional_predicate_arg('car-atom', 2, 2). -decl_functional_predicate_arg(match,4,4). -decl_functional_predicate_arg('TupleConcat',3,3). -decl_functional_predicate_arg('new-space',1,1). -decl_functional_predicate_arg(superpose, 2, 2). -do_predicate_function_canonical(F,FF):- predicate_function_canonical(F,FF),!. -do_predicate_function_canonical(F,F). -predicate_function_canonical(is_Empty,'Empty'). -pi(PI):- PI is pi. -% Retrieve Head of the List -'car-atom'(List, Head):- eval_H(['car-atom', List], Head). -% Mapping any current predicate F/A to a function, if it's not tricky -functional_predicate_arg(F, A, L):- decl_functional_predicate_arg(F, A, L). -functional_predicate_arg(F, A, L):- (atom(F)->true;trace), predicate_arity(F,A), - \+ functional_predicate_arg_tricky(F,A,_), L=A, - \+ decl_functional_predicate_arg(F, A, _). -functional_predicate_arg(F, A, L):- functional_predicate_arg_tricky(F, A, L). + end_of_file. -predicate_arity(F,A):- metta_atom('&self',[:,F,[->|Args]]), length(Args,A). -predicate_arity(F,A):- current_predicate(F/A). -% Certain constructs should not be converted to functions. -not_function(P):- atom(P),!,not_function(P,0). -not_function(P):- callable(P),!,functor(P,F,A),not_function(F,A). -not_function(F,A):- is_arity_0(F,FF),!,not_function(FF,A). -not_function(!,0). -not_function(print,1). -not_function((':-'),2). -not_function((','),2). -not_function((';'),2). -not_function(('='),2). -not_function(('or'),2). -not_function('a',0). -not_function('b',0). -not_function(F,A):- is_control_structure(F,A). -not_function(A,0):- atom(A),!. -not_function('True',0). -not_function(F,A):- predicate_arity(F,A),AA is A+1, \+ decl_functional_predicate_arg(F,AA,_). -needs_call_fr(P):- is_function(P,_Nth),functor(P,F,A),AA is A+1, \+ current_predicate(F/AA). -is_control_structure(F,A):- atom(F), atom_concat('if-',_,F),A>2. -'=='(A, B, Res):- as_tf(equal_enough(A, B),Res). -'or'(G1,G2):- G1 *-> true ; G2. -'or'(G1,G2,Res):- as_tf((G1 ; G2),Res). -% Function without arguments can be converted directly. -is_arity_0(AsFunction,F):- compound(AsFunction), compound_name_arity(AsFunction,F,0). -% Determines whether a given term is a function and retrieves the position -% in the predicate where the function Result is stored/retrieved -is_function(AsFunction, _):- is_ftVar(AsFunction),!,fail. -is_function(AsFunction, _):- AsFunction=='$VAR',!, trace, fail. -is_function(AsFunction, Nth) :- is_arity_0(AsFunction,F), \+ not_function(F,0), !,Nth=1. -is_function(AsFunction, Nth) :- is_arity_0(AsFunction,_), !,Nth=1. -is_function(AsFunction, Nth) :- - callable(AsFunction), - functor(AsFunction, Functor, A), - \+ not_function(Functor, A), - AA is A + 1, - functional_predicate_arg_maybe(Functor, AA, Nth). -functional_predicate_arg_maybe(F, AA, Nth):- functional_predicate_arg(F, AA, Nth),!. -functional_predicate_arg_maybe(F, AA, _):- A is AA - 1,functional_predicate_arg(F,A,_),!,fail. -functional_predicate_arg_maybe(F, Nth, Nth):- asserta(decl_functional_predicate_arg(F, Nth, Nth)),!. -% If Convert is of the form (AsFunction=AsBodyFn), we perform conversion to obtain the equivalent predicate. -compile_head_for_assert(HeadIs, (Head:-Body)):- - compile_head_for_assert(HeadIs, NewHeadIs,Converted), - head_preconds_into_body(NewHeadIs,Converted,Head,Body). -head_as_is(Head):- - as_functor_args(Head,Functor,A,_),!, - head_as_is(Functor,A). -head_as_is(if,3). -compile_head_for_assert(Head, Head, true):- - head_as_is(Head),!. -compile_head_for_assert(Head, NewestHead, HeadCode):- - compile_head_variablization(Head, NewHead, VHeadCode), - compile_head_args(NewHead, NewestHead, AHeadCode), - combine_code(VHeadCode,AHeadCode,HeadCode). -% Construct the new head and the match body -compile_head_args(Head, NewHead, HeadCode) :- - must_det_ll(( - as_functor_args(Head,Functor,A,Args), - maplist(f2p_assign(Head),NewArgs,Args,CodeL), - as_functor_args(NewHead,Functor,A,NewArgs), - list_to_conjuncts(CodeL,HeadCode))),!. @@ -953,542 +1801,497 @@ -:- op(700,xfx,'=~'). -compile_for_assert(HeadIs, AsBodyFn, Converted) :- (AsBodyFn =@= HeadIs ; AsBodyFn == []), !,/*trace,*/ compile_head_for_assert(HeadIs,Converted). -% If Convert is of the form (AsFunction=AsBodyFn), we perform conversion to obtain the equivalent predicate. -compile_for_assert(Head, AsBodyFn, Converted) :- - once(compile_head_variablization(Head, HeadC, CodeForHeadArgs)), - \+(atomic(CodeForHeadArgs)), !, - compile_for_assert(HeadC, - (CodeForHeadArgs,AsBodyFn), Converted). -compile_for_assert(HeadIs, AsBodyFn, Converted) :- fail,is_ftVar(AsBodyFn), /*trace,*/ - AsFunction = HeadIs,!, - must_det_ll(( - Converted = (HeadC :- BodyC), % Create a rule with Head as the converted AsFunction and NextBody as the converted AsBodyFn - %funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head), - f2p(HeadIs,HResult,AsFunction,HHead), - (var(HResult) -> (Result = HResult, HHead = Head) ; - funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head)), - NextBody = x_assign(AsBodyFn,Result), - optimize_head_and_body(Head,NextBody,HeadC,BodyC), - nop(ignore(Result = '$VAR'('HeadRes'))))),!. -compile_for_assert(HeadIs, AsBodyFn, Converted) :- - format("~w ~w ~w\n",[HeadIs, AsBodyFn, Converted]), - AsFunction = HeadIs, - must_det_ll(( - Converted = (HeadC :- NextBodyC), % Create a rule with Head as the converted AsFunction and NextBody as the converted AsBodyFn - /*funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head),*/ - f2p(HeadIs,HResult,AsFunction,HHead), - (var(HResult) -> (Result = HResult, HHead = Head) ; - funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head)), - %verbose_unify(Converted), - f2p(HeadIs,Result,AsBodyFn,NextBody), - %RetResult = Converted, - %RetResult = _, - optimize_head_and_body(Head,NextBody,HeadC,NextBodyC), - %fbug([convert(Convert),head_preconds_into_body(HeadC:-NextBodyC)]), - %if_t(((Head:-NextBody)\=@=(HeadC:-NextBodyC)),fbug(was(Head:-NextBody))), - nop(ignore(Result = '$VAR'('HeadRes'))))),!. -% If Convert is of the form (AsFunction=AsBodyFn), we perform conversion to obtain the equivalent predicate. -compile_for_assert(HeadIs, AsBodyFn, Converted) :- - AsFunction = HeadIs, Converted = (HeadCC :- BodyCC), - funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head), - compile_head_args(Head,HeadC,CodeForHeadArgs), - f2p(HeadIs,Result,AsBodyFn,NextBody), - combine_code(CodeForHeadArgs,NextBody,BodyC),!, - optimize_head_and_body(HeadC,BodyC,HeadCC,BodyCC),!. -/* -*/ -metta_predicate(eval_args(evaluable,eachvar)). -metta_predicate(eval_true(matchable)). -metta_predicate(with_space(space,matchable)). -metta_predicate(limit(number,matchable)). -metta_predicate(findall(template,matchable,listvar)). -metta_predicate(match(space,matchable,template,eachvar)). -head_preconds_into_body(Head,Body,Head,Body):- \+ compound(Head),!. -head_preconds_into_body((PreHead,True),Converted,Head,Body):- True==true,!, - head_preconds_into_body(PreHead,Converted,Head,Body). -head_preconds_into_body((True,PreHead),Converted,Head,Body):- True==true,!, - head_preconds_into_body(PreHead,Converted,Head,Body). -head_preconds_into_body(PreHead,(True,Converted),Head,Body):- True==true,!, - head_preconds_into_body(PreHead,Converted,Head,Body). -head_preconds_into_body(PreHead,(Converted,True),Head,Body):- True==true,!, - head_preconds_into_body(PreHead,Converted,Head,Body). -head_preconds_into_body((AsPredO,Pre),Converted,Head,Body):- - head_preconds_into_body(Pre,(AsPredO,Converted),Head,Body). -head_preconds_into_body(AHead,Body,Head,BodyNew):- - assertable_head(AHead,Head), - optimize_body(Head,Body,BodyNew). + end_of_file. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + end_of_file. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + end_of_file. + + + + -assertable_head(u_assign(FList,R),Head):- FList =~ [F|List], - append(List,[R],NewArgs), atom(F),!, Head=..[F|NewArgs]. -assertable_head(Head,Head). -ok_to_append('$VAR'):- !, fail. -ok_to_append(_). -p2s(P,S):- into_list_args(P,S). -non_compound(S):- \+ compound(S). -did_optimize_conj(Head,B1,B2,B12):- optimize_conj(Head,B1,B2,B12), B12\=@=(B1,B2),!. -optimize_conjuncts(Head,(B1,B2,B3),BN):- B3\==(_,_), - did_optimize_conj(Head,B2,B3,B23), - optimize_conjuncts(Head,B1,B23,BN), !. -optimize_conjuncts(Head,(B1,B2,B3),BN):- - did_optimize_conj(Head,B1,B2,B12), - optimize_conjuncts(Head,B12,B3,BN),!. -%optimize_conjuncts(Head,(B1,B2),BN1):- optimize_conj(Head,B1,B2,BN1). -optimize_conjuncts(Head,(B1,B2),BN1):- did_optimize_conj(Head,B1,B2,BN1),!. -optimize_conjuncts(Head,B1,B2,(BN1,BN2)):- - must_optimize_body(Head,B1,BN1), must_optimize_body(Head,B2,BN2). -optimize_conj(_, x_assign(Term, C), x_assign(True,CC), eval_true(Term)):- 'True'==True, CC==C. -optimize_conj(_, x_assign(Term, C), is_True(CC), eval_true(Term)):- CC==C, !. -optimize_conj(_, B1,BT,B1):- assumed_true(BT),!. -optimize_conj(_, BT,B1,B1):- assumed_true(BT),!. -%optimize_conj(Head, x_assign(Term, C), x_assign(True,CC), Term):- 'True'==True, -% optimize_conj(Head, x_assign(Term, C), is_True(CC), CTerm). -%optimize_conj(Head,B1,BT,BN1):- assumed_true(BT),!, optimize_body(Head,B1,BN1). -%optimize_conj(Head,BT,B1,BN1):- assumed_true(BT),!, optimize_body(Head,B1,BN1). -optimize_conj(Head,B1,B2,(BN1,BN2)):- - optimize_body(Head,B1,BN1), optimize_body(Head,B2,BN2). -assumed_true(B2):- var(B2),!,fail. -assumed_true(eval_true(B2)):-!,assumed_true(B2). -assumed_true(B2):- B2== true,!. -assumed_true(B2):- B2==x_assign('True', '$VAR'('_')),!. -assumed_true(X==Y):- assumed_true(X=Y). -assumed_true(X=Y):- var(X),var(Y), X=Y. -assumed_true(X=Y):- is_ftVar(X),is_ftVar(Y), X=Y. -filter_head_arg(H,F):- var(H),!,H=F. -filter_head_arge(H,F):- H = F. -code_callable(Term,_CTerm):- var(Term),!,fail. -code_callable(Term, CTerm):- current_predicate(_,Term),!,Term=CTerm. -%code_callable(Term, CTerm):- current_predicate(_,Term),!,Term=CTerm. -compile_flow_control(_HeadIs,RetResult,Convert, x_assign(Convert,RetResult)) :- is_ftVar(Convert), var(RetResult),!. -compile_flow_control(_HeadIs,_RetResult,Convert,_):- \+ compound(Convert),!,fail. -compile_flow_control(_HeadIs,_RetResult,Convert,_):- compound_name_arity(Convert,_,0),!,fail. -:- op(700,xfx, =~). -compile_flow_control(HeadIs,RetResult,Convert, (Code1,Eval1Result=Result,Converted)) :- % dif_functors(HeadIs,Convert), - Convert =~ chain(Eval1,Result,Eval2),!, - f2p(HeadIs,Eval1Result,Eval1,Code1), - f2p(HeadIs,RetResult,Eval2,Converted). -compile_flow_control(HeadIs,ResValue2,Convert, (CodeForValue1,Converted)) :- % dif_functors(HeadIs,Convert), - Convert =~ ['eval-in-space',Value1,Value2], - f2p(HeadIs,ResValue1,Value1,CodeForValue1), - f2p(HeadIs,ResValue2,Value2,CodeForValue2), - Converted = with_space(ResValue1,CodeForValue2). -compile_flow_control(_HeadIs,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), - Convert =~ ['bind!',Var,Value],is_ftVar(Value),!, - Converted = eval_args(['bind!',Var,Value],RetResult). -compile_flow_control(_HeadIs,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), - Convert =~ ['bind!',Var,Value], Value =~ ['new-space'],!, - Converted = eval_args(['bind!',Var,Value],RetResult). -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), - Convert =~ ['bind!',Var,Value], - f2p(HeadIs,ValueResult,Value,ValueCode), - Converted = (ValueCode,eval_args(['bind!',Var,ValueResult],RetResult)). -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), - once(Convert =~ if(Cond,Then,Else);Convert =~ 'if'(Cond,Then,Else)), - !,Test = is_True(CondResult), - f2p(HeadIs,CondResult,Cond,CondCode), - compile_test_then_else(RetResult,(CondCode,Test),Then,Else,Converted). +compile_head_variablization(Head, NewHead, HeadCode) :- + must_det_ll(( + as_functor_args(Head,Functor,A,Args), + % Find non-singleton variables in Args + fix_non_singletons(Args, NewArgs, Conditions), + list_to_conjunction(Conditions,HeadCode), + as_functor_args(NewHead,Functor,A,NewArgs))). -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), - Convert =~ 'if-error'(Value,Then,Else),!,Test = is_Error(ValueResult), - f2p(HeadIs,ValueResult,Value,ValueCode), - compile_test_then_else(RetResult,(ValueCode,Test),Then,Else,Converted). +fix_non_singletons(Args, NewArgs, [Code|Conditions]) :- + sub_term_loc(Var, Args, Loc1), is_ftVar(Var), + sub_term_loc_replaced(==(Var), _Var2, Args, Loc2, ReplVar2, NewArgsM), + Loc1 \=@= Loc2, + Code = same(ReplVar2,Var), +fix_non_singletons(NewArgsM, NewArgs, Conditions). +fix_non_singletons(Args, Args, []):-!. -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), - Convert =~ 'if-empty'(Value,Then,Else),!,Test = is_Empty(ValueResult), - f2p(HeadIs,ValueResult,Value,ValueCode), - compile_test_then_else(RetResult,(ValueCode,Test),Then,Else,Converted). -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), - (Convert =~ 'if-non-empty-expression'(Value,Then,Else)),!, - (Test = ( \+ is_Empty(ValueResult))), - f2p(HeadIs,ValueResult,Value,ValueCode), - compile_test_then_else(RetResult,(ValueCode,Test),Then,Else,Converted). +sub_term_loc(A,A,self). +sub_term_loc(E,Args,e(N,nth1)+Loc):- is_list(Args),!, nth1(N,Args,ST),sub_term_loc(E,ST,Loc). +sub_term_loc(E,Args,e(N,arg)+Loc):- compound(Args),arg(N,Args,ST),sub_term_loc(E,ST,Loc). -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), - Convert =~ ['if-equals',Value1,Value2,Then,Else],!,Test = equal_enough(ResValue1,ResValue2), - f2p(HeadIs,ResValue1,Value1,CodeForValue1), - f2p(HeadIs,ResValue2,Value2,CodeForValue2), - compile_test_then_else(RetResult,(CodeForValue1,CodeForValue2,Test),Then,Else,Converted). +sub_term_loc_replaced(P1,E,Args,LOC,Var,NewArgs):- is_list(Args), !, sub_term_loc_l(nth1,P1,E,Args,LOC,Var,NewArgs). +sub_term_loc_replaced(P1,E,FArgs,LOC,Var,NewFArgs):- compound(FArgs), \+ is_ftVar(FArgs),!, + compound_name_arguments(FArgs, Name, Args), + sub_term_loc_l(arg,P1,E,Args,LOC,Var,NewArgs), + compound_name_arguments(NewCompound, Name, NewArgs),NewFArgs=NewCompound. + sub_term_loc_replaced(P1,A,A,self,Var,Var):- call(P1,A). -cname_var(Sym,Src):- gensym(Sym,SrcV),Src='$VAR'(SrcV). -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- - Convert =~ ['assertEqual',Value1,Value2],!, - cname_var('Src_',Src), - cname_var('FA_',ResValue1), - cname_var('FA_',ResValue2), - cname_var('FARL_',L1), - cname_var('FARL_',L2), - f2p(HeadIs,ResValue1,Value1,CodeForValue1), - f2p(HeadIs,ResValue2,Value2,CodeForValue2), - Converted = - (Src = Convert, - loonit_assert_source_tf(Src, - (findall(ResValue1,CodeForValue1,L1), - findall(ResValue2,CodeForValue2,L2)), - equal_enough(L1,L2),RetResult)). -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- - Convert =~ ['assertEqualToResult',Value1,Value2],!, - f2p(HeadIs,ResValue1,Value1,CodeForValue1), - Converted = loonit_assert_source_tf(Convert, - findall(ResValue1,CodeForValue1,L1), - equal_enough(L1,Value2),RetResult). +sub_term_loc_l(Nth,P1,E,Args,e(N,Nth)+Loc,Var,NewArgs):- + reverse(Args,RevArgs), + append(Left,[ST|Right],RevArgs), + sub_term_loc_replaced(P1,E,ST,Loc,Var,ReplaceST), + append(Left,[ReplaceST|Right],RevNewArgs), + reverse(RevNewArgs,NewArgs), + length([_|Right], N). -compile_flow_control(_HeadIs,RetResult,Convert, Converted) :- - Convert =~ 'add-atom'(Where,What), !, - =(What,WhatP), - Converted = as_tf('add-atom'(Where,WhatP),RetResult). -compile_flow_control(_HeadIs,RetResult,Convert, Converted) :- - Convert =~ 'add-atom'(Where,What,RetResult), !, - =(What,WhatP), - Converted = as_tf('add-atom'(Where,WhatP),RetResult). +/* +as_functor_args(AsPred,F,A,ArgsL):- nonvar(AsPred),!,into_list_args(AsPred,[F|ArgsL]), length(ArgsL,A). +as_functor_args(AsPred,F,A,ArgsL):- + nonvar(F),length(ArgsL,A),AsPred = [F|ArgsL]. +*/ +compile_for_assert(HeadIs, AsBodyFn, Converted) :- (AsBodyFn =@= HeadIs ; AsBodyFn == []), !,/*trace,*/ compile_head_for_assert(HeadIs,Converted). -compile_flow_control(_HeadIs,RetResult,Convert, (Converted)) :- - Convert =~ ['superpose',ValueL],is_ftVar(ValueL), - %maybe_unlistify(UValueL,ValueL,URetResult,RetResult), - Converted = eval_args(['superpose',ValueL],RetResult), - cname_var('MeTTa_SP_',ValueL). +% If Convert is of the form (AsFunction=AsBodyFn), we perform conversion to obtain the equivalent predicate. +compile_for_assert(Head, AsBodyFn, Converted) :- + once(compile_head_variablization(Head, HeadC, CodeForHeadArgs)), + \+(atomic(CodeForHeadArgs)), !, + compile_for_assert(HeadC, + (CodeForHeadArgs,AsBodyFn), Converted). -compile_flow_control(HeadIs,RetResult,Convert, (Converted)) :- - Convert =~ ['superpose',ValueL],is_list(ValueL), - %maybe_unlistify(UValueL,ValueL,URetResult,RetResult), - cname_var('SP_Ret',RetResult), - maplist(f2p_assign(HeadIs,RetResult),ValueL,CodeForValueL), - list_to_disjuncts(CodeForValueL,Converted),!. +compile_for_assert(HeadIs, AsBodyFn, Converted) :- is_ftVar(AsBodyFn), /*trace,*/ + AsFunction = HeadIs,!, + must_det_ll(( + Converted = (HeadC :- BodyC), % Create a rule with Head as the converted AsFunction and NextBody as the converted AsBodyFn + %funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head), + f2p(HeadIs, LazyVars, HResult, ResultLazy, AsFunction,HHead), + (var(HResult) -> (Result = HResult, HHead = Head) ; + funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head)), + NextBody = x_assign(AsBodyFn,Result), + optimize_head_and_body(Head,NextBody,HeadC,BodyC), + nop(ignore(Result = '$VAR'('HeadRes'))))),!. +% PLACEHOLDER -maybe_unlistify([UValueL],ValueL,RetResult,[URetResult]):- fail, is_list(UValueL),!, - maybe_unlistify(UValueL,ValueL,RetResult,URetResult). -maybe_unlistify(ValueL,ValueL,RetResult,RetResult). -list_to_disjuncts([],false). -list_to_disjuncts([A],A):- !. -list_to_disjuncts([A|L],(A;D)):- list_to_disjuncts(L,D). +% If Convert is of the form (AsFunction=AsBodyFn), we perform conversion to obtain the equivalent predicate. +compile_for_assert(HeadIs, AsBodyFn, Converted) :- + AsFunction = HeadIs, Converted = (HeadCC :- BodyCC), + funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head), + compile_head_args(Head,HeadC,CodeForHeadArgs), + f2p(HeadIs, LazyVars, Result, ResultLazy, AsBodyFn,NextBody), + combine_code(CodeForHeadArgs,NextBody,BodyC),!, + optimize_head_and_body(HeadC,BodyC,HeadCC,BodyCC),!. -%f2p_assign(_HeadIs,V,Value,is_True(V)):- Value=='True'. -f2p_assign(_HeadIs,ValueR,Value,ValueR=Value):- \+ compound(Value),!. -f2p_assign(_HeadIs,ValueR,Value,ValueR=Value):- is_ftVar(Value),!. -f2p_assign(HeadIs,ValueResult,Value,Converted):- - f2p(HeadIs,ValueResultR,Value,CodeForValue), - %into_equals(ValueResultR,ValueResult,ValueResultRValueResult), - ValueResultRValueResult = (ValueResultR=ValueResult), - combine_code(CodeForValue,ValueResultRValueResult,Converted). -compile_flow_control(HeadIs,RetResult,Convert,Converted) :- - Convert =~ ['println!',Value],!, - Converted = (ValueCode,eval_args(['println!',ValueResult], RetResult)), - f2p(HeadIs,ValueResult,Value,ValueCode). +% =============================== +% COMPILER / OPTIMIZER +% Scryer Compiler vs PySWIP ASM Compiler +% +% PySWIP is 222 times faster per join +% =============================== +% Conversion is possible between a function and a predicate of arity when the result is at the nth arg +:- dynamic decl_functional_predicate_arg/3. -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- - Convert =~ ['case',Value,PNil],[]==PNil,!,Converted = (ValueCode,RetResult=[]), - f2p(HeadIs,_ValueResult,Value,ValueCode). +% Converion is possible between a function and predicate is tricky +functional_predicate_arg_tricky(is, 2, 1). % E.g. eval_args(is(+(1,2)),Result) converts to is(Result,+(1,2)). +% Defining standard mappings for some common functions/predicates +decl_functional_predicate_arg(append, 3, 3). +decl_functional_predicate_arg(+, 3, 3). +decl_functional_predicate_arg(pi, 1, 1). +decl_functional_predicate_arg('Empty', 1, 1). +decl_functional_predicate_arg(call,4,4). +decl_functional_predicate_arg(eval_args, 2, 2). +decl_functional_predicate_arg(edge, 2, 2). +decl_functional_predicate_arg('==', 2, 2). +decl_functional_predicate_arg('is-same', 2, 2). +decl_functional_predicate_arg(assertTrue, 2, 2). +decl_functional_predicate_arg(case, 3, 3). +decl_functional_predicate_arg(assertFalse, 2, 2). +decl_functional_predicate_arg('car-atom', 2, 2). +decl_functional_predicate_arg(match,4,4). +decl_functional_predicate_arg('TupleConcat',3,3). +decl_functional_predicate_arg('new-space',1,1). +decl_functional_predicate_arg(superpose, 2, 2). -compile_flow_control(HeadIs,RetResult,Convert, (ValueCode, Converted)) :- - Convert =~ ['case',Value|Options], \+ is_ftVar(Value),!, - cname_var('CASE_EVAL_',ValueResult), - compile_flow_control(HeadIs,RetResult,['case',ValueResult|Options], Converted), - f2p(HeadIs,ValueResult,Value,ValueCode). +do_predicate_function_canonical(F,FF):- predicate_function_canonical(F,FF),!. +do_predicate_function_canonical(F,F). +predicate_function_canonical(is_Empty,'Empty'). -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- - Convert =~ ['case',Value,Options],!, - must_det_ll(( - maplist(compile_case_bodies(HeadIs),Options,Cases), - Converted = - (( AllCases = Cases, - once((member(caseStruct(MatchVar,MatchCode,BodyResult,BodyCode),AllCases), - (MatchCode,unify_enough(Value,MatchVar)))), - (BodyCode), - BodyResult=RetResult)))). +pi(PI):- PI is pi. -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- - Convert =~ ['case',Value,[Opt|Options]],nonvar(Opt),!, - must_det_ll(( - compile_case_bodies(HeadIs,Opt,caseStruct(Value,If,RetResult,Then)), - Converted = ( If -> Then ; Else ), - ConvertCases =~ ['case',Value,Options], - compile_flow_control(HeadIs,RetResult,ConvertCases,Else))). +% Retrieve Head of the List +'car-atom'(List, Head):- eval_H(['car-atom', List], Head). + + +% Mapping any current predicate F/A to a function, if it's not tricky +functional_predicate_arg(F, A, L):- decl_functional_predicate_arg(F, A, L). +functional_predicate_arg(F, A, L):- (atom(F)->true;trace), predicate_arity(F,A), + \+ functional_predicate_arg_tricky(F,A,_), L=A, + \+ decl_functional_predicate_arg(F, A, _). +functional_predicate_arg(F, A, L):- functional_predicate_arg_tricky(F, A, L). + +predicate_arity(F,A):- metta_atom('&self',[:,F,[->|Args]]), length(Args,A). +predicate_arity(F,A):- current_predicate(F/A). +% Certain constructs should not be converted to functions. +not_function(P):- atom(P),!,not_function(P,0). +not_function(P):- callable(P),!,functor(P,F,A),not_function(F,A). +not_function(F,A):- is_arity_0(F,FF),!,not_function(FF,A). +not_function(!,0). +not_function(print,1). +not_function((':-'),2). +not_function((','),2). +not_function((';'),2). +not_function(('='),2). +not_function(('or'),2). + +not_function('a',0). +not_function('b',0). +not_function(F,A):- is_control_structure(F,A). +not_function(A,0):- atom(A),!. +not_function('True',0). +not_function(F,A):- predicate_arity(F,A),AA is A+1, \+ decl_functional_predicate_arg(F,AA,_). + +needs_call_fr(P):- is_function(P,_Nth),functor(P,F,A),AA is A+1, \+ current_predicate(F/AA). + +is_control_structure(F,A):- atom(F), atom_concat('if-',_,F),A>2. + +'=='(A, B, Res):- as_tf(equal_enough(A, B),Res). +'or'(G1,G2):- G1 *-> true ; G2. +'or'(G1,G2,Res):- as_tf((G1 ; G2),Res). + +% Function without arguments can be converted directly. +is_arity_0(AsFunction,F):- compound(AsFunction), compound_name_arity(AsFunction,F,0). +% Determines whether a given term is a function and retrieves the position +% in the predicate where the function Result is stored/retrieved +is_function(AsFunction, _):- is_ftVar(AsFunction),!,fail. +is_function(AsFunction, _):- AsFunction=='$VAR',!, trace, fail. +is_function(AsFunction, Nth) :- is_arity_0(AsFunction,F), \+ not_function(F,0), !,Nth=1. +is_function(AsFunction, Nth) :- is_arity_0(AsFunction,_), !,Nth=1. +is_function(AsFunction, Nth) :- + callable(AsFunction), + functor(AsFunction, Functor, A), + \+ not_function(Functor, A), + AA is A + 1, + functional_predicate_arg_maybe(Functor, AA, Nth). -/* -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- - Convert =~ ['case',Value,Options],!, - must_det_ll(( - maplist(compile_case_bodies(HeadIs),Options,Cases), - Converted = - (( AllCases = Cases, - once((member(caseStruct(MatchVar,MatchCode,BodyResult,BodyCode),AllCases), - (MatchCode,unify_enough(Value,MatchVar)))), - (BodyCode), - BodyResult=RetResult)))). +functional_predicate_arg_maybe(F, AA, Nth):- functional_predicate_arg(F, AA, Nth),!. +functional_predicate_arg_maybe(F, AA, _):- A is AA - 1,functional_predicate_arg(F,A,_),!,fail. +functional_predicate_arg_maybe(F, Nth, Nth):- asserta(decl_functional_predicate_arg(F, Nth, Nth)),!. -compile_flow_control(HeadIs,_,Convert, Converted) :- - Convert =~ ['case',Value,Options,RetResult],!, - must_det_ll(( - f2p(HeadIs,ValueResult,Value,ValueCode), - maplist(compile_case_bodies(HeadIs),Options,Cases), - Converted = - (( AllCases = Cases, - call(ValueCode), - once((member(caseStruct(MatchVar,MatchCode,BodyResult,BodyCode),AllCases), - both_of(ValueResult,MatchCode,unify_enough(ValueResult,MatchVar)))), - call(BodyCode), - BodyResult=RetResult)))). +% If Convert is of the form (AsFunction=AsBodyFn), we perform conversion to obtain the equivalent predicate. +compile_head_for_assert(HeadIs, (Head:-Body)):- + compile_head_for_assert(HeadIs, NewHeadIs,Converted), + head_preconds_into_body(NewHeadIs,Converted,Head,Body). +head_as_is(Head):- + as_functor_args(Head,Functor,A,_),!, + head_as_is(Functor,A). +head_as_is(if,3). -both_of(Var,G1,G2):- nonvar(Var),!,call(G2),call(G1). -both_of(_Var,G1,G2):- call(G1),call(G2). +compile_head_for_assert(Head, Head, true):- + head_as_is(Head),!. -*/ +compile_head_for_assert(Head, NewestHead, HeadCode):- + compile_head_variablization(Head, NewHead, VHeadCode), + compile_head_args(NewHead, NewestHead, AHeadCode), + combine_code(VHeadCode,AHeadCode,HeadCode). -compile_case_bodies(HeadIs,[Match,Body],caseStruct(_,true,BodyResult,BodyCode)):- Match == '%void%',!, - f2p(HeadIs,BodyResult,Body,BodyCode). -compile_case_bodies(HeadIs,[Match,Body],caseStruct(MatchResult,If,BodyResult,BodyCode)):- !, - f2p(HeadIs,MatchResultV,Match,MatchCode), - combine_code(MatchCode,unify_enough(MatchResult,MatchResultV),If), - f2p(HeadIs,BodyResult,Body,BodyCode). -compile_case_bodies(HeadIs,MatchBody,CS):- compound(MatchBody), MatchBody =~ MB,compile_case_bodies(HeadIs,MB,CS). +% Construct the new head and the match body +compile_head_args(Head, NewHead, HeadCode) :- + must_det_ll(( + as_functor_args(Head,Functor,A,Args), + maplist(f2p_assign(Head),NewArgs,Args,CodeL), + as_functor_args(NewHead,Functor,A,NewArgs), + list_to_conjuncts(CodeL,HeadCode))),!. -compile_flow_control(HeadIs,RetResult,Convert,CodeForValueConverted) :- - % TODO: Plus seems an odd name for a variable - get an idea why? - transpile_prefix(Prefix), - Convert =~ [Plus,N,Value], atom(Plus), - atom_concat(Prefix,Plus,PrefixPlus), - current_predicate(PrefixPlus/3), number(N), - \+ number(Value), \+ is_ftVar(Value),!, - f2p(HeadIs,ValueResult,Value,CodeForValue),!, - Converted =.. [PrefixPlus,N,ValueResult,RetResult], - combine_code(CodeForValue,Converted,CodeForValueConverted). -compound_equals(COL1,COL2):- COL1=@=COL2,!,COL1=COL2. -compound_equals(COL1,COL2):- compound_equals1(COL1,COL2). -compound_equals1(COL1,COL2):- is_ftVar(COL1),!,is_ftVar(COL2),ignore(COL1=COL2),!. -compound_equals1(COL1,COL2):- compound(COL1),!,compound(COL2), COL1=COL2. -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- - Convert =~ ['superpose',COL],compound_equals(COL,'collapse'(Value1)), - f2p(HeadIs,ResValue1,Value1,CodeForValue1), - Converted = (findall(ResValue1,CodeForValue1,Gathered),member(RetResult,Gathered)). -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- - Convert =~ ['collapse',Value1],!, - f2p(HeadIs,ResValue1,Value1,CodeForValue1), - Converted = (findall(ResValue1,CodeForValue1,RetResult)). -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- - Convert =~ ['compose',Value1],!, - Convert2 =~ ['collapse',Value1],!, - compile_flow_control(HeadIs,RetResult,Convert2, Converted). -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), - Convert =~ ['unify',Value1,Value2,Then,Else],!,Test = metta_unify(ResValue1,ResValue2), - f2p(HeadIs,ResValue1,Value1,CodeForValue1), - f2p(HeadIs,ResValue2,Value2,CodeForValue2), - compile_test_then_else(RetResult,(CodeForValue1,CodeForValue2,Test),Then,Else,Converted). +:- op(700,xfx,'=~'). -/* -% match(Space,f(1)=Y,Y) -compile_flow_control(HeadIs,Y,Convert,Converted) :- dif_functors(HeadIs,Convert), - Convert=~ match(Space,AsFunctionY,YY), - nonvar(AsFunctionY),( AsFunctionY =~ (AsFunction=Y)), nonvar(AsFunction), - !, Y==YY, - f2p(HeadIs,Y,AsFunction,Converted),!. -*/ -compile_flow_control(HeadIs,Atom,Convert,Converted) :- - Convert=~ match(Space,Q,T),Q==T,Atom=Q,!, - compile_flow_control(HeadIs,Atom,'get-atoms'(Space),Converted). -compile_flow_control(_HeadIs,Match,Convert,Converted) :- - Convert=~ 'get-atoms'(Space), - Converted = metta_atom_iter(Space,Match). -compile_flow_control(HeadIs,AtomsVar,Convert,Converted) :- - Convert=~ 'get-atoms'(Space), AtomsVar = Pattern, - compile_pattern(HeadIs,Space,Pattern,Converted). +compile_for_assert(HeadIs, AsBodyFn, Converted) :- (AsBodyFn =@= HeadIs ; AsBodyFn == []), !,/*trace,*/ compile_head_for_assert(HeadIs,Converted). -compile_flow_control(HeadIs,RetResult,Convert,Converted) :- dif_functors(HeadIs,Convert), - Convert =~ 'match'(Space,Pattern,Template),!, - f2p(HeadIs,RetResult,Template,TemplateCode), - compile_pattern(HeadIs,Space,Pattern,SpacePatternCode), - combine_code(SpacePatternCode,TemplateCode,Converted). +% If Convert is of the form (AsFunction=AsBodyFn), we perform conversion to obtain the equivalent predicate. +compile_for_assert(Head, AsBodyFn, Converted) :- + once(compile_head_variablization(Head, HeadC, CodeForHeadArgs)), + \+(atomic(CodeForHeadArgs)), !, + compile_for_assert(HeadC, + (CodeForHeadArgs,AsBodyFn), Converted). -compile_pattern(_HeadIs,Space,Match,SpaceMatchCode):- - SpaceMatchCode = metta_atom_iter(Space,Match). +compile_for_assert(HeadIs, AsBodyFn, Converted) :- fail,is_ftVar(AsBodyFn), /*trace,*/ + AsFunction = HeadIs,!, + must_det_ll(( + Converted = (HeadC :- BodyC), % Create a rule with Head as the converted AsFunction and NextBody as the converted AsBodyFn + %funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head), + f2p(HeadIs, LazyVars, HResult, ResultLazy, AsFunction,HHead), + (var(HResult) -> (Result = HResult, HHead = Head) ; + funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head)), + NextBody = x_assign(AsBodyFn,Result), + optimize_head_and_body(Head,NextBody,HeadC,BodyC), + nop(ignore(Result = '$VAR'('HeadRes'))))),!. -metta_atom_iter(Space,Match):- - metta_atom_iter('=',10,Space,Space,Match). +compile_for_assert(HeadIs, AsBodyFn, Converted) :- + format("~q ~q ~q\n",[HeadIs, AsBodyFn, Converted]), + AsFunction = HeadIs, + must_det_ll(( + Converted = (HeadC :- NextBodyC), % Create a rule with Head as the converted AsFunction and NextBody as the converted AsBodyFn + /*funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head),*/ + f2p(HeadIs, LazyVars, HResult, ResultLazy, AsFunction,HHead), + (var(HResult) -> (Result = HResult, HHead = Head) ; + funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head)), + %verbose_unify(Converted), + f2p(HeadIs, LazyVars, Result, ResultLazy, AsBodyFn,NextBody), + %RetResult = Converted, + %RetResult = _, + optimize_head_and_body(Head,NextBody,HeadC,NextBodyC), + %fbug([convert(Convert),head_preconds_into_body(HeadC:-NextBodyC)]), + %if_t(((Head:-NextBody)\=@=(HeadC:-NextBodyC)),fbug(was(Head:-NextBody))), + nop(ignore(Result = '$VAR'('HeadRes'))))),!. +% If Convert is of the form (AsFunction=AsBodyFn), we perform conversion to obtain the equivalent predicate. +compile_for_assert(HeadIs, AsBodyFn, Converted) :- + AsFunction = HeadIs, Converted = (HeadCC :- BodyCC), + funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head), + compile_head_args(Head,HeadC,CodeForHeadArgs), + f2p(HeadIs, LazyVars, Result, ResultLazy, AsBodyFn,NextBody), + combine_code(CodeForHeadArgs,NextBody,BodyC),!, + optimize_head_and_body(HeadC,BodyC,HeadCC,BodyCC),!. -make_with_space(Space,MatchCode,MatchCode):- Space=='&self',!. -make_with_space(Space,MatchCode,with_space(Space,MatchCode)):- Space\=='&self'. +/* +*/ +metta_predicate(eval_args(evaluable,eachvar)). +metta_predicate(eval_true(matchable)). +metta_predicate(with_space(space,matchable)). +metta_predicate(limit(number,matchable)). +metta_predicate(findall(template,matchable,listvar)). +metta_predicate(match(space,matchable,template,eachvar)). -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- dif_functors(HeadIs,Convert), - Convert =~ 'match'(_Space,Match,Template),!, - must_det_ll(( - f2p(HeadIs,_,Match,MatchCode), - into_equals(RetResult,Template,TemplateCode), - combine_code(MatchCode,TemplateCode,Converted))). +head_preconds_into_body(Head,Body,Head,Body):- \+ compound(Head),!. +head_preconds_into_body((PreHead,True),Converted,Head,Body):- True==true,!, + head_preconds_into_body(PreHead,Converted,Head,Body). +head_preconds_into_body((True,PreHead),Converted,Head,Body):- True==true,!, + head_preconds_into_body(PreHead,Converted,Head,Body). +head_preconds_into_body(PreHead,(True,Converted),Head,Body):- True==true,!, + head_preconds_into_body(PreHead,Converted,Head,Body). +head_preconds_into_body(PreHead,(Converted,True),Head,Body):- True==true,!, + head_preconds_into_body(PreHead,Converted,Head,Body). +head_preconds_into_body((AsPredO,Pre),Converted,Head,Body):- + head_preconds_into_body(Pre,(AsPredO,Converted),Head,Body). -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- dif_functors(HeadIs,Convert), - Convert =~ ['if-decons',Atom,Head,Tail,Then,Else],!,Test = unify_cons(AtomResult,ResHead,ResTail), - f2p(HeadIs,AtomResult,Atom,AtomCode), - f2p(HeadIs,ResHead,Head,CodeForHead), - f2p(HeadIs,ResTail,Tail,CodeForTail), - compile_test_then_else(RetResult,(AtomCode,CodeForHead,CodeForTail,Test),Then,Else,Converted). +head_preconds_into_body(AHead,Body,Head,BodyNew):- + assertable_head(AHead,Head), + optimize_body(Head,Body,BodyNew). +assertable_head(u_assign(FList,R),Head):- FList =~ [F|List], + append(List,[R],NewArgs), atom(F),!, Head=..[F|NewArgs]. +assertable_head(Head,Head). -compile_flow_control(_HeadIs,RetResult,Convert,is_True(RetResult)) :- is_compiled_and(AND), - Convert =~ [AND],!. +ok_to_append('$VAR'):- !, fail. +ok_to_append(_). -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- is_compiled_and(AND), - Convert =~ [AND,Body],!, - f2p(HeadIs,RetResult,Body,BodyCode), - compile_test_then_else(RetResult,BodyCode,'True','False',Converted). +p2s(P,S):- into_list_args(P,S). -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- is_compiled_and(AND), - Convert =~ [AND,Body1,Body2],!, - f2p(HeadIs,B1Res,Body1,Body1Code), - f2p(HeadIs,RetResult,Body2,Body2Code), - into_equals(B1Res,'True',AE), - Converted = (Body1Code,AE,Body2Code),!. +non_compound(S):- \+ compound(S). +did_optimize_conj(Head,B1,B2,B12):- optimize_conj(Head,B1,B2,B12), B12\=@=(B1,B2),!. -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- is_compiled_and(AND), - Convert =~ [AND,Body1,Body2],!, - f2p(HeadIs,B1Res,Body1,Body1Code), - f2p(HeadIs,_,Body2,Body2Code), - into_equals(B1Res,'True',AE), - compile_test_then_else(RetResult,(Body1Code,AE,Body2Code),'True','False',Converted). -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- is_compiled_and(AND), - Convert =~ [AND,Body1,Body2|BodyMore],!, - And2 =~ [AND,Body2|BodyMore], - Next =~ [AND,Body1,And2], - compile_flow_control(HeadIs,RetResult, Next, Converted). +optimize_conjuncts(Head,(B1,B2,B3),BN):- B3\==(_,_), + did_optimize_conj(Head,B2,B3,B23), + optimize_conjuncts(Head,B1,B23,BN), !. +optimize_conjuncts(Head,(B1,B2,B3),BN):- + did_optimize_conj(Head,B1,B2,B12), + optimize_conjuncts(Head,B12,B3,BN),!. +%optimize_conjuncts(Head,(B1,B2),BN1):- optimize_conj(Head,B1,B2,BN1). +optimize_conjuncts(Head,(B1,B2),BN1):- did_optimize_conj(Head,B1,B2,BN1),!. +optimize_conjuncts(Head,B1,B2,(BN1,BN2)):- + must_optimize_body(Head,B1,BN1), must_optimize_body(Head,B2,BN2). -compile_flow_control(HeadIs,RetResult,sequential(Convert), Converted) :- !, - compile_flow_control(HeadIs,RetResult,transpose(Convert), Converted). +optimize_conj(_, x_assign(Term, C), x_assign(True,CC), eval_true(Term)):- 'True'==True, CC==C. +optimize_conj(_, x_assign(Term, C), is_True(CC), eval_true(Term)):- CC==C, !. +optimize_conj(_, B1,BT,B1):- assumed_true(BT),!. +optimize_conj(_, BT,B1,B1):- assumed_true(BT),!. +%optimize_conj(Head, x_assign(Term, C), x_assign(True,CC), Term):- 'True'==True, +% optimize_conj(Head, x_assign(Term, C), is_True(CC), CTerm). +%optimize_conj(Head,B1,BT,BN1):- assumed_true(BT),!, optimize_body(Head,B1,BN1). +%optimize_conj(Head,BT,B1,BN1):- assumed_true(BT),!, optimize_body(Head,B1,BN1). +optimize_conj(Head,B1,B2,(BN1,BN2)):- + optimize_body(Head,B1,BN1), optimize_body(Head,B2,BN2). -compile_flow_control(HeadIs,RetResult,transpose(Convert), Converted,Code) :- !, - maplist(each_result(HeadIs,RetResult),Convert, Converted), - list_to_disjuncts(Converted,Code). +assumed_true(B2):- var(B2),!,fail. +assumed_true(eval_true(B2)):-!,assumed_true(B2). +assumed_true(B2):- B2== true,!. +assumed_true(B2):- B2==x_assign('True', '$VAR'('_')),!. +assumed_true(X==Y):- assumed_true(X=Y). +assumed_true(X=Y):- var(X),var(Y), X=Y. +assumed_true(X=Y):- is_ftVar(X),is_ftVar(Y), X=Y. -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), - Convert =~ if(Cond,Then),!, - f2p(HeadIs,CondResult,Cond,CondCode), - f2p(HeadIs,RetResult,Then,ThenCode), - Converted = ((CondCode,is_True(CondResult)),ThenCode). +filter_head_arg(H,F):- var(H),!,H=F. +filter_head_arge(H,F):- H = F. -each_result(HeadIs,RetResult,Convert,Converted):- - f2p(HeadIs,OneResult,Convert,Code1), - into_equals(OneResult,RetResult,Code2), - combine_code(Code1,Code2,Converted). +code_callable(Term,_CTerm):- var(Term),!,fail. +code_callable(Term, CTerm):- current_predicate(_,Term),!,Term=CTerm. +%code_callable(Term, CTerm):- current_predicate(_,Term),!,Term=CTerm. -compile_flow_control(HeadIs,RetResult,Converter, Converted):- de_eval(Converter,Convert),!, - compile_flow_control(HeadIs,RetResult,Convert, Converted). -compile_flow_control(HeadIs,_Result,Convert, Converted) :- fail, - functor(Convert,Func,PA), - functional_predicate_arg(Func,PA,Nth), - Convert =~ [Func|PredArgs], - nth1(Nth,PredArgs,Result,FuncArgs), - RetResult = Result, - AsFunct =~ [Func|FuncArgs], - compile_flow_control(HeadIs,RetResult,AsFunct, Converted). -dif_functors(HeadIs,_):- var(HeadIs),!,fail. -dif_functors(HeadIs,_):- \+ compound(HeadIs),!. -dif_functors(HeadIs,Convert):- compound(HeadIs),compound(Convert), - compound_name_arity(HeadIs,F,A),compound_name_arity(Convert,F,A). -is_compiled_and(AND):- member(AND,[ (','), ('and')]). +compile_flow_control(_HeadIs, LazyVars, RetResult, ResultLazy, Convert, x_assign(Convert,RetResult)) :- is_ftVar(Convert), var(RetResult),!. -flowc. :- discontiguous f2p/4. % If Convert is a variable, the corresponding predicate is just eval_args(Convert, RetResult) -f2p(_HeadIs,RetResult,Convert, RetResultConverted) :- +f2p(_HeadIs, LazyVars, RetResult, ResultLazy, Convert, RetResultConverted) :- is_ftVar(Convert),!,% Check if Convert is a variable into_equals(RetResult,Convert,RetResultConverted). % Converted = eval_args(Convert, RetResult). % Set Converted to eval_args(Convert, RetResult) % If Convert is a variable, the corresponding predicate is just eval_args(Convert, RetResult) -f2p(_HeadIs,RetResult,Convert, RetResultConverted) :- +f2p(_HeadIs, LazyVars, RetResult, ResultLazy, Convert, RetResultConverted) :- is_ftVar(Convert),!,% Check if Convert is a variable into_equals(RetResult,Convert,RetResultConverted). % Converted = eval_args(Convert, RetResult). % Set Converted to eval_args(Convert, RetResult) -f2p(_HeadIs,RetResult,Convert, RetResultConverted) :- +f2p(_HeadIs, LazyVars, RetResult, ResultLazy, Convert, RetResultConverted) :- number(Convert),!,into_equals(RetResult,Convert,RetResultConverted). -f2p(_HeadIs,RetResult,Convert, Converted) :- % HeadIs\=@=Convert, +f2p(_HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- % HeadIs\=@=Convert, is_arity_0(Convert,F), !, Converted = x_assign([F],RetResult),!. -/*f2p(HeadIs,RetResult, ConvertL, (Converted,RetResultL=RetResult)) :- is_list(ConvertL), +/*f2p(HeadIs, LazyVars, RetResult, ResultLazy, ConvertL, (Converted,RetResultL=RetResult)) :- is_list(ConvertL), maplist(f2p_assign(HeadIs),RetResultL,ConvertL, ConvertedL), list_to_conjuncts(ConvertedL,Converted).*/ % If Convert is an "eval_args" function, we convert it to the equivalent "is" predicate. -f2p(HeadIs,RetResult,EvalConvert,Converted):- EvalConvert =~ eval_args(Convert), !, - must_det_ll((f2p(HeadIs,RetResult,Convert, Converted))). +f2p(HeadIs, LazyVars, RetResult, ResultLazy, EvalConvert,Converted):- EvalConvert =~ eval_args(Convert), !, + must_det_ll((f2p(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted))). % placeholder -f2p(HeadIs,RetResult,Convert, Converted):- +f2p(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted):- compound(Convert), Convert = x_assign(C, Var), compound_non_cons(C),into_list_args(C,CC),!, - f2p(HeadIs,RetResult,x_assign(CC, Var), Converted). + f2p(HeadIs, LazyVars, RetResult, ResultLazy, x_assign(CC, Var), Converted). -f2p(_HeadIs,_RetResult,Convert, Converted):- +f2p(_HeadIs, LazyVars, _RetResult, ResultLazy, Convert, Converted):- compound(Convert), Convert = x_assign(C, _Var), is_list(C),Converted = Convert,!. -f2p(HeadIs,RetResult,Convert, Converted) :- +f2p(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- atom(Convert), functional_predicate_arg(Convert,Nth,Nth2), Nth==1,Nth2==1, HeadIs\=@=Convert, @@ -1500,44 +2303,44 @@ % PLACEHOLDER % If Convert is an "is" function, we convert it to the equivalent "is" predicate. -f2p(HeadIs,RetResult,is(Convert),(Converted,is(RetResult,Result))):- !, - must_det_ll((f2p(HeadIs,Result,Convert, Converted))). +f2p(HeadIs, LazyVars, RetResult, ResultLazy, is(Convert),(Converted,is(RetResult,Result))):- !, + must_det_ll((f2p(HeadIs, LazyVars, Result, ResultLazy, Convert, Converted))). % If Convert is an "or" function, we convert it to the equivalent ";" (or) predicate. -f2p(HeadIs,RetResult,or(AsPredI,Convert), (AsPredO *-> true; Converted)) :- fail, !, - must_det_ll((f2p(HeadIs,RetResult,AsPredI, AsPredO), - f2p(HeadIs,RetResult,Convert, Converted))). - -f2p(HeadIs,RetResult,(AsPredI; Convert), (AsPredO; Converted)) :- !, - must_det_ll((f2p(HeadIs,RetResult,AsPredI, AsPredO), - f2p(HeadIs,RetResult,Convert, Converted))). -f2p(HeadIs,RetResult,SOR,or(AsPredO, Converted)) :- +f2p(HeadIs, LazyVars, RetResult, ResultLazy, or(AsPredI,Convert), (AsPredO *-> true; Converted)) :- fail, !, + must_det_ll((f2p(HeadIs, LazyVars, RetResult, ResultLazy, AsPredI, AsPredO), + f2p(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted))). + +f2p(HeadIs, LazyVars, RetResult, ResultLazy, (AsPredI; Convert), (AsPredO; Converted)) :- !, + must_det_ll((f2p(HeadIs, LazyVars, RetResult, ResultLazy, AsPredI, AsPredO), + f2p(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted))). +f2p(HeadIs, LazyVars, RetResult, ResultLazy, SOR,or(AsPredO, Converted)) :- SOR =~ or(AsPredI, Convert), - must_det_ll((f2p(HeadIs,RetResult,AsPredI, AsPredO), - f2p(HeadIs,RetResult,Convert, Converted))),!. + must_det_ll((f2p(HeadIs, LazyVars, RetResult, ResultLazy, AsPredI, AsPredO), + f2p(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted))),!. % If Convert is a "," (and) function, we convert it to the equivalent "," (and) predicate. -f2p(HeadIs,RetResult,(AsPredI, Convert), (AsPredO, Converted)) :- !, - must_det_ll((f2p(HeadIs,_RtResult,AsPredI, AsPredO), - f2p(HeadIs,RetResult,Convert, Converted))). +f2p(HeadIs, LazyVars, RetResult, ResultLazy, (AsPredI, Convert), (AsPredO, Converted)) :- !, + must_det_ll((f2p(HeadIs, LazyVars, _RtResult, ResultLazy, AsPredI, AsPredO), + f2p(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted))). % If Convert is a ":-" (if) function, we convert it to the equivalent ":-" (if) predicate. -f2p(_HeadIs,RetResult, Convert, Converted) :- Convert =(H:-B),!, +f2p(_HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- Convert =(H:-B),!, RetResult=(H:-B), Converted = true. -f2p(_HeadIs,_RetResult, N=V, Code) :- !, into_equals(N,V,Code). +f2p(_HeadIs, LazyVars, _RetResult, ResultLazy, N=V, Code) :- !, into_equals(N,V,Code). % If Convert is a list, we convert it to its termified form and then proceed with the functs_to_preds conversion. -f2p(HeadIs,RetResult,Convert, Converted) :- fail, +f2p(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- fail, is_list(Convert), once((sexpr_s2p(Convert,IS), \+ IS=@=Convert)), !, % Check if Convert is a list and not in predicate form - must_det_ll((f2p(HeadIs,RetResult, IS, Converted))). % Proceed with the conversion of the predicate form of the list. + must_det_ll((f2p(HeadIs, LazyVars, RetResult, ResultLazy, IS, Converted))). % Proceed with the conversion of the predicate form of the list. -f2p(HeadIs,RetResult, ConvertL, Converted) :- fail, +f2p(HeadIs, LazyVars, RetResult, ResultLazy, ConvertL, Converted) :- fail, is_list(ConvertL), maplist(f2p_assign(HeadIs),RetResultL,ConvertL, ConvertedL), list_to_conjuncts(ConvertedL,Conjs), @@ -1545,58 +2348,58 @@ combine_code(Conjs,Code,Converted). -f2p(HeadIs,RetResultL, ConvertL, Converted) :- fail, +f2p(HeadIs, LazyVars, RetResultL, ResultLazy, ConvertL, Converted) :- fail, is_list(ConvertL), ConvertL = [Convert], - f2p(HeadIs,RetResult,Convert, Code), !, + f2p(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Code), !, into_equals(RetResultL,[RetResult],Equals), combine_code(Code,Equals,Converted). % If any sub-term of Convert is a function, convert that sub-term and then proceed with the conversion. -f2p(HeadIs,RetResult,Convert, Converted) :- +f2p(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- rev_sub_sterm(AsFunction, Convert), % Get the deepest sub-term AsFunction of Convert % sub_term(AsFunction, Convert), AsFunction\==Convert, callable(AsFunction), % Check if AsFunction is callable - compile_flow_control(HeadIs,Result,AsFunction, AsPred), + compile_flow_control(HeadIs, LazyVars, Result, ResultLazy, AsFunction, AsPred), HeadIs\=@=AsFunction,!, subst(Convert, AsFunction, Result, Converting), % Substitute AsFunction by Result in Convert - f2p(HeadIs,RetResult,(AsPred,Converting), Converted). % Proceed with the conversion of the remaining terms + f2p(HeadIs, LazyVars, RetResult, ResultLazy, (AsPred,Converting), Converted). % Proceed with the conversion of the remaining terms % If any sub-term of Convert is a function, convert that sub-term and then proceed with the conversion. -f2p(HeadIs,RetResult,Convert, Converted) :- +f2p(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- rev_sub_sterm(AsFunction, Convert), % Get the deepest sub-term AsFunction of Convert callable(AsFunction), % Check if AsFunction is callable is_function(AsFunction, Nth), % Check if AsFunction is a function and get the position Nth where the result is stored/retrieved HeadIs\=@=AsFunction, funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, Nth, AsPred), % Convert AsFunction to a predicate AsPred subst(Convert, AsFunction, Result, Converting), % Substitute AsFunction by Result in Convert - f2p(HeadIs,RetResult, (AsPred, Converting), Converted). % Proceed with the conversion of the remaining terms + f2p(HeadIs, LazyVars, RetResult, ResultLazy, (AsPred, Converting), Converted). % Proceed with the conversion of the remaining terms % If AsFunction is a recognized function, convert it to a predicate. -f2p(HeadIs,RetResult,AsFunction,AsPred):- % HeadIs\=@=AsFunction, +f2p(HeadIs, LazyVars, RetResult, ResultLazy, AsFunction,AsPred):- % HeadIs\=@=AsFunction, is_function(AsFunction, Nth), % Check if AsFunction is a recognized function and get the position Nth where the result is stored/retrieved funct_with_result_is_nth_of_pred(HeadIs,AsFunction, RetResult, Nth, AsPred), \+ ( compound(AsFunction), arg(_,AsFunction, Arg), is_function(Arg,_)),!. % If any sub-term of Convert is an eval_args/2, convert that sub-term and then proceed with the conversion. -f2p(HeadIs,RetResult,Convert, Converted) :- +f2p(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- rev_sub_sterm0(ConvertFunction, Convert), % Get the deepest sub-term AsFunction of Convert callable(ConvertFunction), % Check if AsFunction is callable ConvertFunction = eval_args(AsFunction,Result), ignore(is_function(AsFunction, Nth)), funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, Nth, AsPred), % Convert AsFunction to a predicate AsPred subst(Convert, ConvertFunction, Result, Converting), % Substitute AsFunction by Result in Convert - f2p(HeadIs,RetResult, (AsPred, Converting), Converted). % Proceed with the conversion of the remaining terms + f2p(HeadIs, LazyVars, RetResult, ResultLazy, (AsPred, Converting), Converted). % Proceed with the conversion of the remaining terms /* MAYBE USE ? % If Convert is a compound term, we need to recursively convert its arguments. -f2p(HeadIs,RetResult, Convert, Converted) :- fail, +f2p(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- fail, compound(Convert), !, Convert =~ [Functor|Args], % Deconstruct Convert to functor and arguments maplist(convert_argument, Args, ConvertedArgs), % Recursively convert each argument Converted =~ [Functor|ConvertedArgs], % Reconstruct Converted with the converted arguments - (callable(Converted) -> f2p(HeadIs,RetResult, Converted, _); true). % If Converted is callable, proceed with its conversion + (callable(Converted) -> f2p(HeadIs, LazyVars, RetResult, ResultLazy, Converted, _); true). % If Converted is callable, proceed with its conversion % Helper predicate to convert an argument of a compound term convert_argument(Arg, ConvertedArg) :- (callable(Arg) -> ftp(_, _, Arg, ConvertedArg); ConvertedArg = Arg). @@ -1604,22 +2407,6 @@ -de_eval(eval(X),X):- compound(X),!. - -call1(G):- call(G). -call2(G):- call(G). -call3(G):- call(G). -call4(G):- call(G). -call5(G):- call(G). - -trace_break:- trace,break. - -:- if(debugging(metta(compiler_bugs))). -:- set_prolog_flag(gc,false). -:- endif. - -call_fr(G,Result,FA):- current_predicate(FA),!,call(G,Result). -call_fr(G,Result,_):- Result=G. % This predicate is responsible for converting functions to their equivalent predicates. % It takes a function 'AsFunction' and determines the predicate 'AsPred' which will be @@ -1785,7 +2572,7 @@ reverse(List,RevList),append(Left,[BE|Right],RevList), compound(BE),arg(Nth,BE,ArgRes),sub_var(Result,ArgRes), remove_funct_arg(BE, Nth, AsBodyFunction), - append(Left,[eval_args(AsBodyFunction,Result)|Right],NewRevList), + combine_code(Left,[eval_args(AsBodyFunction,Result)|Right],NewRevList), reverse(NewRevList,NewList), list_to_conjuncts(NewList,NewBody), preds_to_functs0(NewBody,ConvertedBody), @@ -1934,10 +2721,7 @@ NewAcc = (Acc;TransformedBody), combine_bodies(T, NewHead, NewAcc, CombinedBodies). -% combine_code/3 combines Guard and Body to produce either Guard, Body, or a conjunction of both, depending on the values of Guard and Body. -combine_code(Guard, Body, Guard) :- Body==true, !. -combine_code(Guard, Body, Body) :- Guard==true, !. -combine_code(Guard, Body, (Guard, Body)). + % create_unifier/3 creates a unification code that unifies OneHead with NewHead. % If OneHead and NewHead are structurally equal, then they are unified and the unification Guard is 'true'. @@ -1974,3 +2758,8 @@ + + + + + diff --git a/.Attic/metta_lang/metta_compiler_lib.pl b/.Attic/metta_lang/metta_compiler_lib.pl index b85b79e75c4..da17027118a 100644 --- a/.Attic/metta_lang/metta_compiler_lib.pl +++ b/.Attic/metta_lang/metta_compiler_lib.pl @@ -1,5 +1,35 @@ :- discontiguous get_type_sig/3. + +from_prolog_args(_,X,X). +:-dynamic(pred_uses_fallback/2). +:-dynamic(pred_uses_impl/2). + +pred_uses_impl(F,A):- transpile_impl_prefix(F,Fn),current_predicate(Fn/A). + +mc_fallback_unimpl(Fn,Arity,Args,Res):- + (pred_uses_fallback(Fn,Arity);(length(Args,Len),\+pred_uses_impl(Fn,Len))),!, + get_operator_typedef_props(_,Fn,Arity,Types,_RetType0), + current_self(Self), + maybe_eval(Self,Types,Args,NewArgs), + [Fn|NewArgs]=Res. + +maybe_eval(_Self,_Types,[],[]):-!. +maybe_eval(Self,[T|Types],[A|Args],[N|NewArgs]):- + into_typed_arg(30,Self,T,A,N), + maybe_eval(Self,Types,Args,NewArgs). + + +'mc__:'(Obj, Type, [':',Obj, Type]):- current_self(Self), sync_type(10, Self, Obj, Type). %freeze(Obj, get_type(Obj,Type)),!. +sync_type(D, Self, Obj, Type):- nonvar(Obj), nonvar(Type), !, arg_conform(D, Self, Obj, Type). +sync_type(D, Self, Obj, Type):- nonvar(Obj), var(Type), !, get_type(D, Self, Obj, Type). +sync_type(D, Self, Obj, Type):- nonvar(Type), var(Obj), !, set_type(D, Self, Obj, Type). %, freeze(Obj, arg_conform(D, Self, Obj, Type)). +sync_type(D, Self, Obj, Type):- freeze(Type,sync_type(D, Self, Obj, Type)), freeze(Obj, sync_type(D, Self, Obj, Type)),!. + + +%'mc__get-type'(Obj,Type):- attvar(Obj),current_self(Self),!,trace,get_attrs(Obj,Atts),get_type(10, Self, Obj,Type). +'mc__get-type'(Obj,Type):- current_self(Self), !, get_type(10, Self, Obj,Type). + %%%%%%%%%%%%%%%%%%%%% arithmetic % get_type_sig('+',['Number','Number'],'Number'). @@ -22,8 +52,9 @@ %%%%%%%%%%%%%%%%%%%%% comparison -'mc__=='(A,A,1) :- !. -'mc__=='(_,_,0). +'mc__=='(A,B,TF) :- (var(A);var(B)),!,A=B, TF='True'. +'mc__=='(A,B,TF) :- as_tf(A=B,TF). +%'mc__=='(_,_,0). 'mc__<'(A,B,R) :- number(A),number(B),!,(A R=1 ; R=0). 'mc__<'(A,B,['<',A,B]). @@ -36,15 +67,17 @@ 'mc__cons-atom'(A,B,[A|B]). +%%%%%%%%%%%%%%%%%%%%%superpose,collapse + +'mi__superpose'([H|_],H). +'mi__superpose'([_|T],R):-'mi__superpose'(T,R). + %%%%%%%%%%%%%%%%%%%%% misc +'mc__empty'(_) :- fail. + 'mc__stringToChars'(S,C) :- string_chars(S,C). 'mc__charsToString'(C,S) :- string_chars(S,C). mc__assertEqualToResult(A, B, C) :- u_assign([assertEqualToResult, A, B], C). - - - -mc__empty(_):-!,fail. - diff --git a/.Attic/metta_lang/metta_debug.pl b/.Attic/metta_lang/metta_debug.pl index 8cb7d90d6ba..e5f3fcdc902 100755 --- a/.Attic/metta_lang/metta_debug.pl +++ b/.Attic/metta_lang/metta_debug.pl @@ -763,69 +763,6 @@ is_showing(Flag) :- fast_option_value(Flag, 'show'), !. -log_file_type(X):- nonvar(X),!,log_file_type(Is),!,Is=X. -log_file_type(metta):- fast_option_value(compile, full),!. -log_file_type(prolog):- fast_option_value(compile, save),!. -log_file_type(markdown):- fast_option_value(format, markdown),!. -log_file_type(metta):- fast_option_value(compile, false),!. -log_file_type(prolog). - - -into_blocktype(InfoType,Goal):- enter_markdown(InfoType),!,call(Goal). - - -%into_blocktype(InfoType,Goal):- log_file_type(markdown), !, setup_call_cleanup(format('~N```~w~n',[InfoType]),Goal, format('~N```~n',[])). -%into_blocktype(InfoType,Goal):- log_file_type(prolog), !, setup_call_cleanup(format('~N```~w~n',[InfoType]),Goal, format('~N```~n',[])). -%into_blocktype(InfoType,Goal):- log_file_type(prolog), !, setup_call_cleanup(format('~N/*~n```~w~n*/~n',[InfoType]),Goal, format('~N/*~n```~n*/~n',[])). - -output_language( InfoType, Goal ) :- log_file_type(Lang), !, % (Lang==prolog; Lang==metta),!, - ((InfoType == Lang -> (must_det_ll((enter_markdown(Lang),leave_comment)),call(Goal)) ; (must_det_ll(enter_comment),into_blocktype(InfoType,Goal)))). - -%output_language( InfoType, Goal ) :- log_file_type(markdown), !, into_blocktype(InfoType,Goal). -%output_language( comment, Goal ) :- log_file_type(markdown), !, call(Goal). -%output_language( comment, Goal ) :- log_file_type(prolog), !, format('~N:- q.~n', [output_language( comment, Goal)]). -%output_language( comment, Goal ) :- log_file_type(metta), !, in_cmt(Goal). - -:- dynamic(enabled_save_markdown/0). - - - -:- dynamic(inside_comment/0). -leave_comment:- \+ enabled_save_markdown, !. -leave_comment:- inside_comment,!, format('~N*/~n~n'),retract(inside_comment). -leave_comment. - -enter_comment:- \+ enabled_save_markdown, !. -enter_comment:- inside_comment,!. -enter_comment:- format('~N~n/*~n'),assert(inside_comment). -:- enter_comment. - -:- at_halt(leave_markdown(_)). -:- at_halt(leave_comment). - - -:- dynamic(inside_markdown/1). -leave_markdown(_):- \+ enabled_save_markdown, !. -leave_markdown(_):- \+ inside_markdown(_),!. -leave_markdown(Lang):- inside_markdown(Lang),!, format('~N```~n'),retract(inside_markdown(Lang)). -%leave_markdown(_):- inside_markdown(Other),!,leave_markdown(Other). -leave_markdown(_Lang):- !. %format('~N```~n'),!. - -enter_markdown(_):- \+ enabled_save_markdown, !. -enter_markdown(Lang):- inside_markdown(Lang),!. -enter_markdown(Lang):- inside_markdown(Other),!,leave_markdown(Other),!,enter_markdown(Lang). -enter_markdown(Lang):- log_file_type(Us),Us=Lang,inside_comment,!,format('~N```~w~n',[Lang]),asserta(inside_markdown(Lang)),leave_comment. -enter_markdown(Lang):- format('~N```~w~n',[Lang]),asserta(inside_markdown(Lang)). - - -pick_quote(String, '"'):- \+ string_contains(String,'"'),!. -pick_quote(String, '\''):- \+ string_contains(String,'\''),!. -pick_quote(String, '`'):- \+ string_contains(String,'`'),!. - -banner_writeln(Msg):- - writeln('/*===='), - writeln(Msg), - writeln('====*/'),!. %! if_show(+Flag, :Goal) is nondet. % @@ -1047,2732 +984,167 @@ % (Ret\=@=retval(fail)->true;(fail,trace,(call(P4,D1,Self,X,Y)),fail)). -:- set_prolog_flag(expect_pfc_file, unknown). - -% ======================================================= -/* -% -%= predicates to examine the state of pfc -% interactively exploring Pfc justifications. -% -% Logicmoo Project PrologMUD: A MUD server written in Prolog -% Maintainer: Douglas Miles -% Dec 13, 2035 -% -*/ -% ======================================================= -% File: /opt/PrologMUD/pack/logicmoo_base/prolog/logicmoo/mpred/pfc_list_triggers.pl -:- if(( ( \+ ((current_prolog_flag(logicmoo_include,Call),Call))) )). - -%! pfc_listing_module is det. -% -% Defines a module `pfc_listing` with a list of exported predicates. -% -% This predicate is used to define the `pfc_listing` module, which exports a variety of predicates -% related to PFC (Prolog Forward Chaining) operations. These predicates are responsible for tasks such as -% listing triggers, printing facts, rules, and handling logic operations. Some predicates related to PFC -% tracing and debugging are commented out. -% -% This module is conditionally included based on the status of the `logicmoo_include` flag, which -% controls whether this specific code should be loaded. -% -% @example -% % Define the `pfc_listing` module with several utility predicates: -% ?- pfc_listing_module. -% -pfc_listing_module :- nop(module(pfc_listing, - [ draw_line/0, - loop_check_just/1, - pinfo/1, - pp_items/2, - pp_item/2, - pp_filtered/1, - pp_facts/2, - pp_facts/1, - pp_facts/0, - pfc_list_triggers_types/1, - pfc_list_triggers_nlc/1, - pfc_list_triggers_1/1, - pfc_list_triggers_0/1, - pfc_list_triggers/1, - pfc_contains_term/2, - pfc_classify_facts/4, - lqu/0, - get_clause_vars_for_print/2, - %pfcWhyBrouse/2, - %pfcWhy1/1, - %pfcWhy/1, - %pfcWhy/0, - pp_rules/0, - pfcPrintSupports/0, - pfcPrintTriggers/0, - print_db_items/1, - print_db_items/2, - print_db_items/3, - print_db_items/4, - print_db_items_and_neg/3, - show_pred_info/1, - show_pred_info_0/1, - pfc_listing_file/0 - ])). - -%:- include('pfc_header.pi'). - -:- endif. - -% Operator declarations -% -% This section defines custom operators to be used in the program. -% -% - `~` (fx, precedence 500): Unary negation operator. -% - `==>` (xfx, precedence 1050): Defines an implication or rule operator used in logic programming. -% - `<==>` (xfx, precedence 1050): Represents bi-conditional equivalence. -% - `<-` (xfx, precedence 1050): Represents a backward implication or reverse rule. -% - `::::` (xfx, precedence 1150): A specialized operator often used in Prolog for custom logic. -% -% These operator declarations define how terms with these symbols are parsed and processed -% by the Prolog interpreter. -% Operator declarations -:- op(500, fx, '~'). % Unary negation operator -:- op(1050, xfx, ('==>')). % Implication operator -:- op(1050, xfx, '<==>'). % Bi-conditional equivalence operator -:- op(1050, xfx, ('<-')). % Backward implication operator -:- op(1100, fx, ('==>')). % Implication operator (fx variant) -:- op(1150, xfx, ('::::')). % Specialized operator - -% :- use_module(logicmoo(util/logicmoo_util_preddefs)). - -% The `multifile/1` directive allows the specified predicates to have clauses spread across multiple files. -% This is particularly useful in modular Prolog programs where different components may define or extend the -% same predicates. The following predicates are declared as multifile in the `user` module: -% -:- multifile(( - user:portray/1, - user:prolog_list_goal/1, - user:prolog_predicate_name/2, - user:prolog_clause_name/2)). - -% `user:portray/1` can be modified (asserted or retracted) during runtime. -:- dynamic user:portray/1. - -%:- dynamic(whybuffer/2). - -%! lqu is nondet. -% -% Lists all clauses of the predicate `que/2`. -% -% The `lqu/0` predicate uses the built-in `listing/1` predicate to display all clauses -% currently defined for the predicate `que/2`. It helps in inspecting the facts or rules -% related to `que/2` that are loaded in the program. -% -% @example -% % List all clauses of the predicate que/2: -% ?- lqu. -% % Expected output: All defined clauses of que/2. -% -lqu :- listing(que/2). - -% Ensure that the file `metta_pfc_base` is loaded. -:- ensure_loaded(metta_pfc_base). -% File : pfcdebug.pl -% Author : Tim Finin, finin@prc.unisys.com -% Author : Dave Matuszek, dave@prc.unisys.com -% Author : Douglas R. Miles, dmiles@teknowledge.com -% Updated: -% Purpose: provides predicates for examining the database and debugging -% for Pfc. - -% The following predicates can be modified (asserted or retracted) during runtime. -:- dynamic pfcTraced/1. -:- dynamic pfcSpied/2. -:- dynamic pfcTraceExecution/0. -:- dynamic pfcWarnings/1. - -%! pfcDefault(+Option, +DefaultValue) is det. -% -% Set a default value for a PFC (Prolog Forward Chaining) option. -% -% This directive sets a default value for the specified PFC option if it has not been defined yet. -% In this case, it ensures that the `pfcWarnings/1` option has a default value of `true`, -% which likely enables warnings during PFC operations. -% -% - `pfcWarnings(_)`: The option related to enabling or disabling PFC warnings. -% - `pfcWarnings(true)`: Sets the default value for `pfcWarnings/1` to `true`, enabling warnings. -% -% @arg Option The PFC option to configure. -% @arg DefaultValue The default value to set if no value is already set. -% -% @example -% % Set the default value of pfcWarnings to true: -% :- pfcDefault(pfcWarnings(_), pfcWarnings(true)). -% -:- pfcDefault(pfcWarnings(_), pfcWarnings(true)). - -%! pfcQueue is nondet. -% -% Lists all clauses of the predicate `pfcQueue/1`. -% -% This predicate lists all the clauses currently defined for `pfcQueue/1`, -% allowing inspection of the Pfc queue contents. -% -% @example -% % List all clauses of pfcQueue/1: -% ?- pfcQueue. -% -pfcQueue :- listing(pfcQueue/1). - -%! pfcPrintDB is nondet. -% -% Prints the entire Pfc database, including facts, rules, triggers, and supports. -% -% This predicate calls several sub-predicates to print all facts, rules, triggers, -% and supports in the Pfc database. It provides a complete overview of the current -% Pfc knowledge base. -% -% @example -% % Print the entire Pfc database: -% ?- pfcPrintDB. -% -pfcPrintDB :- - pfcPrintFacts, - pfcPrintRules, - pfcPrintTriggers, - pfcPrintSupports, !. - -%! printLine is nondet. -% -% Draws a line in the console output for formatting purposes. -% -% This predicate prints a separator line to the console using ANSI formatting, -% which can be used for visual separation of output sections. -% -% @example -% % Print a separator line: -% ?- printLine. -% -printLine :- ansi_format([underline], "~N=========================================~n", []). - -%! pfcPrintFacts is nondet. -% -% Prints all facts in the Pfc database. -% -% This predicate prints all facts currently in the Pfc database by calling -% `pfcPrintFacts/2` with a wildcard pattern and a flag to show all facts. -% -% @example -% % Print all facts in the Pfc database: -% ?- pfcPrintFacts. -% -pfcPrintFacts :- pfcPrintFacts(_, true). - -%! pfcPrintFacts(+Pattern) is nondet. -% -% Prints all facts in the Pfc database that match a given pattern. -% -% This predicate prints all facts that match the given `Pattern` in the Pfc database. -% The pattern can be used to filter facts for specific queries. -% -% @arg Pattern The pattern to match facts against. -% -% @example -% % Print facts matching a specific pattern: -% ?- pfcPrintFacts(my_predicate(_)). -% -pfcPrintFacts(Pattern) :- pfcPrintFacts(Pattern, true). - -%! pfcPrintFacts(+Pattern, +Condition) is nondet. -% -% Prints all facts in the Pfc database that match a given pattern and condition. -% -% This predicate retrieves facts from the Pfc database that match the given `Pattern` -% and satisfy the specified `Condition`. The facts are classified into user-added facts -% and Pfc-added facts, and then printed accordingly. The predicate uses auxiliary -% predicates to classify and print the facts. -% -% @arg Pattern The pattern to match facts against. -% @arg Condition The condition used to filter facts. -% -% @example -% % Print facts matching a pattern and a condition: -% ?- pfcPrintFacts(my_predicate(_), true). -% -pfcPrintFacts(P, C) :- - pfcFacts(P, C, L), - pfcClassifyFacts(L, User, Pfc, _Rule), - printLine, - pfcPrintf("User added facts:~n", []), - pfcPrintitems(User), - printLine, - pfcPrintf("MettaLog-Pfc added facts:~n", []), - pfcPrintitems(Pfc), - printLine, !. - -%! pfcPrintitems(+List) is det. -% -% Prints a list of items. -% -% This predicate prints each item in the provided `List`. It uses `pretty_numbervars/2` -% to standardize variable names and `portray_clause_w_vars/1` to format and display the items. -% Note that this predicate modifies its arguments during execution, so care should be taken. -% -% @arg List The list of items to print. -% -% @example -% % Print a list of facts: -% ?- pfcPrintitems([fact1, fact2]). -% -pfcPrintitems([]). -pfcPrintitems([H|T]) :- \+ \+ ( pretty_numbervars(H, H1), format(" ", []), portray_clause_w_vars(H1)),pfcPrintitems(T). - -%! pfcClassifyFacts(+Facts, -UserFacts, -PfcFacts, -RuleFacts) is det. -% -% Classifies a list of facts into user-added facts, Pfc-added facts, and rule facts. -% -% This predicate takes a list of `Facts` and classifies them into three categories: -% `UserFacts` (facts added by the user), `PfcFacts` (facts added by the Pfc system), -% and `RuleFacts` (facts that are rules). The classification is based on the type of -% each fact and its associated support structure. -% -% @arg Facts The list of facts to classify. -% @arg UserFacts The list of user-added facts. -% @arg PfcFacts The list of Pfc-added facts. -% @arg RuleFacts The list of rule facts. -% -% @example -% % Classify a list of facts: -% ?- pfcClassifyFacts([fact1, fact2, rule1], User, Pfc, Rule). -% -pfcClassifyFacts([], [], [], []). -pfcClassifyFacts([H|T], User, Pfc, [H|Rule]) :- pfcType(H, rule),!,pfcClassifyFacts(T, User, Pfc, Rule). -pfcClassifyFacts([H|T], [H|User], Pfc, Rule) :- matches_why_UU(UU),pfcGetSupport(H, UU),!,pfcClassifyFacts(T, User, Pfc, Rule). -pfcClassifyFacts([H|T], User, [H|Pfc], Rule) :- pfcClassifyFacts(T, User, Pfc, Rule). - -%! pfcPrintRules is nondet. -% -% Prints all rules in the Pfc database. -% -% This predicate prints all the rules currently defined in the Pfc database. It uses -% `bagof_or_nil/3` to retrieve rules that match different formats (`==>`, `<==>`, and `<-`) -% and then prints them using `pfcPrintitems/1`. Each set of rules is preceded and followed by -% a separator line for formatting purposes. -% -% @example -% % Print all rules in the Pfc database: -% ?- pfcPrintRules. -% -pfcPrintRules :- - printLine, - pfcPrintf("Rules:...~n", []), - bagof_or_nil((P==>Q), clause((P==>Q), true), R1), - pfcPrintitems(R1), - bagof_or_nil((P<==>Q), clause((P<==>Q), true), R2), - pfcPrintitems(R2), - bagof_or_nil((P<-Q), clause((P<-Q), true), R3), - pfcPrintitems(R3), - printLine. - -%! pfcGetTrigger(-Trigger) is nondet. -% -% Retrieves a trigger from the Pfc database. -% -% This predicate retrieves a trigger from the Pfc database using `pfc_call/1`. The trigger -% is nondeterministically returned, meaning multiple triggers can be retrieved through -% backtracking. The retrieved `Trigger` can be any of the types used within the Pfc framework. -% -% @arg Trigger The retrieved trigger from the Pfc database. -% -% @example -% % Retrieve a trigger from the Pfc database: -% ?- pfcGetTrigger(Trigger). -% -pfcGetTrigger(Trigger) :- pfc_call(Trigger). - -%! pfcPrintTriggers is nondet. -% -% Pretty prints all triggers in the Pfc database. -% -% This predicate prints the positive, negative, and goal triggers in the Pfc database. -% Each set of triggers is printed with a heading and followed by the respective triggers -% using `print_db_items/2`. Triggers are categorized as positive (`'$pt$'/2`), negative -% (`'$nt$'/3`), and goal triggers (`'$bt$'/2`). -% -% @example -% % Print all triggers in the Pfc database: -% ?- pfcPrintTriggers. -% -pfcPrintTriggers :- - print_db_items("Positive triggers", '$pt$'(_, _)), - print_db_items("Negative triggers", '$nt$'(_, _, _)), - print_db_items("Goal triggers", '$bt$'(_, _)). - -%! pp_triggers is nondet. -% -% A shorthand predicate to pretty print all triggers in the Pfc database. -% -% This predicate is an alias for `pfcPrintTriggers/0`. It provides a shorter way to invoke -% the trigger printing functionality. -% -% @example -% % Pretty print all triggers using the alias: -% ?- pp_triggers. -% -pp_triggers :- pfcPrintTriggers. - -%! pfcPrintSupports is nondet. -% -% Pretty prints all supports in the Pfc database. -% -% This predicate prints all support relationships in the Pfc database. It retrieves the -% support information using `pfcGetSupport/2` and then pretty-prints the results, filtering -% out predicates based on the conditions defined in `pp_filtered/1`. -% -% @example -% % Print all supports in the Pfc database: -% ?- pfcPrintSupports. -% -pfcPrintSupports :- - % temporary hack. - draw_line, - fmt("Supports ...~n", []), - setof_or_nil((P =< S), (pfcGetSupport(P, S), \+ pp_filtered(P)), L), - pp_items('Support', L), - draw_line, !. - -%! pp_supports is nondet. -% -% Alias for `pfcPrintSupports/0`. -% -% This predicate serves as a shorthand alias for `pfcPrintSupports/0`, which prints all -% support relationships in the Pfc database. -% -pp_supports :- pfcPrintSupports. - -%! pp_filtered(+Predicate) is nondet. -% -% Checks if a predicate should be filtered out from pretty-printing. -% -% This predicate determines whether a given `Predicate` should be filtered out from -% pretty-printing during support or fact displays. It filters out certain system predicates, -% such as those using `pfc_prop/2`. -% -% @arg Predicate The predicate to check. -% -pp_filtered(P) :- var(P), !, fail. -pp_filtered(_:P) :- !, pp_filtered(P). -pp_filtered(P) :- safe_functor(P, F, A), F \== (/), !, pp_filtered(F/A). -pp_filtered(F/_) :- F == pfc_prop. - -%! pfcFact(+Predicate) is nondet. -% -% Checks if a fact was asserted into the database via `pfcAdd/2`. -% -% This predicate checks whether the given `Predicate` was asserted into the Pfc database -% using `pfcAdd/2`. It uses `pfcFact/2` with a default condition of `true`. -% -% @arg Predicate The fact to check. -% -pfcFact(P) :- pfcFact(P, true). - -%! pfcFact(+Predicate, +Condition) is nondet. -% -% Checks if a fact was asserted into the database via `pfcAdd/2` and a condition is satisfied. -% -% This predicate checks whether the given `Predicate` was asserted into the Pfc database -% and whether the provided `Condition` holds. The `Condition` can be any logical check -% on the predicate. -% -% @arg Predicate The fact to check. -% @arg Condition The condition to check. -% -% @example -% % Check if a fact was asserted and a condition is satisfied: -% ?- pfcFact(X, pfcUserFact(X)). -% -pfcFact(F, C) :- - filter_to_pattern_call(F, P, Call), - pfcFact1(P, C), - pfcCallSystem(Call). - -%! pfcFact1(+Predicate, +Condition) is nondet. -% -% Helper predicate for `pfcFact/2`. -% -% This predicate is a helper for `pfcFact/2`. It checks whether the given `Predicate` -% satisfies the `Condition` and whether it is a fact in the Pfc database. -% -% @arg Predicate The fact to check. -% @arg Condition The condition to check. -% -pfcFact1(P, C) :- - pfcGetSupport(P, _), - pfcType(P, fact(_)), - pfcCallSystem(C). -%! pfcFacts(-ListofPfcFacts) is det. -% -% Returns a list of facts added to the Pfc database. -% -% This predicate returns a list of all facts currently in the Pfc database. -% -% @arg ListofPfcFacts The list of facts. -% -pfcFacts(L) :- pfcFacts(_, true, L). -%! pfcFacts(+Pattern, -ListofPfcFacts) is det. -% -% Returns a list of facts added to the Pfc database that match a given pattern. -% -% This predicate returns a list of facts in the Pfc database that match the specified `Pattern`. -% -% @arg Pattern The pattern to match facts against. -% @arg ListofPfcFacts The list of facts. -% -pfcFacts(P, L) :- pfcFacts(P, true, L). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% IMPORTANT: DO NOT DELETE COMMENTED-OUT CODE AS IT MAY BE UN-COMMENTED AND USED +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%! pfcFacts(+Pattern, +Condition, -ListofPfcFacts) is det. -% -% Returns a list of facts added to the Pfc database that match a given pattern and condition. -% -% This predicate returns a list of facts in the Pfc database that match the specified `Pattern` -% and satisfy the `Condition`. -% -% @arg Pattern The pattern to match facts against. -% @arg Condition The condition to filter facts. -% @arg ListofPfcFacts The list of facts. -% -pfcFacts(P, C, L) :- setof_or_nil(P, pfcFact(P, C), L). +/* Output Language Subsectioning -%! brake(+Predicate) is det. -% -% Calls a system predicate and breaks execution. -% -% This predicate calls the specified `Predicate` using `pfcCallSystem/1` and then breaks execution -% by invoking `ibreak/0` (used for debugging). -% -% @arg Predicate The predicate to call before breaking. -% -brake(X) :- pfcCallSystem(X), ibreak. + This module provides functionality for conditional output formatting based on the current logging language. + It allows for dynamic execution and formatting of goals (`Goal`) according to a specified information type (`InfoType`), + adapting the output to match the desired language or format. -%! pfcTraceAdd(+Predicate) is det. -% -% Adds a predicate to the Pfc trace for debugging and monitoring purposes. -% This allows tracing of the given predicate in the Prolog Forward Chaining (Pfc) system. -% -% @arg Predicate The predicate to be added to the trace. -% -% This implementation includes backward compatibility by calling an internal -% version of `pfcTraceAdd/2`, which may eventually be deprecated. -% -% @example Adding a predicate to the trace: -% ?- pfcTraceAdd(my_predicate). -% -pfcTraceAdd(P) :- - % This is here for upward compatibility with older versions. - % Should be removed once no longer needed. - pfcTraceAdd(P, (o, o)). + The module is particularly useful for applications that need to generate outputs in multiple languages or formats, + such as generating documentation, logs, or code in different programming languages or markup languages. -%! pfcTraceAdd(+Trigger, +Support) is det. -% -% Adds a trigger and its support to the Pfc trace for monitoring and debugging purposes. -% This predicate enables tracing of triggers in the Prolog Forward Chaining (Pfc) system -% based on the provided trigger and its support. Certain triggers, such as positive and -% negative triggers, are excluded from tracing. -% -% @arg Trigger The trigger to be traced. Certain internal triggers (`$pt$` and `$nt$`) -% are excluded from the trace. -% @arg Support The support of the trigger, typically providing additional context for -% the trace operation. -% -% @example Tracing a custom trigger: -% ?- pfcTraceAdd(my_trigger, some_support). -% -pfcTraceAdd('$pt$'(_, _), _) :- - % Never trace positive triggers. These are skipped for tracing. - !. -pfcTraceAdd('$nt$'(_, _), _) :- - % Never trace negative triggers. These are skipped for tracing. - !. -pfcTraceAdd(P, S) :- - % Print the trigger and its support to the trace output. - pfcTraceAddPrint(P, S), - % Optionally break into the debugger for detailed inspection. - pfcTraceBreak(P, S). + ### Key Predicate: -%! pfcTraceAddPrint(+Predicate, +Support) is det. -% -% Prints a predicate being added to the Pfc trace if tracing is enabled for the predicate. -% This predicate checks whether tracing is active for the provided predicate and, if so, -% prints the predicate and its support information in a formatted manner. -% -% @arg Predicate The predicate to be printed. If the predicate is being traced, it is printed -% with relevant support information. -% @arg Support The support of the predicate, which can influence how the message is formatted. -% -% @example Printing a traced predicate: -% ?- pfcTraceAddPrint(my_predicate, some_support). -% -pfcTraceAddPrint(P, S) :- - % Check if tracing is enabled for the predicate. - pfcIsTraced(P), - !, - % Create a copy of the predicate with number variables handled. - \+ \+ (pretty_numbervars(P, Pcopy), - % Old code to number variables manually is commented out. - % numbervars(Pcopy,0,_), - % Check if there is a match for unknown reasons (matches_why_UU/1). - matches_why_UU(UU), - % If the support matches, print the predicate with "(u)", otherwise normally. - (S = UU - -> pfcPrintf("Adding (u) ~@", [fmt_cl(Pcopy)]) - ; pfcPrintf("Adding ~@", [fmt_cl(Pcopy)]))). -pfcTraceAddPrint(_, _). % Default case: Do nothing if tracing is not enabled or conditions are not met. - -%! pfcTraceBreak(+Predicate, +Support) is det. -% -% Breaks the execution if the predicate is spied in the Pfc trace. This is used to -% halt the program for inspection when a particular predicate is being traced, allowing -% the user to debug or inspect the state at that point. -% -% @arg Predicate The predicate to check for spying. If the predicate is spied, -% execution breaks. -% @arg Support The support of the predicate, though it is not used in this case. -% -% @example Breaking on a spied predicate: -% ?- pfcTraceBreak(my_predicate, some_support). -% -pfcTraceBreak(P, _S) :- - % If the predicate is spied, proceed with breaking execution. - pfcSpied(P, +) -> - (pretty_numbervars(P, Pcopy), - % Old code to number variables manually is commented out. - % numbervars(Pcopy,0,_), - % Print a message indicating the break and predicate involved. - pfcPrintf("Breaking on pfcAdd(~p)", [Pcopy]), - % Trigger the debugger or break the execution for inspection. - ibreak) - ; true. - -%! pfcTraceRem(+Trigger) is det. -% -% Removes a trigger from the Pfc trace, stopping any further tracing for the given trigger. -% Positive and negative triggers (`$pt$` and `$nt$`) are never traced, and thus are excluded. -% -% @arg Trigger The trigger to remove from tracing. -% -% @example Removing a trigger from the trace: -% ?- pfcTraceRem(my_trigger). -% -pfcTraceRem('$pt$'(_, _)) :- - % Never trace positive triggers. Simply succeed. - !. -pfcTraceRem('$nt$'(_, _)) :- - % Never trace negative triggers. Simply succeed. - !. -pfcTraceRem(P) :- - % Check if the predicate is currently being traced. - (pfcIsTraced(P) - % If traced, print a message indicating it is being removed. - -> pfcPrintf("Removing: ~p.", [P]) - ; true), - % If the predicate is spied, break execution for inspection. - (pfcSpied(P, -) - -> (pfcPrintf("Breaking on pfcRem(~p)", [P]), - ibreak) - ; true). - -%! pfcIsTraced(+Predicate) is nondet. -% -% Checks if a predicate is currently being traced in the Pfc trace. -% -% @arg Predicate The predicate to check. If tracing is active for this predicate, -% the predicate succeeds; otherwise, it fails. -% -% @example Checking if a predicate is traced: -% ?- pfcIsTraced(my_predicate). -% -pfcIsTraced(P) :- - % Check if the predicate is not being traced, and fail if so. - pfcIsNotTraced(P),!, fail. -pfcIsTraced(P) :- - % Check if the first argument of the compound predicate is being traced. - compound_eles(1, P, Arg),pfcTraced(Arg). + - **output_language/2**: + - Usage: `output_language(+InfoType, :Goal) is det.` + - Description: Outputs the specified `Goal` in the language defined by `InfoType`, + formatting the output according to the current log file type. + - See the predicate documentation for more details. -%! pfcIsNotTraced(+Predicate) is nondet. -% -% Checks if a predicate is currently *not* being traced. -% -% @arg Predicate The predicate to check. If it is not being traced, this predicate succeeds. -% -% @example Checking if a predicate is not traced: -% ?- pfcIsNotTraced(my_predicate). -% -pfcIsNotTraced(P) :- - % Check if the first argument of the compound predicate is ignored. - compound_eles(1, P, Arg), pfcIgnored(Arg). + ### Dependencies: -% The pfcIgnored/1 can be modified (asserted or retracted) during runtime. -:- dynamic(pfcIgnored/1). + The module relies on several auxiliary predicates and settings that should be defined elsewhere in your codebase: -%! compound_eles(+Level, +Compound, -Element) is det. -% -% Extracts elements from a compound term by traversing its structure based on the specified level. -% The predicate handles variables, compound terms, and attributes. -% -% @arg Level The level of extraction, determining how deep to traverse the compound term structure. -% @arg Compound The compound term from which elements are extracted. It can also be a variable with attributes. -% @arg Element The element that is extracted from the compound term or variable. -% -% This predicate is used to recursively navigate through compound terms, potentially accessing -% nested structures depending on the specified level. -% -% @example Extracting elements from a compound term: -% ?- compound_eles(1, foo(bar, baz), E). -% E = foo ; -% E = bar ; -% E = baz. -% -% @example Extracting elements from a term at a deeper level: -% ?- compound_eles(2, foo(bar(baz)), E). -% E = baz. -% -compound_eles(Lvl, P, Arg) :- - % If P is a variable, retrieve its attribute and treat it as a compound term. - var(P),!,get_attr(P, A, AV),compound_eles(Lvl, attvar(A, AV), Arg). -compound_eles(Lvl, P, Arg) :- - % If P is not a compound term or the level is less than 1, return P as the result. - (\+ compound(P); Lvl < 1),!,Arg = P. -compound_eles(Lvl, P, Arg) :- - % Decrease the level by 1 and recurse into the substructure of P. - LvlM1 is Lvl - 1,compound_eles(P, E),compound_eles(LvlM1, E, Arg). + - `log_file_type/1`: Retrieves the current log file type or language. + - `enter_markdown/1`: Enters markdown mode for a specific language. + - `leave_markdown/1`: Exits markdown mode for a specific language. + - `enter_comment/0`: Enters comment mode for output. + - `leave_comment/0`: Exits the current comment context. + - `into_blocktype/2`: Processes a goal within a specific block type. + - `in_file_output/1`: Redirects output operations within its scope. + - `must_det_ll/1`: Ensures that enclosed operations are deterministic and properly handled. -%! compound_eles(+Compound, -Element) is det. -% -% Extracts elements from a compound term or list by iterating through the list elements -% or the functor and arguments of a compound term. -% -% @arg Compound The compound term or list to be decomposed. -% @arg Element The extracted element, either a member of the list or the functor/arguments -% of the compound term. -% -% This predicate handles both lists and compound terms. For lists, it returns each member -% of the list, and for compound terms, it returns the functor followed by the arguments. -% -% @example Extracting elements from a list: -% ?- compound_eles([a, b, c], E). -% E = a ; -% E = b ; -% E = c. -% -% @example Extracting the functor and arguments from a compound term: -% ?- compound_eles(foo(bar, baz), E). -% E = foo ; -% E = bar ; -% E = baz. -% -compound_eles(P, E) :- - % If P is a list, extract each element as E. - is_list(P),!,member(E, P). -compound_eles(P, E) :- - % If P is a compound term, extract its functor and arguments. - compound(P),compound_name_arguments(P, F, Args),!,member(E, [F | Args]). + ### Example Usage: -%! mpred_trace_exec is det. -% -% Enables tracing and watching in the Prolog Forward Chaining (Pfc) system. -% This predicate activates both the `pfcWatch` and `pfcTrace` functionalities, -% allowing for detailed observation of rule executions and predicate tracing. -% -% @example Enabling tracing and watching: -% ?- mpred_trace_exec. -% -mpred_trace_exec :- pfcWatch,pfcTrace. + ```prolog + % Output the goal in the current file language + ?- output_language(prolog, format('~q.',[prolog:-code])). + ``` +*/ -%! mpred_notrace_exec is det. -% -% Disables tracing and watching in the Prolog Forward Chaining (Pfc) system. -% This predicate deactivates both `pfcTrace` and `pfcWatch` functionalities, -% stopping the detailed observation of rule executions and predicate tracing. -% -% @example Disabling tracing and watching: -% ?- mpred_notrace_exec. -% -mpred_notrace_exec :- - pfcNoTrace, - pfcNoWatch. +:- dynamic(enabled_use_markdown/0). % Flag indicating if markdown output is enabled +:- dynamic(enabled_use_comments/0). % Flag indicating if comment output is enabled +:- dynamic(enabled_output_lang/1). % Tracks the enabled output languages + +%! enabled_use_markdown is semidet. +% Succeeds if markdown output is enabled based on the 'markdown' option. +enabled_use_markdown :- fast_option_value(markdown, true), !. + +%! enabled_use_comments is semidet. +% Succeeds if comment output is enabled; OFTEN relies on markdown being enabled. +enabled_use_comments :- enabled_use_markdown. + +%! in_file_output(:Goal) is det. +% Executes the provided Goal; can be modified for output redirection. +% when we are wrtting out a markdown or conversion file we like to be inside +% this body in case there is some other sort of redirrection we work arround +% in most cases this should turn off ansi color printing +% EXCEPT when we test log output (because we use ansi2html on _that_ output) +in_file_output(Goal) :- + format('~N'),call(Goal),format('~N'). + +%! into_blocktype(+InfoType, :Goal) is det. +% Enters markdown mode for InfoType and executes Goal. +% Alternative implementations are commented out and may be used if needed. +% into_blocktype(InfoType, Goal) :- +% log_file_type(markdown), !, +% setup_call_cleanup( +% format('~N```~w~n', [InfoType]), +% Goal, +% format('~N```~n', []) +% ). +into_blocktype(InfoType, Goal) :- enter_markdown(InfoType), !, call(Goal). + +%! output_language(+InfoType, :Goal) is det. +% Outputs Goal in the language defined by InfoType, formatting based on current log file type. +% +% If `InfoType` matches the current log file type (`Lang`), it enters markdown mode, +% leaves comment mode if necessary, and executes `Goal`. +% Otherwise, it enters comment mode and processes `Goal` within the specified block type. -%! pfcTrace is det. -% -% Enables global tracing in the Pfc system. This allows for tracking the execution of -% rules and predicates without specifying a particular form. -% -% @example Enabling global tracing: -% ?- pfcTrace. -% -pfcTrace :- - pfcTrace(_). +%output_language( InfoType, Goal ) :- log_file_type(markdown), !, into_blocktype(InfoType,Goal). +%output_language( comment, Goal ) :- log_file_type(markdown), !, call(Goal). +%output_language( comment, Goal ) :- log_file_type(prolog), !, format('~N:- q.~n', [output_language( comment, Goal)]). +%output_language( comment, Goal ) :- log_file_type(metta), !, in_cmt(Goal). +output_language( InfoType, Goal ) :- notrace((output_language_impl( InfoType, Goal ))). +output_language_impl( InfoType, Goal ) :- log_file_type(Lang), !, % (Lang==prolog; Lang==metta),!, + in_file_output(((InfoType == Lang -> (must_det_ll((enter_markdown(Lang),leave_comment)),call(Goal)) ; (must_det_ll(enter_comment),into_blocktype(InfoType,Goal))))). -%! pfcTrace(+Form) is det. -% -% Enables tracing for a specific form in the Pfc system. This allows for targeted -% tracing, where only the specified form will be traced during execution. -% -% @arg Form The form to trace. +%! log_file_type(-Type) is det. +% Determines the current log file type or language based on options. % -% @example Enabling tracing for a specific form: -% ?- pfcTrace(my_form). -% -pfcTrace(Form) :- - assert(pfcTraced(Form)). +% The log file type can be `'prolog'`, `'markdown'`, or `'metta'`. +% It checks various options to decide the type and defaults to `'prolog'` if none match. +log_file_type(X) :- nonvar(X), !, log_file_type(Is), !, Is = X. % If X is instantiated, check if it matches current log file type +log_file_type(prolog) :- fast_option_value(compile, save), !. % If 'compile' option is 'save', type is 'prolog' +log_file_type(markdown) :- fast_option_value(markdown, true), !. % If 'markdown' option is true, type is 'markdown' +log_file_type(metta) :- \+ fast_option_value(compile, save), !. % If 'compile' option is not 'save', type is 'metta' +log_file_type(prolog). % Default type is 'prolog' -%! pfcTrace(+Form, +Condition) is det. -% -% Enables tracing for a specific form under a given condition in the Pfc system. -% This allows for conditional tracing, where the form is only traced if the condition holds true. -% -% @arg Form The form to trace. -% @arg Condition The condition under which the form will be traced. -% -% @example Enabling conditional tracing for a form: -% ?- pfcTrace(my_form, my_condition). -% -pfcTrace(Form, Condition) :- - assert((pfcTraced(Form) :- Condition)). +:- dynamic(inside_comment/0). % Tracks if currently inside a comment -%! pfcSpy(+Form) is det. -% -% Adds a form to the Pfc spy list, allowing the form to be monitored during execution. -% By default, the form is spied with both the addition (`+`) and removal (`-`) modes. -% -% @arg Form The form to spy on. -% -% @example Spying on a form: -% ?- pfcSpy(my_form). +%! leave_comment is det. +% Exits comment mode if inside a comment. % -pfcSpy(Form) :- - pfcSpy(Form, [+,-], true). +% If comments are not enabled (`enabled_use_comments` fails), it does nothing. +% If currently inside a comment, it outputs the comment closing syntax and retracts the flag. +leave_comment :- \+ enabled_use_comments, !. % If comments are not enabled, do nothing +leave_comment :- inside_comment, !, format('~N*/~n~n'), retract(inside_comment). % If inside comment, output '*/', retract flag +leave_comment. % If not inside comment, do nothing -%! pfcSpy(+Form, +Modes) is det. +%! enter_comment is det. +% Enters comment mode for output. % -% Adds a form to the Pfc spy list with specific modes. The modes determine whether -% to spy on the form during addition (`+`), removal (`-`), or both. -% -% @arg Form The form to spy on. -% @arg Modes The modes to use for spying, e.g., `+` for addition or `-` for removal. -% -% @example Spying on a form with specific modes: -% ?- pfcSpy(my_form, [+]). -% -pfcSpy(Form, Modes) :- - pfcSpy(Form, Modes, true). +% If comments are not enabled, it does nothing. +% If not already inside a comment, it outputs the comment opening syntax and sets the flag. +enter_comment :- \+ enabled_use_comments, !. % If comments are not enabled, do nothing +enter_comment :- inside_comment, !. % If already inside comment, do nothing +enter_comment :- format('~N~n/*~n'), assert(inside_comment). % Output '/*', set inside_comment flag -%! pfcSpy(+Form, +Modes, +Condition) is det. -% -% Adds a form to the Pfc spy list with specific modes and a condition. The form -% will only be spied upon if the specified condition holds true, providing fine-grained -% control over when to spy on the form. -% -% @arg Form The form to spy on. -% @arg Modes The modes to use for spying, e.g., `+`, `-`. -% @arg Condition The condition under which to spy on the form. -% -% @example Spying on a form with modes and a condition: -% ?- pfcSpy(my_form, [+], my_condition). -% -pfcSpy(Form, [H|T], Condition) :- - % Recursively process each mode in the list. - !, - pfcSpy1(Form, H, Condition), - pfcSpy(Form, T, Condition). +:- enter_comment. % Start by entering comment mode at the beginning -pfcSpy(Form, Mode, Condition) :- - % Process the single mode for the form. - pfcSpy1(Form, Mode, Condition). +:- dynamic(inside_markdown/1). % Tracks the current markdown language mode -%! pfcSpy1(+Form, +Mode, +Condition) is det. +%! leave_markdown(+Lang) is det. +% Exits markdown mode for Lang if inside it. % -% Helper predicate for `pfcSpy/3`. It asserts that the form is spied with the -% given mode and condition, adding the spy rule to the Pfc system. -% -% @arg Form The form to spy on. -% @arg Mode The mode to use for spying, e.g., `+` or `-`. -% @arg Condition The condition under which to spy on the form. -% -pfcSpy1(Form, Mode, Condition) :- - assert((pfcSpied(Form, Mode) :- Condition)). +% If markdown is not enabled, or not inside any markdown mode, it does nothing. +% If inside markdown mode for `Lang`, it outputs the markdown code block closing syntax and retracts the flag. +leave_markdown(_) :- \+ enabled_use_markdown, !. % If markdown not enabled, do nothing +leave_markdown(_) :- \+ inside_markdown(_), !. % If not inside any markdown, do nothing +leave_markdown(Lang) :- inside_markdown(Lang), !, format('~N```~n'), retract(inside_markdown(Lang)). % If inside Lang markdown, output '```', retract flag +leave_markdown(_Lang) :- !. % Do nothing otherwise -%! pfcNospy is det. -% -% Removes all forms from the Pfc spy list. This predicate clears all spy points -% that have been set, stopping any further spying on forms. -% -% @example Removing all spy points: -% ?- pfcNospy. +%! enter_markdown(+Lang) is det. +% Enters markdown mode for Lang. % -pfcNospy :- - pfcNospy(_,_,_). +% If markdown is not enabled, it does nothing. +% If already inside markdown mode for `Lang`, it does nothing. +% If inside markdown mode for a different language, it leaves that mode first. +% It outputs the markdown code block opening syntax with the language specifier and sets the flag. +enter_markdown(_) :- \+ enabled_use_markdown, !. % If markdown not enabled, do nothing +enter_markdown(Lang) :- inside_markdown(Lang), !. % If already inside Lang markdown, do nothing +enter_markdown(Lang) :- inside_markdown(Other), !, leave_markdown(Other), !, enter_markdown(Lang). % If inside other markdown, leave it, enter Lang markdown +enter_markdown(Lang) :- log_file_type(Us), Us = Lang, inside_comment, !, % If current log file type is Lang and inside comment + format('~N```~w~n', [Lang]), asserta(inside_markdown(Lang)), leave_comment. % Output '```Lang', set flag, leave comment +enter_markdown(Lang) :- format('~N```~w~n', [Lang]), asserta(inside_markdown(Lang)). % Output '```Lang', set flag -%! pfcNospy(+Form) is det. +%! pick_quote(+String, -Quote) is det. +% Selects a quote character not present in String. % -% Removes a specific form from the Pfc spy list, effectively stopping spying -% on the given form. -% -% @arg Form The form to remove from the spy list. -% -% @example Removing a specific form from the spy list: -% ?- pfcNospy(my_form). -% -pfcNospy(Form) :- - pfcNospy(Form,_,_). +% It tries `"`, `'`, and `` ` `` in order and selects the first one not found in `String`. +pick_quote(String, '"') :- \+ string_contains(String, '"'), !. % Use '"' if not in String +pick_quote(String, '\'') :- \+ string_contains(String, '\''), !. % Use '\'' if not in String +pick_quote(String, '`') :- \+ string_contains(String, '`'), !. % Use '`' if not in String -%! pfcNospy(+Form, +Mode, +Condition) is det. -% -% Removes a specific form from the Pfc spy list, considering the given mode and condition. -% This predicate erases the spy points that match the provided form, mode, and condition. -% -% @arg Form The form to remove from the spy list. -% @arg Mode The mode to remove (`+`, `-`, or both). -% @arg Condition The condition under which the form was being spied. -% -% @example Removing a form with a specific mode and condition: -% ?- pfcNospy(my_form, +, my_condition). -% -pfcNospy(Form, Mode, Condition) :- - % Find and erase the matching spy clause. - clause(pfcSpied(Form, Mode), Condition, Ref), - erase(Ref), - fail. +:- at_halt(in_file_output(leave_markdown(_))). % Ensure markdown mode is exited at halt +:- at_halt(in_file_output(leave_comment)). % Ensure comment mode is exited at halt -% Ensure pfcNospy succeeds even when no more spy points exist. -pfcNospy(_,_,_). -%! pfcNoTrace is det. -% -% Disables all tracing in the Pfc system. This stops any tracing that was -% previously enabled for forms. -% -% @example Disabling all tracing: -% ?- pfcNoTrace. -% -pfcNoTrace :- pfcUntrace. - -%! pfcUntrace is det. -% -% Untraces all forms in the Pfc system, removing any trace points that were set. -% -% @example Untracing all forms: -% ?- pfcUntrace. -% -pfcUntrace :- pfcUntrace(_). - -%! pfcUntrace(+Form) is det. -% -% Untraces a specific form in the Pfc system, stopping any further tracing for that form. -% -% @arg Form The form to untrace. -% -% @example Untracing a specific form: -% ?- pfcUntrace(my_form). -% -pfcUntrace(Form) :- retractall(pfcTraced(Form)). - -%! pfcTraceMsg(+Message) is det. -% -% Traces a message in the Pfc system. This is used to output debug or trace messages. -% By default, it traces a single message without any additional arguments. -% -% @arg Message The message to trace. -% -% @example Tracing a simple message: -% ?- pfcTraceMsg('This is a trace message'). -% -pfcTraceMsg(Msg) :- - pfcTraceMsg('~p', [Msg]). - -%! pfcTraceMsg(+Message, +Arguments) is det. -% -% Traces a formatted message with arguments in the Pfc system. The message is output -% if tracing is enabled or if any of the arguments is traced. -% -% @arg Message The formatted message to trace. -% @arg Arguments The arguments to include in the message. -% -% @example Tracing a message with arguments: -% ?- pfcTraceMsg('Tracing predicate ~p with arg ~p', [my_pred, my_arg]). -% -pfcTraceMsg(Msg, Args) :- - % If tracing is enabled, print the message with the given arguments. - pfcTraceExecution, - !, - pfcPrintf(user_output, Msg, Args). -pfcTraceMsg(Msg, Args) :- - % If any argument is traced, print the message. - member(P, Args), pfcIsTraced(P), - !, - pfcPrintf(user_output, Msg, Args). -pfcTraceMsg(_, _). - -%! pfcPrintf(+Message, +Arguments) is det. -% -% Prints a formatted message to the default output in the Pfc system. -% -% @arg Message The formatted message to print. -% @arg Arguments The arguments for the message. -% -% @example Printing a formatted message: -% ?- pfcPrintf('Outputting ~p', [my_value]). -% -pfcPrintf(Msg, Args) :- pfcPrintf(user_output, Msg, Args). - -%! pfcPrintf(+Where, +Message, +Arguments) is det. -% -% Prints a formatted message to a specified output location in the Pfc system. -% -% @arg Where The output location (e.g., `user_output`). -% @arg Message The formatted message to print. -% @arg Arguments The arguments for the message. -% -% @example Printing a message to user_output: -% ?- pfcPrintf(user_output, 'Message: ~p', [my_message]). -% -pfcPrintf(Where, Msg, Args) :- - % Ensure the output is formatted with a newline. - format(Where, '~N', []),with_output_to(Where, color_g_mesg_ok(blue, format(Msg, Args))). - -%! pfcWatch is det. -% -% Enables execution tracing in the Pfc system. This will trace the execution -% of rules and predicates in the system. -% -% @example Enabling execution tracing: -% ?- pfcWatch. -% -pfcWatch :- clause(pfcTraceExecution, true),!. -pfcWatch :- assert(pfcTraceExecution). - -%! pfcNoWatch is det. -% -% Disables execution tracing in the Pfc system. This stops tracing of rule -% and predicate execution. -% -% @example Disabling execution tracing: -% ?- pfcNoWatch. -% -pfcNoWatch :- retractall(pfcTraceExecution). - -%! pfcError(+Message) is det. -% -% Prints an error message in the Pfc system. -% -% @arg Message The error message to print. -% -% @example Printing a simple error message: -% ?- pfcError('An error occurred'). -% -pfcError(Msg) :- pfcError(Msg, []). - -%! pfcError(+Message, +Arguments) is det. -% -% Prints a formatted error message with arguments in the Pfc system. -% -% @arg Message The formatted error message. -% @arg Arguments The arguments to include in the message. -% -% @example Printing an error message with arguments: -% ?- pfcError('Error with predicate ~p', [my_predicate]). -% -pfcError(Msg, Args) :- format("~N~nERROR/Pfc: ", []),format(Msg, Args). - -% % -% % These control whether or not warnings are printed at all. -% % pfcWarn. -% % nopfcWarn. -% % -% % These print a warning message if the flag pfcWarnings is set. -% % pfcWarn(+Message) -% % pfcWarn(+Message,+ListOfArguments) -% % - -%! pfcWarn is det. -% -% Enables warning messages in the Pfc system. This predicate sets a flag that allows -% warning messages to be printed during execution. -% -% @example Enabling warning messages: -% ?- pfcWarn. -% -pfcWarn :- retractall(pfcWarnings(_)),assert(pfcWarnings(true)). - -%! nopfcWarn is det. -% -% Disables warning messages in the Pfc system. This predicate sets a flag that prevents -% warning messages from being printed during execution. -% -% @example Disabling warning messages: -% ?- nopfcWarn. -% -nopfcWarn :- retractall(pfcWarnings(_)),assert(pfcWarnings(false)). - -%! pfcWarn(+Message) is det. -% -% Prints a warning message in the Pfc system. This is used to output a simple warning message. -% -% @arg Message The warning message to print. -% -% @example Printing a warning message: -% ?- pfcWarn('This is a warning'). -% -pfcWarn(Msg) :- pfcWarn('~p', [Msg]). - -%! pfcWarn(+Message, +Arguments) is det. -% -% Prints a formatted warning message with arguments in the Pfc system. The message will only -% be printed if warning messages are enabled. -% -% @arg Message The formatted warning message to print. -% @arg Arguments The arguments to include in the message. -% -% @example Printing a warning message with arguments: -% ?- pfcWarn('Warning for predicate ~p', [my_predicate]). -% -pfcWarn(Msg, Args) :- - % If warnings are enabled, print the warning message. - pfcWarnings(true), - !, - ansi_format([underline, fg(red)], "~N==============WARNING/Pfc================~n", []), - ansi_format([fg(yellow)], Msg, Args), - printLine. -pfcWarn(_, _). - -%! pfcWarnings is det. -% -% Enables warning messages in the Pfc system by setting the internal flag. -% This flag causes all Pfc warning messages to be printed. -% -% @example Enabling warnings: -% ?- pfcWarnings. -% -pfcWarnings :- retractall(pfcWarnings(_)),assert(pfcWarnings(true)). - -%! pfcNoWarnings is det. -% -% Disables warning messages in the Pfc system by clearing the internal flag. -% This flag stops Pfc warning messages from being printed. -% -% @example Disabling warnings: -% ?- pfcNoWarnings. -% -pfcNoWarnings :- retractall(pfcWarnings(_)). - -%! pp_facts is nondet. -% -% Pretty prints all facts in the Pfc database. This predicate outputs a formatted list -% of all facts currently stored in the Pfc database. -% -% @example Pretty printing all facts: -% ?- pp_facts. -% -pp_facts :- pp_facts(_, true). - -%! pp_facts(+Pattern) is nondet. -% -% Pretty prints facts in the Pfc database that match a given pattern. Only facts that -% match the specified pattern are printed. -% -% @arg Pattern The pattern to match facts against. -% -% @example Pretty printing facts that match a pattern: -% ?- pp_facts(my_pattern). -% -pp_facts(Pattern) :- pp_facts(Pattern, true). - -%! pp_facts(+Pattern, +Condition) is nondet. -% -% Pretty prints facts in the Pfc database that match a given pattern and condition. -% The facts are categorized into user-added facts and system (MettaLog-Pfc) added facts -% before being printed. -% -% @arg Pattern The pattern to match facts against. -% @arg Condition The condition used to filter facts. -% -% @example Pretty printing facts matching a pattern and condition: -% ?- pp_facts(my_pattern, my_condition). -% -pp_facts(P, C) :- - % Retrieve the list of facts that match the pattern and condition. - pfcFacts(P, C, L), - % Classify the facts into user-added and Pfc-added categories. - pfc_classify_facts(L, User, Pfc, _Rule), - % Draw a line and print user-added facts. - draw_line, - fmt("User added facts:", []), - pp_items(user, User), - % Draw a separator line. - draw_line, - draw_line, - % Print system-added (MettaLog-Pfc) facts. - fmt("MettaLog-Pfc added facts:", []), - pp_items(system, Pfc), - % Final line to close the output. - draw_line. - -%! pp_deds is nondet. -% -% Pretty prints all deduced facts in the Pfc database. Deduced facts are those -% generated by the system (MettaLog-Pfc) during reasoning. -% -% @example Pretty printing all deduced facts: -% ?- pp_deds. -% -pp_deds :- - pp_deds(_, true). - -%! pp_deds(+Pattern) is nondet. -% -% Pretty prints deduced facts in the Pfc database that match a given pattern. -% This predicate filters the deduced facts based on the specified pattern. -% -% @arg Pattern The pattern to match deduced facts against. -% -% @example Pretty printing deduced facts matching a pattern: -% ?- pp_deds(my_pattern). -% -pp_deds(Pattern) :- pp_deds(Pattern, true). - -%! pp_deds(+Pattern, +Condition) is nondet. -% -% Pretty prints deduced facts in the Pfc database that match a given pattern and condition. -% The facts are filtered by both the pattern and the condition before being printed. -% -% @arg Pattern The pattern to match deduced facts against. -% @arg Condition The condition to filter deduced facts. -% -% @example Pretty printing deduced facts with a pattern and condition: -% ?- pp_deds(my_pattern, my_condition). -% -pp_deds(P, C) :- - % Retrieve the list of deduced facts that match the pattern and condition. - pfcFacts(P, C, L), - % Classify the facts, extracting only the Pfc (deduced) facts. - pfc_classify_facts(L, _User, Pfc, _Rule), - % Draw a line and print system-added deduced facts. - draw_line,fmt("MettaLog-Pfc added facts:", []),pp_items(system, Pfc),draw_line. - -%! show_deds_w(+Pattern) is nondet. -% -% Shows deduced facts in the Pfc database that match a given pattern. This predicate -% is a wrapper for `pp_deds/2`, focused on displaying deduced facts. -% -% @arg Pattern The pattern to match deduced facts against. -% -% @example Showing deduced facts that match a pattern: -% ?- show_deds_w(my_pattern). -% -show_deds_w(F) :- pp_deds(F). - -%! show_info(+Pattern) is nondet. -% -% Shows information about facts in the Pfc database that match a given pattern. -% This predicate retrieves facts that match the specified pattern and classifies -% them into user-added and system-added (MettaLog-Pfc) facts before displaying them. -% -% @arg Pattern The pattern to match facts against. -% -% @example Showing information about facts matching a pattern: -% ?- show_info(my_pattern). -% -show_info(F) :- - % Retrieve all facts in the Pfc database. - pfcFacts(_, true, L), - % Filter the facts that match the given pattern. - include(sub_functor(F), L, FL), - % Classify the filtered facts into user-added and system-added (Pfc) facts. - pfc_classify_facts(FL, User, Pfc, _Rule), - % Draw a line and print user-added facts that match the pattern. - draw_line, fmt("User added facts with ~q:", [F]), pp_items(user, User), - % Draw separator lines and print system-added (Pfc) facts that match the pattern. - draw_line, draw_line, fmt("MettaLog-Pfc added facts with ~q:", [F]), pp_items(system, Pfc), - % Final line to close the output. - draw_line. - -%! maybe_filter_to_pattern_call(+Pattern, +Predicate, -Condition) is det. -% -% Converts a pattern and a predicate into a condition for filtering. This predicate creates -% a condition based on the pattern and predicate provided, which can then be used to filter -% facts or other data. -% -% @arg Pattern The pattern used for filtering. -% @arg Predicate The predicate to apply the filtering to. -% @arg Condition The resulting condition used for filtering. -% -% @example Filtering based on a pattern: -% ?- maybe_filter_to_pattern_call(my_pattern, my_predicate, Condition). -% -maybe_filter_to_pattern_call(F, _, true) :- var(F), !, fail. -maybe_filter_to_pattern_call(F, P, true) :- atom(F), !, (P = F ; freeze(P, (P \== F, sub_functor(F, P)))). -maybe_filter_to_pattern_call(F, P, true) :- \+ compound(F), !, P = _ ; freeze(P, (P \== F, sub_functor(F, P))). -maybe_filter_to_pattern_call(F/A, P, true) :- !, freeze(P, (P \== F, sub_functor(F/A, P))). -% maybe_filter_to_pattern_call(F, P, true) :- P = F. - -%! filter_to_pattern_call(+Pattern, +Predicate, -Condition) is det. -% -% Converts a pattern and a predicate into a condition for filtering, with alternative handling -% if the primary method fails. This predicate first attempts to apply `maybe_filter_to_pattern_call/3` -% and, if it fails, it falls back to `alt_filter_to_pattern_call/3`. -% -% @arg Pattern The pattern to filter. -% @arg Predicate The predicate to filter. -% @arg Condition The resulting condition used for filtering. -% -% @example Filtering with fallback: -% ?- filter_to_pattern_call(my_pattern, my_predicate, Condition). -% -filter_to_pattern_call(F, P, Call) :- maybe_filter_to_pattern_call(F, P, Call) *-> true; alt_filter_to_pattern_call(F, P, Call). - -%! alt_filter_to_pattern_call(+Pattern, +Predicate, -Condition) is det. -% -% Alternative handling for `filter_to_pattern_call/3` in case the primary method fails. -% It simply checks if the pattern and predicate are the same. -% -% @arg Pattern The pattern to filter. -% @arg Predicate The predicate to filter. -% @arg Condition The resulting condition. -% -% @example Alternative filtering: -% ?- alt_filter_to_pattern_call(my_pattern, my_predicate, Condition). -% -alt_filter_to_pattern_call(P, P, true). - -%! sub_functor(+Functor, +Term) is nondet. -% -% Checks if a term contains a specific functor. This predicate searches through the term -% to determine if it contains the functor or a similar term with the specified arity. -% -% @arg Functor The functor to check for. -% @arg Term The term to check. -% -% @example Checking if a term contains a functor: -% ?- sub_functor(my_functor/2, my_term). -% -sub_functor(F-UnF, Term) :- !, sub_functor(F, Term), \+ sub_functor(UnF, Term). -sub_functor(F, Term) :- var(F), !, sub_var(F, Term), !. -sub_functor(F/A, Term) :- !, sub_term(E, Term), compound(E), compound_name_arity(E, F, A). -sub_functor(F, Term) :- sub_term(E, Term), E =@= F, !. -sub_functor(F, Term) :- sub_term(E, Term), compound(E), compound_name_arity(E, FF, AA), (AA == F ; FF == F). - -%! pp_items(+Type, +Items) is nondet. -% -% Pretty prints a list of items. Each item in the list is printed according to its type. -% -% @arg Type The type of items (e.g., `user`, `system`) which affects how they are printed. -% @arg Items The list of items to print. -% -% @example Pretty printing a list of items: -% ?- pp_items(user, [item1, item2]). -% -pp_items(_Type, []) :- !. -pp_items(Type, [H|T]) :- ignore(pp_item(Type, H)), !, pp_items(Type, T). -pp_items(Type, H) :- ignore(pp_item(Type, H)). - -% Declares `print_mode/1` as a thread-local predicate, meaning each thread can have its -% own value for `print_mode/1`. This is useful in multithreaded environments where -% different threads may need different printing modes without affecting each other. -:- thread_local t_l:print_mode/1. - -%! pp_item(+Mode, +Item) is nondet. -% -% Pretty prints a single item based on the given printing mode. It handles various types of items, -% including rules, triggers, and facts, and applies specific formatting rules depending on the mode. -% -% @arg Mode The mode for printing (e.g., `user`, `system`, or custom modes like `html`). -% @arg Item The item to print, which can be a fact, rule, or other data structure. -% -% @example Pretty printing a fact: -% ?- pp_item(user, my_fact). -% -pp_item(_M, H) :- pp_filtered(H), !. -pp_item(MM, (H :- B)) :- B == true, pp_item(MM, H). -pp_item(MM, H) :- flag(show_asserions_offered, X, X+1), find_and_call(get_print_mode(html)), (\+ \+ if_defined(pp_item_html(MM, H))), !. -pp_item(MM, '$spft$'(W0, U, ax)) :- W = (_KB:W0), !, pp_item(MM, U:W). -pp_item(MM, '$spft$'(W0, F, U)) :- W = (_KB:W0), atom(U), !, fmt('~N%~n', []), pp_item(MM, U:W), fmt('rule: ~p~n~n', [F]), !. -pp_item(MM, '$spft$'(W0, F, U)) :- W = (_KB:W0), !, fmt('~w~nd: ~p~nformat: ~p~n', [MM, W, F]), pp_item(MM, U). -pp_item(MM, '$nt$'(Trigger0, Test, Body)) :- Trigger = (_KB:Trigger0), !, fmt('~w n-trigger(-): ~p~ntest: ~p~nbody: ~p~n', [MM, Trigger, Test, Body]). -pp_item(MM, '$pt$'(F0, Body)) :- F = (_KB:F0), !, fmt('~w p-trigger(+):~n', [MM]), pp_item('', (F:-Body)). -pp_item(MM, '$bt$'(F0, Body)) :- F = (_KB:F0), !, fmt('~w b-trigger(?):~n', [MM]), pp_item('', (F:-Body)). -pp_item(MM, U:W) :- !, format(string(S), '~w ~w:', [MM, U]), !, pp_item(S, W). -pp_item(MM, H) :- \+ \+ (get_clause_vars_for_print(H, HH), fmt("~w ~p~N", [MM, HH])). - -%! get_clause_vars_for_print(+Clause, -ClauseWithVars) is det. -% -% Prepares a clause for printing by handling variables. If the clause contains variables, -% it generates a copy of the clause with variables properly numbered for readability. -% Ground clauses are returned unchanged. -% -% @arg Clause The clause to prepare for printing. -% @arg ClauseWithVars The clause with variables prepared for printing. -% -% @example Preparing a clause for printing: -% ?- get_clause_vars_for_print(my_clause(X, Y), ClauseWithVars). -% -get_clause_vars_for_print(HB, HB) :- ground(HB), !. -get_clause_vars_for_print(I, I) :- is_listing_hidden(skipVarnames), fail. -get_clause_vars_for_print(H0, MHB) :- get_clause_vars_copy(H0, MHB), H0 \=@= MHB, !. -get_clause_vars_for_print(HB, HB) :- numbervars(HB, 0, _, [singletons(true), attvars(skip)]), !. - -%! pfc_classify_facts(+Facts, -UserFacts, -PfcFacts, -Rules) is det. -% -% Classifies a list of facts into user-added facts, system (Pfc) deductions, and rules. -% This is used to differentiate between facts added directly by the user, those inferred -% by the Pfc system, and rules. -% -% @arg Facts The list of facts to classify. -% @arg UserFacts The list of facts added by the user. -% @arg PfcFacts The list of facts deduced by the system. -% @arg Rules The list of classified rules. -% -% @example Classifying facts: -% ?- pfc_classify_facts([fact1, fact2, rule1], UserFacts, PfcFacts, Rules). -% -pfc_classify_facts([],[],[],[]). -pfc_classify_facts([H|T],User,Pfc,[H|Rule]) :- pfcType(H,rule), !,pfc_classify_facts(T,User,Pfc,Rule). -pfc_classify_facts([H|T],[H|User],Pfc,Rule) :- pfcGetSupport(H,(mfl4(_VarNameZ,_,_,_),ax)), !, - pfc_classify_facts(T,User,Pfc,Rule). -pfc_classify_facts([H|T],User,[H|Pfc],Rule) :- pfc_classify_facts(T,User,Pfc,Rule). - -%= - -%! print_db_items(+T, +I) is nondet. -% -% Prints database items with a given title or label. This predicate is used to format and -% display items from the database, surrounded by separator lines for clarity. -% -% @arg T The title or label for the items being printed. -% @arg I The items or goals to be printed. -% -% @example Printing database items: -% ?- print_db_items('Facts', [fact1, fact2, fact3]). -% -print_db_items(T, I):- - draw_line, % Draw a separator line before printing. - fmt("~N~w ...~n", [T]), % Print the title. - print_db_items(I), % Print the database items. - draw_line, % Draw a separator line after printing. - !. - - -%= - -%! print_db_items(+I) is nondet. -% -% Prints database items based on the provided predicate or item. This predicate checks if -% the input is a valid functor/arity pair or a specific clause and prints matching database -% entries accordingly. -% -% @arg I The predicate or item to be printed. -% -% @example Printing all clauses for a predicate: -% ?- print_db_items(my_predicate/2). -% -print_db_items(F/A):- - number(A),!, % Check if A is a number, ensuring F/A is a valid functor/arity pair. - safe_functor(P,F,A),!, % Safely create a functor from F and A. - print_db_items(P). % Print the functor. -print_db_items(H):- - bagof(H, clause(H,true), R1), % Collect all clauses matching H into a list R1. - pp_items((':'), R1), % Pretty print the collected items. - R1 \== [], !. % Succeed if the list is non-empty. -print_db_items(H):- - \+ current_predicate(_,H),!. % Succeed if H is not a current predicate. -print_db_items(H):- - catch(('$find_predicate'(H,_), call_u(listing(H))), _, true),!, % Try to list the predicate, catching any errors. - nl, nl. % Print two newlines after listing. - -%= - -%! pp_rules is nondet. -% -% Pretty prints various types of rules and facts from the database. This predicate organizes -% and prints different rule types (forward, bidirectional, implication, etc.) along with -% facts (positive and negative). -% -% @example Pretty printing rules and facts: -% ?- pp_rules. -% -pp_rules :- - print_db_items("Forward Rules",(_ ==> _)), % Print forward rules. - print_db_items("Bidirectional Rules",(_ <==> _)), % Print bidirectional rules. - print_db_items("Implication Rules",=>(_ , _)), % Print implication rules. - print_db_items("Bi-conditional Rules",<=>(_ , _)), % Print bi-conditional rules. - print_db_items("Backchaining Rules",(_ <- _)), % Print backchaining rules. - print_db_items("Positive Facts",(==>(_))), % Print positive facts. - print_db_items("Negative Facts",(~(_))). % Print negative facts. - -%= - -%! draw_line is nondet. -% -% Draws a line separator in the console output. This predicate is useful for -% visually separating different sections of printed information. It only -% operates in the main thread. -% -% @example Drawing a line separator: -% ?- draw_line. -% -draw_line:- - \+ thread_self_main,!. % Do nothing if not in the main thread. -draw_line:- printLine,!. % Attempt to use printLine to draw a line. -draw_line:- - (t_l:print_mode(H)->true;H=unknown), % Get the current print mode or set to unknown. - fmt("~N% % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % %~n",[]), % Draw the line using format. - H=H. - -:- meta_predicate loop_check_just(0). - -%= - -%! loop_check_just(:GoalG) is nondet. -% -% Performs a loop check for a given goal in the context of justifications. -% This is used to prevent infinite loops in recursive reasoning or backtracking. -% -% @arg GoalG The goal to check for loops. -% -% @example Checking a goal for loops: -% ?- loop_check_just(my_goal). -% -loop_check_just(G):- - loop_check(G, ignore(arg(1, G, []))). % Perform loop check, ignoring goals with an empty first argument. - -%= - -%! show_pred_info(?PI) is nondet. -% -% Shows information about a predicate. This includes displaying instances where the functor -% is a certain type and additional information if the predicate is not imported from another module. -% -% @arg PI The predicate indicator (F/A) for which information is to be shown. -% -% @example Showing information about a predicate: -% ?- show_pred_info(my_predicate/2). -% -show_pred_info(PI):- - (( - pi_to_head_l(PI,Head), % Convert predicate indicator to head. - % doall(show_call(why,call_u(isa(Head,_)))), - safe_functor(Head,F,_), % Extract the functor from the head. - doall(show_call(why,call_u(isa(F,_)))), % Show all instances where F is a certain type. - ((current_predicate(_,M:Head), (\+ predicate_property(M:Head,imported_from(_)))) - -> show_pred_info_0(M:Head); % Show predicate info if not imported. - wdmsg_pretty(cannot_show_pred_info(Head))))),!. % Display a message if unable to show info. - -%= - -%! show_pred_info_0(?Head) is nondet. -% -% Primary helper for displaying information about a predicate. This predicate shows all properties -% of the predicate and lists its clauses or a general listing if clauses exist. -% -% @arg Head The head of the predicate for which information is to be shown. -% -% @example Showing detailed information for a predicate: -% ?- show_pred_info_0(my_predicate). -% -show_pred_info_0(Head):- - doall(show_call(why, predicate_property(Head, _))), % Show all properties of the predicate. - (has_cl(Head) -> doall((show_call(why, clause(Head, _)))) ; quietly((listing(Head)))), !. % List predicate clauses or show listing. - -% =================================================== -% Pretty Print Formula -% =================================================== - -%= - -%! print_db_items(?Title, ?Mask, ?What) is nondet. -% -% Prints database items matching a given mask or pattern, along with a title. This predicate -% handles the organization and printing of matched database entries under the specified title. -% -% @arg Title The title to be printed, describing the type of items being displayed. -% @arg Mask The mask or pattern used to filter the items. -% @arg What The items to be printed. -% -% @example Printing database items: -% ?- print_db_items('Rules', _ ==> _, _). -% -print_db_items(Title, Mask, What):- - print_db_items(Title, Mask, Mask, What). % Print items with the given title, mask, and what parameters. - -%= - - -%! print_db_items(+Title, +Mask, +Show, +What) is nondet. -% -% Prints database items based on a mask, show predicate, and a condition. This predicate filters -% items matching the mask and the given condition, then applies the show predicate to print them -% under the specified title. -% -% @arg Title The title describing the items to be printed. -% @arg Mask The mask used to filter items (predicate pattern). -% @arg Show The show predicate that determines how the items are displayed. -% @arg What The condition to filter items. -% -% @example Printing database items based on a mask and condition: -% ?- print_db_items('Rules', _ ==> _, pp_item, _). -% -print_db_items(Title, Mask, Show, What0) :- - get_pi(Mask, H), get_pi(What0, What), - format(atom(Showing), '~p for ~p...', [Title, What]), - statistics(cputime, Now), Max is Now + 2, !, - gripe_time(1.0, - doall((once(statistics(cputime, NewNow)), NewNow < Max, clause_or_call(H, B), - quietly(pfc_contains_term(What, (H:-B))), - flag(print_db_items, LI, LI+1), - ignore(quietly(pp_item(Showing, Show)))))), - ignore(pp_item(Showing, done)), !. - -%! pfc_contains_term(+Term, +Inside) is nondet. -% -% Checks if a term contains another term. This is used to determine if a specific term -% is part of a larger structure within another term. -% -% @arg Term The term to check. -% @arg Inside The term to look for inside the main term. -% -pfc_contains_term(What, _) :- is_ftVar(What), !. -pfc_contains_term(What, Inside) :- compound(What), !, (\+ \+ ((copy_term_nat(Inside, Inside0), snumbervars(Inside0), occurs:contains_term(What, Inside0)))), !. -pfc_contains_term(What, Inside) :- (\+ \+ once((subst(Inside, What, foundZadooksy, Diff), Diff \=@= Inside ))), !. - -%! hook_pfc_listing(+What) is nondet. -% -% Hook for Pfc listing. This hook allows for custom listing of items based on the condition `What`. -% -% @arg What The condition used to filter items for listing. -% -:- current_prolog_flag(pfc_shared_module, BaseKB), - assert_if_new((BaseKB:hook_pfc_listing(What) :- on_x_debug(pfc_list_triggers(What)))). - -% Declares `pfc_list_triggers_disabled/0` as a thread-local predicate, meaning that -% each thread can have its own instance of this predicate. This is useful in -% multithreaded environments where enabling or disabling trigger listing can be -% controlled independently for each thread. -:- thread_local t_l:pfc_list_triggers_disabled/0. - -% listing(L):-locally(t_l:pfc_list_triggers_disabled,listing(L)). - -%! pfc_list_triggers(+What) is nondet. -% -% Lists triggers in the Pfc database that match a given condition. If the predicate -% `pfc_list_triggers_disabled/0` is set, listing is skipped for that thread. -% -% @arg What The condition used to filter triggers. -% -% @example Listing triggers based on a condition: -% ?- pfc_list_triggers(my_condition). -% -pfc_list_triggers(_) :- t_l:pfc_list_triggers_disabled, !. -pfc_list_triggers(What) :- loop_check(pfc_list_triggers_nlc(What)). - -%! pfc_list_triggers_nlc(+What) is nondet. -% -% Lists triggers in the Pfc database without performing a loop check. This is a helper -% predicate for `pfc_list_triggers/1`. -% -% @arg What The condition used to filter triggers. -% -:-meta_predicate(pfc_list_triggers_nlc(?)). -pfc_list_triggers_nlc(MM:What) :- atom(MM), !, MM:pfc_list_triggers(What). -pfc_list_triggers_nlc(What) :- loop_check(pfc_list_triggers_0(What), true). - -%! pfc_list_triggers_0(+What) is nondet. -% -% Primary helper for listing triggers in the Pfc database. It handles various patterns for -% listing triggers. -% -% @arg What The condition used to filter triggers. -% -pfc_list_triggers_0(What) :- get_pi(What, PI), PI \=@= What, pfc_list_triggers(PI). -pfc_list_triggers_0(What) :- nonvar(What), What = ~(Then), !, \+ \+ pfc_list_triggers_1(Then), \+ \+ pfc_list_triggers_1(What). -pfc_list_triggers_0(What) :- \+ \+ pfc_list_triggers_1(~(What)), \+ \+ pfc_list_triggers_1(What). - -%! pfc_list_triggers_types(-TriggerType) is nondet. -% -% Lists various trigger types in the Pfc database. This predicate is used to identify -% different types of triggers available in the system. -% -% @arg TriggerType The trigger type to list. -% -pfc_list_triggers_types('Triggers'). -pfc_list_triggers_types('Instances'). -pfc_list_triggers_types('Subclasses'). -pfc_list_triggers_types('ArgTypes'). -pfc_list_triggers_types('Arity'). -pfc_list_triggers_types('Forward'). -pfc_list_triggers_types('Bidirectional'). -pfc_list_triggers_types('Backchaining'). -pfc_list_triggers_types('Negative'). -pfc_list_triggers_types('Sources'). -pfc_list_triggers_types('Supports'). -pfc_list_triggers_types('Edits'). - -%! print_db_items_and_neg(+Title, +Fact, +What) is nondet. -% -% Prints database items and their negations. It prints both the items and their negations -% based on the specified condition. -% -% @arg Title The title for the items being printed. -% @arg Fact The fact to check. -% @arg What The condition used to filter items. -% -% @example Printing items and their negations: -% ?- print_db_items_and_neg('Facts', my_fact, my_condition). -% -print_db_items_and_neg(Title, Fact, What) :- print_db_items(Title, Fact, What). -print_db_items_and_neg(Title, Fact, What) :- print_db_items(Title, ~(Fact), What). - -%! pfc_list_triggers_1(+What) is nondet. -% -% Secondary helper for listing triggers in the Pfc database. This predicate handles a wide variety of -% Pfc constructs such as facts, rules, instances, subclasses, and argument types, and organizes them -% for display based on the specified condition `What`. -% -% @arg What The condition used to filter triggers. -% -% @example Listing Pfc triggers: -% ?- pfc_list_triggers_1(my_condition). -% -pfc_list_triggers_1(What) :- var(What), !. -pfc_list_triggers_1(~(What)) :- var(What), !. -pfc_list_triggers_1(~(_What)) :- !. -pfc_list_triggers_1(What) :- - print_db_items('Supports User', spft_precanonical(P, mfl4(VarNameZ, _, _, _), ax), '$spft$'(P, mfl4(VarNameZ, _, _, _), ax), What), - print_db_items('Forward Facts', (nesc(F)), F, What), - print_db_items('Forward Rules', (_==>_), What), - ignore((What\= ~(_), safe_functor(What, IWhat, _), - print_db_items_and_neg('Instance Of', isa(IWhat, _), IWhat), - print_db_items_and_neg('Instances: ', isa(_, IWhat), IWhat), - print_db_items_and_neg('Subclass Of', genls(IWhat, _), IWhat), - print_db_items_and_neg('Subclasses: ', genls(_, IWhat), IWhat))), - forall(suggest_m(M), print_db_items('PFC Watches', pfc_prop(M, _, _, _), What)), - print_db_items('Triggers Negative', '$nt$'(_, _, _, _), What), - print_db_items('Triggers Goal', '$bt$'(_, _, _), What), - print_db_items('Triggers Positive', '$pt$'(_, _, _), What), - print_db_items('Bidirectional Rules', (_<==>_), What), - dif(A, B), print_db_items('Supports Deduced', spft_precanonical(P, A, B), '$spft$'(P, A, B), What), - dif(G, ax), print_db_items('Supports Nonuser', spft_precanonical(P, G, G), '$spft$'(P, G, G), What), - print_db_items('Backchaining Rules', (_<-_), What), - % print_db_items('Edits',is_disabled_clause(_),What), - print_db_items('Edits', is_edited_clause(_, _, _), What), - print_db_items('Instances', isa(_, _), What), - print_db_items('Subclasses', genls(_, _), What), - print_db_items('Negative Facts', ~(_), What), - print_db_items('ArgTypes', argGenls(_, _, _), What), - print_db_items('ArgTypes', argIsa(_, _, _), What), - print_db_items('ArgTypes', argQuotedIsa(_, _, _), What), - print_db_items('ArgTypes', meta_argtypes(_), What), - print_db_items('ArgTypes', predicate_property(G, meta_predicate(G)), What), - print_db_items('ArgTypes', resultGenls(_, _), What), - print_db_items('ArgTypes', resultIsa(_, _), What), - print_db_items('Arity', arity(_, _), What), - print_db_items('Arity', current_predicate(_), What), - print_db_items('MetaFacts Predicate', predicate_property(_, _), What), - print_db_items('Sources', module_property(_, _), What), - print_db_items('Sources', predicateConventionMt(_, _), What), - print_db_items('Sources', source_file(_, _), What), - print_db_items('Sources', _:man_index(_, _, _, _, _), What), - print_db_items('Sources', _:'$pldoc'(_, _, _, _), What), - print_db_items('Sources', _:'$pred_option'(_, _, _, _), What), - print_db_items('Sources',_:'$mode'(_,_),What), - !. - -%! pinfo(+Functor_Arity) is nondet. -% -% Shows information about a predicate for a given functor and arity. This includes listing -% the predicate definition and displaying its properties. -% -% @arg Functor_Arity The functor and arity of the predicate (in the form F/A). -% -% @example Showing information for a predicate: -% ?- pinfo(my_predicate/2). -% -pinfo(F/A) :- - listing(F/A), % List the definition of the predicate. - safe_functor(P, F, A), % Create a functor from F/A. - findall(Prop, predicate_property(P, Prop), List), % Collect all properties of the predicate. - wdmsg_pretty(pinfo(F/A) == List), % Display the properties in a formatted way. - !. - -%! pp_DB is nondet. -% -% Pretty prints all facts, rules, triggers, and supports in the default module. -% This predicate iterates through the default module and prints the database content, -% including facts, rules, and triggers, in a formatted way. -% -% @example Pretty printing the default module content: -% ?- pp_DB. -% -%pp_DB:- defaultAssertMt(M),clause_b(mtHybrid(M)),!,pp_DB(M). -%pp_DB:- forall(clause_b(mtHybrid(M)),pp_DB(M)). -pp_DB :- prolog_load_context(module, M), pp_DB(M). - -%! with_exact_kb(+Module, +Goal) is det. -% -% Executes a goal within the context of a specific module. This predicate ensures that -% the goal is called with the exact module context provided. -% -% @arg Module The module context in which the goal will be executed. -% @arg Goal The goal to execute within the module context. -% -% @example Executing a goal in a specific module: -% ?- with_exact_kb(my_module, my_goal). -% -with_exact_kb(M, G) :- - M:call(G). - -%! pp_DB(+Module) is nondet. -% -% Pretty prints the Pfc database for a specific module. This includes facts, rules, -% triggers, and supports stored in the given module. -% -% @arg Module The module context for which the Pfc database will be printed. -% -% @example Pretty printing the Pfc database for a module: -% ?- pp_DB(my_module). -% -pp_DB(M) :- - with_exact_kb(M, M:must_det_ll(( - pp_db_facts, % Pretty print facts. - pp_db_rules, % Pretty print rules. - pp_db_triggers, % Pretty print triggers. - pp_db_supports % Pretty print supports. - ))). - -%! pp_db_facts is nondet. -% -% Pretty prints all facts in the current module Pfc database. -% -% @example Pretty printing facts in the current module: -% ?- pp_db_facts. -% -pp_db_facts :- context_module(M),pp_db_facts(M). - -%! pp_db_rules is nondet. -% -% Pretty prints all rules in the current module Pfc database. -% -% @example Pretty printing rules in the current module: -% ?- pp_db_rules. -% -pp_db_rules :- context_module(M),pp_db_rules(M). - -%! pp_db_triggers is nondet. -% -% Pretty prints all triggers in the current module Pfc database. -% -% @example Pretty printing triggers in the current module: -% ?- pp_db_triggers. -% -pp_db_triggers :- context_module(M),pp_db_triggers(M). - -%! pp_db_supports is nondet. -% -% Pretty prints all supports in the current module Pfc database. -% -% @example Pretty printing supports in the current module: -% ?- pp_db_supports. -% -pp_db_supports :- context_module(M),pp_db_supports(M). - -% Import and export pp_DB/0 at the system level. -% This allows the predicate to be used across different modules. -:- system:import(pp_DB/0). -:- system:export(pp_DB/0). - -%! pp_db_facts(+Module) is nondet. -% -% Pretty prints all facts in a specific module Pfc database. This predicate -% calls the actual printing function while handling any potential errors gracefully. -% -% @arg Module The module context for which the facts will be printed. -% -pp_db_facts(MM) :- ignore(pp_db_facts(MM, _, true)). - -%! pp_db_facts(+Module, +Pattern) is nondet. -% -% Pretty prints facts in a specific module Pfc database that match a given pattern. -% -% @arg Module The module context. -% @arg Pattern The pattern to match facts against. -% -pp_db_facts(MM, Pattern) :- pp_db_facts(MM, Pattern, true). - -%! pp_db_facts(+Module, +Pattern, +Condition) is nondet. -% -% Pretty prints facts in a specific module Pfc database that match a given pattern and condition. -% -% @arg Module The module context. -% @arg Pattern The pattern to match facts against. -% @arg Condition The condition to filter facts. -% -pp_db_facts(MM, P, C) :- - pfc_facts_in_kb(MM, P, C, L), - pfc_classifyFacts(L, User, Pfc, _ZRule), - length(User, UserSize), length(Pfc, PfcSize), - format("~N~nUser added facts in [~w]: ~w", [MM, UserSize]), - pp_db_items(User), - format("~N~nSystem added facts in [~w]: ~w", [MM, PfcSize]), - pp_db_items(Pfc). - -%! pp_db_items(+Items) is det. -% -% Pretty prints a list of database items. -% -% @arg Items The list of items to print. -% -pp_db_items(Var) :- var(Var), !, format("~N ~p", [Var]). -pp_db_items([]) :- !. -pp_db_items([H|T]) :- !, - % numbervars(H,0,_), - format("~N ~p", [H]), - nonvar(T), pp_db_items(T). -pp_db_items((P >= FT)) :- is_hidden_pft(P, FT), !. -pp_db_items(Var) :- format("~N ~p", [Var]). - -%! is_hidden_pft(+Predicate, +FactType) is nondet. -% -% Checks if a fact type should be hidden based on certain criteria. -% -% @arg Predicate The predicate to check. -% @arg FactType The fact type to check. -% -is_hidden_pft(_,(mfl4(_VarNameZ, BaseKB, _, _), ax)) :- current_prolog_flag(pfc_shared_module, BaseKB), !. -is_hidden_pft(_,(why_marked(_), ax)). - -%! pp_mask(+Type, +Module, +Mask) is nondet. -% -% Prints masked items in a module Pfc database. -% -% @arg Type The type of items. -% @arg Module The module context. -% @arg Mask The mask to filter items. -% -pp_mask(Type, MM, Mask) :- - bagof_or_nil(Mask, lookup_kb(MM, Mask), Nts), - list_to_set_variant(Nts, NtsSet), !, - pp_mask_list(Type, MM, NtsSet). - -%! pp_mask_list(+Type, +Module, +List) is nondet. -% -% Pretty prints a list of masked items. -% -% @arg Type The type of items. -% @arg Module The module context. -% @arg List The list of masked items. -% -pp_mask_list(Type, MM, []) :- !,format("~N~nNo ~ws in [~w]...~n", [Type, MM]). -pp_mask_list(Type, MM, NtsSet) :- length(NtsSet, Size), !,format("~N~n~ws (~w) in [~w]...~n", [Type, Size, MM]), - pp_db_items(NtsSet). - -%! pfc_classifyFacts(+Facts, -UserFacts, -PfcFacts, -Rules) is det. -% -% Classifies a list of facts into user facts, Pfc system-added facts, and rule facts. -% -% @arg Facts The list of facts to classify. -% @arg UserFacts The output list of user-added facts. -% @arg PfcFacts The output list of system-added (Pfc) facts. -% @arg Rules The output list of rule facts. -% -pfc_classifyFacts([], [], [], []). -pfc_classifyFacts([H|T], User, Pfc, [H|Rule]) :- - pfcType(H, rule(_)), !, - pfc_classifyFacts(T, User, Pfc, Rule). -pfc_classifyFacts([H|T], [H|User], Pfc, Rule) :- - get_first_user_reason(H, _UU), !, - pfc_classifyFacts(T, User, Pfc, Rule). -pfc_classifyFacts([H|T], User, [H|Pfc], Rule) :- - pfc_classifyFacts(T, User, Pfc, Rule). - -%! pp_db_rules(+Module) is det. -% -% Pretty prints all types of rules in a specified module. This includes forward rules, -% bidirectional rules, backchaining rules, implication rules, bi-conditional rules, -% and negative facts. -% -% @arg Module The module in which to search for rules. -% -pp_db_rules(MM) :- - pp_mask("Forward Rule", MM, ==>(_,_)), - pp_mask("Bidirectional Rule", MM, <==>(_,_)), - pp_mask("Backchaining Rule", MM, <-(_, _)), - pp_mask("Implication Rule", MM, =>(_, _)), - pp_mask("Bi-conditional Rule", MM, <=>(_, _)), - pp_mask("Negative Fact", MM, (~(_))), - % Additional rule types can be uncommented if needed. - % pp_mask("Material-implRule", MM, <=(_, _)), - % pp_mask("PrologRule", MM, :-( _, _)), - !. - -%! pp_db_triggers(+Module) is det. -% -% Pretty prints all triggers in a specific module Pfc database. This includes positive, -% negative, and goal triggers. -% -% @arg Module The module context. -% -pp_db_triggers(MM) :- - pp_mask("Positive trigger(+)", MM, '$pt$'(_, _)), - pp_mask("Negative trigger(-)", MM, '$nt$'(_, _, _)), - pp_mask("Goal trigger(?)", MM, '$bt$'(_, _)), !. - -%! pp_db_supports(+Module) is nondet. -% -% Pretty prints all supports in a specific module Pfc database. -% -% @arg Module The module context. -% -pp_db_supports(MM) :- - % temporary hack to print supports - format("~N~nSupports in [~w]...~n", [MM]), - with_exact_kb(MM, bagof_or_nil((P >= S), pfcGetSupport(P, S), L)), - list_to_set_variant(L, LS), - pp_db_items(LS), !. - -%! list_to_set_variant(+List, -Unique) is det. -% -% Converts a list to a set, removing variants. Ensures that only unique items are retained. -% -% @arg List The input list. -% @arg Unique The output list of unique items. -% -list_to_set_variant(List, Unique) :- - list_unique_1(List, [], Unique), !. - -%! list_unique_1(+List, +So_far, -Unique) is det. -% -% Helper predicate for `list_to_set_variant/2`. Iteratively checks each item and builds -% a list of unique items based on variant equality. -% -% @arg List The input list. -% @arg So_far The accumulator for unique items. -% @arg Unique The output set of unique items. -% -list_unique_1([], _, []). -list_unique_1([X|Xs], So_far, Us) :- - memberchk_variant(X, So_far), !, - list_unique_1(Xs, So_far, Us). -list_unique_1([X|Xs], So_far, [X|Us]) :- - list_unique_1(Xs, [X|So_far], Us). - -%! memberchk_variant(+Val, +List) is nondet. -% -% Checks for membership using =@= (variant equality) rather than unification. -% -% @arg Val The value to check. -% @arg List The list in which to check for membership. -% -memberchk_variant(X, [Y|Ys]) :- - (X =@= Y -> true ; memberchk_variant(X, Ys)). - -%! lookup_kb(+MM, -MHB) is nondet. -% -% Looks up a clause in the knowledge base for the given module `MM`. The predicate searches -% for a clause in the specified module and returns the head-body clause `MHB` if found. -% -% @arg MM The module context to operate within. -% @arg MHB The head-body clause found. -% -lookup_kb(MM, MHB) :- - strip_module(MHB,M,HB), - expand_to_hb(HB, H, B), - (MM:clause(M:H, B, Ref) *-> true; M:clause(MM:H, B, Ref)), - %clause_ref_module(Ref), - clause_property(Ref, module(MM)). - -%! has_cl(+Head) is nondet. -% -% Checks if a clause exists for a specific predicate head. It uses the `predicate_property/2` -% to verify if the predicate has any clauses. -% -% @arg Head The predicate head to check. -% -has_cl(H) :- predicate_property(H, number_of_clauses(_)). - -%! clause_or_call(+H, ?B) is nondet. -% -% Determines whether a predicate can be called directly or needs to match a clause. -% The predicate checks if there are more clauses than rules and chooses the appropriate -% approach to execute or retrieve the clause. -% -% @arg H The head of the predicate. -% @arg B The body of the clause or goal to execute. -% -% PFC2.0 clause_or_call(M:H,B):-is_ftVar(M),!,no_repeats(M:F/A,(f_to_mfa(H,M,F,A))),M:clause_or_call(H,B). -% PFC2.0 clause_or_call(isa(I,C),true):-!,call_u(isa_asserted(I,C)). -% PFC2.0 clause_or_call(genls(I,C),true):-!,on_x_log_throw(call_u(genls(I,C))). -clause_or_call(H, B) :- clause(src_edit(_Before, H), B). -clause_or_call(H, B) :- - predicate_property(H, number_of_clauses(C)), - predicate_property(H, number_of_rules(R)), - ((R*2 < C) -> (clause(H, B) *-> ! ; fail) ; clause(H, B)). - -% PFC2.0 clause_or_call(H,true):- call_u(should_call_for_facts(H)),no_repeats(on_x_log_throw(H)). - - /* - - - -% as opposed to simply using clause(H,true). - -% % should_call_for_facts( +H) is nondet. -% -% Should Call For Facts. -% -should_call_for_facts(H):- get_functor(H,F,A),call_u(should_call_for_facts(H,F,A)). - -% % should_call_for_facts( +VALUE1, ?F, ?VALUE3) is nondet. -% -% Should Call For Facts. -% -should_call_for_facts(_,F,_):- a(prologSideEffects,F),!,fail. -should_call_for_facts(H,_,_):- modulize_head(H,HH), \+ predicate_property(HH,number_of_clauses(_)),!. -should_call_for_facts(_,F,A):- clause_b(pfc_prop(_M,F,A,pfcRHS)),!,fail. -should_call_for_facts(_,F,A):- clause_b(pfc_prop(_M,F,A,pfcMustFC)),!,fail. -should_call_for_facts(_,F,_):- a(prologDynamic,F),!. -should_call_for_facts(_,F,_):- \+ a(pfcControlled,F),!. - - */ - -%! no_side_effects(+Predicate) is nondet. -% -% Checks if a predicate has no side effects. This is done by checking if side effects are -% disabled or if the predicate belongs to the list of predicates with side effects. -% -% @arg Predicate The predicate to check. -% -no_side_effects(P) :- (\+ is_side_effect_disabled -> true;(get_functor(P, F, _), a(prologSideEffects, F))). - -%! pfc_facts_in_kb(+Module, +Pattern, +Condition, -Facts) is det. -% -% Retrieves facts from a specific module knowledge base. -% -% @arg Module The module context. -% @arg Pattern The pattern to match facts against. -% @arg Condition The condition to filter facts. -% @arg Facts The retrieved facts. -% -pfc_facts_in_kb(MM, P, C, L) :- - with_exact_kb(MM, setof_or_nil(P, pfcFact(P, C), L)). - -%! lookup_spft(+Predicate, -Fact, -Type) is nondet. -% -% Looks up a support fact type for a specific predicate. -% -% @arg Predicate The predicate to look up. -% @arg Fact The support fact. -% @arg Type The support type. -% -lookup_spft(P, F, T) :- - pfcGetSupport(P, (F, T)). - -%! u_to_uu(+U, -UU) is det. -% -% Converts a user fact or support to a user fact type (U to UU). -% -% @arg U The user fact or support. -% @arg UU The resulting user fact type. -% -u_to_uu(U, (U, ax)) :- var(U), !. -u_to_uu(U, U) :- nonvar(U), U = (_, _), !. -u_to_uu([U|More], UU) :- list_to_conjuncts([U|More], C), !, u_to_uu(C, UU). -u_to_uu(U, (U, ax)) :- !. - -%! get_source_uu(-UU) is det. -% -% Retrieves the source reference for the current context as a user fact type (UU). -% -% @arg UU The retrieved source reference. -% -:- module_transparent((get_source_uu)/1). -get_source_uu(UU) :- must_ex((get_source_ref1(U), u_to_uu(U, UU))), !. - -%! get_source_ref1(-U) is det. -% -% Retrieves the source reference for the current context. -% -% @arg U The retrieved source reference. -% -get_source_ref1(U) :- quietly_ex((current_why(U), nonvar(U)));ground(U), !. -get_source_ref1(U) :- quietly_ex((get_source_mfl(U))), !. - -%! get_why_uu(-UU) is det. -% -% Retrieves the current "why" reference as a user fact type (UU). -% -% @arg UU The retrieved user fact type. -% -:- module_transparent((get_why_uu)/1). -get_why_uu(UU) :- findall(U, current_why(U), Whys),Whys \== [], !,u_to_uu(Whys, UU). -get_why_uu(UU) :- get_source_uu(UU), !. - -%! get_startup_uu(-UU) is det. -% -% Retrieves the startup "why" reference as a user fact type (UU). -% -% @arg UU The retrieved user fact type. -% -get_startup_uu(UU) :- prolog_load_context(module, CM),u_to_uu((isRuntime, mfl4(VarNameZ, CM, user_input, _)), UU), - varnames_load_context(VarNameZ). - -%! is_user_reason(+UserFact) is nondet. -% -% Checks if a user fact is a valid user reason. -% -% @arg UserFact The user fact to check. -% -is_user_reason((_, U)) :- atomic(U). - -only_is_user_reason((U1, U2)) :- freeze(U2, is_user_reason((U1, U2))). - -%! is_user_fact(+Predicate) is nondet. -% -% Checks if a predicate is a user-added fact. -% -% @arg Predicate The predicate to check. -% -is_user_fact(P) :- get_first_user_reason(P, UU),is_user_reason(UU). - -%! get_first_real_user_reason(+Predicate, -UU) is nondet. -% -% Retrieves the first real user reason for a predicate. -% -% @arg Predicate The predicate to check. -% @arg UU The retrieved user reason. -% -get_first_real_user_reason(P, UU) :- nonvar(P), UU = (F, T), - quietly_ex(((((lookup_spft(P, F, T))), is_user_reason(UU)) *-> true; - ((((lookup_spft(P, F, T))), \+ is_user_reason(UU)) *-> (!, fail) ; fail))). - -%! get_first_user_reason(+Predicate, -UU) is nondet. -% -% Retrieves the first user reason for a predicate. This predicate checks various sources -% (such as lookup tables, asserted clauses, and source locations) to determine the first -% user reason associated with the given predicate. -% -% @arg Predicate The predicate to check. -% @arg UU The retrieved user reason, consisting of a source reference and a term. -% -get_first_user_reason(P, (F, T)) :- - UU = (F, T), - ((((lookup_spft(P, F, T))), is_user_reason(UU)) *-> true; - ((((lookup_spft(P, F, T))), \+ is_user_reason(UU)) *-> (!, fail) ; - (clause_asserted(P), get_source_uu(UU), is_user_reason(UU)))), !. -get_first_user_reason(_, UU) :- get_why_uu(UU), is_user_reason(UU), !. -get_first_user_reason(_, UU) :- get_why_uu(UU), !. -get_first_user_reason(P, UU) :- must_ex(ignore((get_first_user_reason0(P, UU)))), !. -%get_first_user_reason(_,UU):- get_source_uu(UU),\+is_user_reason(UU). % ignore(get_source_uu(UU)). - -%! get_first_user_reason0(+Predicate, -UU) is nondet. -% -% Helper predicate for `get_first_user_reason/2`. This predicate retrieves the source -% reference (user reason) for a given predicate by calling `get_source_mfl/1`. -% -% @arg Predicate The predicate to check. -% @arg UU The retrieved user reason, which consists of the source reference and the 'ax' marker. -% -get_first_user_reason0(_, (M, ax)) :- get_source_mfl(M). - -%:- export(pfc_at_box:defaultAssertMt/1). -%:- system:import(defaultAssertMt/1). -%:- pfc_lib:import(pfc_at_box:defaultAssertMt/1). - -%! get_source_mfl(-MFL) is det. -% -% Retrieves the source reference for the current module/file location. This includes -% the module, file, line number, and variable names. -% -% @arg MFL The retrieved source reference, typically of the form `mfl4/4`. -% -:- module_transparent((get_source_mfl)/1). -get_source_mfl(M):- current_why(M), nonvar(M) , M =mfl4(_VarNameZ,_,_,_). -get_source_mfl(mfl4(VarNameZ, M, F, L)) :- defaultAssertMt(M), current_source_location(F, L), varnames_load_context(VarNameZ). -get_source_mfl(mfl4(VarNameZ, M, F, L)) :- defaultAssertMt(M), current_source_file(F:L), varnames_load_context(VarNameZ). -get_source_mfl(mfl4(VarNameZ, M, F, _L)) :- defaultAssertMt(M), current_source_file(F), varnames_load_context(VarNameZ). -get_source_mfl(mfl4(VarNameZ, M, _F, _L)) :- defaultAssertMt(M), varnames_load_context(VarNameZ). -%get_source_mfl(M):-(defaultAssertMt(M)->true;(atom(M)->(module_property(M,class(_)),!);(var(M),module_property(M,class(_))))). -get_source_mfl(M):-fail,dtrace, -((defaultAssertMt(M)->!; -(atom(M)->(module_property(M,class(_)),!); -pfcError(no_source_ref(M))))). - -%! is_source_ref1(+Term) is nondet. -% -% Placeholder predicate to check if a term is a source reference. -% Currently, it accepts any term but can be expanded for specific logic. -% -is_source_ref1(_). - -%! defaultAssertMt(-Module) is det. -% -% Retrieves the current module context during loading. This predicate -% provides the default module where assertions will be made. -% -% @arg Module The module being loaded, retrieved from the current Prolog context. -% -defaultAssertMt(M) :- prolog_load_context(module, M). - -%! pfc_pp_db_justifications(+Predicate, +Justifications) is det. -% -% Pretty prints the justifications for a predicate. -% -% @arg Predicate The predicate to print justifications for. -% @arg Justifications The list of justifications to print. -% -pfc_pp_db_justifications(P, Js) :- - show_current_source_location, - must_ex(quietly_ex((format("~NJustifications for ~p:", [P]), - pfc_pp_db_justification1('', Js, 1)))). - -%! pfc_pp_db_justification1(+Prefix, +Justifications, +N) is det. -% -% Helper predicate for `pfc_pp_db_justifications/2`. This predicate recursively -% prints the justifications with numbered steps. -% -% @arg Prefix The prefix for printing. -% @arg Justifications The list of justifications to print. -% @arg N The current justification number. -% -pfc_pp_db_justification1(_, [], _). -pfc_pp_db_justification1(Prefix, [J|Js], N) :- - nl, - pfc_pp_db_justifications2(Prefix, J, N, 1), - N2 is N + 1, - pfc_pp_db_justification1(Prefix, Js, N2). - -%! pfc_pp_db_justifications2(+Prefix, +Justification, +JustNo, +StepNo) is det. -% -% Helper predicate for `pfc_pp_db_justification1/3`. This predicate prints individual -% steps of a justification, handling sub-justifications as necessary. -% -% @arg Prefix The prefix for printing. -% @arg Justification The justification to print. -% @arg JustNo The current justification number. -% @arg StepNo The current step number. -% -pfc_pp_db_justifications2(_, [], _, _). -pfc_pp_db_justifications2(Prefix, [C|Rest], JustNo, StepNo) :- -(nb_hasval('$last_printed',C)-> dmsg_pretty(chasVal(C)) ; - ((StepNo==1->fmt('~N~n',[]);true), - backward_compatibility:sformat(LP,' ~w.~p.~p',[Prefix,JustNo,StepNo]), - nb_pushval('$last_printed',LP), - format("~N ~w ~p",[LP,C]), - ignore(loop_check(pfcWhy_sub_sub(C))), - StepNext is 1+StepNo, - pfc_pp_db_justifications2(Prefix,Rest,JustNo,StepNext))). - -%! pfcWhy_sub_sub(+Predicate) is det. -% -% Sub-function for `pfcWhy` to handle sub-subjustifications, printing nested justifications -% as needed. -% -% @arg Predicate The predicate to check. -% -pfcWhy_sub_sub(P) :- - justifications(P, Js), - clear_proofs, - % retractall_u(t_l:whybuffer(_,_)), - (nb_hasval('$last_printed', P) -> dmsg_pretty(hasVal(P)) ; - (( - assertz(t_l:whybuffer(P, Js)), - nb_getval('$last_printed', LP), - ((pfc_pp_db_justification1(LP, Js, 1), fmt('~N~n', [])))))). - -% File : pfcwhy.pl -% Author : Tim Finin, finin@prc.unisys.com -% Updated: -% Purpose: predicates for interactively exploring Pfc justifications. - -% ***** predicates for browsing justifications ***** - -% Import the lists library for list processing. -:- use_module(library(lists)). - -% Declare `t_l:whybuffer/2` as a dynamic predicate, allowing it to be modified during runtime. -:- dynamic(t_l:whybuffer/2). - -%! pfcWhy is nondet. -% -% Interactively explores Pfc justifications. This predicate calls `pfcWhy/1` -% with the current predicate stored in `whybuffer`. -% -pfcWhy :- - t_l:whybuffer(P, _), - pfcWhy(P). - -%! pfcTF(+Predicate) is nondet. -% -% Prints the truth value of a predicate. It first checks if the predicate is true using -% `pfc_call/1`, and then prints its truth value using `pfcTF1/1`. -% -% @arg Predicate The predicate to check. -% -pfcTF(P) :- - pfc_call(P) *-> foreach(pfcTF1(P), true); pfcTF1(P). - -%! pfcTF1(+Predicate) is nondet. -% -% Helper predicate for `pfcTF/1`. This predicate prints the truth value and explores -% both the truth (`P`) and negation (`~P`) of the predicate interactively. -% -% @arg Predicate The predicate to check. -% -pfcTF1(P) :- - ansi_format([underline], "~N=========================================", []), - (ignore(pfcWhy(P))), - ignore(pfcWhy(~P)), - printLine. - -%! pfcWhy(+N) is nondet. -%! pfcWhy(+Predicate) is nondet. -% -% Interactively explores the Nth justification for a predicate or explores all justifications -% for a predicate if no number is provided. -% -% @arg N The justification number to explore. -% @arg Predicate The predicate to explore. -% -pfcWhy(N) :- number(N), !,t_l:whybuffer(P, Js),pfcWhyCommand(N, P, Js). -pfcWhy(P) :- justifications(P, Js),retractall(t_l:whybuffer(_,_)),assert(t_l:whybuffer(P, Js)), - pfcWhyBrouse(P, Js). - -%! pfcWhy1(+Predicate) is nondet. -% -% Interactively explores the first justification for a predicate. -% -% @arg Predicate The predicate to explore. -% -pfcWhy1(P) :- justifications(P, Js),pfcWhyBrouse(P, Js). - -%! pfcWhy2(+Predicate, +N) is nondet. -% -% Interactively explores the Nth justification for a predicate. -% -% @arg Predicate The predicate to explore. -% @arg N The justification number to explore. -% -pfcWhy2(P, N) :- justifications(P, Js),pfcShowJustification1(Js, N). - -%! pfcWhyBrouse(+Predicate, +Justifications) is nondet. -% -% Interactively explores justifications for a predicate. This predicate shows the -% justifications for the given predicate and waits for the user to input a command -% to continue exploring or modify the exploration. -% -% @arg Predicate The predicate to explore. -% @arg Justifications The justifications to explore. -% -pfcWhyBrouse(P, Js) :- - % rtrace(pfc_pp_db_justifications(P,Js)), - pfcShowJustifications(P, Js), - nop((pfcAsk(' >> ', Answer), - pfcWhyCommand(Answer, P, Js))). - -%! pfcWhyCommand(+Command, +Predicate, +Justifications) is nondet. -% -% Executes a command during Pfc justification exploration. This predicate processes -% different commands, such as quitting, viewing help, focusing on a specific justification, -% or navigating through steps. -% -% @arg Command The command to execute (e.g., `q` for quit, `h` for help). -% @arg Predicate The predicate being explored. -% @arg Justifications The justifications being explored. -% -pfcWhyCommand(q, _, _) :- !. % Quit. -pfcWhyCommand(h, _, _) :- !, % Help. - format("~nJustification Browser Commands: - q quit. - N focus on Nth justification. - N.M browse step M of the Nth justification - u up a level~n", []). -pfcWhyCommand(N, _P, Js) :- float(N), !, - pfcSelectJustificationNode(Js, N, Node), - pfcWhy1(Node). - -pfcWhyCommand(u, _, _) :- !. % Up a level. -%! pfcCommand(+Command, +Predicate, +Justifications) is nondet. -% -% Handles commands during Pfc justification exploration. This predicate checks if a given -% command is implemented or recognized and provides appropriate feedback. -% -% @arg Command The command to execute. -% @arg Predicate The predicate being explored (not used in these cases). -% @arg Justifications The justifications being explored (not used in these cases). -% -pfcCommand(N, _, _) :- - integer(N), !, - pfcPrintf("~p is a yet unimplemented command.", [N]), - fail. -pfcCommand(X, _, _) :- - pfcPrintf("~p is an unrecognized command, enter h. for help.", [X]), - fail. - -%! pfcShowJustifications(+Predicate, +Justifications) is nondet. -% -% Pretty prints the justifications for a given predicate. This predicate formats and -% prints each justification associated with the predicate. -% -% @arg Predicate The predicate to print justifications for. -% @arg Justifications The list of justifications to print. -% -pfcShowJustifications(P, Js) :- - show_current_source_location, - reset_shown_justs, - %color_line(yellow,1), - format("~N~nJustifications for ", []), - ansi_format([fg(green)], '~@', [pp(P)]), - format(" :~n", []), - pfcShowJustification1(Js, 1),!, - printLine. - -%! pfcShowJustification1(+Justifications, +N) is nondet. -% -% Pretty prints the Nth justification in a list of justifications. This predicate -% recursively prints each justification, incrementing the justification number. -% -% @arg Justifications The list of justifications to print. -% @arg N The current justification number. -% -pfcShowJustification1([J|Js], N) :- !, - % show one justification and recurse. - %reset_shown_justs, - pfcShowSingleJustStep(N, J),!, - N2 is N+1, - pfcShowJustification1(Js, N2). -pfcShowJustification1(J, N) :- - %reset_shown_justs, % nl, - pfcShowSingleJustStep(N, J),!. - -%! pfcShowSingleJustStep(+JustNo, +Justification) is nondet. -% -% Pretty prints a single step in a justification. -% This predicate handles the formatting and printing of the justification step. -% -% @arg JustNo The justification number. -% @arg Justification The justification step to print. -% -pfcShowSingleJustStep(N, J) :- pfcShowSingleJust(N, step(1), J),!. -pfcShowSingleJustStep(N, J) :- pp(pfcShowSingleJustStep(N, J)),!. - -%! incrStep(+StepNo, -Step) is det. -% -% Increments the step number in a justification. -% This predicate updates the step number by incrementing it by 1. -% -% @arg StepNo The current step number. -% @arg Step The incremented step number. -% -incrStep(StepNo, Step) :- compound(StepNo), arg(1, StepNo, Step), X is Step+1, nb_setarg(1, StepNo, X). - -%! pfcShowSingleJust(+JustNo, +StepNo, +Justification) is nondet. -% -% Pretty prints a single justification step. The predicate handles various formats of -% justification steps, including conjunctions, conditionals, and Prolog clauses. -% -% @arg JustNo The justification number. -% @arg StepNo The step number within the justification. -% @arg Justification The justification step to print. -% -pfcShowSingleJust(JustNo, StepNo, C) :- is_ftVar(C), !, incrStep(StepNo, Step), - ansi_format([fg(cyan)], "~N ~w.~w ~w ", [JustNo, Step, C]), !, maybe_more_c(C). -pfcShowSingleJust(_JustNo,_StepNo,[]):-!. -pfcShowSingleJust(JustNo, StepNo, (P, T)) :- !, - pfcShowSingleJust(JustNo, StepNo, P), - pfcShowSingleJust(JustNo, StepNo, T). -pfcShowSingleJust(JustNo, StepNo, (P, F, T)) :- !, - pfcShowSingleJust1(JustNo, StepNo, P), - pfcShowSingleJust(JustNo, StepNo, F), - pfcShowSingleJust1(JustNo, StepNo, T). -pfcShowSingleJust(JustNo, StepNo, (P *-> T)) :- !, - pfcShowSingleJust1(JustNo, StepNo, P), format(' *-> ', []), - pfcShowSingleJust1(JustNo, StepNo, T). -pfcShowSingleJust(JustNo, StepNo, (P :- T)) :- !, - pfcShowSingleJust1(JustNo, StepNo, P), format(':- ~p.', [T]). -pfcShowSingleJust(JustNo, StepNo, (P : - T)) :- !, - pfcShowSingleJust1(JustNo, StepNo, P), format(' :- ', []), - pfcShowSingleJust(JustNo, StepNo, T). -pfcShowSingleJust(JustNo, StepNo, (P :- T)) :- !, - pfcShowSingleJust1(JustNo, StepNo, call(T)), - pfcShowSingleJust1(JustNo, StepNo, P). -pfcShowSingleJust(JustNo, StepNo, [P|T]) :- !, - pfcShowSingleJust(JustNo, StepNo, P), - pfcShowSingleJust(JustNo, StepNo, T). -pfcShowSingleJust(JustNo, StepNo, '$pt$'(P, Body)) :- !, - pfcShowSingleJust1(JustNo, StepNo, '$pt$'(P)), - pfcShowSingleJust(JustNo, StepNo, Body). -pfcShowSingleJust(JustNo, StepNo, C) :- - pfcShowSingleJust1(JustNo, StepNo, C). - -%! fmt_cl(+Clause) is det. -% -% Formats and writes a clause to the output. It uses various formatting strategies, -% such as handling variables, pretty printing, and special term portrayals. -% -% @arg Clause The clause to format and write. -% -fmt_cl(P) :- \+ \+ (numbervars(P, 666, _, [attvars(skip), singletons(true)]), write_src(P)), !. -fmt_cl(P) :- \+ \+ (pretty_numbervars(P, PP), numbervars(PP, 126, _, [attvar(skip), singletons(true)]), - write_term(PP, [portray(true), portray_goal(fmt_cl)])), write('.'). -fmt_cl(S,_):- term_is_ansi(S), !, write_keeping_ansi(S). -fmt_cl(G,_):- is_grid(G),write('"'),user:print_grid(G),write('"'),!. -% fmt_cl(P,_):- catch(arc_portray(P),_,fail),!. -fmt_cl(P,_):- is_list(P),catch(p_p_t_no_nl(P),_,fail),!. -%ptg(PP,Opts):- is_list(PP),select(portray_goal(ptg),Opts,Never),write_term(PP,Never). - -%! unwrap_litr(+Clause, -UnwrappedClause) is det. -% -% Unwraps a literal clause to its core form. This predicate is used to simplify -% nested terms such as `call/1`, `'$pt$'/1`, and similar wrappers. -% -% @arg Clause The clause to unwrap. -% @arg UnwrappedClause The unwrapped version of the clause. -% -unwrap_litr(C, CCC+VS) :- - copy_term(C, CC, VS), - numbervars(CC+VS, 0, _), - unwrap_litr0(CC, CCC), !. -unwrap_litr0(call(C), CC) :- unwrap_litr0(C, CC). -unwrap_litr0('$pt$'(C), CC) :- unwrap_litr0(C, CC). -unwrap_litr0(body(C), CC) :- unwrap_litr0(C, CC). -unwrap_litr0(head(C), CC) :- unwrap_litr0(C, CC). -unwrap_litr0(C, C). - - -% Declares `shown_why/1` as a thread-local predicate, meaning that each thread can have its -% own instance of `shown_why/1`. This allows different threads to track which justifications -% have been shown independently of one another. -:- thread_local t_l:shown_why/1. - -%! pfcShowSingleJust1(+JustNo, +StepNo, +Clause) is det. -% -% Pretty prints a single clause in a justification. This predicate processes the clause and, -% if necessary, unwraps the literal before printing. -% -% @arg JustNo The justification number. -% @arg StepNo The step number in the justification. -% @arg Clause The clause to print. -% -pfcShowSingleJust1(JustNo, _, MFL) :- is_mfl(MFL), JustNo \== 1, !. -pfcShowSingleJust1(JustNo, StepNo, C) :- - unwrap_litr(C, CC), !, - pfcShowSingleJust4(JustNo, StepNo, C, CC). - -%! pfcShowSingleJust4(+JustNo, +StepNo, +Clause, +UnwrappedClause) is det. -% -% Helper predicate for `pfcShowSingleJust1/3`. It handles printing the clause and its unwrapped version. -% -% @arg JustNo The justification number. -% @arg StepNo The step number in the justification. -% @arg Clause The clause to print. -% @arg UnwrappedClause The unwrapped version of the clause. -% -pfcShowSingleJust4(_, _, _, CC) :- t_l:shown_why(C), C =@= CC, !. -pfcShowSingleJust4(_, _, _, MFL) :- is_mfl(MFL), !. -pfcShowSingleJust4(JustNo, StepNo, C, CC) :- assert(t_l:shown_why(CC)), !, - incrStep(StepNo, Step), - ansi_format([fg(cyan)], "~N ~w.~w ~@ ", [JustNo, Step, user:fmt_cl(C)]), - %write('<'), - pfcShowSingleJust_C(C),!,%write('>'), - format('~N'), - ignore((maybe_more_c(C))), - assert(t_l:shown_why(C)), - format('~N'), !. - -%! is_mfl(+Term) is nondet. -% -% Checks if a term is an mfl (module/file/line) reference. An mfl reference is represented -% as `mfl4/4`. -% -% @arg Term The term to check. -% -is_mfl(MFL) :- compound(MFL), MFL = mfl4(_, _, _, _). - -%! maybe_more_c(+Term) is det. -% -% Triggers exploration of more clauses if needed. This predicate checks if more clauses -% related to a term should be explored based on certain conditions. -% -% @arg Term The term to check for further clause exploration. -% -maybe_more_c(MFL) :- is_mfl(MFL), !. -maybe_more_c(_) :- t_l:shown_why(no_recurse). -maybe_more_c(C) :- t_l:shown_why(more(C)), !. -maybe_more_c(C) :- t_l:shown_why((C)), !. -maybe_more_c(C) :- - assert(t_l:shown_why(more(C))), - assert(t_l:shown_why((C))), - locally(t_l:shown_why(no_recurse), - locally(t_l:shown_why((C)), - locally(t_l:shown_why(more(C)), - ignore(catch(pfcWhy2(C, 1.1), E, fbugio(E)))))), - !. - -%! pfcShowSingleJust_C(+Clause) is det. -% -% Helper predicate for `pfcShowSingleJust1/3` that displays a single clause justification. -% -% @arg Clause The clause to display. -% -pfcShowSingleJust_C(C) :- is_file_ref(C), !. -pfcShowSingleJust_C(C) :- find_mfl(C, MFL), assert(t_l:shown_why(MFL)), !, pfcShowSingleJust_MFL(MFL). -pfcShowSingleJust_C(_) :- ansi_format([hfg(black)], " % [no_mfl] ", []), !. - -%! short_filename(+File, -ShortFilename) is det. -% -% Extracts a short filename from a full file path. This predicate simplifies the file path by -% removing unnecessary components. -% -% @arg File The full file path. -% @arg ShortFilename The extracted short filename. -% -short_filename(F, FN) :- symbolic_list_concat([_, FN], '/pack/', F), !. -short_filename(F, FN) :- symbolic_list_concat([_, FN], swipl, F), !. -short_filename(F, FN) :- F = FN, !. - -%! pfcShowSingleJust_MFL(+MFL) is det. -% -% Helper predicate for `pfcShowSingleJust_C/1` that displays an mfl (module/file/line) reference. -% -% @arg MFL The mfl (module/file/line) reference to display. -% -pfcShowSingleJust_MFL(MFL) :- - MFL = mfl4(VarNameZ, _M, F, L), atom(F), short_filename(F, FN), !, - varnames_load_context(VarNameZ), - ansi_format([hfg(black)], " % [~w:~w] ", [FN, L]). -pfcShowSingleJust_MFL(MFL) :- - MFL = mfl4(V, M, F, L), my_maplist(var, [V, M, F, L]), !. -pfcShowSingleJust_MFL(MFL) :- - ansi_format([hfg(black)], " % [~w] ", [MFL]), !. - -%! pfcAsk(+Message, -Answer) is det. -% -% Asks the user for input during Pfc justification exploration. -% -% @arg Message The message to display to the user. -% @arg Answer The user input. -% -pfcAsk(Msg, Ans) :- - format("~n~w", [Msg]), % Display the message to the user. - read(Ans). % Read the user input. - -%! pfcSelectJustificationNode(+Justifications, +Index, -Node) is det. -% -% Selects a specific node in a list of justifications based on an index. The node -% corresponds to a specific step in the justification process. -% -% @arg Justifications The list of justifications. -% @arg Index The index used to select the node. -% @arg Node The selected node. -% -pfcSelectJustificationNode(Js, Index, Step) :- - JustNo is integer(Index), % Convert index to an integer for selecting the justification. - nth1(JustNo, Js, Justification), % Get the Justification at position JustNo. - StepNo is 1 + integer(Index*10 - JustNo*10), % Calculate the step number. - nth1(StepNo, Justification, Step). % Get the Step at position StepNo within the justification. diff --git a/.Attic/metta_lang/metta_eval.pl b/.Attic/metta_lang/metta_eval.pl index 4db7aecf18c..cf378f7a3de 100755 --- a/.Attic/metta_lang/metta_eval.pl +++ b/.Attic/metta_lang/metta_eval.pl @@ -94,9 +94,7 @@ coerce('Bool',Value,Result):- Value=0, !, Result='False'. coerce('Bool',Value,Result):- Value='False', !, Result='False'. coerce('Bool',Value,Result):- is_list(Value), length(Value, 0), !, Result='False'. -coerce('Bool',Value,Result):- is_list(Value),!,as_tf(call_true(Value),Result), -set_list_value(Value,Result). -coerce('Bool',Value,Result):- !, Result='True'. +coerce('Bool',_Valu,Result):- !, Result='True'. coerce('Number',Value,Result):- number(Value), !, Value=Result. coerce('Number',Value,Result):- string(Value), !, number_string(Result, Value). @@ -104,8 +102,15 @@ coerce('Number',Value,Result):- Value='True', !, Result=1. coerce('Number',Value,Result):- atom(Value), !, atom_number(Value, Result). +coerce('String', Value, Result):- string(Value), !, Value=Result. coerce('String', Value, Result):- term_string(Value,Result). +coerce(Type, Value, Result):- + (get_type(Value,ValuesType);ValuesType='Any'), + freeze(Nonvar,Nonvar='def-coerce'), + current_self(KB),metta_atom(KB,[Nonvar,ValuesType,Type,Function]),nonvar(Nonvar), + eval([Function,Value],Result),!. + set_list_value(Value,Result):- nb_setarg(1,Value,echo),nb_setarg(1,Value,[Result]). %is_self_eval_l_fa('S',1). % cheat to comment @@ -145,7 +150,7 @@ % is_metta_declaration([F|T]):- is_list(T), is_user_defined_head([F]),!. % Sets the current self space to '&self'. This is likely used to track the current context or scope during the evaluation of Metta code. -:- nb_setval(self_space, '&self'). +%:- nb_setval(self_space, '&self'). %current_self(Space):- nb_current(self_space,Space). @@ -164,8 +169,19 @@ eval_true(X):- eval_args(X,Y), once(var(Y) ; \+ is_False(Y)). eval(Depth,Self,X,Y):- eval('=',_,Depth,Self,X,Y). -eval(Eq,RetType,Depth,Self,X,Y):- - catch_metta_return(eval_args(Eq,RetType,Depth,Self,X,Y),Y). +eval(Eq,RetType,Depth,Self,X,O):- + eval_reducable(Eq,RetType,Depth,Self,X,eval_args(Eq,RetType,Depth,Self,X,Y),Y,O). + + +eval_reducable(Eq,RetType,Depth,Self,X,G,Y,O):- catch_metta_return(G,Y), return_x_g_y(Eq,RetType,Depth,Self,X,X,Y,O). + +return_x_g_y(_Eq,_RetType,_Depth,_Self,X,_,Y,R):- Y == 'NotReducable',!,R=X. +return_x_g_y(Eq,RetType,Depth, Self,X,M,Y,R):- M\=@=Y, !, eval_args(Eq,RetType,Depth,Self,Y,Z), return_x_g_y(Eq,RetType,Depth,Self,X,Y,Z,R). +return_x_g_y(_Eq,_RetType,_Depth,_Self,_X,_M,R,R). + +catch_metta_return(G,Y):- + catch(G,metta_return(Y),ignore(retract(thrown_metta_return(Y)))). + %:- set_prolog_flag(gc,false). /* @@ -222,8 +238,7 @@ eval_ret(Eq,RetType,Depth,Self,X,Y):- eval_00(Eq,RetType,Depth,Self,X,Y), is_returned(Y). -catch_metta_return(G,Y):- - catch(G,metta_return(Y),ignore(retract(thrown_metta_return(Y)))). + allow_repeats_eval_(_):- !. allow_repeats_eval_(_):- option_value(no_repeats,false),!. @@ -238,7 +253,7 @@ eval_00(Eq,RetType,Depth,Self,X,YO):- eval_01(Eq,RetType,Depth,Self,X,YO). eval_01(Eq,RetType,Depth,Self,X,YO):- - X\==[empty], % speed up n-queens x60 + % X\==[empty], % speed up n-queens x60 but breaks other things if_t((Depth<1, trace_on_overflow), debug(metta(eval_args))), notrace((Depth2 is Depth-1, copy_term(X, XX))), @@ -248,7 +263,7 @@ ;eval_01(Eq,RetType,Depth2,Self,M,Y)), eval_02(Eq,RetType,Depth2,Self,Y,YO))). -eval_02(Eq,RetType,Depth2,Self,Y,YO):- Y\==[empty], % speed up n-queens x60 +eval_02(Eq,RetType,Depth2,Self,Y,YO):- % Y\==[empty], % speed up n-queens x60 but breaks other things once(if_or_else((subst_args_here(Eq,RetType,Depth2,Self,Y,YO)), if_or_else((fail,finish_eval(Eq,RetType,Depth2,Self,Y,YO)), Y=YO))). @@ -261,9 +276,10 @@ % % uncommented causes 7% failure but a 10x speedup % subst_args_here(Eq,RetType,Depth2,Self,Y,YO):- Y=YO. % % this next one at least causes no failures and 5x speedup -subst_args_here(Eq,RetType,Depth2,Self,Y,YO):- wont_need_subst(Y),!, Y=YO. +subst_args_here(_Eq,_RetType,_Depth2,_Self,Y,YO):- wont_need_subst(Y),!, Y=YO. subst_args_here(Eq,RetType,Depth2,Self,Y,YO):- subst_args(Eq,RetType,Depth2,Self,Y,YO), + %Y =YO, notrace(if_t_else((wont_need_subst(Y),Y\=@=YO), (write_src_uo(needed_subst_args(Y,YO)),bt,sleep(1.0)), nop(write_src_uo(unneeded_subst_args(Y))))). @@ -510,8 +526,8 @@ eval_until_unify(_Eq,_RetType,_Dpth,_Slf,X,X):- !. eval_until_unify(Eq,RetType,Depth,Self,X,Y):- eval_until_eq(Eq,RetType,Depth,Self,X,Y),!. -eval_until_eq(_Eq,_RetType,_Dpth,_Slf,X,Y):- catch_nowarn(X=:=Y),!. -eval_until_eq(_Eq,_RetType,_Dpth,_Slf,X,Y):- catch_nowarn('#='(X,Y)),!. +eval_until_eq(_Eq,_RetType,_Dpth,_Slf,X,Y):- notrace(catch_nowarn(X=:=Y)),!. +eval_until_eq(_Eq,_RetType,_Dpth,_Slf,X,Y):- notrace(catch_nowarn('#='(X,Y))),!. eval_until_eq(Eq,RetType,_Dpth,_Slf,X,Y):- X=Y,check_returnval(Eq,RetType,Y). %eval_until_eq(Eq,RetType,Depth,Self,X,Y):- var(Y),!,eval_in_steps_or_same(Eq,RetType,Depth,Self,X,XX),Y=XX. %eval_until_eq(Eq,RetType,Depth,Self,Y,X):- var(Y),!,eval_in_steps_or_same(Eq,RetType,Depth,Self,X,XX),Y=XX. @@ -598,6 +614,44 @@ % ================================================================= % ================================================================= +gen_eval_20_stubs:- + shell(clear), + make,call(gen_eval_20_stubs2). +gen_eval_20_stubs2:- + Clause = (impls([F|Args],Res,ParamTypes,RetType):- Body), + + forall(gen_eval_20_stubs([F|Args],Res,ParamTypes,RetType,Body), + ignore(( + numbervars(Clause,0,_), + nonvar(F),atom(F), + ast_to_prolog_aux(no_caller,fn_impl(F,Args,Res),Head), + ast_to_prolog_aux(Head,Body,Body1), + print_tree_nl(Head:-Body1)))). + + +is_like_eval_20(E20):- atom(E20),atom_concat(eval,_,E20), + %(E20 = eval_args;E20 = eval_20), + \+ atom_concat(find,_,E20), + \+ atom_concat(_,e,E20). + +gen_eval_20_stubs([F|Args],Res,ParamTypes,RetType,Body):- + predicate_property(eval_20(Eq,RetType,Depth,Self,[F|Args],Res),file(File)), + predicate_property(Head,file(File)), + Head=..[E20,Eq,RetType,Depth,Self,[F|Args],Res], + is_like_eval_20(E20), + clause(Head, Body), + ignore(once((sub_term(FF==Sym, Body), atom(Sym), FF == F,F=Sym))), + %min_max_args(Args,Startl,Ends), + (is_list(Args)->true;between(1,5,Len)), + once(len_or_unbound(Args,Len)), + nonvar(F),atom(F), + ignore(Depth=666), + % ignore(Eq= '='), + ignore(Self= '&self'), + once(get_operator_typedef(Self,F,Len,ParamTypes,RetType)). + + + eval_20(Eq,RetType,_Dpth,_Slf,['repl!'],Y):- !, repl,check_returnval(Eq,RetType,Y). %eval_20(Eq,RetType,Depth,Self,['enforce',Cond],Res):- !, enforce_true(Eq,RetType,Depth,Self,Cond,Res). eval_20(Eq,RetType,Depth,Self,['!',Cond],Res):- !, call(eval_args(Eq,RetType,Depth,Self,Cond,Res)). @@ -856,8 +910,6 @@ eval_20(Eq,RetType,Depth,Self,[Op,Space|Args],Res):- is_space_op(Op),!, eval_space_start(Eq,RetType,Depth,Self,[Op,Space|Args],Res). -eval_20(Eq,RetType,Depth,Self,['unify',Space|Args],Res):- !, - eval_space_start(Eq,RetType,Depth,Self,['match',Space|Args],Res). eval_space_start(Eq,RetType,_Depth,_Self,[_Op,_Other,Atom],Res):- (Atom == [] ; Atom =='Empty'; Atom =='Nil'),!,make_nop(RetType,'False',Res),check_returnval(Eq,RetType,Res). @@ -1123,12 +1175,13 @@ eval_20(_Eq,_RetType1,_Depth,_Self,['call!'|S], TF):- !, eval_call(S,TF). eval_20(_Eq,_RetType1,_Depth,_Self,['call-p!'|S], TF):- !, eval_call(S,TF). eval_20(_Eq,_RetType1,_Depth,_Self,['call-fn!'|S], R):- !, eval_call_fn(S,R). -eval_20(_Eq,_RetType1,_Depth,_Self,['call-fn-nth!',Nth,S], R):- +eval_20(_Eq,_RetType1,_Depth,_Self,['call-fn-nth!',Nth|S], R):- length(Left,Nth), append(Left,Right,S), append(Left,[R|Right],NewS),!, eval_call(NewS,_). + max_counting(F,Max):- flag(F,X,X+1), X true; (flag(F,_,10),!,fail). @@ -1166,12 +1219,31 @@ % ================================================================= % ================================================================= % ================================================================= +metta_container_sub_part(Container,Item):- is_space(Container),!,metta_atom(Container,Item). +metta_container_sub_part(Container,Item):- is_list(Container),!,member(Item,Container). + +% GUESS `¯\\_ :( _/¯` what version of unify they are trying to use? ¯(°_o)/¯ + +% 1) If Arg1 is a space, then we redirect to a `match` operation. +eval_20(Eq,RetType,Depth,Self,['unify',Arg1,Arg2|Args],Res):- is_metta_space(Arg1), !, + eval_args(Eq,RetType,Depth,Self,['match',Arg1,Arg2|Args],Res). +% 2) If Arg1 and Arg2 are nonvars and Arg1 is declared a `Container`, then use `container-unify` +eval_20(Eq,RetType,Depth,Self,['unify',Arg1,Arg2|Args],Res):- nonvar(Arg1), nonvar(Arg2), get_type(Depth,Self,Arg1,'Container'), + eval_args(Eq,RetType,Depth,Self,['container-unify',Arg1,Arg2|Args],Res). +% 3) Otherwise, default to using `if-unify` for the unify operation. +eval_20(Eq,RetType,Depth,Self,['unify',Arg1,Arg2|Args],Res):- !, + eval_args(Eq,RetType,Depth,Self,['if-unify',Arg1,Arg2|Args],Res). + +eval_20(Eq,RetType,Depth,Self,['container-unify',Arg1,Arg2,Then|ElseL],Res):- + ((metta_container_sub_part(Arg1,Part),eval_args_true(Eq,'Bool',Depth,Self,['==',Part,Arg2])) + *-> eval_args(Eq,RetType,Depth,Self,Then,Res) + ; (ElseL=[Else],eval_args(Eq,RetType,Depth,Self,Else,Res))). + +eval_20(Eq,RetType,Depth,Self,['if-unify',X,Y,Then|ElseL],Res):- !, + (eval_args_true(Eq,'Bool',Depth,Self,['==',X,Y]) + *-> eval_args(Eq,RetType,Depth,Self,Then,Res) + ; (ElseL=[Else],eval_args(Eq,RetType,Depth,Self,Else,Res))). -eval_20(Eq,RetType,Depth,Self,['if-unify',X,Y,Then,Else],Res):- !, - eval_args(Eq,'Bool',Depth,Self,['==',X,Y],TF), - (is_True(TF) - -> eval_args(Eq,RetType,Depth,Self,Then,Res) - ; eval_args(Eq,RetType,Depth,Self,Else,Res)). eval_20(Eq,RetType,Depth,Self,['if-decons-expr',HT,H,T,Then,Else],Res):- !, @@ -1188,15 +1260,13 @@ eval_20(Eq,RetType,Depth,Self,['if',Cond,Then,Else],Res):- !, - eval_args(Eq,'Bool',Depth,Self,Cond,TF), - (is_True(TF) - -> eval_args(Eq,RetType,Depth,Self,Then,Res) + (eval_args_true(Eq,'Bool',Depth,Self,Cond) + *-> eval_args(Eq,RetType,Depth,Self,Then,Res) ; eval_args(Eq,RetType,Depth,Self,Else,Res)). eval_20(Eq,RetType,Depth,Self,['If',Cond,Then,Else],Res):- !, - eval_args(Eq,'Bool',Depth,Self,Cond,TF), - (is_True(TF) - -> eval_args(Eq,RetType,Depth,Self,Then,Res) + (eval_args_true(Eq,'Bool',Depth,Self,Cond) + *-> eval_args(Eq,RetType,Depth,Self,Then,Res) ; eval_args(Eq,RetType,Depth,Self,Else,Res)). eval_20(Eq,RetType,Depth,Self,['If',Cond,Then],Res):- !, @@ -1477,9 +1547,12 @@ % Placeholder to deal with formatting {:} later format_args_get_format(FormatRest, FormatRest, _). -format_args_write(Arg,_) :- string(Arg), !, write(Arg). -format_args_write('#\\'(Arg),_) :- !, write(Arg). -format_args_write(Arg,_) :- write_src_woi(Arg). +format_args_write(Arg,_) :- \+ compound(Arg), !, format_arg(Arg). +format_args_write('#\\'(Char),_) :- !, format_arg(Char). +format_args_write(Arg,_) :- format_arg(Arg). + +format_arg(Arg) :- string(Arg), !, write(Arg). +format_arg(Arg):- \+ \+ write_src_woi(Arg). format_nth_args([], _, _). format_nth_args(['{','{'|FormatRest], Iterator, Args) :- !, put('{'), format_nth_args(FormatRest, Iterator, Args). % escaped @@ -1814,18 +1887,52 @@ % ================================================================= % ================================================================= % ================================================================= -% METTLOG COMPILER PREDEFS +% METTALOG COMPILER PREDEFS % ================================================================= % ================================================================= % ================================================================= +%/* TODO: this should take into account the compilation prefix but +eval_20(_Eq,_RetType,_Dpth,_Slf,['current-predicate-arity',F],A):- +% These two are no longer strictly compiler redefinitions - the compiler +% predicates should be predicate/function-arity (not "current"), for +% arities explicitly declared by the user. This pair of predicates +% should instead handle deduced arities of functions defined but without +% an explicit arity declaration. + !, + eval_for('Symbol',F,FF), + current_predicate_arity(FF,A). +eval_20(_Eq,_RetType,_Dpth,_Slf,['current-function-arity',F],A):- + !, + eval_for('Symbol',F,FF), + current_function_arity(FF,A). +%*/ -eval_20(_Eq,_RetType,_Dpth,_Slf,['predicate-arity',F],A):- !, - eval_for('Symbol',F,FF), - predicate_arity(FF,A). -eval_20(_Eq,_RetType,_Dpth,_Slf,['function-arity',F],A):- !, - eval_for('Symbol',F,FF), - function_arity(FF,A). +/* TODO: This could work but the prefixed prdicate/function is not found. +eval_20(_Eq,_RetType,_Dpth,_Slf,['current-predicate-arity',F],A):- + !, + eval_for('Symbol',F,FF), + transpile_prefix(P), + atom_concat(P,FF,FF_mc), + current_predicate_arity(FF_mc,A). +eval_20(_Eq,_RetType,_Dpth,_Slf,['current-function-arity',F],A):- + !, + eval_for('Symbol',F,FF), + transpile_prefix(P), + atom_concat(P,FF,FF_mc), + current_function_arity(FF_mc,A). +*/ + +current_predicate_arity(F,A):- + metta_atom('&self',[:,F,[->|Args]]), + !, + length(Args,A). +current_predicate_arity(F,A):- + current_predicate(F/A). + +current_function_arity(F,A):- + current_predicate_arity(F,PA) + ,A is PA - 1. @@ -1876,9 +1983,9 @@ (!,write_src(E),fail))),!. -empty('Empty'). -','(A,B,(AA,BB)):- eval_args(A,AA),eval_args(B,BB). -':'(A,B,[':',A,B]). +%empty('Empty'). +%','(A,B,(AA,BB)):- eval_args(A,AA),eval_args(B,BB). +%':'(A,B,[':',A,B]). '<'(A,B,TFO):- as_tf(A'(A,B,TFO):- as_tf(A M=Y ; % finish_eval(Depth,Self,M,Y); (eval_failed(Depth,Self,X,Y)*->true;X=Y)). eval_40(Eq,RetType,Depth,Self,AEMore,ResOut):- eval_41(Eq,RetType,Depth,Self,AEMore,ResOut). eval_70(Eq,RetType,Depth,Self,PredDecl,Res):- - if_or_else(eval_maybe_python(Eq,RetType,Depth,Self,PredDecl,Res), - if_or_else(eval_maybe_host_predicate(Eq,RetType,Depth,Self,PredDecl,Res), - if_or_else(eval_maybe_host_function(Eq,RetType,Depth,Self,PredDecl,Res), + % if_or_else(eval_maybe_python(Eq,RetType,Depth,Self,PredDecl,Res), + % if_or_else(eval_maybe_host_predicate(Eq,RetType,Depth,Self,PredDecl,Res), + % if_or_else(eval_maybe_host_function(Eq,RetType,Depth,Self,PredDecl,Res), if_or_else(eval_maybe_defn(Eq,RetType,Depth,Self,PredDecl,Res), - eval_maybe_subst(Eq,RetType,Depth,Self,PredDecl,Res))))). + eval_maybe_subst(Eq,RetType,Depth,Self,PredDecl,Res)). +eval_30(Eq,RetType,Depth,Self,PredDecl,Res):- + if_or_else(eval_maybe_python(Eq,RetType,Depth,Self,PredDecl,Res), + if_or_else(eval_maybe_host_predicate(Eq,RetType,Depth,Self,PredDecl,Res), + if_or_else(eval_maybe_host_function(Eq,RetType,Depth,Self,PredDecl,Res), fail))). + eval_all_args:- true_flag. fail_missed_defn:- true_flag. fail_on_constructor:- true_flag. @@ -2331,12 +2458,15 @@ %eval_80(_Eq,_RetType,_Dpth,_Slf,LESS,Res):- fake_notrace((once((eval_selfless(LESS,Res),fake_notrace(LESS\==Res))))),!. +is_host_predicate([AE|More],Pred,Len):- + is_system_pred(AE), + length(More,Len), + is_syspred(AE,Len,Pred), + \+ (atom(AE), atom_concat(_,'-fn',AE)). + % predicate inherited by system eval_maybe_host_predicate(Eq,RetType,_Depth,_Self,[AE|More],TF):- allow_host_functions, - once((is_system_pred(AE), - length(More,Len), - is_syspred(AE,Len,Pred))), - \+ (atom(AE), atom_concat(_,'-fn',AE)), + is_host_predicate([AE|More],Pred,_Len), %current_predicate(Pred/Len), %fake_notrace( \+ is_user_defined_goal(Self,[AE|More])),!, %adjust_args(Depth,Self,AE,More,Adjusted), @@ -2380,26 +2510,36 @@ s2ps(S,P):- S=='Nil',!,P=[]. s2ps(S,P):- \+ is_list(S),!,P=S. -s2ps([F|S],P):- atom(F),maplist(s2ps,S,SS),join_s2ps(F,SS,P),!. -s2ps([F|S],P):- is_list(F),maplist(s2ps,[F|S],SS),join_s2ps(call,SS,P),!. +s2ps([F|S],P):- atom(F),maplist(s2p1,S,SS),join_s2ps(F,SS,P),!. +s2ps([F|S],P):- is_list(F),maplist(s2p1,[F|S],SS),join_s2ps(call,SS,P),!. +%s2ps(S,P):- is_list(F),maplist(s2ps,[F|S],SS),join_s2ps(call,SS,P),!. s2ps(S,S):-!. + +s2p1(S,P):- S=='Nil',!,P=[]. +s2p1(S,P):- \+ is_list(S),!,P=S. +s2p1(['Cons',H,T],[HH|TT]):-!,s2p1(H,HH),s2p1(T,TT),!. +s2p1(S,S). + join_s2ps('Cons',[H,T],[H|T]):-!. join_s2ps(F,Args,P):-atom(F),P=..[F|Args]. eval_call(S,TF):- - s2ps(S,P), !, - fbug(eval_call(P,'$VAR'('TF'))),as_tf(P,TF). + s2ps(S,P), !, fbug(eval_call(P,'$VAR'('TF'))), + as_tf_tracabe(P,TF). eval_call_fn(S,R):- - s2ps(S,P), !, - fbug(eval_call_fn(P,'$VAR'('R'))),as_tf(call(P,R),TF),TF\=='False'. + s2ps(S,P), !, fbug(eval_call_fn(P,'$VAR'('R'))), + as_tf_tracabe(call(P,R),TF),TF\=='False'. -% function inherited from system -eval_maybe_host_function(Eq,RetType,_Depth,_Self,[AE|More],Res):- allow_host_functions, +is_host_function([AE|More],Pred,Len):- is_system_pred(AE), length([AE|More],Len), is_syspred(AE,Len,Pred), - \+ (symbol(AE), symbol_concat(_,'-p',AE)), % thus maybe -fn or ! + \+ (symbol(AE), symbol_concat(_,'-p',AE)). % thus maybe -fn or ! + +% function inherited from system +eval_maybe_host_function(Eq,RetType,_Depth,_Self,[AE|More],Res):- allow_host_functions, + is_host_function([AE|More],Pred,_Len), % thus maybe -fn or ! %fake_notrace( \+ is_user_defined_goal(Self,[AE|More])),!, %adjust_args(Depth,Self,AE,More,Adjusted),!, %Len1 is Len+1, @@ -2439,9 +2579,9 @@ - +%catch_err(G,E,C):- catch(G,E,(always_rethrow(E)->(throw(E));C)). catch_warn(G):- (catch_err(G,E,(fbug(catch_warn(G)-->E),fail))). -catch_nowarn(G):- (catch_err(G,error(_,_),fail)). +catch_nowarn(G):- catch(G,E,(always_rethrow(E)->(throw(E)),fail)). % less Macro-ey Functions @@ -2557,7 +2697,11 @@ :-if(true). :- nodebug(metta('defn')). -eval_maybe_defn(Eq,RetType,Depth,Self,X,Res):- + +eval_maybe_defn(Eq,RetType,Depth,Self,X,O):- + eval_reducable(Eq,RetType,Depth,Self,X,eval_maybe_defn_now(Eq,RetType,Depth,Self,X,Res),Res,O). + +eval_maybe_defn_now(Eq,RetType,Depth,Self,X,Res):- \+ fail_on_constructor, \+ \+ (curried_arity(X,F,A), is_metta_type_constructor(Self,F,AA), @@ -2565,7 +2709,7 @@ if_trace(e,color_g_mesg('#772000', indentq2(Depth,defs_none_cached((F/A/AA)=X))))),!, eval_constructor(Eq,RetType,Depth,Self,X,Res). -eval_maybe_defn(Eq,RetType,Depth,Self,X,Y):- can_be_ok(eval_maybe_defn,X),!, +eval_maybe_defn_now(Eq,RetType,Depth,Self,X,Y):- can_be_ok(eval_maybe_defn,X),!, trace_eval(eval_defn_choose_candidates(Eq,RetType),'defn',Depth,Self,X,Y). eval_constructor(Eq,RetType,Depth,Self,X,Res):- @@ -2695,16 +2839,14 @@ findall_eval(_Eq,_RetType,_Dpth,_Slf,X,L):- self_eval(X),!,L=[X]. findall_eval(_Eq,_RetType,_Dpth,_Slf,X,L):- typed_list(X,_Type,L),!. findall_eval(Eq,RetType,Depth,Self,Funcall,L):- - findall_ne(E, - catch_metta_return(eval_args(Eq,RetType,Depth,Self,Funcall,E),E),L). + findall_ne(E,eval(Eq,RetType,Depth,Self,Funcall,E),L). %bagof_eval(Eq,RetType,Depth,Self,X,L):- bagof_eval(Eq,RetType,_RT,Depth,Self,X,L). %bagof_eval(Eq,RetType,Depth,Self,X,S):- bagof(E,eval_ne(Eq,RetType,Depth,Self,X,E),S)*->true;S=[]. bagof_eval(_Eq,_RetType,_Dpth,_Slf,X,L):- self_eval(X),!,L=[X]. bagof_eval(_Eq,_RetType,_Dpth,_Slf,X,L):- typed_list(X,_Type,L),!. bagof_eval(Eq,RetType,Depth,Self,Funcall,L):- - bagof_ne(E, - catch_metta_return(eval_args(Eq,RetType,Depth,Self,Funcall,E),E),L). + bagof_ne(E,eval(Eq,RetType,Depth,Self,Funcall,E),L). setof_eval(Depth,Self,Funcall,L):- setof_eval('=',_RT,Depth,Self,Funcall,L). setof_eval(Eq,RetType,Depth,Self,Funcall,S):- findall_eval(Eq,RetType,Depth,Self,Funcall,L), @@ -2720,7 +2862,7 @@ ((eval_args(Eq,RetType,Depth,Self,Funcall,E)) *-> is_returned(E);(fail,E=Funcall)). -is_returned(E):- notrace( \+ is_empty(E)). +is_returned(E):- notrace( \+ is_empty(E)), nop(assertion(E \== 'NotReducable')). is_empty(E):- notrace(( nonvar(E), sub_var('Empty',E))),!. diff --git a/.Attic/metta_lang/metta_interp.pl b/.Attic/metta_lang/metta_interp.pl index 2e704eb5c79..4f3817b26e4 100755 --- a/.Attic/metta_lang/metta_interp.pl +++ b/.Attic/metta_lang/metta_interp.pl @@ -368,8 +368,12 @@ :- use_module(library(shell)). %:- use_module(library(tabling)). -:- nb_setval(self_space, '&self'). -current_self(Self):- ((nb_current(self_space,Self),Self\==[])->true;Self='&self'). +use_top_self :- \+ fast_option_value('top-self', false). +top_self('&top'):- use_top_self,!. +top_self('&self'). + +%:- top_self(Self), nb_setval(self_space, '&self'), +current_self(Self):- ((nb_current(self_space,Self),Self\==[])->true;top_self(Self)). :- nb_setval(repl_mode, '+'). @@ -403,14 +407,15 @@ % Resource Limits option_value_name_default_type_help('stack-max', 500, [inf,1000,10_000], "Maximum stack depth allowed during execution", 'Resource Limits'). -all_option_value_name_default_type_help('maximum-result-count', inf, [inf,1,2,3,10], "Set the maximum number of results, infinite by default", 'Miscellaneous'). -option_value_name_default_type_help('limit', inf, [inf,1,2,3,10], "Set the maximum number of results, infinite by default", 'Miscellaneous'). +all_option_value_name_default_type_help('limit-result-count', inf, [inf,1,2,3,10], "Set the maximum number of results, infinite by default", 'Miscellaneous'). option_value_name_default_type_help('initial-result-count', 10, [inf,10], "For MeTTaLog log mode: print the first 10 answers without waiting for user", 'Miscellaneous'). % Miscellaneous option_value_name_default_type_help('answer-format', 'show', ['rust', 'silent', 'detailed'], "Control how results are displayed", 'Output and Logging'). option_value_name_default_type_help('repeats', true, [true, false], "false to avoid repeated results", 'Miscellaneous'). option_value_name_default_type_help('time', true, [false, true], "Enable or disable timing for operations (in Rust compatibility mode, this is false)", 'Miscellaneous'). +option_value_name_default_type_help('vn', true, [true, auto, false], "Enable or disable, (auto = enable but not if it breaks stuff) EXPERIMENTAL BUG-FIX where variable names are preserved (see https://github.com/trueagi-io/metta-wam/issues/221)", 'Miscellaneous'). +option_value_name_default_type_help('top-self', false, [false, true, auto], "Do not pretend &self==top", 'Miscellaneous'). % Testing and Validation option_value_name_default_type_help('synth-unit-tests', false, [false, true], "Synthesize unit tests", 'Testing and Validation'). @@ -443,6 +448,8 @@ option_value_name_default_type_help('repl-on-fail', false, [false, true], "Start REPL on failed unit test", 'Debugging and Tracing'). option_value_name_default_type_help('exit-on-fail', false, [true, false], "Rust exits on first Assertion Error", 'Debugging and Tracing'). +option_value_name_default_type_help('rrtrace', false, [false, true], "Extreme Tracing", 'Debugging and Tracing'). + % Define the possible values for various types % Verbosity values @@ -559,7 +566,8 @@ set_option_value_interp(N,V):- %(different_from(N,V)->Note=true;Note=false), Note = true, - fbugio(Note,set_option_value(N,V)),set_option_value(N,V), + %fbugio(Note,set_option_value(N,V)), + set_option_value(N,V), ignore(forall(on_set_value(Note,N,V),true)). on_set_value(Note,N,'True'):- on_set_value(Note,N,true). @@ -645,8 +653,10 @@ ). null_io(G):- null_user_output(Out), !, with_output_to(Out,G). -user_io(G):- current_prolog_flag(mettalog_rt, true), !, original_user_error(Out), ttyflush, !, with_output_to(Out,G), flush_output(Out), ttyflush. -user_io(G):- original_user_output(Out), ttyflush, !, with_output_to(Out,G), flush_output(Out), ttyflush. + +user_io(G):- notrace(user_io_0(G)). +user_io_0(G):- current_prolog_flag(mettalog_rt, true), !, original_user_error(Out), ttyflush, !, with_output_to(Out,G), flush_output(Out), ttyflush. +user_io_0(G):- original_user_output(Out), ttyflush, !, with_output_to(Out,G), flush_output(Out), ttyflush. user_err(G):- original_user_error(Out), !, with_output_to(Out,G). with_output_to_s(Out,G):- current_output(COut), redo_call_cleanup(set_prolog_IO(user_input, Out,user_error), G, @@ -666,8 +676,10 @@ % If output is not suspended, it captures the output based on the streams involved. % % @arg G The goal to be executed. -in_answer_io(_):- nb_current(suspend_answers,true),!. -in_answer_io(G) :- + +in_answer_io(G):- notrace((in_answer_io_0(G))). +in_answer_io_0(_):- nb_current(suspend_answers,true),!. +in_answer_io_0(G) :- % Get the answer_output stream answer_output(AnswerOut), % Get the current output stream @@ -856,6 +868,7 @@ :- ensure_loaded(metta_utils). %:- ensure_loaded(mettalog('metta_ontology.pfc.pl')). +:- ensure_loaded(metta_pfc_debug). :- ensure_loaded(metta_pfc_base). :- ensure_loaded(metta_pfc_support). :- ensure_loaded(metta_compiler). @@ -1094,7 +1107,7 @@ cmdline_load_metta(Phase,Self,[M|Rest]):- m_opt(M,Opt), is_cmd_option(Opt,M,TF), - fbug(is_cmd_option(Phase,Opt,M,TF)), + %fbug(is_cmd_option(Phase,Opt,M,TF)), set_option_value_interp(Opt,TF), !, %set_tty_color_term(true), cmdline_load_metta(Phase,Self,Rest). @@ -1311,6 +1324,7 @@ ignore(( \+ ((forall(load_hook0(Load,Hooked),true))))),!. +rtrace_on_error(G):- !, call(G). %rtrace_on_error(G):- catch(G,_,fail). rtrace_on_error(G):- catch_err(G,E, @@ -1358,7 +1372,7 @@ load_hook0(_,_):- \+ show_transpiler, !. % \+ is_transpiling, !. load_hook0(Load,Assertion):- assertion_hb(Assertion,Self,Eq,H,B), - functs_to_preds([Eq,H,B],Preds), + once(functs_to_preds([Eq,H,B],Preds)), assert_preds(Self,Load,Preds),!. % old compiler hook load_hook0(Load,Assertion):- @@ -1391,16 +1405,21 @@ :- dynamic(metta_atom_asserted/2). :- multifile(metta_atom_asserted/2). -:- dynamic(metta_atom_asserted_deduced/2). -:- multifile(metta_atom_asserted_deduced/2). +:- dynamic(metta_atom_deduced/2). +:- multifile(metta_atom_deduced/2). metta_atom_asserted(X,Y):- - metta_atom_asserted_deduced(X,Y), + metta_atom_deduced(X,Y), \+ clause(metta_atom_asserted(X,Y),true). %get_metta_atom(Eq,KB, [F|List]):- KB='&flybase',fb_pred(F, Len), length(List,Len),apply(F,List). +maybe_into_top_self(WSelf, Self):- use_top_self,WSelf=='&self',current_self(Self),Self\==WSelf,!. +into_top_self(WSelf, Self):- maybe_into_top_self(WSelf, Self),!. +into_top_self(Self, Self). + + get_metta_atom_from(KB,Atom):- metta_atom(KB,Atom). get_metta_atom(Eq,Space, Atom):- metta_atom(Space, Atom), \+ (Atom =[EQ,_,_], EQ==Eq). @@ -1410,46 +1429,62 @@ metta_atom(Space, Atom):- typed_list(Space,_,L),!, member(Atom,L). metta_atom(KB, [F, A| List]):- KB=='&flybase',fb_pred_nr(F, Len),current_predicate(F/Len), length([A|List],Len),apply(F,[A|List]). %metta_atom(KB,Atom):- KB=='&corelib',!, metta_atom_corelib(Atom). +%metta_atom(X,Y):- use_top_self,maybe_resolve_space_dag(X,XX),!,in_dag(XX,XXX),XXX\==X,metta_atom(XXX,Y). + +metta_atom(X,Y):- maybe_into_top_self(X, TopSelf),!,metta_atom(TopSelf,Y). +%metta_atom(X,Y):- var(X),use_top_self,current_self(TopSelf),metta_atom(TopSelf,Y),X='&self'. metta_atom(KB,Atom):- metta_atom_in_file( KB,Atom). metta_atom(KB,Atom):- metta_atom_asserted( KB,Atom). %metta_atom(KB,Atom):- KB == '&corelib', !, metta_atom_asserted('&self',Atom). -metta_atom(KB,Atom):- KB \== '&corelib', using_all_spaces,!, metta_atom('&corelib',Atom). -metta_atom(KB,Atom):- KB \== '&corelib', !, metta_atom('&corelib',Atom). -metta_atom(KB,Atom):- KB \== '&corelib', !, +%metta_atom(KB,Atom):- KB \== '&corelib', using_all_spaces,!, metta_atom('&corelib',Atom). +%metta_atom(KB,Atom):- KB \== '&corelib', !, metta_atom('&corelib',Atom). +metta_atom(KB,Atom):- KB \== '&corelib', !, % is_code_inheritor(KB), \+ \+ (metta_atom_asserted(KB,'&corelib'), should_inherit_from_corelib(Atom)), !, metta_atom('&corelib',Atom). should_inherit_from_corelib(_):- using_all_spaces,!. -should_inherit_from_corelib([H,A|_]):- H == ':',!,nonvar(A). -should_inherit_from_corelib([H|_]):- H == '@doc', !. +should_inherit_from_corelib([H,A|_]):- nonvar(A), should_inherit_op_from_corelib(H),!,nonvar(A). +%should_inherit_from_corelib([H|_]):- H == '@doc', !. should_inherit_from_corelib([H,A|T]):- fail, - H == '=',write_src_uo(try([H,A|T])),!,is_list(A), - A=[F|_],nonvar(F), F \==':', + H == '=',write_src_uo(try([H,A|T])),!, + A=[F|_],nonvar(F), F \==':',is_list(A), \+ metta_atom_asserted('&self',[:,F|_]), % \+ \+ metta_atom_asserted('&corelib',[=,[F|_]|_]), write_src_uo([H,A|T]). -/* -should_inherit_op_from_corelib('='). + +is_code_inheritor(KB):- current_self(KB). % code runing from a KB can see corlib +%should_inherit_op_from_corelib('='). should_inherit_op_from_corelib(':'). should_inherit_op_from_corelib('@doc'). %should_inherit_op_from_corelib(_). -*/ -metta_atom_asserted('&self','&corelib'). -metta_atom_asserted('&self','&stdlib'). + +%metta_atom_asserted('&self','&corelib'). +%metta_atom_asserted('&self','&stdlib'). +metta_atom_asserted(Top,'&corelib'):- top_self(Top). +metta_atom_asserted(Top,'&stdlib'):- top_self(Top). metta_atom_asserted('&stdlib','&corelib'). metta_atom_asserted('&flybase','&corelib'). +metta_atom_asserted('&flybase','&stdlib'). metta_atom_asserted('&catalog','&corelib'). metta_atom_asserted('&catalog','&stdlib'). -/* -'mod-space'(top,'&self'). +maybe_resolve_space_dag(Var,[XX]):- var(Var),!, \+ attvar(Var), freeze(XX,space_to_ctx(XX,Var)). +maybe_resolve_space_dag('&self',[Self]):- current_self(Self). +in_dag(X,XX):- is_list(X),!,member(XX,X). +in_dag(X,X). + +space_to_ctx(Top,Var):- nonvar(Top),current_self(Top),!,Var='&self'. +space_to_ctx(Top,Var):- 'mod-space'(Top,Var),!. +space_to_ctx(Var,Var). + +'mod-space'(top,'&top'). 'mod-space'(catalog,'&catalog'). 'mod-space'(corelib,'&corelib'). 'mod-space'(stdlib,'&stdlib'). -'mod-space'(Top,'&self'):- Top == self. -*/ +'mod-space'(Top,'&self'):- current_self(Top). + not_metta_atom_corelib(A,N):- A \== '&corelib' , metta_atom('&corelib',N). %metta_atom_asserted_fallback( KB,Atom):- metta_atom_stdlib(KB,Atom) @@ -1631,16 +1666,24 @@ never_compile(X):- always_exec(X). -always_exec(exec(W)):- !, is_list(W), always_exec(W). +always_exec(W):- var(W),!,fail. +always_exec([H|_]):- always_exec_symbol(H),!. always_exec(Comp):- compound(Comp),compound_name_arity(Comp,Name,N),symbol_concat('eval',_,Name),Nm1 is N-1, arg(Nm1,Comp,TA),!,always_exec(TA). +always_exec([H|_]):- always_exec_symbol(H),!. always_exec(List):- \+ is_list(List),!,fail. always_exec([Var|_]):- \+ symbol(Var),!,fail. always_exec(['extend-py!'|_]):- !, fail. -always_exec([H|_]):- symbol_concat(_,'!',H),!. %pragma!/print!/transfer!/include! etc always_exec(['assertEqualToResult'|_]):-!,fail. always_exec(['assertEqual'|_]):-!,fail. always_exec(_):-!,fail. % everything else +always_exec_symbol(Sym):- \+ symbol(Sym),!,fail. +always_exec_symbol(H):- symbol_concat(_,'!',H),!. %pragma!/print!/transfer!/bind!/include! etc +always_exec_symbol(H):- symbol_concat('add-atom',_,H),!. +always_exec_symbol(H):- symbol_concat('remove-atom',_,H),!. +always_exec_symbol(H):- symbol_concat('subst-',_,H),!. + + file_hides_results([W|_]):- W== 'pragma!'. if_t(A,B,C):- trace,if_t((A,B),C). @@ -1739,24 +1782,29 @@ ignore(( symbolic(Cmt),symbolic_list_concat([_,Src],'MeTTaLog: ',Cmt),!,atom_string(Src,SrcCode),do_metta(mettalog_only(From),Load,Self,SrcCode,Out))),!. do_metta(From,How,Self,Src,Out):- string(Src),!, - normalize_space(string(TaxM),Src), - convert_tax(How,Self,TaxM,Expr,NewHow),!, + must_det_ll((normalize_space(string(TaxM),Src), + convert_tax(How,Self,TaxM,Expr,NewHow))), do_metta(From,NewHow,Self,Expr,Out). do_metta(From,_,Self,exec(Expr),Out):- !, do_metta(From,exec,Self,Expr,Out). + + +% Prolog CALL do_metta(From,_,Self, call(Expr),Out):- !, do_metta(From,call,Self,Expr,Out). do_metta(From,_,Self, ':-'(Expr),Out):- !, do_metta(From,call,Self,Expr,Out). do_metta(From,call,Self,TermV,FOut):- !, if_t(into_simple_op(call,TermV,OP),pfcAdd_Now('next-operation'(OP))), call_for_term_variables(TermV,Term,NamedVarsList,X), must_be(nonvar,Term), copy_term(NamedVarsList,Was), - Output = NamedVarsList, - user:interactively_do_metta_exec(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut). + Output = X, + user:u_do_metta_exec(From,Self,call(TermV),Term,X,NamedVarsList,Was,Output,FOut). +% Non Exec do_metta(_File,Load,Self,Src,Out):- Load\==exec, !, if_t(into_simple_op(Load,Src,OP),pfcAdd_Now('next-operation'(OP))), dont_give_up(as_tf(asserted_do_metta(Self,Load,Src),Out)). +% Doing Exec do_metta(file(Filename),exec,Self,TermV,Out):- must_det_ll((inc_exec_num(Filename), get_exec_num(Filename,Nth), @@ -1780,10 +1828,12 @@ do_metta_exec(From,Self,TermV,FOut):- Output = X, %format("########################X0 ~w ~w ~w\n",[Self,TermV,FOut]), - (catch(((output_language(metta,write_exec(TermV)), + (catch((( + % Show exec from file(_) + if_t(From=file(_),output_language(metta,write_exec(TermV))), notrace(into_metta_callable(Self,TermV,Term,X,NamedVarsList,Was)),!, %format("########################X1 ~w ~w ~w ~w\n",[Term,X,NamedVarsList,Output]), - user:interactively_do_metta_exec(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut))), + user:u_do_metta_exec(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut))), give_up(Why),pp_m(red,gave_up(Why)))). %format("########################X2 ~w ~w ~w\n",[Self,TermV,FOut]). @@ -1794,13 +1844,79 @@ o_s(S,S). into_simple_op(Load,[Op|O],op(Load,Op,S)):- o_s(O,S),!. -call_for_term_variables(TermV,catch_red(show_failure(Term)),NamedVarsList,X):- - term_variables(TermV, AllVars), call_for_term_variables4v(TermV,AllVars,Term,NamedVarsList,X),!, - must_be(callable,Term). -call_for_term_variables(TermV,catch_red(show_failure(Term)),NamedVarsList,X):- - get_term_variables(TermV, DCAllVars, Singletons, NonSingletons), - call_for_term_variables5(TermV, DCAllVars, Singletons, NonSingletons, Term,NamedVarsList,X),!, - must_be(callable,Term). + +%! call_for_term_variables(+Term, +X, -Result, -NamedVarsList, +TF) is det. +% Handles the term `Term` and determines the term variable list and final result. +% This version handles the case when the term has no variables and converts it to a truth-functional form. +% +% @arg Term The input term to be analyzed. +% @arg X The list of variables found within the term. It can be empty or contain one variable. +% @arg Result The final result, either as the original term or transformed into a truth-functional form. +% @arg NamedVarsList The list of named variables associated with the term. +% @arg TF The truth-functional form when the term has no variables. +% +% @example +% % Example with no variables: +% ?- call_for_term_variables(foo, Result, Vars, TF). +% Result = as_tf(foo, TF), +% Vars = []. +% +call_for_term_variables(TermV,catch_red(show_failure(TermR)),NewNamedVarsList,X):- + subst_vars(TermV,Term,NamedVarsList), + wwdmsg(subst_vars(TermV,Term,NamedVarsList)), + term_variables(Term, AllVars), + %get_global_varnames(VNs), append(NamedVarsList,VNs,All), nb_setval('$variable_names',All), wdmsg(term_variables(Term, AllVars)=All), + term_singletons(Term, Singletons),term_dont_cares(Term, DontCares), + + wwdmsg((term_singletons(Term, Singletons),term_dont_cares(Term, DontCares))), + include(not_in_eq(Singletons), AllVars, NonSingletons), + wwdmsg([dc=DontCares, sv=Singletons, ns=NonSingletons]), !, + include(not_in_eq(DontCares), NonSingletons, CNonSingletons), + include(not_in_eq(DontCares), Singletons, CSingletons), + wwdmsg([dc=DontCares, csv=CSingletons, cns=CNonSingletons]),!, + maplist(maplist(into_named_vars), + [DontCares, CSingletons, CNonSingletons], + [DontCaresN, CSingletonsN, CNonSingletonsN]), + wwdmsg([dc_nv=DontCaresN, sv_nv=CSingletonsN, ns_nv=CNonSingletonsN]), + call_for_term_variables5(Term, DontCaresN, CNonSingletonsN, CSingletonsN, TermR, NamedVarsList, NewNamedVarsList, X),!, + wwdmsg(call_for_term_variables5(orig=Term, all=DontCaresN, singles=CSingletonsN, shared=CNonSingletonsN, call=TermR, nvl=NamedVarsList, nvlo=NewNamedVarsList, output=X)). + +wwdmsg(_). +% If the term is ground, return the as_tf form. +%call_for_term_variables5(Term,_,_,_,as_tf(Term,Ret),VL,['$RetVal'=Ret|VL],[==,['call!',Term],Ret]) :- ground(Term), !. +% If the term is ground, create a call_nth with the term. +call_for_term_variables5(Term,_,_,_,call_nth(Term,Count),VL,['Count'=Count|VL],Ret) :- Ret=Term. + + +into_metta_callable(_Self,CALL,Term,X,NamedVarsList,Was):- fail, + % wdmsg(mc(CALL)), + CALL= call(TermV), + \+ never_compile(TermV), + must_det_ll(((( + term_variables(TermV,Res), + % ignore(Res = '$VAR'('ExecRes')), + RealRes = Res, + TermV=ExecGoal, + %format("~w ~w\n",[Res,ExecGoal]), + subst_vars(Res+ExecGoal,Res+Term,NamedVarsList), + copy_term_g(NamedVarsList,Was), + term_variables(Term,Vars), + + + Call = do_metta_runtime(Res, ExecGoal), + output_language(prolog, notrace((color_g_mesg('#114411', print_pl_source(:- Call ))))), + %nl,writeq(Term),nl, + ((\+ \+ + (( + %numbervars(v(TermV,Term,NamedVarsList,Vars),999,_,[attvar(skip)]), + %nb_current(variable_names,NamedVarsList), + %nl,print(subst_vars(Term,NamedVarsList,Vars)), + nop(nl))))), + nop(maplist(verbose_unify,Vars)), + %NamedVarsList=[_=RealRealRes|_], + %var(RealRes), + X = RealRes)))),!. + into_metta_callable(_Self,TermV,Term,X,NamedVarsList,Was):- \+ never_compile(TermV), @@ -2035,8 +2151,12 @@ %:- ensure_loaded('../../examples/factorial'). %:- ensure_loaded('../../examples/fibonacci'). +extreme_tracing:- \+ fast_option_value(rrtrace, false),!. + %print_preds_to_functs:-preds_to_functs_src(factorial_tail_basic) -ggtrace(G):- call(G). +ggtrace(G):- extreme_tracing,!, rtrace(G). +ggtrace(G):- !, fail, call(G). +%ggtrace(G):- call(G). ggtrace0(G):- ggtrace, leash(-all), visible(-all), @@ -2323,7 +2443,7 @@ % Print the elapsed wall and CPU time with a description, output to user_error print_elapsed_time(WallElapsedTime, CPUElapsedTime, Description) :- with_output_to(user_error, - format(' % Walltime: ~9f seconds, CPUtime: ~9f seconds for ~w~n', + format('~N % Walltime: ~9f seconds, CPUtime: ~9f seconds for ~w~n', [WallElapsedTime, CPUElapsedTime, Description])). % Execute a Prolog query and handle output, performance logging, and time measurements to user_error diff --git a/.Attic/metta_lang/metta_loader.pl b/.Attic/metta_lang/metta_loader.pl index 60f993856d1..60b9d6ea3c1 100755 --- a/.Attic/metta_lang/metta_loader.pl +++ b/.Attic/metta_lang/metta_loader.pl @@ -883,9 +883,11 @@ % If Filename is not a valid symbol or file does not exist, handle wildcards for includes. (\+ symbol(Filename); \+ exists_file(Filename)),!, must_det_ll(with_wild_path(include_metta(Self), Filename)),!. -include_metta1(Self, RelFilename):- + +include_metta1(WSelf, RelFilename):- % Ensure RelFilename is a valid symbol and exists as a file. must_det_ll(( + into_top_self(WSelf, Self), symbol(RelFilename), exists_file(RelFilename),!, % Convert the relative filename to an absolute path. @@ -1539,6 +1541,7 @@ % % Convert "example.metta" to a `.qlf` format. % ?- convert_metta_to_loadable('example.metta', QlfFile). % +convert_metta_to_loadable(_Filename, _QlfFile) :- !, fail. convert_metta_to_loadable(_Filename, _QlfFile) :- % Use fast buffer, so skip Datalog conversion use_fast_buffer, !, fail. @@ -2573,7 +2576,7 @@ at_end_of_stream(S), !, F1 = end_of_file. new_parse_sexpr_metta_IO1(S, F1):- % Skip whitespace characters and continue parsing. - peek_char(S, Char), char_type(Char, space), !, get_char(S, Char), parse_sexpr_metta_IO(S, F1). + peek_char(S, Char), char_type(Char, space), !, get_char(S, Char), new_parse_sexpr_metta_IO1(S, F1). new_parse_sexpr_metta_IO1(S, _F1):- % Read and assert position and item details for non-whitespace characters. S = InStream, @@ -2596,7 +2599,7 @@ % @arg S The input stream to read from. % @arg F1 The resulting parsed form. % -new_parse_sexpr_metta_IO(S, F1):- new_parse_sexpr_metta_IO1(S, F1), nop(wdmsg(new_parse_sexpr_metta_IO1(S, F1))). +new_parse_sexpr_metta_IO(S, F1):- new_parse_sexpr_metta_IO1(S, F1),!. % nop(wdmsg(new_parse_sexpr_metta_IO1(S, F1))). %! in2_stream(+N1, -S1) is nondet. % @@ -3346,7 +3349,20 @@ % @arg NamedVarsList The list of named variables. % subst_vars(TermWDV, NewTerm, NamedVarsList) :- - subst_vars(TermWDV, NewTerm, [], NamedVarsList). + subst_vars(TermWDV, NewTerm, [], NamedVarsList), + if_t(fast_option_value('vn', 'true'), memorize_varnames(NamedVarsList)). + + +memorize_varnames(NamedVarsList):- \+ compound(NamedVarsList),!. +memorize_varnames([NamedVar|NamedVarsList]):- !, + memorize_varname(NamedVar), + memorize_varnames(NamedVarsList). +memorize_varnames(_). +memorize_varname(NamedVar):- \+ compound(NamedVar),!. +memorize_varname(Name=Var):- var(Var),atomic(Name),put_attr(Var,vn,Name). +memorize_varname(_). + + %! subst_vars(+Term, -Term, +Acc, -NamedVarsList) is det. % @@ -3633,11 +3649,11 @@ forall(metta_type('&corelib', Symb, Def), gen_interp_stubs('&corelib', Symb, Def)). -% Dynamic and multifile declaration for metta_atom_asserted_deduced/2. -:- dynamic(metta_atom_asserted_deduced/2). -:- multifile(metta_atom_asserted_deduced/2). +% Dynamic and multifile declaration for metta_atom_deduced/2. +:- dynamic(metta_atom_deduced/2). +:- multifile(metta_atom_deduced/2). -%! metta_atom_asserted_deduced(+Source, +Term) is nondet. +%! metta_atom_deduced(+Source, +Term) is nondet. % % Determines if a `Term` is part of the core library, logging the term if so. % @@ -3647,7 +3663,7 @@ % @arg Source The source of the term, expected to be `&corelib`. % @arg Term The term to verify. % -metta_atom_asserted_deduced('&corelib', Term) :- fail, +metta_atom_deduced('&corelib', Term) :- fail, % Log terms matching core library types. %\+ did_generate_interpreter_stubs, metta_atom_corelib_types(Term), diff --git a/.Attic/metta_lang/metta_parser.pl b/.Attic/metta_lang/metta_parser.pl index 61ff87fc098..2dae77f8111 100644 --- a/.Attic/metta_lang/metta_parser.pl +++ b/.Attic/metta_lang/metta_parser.pl @@ -206,6 +206,35 @@ svar_fixvarname(SVAR, UP):- integer(SVAR),UP=SVAR,!. svar_fixvarname(SVAR, UP):- svar(SVAR,UP),!. svar_fixvarname(SVAR, UP):- n_to_vn(UP,SVAR),!. +% convert_to_var_name(+Input, -VarName) +% Converts Input (atom or string) into a Prolog-legal variable name. +% It replaces illegal characters with underscores and then prefixes the name with '_'. +svar_fixvarname(Input, VarName) :- + % Convert input to character list + ( atom(Input) -> atom_chars(Input, Chars) + ; string(Input) -> string_chars(Input, Chars) + ), + % Transform each character into an allowed sequence + maplist(char_to_allowed_sequence, Chars, TransformedList), + % Flatten the list of lists into a single list of chars + flatten(TransformedList, SafeChars), + % Always prefix with '_' + VarChars = ['_'|SafeChars], + atom_chars(VarName, VarChars). + +% char_to_allowed_sequence(+Char, -Sequence) +% If Char is alphanumeric or '_', it is kept as is. +% Otherwise, convert it into '_'. +char_to_allowed_sequence(Char, [Char]) :- + (char_type(Char, alnum); Char == '_'), !. +char_to_allowed_sequence(Char, Sequence) :- + % Get ASCII code + char_code(Char, Code), + % Convert code to a list of digits + number_chars(Code, CodeChars), + % Build a sequence like ['_', '5', '4'] for Code = 54, for example + Sequence = ['_'|CodeChars]. + %! svar_fixname(?Var, ?NameO) is det. % @@ -231,6 +260,10 @@ svar_fixname('block'(Name), UP) :- % Handle 'block' variables. !, svar_fixvarname(Name, UP). + +svar_fixname('_', '_') :- !. +svar_fixname('', '__') :- !. + svar_fixname(SVAR, SVARO) :- % If the name is already valid, return it as is. ok_var_name(SVAR), !, SVARO = SVAR. @@ -279,8 +312,8 @@ fix_varcase(Word, Word) :- % If the word starts with '_', leave it unchanged. atom_concat_or_rtrace('_', _, Word), !. - fix_varcase(Word, WordC) :- string(Word),atom_string(Atom,Word),!,fix_varcase(Atom, WordC). +fix_varcase('', '__') :- !. fix_varcase(Word, WordC) :- atom(Word),downcase_atom(Word, UC),Word=UC,atom_concat('_',UC,WordC),!. fix_varcase(Word, WordC) :- % Convert the first letter to uppercase. @@ -778,12 +811,24 @@ % @arg Item The item read from the stream. read_sexpr(I,O):- string(I), open_string(I,S),!,read_sexpr(S,O). read_sexpr(I,O):- + catch(read_sexpr_or_error(I,O),E,handle_read_error(E)). + +handle_read_error(E):- + write_src_uo(E), + print_message(error,E), + %throw(E), + %throw('$aborted'), + !. + +read_sexpr_or_error(I,O):- setup_call_cleanup( flag('$file_src_ordinal',Ordinal,Ordinal+1_000_000), setup_call_cleanup( (nb_current('$file_src_depth', Lvl)->true;(Lvl=0,nb_setval('$file_src_depth', Lvl))), - cont_sexpr(is_delimiter(),I, O), + cont_sexpr(is_delimiter,I, O), b_setval('$file_src_depth', Lvl)), nop(flag('$file_src_ordinal',_,Ordinal))). + + %! cont_sexpr(+EndChar:atom, +Stream:stream, -Item) is det. % % Reads a single item (S-expression or comment) from the specified stream, handling different formats and encodings. @@ -791,8 +836,6 @@ % @arg EndChar that denotes the end of a symbol. % @arg Stream Stream from which to read. % @arg Item The item read from the stream. - - cont_sexpr(EndChar, Stream, Item):- skip_spaces(Stream), % Ignore whitespace before reading the expression. read_line_char(Stream, StartRange), @@ -802,23 +845,104 @@ push_item_range(Item, Range). -cont_sexpr_once(EndChar, Stream, Item):- - skip_spaces(Stream), % Ignore whitespace before reading the expression. +cont_sexpr_once(EndChar, Stream, Item) :- + skip_spaces(Stream), get_char(Stream, Char), - ( Char = '(' -> read_list(')', Stream, Item) % If '(', read an S-expression list. - ; Char = '[' -> (read_list(']', Stream, It3m), Item = ['[...]',It3m]) % If '[', read an S-expression list. - ; Char = '{' -> (read_list('}', Stream, It3m), Item = ['{...}',It3m]) % If '{', read an S-expression list. - ; Char = '"' -> read_quoted_string(Stream, '"', Item) % Read a quoted string. - ; (Char = '!', nb_current('$file_src_depth', 0)) -> (cont_sexpr_once(EndChar, Stream, Subr), Item = exec(Subr)) % Read called directive - ; Char = '\'' -> read_quoted_symbol(Stream, '\'', Item) % Read a quoted symbol. - ; Char = '`' -> read_quoted_symbol(Stream, '`', Item) % Read a backquoted symbol. - ; Char = end_of_file -> Item = end_of_file % If EOF, set Item to 'end_of_file'. - ; read_symbolic(EndChar, Stream, Char, Item) % Otherwise, read a symbolic expression. - ), !. + cont_sexpr_from_char(EndChar, Stream, Char, Item), !. + +% If EOF, return end_of_file +cont_sexpr_from_char(_EndChar, _Stream, end_of_file, end_of_file). + +% If '(', read an S-expression list. +cont_sexpr_from_char(_EndChar, Stream, '(', Item) :- + read_list(')', Stream, Item). + +% If '[', '{', etc. - using paren_pair +cont_sexpr_from_char(_EndChar, Stream, Char, Item) :- paren_pair(Char, EndOfParen, Functor), + read_list(EndOfParen, Stream, It3m), + Item = [Functor, It3m]. + +% Unexpected start character +cont_sexpr_from_char(EndChar, Stream, Char, Item) :- paren_pair(_, Char, _), + nb_current('$file_src_depth', 0), + sformat(Reason, "Unexpected start character: '~w'", [Char]), + throw_stream_error(Stream, syntax_error(unexpected_char(Char), Reason)), + % keep going we consumed the Char (if thorw_stream_error/2 permits) + cont_sexpr(EndChar, Stream, Item). + +% If '"', read a quoted string. +cont_sexpr_from_char(_EndChar, Stream, '"', Item) :- + read_quoted_string(Stream, '"', Item). + +% If '!' followed by '(', '#', or file depth 0, read a directive to be executed +cont_sexpr_from_char(EndChar, Stream, '!', Item) :- + ( peek_char(Stream, '(') + ; peek_char(Stream, '#') + ; nb_current('$file_src_depth', 0)), + cont_sexpr_once(EndChar, Stream, Subr), + Item = exec(Subr). + +% If '#' followed by '(', read SExpr as Prolog Expression +cont_sexpr_from_char(EndChar, Stream, '#', Item) :- peek_char(Stream, '('), + cont_sexpr_once(EndChar, Stream, Subr), + univ_maybe_var(Item, Subr). + +% If '#' followed by '{', read Prolog syntax until '}' and a period +cont_sexpr_from_char(_EndChar, Stream, '#', Item) :- peek_char(Stream, '{'), + read_prolog_syntax(Stream, Subr), + Subr = {Item}. + +% If '\'', read a quoted symbol. +cont_sexpr_from_char(_EndChar, Stream, '\'', Item) :- + read_quoted_symbol(Stream, '\'', Item). + +% If '`', read a backquoted symbol. +cont_sexpr_from_char(_EndChar, Stream, '`', Item) :- + read_quoted_symbol(Stream, '`', Item). + +% Otherwise, read a symbolic expression. +cont_sexpr_from_char(EndChar, Stream, Char, Item) :- + read_symbolic(EndChar, Stream, Char, Item). + can_do_level(0). can_do_level(_). +paren_pair('(',')',_). +paren_pair('{','}','{...}'). +paren_pair('[',']','[...]'). + +% #( : user #(load_metta_file &self various_syntaxes.metta) ) +univ_maybe_var(Item,[F|Subr]):- is_list(Subr), atom(F), Item =.. [F|Subr],!. +univ_maybe_var('#'(Subr),Subr):- !. + +read_prolog_syntax(Stream, Clause) :- + % Stop if at the end of the stream. + at_end_of_stream(Stream), !, Clause = end_of_file. +read_prolog_syntax(Stream, Clause) :- + % Handle errors while reading a clause. + catch(read_prolog_syntax_unsafe(Stream, Clause), E, + throw_stream_error(Stream,E)), !. +read_prolog_syntax_unsafe(Stream, Term) :- + % Set options for reading the clause with metadata. + Options = [ variable_names(Bindings), + term_position(Pos), + subterm_positions(RawLayout), + syntax_errors(error), + comments(Comments), + module(trans_mod)], + % Read the term with the specified options. + read_term(Stream, Term, Options), + ( (fail, Term == end_of_file) + -> true + ; % Store term position and variable names. + b_setval('$term_position', Pos), + nb_setval('$variable_names', Bindings), + % Display information about the term. + maplist(star_vars,Bindings), + nop(display_term_info(Stream, Term, Bindings, Pos, RawLayout, Comments))). + +star_vars(N=V):- ignore('$VAR'(N) = V). %! maybe_name_vars(+List) is det. % @@ -1106,12 +1230,13 @@ nb_current('$file_src_depth', LvL), flag('$file_src_ordinal',Ordinal,Ordinal+1), succ(LvL,LvLNext), - nb_setval('$file_src_depth', LvLNext), read_position(Stream, Line, Col, CharPos, _), + setup_call_cleanup( + nb_setval('$file_src_depth', LvLNext), catch(read_list_cont(EndChar, Stream, List), stream_error(_Where,Why), throw(stream_error(Line:Col:CharPos,Why))), - nb_setval('$file_src_depth', LvL). + nb_setval('$file_src_depth', LvL)). read_list_cont(EndChar, Stream, List) :- skip_spaces(Stream), % Skip any leading spaces before reading. @@ -1269,8 +1394,8 @@ % @arg Char Character to check. is_delimiter(Char) :- char_type(Char, space) ; % Space is a delimiter. - arg(_, v('(', ')', end_of_file), Char). % Other delimiters include parentheses and end of file. + arg(_, v( /*'(', ')', */ end_of_file), Char). % Other delimiters include parentheses and end of file. % Ensure the program runs upon initialization. -:- initialization(main_init, main). +% :- initialization(main_init, main). diff --git a/.Attic/metta_lang/metta_printer.pl b/.Attic/metta_lang/metta_printer.pl index b0f8bba9731..466b3702aef 100755 --- a/.Attic/metta_lang/metta_printer.pl +++ b/.Attic/metta_lang/metta_printer.pl @@ -148,7 +148,7 @@ % If Term is a list, apply list-specific formatting. is_list(Term), !, writeln('---------------------'), - numbervars(Term, 666, _, [attvar(bind)]), % Bind variables for display. + numbervars(Term, 666, _, [attvar(skip)]), % Bind variables for display. write((Msg)), write(':'), nl, write_src(Term), nl. ppct(Msg, Term) :- @@ -162,14 +162,14 @@ Term = (_ = _), !, writeln('---------------------'), write((Msg)), write(':'), nl, - numbervars(Term, 444, _, [attvar(bind)]), + numbervars(Term, 444, _, [attvar(skip)]), write_src(Term), nl. ppct(Msg, Term) :- % For clauses with specific formatting needs, include variable numbering and tree display. Term = (_ :- _), !, writeln('---------------------'), write((Msg)), write(':'), nl, - numbervars(Term, 222, _, [attvar(bind)]), + numbervars(Term, 222, _, [attvar(skip)]), print_tree(Term), nl. %! pp_metta(+P) is det. @@ -190,7 +190,8 @@ % pp_metta(P) :- % Standardize variable names in P for readability. - pretty_numbervars(P, PP), + %pretty_numbervars(P, PP), + P=PP, % Pretty-print PP with the `concepts=false` option. with_option(concepts=false, pp_fb(PP)). @@ -238,6 +239,8 @@ % Run the primary source-printing predicate within `run_pl_source/1`. run_pl_source(print_pl_source0(P)). +pnotrace(G):- quietly(G). + %! run_pl_source(+G) is det. % % Executes a goal `G` safely, catching any errors and attempting a retry with tracing if needed. @@ -273,13 +276,13 @@ % print_pl_source0(_) :- % Do not print if compatibility mode is enabled. - notrace(is_compatio), !. + pnotrace(is_compatio), !. print_pl_source0(_) :- % Do not print if silent loading mode is enabled. - notrace(silent_loading), !. + pnotrace(silent_loading), !. print_pl_source0(P) :- % Check if P was just printed (avoid redundant printing). - notrace((just_printed(PP), PP =@= P)), !. + pnotrace((just_printed(PP), PP =@= P)), !. print_pl_source0((A :- B)) :- % For rules (A :- B), display using portray_clause for readability. !,portray_clause((A :- B)). @@ -517,7 +520,7 @@ var(V), !, write_dvar(V), !. is_final_write('$VAR'(S)) :- % For '$VAR' structures, write the variable name S. - !, write_dvar(S), !. + !, write_dvar(S), !. is_final_write('#\\'(S)) :- % For special character format `#\S`, write S in single quotes. !, format("'~w'", [S]). @@ -554,13 +557,13 @@ % write_dvar(S) :- % If S is an underscore, output the name directly. - S == '_', !, write_dname(S). + S == '_', !, write('$_'). write_dvar(S) :- % If S is a double underscore, write `$` to represent it. S == '__', !, write('$'). write_dvar(S) :- % For an unbound variable, get its name and write it. - var(S), get_var_name(S, N), write_dname(N), !. + var(S), get_var_name(S, N), write_dvar(N), !. write_dvar(S) :- % For an unbound variable without a name, format it as `$`. var(S), !, format('$~p', [S]). @@ -710,47 +713,53 @@ % Writes the source of a term `V` with indentation enabled. % % This predicate sets indentation mode on by calling `with_indents/2` with `true`, -% and then writes the source of `V` using `write_src/1`. The use of `notrace/1` +% and then writes the source of `V` using `write_src/1`. The use of `pnotrace/1` % ensures that tracing is disabled during this operation. % % @arg V The term whose source is to be written with indentation. % write_src_wi(V) :- % Enable indentation and write the source of V. - notrace((with_indents(true, write_src(V)))). + pnotrace((with_indents(true, write_src(V)))). %! write_src(+V) is det. % % Writes the source of a term `V` after guessing Metta variables. % % This predicate first tries to identify variables in `V` using `guess_metta_vars/1` -% and then formats `V` for output using `pp_sex/1`. The `notrace/1` wrapper +% and then formats `V` for output using `pp_sex/1`. The `pnotrace/1` wrapper % ensures tracing is turned off. % % @arg V The term to be written as source. % write_src(V) :- % Guess variables in V and pretty-print using `pp_sex/1`. - \+ \+ notrace((src_vars(V, I), pp_sex(I))), !. + \+ \+ pnotrace((src_vars(V, I), pp_sex(I))), !. print_compounds_special:- true. +src_vars(V,I):- var(V),!,I=V. src_vars(V,I):- %ignore(guess_metta_vars(V)), - ignore(guess_varnames(V,I)), - ignore(numbervars(V,10000,_,[singleton(true),attvar(skip)])). - + pre_guess_varnames(V,II),ignore(II=V), + guess_varnames(II,I), + nop(ignore(numbervars(I,10000,_,[singleton(true),attvar(skip)]))). +pre_guess_varnames(V,I):- \+ compound(V),!,I=V. +pre_guess_varnames(V,I):- functor(V,F,A),functor(II,F,A), metta_file_buffer(_, _, _, II, Vs, _,_), Vs\==[], I=@=II, I=II, V=I,maybe_name_vars(Vs),!. +pre_guess_varnames(V,I):- is_list(V),!,maplist(pre_guess_varnames,V,I). +pre_guess_varnames(C,I):- compound_name_arguments(C,F,V),!,maplist(pre_guess_varnames,V,VV),compound_name_arguments(I,F,VV),!. +pre_guess_varnames(V,V). %! write_src_woi(+Term) is det. % % Writes the source of a term `Term` with indentation disabled. % % This predicate calls `with_indents/2` with `false` to disable indentation, -% and then writes `Term` using `write_src/1`. The `notrace/1` wrapper ensures +% and then writes `Term` using `write_src/1`. The `pnotrace/1` wrapper ensures % that tracing is disabled. % % @arg Term The term to be written without indentation. % write_src_woi(Term) :- % Disable indentation and write the source of Term. - notrace((with_indents(false, write_src(Term)))). + pnotrace((with_indents(false, write_src(Term)))). %! write_src_woi_nl(+X) is det. % @@ -764,7 +773,7 @@ % write_src_woi_nl(X) :- % Guess variables in X, add newlines, and write without indentation. - \+ \+ notrace(( + \+ \+ pnotrace(( format('~N'), write_src_woi(X), format('~N') )). diff --git a/.Attic/metta_lang/metta_python.pl b/.Attic/metta_lang/metta_python.pl index a8df8fed32c..13a1db7b22d 100755 --- a/.Attic/metta_lang/metta_python.pl +++ b/.Attic/metta_lang/metta_python.pl @@ -150,7 +150,7 @@ is_rust_space(GSpace),!. is_not_prolog_space(GSpace):- % Check if the space is neither an asserted space nor an nb space. - \+ is_asserted_space(GSpace),\+ is_nb_space(GSpace),!. + \+ is_asserted_space(GSpace), \+ is_nb_space(GSpace),!. %! with_safe_argv(:Goal) is det. % diff --git a/.Attic/metta_lang/metta_repl.pl b/.Attic/metta_lang/metta_repl.pl index 69d7c8ac26a..d91ebe034d3 100755 --- a/.Attic/metta_lang/metta_repl.pl +++ b/.Attic/metta_lang/metta_repl.pl @@ -152,6 +152,10 @@ % ?- save_history. % true. % +:- if(is_win64). +% Dummy to avoid errors on windows. +save_history. +:- else. save_history :- % Get the current input stream. current_input(Input), @@ -163,6 +167,7 @@ ; % Otherwise, do nothing. true). +:- endif. %! load_and_trim_history is det. % Loads and trims the REPL history if needed, and installs readline support. @@ -216,7 +221,7 @@ % Set the option 'doing_repl' to true. with_option('doing_repl', true, % Set the 'repl' option to true and then start repl2. - with_option(repl, true, repl2)). + with_option(repl, true, repl2)). %! repl2 is nondet. % The main loop of the REPL, responsible for managing history, garbage collection, and catching any errors. @@ -228,13 +233,14 @@ % repl2 :- % Load the REPL history and clean it up if necessary. - load_and_trim_history, + ignore(catch(load_and_trim_history,_,true)), + % Begin an infinite loop using repeat to keep REPL active. repeat, % Reset internal caches for better performance. - reset_caches, + notrace((reset_caches, % Force garbage collection to free memory. - garbage_collect, + garbage_collect)), % Execute repl3 and catch any errors that occur during execution. ignore(catch((ignore(catch(once(repl3), restart_reading, true))), % If an error occurs, print the reason and continue the loop. @@ -271,18 +277,24 @@ % metta> % repl3 :- - % Create the prompt by writing it to an atom `P`. - with_output_to(atom(P), write_metta_prompt), % Set up cleanup for the terminal prompt and execute repl4. - notrace(prompt(Was, P)), + notrace(prompt(Was, Was)), setup_call_cleanup( % Set the terminal prompt without tracing. - true, + notrace(set_metta_prompt), % Flush the terminal and call repl4 to handle input. ((ttyflush, repl4, ttyflush)), % After execution, restore the previous terminal prompt. notrace(prompt(_, Was))). +% Create the prompt by writing it to an atom `P`. +set_metta_prompt:- + with_output_to(atom(P), write_metta_prompt), + prompt1(P), + prompt(_, P). + + + %! repl4 is det. % Executes the REPL logic by reading the input, processing expressions, and handling directives or commands. % The loop is managed through exceptions (e.g., restarting or ending input). @@ -293,7 +305,7 @@ % repl4 :- % Reset the evaluation number to ensure expressions are counted properly. - ((reset_eval_num, + notrace((reset_eval_num, % Write the result of the previous evaluation (if any) to the output. write_answer_output, % The following command to reset terminal settings is commented out for now. @@ -307,16 +319,22 @@ % Check for any directives embedded in the expression and process them. (ignore(check_has_directive(Expr))), % Get the current self reference and reading mode for the REPL. - current_self(Self), current_read_mode(repl, Mode), + current_self(Self), current_read_mode(repl, Mode))), % Output the read expression for debugging purposes, if applicable. - nop(writeqln(repl_read(Expr))),!, + %nop(writeqln(repl_read(Expr))),!, % Evaluate the expression using the `do_metta/5` predicate. ignore(once((do_metta(repl_true, Mode, Self, Expr, O)))),!, % Optionally write the result of the evaluation to the source. - nop((write_src(O), nl)), + notrace((nop((write_src(O), nl)), % Throw `restart_reading` to restart the REPL input process after execution. nop(notrace(throw(restart_reading))))),!. +cls:- shell(clear). + +:- dynamic(metta_trace_restore/1). +store_metta_trace:- ignore((\+ metta_trace_restore(_), get_trace_reset(W),assert(metta_trace_restore(W)))),notrace. +restore_metta_trace:- notrace,ignore((retract(metta_trace_restore(W)),call(W))). + %! check_has_directive(+V) is nondet. % % Processes a given input `V` to determine if it contains a recognized directive @@ -407,31 +425,6 @@ % If the input stream is not provided, do nothing. read_pending_white_codes(_). -%! call_for_term_variables4v(+Term, +X, -Result, -NamedVarsList, +TF) is det. -% Handles the term `Term` and determines the term variable list and final result. -% This version handles the case when the term has no variables and converts it to a truth-functional form. -% -% @arg Term The input term to be analyzed. -% @arg X The list of variables found within the term. It can be empty or contain one variable. -% @arg Result The final result, either as the original term or transformed into a truth-functional form. -% @arg NamedVarsList The list of named variables associated with the term. -% @arg TF The truth-functional form when the term has no variables. -% -% @example -% % Example with no variables: -% ?- call_for_term_variables4v(foo, [], Result, Vars, true). -% Result = as_tf(foo, true), -% Vars = []. -% -call_for_term_variables4v(Term, [], as_tf(Term, TF), NamedVarsList, TF) :- - % Get global variable names for the term. - get_global_varnames(NamedVarsList), - % Succeed if no variables are present. - !. -% Handles the case when the term has one variable and passes the term as-is. -call_for_term_variables4v(Term, [X], Term, NamedVarsList, X) :- - % Get global variable names for the term. - get_global_varnames(NamedVarsList). %! balanced_parentheses(+Str) is semidet. % Checks if parentheses are balanced in a string or list of characters `Str`. @@ -458,25 +451,45 @@ % If input is already a list of characters, check the balance starting at count 0. balanced_parentheses(Chars) :- balanced_parentheses(Chars, 0). -%! balanced_parentheses(+Chars, +N) is semidet. -% Recursive helper predicate to check if parentheses are balanced in a list of characters `Chars`. -% The second argument `N` keeps track of the net balance of opening and closing parentheses. + +%! balanced_parentheses(+Chars, +N) is semidet. +% +% True when Chars contains a set of balanced parentheses. +% +% Recursive helper predicate to check if parentheses are balanced in a +% list of characters `Chars`. The second argument `N` keeps track of +% the net balance of opening and closing parentheses. % % @arg Chars A list of characters to process for balanced parentheses. -% @arg N A count tracking the net balance of open and close parentheses. +% @arg N An integer count tracking the net balance of open and close +% parentheses. % % @example % ?- balanced_parentheses(['(', ')', '(', ')'], 0). % true. % +% Raises unbalanced_parens warning when there are more '(' closing +% parentheses than open parentheses. The repl is then restart4ed. +% +% Example: +% metta+>()) +% Warning: Found unbalanced parentheses! +% metta+> +% balanced_parentheses([], 0). % Increment count when encountering an opening parenthesis. balanced_parentheses(['('|T], N) :- N1 is N + 1, !, balanced_parentheses(T, N1). % Decrement count when encountering a closing parenthesis, ensuring the count remains positive. balanced_parentheses([')'|T], N) :- N > 0, N1 is N - 1, !, balanced_parentheses(T, N1). +% If we have a ')' and the count is 0 or less, then we have a stray ')'. +balanced_parentheses([')'|_T], N) :- N =< 0, print_message(warning,unbalanced_parens), throw(restart_reading). % Skip any characters that are not parentheses. balanced_parentheses([H|T], N) :- H \= '(', H \= ')', !, balanced_parentheses(T, N). +prolog:message(unbalanced_parens) --> + ['Found unbalanced parentheses!'-[]]. + + %! next_expr(+ExprI, -Expr) is det. % % Processes the given expression and returns the next expression to be used. @@ -571,9 +584,10 @@ % repl_read_next(NewAccumulated, Expr) :- % Concatenate the input with '.' and try to interpret it as an atom. - symbol_concat(Atom,'.',NewAccumulated), + symbol_concat(_Atom,'.',NewAccumulated), % Attempt to read the term from the atom, handle errors and retry if necessary. - catch_err((read_term_from_atom(Atom, Term, []), Expr = call(Term)), E, + open_string(NewAccumulated,Stream), + catch_err((read_prolog_syntax_unsafe(Stream, Term), Expr = call(Term)), E, (((fail, write('Syntax error: '), writeq(E), nl, repl_read_next(Expr))))), !. % Previously commented: repl_read_next(Str, Expr):- ((clause(t_l:s_reader_info(Expr),_,Ref),erase(Ref))). @@ -587,8 +601,6 @@ % Handle input starting with '@'. repl_read_next(Str, Expr) :- symbol_concat('@', _, Str), !, atom_string(Expr, Str). -% Handle incorrect input with unbalanced parentheses. -repl_read_next(Str, _Expr) :- symbol_concat(')', _, Str), !, fbug(repl_read_syntax(Str)), throw(restart_reading). % Normalize spaces in the accumulated input and re-read if the normalized result is different. repl_read_next(NewAccumulated, Expr) :- fail, @@ -615,8 +627,12 @@ % Read the next line of input, accumulate it, and continue processing. repl_read_next(Accumulated, Expr) :- + if_t(flag(need_prompt,1,0),(nl,set_metta_prompt)), % Read a line from the current input stream. read_line_to_string(current_input, Line), + % switch prompts after the first line is read + format(atom(T),'| ~t',[]), + prompt(_,T), % Call repl_read_next with the new line concatenated to the accumulated input. repl_read_next(Accumulated, Line, Expr). @@ -684,7 +700,7 @@ current_input(Input), % If the input is from a terminal, add Str to the history using el_add_history/2. (((stream_property(Input, tty(true)))) -> - ((notrace(ignore(el_add_history(Input,Str))))) + ((notrace(ignore(catch(el_add_history(Input,Str),_,true))))) ; % Otherwise, do nothing. true), !. @@ -746,45 +762,6 @@ % Directive to set a global variable for variable names. :- nb_setval(variable_names, []). -%! call_for_term_variables5(+Term, +DC, +Vars1, +Vars2, -CallTerm, -DCVars, -TF) is det. -% -% Processes term variables and generates a call structure based on the provided term, -% handling cases with ground terms, single variables, and multiple variables. -% -% @arg Term The input term to process. -% @arg DC The direct constraints or variables list (can be empty). -% @arg Vars1 The first set of variables (e.g., `[Var=Value]` format). -% @arg Vars2 The second set of variables. -% @arg CallTerm The generated term call (e.g., `call_nth/2` or `as_tf/2`). -% @arg DCVars The combined list of variables or constraints. -% @arg TF The variable or value associated with the call. -% -% @example Handling a ground term: -% ?- call_for_term_variables5(hello, [], [], [], CallTerm, DCVars, TF). -% CallTerm = as_tf(hello, TF), -% DCVars = [], -% TF = _. -% -% @example Single variable case: -% ?- call_for_term_variables5(hello, [], [], [X=_], CallTerm, DCVars, TF). -% CallTerm = call_nth(hello, Count), -% DCVars = ['Count' = Count], -% TF = X. -% - % If the term is ground, return the as_tf form. -call_for_term_variables5(Term,[],[],[],as_tf(Term,TF),[],TF) :- ground(Term), !. - % If the term is ground, create a call_nth with the term. -call_for_term_variables5(Term,DC,[],[],call_nth(Term,TF),DC,TF) :- ground(Term), !. -% If there is one variable, set the term to call_nth. -call_for_term_variables5(Term,_,[],[_=Var],call_nth(Term,Count),['Count'=Count],Var). -% Similar case when the variable is reversed in arguments. -call_for_term_variables5(Term,_,[_=Var],[],call_nth(Term,Count),['Count'=Count],Var). -% If both term variables and equal variable are present, pass them along. -call_for_term_variables5(Term,_,Vars,[_=Var],Term,Vars,Var). -% Same case but with the variables reversed. -call_for_term_variables5(Term,_,[_=Var],Vars,Term,Vars,Var). -% Handle case with more than one variable, generating a call_nth. -call_for_term_variables5(Term,_,SVars,Vars,call_nth(Term,Count),[Vars,SVars],Count). %! is_interactive(+From) is nondet. % @@ -1026,8 +1003,8 @@ % For each clause of reset_cache, run the body in rtrace mode to handle errors. forall(clause(reset_cache, Body), forall(rtrace_on_error(Body), true)). -%! interactively_do_metta_exec(+From, +Self, +TermV, +Term, +X, +NamedVarsList, +Was, -Output, -FOut) is det. -% Executes a metta command interactively, handling potential errors and caching. +%! u_do_metta_exec(+From, +Self, +TermV, +Term, +X, +NamedVarsList, +Was, -Output, -FOut) is det. +% Executes a metta command (maybe interactively), handling potential errors and caching. % Resets caches and evaluates the execution command, catching any errors that occur. % % @arg From is the source of the interaction (e.g., REPL, file). @@ -1041,22 +1018,22 @@ % @arg FOut is the final output, after additional processing. % % @example -% ?- interactively_do_metta_exec(repl, self, TermV, my_term, X, NamedVarsList, Was, Output, FOut). +% ?- u_do_metta_exec(repl, self, TermV, my_term, X, NamedVarsList, Was, Output, FOut). % Output = ..., FOut = ... -interactively_do_metta_exec(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut) :- +u_do_metta_exec(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut) :- % Reset internal caches before executing the command. reset_caches, % Attempt to execute the command interactively, catching any errors. - catch(interactively_do_metta_exec00(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut), + catch(u_do_metta_exec00(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut), Error, % If an error occurs, log it along with the source and the term. write_src(error(Error,From,TermV))). each_pair_list(A-B,A,B). -%! interactively_do_metta_exec00(+From, +Self, +TermV, +Term, +X, +NamedVarsList, +Was, -Output, -FOut) is det. +%! u_do_metta_exec00(+From, +Self, +TermV, +Term, +X, +NamedVarsList, +Was, -Output, -FOut) is det. % A helper function that handles the core logic of the interactive metta execution, catching potential aborts. -% This is the next layer in the call stack after interactively_do_metta_exec/9. +% This is the next layer in the call stack after u_do_metta_exec/9. % % @arg From is the source of the interaction. % @arg Self is the current context or environment. @@ -1067,17 +1044,17 @@ % @arg Was is the previous state before execution. % @arg Output is the output generated from the execution. % @arg FOut is the final output, after additional processing. -interactively_do_metta_exec00(file(lsp(From)),Self,TermV,Term,X,NamedVarsList,Was,OutputL,FOutL):- fail, nonvar(From), !, - findall(Output-FOut,interactively_do_metta_exec01(repl_true,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut),List), +u_do_metta_exec00(file(lsp(From)),Self,TermV,Term,X,NamedVarsList,Was,OutputL,FOutL):- fail, nonvar(From), !, + findall(Output-FOut,u_do_metta_exec01(repl_true,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut),List), maplist(each_pair_list,List,OutputL,FOutL). -interactively_do_metta_exec00(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut) :- +u_do_metta_exec00(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut) :- % Attempt the actual execution and catch any '$aborted' exceptions. - catch(interactively_do_metta_exec01(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut), + catch(u_do_metta_exec01(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut), % Handle the '$aborted' exception by logging it. '$aborted', fbug(aborted(From,TermV))). -%! interactively_do_metta_exec01(+From, +Self, +_TermV, +Term, -X, +NamedVarsList, +Was, -VOutput, +FOut) is det. +%! u_do_metta_exec01(+From, +Self, +_TermV, +Term, -X, +NamedVarsList, +Was, -VOutput, +FOut) is det. % % Executes a term in a controlled interactive environment, handling history, skipping, and timing of results. % This predicate manages evaluation in an interactive session, possibly skipping certain executions based on file source and other conditions. @@ -1093,173 +1070,196 @@ % @arg FOut is the final output to be printed. % % @example -% ?- interactively_do_metta_exec01(file("example"), self, _, term(likes), Result, NamedVarsList, Was, Output, Final). +% ?- u_do_metta_exec01(file("example"), self, _, term(likes), Result, NamedVarsList, Was, Output, Final). % Result = likes(X,Y), % Output = "Execution Time: 1.5s", % Final = 'Completed Successfully'. % % @see reset_eval_num/0 for resetting evaluation counters, notrace/1 to suppress trace during execution, and lazy_findall/3 for lazy evaluation. +:- discontiguous u_do_metta_exec01/9. + % Handles interactive execution of mettalog commands, but skips execution if From is a file and results are hidden. -interactively_do_metta_exec01(file(_), Self, _TermV, Term, X, _NamedVarsList, _Was, _Output, _FOut) :- - % Checks if the term should hide results when sourced from a file - file_hides_results(Term), !, - % Evaluate arguments and return the result - eval_args(Self, Term, X). - -% Reset evaluation counter -interactively_do_metta_exec01(From,Self,_TermV,Term,X,NamedVarsList,Was,VOutput,FOut):- - %format("%%%%%%%%%%%%%%%%%%%%%%%%%2 ~w\n",[Term]), - notrace(( +u_do_metta_exec01(file(_), Self, _TermV, Term, X, _NamedVarsList, _Was, _Output, _FOut) :- + notrace(file_hides_results(Term)), !, % Checks if the term should hide results when sourced from a file + eval_args(Self, Term, X). % Evaluate arguments and return the result + +u_do_metta_exec01(From,Self,TermV,Term,X,NamedVarsList,Was,VOutput,FOut):- + notrace((flag(result_num,_,0), % Reset result number flag + reset_eval_num, % Reset evaluation counters for a fresh start + inside_assert(Term,BaseEval))), % Convert the current term into a base evaluation + (notrace(skip_do_metta_exec(From,Self,TermV,BaseEval,Term,X,NamedVarsList,Was,VOutput,FOut))-> true; + u_do_metta_exec02(From,Self,TermV,BaseEval,Term,X,NamedVarsList,Was,VOutput,FOut)). + +% --exec=skip +skip_do_metta_exec(From,Self,TermV,BaseEval,_Term,X,NamedVarsList,_Was,_VOutput,_FOut):- + option_value('exec',skip), From = file(_Filename), + \+ always_exec(BaseEval), \+ always_exec(TermV), + color_g_mesg('#da70d6', (write('; SKIPPING: '), write_src_woi(TermV))), + prolog_only(if_t((TermV\=@=BaseEval),color_g_mesg('#da70d6', (write('\n% Thus: '), writeq(eval_H(500,Self,BaseEval,X)),writeln('.'))))), + \+ \+ maybe_add_history(Self, BaseEval, NamedVarsList). + +maybe_add_history(Self, BaseEval, NamedVarsList) :- + % Prepare evaluation for the base term + PL=eval(Self,BaseEval,X), + user:maplist(name_vars, NamedVarsList), + user:name_vars('OUT' = X), + if_t(\+ option_value(doing_repl,true), + if_t(\+ option_value(repl,true), + if_t(option_value(prolog,true), add_history_pl(PL)))), + if_t(option_value(repl,true), add_history_src(exec(BaseEval))), - % Reset evaluation counters for a fresh start - reset_eval_num, + % Debug output in interactive mode, showing evaluated terms and results + prolog_only((color_g_mesg('#da70d6', (write('% DEBUG: '), writeq(PL), writeln('.'))))). + +u_do_metta_exec02(From,Self,TermV,BaseEval,Term,_X,NamedVarsList,Was,VOutput,FOut):- + notrace(( + if_t(is_interactive(From), \+ \+ maybe_add_history(Self, BaseEval, NamedVarsList)), + % Was --exec=skip but this is the type of directive we'd do anyways + if_t((From = file(_), option_value('exec',skip)), color_g_mesg('#da7036', (write('\n; Always-Exec: '), write_src_woi(TermV)))), % Initialize the result variable, with FOut to hold the final output Result = res(FOut), - % Placeholder for a previous result, starting with 'Empty' - Prev = prev_result('Empty'), + % If compatible, determine the evaluation mode (either 'leap' or 'each') + (is_compatio -> option_else(answer,Leap,leap) ; option_else(answer,Leap, each)), - % Assert the current term into a base evaluation - inside_assert(Term,BaseEval), + % Set options for maximum and initial result counts, infinite results if needed + option_else('limit-result-count',MaxResults,inf), + option_else('initial-result-count',InitialResults,10), - % If compatible, determine the evaluation mode (either 'leap' or 'each') - (is_compatio -> option_else(answer,Leap,leap) ; option_else(answer,Leap,each)), - - % Set options for maximum and initial result counts, infinite results if needed - option_else('maximum-result-count',MaxResults,inf), - option_else('initial-result-count',LeashResults,10), - - % Control variable initialized with max result count and leap control - Control = contrl(MaxResults,Leap), - Skipping = _, - - % Commented code for interactive control, previously enabled for file skipping - /* previously: if From = file(_Filename), option_value('exec',skip), \+ always_exec(BaseEval) */ - (((From = file(_Filename), option_value('exec',skip), \+ always_exec(BaseEval))) - -> ( - % Skip execution if conditions are met - GgGgGgGgGgG = (skip(Term),deterministic(Complete)), - % Mark as skipped - Skipping = 1,!, - % Previously: Output = "Skipped" - /* previously: color_g_mesg('#da70d6', (write('% SKIPPING: '), writeq(eval_H(500,Self,BaseEval,X)),writeln('.'))) */ - true - ) - ; % Otherwise, execute the goal interactively - GgGgGgGgGgG = ( - % Execute Term and capture the result - (( (Term),deterministic(Complete), - % Transform output for display and store it in the result - xform_out(VOutput,Output), nb_setarg(1,Result,Output)))), - !, % Ensure the top-level metta evaluation is completed - - % Reset result number flag - flag(result_num,_,0), + % Control variable initialized with max result count and leap control + Control = contrl(InitialResults,MaxResults,Leap), - % Prepare evaluation for the base term - PL=eval(Self,BaseEval,X), + GgGgGgGgGgG = ( + % Execute Term and capture the result + (( (Term),deterministic(Complete), % record if top-level metta evaluation is completed + % Transform output for display and store it in the result + notrace((xform_out(VOutput,Output), nb_setarg(1,Result,Output)))))), + + + % Placeholder for a previous result, starting with 'Empty' + Prev = prev_result('Empty'), - % Apply mappings and assignments, track result history if necessary - ( % with_indents(true, - \+ \+ (user:maplist(name_vars,NamedVarsList), - user:name_vars('OUT'=X), - /* previously: add_history_src(exec(BaseEval)) */ - if_t(Skipping==1,writeln(' ; SKIPPING')), - /* previously: if_t(TermV\=BaseEval,color_g_mesg('#fa90f6', (write('; '), with_indents(false,write_src(exec(BaseEval)))))) */ - - % Handle interactive result output or non-interactive result history - if_t((is_interactive(From);Skipping==1), - ( - if_t( \+ option_value(doing_repl,true), - if_t( \+ option_value(repl,true), - if_t( option_value(prolog,true), add_history_pl(PL)))), - if_t(option_value(repl,true), add_history_src(exec(BaseEval))))), - - % Debug output in interactive mode, showing evaluated terms and results - prolog_only((color_g_mesg('#da70d6', (write('% DEBUG: '), writeq(PL),writeln('.'))))), - true))))), - - % Print formatted answer output - in_answer_io(format('~n[')),!, + % Print formatted answer output + in_answer_io(format('~n[')))),!, % Interactive looping with possible timing and stepping control - (forall_interactive( + ( + forall_interactive( From, WasInteractive,Complete, %may_rtrace - (timed_call(GgGgGgGgGgG,Seconds)), - ((((((Complete==true->!;true), - %repeat, - set_option_value(interactive,WasInteractive), - Control = contrl(Max,DoLeap), - nb_setarg(1,Result,Output), - current_input(CI), - read_pending_codes(CI,_,[]), - flag(result_num,R,R+1), - flag(result_num,ResNum,ResNum), - reset_eval_num, - %not_compatio(format('~N')), maybe more space between answers? - - user_io(( - in_answer_io(if_t((Prev\=@=prev_result('Empty')),write(', '))), - nb_setarg(1,Prev,Output))), - - - output_language(answers,(if_t(ResNum=(old_not_compatio(format('~N~nDeterministic: ', [])), !); %or Nondet - /* previously: handle deterministic result output */ - (Complete==true -> (old_not_compatio(format('~N~nLast Result(~w): ',[ResNum])),! ); - old_not_compatio(format('~N~nNDet Result(~w): ',[ResNum]))))), - ignore((( - if_t( \+ symbolic(Output), not_compatio(nop(nl))), - %if_t(ResNum==1,in_answer_io(format('~N['))), - % user_io - (with_indents(is_mettalog, - color_g_mesg_ok(yellow, - \+ \+ - (maybe_name_vars(NamedVarsList), - old_not_compatio(write_bsrc(Output)), - true)))) )) ))))), - in_answer_io(write_asrc((Output))), - - not_compatio(extra_answer_padding(format('~N'))), % Just in case, add some virt space between answers - - ((Complete \== true, WasInteractive, DoLeap \== leap, - LeashResults > ResNum, ResNum < Max) -> Stepping = true ; Stepping = false), - - %if_debugging(time,with_output_to(user_error,give_time('Execution',Seconds))), - if_t((Stepping==true;Complete==true),if_trace(time,color_g_mesg_ok(yellow,(user_io(give_time('Execution',Seconds)))))), - %with_output_to(user_error,give_time('Execution',Seconds)), - %user_io(give_time('Execution',Seconds)), - %not_compatio(give_time('Execution',Seconds), - color_g_mesg(green, - ignore((NamedVarsList \=@= Was ->(not_compatio(( - reverse(NamedVarsList,NamedVarsListR), - maplist(print_var,NamedVarsListR), nop(nl)))) ; true))))), - ( - (Stepping==true) -> - (old_not_compatio(write("~npress ';' for more solutions ")),get_single_char_key(C), - old_not_compatio((writeq(key=C),nl)), + timed_call(GgGgGgGgGgG,Seconds), + + + ((( + + %(Complete==true->!;true), + + ((print_result_output(WasInteractive,Complete,ResNum,Prev,NamedVarsList,Control,Result,Seconds,Was,Output,Stepping))), + + (ResNum >= MaxResults -> ! ; true), + + + Cut = _, + Next = _, + ((Stepping==true) -> + (repeat, + old_not_compatio(format("~npress ';' for more solutions ")),get_single_char_key(C), + old_not_compatio((writeq(key=C),nl)), (C=='b' -> (once(repl),fail) ; - (C=='m' -> make ; - (C=='t' -> (nop(set_debug(eval,true)),rtrace) ; - (C=='T' -> (set_debug(eval,true)); - (C==';' -> true ; - (C==esc('[A',[27,91,65]) -> nb_setarg(2, Control, leap) ; - (C=='L' -> nb_setarg(1, Control, ResNum) ; - (C=='l' -> nb_setarg(2, Control, leap) ; - (((C=='\n');(C=='\r')) -> (!,fail); - (!,fail)))))))))))); - - (Complete\==true, \+ WasInteractive, Control = contrl(Max,leap)) -> true ; - (((Complete==true ->! ; true))))), not_compatio(extra_answer_padding(format('~N~n'))))) - *-> (ignore(Result = res(FOut)),ignore(Output = (FOut))) - ; (flag(result_num,ResNum,ResNum),(ResNum==0-> - (in_answer_io(nop(write('['))),old_not_compatio(format('~N~n~n')),!,true);true))), - in_answer_io(write(']\n')), + (C=='B' -> (once(prolog),fail) ; + (C=='a' -> (notrace(abort),fail) ; + (C=='e' -> (notrace(halt(5)),fail) ; + (C=='m' -> (make,fail) ; + (C=='c' -> (trace,Next=true) ; + (C==' ' -> (trace,Next=true) ; + (C=='t' -> (nop(set_debug(eval,true)),rtrace,Next=true) ; + (C=='T' -> (set_debug(eval,true),Next=true); + (C=='?' -> (print_debug_help,fail)) ; + (C==';' -> Next=true ; + (C==esc('[A',[27,91,65]) -> (Cut=true,Next=false) ; + (C==esc('[B',[27,91,66]) -> (nb_setarg(3, Control, leap),Cut=false,Next=true) ; + (C=='L' -> nb_setarg(2, Control, ResNum) ; + (C=='l' -> (nb_setarg(3, Control, leap),Next=true) ; + (((C=='\n');(C=='\r')) -> (Cut=false,nb_setarg(3, Control, leap),Next=true); + (C=='g' -> write_src(exec(TermV)); + (C=='s' -> (Cut=true,Next=false); + (true -> (write('Unknown Char'),fail))))))))))))))))))), + (nonvar(Next);nonvar(Cut))) ; true), + + ((Complete==true;Cut==true) ->! ; true), + (nonvar(Next)->Next==true; true), + ((flag(result_num,ResNum,ResNum),ResNum >= MaxResults) -> (!,fail) ; true) + /*(Complete\==true, \+ WasInteractive, Control = contrl(_,_,leap)) -> true ; + + )), + not_compatio(extra_answer_padding(format('~N~n'))) + )*/ + + ))) + ) *-> % Each forall_interactive + (((flag(result_num,ResNum,ResNum),ResNum >= MaxResults) -> ! ; true),ignore(Result = res(FOut)),ignore(Output = (FOut))) + ; % Last forall_interactive + (flag(result_num,ResNum,ResNum),(ResNum==0-> (old_not_compatio(format('~N;; no-results ;; ~n')),!,true);true)) + + ), + + in_answer_io((write(']'),if_t(\+is_mettalog,nl))), + flag(need_prompt,_,1), ignore(Result = res(FOut)). +print_result_output(WasInteractive,Complete,ResNum,Prev,NamedVarsList,Control,Result,Seconds,Was,Output,Stepping):- + set_option_value(interactive,WasInteractive), + Control = contrl(LeashResults,Max,DoLeap), + assertion(LeashResults==inf;number(LeashResults)), + assertion(Max==inf;number(Max)), + nb_setarg(1,Result,Output), + current_input(CI), read_pending_codes(CI,_,[]), + flag(result_num,R,R+1), + flag(result_num,ResNum,ResNum), + reset_eval_num, + %not_compatio(format('~N')), maybe more space between answers? + + user_io(( + in_answer_io(if_t((Prev\=@=prev_result('Empty')),write(', '))), + nb_setarg(1,Prev,Output))), + + + output_language(answers,(if_t(ResNum=(old_not_compatio(format('~N~nDeterministic: ', [])), !); %or Nondet + /* previously: handle deterministic result output */ + (Complete==true -> (old_not_compatio(format('~N~nR(~w): ',[ResNum])),! ); + old_not_compatio(format('~N~nN(~w): ',[ResNum]))))), + ignore((( + if_t( \+ symbolic(Output), not_compatio(nop(nl))), + %if_t(ResNum==1,in_answer_io(format('~N['))), + % user_io + (with_indents(is_mettalog, + color_g_mesg_ok(yellow, + \+ \+ + (maybe_name_vars(NamedVarsList), + old_not_compatio(write_bsrc(Output)), + true)))) )) ))))), + + in_answer_io(write_asrc((Output))), + + + ((Complete \== true, WasInteractive, DoLeap \== leap, + LeashResults =< ResNum, ResNum < Max) -> Stepping = true ; Stepping = false), + + %if_debugging(time,with_output_to(user_error,give_time('Execution',Seconds))), + if_t((Stepping==true;Complete==true),if_trace(time,color_g_mesg_ok(yellow,(user_io(give_time('Execution',Seconds)))))), + + color_g_mesg(green, + ignore((NamedVarsList \=@= Was ->(not_compatio(( + reverse(NamedVarsList,NamedVarsListR), + maplist(print_var,NamedVarsListR), nop(nl)))) ; true))). + + + + +%old_not_compatio(_G):- \+ is_testing, !. old_not_compatio(G):- call(G),ttyflush. %! maybe_assign(+N_V) is det. @@ -1372,7 +1372,7 @@ % Execute the goal. Goal, % If the goal is complete, quietly execute 'After', otherwise negate 'After'. - (Complete == true -> (quietly(After), !) ; (quietly(\+ After))). + (Complete == true -> (quietly(After), !) ; ( \+ quietly(After))). %! print_var(+Name, +Var) is det. % @@ -1449,7 +1449,11 @@ % write_bsrc(Var):- Var=='Empty',!,write(Var). % Special case: write 'Empty' directly. write_bsrc(Var):- ground(Var),!,write_bsrc1(Var). % If the variable is ground, write it directly. -write_bsrc(Var):- copy_term(Var,Copy,Goals),Var=Copy,write_bsrc_goal(Var,Goals). % For non-ground terms, handle goals. +write_bsrc(Var):- copy_term(Var,Copy,Goals),Var=Copy, + exclude(excluded_hidden_goal,Goals,UnhiddenGoals), + write_bsrc_goal(Var,UnhiddenGoals). % For non-ground terms, handle goals. + +excluded_hidden_goal(name_variable(_,_)). %! write_bsrc_goal(+Var, +Goals) is det. % @@ -1976,12 +1980,18 @@ % This installs readline/editline support, allowing for line editing and history during input. :- dynamic(is_installed_readline_editline/1). :- volatile(is_installed_readline_editline/1). + +:- if(is_win64). +% dummy for on windows +install_readline_editline. +:-else. install_readline_editline :- % Get the current input stream. current_input(Input), % Install readline support for the current input. install_readline(Input), !. +:- endif. %! el_wrap_metta(+Input) is det. % @@ -2278,28 +2288,28 @@ % % ?- print_help. % -print_help :- +print_debug_help :- % Print each available debugger command with its description. writeln('Debugger commands:'), writeln('(;) next - Retry with next solution.'), writeln('(g) goal - Show the current goal.'), - writeln('(u) up - Finish this goal without interruption.'), + %writeln('(u) up - Finish this goal without interruption.'), writeln('(s) skip - Skip to the next solution.'), writeln('(c) creep or - Proceed step by step.'), writeln('(l) leap - Leap over (the debugging).'), - writeln('(f) fail - Force the current goal to fail.'), - writeln('(B) back - Go back to the previous step.'), + %writeln('(f) fail - Force the current goal to fail.'), + %writeln('(B) back - Go back to the previous step.'), writeln('(t) trace - Toggle tracing on or off.'), writeln('(e) exit - Exit the debugger.'), writeln('(a) abort - Abort the current operation.'), writeln('(b) break - Break to a new sub-REPL.'), - writeln('(h) help - Display this help message.'), - writeln('(A) alternatives - Show alternative solutions.'), + writeln('(?) help - Display this help message.'), + %writeln('(A) alternatives - Show alternative solutions.'), writeln('(m) make - Recompile/Update the current running code.'), - writeln('(C) compile - Compile a fresh executable (based on the running state).'), - writeln('(E) error msg - Show the latest error messages.'), - writeln('(r) retry - Retry the previous command.'), - writeln('(I) info - Show information about the current state.'), + %writeln('(C) compile - Compile a fresh executable (based on the running state).'), + %writeln('(E) error msg - Show the latest error messages.'), + %writeln('(r) retry - Retry the previous command.'), + %writeln('(I) info - Show information about the current state.'), !. diff --git a/.Attic/metta_lang/metta_space.pl b/.Attic/metta_lang/metta_space.pl index aeaa6be1cad..9d1a65eba2a 100755 --- a/.Attic/metta_lang/metta_space.pl +++ b/.Attic/metta_lang/metta_space.pl @@ -377,7 +377,8 @@ % @example Clear all atoms from a space: % ?- 'clear-atoms'('my_space'). % -'clear-atoms'(SpaceNameOrInstance) :- +'clear-atoms'(DynSpace) :- + into_top_self(DynSpace, SpaceNameOrInstance), % Log the operation of clearing atoms from the specified space. dout(space, ['clear-atoms', SpaceNameOrInstance]), % Retrieve the appropriate method for clearing the space based on its type. @@ -404,7 +405,8 @@ % @example Add an atom to a space: % ?- 'add-atom'('my_space', my_atom). % -'add-atom'(SpaceNameOrInstance, Atom) :- +'add-atom'(DynSpace, Atom) :- + into_top_self(DynSpace, SpaceNameOrInstance), % Retrieve the method for adding an atom based on the space type. ((space_type_method(Type, add_atom, Method), % Ensure the space type matches by calling the type predicate. @@ -447,7 +449,8 @@ % @example Remove an atom from a space: % ?- 'remove-atom'('my_space', my_atom). % -'remove-atom'(SpaceNameOrInstance, Atom) :- +'remove-atom'(DynSpace, Atom) :- + into_top_self(DynSpace, SpaceNameOrInstance), % Log the operation of removing an atom from the specified space. dout(space, ['remove-atom', SpaceNameOrInstance, Atom]), % Retrieve the method for removing an atom based on the space type. @@ -494,7 +497,8 @@ % @example Replace an atom in a space: % ?- 'replace-atom'('my_space', old_atom, new_atom). % -'replace-atom'(SpaceNameOrInstance, Atom, New) :- +'replace-atom'(DynSpace, Atom, New) :- + into_top_self(DynSpace, SpaceNameOrInstance), dout(space, ['replace-atom', SpaceNameOrInstance, Atom, New]), space_type_method(Type, replace_atom, Method), call(Type, SpaceNameOrInstance), @@ -536,7 +540,8 @@ % ?- 'atom-count'(env, Count). % Count = 10. % -'atom-count'(SpaceNameOrInstance, Count) :- +'atom-count'(DynSpace, Count) :- + into_top_self(DynSpace, SpaceNameOrInstance), dout(space, ['atom-count', SpaceNameOrInstance]), space_type_method(Type, atom_count, Method), call(Type, SpaceNameOrInstance), !, @@ -568,7 +573,8 @@ % ?- get-atoms('env1', Atoms). % Atoms = [atomA, atomB, atomC]. % -'get-atoms'(SpaceNameOrInstance, AtomsL) :- +'get-atoms'(DynSpace, AtomsL) :- + into_top_self(DynSpace, SpaceNameOrInstance), % Output a debug message indicating the 'get-atoms' request to the space. dout(space, ['get-atoms', SpaceNameOrInstance]), % Determine the method for retrieving atoms based on the space type. @@ -598,7 +604,8 @@ % @example Iterate over atoms in a space: % ?- 'atoms_iter'('my_space', Iter). % -'atoms_iter'(SpaceNameOrInstance, Iter) :- +'atoms_iter'(DynSpace, Iter) :- + into_top_self(DynSpace, SpaceNameOrInstance), dout(space, ['atoms_iter', SpaceNameOrInstance]), space_type_method(Type, atoms_iter, Method), call(Type, SpaceNameOrInstance), @@ -621,7 +628,8 @@ % @example Match atoms in a space: % ?- 'atoms_match'('my_space', Atoms, my_template, else_clause). % -'atoms_match'(SpaceNameOrInstance, Atoms, Template, Else) :- +'atoms_match'(DynSpace, Atoms, Template, Else) :- + into_top_self(DynSpace, SpaceNameOrInstance), space_type_method(Type, atoms_match, Method), call(Type, SpaceNameOrInstance), !, @@ -642,7 +650,8 @@ % @example Query a space for an atom: % ?- 'space_query'('my_space', query_atom, Result). % -'space_query'(SpaceNameOrInstance, QueryAtom, Result) :- +'space_query'(DynSpace, QueryAtom, Result) :- + into_top_self(DynSpace, SpaceNameOrInstance), space_type_method(Type, query, Method), call(Type, SpaceNameOrInstance), !, @@ -663,7 +672,8 @@ % ?- subst_pattern_template('example_space', some_pattern, Template). % Template = [substituted_atom1, substituted_atom2]. % -subst_pattern_template(SpaceNameOrInstance, Pattern, Template) :- +subst_pattern_template(DynSpace, Pattern, Template) :- + into_top_self(DynSpace, SpaceNameOrInstance), % Log the operation for traceability. dout(space, [subst_pattern_template, SpaceNameOrInstance, Pattern, Template]), % Match and substitute atoms in the given space according to the pattern. @@ -689,10 +699,12 @@ % ?- was_asserted_space('&self'). % true. % -was_asserted_space('&self'). +was_asserted_space('&self'):- current_self(X), (X=='&self'->true;was_asserted_space(X)). was_asserted_space('&stdlib'). was_asserted_space('&corelib'). was_asserted_space('&flybase'). +was_asserted_space('&top'). +was_asserted_space('&catalog'). /* was_asserted_space('&attentional_focus'). was_asserted_space('&belief_events'). @@ -715,12 +727,13 @@ % ?- is_asserted_space('&self'). % true. % -is_asserted_space(X) :- - was_asserted_space(X). +is_asserted_space(X) :- was_asserted_space(X). +/* is_asserted_space(X) :- \+ is_as_nb_space(X), \+ py_named_space(X), !. +*/ %! is_python_space_not_prolog(+Space) is nondet. % @@ -1335,9 +1348,12 @@ % % Get the atom count for a loaded context. % ?- atom_count_provider(some_context, Count). % -atom_count_provider(Self, Count) :- + + +atom_count_provider(SpaceNameOrInstance, Count) :- + into_top_self(SpaceNameOrInstance, DynSpace), % Check if the context has been loaded into a knowledge base (KB). - user:loaded_into_kb(Self, Filename), + user:loaded_into_kb(DynSpace, Filename), % Retrieve the associated predicate for the given filename. once(user:asserted_metta_pred(Mangle, Filename)), % Derive a related predicate from the original. @@ -1354,8 +1370,9 @@ predicate_property(Data, number_of_rules(RC)), % Calculate the atom count as the difference between clauses and rules. Count is CC - RC. -atom_count_provider(KB, Count) :- +atom_count_provider(SpaceNameOrInstance, Count) :- must_det_ll(( + into_top_self(SpaceNameOrInstance, KB), % Predicate for asserted atoms. AMA = metta_atom_asserted, % Declare the predicate with arity 2. @@ -1405,7 +1422,8 @@ % % Iterate over atoms in 'example_kb' and retrieve them. % ?- metta_assertdb_iter('example_kb', Atom). % -metta_assertdb_iter(KB, Atoms) :- +metta_assertdb_iter(SpaceNameOrInstance, Atoms) :- + into_top_self(SpaceNameOrInstance, KB), % Dynamically construct the predicate for the given KB. MP =.. [metta_atom, KB, Atoms], % Call the constructed predicate to retrieve atoms. @@ -1426,7 +1444,8 @@ % % Execute a query against the KB and bind variables. % ?- metta_iter_bind('example_kb', my_query(X), Vars, ['X']). % -metta_iter_bind(KB, Query, Vars, VarNames) :- +metta_iter_bind(SpaceNameOrInstance, Query, Vars, VarNames) :- + into_top_self(SpaceNameOrInstance, KB), % Extract all variables from the query. term_variables(Query, QVars), % Align the provided variable names with the query variables. @@ -1459,7 +1478,8 @@ % % Query the KB and retrieve bound variables. % ?- space_query_vars('example_kb', my_query(X), Vars). % -space_query_vars(KB, Query, Vars) :- +space_query_vars(SpaceNameOrInstance, Query, Vars) :- + into_top_self(SpaceNameOrInstance, KB), % Check if the knowledge base is an asserted space. is_asserted_space(KB), !, % Declare the predicate for asserted atoms with arity 2. diff --git a/.Attic/metta_lang/metta_subst.pl b/.Attic/metta_lang/metta_subst.pl index 59b13682fd4..3d1b7162251 100755 --- a/.Attic/metta_lang/metta_subst.pl +++ b/.Attic/metta_lang/metta_subst.pl @@ -65,7 +65,7 @@ self_subst('True'). self_subst('False'). self_subst('F'). %' -:- nb_setval(self_space, '&self'). % ' +%:- nb_setval(self_space, '&self'). % ' substs_to(XX,Y):- Y==XX,!. substs_to(XX,Y):- Y=='True',!, is_True(XX),!. %' diff --git a/.Attic/metta_lang/metta_testing.pl b/.Attic/metta_lang/metta_testing.pl index 907f1bac43d..18e75b384a2 100755 --- a/.Attic/metta_lang/metta_testing.pl +++ b/.Attic/metta_lang/metta_testing.pl @@ -245,13 +245,38 @@ % @example % % Apply color formatting directly: % ?- our_ansi_format(green, 'Success: ~w', ['All tests passed']). -our_ansi_format(C, Fmt, Args) :- - % If Color is not an atom, apply ansi_format directly. - \+ atom(C), % set_stream(current_output,encoding(utf8)), - ansi_format(C, Fmt, Args). -our_ansi_format(C, Fmt, Args) :- - % If Color is atomic, set the foreground color and format the output. - our_ansi_format([fg(C)], Fmt, Args). +% +our_ansi_format(C, Fmt, Args):- +% This better be a list of ansi_format/3 attributes because we're not +% checking that. Those can be compound fg, bg etc terms, or single atoms +% denoting not font style, e.g. bold (but not colour!). + is_list(C), + !, + ansi_format(C,Fmt,Args). +% ansi_format/3 accepts as its first argument a single compound term +% denoting a colour attribute, as well as a list thereof. The following +% clause deals with single, arity-1 compounds. Acceptable attribute +% terms are found in the SWI-Prolog documentation. +our_ansi_format(CT, Fmt, Args):- + compound(CT), + CT =.. [Attr,_C], + memberchk(Attr,[fg,bg,hfg,hbg,fg8,bg8]), + !, + ansi_format(CT,Fmt,Args). +% The Attribute term may be an arity-3 compound with arguments for R, G +% and B values. +our_ansi_format(CT, Fmt, Args):- + compound(CT), + CT =.. [Attr,_R,_G,_B], + memberchk(Attr,[fg,bg]), + !, + ansi_format(CT,Fmt,Args). +% If the colour term is a single atom, then it's probably our shortcut +% for "use this colour in the forergound". +our_ansi_format(C, Fmt, Args):- + atom(C), + ansi_format([fg(C)],Fmt,Args). + %! print_current_test is det. % @@ -384,7 +409,7 @@ % Increments the success counter. flag(loonit_success, X, X + 1), !, % Displays a success message in cyan color. - color_g_mesg(cyan, write_src(loonit_success(G))), !. + color_g_mesg(cyan, write_src_wi(loonit_success(G))), !. %! write_pass_fail(+TestDetails, +Status, +Goal) is det. % @@ -829,7 +854,7 @@ loonit_asserts1(TestSrc,Pre,G) :- fail, sub_var('BadType',TestSrc), \+ check_type,!, write('\n!check_type (not considering this a failure)\n'), - color_g_mesg('#D8BFD8',write_src(loonit_failureR(G))),!, + color_g_mesg('#D8BFD8',write_src_wi(loonit_failureR(G))),!, ignore((( option_value('on-fail','trace'), setup_call_cleanup(debug(metta(eval)),call((Pre,G)),nodebug(metta(eval)))))). @@ -837,7 +862,7 @@ loonit_asserts1(TestSrc, Pre, G) :- % Handle failed Goal by logging, flagging failure, and optionally tracing. must_det_ll(( - color_g_mesg(red, write_src(loonit_failureR(G))), + color_g_mesg(red, write_src_wi(loonit_failureR(G))), write_pass_fail(TestSrc, 'FAIL', G), flag(loonit_failure, X, X + 1), % Optional trace or REPL on failure based on settings. diff --git a/.Attic/metta_lang/metta_types.pl b/.Attic/metta_lang/metta_types.pl index 4bc87550e47..60cc59dd6e8 100755 --- a/.Attic/metta_lang/metta_types.pl +++ b/.Attic/metta_lang/metta_types.pl @@ -441,7 +441,7 @@ % Ensure no repeated types using no_repeats_var/1. no_repeats_var(NoRepeatType), % Retrieve the type of the value. - get_type_each(Depth, Self, Val, Type), + get_type_each(Depth, Self, Val, Type), Type\=='', % Ensure the type matches the expected no-repeat type. NoRepeatType = Type, Type = TypeO, @@ -452,7 +452,7 @@ % % Succeeds if only the first matching type should be returned. % -return_only_first_type :- +return_only_first_type :- fail, % Check if the flag is set to true. true_flag. @@ -471,6 +471,7 @@ % Use no_repeats to ensure uniqueness in space type methods. no_repeats(Test, space_type_method(Test, _, _)), % Call the test to determine the space type. + is_not_prolog_space \== Test, call(Test, Space), !. %! is_state_type(+State, -Type) is nondet. @@ -1310,7 +1311,7 @@ % ignored_args_conform(Depth, Self, A, L) :- % If either Args or List is not a conz structure, succeed without further checks. - (\+ iz_conz(Args); \+ iz_conz(List)), !. + (\+ iz_conz(A); \+ iz_conz(L)), !. ignored_args_conform(Depth, Self, A, L) :- % Check if each argument conforms to its corresponding expected type. maplist(ignored_arg_conform(Depth, Self), A, L). @@ -1365,7 +1366,7 @@ nonvar(L), is_nonspecific_type(L), !. arg_conform(Depth, Self, A, L) :- % Check the argument type and verify it conforms to the expected type. - get_type(Depth, Self, A, T), + get_type_each(Depth, Self, A, T), T \== 'Var', type_conform(T, L), !. % arg_conform(_Dpth, _Slf, _, _). % arg_conform(Depth, Self, A, _) :- get_type(Depth, Self, A, _), !. @@ -1380,7 +1381,8 @@ type_conform(T, L) :- % Succeed if the types are equal. T = L, !. -type_conform(T, L) :- +type_conform(T, L) :- \+ is_nonspecific_type(T), \+ is_nonspecific_type(L), !, can_assign(T, L). +type_conform(T, L) :- fail, % Succeed if either type is non-specific. \+ \+ (is_nonspecific_type(T); is_nonspecific_type(L)), !. type_conform(T, L) :- @@ -1515,11 +1517,10 @@ % @note The commented-out duplicate clause remains for reference. % % set_type(Depth, Self, Var, Type) :- nop(set_type(Depth, Self, Var, Type)), !. -set_type(Depth, Self, Var, Type) :- - nop(set_type(Depth, Self, Var, Type)), !. +% set_type(Depth, Self, Var, Type) :- freeze(Obj, get_type(D, Self, Obj,Type)),!. set_type(Depth, Self, Var, Type) :- % Retrieve the current types of the variable. - get_types(Depth, Self, Var, TypeL), + (get_types(Depth, Self, Var, TypeL) -> true ; TypeL = []), % Add the new type to the list if necessary. add_type(Depth, Self, Var, TypeL, Type). @@ -1533,16 +1534,18 @@ % @arg TypeList The current list of types for the variable. % @arg Type The new type to add. % -add_type(_Depth, _Self, Var, _TypeL, _Type) :- - % If the variable is not bound, do nothing. - \+ nonvar(Var), !. add_type(_Depth, _Self, _Var, TypeL, Type) :- % If the type is already in the list, do nothing. \+ \+ (member(E, TypeL), E == Type), !. -add_type(_Depth, Self, _Var, TypeL, Type) :- +add_type(_Depth, Self, Var, TypeL, Type) :- var(Var), !, % Add the new type to the list and set it as an attribute. append([Type], TypeL, TypeList), put_attr(Var, metta_type, Self = TypeList). +add_type(_Depth, _Self, Var, TypeL, Type) :- + ignore(append(_,[Type|_], TypeL)),!. + % If the variable is not bound, do nothing. + + %! can_assign(+Was, +Type) is nondet. % @@ -1556,12 +1559,15 @@ % ?- can_assign('Number', 'Number'). % true. % -can_assign(Was, Type) :- - % If either type is non-specific, assignment is allowed. - (is_nonspecific_type(Was); is_nonspecific_type(Type)), !. -can_assign(Was, Type) :- - % If the types are identical, assignment is allowed. - Was = Type, !. + +% If the types are identical, assignment is allowed. +can_assign(Was, Type) :- nonvar(Was),nonvar(Type), + formated_data_type(Was),formated_data_type(Type),!,Type==Was. +% If the types are identical, assignment is allowed. +can_assign(Was, Type) :- Was = Type, !. +% If either type is non-specific, assignment is allowed. +can_assign(Was, Type) :- nonvar(Was),nonvar(Type), (is_nonspecific_type(Was); is_nonspecific_type(Type)), !. + %can_assign(Was,Type):- (Was=='Nat';Type=='Nat'),!,fail. %can_assign(Was,Type):- \+ cant_assign_to(Was,Type). %can_assign(_Ws,_Typ). @@ -1607,6 +1613,7 @@ is_nonspecific_type0('%Undefined%'). is_nonspecific_type0('ErrorType'). +is_nonspecific_type0('Expression'). % is_nonspecific_type([]). is_nonspecific_type0('Atom'). is_nonspecific_type0(Any) :- diff --git a/.Attic/metta_lang/metta_utils.pl b/.Attic/metta_lang/metta_utils.pl index 0a36cf0eda6..4c99b236f61 100755 --- a/.Attic/metta_lang/metta_utils.pl +++ b/.Attic/metta_lang/metta_utils.pl @@ -860,7 +860,7 @@ % to `t` or when the system is running in CGI mode. % % The `notrace/0` predicate is used to disable tracing. -%never_rrtrace:-!. +never_rrtrace:- \+ extreme_tracing,!. never_rrtrace :- % If `cant_rrtrace` is currently set to `t`, disable tracing using `notrace`. nb_current(cant_rrtrace, t),!,notrace. @@ -1237,7 +1237,8 @@ always_rethrow(time_limit_exceeded). always_rethrow(depth_limit_exceeded). always_rethrow(restart_reading). -always_rethrow(E):- never_rrtrace,!,throw(E). +%always_rethrow(E):- never_rrtrace,!,throw(E). +%always_rethrow(_). %! catch_non_abort(:Goal) is det. % @@ -1446,14 +1447,14 @@ :- set_prolog_flag(mettalog_error,unset). %:- set_prolog_flag(mettalog_error,break). %:- set_prolog_flag(mettalog_error,keep_going). -on_mettalog_error(Why):- current_prolog_flag(mettalog_error,break),!,write_src_uo(on_mettalog_error(break,Why)),break. +on_mettalog_error(Why):- (current_prolog_flag(mettalog_error,break);extreme_tracing),!,bt,write_src_uo(on_mettalog_error(Why)),trace. on_mettalog_error(Why):- write_src_uo(on_mettalog_error(Why)). % super safety checks is optional code that can be ran .. normally this is done with assertion/1 but unfortionately assertion/1 is not guarenteed to keep bindings and can be said to be wrapped in `once/1` super_safety_checks(G):- (call(G)*->true;on_mettalog_error(super_safety_checks(failed(G)))). % If there is an error, log it, perform a stack dump -ugtrace(Why, _):- notrace((write_src_uo(ugtrace(Why,G)),stack_dump, write_src_uo(ugtrace(Why,G)), fail)). +%ugtrace(Why, _):- notrace((write_src_uo(ugtrace(Why,G)),stack_dump, write_src_uo(ugtrace(Why,G)), fail)). ugtrace(Why, _):- on_mettalog_error(Why), fail. % If tracing is already enabled, log the reason and trace the goal G. @@ -1462,7 +1463,7 @@ % If testing is enabled, handle the failure and abort. ugtrace(Why, _):- is_testing, !, ignore(give_up(Why, 5)), throw('$aborted'). % Otherwise, log the reason, trace the goal G, and abort. -ugtrace(Why, G):- fbugio(Why), ggtrace(G), throw('$aborted'). +ugtrace(Why, G):- fbugio(Why), nortrace, notrace, trace, ggtrace(G), throw('$aborted'). % ugtrace(Why,G):- ggtrace(G). %! give_up(+Why, +N) is det. @@ -1510,7 +1511,7 @@ % ?- rrtrace(my_wrapper, my_goal). % % If reversible tracing is disabled, log the message and fail. -rrtrace(P1, X):- never_rrtrace, !, nop((u_dmsg(cant_rrtrace(P1, X)))), !, fail. +rrtrace(P1, X):- never_rrtrace, !, ((u_dmsg(cant_rrtrace(P1, X)))), !, fail. % If in a CGI environment, log the HTML output and call the goal normally. rrtrace(P1, G):- is_cgi, !, u_dmsg(arc_html(rrtrace(P1, G))), call(P1, G). % If not in a GUI tracer environment, disable tracing and call the goal, or enable interactive tracing (itrace). diff --git a/.Attic/metta_lang/stdlib_mettalog.metta b/.Attic/metta_lang/stdlib_mettalog.metta index ac7b0f52aa8..45bb95eb2ba 100644 --- a/.Attic/metta_lang/stdlib_mettalog.metta +++ b/.Attic/metta_lang/stdlib_mettalog.metta @@ -97,26 +97,34 @@ (= (If False $then) (let $n 0 (let $n 1 $n))) (= (If $cond $then $else) (if $cond $then $else)) +(@doc type-check + (@desc "The value of type-check determines MeTTa's type-checking behavior. Set via pragma!. When set to auto (i.e. !(pragma! type-check auto)), types are checked immediately on adding an expression to the space. By default, when unset (or set to anything other than auto), types are checked only on evaluation. For example !(+ 1 \"2\") would trigger a type violation, but (= (foo $x) (+ $x \"2\")) would not, unless type-check is set to auto, in which case both would trigger type violations.")) +(: type-check Symbol) + (iz predicate-arity MeTTaLog) (@doc predicate-arity (@desc "Specifies the arity (number of arguments) for a given predicate, allowing it to be queriable in the system's match framework. This is particularly useful for enabling built-in functions, such as `size-atom`, to be used as predicates in declarative contexts and run in reverse to compute inputs based on outputs. + For example: ; Enable the built-in function `size-atom` that takes an atom and returns the size as a predicate with arity 2 - (add-atom &dyn-space (predicate-arity size-atom 2)) + (predicate-arity size-atom 2) + ; Now `size-atom` can be used as a predicate in pattern matching - (match &dyn-space '(size-atom (a b c) $size) + !(match &dyn-space '(size-atom (a b c) $size) (The abc tuple was len $size)) ; This pattern will resolve `Size = 3` and execute the action. + Additionally, by running `size-atom` in reverse, you can compute a new atom based on a desired size: - (match &dyn-space '(size-atom $new-atom 4) + !(match &dyn-space '(size-atom $new-atom 4) (The new atom is $new-atom)) ; This resolves `$new-atom` to a tuple of size 4, such as ($1 $2 $3 $4). + This reverse functionality is made possible because predicates can describe relationships, allowing you to infer inputs from outputs.") (@params ( (@param "Predicate symbol" "The name of the predicate whose arity is being defined.") @@ -128,32 +136,43 @@ This reverse functionality is made possible because predicates can describe rela (function-arity predicate-arity 1) + + (@doc function-arity (@desc "Defines the arity of a function, allowing predicates or built-in facts to also behave as callable functions. This enables procedural-style execution where the last argument of the predicate becomes the function's return value, and the system internally resolves the function using a `match` query. + For example: - ; Declare the built-in predicate `max` with arity 2 - (predicate-arity max 2) + ; Declare the built-in predicate `max` with arity 3 + (predicate-arity max 3) ; Enable `max` as a function - (add-atom &dyn-space (function-arity max 2)) + (function-arity max 2) + ; Define the rules for `max` - (add-atom &dyn-space (max $X $Y $X) (<= $X $Y)) - (add-atom &dyn-space (max $X $Y $Y) (> $X $Y)) + (= (max $X $Y $Y) (<= $X $Y)) + (= (max $X $Y $X) (> $X $Y)) + ; Using `max` declaratively as a predicate - (match &dyn-space (max (5 10) $max) + !(match &self (max (5 10) $max) (The maximum is $max)) - ; This resolves `$max = 10`. + [(The maximum is 10)] + ; Using `max` procedurally as a function - (max 5 10) - ; Returns: 10. + !(max 5 10) + [10] + + ; Reverse execution with `max` - (max $pair 10) - ; Returns: a pair such as (8 10) or (10 5) where the maximum is 10. + !(let True (== (max $a $b) 10) ($a $b)) ; as a function + [(#(exists $a (=< $a 10)) 10), (10 #(exists $b (=< 10 $b )))] + !(match &self (max $a $b 10) ($a $b)) ; or as a predicate + [(#(exists $a (=< $a 10)) 10), (10 #(exists $b (=< 10 $b )))] + This dual behavior allows predicates to act as functions, bridging procedural and declarative paradigms. By defining `function-arity`, the function automatically resolves using the logic of the associated predicate.") (@params ( @@ -164,6 +183,7 @@ For example: (predicate-arity function-arity 2) (function-arity function-arity 1) + ;; If Function (iz If MeTTa) @@ -312,7 +332,9 @@ For example: (@params ( (@param "Value to be returned"))) (@return "Passed argument")) -(: return (-> $t $t)) +; probably should be (: return (-> $t $t)) +(: return (-> Atom Atom)) + (iz function MinimalMeTTa) (@doc function diff --git a/.Attic/metta_lang/swi_support.pl b/.Attic/metta_lang/swi_support.pl index ba11db40559..6cdcfdf3c6d 100755 --- a/.Attic/metta_lang/swi_support.pl +++ b/.Attic/metta_lang/swi_support.pl @@ -343,6 +343,7 @@ \+ atom(NA), !. p2mE(false, 'False'). % Convert false to 'False'. p2mE(true, 'True'). % Convert true to 'True'. +p2mE(E, N):- atom(E), atom_number(E, NN),!,NN=N. p2mE(E, E). % Leave other values unchanged. %! set_option_value(+Name, +Value) is det. diff --git a/prolog/metta_lang/metta_eval.pl b/prolog/metta_lang/metta_eval.pl index cf378f7a3de..f34644a4249 100755 --- a/prolog/metta_lang/metta_eval.pl +++ b/prolog/metta_lang/metta_eval.pl @@ -150,7 +150,7 @@ % is_metta_declaration([F|T]):- is_list(T), is_user_defined_head([F]),!. % Sets the current self space to '&self'. This is likely used to track the current context or scope during the evaluation of Metta code. -%:- nb_setval(self_space, '&self'). +:- nb_setval(self_space, '&self'). %current_self(Space):- nb_current(self_space,Space). @@ -278,8 +278,8 @@ % % this next one at least causes no failures and 5x speedup subst_args_here(_Eq,_RetType,_Depth2,_Self,Y,YO):- wont_need_subst(Y),!, Y=YO. subst_args_here(Eq,RetType,Depth2,Self,Y,YO):- - subst_args(Eq,RetType,Depth2,Self,Y,YO), - %Y =YO, + %subst_args(Eq,RetType,Depth2,Self,Y,YO), + Y =YO, notrace(if_t_else((wont_need_subst(Y),Y\=@=YO), (write_src_uo(needed_subst_args(Y,YO)),bt,sleep(1.0)), nop(write_src_uo(unneeded_subst_args(Y))))). @@ -1547,12 +1547,9 @@ % Placeholder to deal with formatting {:} later format_args_get_format(FormatRest, FormatRest, _). -format_args_write(Arg,_) :- \+ compound(Arg), !, format_arg(Arg). -format_args_write('#\\'(Char),_) :- !, format_arg(Char). -format_args_write(Arg,_) :- format_arg(Arg). - -format_arg(Arg) :- string(Arg), !, write(Arg). -format_arg(Arg):- \+ \+ write_src_woi(Arg). +format_args_write(Arg,_) :- string(Arg), !, write(Arg). +format_args_write('#\\'(Arg),_) :- !, write(Arg). +format_args_write(Arg,_) :- write_src_woi(Arg). format_nth_args([], _, _). format_nth_args(['{','{'|FormatRest], Iterator, Args) :- !, put('{'), format_nth_args(FormatRest, Iterator, Args). % escaped diff --git a/prolog/metta_lang/metta_interp.pl b/prolog/metta_lang/metta_interp.pl index 4f3817b26e4..b2fe793540c 100755 --- a/prolog/metta_lang/metta_interp.pl +++ b/prolog/metta_lang/metta_interp.pl @@ -368,12 +368,8 @@ :- use_module(library(shell)). %:- use_module(library(tabling)). -use_top_self :- \+ fast_option_value('top-self', false). -top_self('&top'):- use_top_self,!. -top_self('&self'). - -%:- top_self(Self), nb_setval(self_space, '&self'), -current_self(Self):- ((nb_current(self_space,Self),Self\==[])->true;top_self(Self)). +:- nb_setval(self_space, '&self'). +current_self(Self):- ((nb_current(self_space,Self),Self\==[])->true;Self='&self'). :- nb_setval(repl_mode, '+'). @@ -414,8 +410,7 @@ option_value_name_default_type_help('answer-format', 'show', ['rust', 'silent', 'detailed'], "Control how results are displayed", 'Output and Logging'). option_value_name_default_type_help('repeats', true, [true, false], "false to avoid repeated results", 'Miscellaneous'). option_value_name_default_type_help('time', true, [false, true], "Enable or disable timing for operations (in Rust compatibility mode, this is false)", 'Miscellaneous'). -option_value_name_default_type_help('vn', true, [true, auto, false], "Enable or disable, (auto = enable but not if it breaks stuff) EXPERIMENTAL BUG-FIX where variable names are preserved (see https://github.com/trueagi-io/metta-wam/issues/221)", 'Miscellaneous'). -option_value_name_default_type_help('top-self', false, [false, true, auto], "Do not pretend &self==top", 'Miscellaneous'). +option_value_name_default_type_help('vn', auto, [auto, true, false], "Enable or disable, (auto = enable but not if it breaks stuff) EXPERIMENTAL BUG-FIX where variable names are preserved (see https://github.com/trueagi-io/metta-wam/issues/221)", 'Miscellaneous'). % Testing and Validation option_value_name_default_type_help('synth-unit-tests', false, [false, true], "Synthesize unit tests", 'Testing and Validation'). @@ -1415,11 +1410,6 @@ %get_metta_atom(Eq,KB, [F|List]):- KB='&flybase',fb_pred(F, Len), length(List,Len),apply(F,List). -maybe_into_top_self(WSelf, Self):- use_top_self,WSelf=='&self',current_self(Self),Self\==WSelf,!. -into_top_self(WSelf, Self):- maybe_into_top_self(WSelf, Self),!. -into_top_self(Self, Self). - - get_metta_atom_from(KB,Atom):- metta_atom(KB,Atom). get_metta_atom(Eq,Space, Atom):- metta_atom(Space, Atom), \+ (Atom =[EQ,_,_], EQ==Eq). @@ -1429,26 +1419,22 @@ metta_atom(Space, Atom):- typed_list(Space,_,L),!, member(Atom,L). metta_atom(KB, [F, A| List]):- KB=='&flybase',fb_pred_nr(F, Len),current_predicate(F/Len), length([A|List],Len),apply(F,[A|List]). %metta_atom(KB,Atom):- KB=='&corelib',!, metta_atom_corelib(Atom). -%metta_atom(X,Y):- use_top_self,maybe_resolve_space_dag(X,XX),!,in_dag(XX,XXX),XXX\==X,metta_atom(XXX,Y). - -metta_atom(X,Y):- maybe_into_top_self(X, TopSelf),!,metta_atom(TopSelf,Y). -%metta_atom(X,Y):- var(X),use_top_self,current_self(TopSelf),metta_atom(TopSelf,Y),X='&self'. metta_atom(KB,Atom):- metta_atom_in_file( KB,Atom). metta_atom(KB,Atom):- metta_atom_asserted( KB,Atom). %metta_atom(KB,Atom):- KB == '&corelib', !, metta_atom_asserted('&self',Atom). -%metta_atom(KB,Atom):- KB \== '&corelib', using_all_spaces,!, metta_atom('&corelib',Atom). +metta_atom(KB,Atom):- KB \== '&corelib', using_all_spaces,!, metta_atom('&corelib',Atom). %metta_atom(KB,Atom):- KB \== '&corelib', !, metta_atom('&corelib',Atom). -metta_atom(KB,Atom):- KB \== '&corelib', !, % is_code_inheritor(KB), +metta_atom(KB,Atom):- KB \== '&corelib', !, \+ \+ (metta_atom_asserted(KB,'&corelib'), should_inherit_from_corelib(Atom)), !, metta_atom('&corelib',Atom). should_inherit_from_corelib(_):- using_all_spaces,!. -should_inherit_from_corelib([H,A|_]):- nonvar(A), should_inherit_op_from_corelib(H),!,nonvar(A). -%should_inherit_from_corelib([H|_]):- H == '@doc', !. +should_inherit_from_corelib([H,A|_]):- H == ':',!,nonvar(A). +should_inherit_from_corelib([H|_]):- H == '@doc', !. should_inherit_from_corelib([H,A|T]):- fail, - H == '=',write_src_uo(try([H,A|T])),!, - A=[F|_],nonvar(F), F \==':',is_list(A), + H == '=',write_src_uo(try([H,A|T])),!,is_list(A), + A=[F|_],nonvar(F), F \==':', \+ metta_atom_asserted('&self',[:,F|_]), % \+ \+ metta_atom_asserted('&corelib',[=,[F|_]|_]), write_src_uo([H,A|T]). @@ -1460,13 +1446,12 @@ should_inherit_op_from_corelib('@doc'). %should_inherit_op_from_corelib(_). -%metta_atom_asserted('&self','&corelib'). -%metta_atom_asserted('&self','&stdlib'). -metta_atom_asserted(Top,'&corelib'):- top_self(Top). -metta_atom_asserted(Top,'&stdlib'):- top_self(Top). +metta_atom_asserted('&self','&corelib'). +metta_atom_asserted('&self','&stdlib'). +metta_atom_asserted('top','&corelib'). +metta_atom_asserted('top','&stdlib'). metta_atom_asserted('&stdlib','&corelib'). metta_atom_asserted('&flybase','&corelib'). -metta_atom_asserted('&flybase','&stdlib'). metta_atom_asserted('&catalog','&corelib'). metta_atom_asserted('&catalog','&stdlib'). @@ -1476,14 +1461,13 @@ in_dag(X,X). space_to_ctx(Top,Var):- nonvar(Top),current_self(Top),!,Var='&self'. -space_to_ctx(Top,Var):- 'mod-space'(Top,Var),!. -space_to_ctx(Var,Var). +space_to_ctx(Top,Var):- 'mod-space'(Top,Var). -'mod-space'(top,'&top'). +'mod-space'(top,'&self'). 'mod-space'(catalog,'&catalog'). 'mod-space'(corelib,'&corelib'). 'mod-space'(stdlib,'&stdlib'). -'mod-space'(Top,'&self'):- current_self(Top). +'mod-space'(Top,'&self'):- Top == self. not_metta_atom_corelib(A,N):- A \== '&corelib' , metta_atom('&corelib',N). @@ -1782,29 +1766,24 @@ ignore(( symbolic(Cmt),symbolic_list_concat([_,Src],'MeTTaLog: ',Cmt),!,atom_string(Src,SrcCode),do_metta(mettalog_only(From),Load,Self,SrcCode,Out))),!. do_metta(From,How,Self,Src,Out):- string(Src),!, - must_det_ll((normalize_space(string(TaxM),Src), - convert_tax(How,Self,TaxM,Expr,NewHow))), + normalize_space(string(TaxM),Src), + convert_tax(How,Self,TaxM,Expr,NewHow),!, do_metta(From,NewHow,Self,Expr,Out). do_metta(From,_,Self,exec(Expr),Out):- !, do_metta(From,exec,Self,Expr,Out). - - -% Prolog CALL do_metta(From,_,Self, call(Expr),Out):- !, do_metta(From,call,Self,Expr,Out). do_metta(From,_,Self, ':-'(Expr),Out):- !, do_metta(From,call,Self,Expr,Out). do_metta(From,call,Self,TermV,FOut):- !, if_t(into_simple_op(call,TermV,OP),pfcAdd_Now('next-operation'(OP))), call_for_term_variables(TermV,Term,NamedVarsList,X), must_be(nonvar,Term), copy_term(NamedVarsList,Was), - Output = X, - user:u_do_metta_exec(From,Self,call(TermV),Term,X,NamedVarsList,Was,Output,FOut). + Output = NamedVarsList, + user:u_do_metta_exec(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut). -% Non Exec do_metta(_File,Load,Self,Src,Out):- Load\==exec, !, if_t(into_simple_op(Load,Src,OP),pfcAdd_Now('next-operation'(OP))), dont_give_up(as_tf(asserted_do_metta(Self,Load,Src),Out)). -% Doing Exec do_metta(file(Filename),exec,Self,TermV,Out):- must_det_ll((inc_exec_num(Filename), get_exec_num(Filename,Nth), @@ -1844,79 +1823,13 @@ o_s(S,S). into_simple_op(Load,[Op|O],op(Load,Op,S)):- o_s(O,S),!. - -%! call_for_term_variables(+Term, +X, -Result, -NamedVarsList, +TF) is det. -% Handles the term `Term` and determines the term variable list and final result. -% This version handles the case when the term has no variables and converts it to a truth-functional form. -% -% @arg Term The input term to be analyzed. -% @arg X The list of variables found within the term. It can be empty or contain one variable. -% @arg Result The final result, either as the original term or transformed into a truth-functional form. -% @arg NamedVarsList The list of named variables associated with the term. -% @arg TF The truth-functional form when the term has no variables. -% -% @example -% % Example with no variables: -% ?- call_for_term_variables(foo, Result, Vars, TF). -% Result = as_tf(foo, TF), -% Vars = []. -% -call_for_term_variables(TermV,catch_red(show_failure(TermR)),NewNamedVarsList,X):- - subst_vars(TermV,Term,NamedVarsList), - wwdmsg(subst_vars(TermV,Term,NamedVarsList)), - term_variables(Term, AllVars), - %get_global_varnames(VNs), append(NamedVarsList,VNs,All), nb_setval('$variable_names',All), wdmsg(term_variables(Term, AllVars)=All), - term_singletons(Term, Singletons),term_dont_cares(Term, DontCares), - - wwdmsg((term_singletons(Term, Singletons),term_dont_cares(Term, DontCares))), - include(not_in_eq(Singletons), AllVars, NonSingletons), - wwdmsg([dc=DontCares, sv=Singletons, ns=NonSingletons]), !, - include(not_in_eq(DontCares), NonSingletons, CNonSingletons), - include(not_in_eq(DontCares), Singletons, CSingletons), - wwdmsg([dc=DontCares, csv=CSingletons, cns=CNonSingletons]),!, - maplist(maplist(into_named_vars), - [DontCares, CSingletons, CNonSingletons], - [DontCaresN, CSingletonsN, CNonSingletonsN]), - wwdmsg([dc_nv=DontCaresN, sv_nv=CSingletonsN, ns_nv=CNonSingletonsN]), - call_for_term_variables5(Term, DontCaresN, CNonSingletonsN, CSingletonsN, TermR, NamedVarsList, NewNamedVarsList, X),!, - wwdmsg(call_for_term_variables5(orig=Term, all=DontCaresN, singles=CSingletonsN, shared=CNonSingletonsN, call=TermR, nvl=NamedVarsList, nvlo=NewNamedVarsList, output=X)). - -wwdmsg(_). -% If the term is ground, return the as_tf form. -%call_for_term_variables5(Term,_,_,_,as_tf(Term,Ret),VL,['$RetVal'=Ret|VL],[==,['call!',Term],Ret]) :- ground(Term), !. -% If the term is ground, create a call_nth with the term. -call_for_term_variables5(Term,_,_,_,call_nth(Term,Count),VL,['Count'=Count|VL],Ret) :- Ret=Term. - - -into_metta_callable(_Self,CALL,Term,X,NamedVarsList,Was):- fail, - % wdmsg(mc(CALL)), - CALL= call(TermV), - \+ never_compile(TermV), - must_det_ll(((( - term_variables(TermV,Res), - % ignore(Res = '$VAR'('ExecRes')), - RealRes = Res, - TermV=ExecGoal, - %format("~w ~w\n",[Res,ExecGoal]), - subst_vars(Res+ExecGoal,Res+Term,NamedVarsList), - copy_term_g(NamedVarsList,Was), - term_variables(Term,Vars), - - - Call = do_metta_runtime(Res, ExecGoal), - output_language(prolog, notrace((color_g_mesg('#114411', print_pl_source(:- Call ))))), - %nl,writeq(Term),nl, - ((\+ \+ - (( - %numbervars(v(TermV,Term,NamedVarsList,Vars),999,_,[attvar(skip)]), - %nb_current(variable_names,NamedVarsList), - %nl,print(subst_vars(Term,NamedVarsList,Vars)), - nop(nl))))), - nop(maplist(verbose_unify,Vars)), - %NamedVarsList=[_=RealRealRes|_], - %var(RealRes), - X = RealRes)))),!. - +call_for_term_variables(TermV,catch_red(show_failure(Term)),NamedVarsList,X):- + term_variables(TermV, AllVars), call_for_term_variables4v(TermV,AllVars,Term,NamedVarsList,X),!, + must_be(callable,Term). +call_for_term_variables(TermV,catch_red(show_failure(Term)),NamedVarsList,X):- + get_term_variables(TermV, DCAllVars, Singletons, NonSingletons), + call_for_term_variables5(TermV, DCAllVars, Singletons, NonSingletons, Term,NamedVarsList,X),!, + must_be(callable,Term). into_metta_callable(_Self,TermV,Term,X,NamedVarsList,Was):- \+ never_compile(TermV), diff --git a/prolog/metta_lang/metta_loader.pl b/prolog/metta_lang/metta_loader.pl index 60b9d6ea3c1..58067038dbe 100755 --- a/prolog/metta_lang/metta_loader.pl +++ b/prolog/metta_lang/metta_loader.pl @@ -883,11 +883,9 @@ % If Filename is not a valid symbol or file does not exist, handle wildcards for includes. (\+ symbol(Filename); \+ exists_file(Filename)),!, must_det_ll(with_wild_path(include_metta(Self), Filename)),!. - -include_metta1(WSelf, RelFilename):- +include_metta1(Self, RelFilename):- % Ensure RelFilename is a valid symbol and exists as a file. must_det_ll(( - into_top_self(WSelf, Self), symbol(RelFilename), exists_file(RelFilename),!, % Convert the relative filename to an absolute path. diff --git a/prolog/metta_lang/metta_parser.pl b/prolog/metta_lang/metta_parser.pl index 2dae77f8111..46bc199afac 100644 --- a/prolog/metta_lang/metta_parser.pl +++ b/prolog/metta_lang/metta_parser.pl @@ -921,9 +921,9 @@ at_end_of_stream(Stream), !, Clause = end_of_file. read_prolog_syntax(Stream, Clause) :- % Handle errors while reading a clause. - catch(read_prolog_syntax_unsafe(Stream, Clause), E, + catch(read_prolog_syntax_0(Stream, Clause), E, throw_stream_error(Stream,E)), !. -read_prolog_syntax_unsafe(Stream, Term) :- +read_prolog_syntax_0(Stream, Term) :- % Set options for reading the clause with metadata. Options = [ variable_names(Bindings), term_position(Pos), @@ -937,12 +937,12 @@ -> true ; % Store term position and variable names. b_setval('$term_position', Pos), - nb_setval('$variable_names', Bindings), + b_setval('$variable_names', Bindings), % Display information about the term. maplist(star_vars,Bindings), nop(display_term_info(Stream, Term, Bindings, Pos, RawLayout, Comments))). -star_vars(N=V):- ignore('$VAR'(N) = V). +star_vars(N=V):- ignore('$'(N) = V). %! maybe_name_vars(+List) is det. % diff --git a/prolog/metta_lang/metta_printer.pl b/prolog/metta_lang/metta_printer.pl index 466b3702aef..55ec7e8201a 100755 --- a/prolog/metta_lang/metta_printer.pl +++ b/prolog/metta_lang/metta_printer.pl @@ -148,7 +148,7 @@ % If Term is a list, apply list-specific formatting. is_list(Term), !, writeln('---------------------'), - numbervars(Term, 666, _, [attvar(skip)]), % Bind variables for display. + numbervars(Term, 666, _, [attvar(bind)]), % Bind variables for display. write((Msg)), write(':'), nl, write_src(Term), nl. ppct(Msg, Term) :- @@ -162,14 +162,14 @@ Term = (_ = _), !, writeln('---------------------'), write((Msg)), write(':'), nl, - numbervars(Term, 444, _, [attvar(skip)]), + numbervars(Term, 444, _, [attvar(bind)]), write_src(Term), nl. ppct(Msg, Term) :- % For clauses with specific formatting needs, include variable numbering and tree display. Term = (_ :- _), !, writeln('---------------------'), write((Msg)), write(':'), nl, - numbervars(Term, 222, _, [attvar(skip)]), + numbervars(Term, 222, _, [attvar(bind)]), print_tree(Term), nl. %! pp_metta(+P) is det. @@ -190,8 +190,7 @@ % pp_metta(P) :- % Standardize variable names in P for readability. - %pretty_numbervars(P, PP), - P=PP, + pretty_numbervars(P, PP), % Pretty-print PP with the `concepts=false` option. with_option(concepts=false, pp_fb(PP)). @@ -239,8 +238,6 @@ % Run the primary source-printing predicate within `run_pl_source/1`. run_pl_source(print_pl_source0(P)). -pnotrace(G):- quietly(G). - %! run_pl_source(+G) is det. % % Executes a goal `G` safely, catching any errors and attempting a retry with tracing if needed. @@ -276,13 +273,13 @@ % print_pl_source0(_) :- % Do not print if compatibility mode is enabled. - pnotrace(is_compatio), !. + notrace(is_compatio), !. print_pl_source0(_) :- % Do not print if silent loading mode is enabled. - pnotrace(silent_loading), !. + notrace(silent_loading), !. print_pl_source0(P) :- % Check if P was just printed (avoid redundant printing). - pnotrace((just_printed(PP), PP =@= P)), !. + notrace((just_printed(PP), PP =@= P)), !. print_pl_source0((A :- B)) :- % For rules (A :- B), display using portray_clause for readability. !,portray_clause((A :- B)). @@ -520,7 +517,7 @@ var(V), !, write_dvar(V), !. is_final_write('$VAR'(S)) :- % For '$VAR' structures, write the variable name S. - !, write_dvar(S), !. + !, write_dvar(S), !. is_final_write('#\\'(S)) :- % For special character format `#\S`, write S in single quotes. !, format("'~w'", [S]). @@ -713,53 +710,47 @@ % Writes the source of a term `V` with indentation enabled. % % This predicate sets indentation mode on by calling `with_indents/2` with `true`, -% and then writes the source of `V` using `write_src/1`. The use of `pnotrace/1` +% and then writes the source of `V` using `write_src/1`. The use of `notrace/1` % ensures that tracing is disabled during this operation. % % @arg V The term whose source is to be written with indentation. % write_src_wi(V) :- % Enable indentation and write the source of V. - pnotrace((with_indents(true, write_src(V)))). + notrace((with_indents(true, write_src(V)))). %! write_src(+V) is det. % % Writes the source of a term `V` after guessing Metta variables. % % This predicate first tries to identify variables in `V` using `guess_metta_vars/1` -% and then formats `V` for output using `pp_sex/1`. The `pnotrace/1` wrapper +% and then formats `V` for output using `pp_sex/1`. The `notrace/1` wrapper % ensures tracing is turned off. % % @arg V The term to be written as source. % write_src(V) :- % Guess variables in V and pretty-print using `pp_sex/1`. - \+ \+ pnotrace((src_vars(V, I), pp_sex(I))), !. + \+ \+ notrace((src_vars(V, I), pp_sex(I))), !. print_compounds_special:- true. -src_vars(V,I):- var(V),!,I=V. src_vars(V,I):- %ignore(guess_metta_vars(V)), - pre_guess_varnames(V,II),ignore(II=V), - guess_varnames(II,I), - nop(ignore(numbervars(I,10000,_,[singleton(true),attvar(skip)]))). -pre_guess_varnames(V,I):- \+ compound(V),!,I=V. -pre_guess_varnames(V,I):- functor(V,F,A),functor(II,F,A), metta_file_buffer(_, _, _, II, Vs, _,_), Vs\==[], I=@=II, I=II, V=I,maybe_name_vars(Vs),!. -pre_guess_varnames(V,I):- is_list(V),!,maplist(pre_guess_varnames,V,I). -pre_guess_varnames(C,I):- compound_name_arguments(C,F,V),!,maplist(pre_guess_varnames,V,VV),compound_name_arguments(I,F,VV),!. -pre_guess_varnames(V,V). + ignore(guess_varnames(V,I)), + ignore(numbervars(V,10000,_,[singleton(true),attvar(skip)])). + %! write_src_woi(+Term) is det. % % Writes the source of a term `Term` with indentation disabled. % % This predicate calls `with_indents/2` with `false` to disable indentation, -% and then writes `Term` using `write_src/1`. The `pnotrace/1` wrapper ensures +% and then writes `Term` using `write_src/1`. The `notrace/1` wrapper ensures % that tracing is disabled. % % @arg Term The term to be written without indentation. % write_src_woi(Term) :- % Disable indentation and write the source of Term. - pnotrace((with_indents(false, write_src(Term)))). + notrace((with_indents(false, write_src(Term)))). %! write_src_woi_nl(+X) is det. % @@ -773,7 +764,7 @@ % write_src_woi_nl(X) :- % Guess variables in X, add newlines, and write without indentation. - \+ \+ pnotrace(( + \+ \+ notrace(( format('~N'), write_src_woi(X), format('~N') )). diff --git a/prolog/metta_lang/metta_repl.pl b/prolog/metta_lang/metta_repl.pl index d91ebe034d3..454f5747871 100755 --- a/prolog/metta_lang/metta_repl.pl +++ b/prolog/metta_lang/metta_repl.pl @@ -152,10 +152,6 @@ % ?- save_history. % true. % -:- if(is_win64). -% Dummy to avoid errors on windows. -save_history. -:- else. save_history :- % Get the current input stream. current_input(Input), @@ -167,7 +163,6 @@ ; % Otherwise, do nothing. true). -:- endif. %! load_and_trim_history is det. % Loads and trims the REPL history if needed, and installs readline support. @@ -425,6 +420,31 @@ % If the input stream is not provided, do nothing. read_pending_white_codes(_). +%! call_for_term_variables4v(+Term, +X, -Result, -NamedVarsList, +TF) is det. +% Handles the term `Term` and determines the term variable list and final result. +% This version handles the case when the term has no variables and converts it to a truth-functional form. +% +% @arg Term The input term to be analyzed. +% @arg X The list of variables found within the term. It can be empty or contain one variable. +% @arg Result The final result, either as the original term or transformed into a truth-functional form. +% @arg NamedVarsList The list of named variables associated with the term. +% @arg TF The truth-functional form when the term has no variables. +% +% @example +% % Example with no variables: +% ?- call_for_term_variables4v(foo, [], Result, Vars, true). +% Result = as_tf(foo, true), +% Vars = []. +% +call_for_term_variables4v(Term, [], as_tf(Term, TF), NamedVarsList, TF) :- + % Get global variable names for the term. + get_global_varnames(NamedVarsList), + % Succeed if no variables are present. + !. +% Handles the case when the term has one variable and passes the term as-is. +call_for_term_variables4v(Term, [X], Term, NamedVarsList, X) :- + % Get global variable names for the term. + get_global_varnames(NamedVarsList). %! balanced_parentheses(+Str) is semidet. % Checks if parentheses are balanced in a string or list of characters `Str`. @@ -584,10 +604,9 @@ % repl_read_next(NewAccumulated, Expr) :- % Concatenate the input with '.' and try to interpret it as an atom. - symbol_concat(_Atom,'.',NewAccumulated), + symbol_concat(Atom,'.',NewAccumulated), % Attempt to read the term from the atom, handle errors and retry if necessary. - open_string(NewAccumulated,Stream), - catch_err((read_prolog_syntax_unsafe(Stream, Term), Expr = call(Term)), E, + catch_err((read_term_from_atom(Atom, Term, []), Expr = call(Term)), E, (((fail, write('Syntax error: '), writeq(E), nl, repl_read_next(Expr))))), !. % Previously commented: repl_read_next(Str, Expr):- ((clause(t_l:s_reader_info(Expr),_,Ref),erase(Ref))). @@ -762,6 +781,45 @@ % Directive to set a global variable for variable names. :- nb_setval(variable_names, []). +%! call_for_term_variables5(+Term, +DC, +Vars1, +Vars2, -CallTerm, -DCVars, -TF) is det. +% +% Processes term variables and generates a call structure based on the provided term, +% handling cases with ground terms, single variables, and multiple variables. +% +% @arg Term The input term to process. +% @arg DC The direct constraints or variables list (can be empty). +% @arg Vars1 The first set of variables (e.g., `[Var=Value]` format). +% @arg Vars2 The second set of variables. +% @arg CallTerm The generated term call (e.g., `call_nth/2` or `as_tf/2`). +% @arg DCVars The combined list of variables or constraints. +% @arg TF The variable or value associated with the call. +% +% @example Handling a ground term: +% ?- call_for_term_variables5(hello, [], [], [], CallTerm, DCVars, TF). +% CallTerm = as_tf(hello, TF), +% DCVars = [], +% TF = _. +% +% @example Single variable case: +% ?- call_for_term_variables5(hello, [], [], [X=_], CallTerm, DCVars, TF). +% CallTerm = call_nth(hello, Count), +% DCVars = ['Count' = Count], +% TF = X. +% + % If the term is ground, return the as_tf form. +call_for_term_variables5(Term,[],[],[],as_tf(Term,TF),[],TF) :- ground(Term), !. + % If the term is ground, create a call_nth with the term. +call_for_term_variables5(Term,DC,[],[],call_nth(Term,TF),DC,TF) :- ground(Term), !. +% If there is one variable, set the term to call_nth. +call_for_term_variables5(Term,_,[],[_=Var],call_nth(Term,Count),['Count'=Count],Var). +% Similar case when the variable is reversed in arguments. +call_for_term_variables5(Term,_,[_=Var],[],call_nth(Term,Count),['Count'=Count],Var). +% If both term variables and equal variable are present, pass them along. +call_for_term_variables5(Term,_,Vars,[_=Var],Term,Vars,Var). +% Same case but with the variables reversed. +call_for_term_variables5(Term,_,[_=Var],Vars,Term,Vars,Var). +% Handle case with more than one variable, generating a call_nth. +call_for_term_variables5(Term,_,SVars,Vars,call_nth(Term,Count),[Vars,SVars],Count). %! is_interactive(+From) is nondet. % @@ -1980,18 +2038,12 @@ % This installs readline/editline support, allowing for line editing and history during input. :- dynamic(is_installed_readline_editline/1). :- volatile(is_installed_readline_editline/1). - -:- if(is_win64). -% dummy for on windows -install_readline_editline. -:-else. install_readline_editline :- % Get the current input stream. current_input(Input), % Install readline support for the current input. install_readline(Input), !. -:- endif. %! el_wrap_metta(+Input) is det. % diff --git a/prolog/metta_lang/metta_space.pl b/prolog/metta_lang/metta_space.pl index 9d1a65eba2a..a3cc1efe46c 100755 --- a/prolog/metta_lang/metta_space.pl +++ b/prolog/metta_lang/metta_space.pl @@ -377,8 +377,7 @@ % @example Clear all atoms from a space: % ?- 'clear-atoms'('my_space'). % -'clear-atoms'(DynSpace) :- - into_top_self(DynSpace, SpaceNameOrInstance), +'clear-atoms'(SpaceNameOrInstance) :- % Log the operation of clearing atoms from the specified space. dout(space, ['clear-atoms', SpaceNameOrInstance]), % Retrieve the appropriate method for clearing the space based on its type. @@ -405,8 +404,7 @@ % @example Add an atom to a space: % ?- 'add-atom'('my_space', my_atom). % -'add-atom'(DynSpace, Atom) :- - into_top_self(DynSpace, SpaceNameOrInstance), +'add-atom'(SpaceNameOrInstance, Atom) :- % Retrieve the method for adding an atom based on the space type. ((space_type_method(Type, add_atom, Method), % Ensure the space type matches by calling the type predicate. @@ -449,8 +447,7 @@ % @example Remove an atom from a space: % ?- 'remove-atom'('my_space', my_atom). % -'remove-atom'(DynSpace, Atom) :- - into_top_self(DynSpace, SpaceNameOrInstance), +'remove-atom'(SpaceNameOrInstance, Atom) :- % Log the operation of removing an atom from the specified space. dout(space, ['remove-atom', SpaceNameOrInstance, Atom]), % Retrieve the method for removing an atom based on the space type. @@ -497,8 +494,7 @@ % @example Replace an atom in a space: % ?- 'replace-atom'('my_space', old_atom, new_atom). % -'replace-atom'(DynSpace, Atom, New) :- - into_top_self(DynSpace, SpaceNameOrInstance), +'replace-atom'(SpaceNameOrInstance, Atom, New) :- dout(space, ['replace-atom', SpaceNameOrInstance, Atom, New]), space_type_method(Type, replace_atom, Method), call(Type, SpaceNameOrInstance), @@ -540,8 +536,7 @@ % ?- 'atom-count'(env, Count). % Count = 10. % -'atom-count'(DynSpace, Count) :- - into_top_self(DynSpace, SpaceNameOrInstance), +'atom-count'(SpaceNameOrInstance, Count) :- dout(space, ['atom-count', SpaceNameOrInstance]), space_type_method(Type, atom_count, Method), call(Type, SpaceNameOrInstance), !, @@ -573,8 +568,7 @@ % ?- get-atoms('env1', Atoms). % Atoms = [atomA, atomB, atomC]. % -'get-atoms'(DynSpace, AtomsL) :- - into_top_self(DynSpace, SpaceNameOrInstance), +'get-atoms'(SpaceNameOrInstance, AtomsL) :- % Output a debug message indicating the 'get-atoms' request to the space. dout(space, ['get-atoms', SpaceNameOrInstance]), % Determine the method for retrieving atoms based on the space type. @@ -604,8 +598,7 @@ % @example Iterate over atoms in a space: % ?- 'atoms_iter'('my_space', Iter). % -'atoms_iter'(DynSpace, Iter) :- - into_top_self(DynSpace, SpaceNameOrInstance), +'atoms_iter'(SpaceNameOrInstance, Iter) :- dout(space, ['atoms_iter', SpaceNameOrInstance]), space_type_method(Type, atoms_iter, Method), call(Type, SpaceNameOrInstance), @@ -628,8 +621,7 @@ % @example Match atoms in a space: % ?- 'atoms_match'('my_space', Atoms, my_template, else_clause). % -'atoms_match'(DynSpace, Atoms, Template, Else) :- - into_top_self(DynSpace, SpaceNameOrInstance), +'atoms_match'(SpaceNameOrInstance, Atoms, Template, Else) :- space_type_method(Type, atoms_match, Method), call(Type, SpaceNameOrInstance), !, @@ -650,8 +642,7 @@ % @example Query a space for an atom: % ?- 'space_query'('my_space', query_atom, Result). % -'space_query'(DynSpace, QueryAtom, Result) :- - into_top_self(DynSpace, SpaceNameOrInstance), +'space_query'(SpaceNameOrInstance, QueryAtom, Result) :- space_type_method(Type, query, Method), call(Type, SpaceNameOrInstance), !, @@ -672,8 +663,7 @@ % ?- subst_pattern_template('example_space', some_pattern, Template). % Template = [substituted_atom1, substituted_atom2]. % -subst_pattern_template(DynSpace, Pattern, Template) :- - into_top_self(DynSpace, SpaceNameOrInstance), +subst_pattern_template(SpaceNameOrInstance, Pattern, Template) :- % Log the operation for traceability. dout(space, [subst_pattern_template, SpaceNameOrInstance, Pattern, Template]), % Match and substitute atoms in the given space according to the pattern. @@ -699,12 +689,10 @@ % ?- was_asserted_space('&self'). % true. % -was_asserted_space('&self'):- current_self(X), (X=='&self'->true;was_asserted_space(X)). +was_asserted_space('&self'). was_asserted_space('&stdlib'). was_asserted_space('&corelib'). was_asserted_space('&flybase'). -was_asserted_space('&top'). -was_asserted_space('&catalog'). /* was_asserted_space('&attentional_focus'). was_asserted_space('&belief_events'). @@ -1348,12 +1336,9 @@ % % Get the atom count for a loaded context. % ?- atom_count_provider(some_context, Count). % - - -atom_count_provider(SpaceNameOrInstance, Count) :- - into_top_self(SpaceNameOrInstance, DynSpace), +atom_count_provider(Self, Count) :- % Check if the context has been loaded into a knowledge base (KB). - user:loaded_into_kb(DynSpace, Filename), + user:loaded_into_kb(Self, Filename), % Retrieve the associated predicate for the given filename. once(user:asserted_metta_pred(Mangle, Filename)), % Derive a related predicate from the original. @@ -1370,9 +1355,8 @@ predicate_property(Data, number_of_rules(RC)), % Calculate the atom count as the difference between clauses and rules. Count is CC - RC. -atom_count_provider(SpaceNameOrInstance, Count) :- +atom_count_provider(KB, Count) :- must_det_ll(( - into_top_self(SpaceNameOrInstance, KB), % Predicate for asserted atoms. AMA = metta_atom_asserted, % Declare the predicate with arity 2. @@ -1422,8 +1406,7 @@ % % Iterate over atoms in 'example_kb' and retrieve them. % ?- metta_assertdb_iter('example_kb', Atom). % -metta_assertdb_iter(SpaceNameOrInstance, Atoms) :- - into_top_self(SpaceNameOrInstance, KB), +metta_assertdb_iter(KB, Atoms) :- % Dynamically construct the predicate for the given KB. MP =.. [metta_atom, KB, Atoms], % Call the constructed predicate to retrieve atoms. @@ -1444,8 +1427,7 @@ % % Execute a query against the KB and bind variables. % ?- metta_iter_bind('example_kb', my_query(X), Vars, ['X']). % -metta_iter_bind(SpaceNameOrInstance, Query, Vars, VarNames) :- - into_top_self(SpaceNameOrInstance, KB), +metta_iter_bind(KB, Query, Vars, VarNames) :- % Extract all variables from the query. term_variables(Query, QVars), % Align the provided variable names with the query variables. @@ -1478,8 +1460,7 @@ % % Query the KB and retrieve bound variables. % ?- space_query_vars('example_kb', my_query(X), Vars). % -space_query_vars(SpaceNameOrInstance, Query, Vars) :- - into_top_self(SpaceNameOrInstance, KB), +space_query_vars(KB, Query, Vars) :- % Check if the knowledge base is an asserted space. is_asserted_space(KB), !, % Declare the predicate for asserted atoms with arity 2. diff --git a/prolog/metta_lang/metta_subst.pl b/prolog/metta_lang/metta_subst.pl index 3d1b7162251..59b13682fd4 100755 --- a/prolog/metta_lang/metta_subst.pl +++ b/prolog/metta_lang/metta_subst.pl @@ -65,7 +65,7 @@ self_subst('True'). self_subst('False'). self_subst('F'). %' -%:- nb_setval(self_space, '&self'). % ' +:- nb_setval(self_space, '&self'). % ' substs_to(XX,Y):- Y==XX,!. substs_to(XX,Y):- Y=='True',!, is_True(XX),!. %' diff --git a/prolog/metta_lang/stdlib_mettalog.metta b/prolog/metta_lang/stdlib_mettalog.metta index 45bb95eb2ba..3bfb94a1a90 100644 --- a/prolog/metta_lang/stdlib_mettalog.metta +++ b/prolog/metta_lang/stdlib_mettalog.metta @@ -97,12 +97,9 @@ (= (If False $then) (let $n 0 (let $n 1 $n))) (= (If $cond $then $else) (if $cond $then $else)) -(@doc type-check - (@desc "The value of type-check determines MeTTa's type-checking behavior. Set via pragma!. When set to auto (i.e. !(pragma! type-check auto)), types are checked immediately on adding an expression to the space. By default, when unset (or set to anything other than auto), types are checked only on evaluation. For example !(+ 1 \"2\") would trigger a type violation, but (= (foo $x) (+ $x \"2\")) would not, unless type-check is set to auto, in which case both would trigger type violations.")) -(: type-check Symbol) - (iz predicate-arity MeTTaLog) + (@doc predicate-arity (@desc "Specifies the arity (number of arguments) for a given predicate, allowing it to be queriable in the system's match framework. This is particularly useful for enabling built-in functions, such as `size-atom`, to be used as predicates in declarative contexts and run in reverse to compute inputs based on outputs. From 45492ebfc1db61349373f06d95a08fbc54bfca23 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Sat, 21 Dec 2024 15:04:34 -0800 Subject: [PATCH 26/42] ci --- .github/workflows/ci.yml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 723548092fb..39a8d28848a 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -308,6 +308,9 @@ jobs: echo "
  • JUnit Standard Report
  • " >> allure-history/index.html echo "
  • JUnit Matrix Report
  • " >> allure-history/index.html #echo "
  • Help Documentation
  • " >> allure-history/index.html + echo "
  • Install MeTTaLog
  • " >> allure-history/index.html + echo "
  • Interpeter/Compiler Devel
  • " >> allure-history/index.html + echo "
  • Testing Suite
  • " >> allure-history/index.html echo "" >> allure-history/index.html echo "" >> allure-history/index.html echo "" >> allure-history/index.html From 26fea876a2699db0fa3e987f95cdc4802221eb77 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Sat, 21 Dec 2024 15:26:13 -0800 Subject: [PATCH 27/42] revert to 1cde39d33ea5524491797daf8dca0082115c75fc~2 --- prolog/metta_lang/metta_eval.pl | 77 ++++++++++++++++----------------- 1 file changed, 38 insertions(+), 39 deletions(-) diff --git a/prolog/metta_lang/metta_eval.pl b/prolog/metta_lang/metta_eval.pl index f34644a4249..de8842695f3 100755 --- a/prolog/metta_lang/metta_eval.pl +++ b/prolog/metta_lang/metta_eval.pl @@ -169,19 +169,8 @@ eval_true(X):- eval_args(X,Y), once(var(Y) ; \+ is_False(Y)). eval(Depth,Self,X,Y):- eval('=',_,Depth,Self,X,Y). -eval(Eq,RetType,Depth,Self,X,O):- - eval_reducable(Eq,RetType,Depth,Self,X,eval_args(Eq,RetType,Depth,Self,X,Y),Y,O). - - -eval_reducable(Eq,RetType,Depth,Self,X,G,Y,O):- catch_metta_return(G,Y), return_x_g_y(Eq,RetType,Depth,Self,X,X,Y,O). - -return_x_g_y(_Eq,_RetType,_Depth,_Self,X,_,Y,R):- Y == 'NotReducable',!,R=X. -return_x_g_y(Eq,RetType,Depth, Self,X,M,Y,R):- M\=@=Y, !, eval_args(Eq,RetType,Depth,Self,Y,Z), return_x_g_y(Eq,RetType,Depth,Self,X,Y,Z,R). -return_x_g_y(_Eq,_RetType,_Depth,_Self,_X,_M,R,R). - -catch_metta_return(G,Y):- - catch(G,metta_return(Y),ignore(retract(thrown_metta_return(Y)))). - +eval(Eq,RetType,Depth,Self,X,Y):- + catch_metta_return(eval_args(Eq,RetType,Depth,Self,X,Y),Y). %:- set_prolog_flag(gc,false). /* @@ -238,7 +227,8 @@ eval_ret(Eq,RetType,Depth,Self,X,Y):- eval_00(Eq,RetType,Depth,Self,X,Y), is_returned(Y). - +catch_metta_return(G,Y):- + catch(G,metta_return(Y),ignore(retract(thrown_metta_return(Y)))). allow_repeats_eval_(_):- !. allow_repeats_eval_(_):- option_value(no_repeats,false),!. @@ -253,7 +243,7 @@ eval_00(Eq,RetType,Depth,Self,X,YO):- eval_01(Eq,RetType,Depth,Self,X,YO). eval_01(Eq,RetType,Depth,Self,X,YO):- - % X\==[empty], % speed up n-queens x60 but breaks other things + X\==[empty], % speed up n-queens x60 if_t((Depth<1, trace_on_overflow), debug(metta(eval_args))), notrace((Depth2 is Depth-1, copy_term(X, XX))), @@ -263,7 +253,7 @@ ;eval_01(Eq,RetType,Depth2,Self,M,Y)), eval_02(Eq,RetType,Depth2,Self,Y,YO))). -eval_02(Eq,RetType,Depth2,Self,Y,YO):- % Y\==[empty], % speed up n-queens x60 but breaks other things +eval_02(Eq,RetType,Depth2,Self,Y,YO):- Y\==[empty], % speed up n-queens x60 once(if_or_else((subst_args_here(Eq,RetType,Depth2,Self,Y,YO)), if_or_else((fail,finish_eval(Eq,RetType,Depth2,Self,Y,YO)), Y=YO))). @@ -278,8 +268,7 @@ % % this next one at least causes no failures and 5x speedup subst_args_here(_Eq,_RetType,_Depth2,_Self,Y,YO):- wont_need_subst(Y),!, Y=YO. subst_args_here(Eq,RetType,Depth2,Self,Y,YO):- - %subst_args(Eq,RetType,Depth2,Self,Y,YO), - Y =YO, + subst_args(Eq,RetType,Depth2,Self,Y,YO), notrace(if_t_else((wont_need_subst(Y),Y\=@=YO), (write_src_uo(needed_subst_args(Y,YO)),bt,sleep(1.0)), nop(write_src_uo(unneeded_subst_args(Y))))). @@ -1260,13 +1249,15 @@ eval_20(Eq,RetType,Depth,Self,['if',Cond,Then,Else],Res):- !, - (eval_args_true(Eq,'Bool',Depth,Self,Cond) - *-> eval_args(Eq,RetType,Depth,Self,Then,Res) + eval_args(Eq,'Bool',Depth,Self,Cond,TF), + (is_True(TF) + -> eval_args(Eq,RetType,Depth,Self,Then,Res) ; eval_args(Eq,RetType,Depth,Self,Else,Res)). eval_20(Eq,RetType,Depth,Self,['If',Cond,Then,Else],Res):- !, - (eval_args_true(Eq,'Bool',Depth,Self,Cond) - *-> eval_args(Eq,RetType,Depth,Self,Then,Res) + eval_args(Eq,'Bool',Depth,Self,Cond,TF), + (is_True(TF) + -> eval_args(Eq,RetType,Depth,Self,Then,Res) ; eval_args(Eq,RetType,Depth,Self,Else,Res)). eval_20(Eq,RetType,Depth,Self,['If',Cond,Then],Res):- !, @@ -1980,9 +1971,9 @@ (!,write_src(E),fail))),!. -%empty('Empty'). -%','(A,B,(AA,BB)):- eval_args(A,AA),eval_args(B,BB). -%':'(A,B,[':',A,B]). +empty('Empty'). +','(A,B,(AA,BB)):- eval_args(A,AA),eval_args(B,BB). +':'(A,B,[':',A,B]). '<'(A,B,TFO):- as_tf(A'(A,B,TFO):- as_tf(Atrue;S=[]. bagof_eval(_Eq,_RetType,_Dpth,_Slf,X,L):- self_eval(X),!,L=[X]. bagof_eval(_Eq,_RetType,_Dpth,_Slf,X,L):- typed_list(X,_Type,L),!. bagof_eval(Eq,RetType,Depth,Self,Funcall,L):- - bagof_ne(E,eval(Eq,RetType,Depth,Self,Funcall,E),L). + bagof_ne(E, + catch_metta_return(eval_args(Eq,RetType,Depth,Self,Funcall,E),E),L). setof_eval(Depth,Self,Funcall,L):- setof_eval('=',_RT,Depth,Self,Funcall,L). setof_eval(Eq,RetType,Depth,Self,Funcall,S):- findall_eval(Eq,RetType,Depth,Self,Funcall,L), @@ -2859,7 +2858,7 @@ ((eval_args(Eq,RetType,Depth,Self,Funcall,E)) *-> is_returned(E);(fail,E=Funcall)). -is_returned(E):- notrace( \+ is_empty(E)), nop(assertion(E \== 'NotReducable')). +is_returned(E):- notrace( \+ is_empty(E)). is_empty(E):- notrace(( nonvar(E), sub_var('Empty',E))),!. From 025eb43fa346ff647c5e373979ed50b7ec4bba96 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Sat, 21 Dec 2024 16:13:44 -0800 Subject: [PATCH 28/42] better impl of NotReducable --- prolog/metta_lang/metta_eval.pl | 53 +++++++++++++-------------------- 1 file changed, 20 insertions(+), 33 deletions(-) diff --git a/prolog/metta_lang/metta_eval.pl b/prolog/metta_lang/metta_eval.pl index de8842695f3..21504867b82 100755 --- a/prolog/metta_lang/metta_eval.pl +++ b/prolog/metta_lang/metta_eval.pl @@ -79,7 +79,7 @@ self_eval0('Empty'). self_eval0([]). self_eval0('%Undefined%'). -self_eval0(X):- atom(X),!, \+ nb_bound(X,_),!. +self_eval0(X):- atom(X),!, X\=='NotReducable', \+ nb_bound(X,_),!. nb_bound(Name,X):- atom(Name), % atom_concat('&', _, Name), nb_current(Name, X), compound(X). % spaces and states are stored as compounds @@ -243,7 +243,7 @@ eval_00(Eq,RetType,Depth,Self,X,YO):- eval_01(Eq,RetType,Depth,Self,X,YO). eval_01(Eq,RetType,Depth,Self,X,YO):- - X\==[empty], % speed up n-queens x60 + % X\==[empty], % speed up n-queens x60 but breaks other things if_t((Depth<1, trace_on_overflow), debug(metta(eval_args))), notrace((Depth2 is Depth-1, copy_term(X, XX))), @@ -253,7 +253,7 @@ ;eval_01(Eq,RetType,Depth2,Self,M,Y)), eval_02(Eq,RetType,Depth2,Self,Y,YO))). -eval_02(Eq,RetType,Depth2,Self,Y,YO):- Y\==[empty], % speed up n-queens x60 +eval_02(Eq,RetType,Depth2,Self,Y,YO):- % Y\==[empty], % speed up n-queens x60 but breaks other things once(if_or_else((subst_args_here(Eq,RetType,Depth2,Self,Y,YO)), if_or_else((fail,finish_eval(Eq,RetType,Depth2,Self,Y,YO)), Y=YO))). @@ -300,8 +300,9 @@ eval_20(Eq,RetType,_Dpth,_Slf,Name,Y):- atom(Name), !, + (Name=='NotReducable'->throw(metta_NotReducable); (nb_bound(Name,X)->do_expander(Eq,RetType,X,Y); - Y = Name). + Y = Name)). eval_20(Eq,RetType,_Dpth,_Slf,X,Y):- no_eval(X),!,do_expander(Eq,RetType,X,Y). @@ -1249,15 +1250,13 @@ eval_20(Eq,RetType,Depth,Self,['if',Cond,Then,Else],Res):- !, - eval_args(Eq,'Bool',Depth,Self,Cond,TF), - (is_True(TF) - -> eval_args(Eq,RetType,Depth,Self,Then,Res) + (eval_args_true(Eq,'Bool',Depth,Self,Cond) + *-> eval_args(Eq,RetType,Depth,Self,Then,Res) ; eval_args(Eq,RetType,Depth,Self,Else,Res)). eval_20(Eq,RetType,Depth,Self,['If',Cond,Then,Else],Res):- !, - eval_args(Eq,'Bool',Depth,Self,Cond,TF), - (is_True(TF) - -> eval_args(Eq,RetType,Depth,Self,Then,Res) + (eval_args_true(Eq,'Bool',Depth,Self,Cond) + *-> eval_args(Eq,RetType,Depth,Self,Then,Res) ; eval_args(Eq,RetType,Depth,Self,Else,Res)). eval_20(Eq,RetType,Depth,Self,['If',Cond,Then],Res):- !, @@ -1971,9 +1970,9 @@ (!,write_src(E),fail))),!. -empty('Empty'). -','(A,B,(AA,BB)):- eval_args(A,AA),eval_args(B,BB). -':'(A,B,[':',A,B]). +%empty('Empty'). +%','(A,B,(AA,BB)):- eval_args(A,AA),eval_args(B,BB). +%':'(A,B,[':',A,B]). '<'(A,B,TFO):- as_tf(A'(A,B,TFO):- as_tf(AB0),get_defn_expansions(Eq,RetType,Depth,Self,X,XX,B0),XXB0L),!, - eval_defn_bodies(Eq,RetType,Depth,Self,X,Y,XXB0L). + catch(eval_defn_bodies(Eq,RetType,Depth,Self,X,Y,XXB0L),metta_NotReducable,X=Y). eval_defn_choose_candidates(Eq,RetType,Depth,Self,X,Y):- eval_defn_bodies(Eq,RetType,Depth,Self,X,Y,[]),!. @@ -2833,16 +2822,14 @@ findall_eval(_Eq,_RetType,_Dpth,_Slf,X,L):- self_eval(X),!,L=[X]. findall_eval(_Eq,_RetType,_Dpth,_Slf,X,L):- typed_list(X,_Type,L),!. findall_eval(Eq,RetType,Depth,Self,Funcall,L):- - findall_ne(E, - catch_metta_return(eval_args(Eq,RetType,Depth,Self,Funcall,E),E),L). + findall_ne(E,eval(Eq,RetType,Depth,Self,Funcall,E),L). %bagof_eval(Eq,RetType,Depth,Self,X,L):- bagof_eval(Eq,RetType,_RT,Depth,Self,X,L). %bagof_eval(Eq,RetType,Depth,Self,X,S):- bagof(E,eval_ne(Eq,RetType,Depth,Self,X,E),S)*->true;S=[]. bagof_eval(_Eq,_RetType,_Dpth,_Slf,X,L):- self_eval(X),!,L=[X]. bagof_eval(_Eq,_RetType,_Dpth,_Slf,X,L):- typed_list(X,_Type,L),!. bagof_eval(Eq,RetType,Depth,Self,Funcall,L):- - bagof_ne(E, - catch_metta_return(eval_args(Eq,RetType,Depth,Self,Funcall,E),E),L). + bagof_ne(E,eval(Eq,RetType,Depth,Self,Funcall,E),L). setof_eval(Depth,Self,Funcall,L):- setof_eval('=',_RT,Depth,Self,Funcall,L). setof_eval(Eq,RetType,Depth,Self,Funcall,S):- findall_eval(Eq,RetType,Depth,Self,Funcall,L), From 43914134e818d31e2bf1f5df2aa22d33cb6eff6d Mon Sep 17 00:00:00 2001 From: logicmoo Date: Sat, 21 Dec 2024 16:52:05 -0800 Subject: [PATCH 29/42] forward again --- prolog/metta_lang/metta_eval.pl | 10 +- prolog/metta_lang/metta_interp.pl | 139 +++++++++++++++++++----- prolog/metta_lang/metta_loader.pl | 4 +- prolog/metta_lang/metta_parser.pl | 8 +- prolog/metta_lang/metta_printer.pl | 45 +++++--- prolog/metta_lang/metta_repl.pl | 80 +++----------- prolog/metta_lang/metta_space.pl | 53 ++++++--- prolog/metta_lang/metta_subst.pl | 10 +- prolog/metta_lang/stdlib_mettalog.metta | 5 +- 9 files changed, 213 insertions(+), 141 deletions(-) diff --git a/prolog/metta_lang/metta_eval.pl b/prolog/metta_lang/metta_eval.pl index 21504867b82..7eaebd955f8 100755 --- a/prolog/metta_lang/metta_eval.pl +++ b/prolog/metta_lang/metta_eval.pl @@ -269,6 +269,7 @@ subst_args_here(_Eq,_RetType,_Depth2,_Self,Y,YO):- wont_need_subst(Y),!, Y=YO. subst_args_here(Eq,RetType,Depth2,Self,Y,YO):- subst_args(Eq,RetType,Depth2,Self,Y,YO), + %Y =YO, notrace(if_t_else((wont_need_subst(Y),Y\=@=YO), (write_src_uo(needed_subst_args(Y,YO)),bt,sleep(1.0)), nop(write_src_uo(unneeded_subst_args(Y))))). @@ -1537,9 +1538,12 @@ % Placeholder to deal with formatting {:} later format_args_get_format(FormatRest, FormatRest, _). -format_args_write(Arg,_) :- string(Arg), !, write(Arg). -format_args_write('#\\'(Arg),_) :- !, write(Arg). -format_args_write(Arg,_) :- write_src_woi(Arg). +format_args_write(Arg,_) :- \+ compound(Arg), !, format_arg(Arg). +format_args_write('#\\'(Char),_) :- !, format_arg(Char). +format_args_write(Arg,_) :- format_arg(Arg). + +format_arg(Arg) :- string(Arg), !, write(Arg). +format_arg(Arg):- \+ \+ write_src_woi(Arg). format_nth_args([], _, _). format_nth_args(['{','{'|FormatRest], Iterator, Args) :- !, put('{'), format_nth_args(FormatRest, Iterator, Args). % escaped diff --git a/prolog/metta_lang/metta_interp.pl b/prolog/metta_lang/metta_interp.pl index b2fe793540c..f4e32c23487 100755 --- a/prolog/metta_lang/metta_interp.pl +++ b/prolog/metta_lang/metta_interp.pl @@ -368,8 +368,12 @@ :- use_module(library(shell)). %:- use_module(library(tabling)). -:- nb_setval(self_space, '&self'). -current_self(Self):- ((nb_current(self_space,Self),Self\==[])->true;Self='&self'). +use_top_self :- \+ fast_option_value('top-self', false). +top_self('&top'):- use_top_self,!. +top_self('&self'). + +%:- top_self(Self), nb_setval(self_space, '&self'), +current_self(Self):- ((nb_current(self_space,Self),Self\==[])->true;top_self(Self)). :- nb_setval(repl_mode, '+'). @@ -411,6 +415,7 @@ option_value_name_default_type_help('repeats', true, [true, false], "false to avoid repeated results", 'Miscellaneous'). option_value_name_default_type_help('time', true, [false, true], "Enable or disable timing for operations (in Rust compatibility mode, this is false)", 'Miscellaneous'). option_value_name_default_type_help('vn', auto, [auto, true, false], "Enable or disable, (auto = enable but not if it breaks stuff) EXPERIMENTAL BUG-FIX where variable names are preserved (see https://github.com/trueagi-io/metta-wam/issues/221)", 'Miscellaneous'). +option_value_name_default_type_help('top-self', false, [true, false, auto], "When set, stop pretending &self==&top", 'Miscellaneous'). % Testing and Validation option_value_name_default_type_help('synth-unit-tests', false, [false, true], "Synthesize unit tests", 'Testing and Validation'). @@ -1410,6 +1415,11 @@ %get_metta_atom(Eq,KB, [F|List]):- KB='&flybase',fb_pred(F, Len), length(List,Len),apply(F,List). +maybe_into_top_self(WSelf, Self):- use_top_self,WSelf=='&self',current_self(Self),Self\==WSelf,!. +into_top_self(WSelf, Self):- maybe_into_top_self(WSelf, Self),!. +into_top_self(Self, Self). + + get_metta_atom_from(KB,Atom):- metta_atom(KB,Atom). get_metta_atom(Eq,Space, Atom):- metta_atom(Space, Atom), \+ (Atom =[EQ,_,_], EQ==Eq). @@ -1419,22 +1429,26 @@ metta_atom(Space, Atom):- typed_list(Space,_,L),!, member(Atom,L). metta_atom(KB, [F, A| List]):- KB=='&flybase',fb_pred_nr(F, Len),current_predicate(F/Len), length([A|List],Len),apply(F,[A|List]). %metta_atom(KB,Atom):- KB=='&corelib',!, metta_atom_corelib(Atom). +%metta_atom(X,Y):- use_top_self,maybe_resolve_space_dag(X,XX),!,in_dag(XX,XXX),XXX\==X,metta_atom(XXX,Y). + +metta_atom(X,Y):- maybe_into_top_self(X, TopSelf),!,metta_atom(TopSelf,Y). +%metta_atom(X,Y):- var(X),use_top_self,current_self(TopSelf),metta_atom(TopSelf,Y),X='&self'. metta_atom(KB,Atom):- metta_atom_in_file( KB,Atom). metta_atom(KB,Atom):- metta_atom_asserted( KB,Atom). %metta_atom(KB,Atom):- KB == '&corelib', !, metta_atom_asserted('&self',Atom). -metta_atom(KB,Atom):- KB \== '&corelib', using_all_spaces,!, metta_atom('&corelib',Atom). +%metta_atom(KB,Atom):- KB \== '&corelib', using_all_spaces,!, metta_atom('&corelib',Atom). %metta_atom(KB,Atom):- KB \== '&corelib', !, metta_atom('&corelib',Atom). -metta_atom(KB,Atom):- KB \== '&corelib', !, +metta_atom(KB,Atom):- KB \== '&corelib', !, % is_code_inheritor(KB), \+ \+ (metta_atom_asserted(KB,'&corelib'), should_inherit_from_corelib(Atom)), !, metta_atom('&corelib',Atom). should_inherit_from_corelib(_):- using_all_spaces,!. -should_inherit_from_corelib([H,A|_]):- H == ':',!,nonvar(A). -should_inherit_from_corelib([H|_]):- H == '@doc', !. +should_inherit_from_corelib([H,A|_]):- nonvar(A), should_inherit_op_from_corelib(H),!,nonvar(A). +%should_inherit_from_corelib([H|_]):- H == '@doc', !. should_inherit_from_corelib([H,A|T]):- fail, - H == '=',write_src_uo(try([H,A|T])),!,is_list(A), - A=[F|_],nonvar(F), F \==':', + H == '=',write_src_uo(try([H,A|T])),!, + A=[F|_],nonvar(F), F \==':',is_list(A), \+ metta_atom_asserted('&self',[:,F|_]), % \+ \+ metta_atom_asserted('&corelib',[=,[F|_]|_]), write_src_uo([H,A|T]). @@ -1446,12 +1460,13 @@ should_inherit_op_from_corelib('@doc'). %should_inherit_op_from_corelib(_). -metta_atom_asserted('&self','&corelib'). -metta_atom_asserted('&self','&stdlib'). -metta_atom_asserted('top','&corelib'). -metta_atom_asserted('top','&stdlib'). +%metta_atom_asserted('&self','&corelib'). +%metta_atom_asserted('&self','&stdlib'). +metta_atom_asserted(Top,'&corelib'):- top_self(Top). +metta_atom_asserted(Top,'&stdlib'):- top_self(Top). metta_atom_asserted('&stdlib','&corelib'). metta_atom_asserted('&flybase','&corelib'). +metta_atom_asserted('&flybase','&stdlib'). metta_atom_asserted('&catalog','&corelib'). metta_atom_asserted('&catalog','&stdlib'). @@ -1461,13 +1476,14 @@ in_dag(X,X). space_to_ctx(Top,Var):- nonvar(Top),current_self(Top),!,Var='&self'. -space_to_ctx(Top,Var):- 'mod-space'(Top,Var). +space_to_ctx(Top,Var):- 'mod-space'(Top,Var),!. +space_to_ctx(Var,Var). -'mod-space'(top,'&self'). +'mod-space'(top,'&top'). 'mod-space'(catalog,'&catalog'). 'mod-space'(corelib,'&corelib'). 'mod-space'(stdlib,'&stdlib'). -'mod-space'(Top,'&self'):- Top == self. +'mod-space'(Top,'&self'):- current_self(Top). not_metta_atom_corelib(A,N):- A \== '&corelib' , metta_atom('&corelib',N). @@ -1766,24 +1782,29 @@ ignore(( symbolic(Cmt),symbolic_list_concat([_,Src],'MeTTaLog: ',Cmt),!,atom_string(Src,SrcCode),do_metta(mettalog_only(From),Load,Self,SrcCode,Out))),!. do_metta(From,How,Self,Src,Out):- string(Src),!, - normalize_space(string(TaxM),Src), - convert_tax(How,Self,TaxM,Expr,NewHow),!, + must_det_ll((normalize_space(string(TaxM),Src), + convert_tax(How,Self,TaxM,Expr,NewHow))), do_metta(From,NewHow,Self,Expr,Out). do_metta(From,_,Self,exec(Expr),Out):- !, do_metta(From,exec,Self,Expr,Out). + + +% Prolog CALL do_metta(From,_,Self, call(Expr),Out):- !, do_metta(From,call,Self,Expr,Out). do_metta(From,_,Self, ':-'(Expr),Out):- !, do_metta(From,call,Self,Expr,Out). do_metta(From,call,Self,TermV,FOut):- !, if_t(into_simple_op(call,TermV,OP),pfcAdd_Now('next-operation'(OP))), call_for_term_variables(TermV,Term,NamedVarsList,X), must_be(nonvar,Term), copy_term(NamedVarsList,Was), - Output = NamedVarsList, - user:u_do_metta_exec(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut). + Output = X, + user:u_do_metta_exec(From,Self,call(TermV),Term,X,NamedVarsList,Was,Output,FOut). +% Non Exec do_metta(_File,Load,Self,Src,Out):- Load\==exec, !, if_t(into_simple_op(Load,Src,OP),pfcAdd_Now('next-operation'(OP))), dont_give_up(as_tf(asserted_do_metta(Self,Load,Src),Out)). +% Doing Exec do_metta(file(Filename),exec,Self,TermV,Out):- must_det_ll((inc_exec_num(Filename), get_exec_num(Filename,Nth), @@ -1823,13 +1844,79 @@ o_s(S,S). into_simple_op(Load,[Op|O],op(Load,Op,S)):- o_s(O,S),!. -call_for_term_variables(TermV,catch_red(show_failure(Term)),NamedVarsList,X):- - term_variables(TermV, AllVars), call_for_term_variables4v(TermV,AllVars,Term,NamedVarsList,X),!, - must_be(callable,Term). -call_for_term_variables(TermV,catch_red(show_failure(Term)),NamedVarsList,X):- - get_term_variables(TermV, DCAllVars, Singletons, NonSingletons), - call_for_term_variables5(TermV, DCAllVars, Singletons, NonSingletons, Term,NamedVarsList,X),!, - must_be(callable,Term). + +%! call_for_term_variables(+Term, +X, -Result, -NamedVarsList, +TF) is det. +% Handles the term `Term` and determines the term variable list and final result. +% This version handles the case when the term has no variables and converts it to a truth-functional form. +% +% @arg Term The input term to be analyzed. +% @arg X The list of variables found within the term. It can be empty or contain one variable. +% @arg Result The final result, either as the original term or transformed into a truth-functional form. +% @arg NamedVarsList The list of named variables associated with the term. +% @arg TF The truth-functional form when the term has no variables. +% +% @example +% % Example with no variables: +% ?- call_for_term_variables(foo, Result, Vars, TF). +% Result = as_tf(foo, TF), +% Vars = []. +% +call_for_term_variables(TermV,catch_red(show_failure(TermR)),NewNamedVarsList,X):- + subst_vars(TermV,Term,NamedVarsList), + wwdmsg(subst_vars(TermV,Term,NamedVarsList)), + term_variables(Term, AllVars), + %get_global_varnames(VNs), append(NamedVarsList,VNs,All), nb_setval('$variable_names',All), wdmsg(term_variables(Term, AllVars)=All), + term_singletons(Term, Singletons),term_dont_cares(Term, DontCares), + + wwdmsg((term_singletons(Term, Singletons),term_dont_cares(Term, DontCares))), + include(not_in_eq(Singletons), AllVars, NonSingletons), + wwdmsg([dc=DontCares, sv=Singletons, ns=NonSingletons]), !, + include(not_in_eq(DontCares), NonSingletons, CNonSingletons), + include(not_in_eq(DontCares), Singletons, CSingletons), + wwdmsg([dc=DontCares, csv=CSingletons, cns=CNonSingletons]),!, + maplist(maplist(into_named_vars), + [DontCares, CSingletons, CNonSingletons], + [DontCaresN, CSingletonsN, CNonSingletonsN]), + wwdmsg([dc_nv=DontCaresN, sv_nv=CSingletonsN, ns_nv=CNonSingletonsN]), + call_for_term_variables5(Term, DontCaresN, CNonSingletonsN, CSingletonsN, TermR, NamedVarsList, NewNamedVarsList, X),!, + wwdmsg(call_for_term_variables5(orig=Term, all=DontCaresN, singles=CSingletonsN, shared=CNonSingletonsN, call=TermR, nvl=NamedVarsList, nvlo=NewNamedVarsList, output=X)). + +wwdmsg(_). +% If the term is ground, return the as_tf form. +%call_for_term_variables5(Term,_,_,_,as_tf(Term,Ret),VL,['$RetVal'=Ret|VL],[==,['call!',Term],Ret]) :- ground(Term), !. +% If the term is ground, create a call_nth with the term. +call_for_term_variables5(Term,_,_,_,call_nth(Term,Count),VL,['Count'=Count|VL],Ret) :- Ret=Term. + + +into_metta_callable(_Self,CALL,Term,X,NamedVarsList,Was):- fail, + % wdmsg(mc(CALL)), + CALL= call(TermV), + \+ never_compile(TermV), + must_det_ll(((( + term_variables(TermV,Res), + % ignore(Res = '$VAR'('ExecRes')), + RealRes = Res, + TermV=ExecGoal, + %format("~w ~w\n",[Res,ExecGoal]), + subst_vars(Res+ExecGoal,Res+Term,NamedVarsList), + copy_term_g(NamedVarsList,Was), + term_variables(Term,Vars), + + + Call = do_metta_runtime(Res, ExecGoal), + output_language(prolog, notrace((color_g_mesg('#114411', print_pl_source(:- Call ))))), + %nl,writeq(Term),nl, + ((\+ \+ + (( + %numbervars(v(TermV,Term,NamedVarsList,Vars),999,_,[attvar(skip)]), + %nb_current(variable_names,NamedVarsList), + %nl,print(subst_vars(Term,NamedVarsList,Vars)), + nop(nl))))), + nop(maplist(verbose_unify,Vars)), + %NamedVarsList=[_=RealRealRes|_], + %var(RealRes), + X = RealRes)))),!. + into_metta_callable(_Self,TermV,Term,X,NamedVarsList,Was):- \+ never_compile(TermV), diff --git a/prolog/metta_lang/metta_loader.pl b/prolog/metta_lang/metta_loader.pl index 58067038dbe..60b9d6ea3c1 100755 --- a/prolog/metta_lang/metta_loader.pl +++ b/prolog/metta_lang/metta_loader.pl @@ -883,9 +883,11 @@ % If Filename is not a valid symbol or file does not exist, handle wildcards for includes. (\+ symbol(Filename); \+ exists_file(Filename)),!, must_det_ll(with_wild_path(include_metta(Self), Filename)),!. -include_metta1(Self, RelFilename):- + +include_metta1(WSelf, RelFilename):- % Ensure RelFilename is a valid symbol and exists as a file. must_det_ll(( + into_top_self(WSelf, Self), symbol(RelFilename), exists_file(RelFilename),!, % Convert the relative filename to an absolute path. diff --git a/prolog/metta_lang/metta_parser.pl b/prolog/metta_lang/metta_parser.pl index 46bc199afac..2dae77f8111 100644 --- a/prolog/metta_lang/metta_parser.pl +++ b/prolog/metta_lang/metta_parser.pl @@ -921,9 +921,9 @@ at_end_of_stream(Stream), !, Clause = end_of_file. read_prolog_syntax(Stream, Clause) :- % Handle errors while reading a clause. - catch(read_prolog_syntax_0(Stream, Clause), E, + catch(read_prolog_syntax_unsafe(Stream, Clause), E, throw_stream_error(Stream,E)), !. -read_prolog_syntax_0(Stream, Term) :- +read_prolog_syntax_unsafe(Stream, Term) :- % Set options for reading the clause with metadata. Options = [ variable_names(Bindings), term_position(Pos), @@ -937,12 +937,12 @@ -> true ; % Store term position and variable names. b_setval('$term_position', Pos), - b_setval('$variable_names', Bindings), + nb_setval('$variable_names', Bindings), % Display information about the term. maplist(star_vars,Bindings), nop(display_term_info(Stream, Term, Bindings, Pos, RawLayout, Comments))). -star_vars(N=V):- ignore('$'(N) = V). +star_vars(N=V):- ignore('$VAR'(N) = V). %! maybe_name_vars(+List) is det. % diff --git a/prolog/metta_lang/metta_printer.pl b/prolog/metta_lang/metta_printer.pl index 55ec7e8201a..466b3702aef 100755 --- a/prolog/metta_lang/metta_printer.pl +++ b/prolog/metta_lang/metta_printer.pl @@ -148,7 +148,7 @@ % If Term is a list, apply list-specific formatting. is_list(Term), !, writeln('---------------------'), - numbervars(Term, 666, _, [attvar(bind)]), % Bind variables for display. + numbervars(Term, 666, _, [attvar(skip)]), % Bind variables for display. write((Msg)), write(':'), nl, write_src(Term), nl. ppct(Msg, Term) :- @@ -162,14 +162,14 @@ Term = (_ = _), !, writeln('---------------------'), write((Msg)), write(':'), nl, - numbervars(Term, 444, _, [attvar(bind)]), + numbervars(Term, 444, _, [attvar(skip)]), write_src(Term), nl. ppct(Msg, Term) :- % For clauses with specific formatting needs, include variable numbering and tree display. Term = (_ :- _), !, writeln('---------------------'), write((Msg)), write(':'), nl, - numbervars(Term, 222, _, [attvar(bind)]), + numbervars(Term, 222, _, [attvar(skip)]), print_tree(Term), nl. %! pp_metta(+P) is det. @@ -190,7 +190,8 @@ % pp_metta(P) :- % Standardize variable names in P for readability. - pretty_numbervars(P, PP), + %pretty_numbervars(P, PP), + P=PP, % Pretty-print PP with the `concepts=false` option. with_option(concepts=false, pp_fb(PP)). @@ -238,6 +239,8 @@ % Run the primary source-printing predicate within `run_pl_source/1`. run_pl_source(print_pl_source0(P)). +pnotrace(G):- quietly(G). + %! run_pl_source(+G) is det. % % Executes a goal `G` safely, catching any errors and attempting a retry with tracing if needed. @@ -273,13 +276,13 @@ % print_pl_source0(_) :- % Do not print if compatibility mode is enabled. - notrace(is_compatio), !. + pnotrace(is_compatio), !. print_pl_source0(_) :- % Do not print if silent loading mode is enabled. - notrace(silent_loading), !. + pnotrace(silent_loading), !. print_pl_source0(P) :- % Check if P was just printed (avoid redundant printing). - notrace((just_printed(PP), PP =@= P)), !. + pnotrace((just_printed(PP), PP =@= P)), !. print_pl_source0((A :- B)) :- % For rules (A :- B), display using portray_clause for readability. !,portray_clause((A :- B)). @@ -517,7 +520,7 @@ var(V), !, write_dvar(V), !. is_final_write('$VAR'(S)) :- % For '$VAR' structures, write the variable name S. - !, write_dvar(S), !. + !, write_dvar(S), !. is_final_write('#\\'(S)) :- % For special character format `#\S`, write S in single quotes. !, format("'~w'", [S]). @@ -710,47 +713,53 @@ % Writes the source of a term `V` with indentation enabled. % % This predicate sets indentation mode on by calling `with_indents/2` with `true`, -% and then writes the source of `V` using `write_src/1`. The use of `notrace/1` +% and then writes the source of `V` using `write_src/1`. The use of `pnotrace/1` % ensures that tracing is disabled during this operation. % % @arg V The term whose source is to be written with indentation. % write_src_wi(V) :- % Enable indentation and write the source of V. - notrace((with_indents(true, write_src(V)))). + pnotrace((with_indents(true, write_src(V)))). %! write_src(+V) is det. % % Writes the source of a term `V` after guessing Metta variables. % % This predicate first tries to identify variables in `V` using `guess_metta_vars/1` -% and then formats `V` for output using `pp_sex/1`. The `notrace/1` wrapper +% and then formats `V` for output using `pp_sex/1`. The `pnotrace/1` wrapper % ensures tracing is turned off. % % @arg V The term to be written as source. % write_src(V) :- % Guess variables in V and pretty-print using `pp_sex/1`. - \+ \+ notrace((src_vars(V, I), pp_sex(I))), !. + \+ \+ pnotrace((src_vars(V, I), pp_sex(I))), !. print_compounds_special:- true. +src_vars(V,I):- var(V),!,I=V. src_vars(V,I):- %ignore(guess_metta_vars(V)), - ignore(guess_varnames(V,I)), - ignore(numbervars(V,10000,_,[singleton(true),attvar(skip)])). - + pre_guess_varnames(V,II),ignore(II=V), + guess_varnames(II,I), + nop(ignore(numbervars(I,10000,_,[singleton(true),attvar(skip)]))). +pre_guess_varnames(V,I):- \+ compound(V),!,I=V. +pre_guess_varnames(V,I):- functor(V,F,A),functor(II,F,A), metta_file_buffer(_, _, _, II, Vs, _,_), Vs\==[], I=@=II, I=II, V=I,maybe_name_vars(Vs),!. +pre_guess_varnames(V,I):- is_list(V),!,maplist(pre_guess_varnames,V,I). +pre_guess_varnames(C,I):- compound_name_arguments(C,F,V),!,maplist(pre_guess_varnames,V,VV),compound_name_arguments(I,F,VV),!. +pre_guess_varnames(V,V). %! write_src_woi(+Term) is det. % % Writes the source of a term `Term` with indentation disabled. % % This predicate calls `with_indents/2` with `false` to disable indentation, -% and then writes `Term` using `write_src/1`. The `notrace/1` wrapper ensures +% and then writes `Term` using `write_src/1`. The `pnotrace/1` wrapper ensures % that tracing is disabled. % % @arg Term The term to be written without indentation. % write_src_woi(Term) :- % Disable indentation and write the source of Term. - notrace((with_indents(false, write_src(Term)))). + pnotrace((with_indents(false, write_src(Term)))). %! write_src_woi_nl(+X) is det. % @@ -764,7 +773,7 @@ % write_src_woi_nl(X) :- % Guess variables in X, add newlines, and write without indentation. - \+ \+ notrace(( + \+ \+ pnotrace(( format('~N'), write_src_woi(X), format('~N') )). diff --git a/prolog/metta_lang/metta_repl.pl b/prolog/metta_lang/metta_repl.pl index 454f5747871..d91ebe034d3 100755 --- a/prolog/metta_lang/metta_repl.pl +++ b/prolog/metta_lang/metta_repl.pl @@ -152,6 +152,10 @@ % ?- save_history. % true. % +:- if(is_win64). +% Dummy to avoid errors on windows. +save_history. +:- else. save_history :- % Get the current input stream. current_input(Input), @@ -163,6 +167,7 @@ ; % Otherwise, do nothing. true). +:- endif. %! load_and_trim_history is det. % Loads and trims the REPL history if needed, and installs readline support. @@ -420,31 +425,6 @@ % If the input stream is not provided, do nothing. read_pending_white_codes(_). -%! call_for_term_variables4v(+Term, +X, -Result, -NamedVarsList, +TF) is det. -% Handles the term `Term` and determines the term variable list and final result. -% This version handles the case when the term has no variables and converts it to a truth-functional form. -% -% @arg Term The input term to be analyzed. -% @arg X The list of variables found within the term. It can be empty or contain one variable. -% @arg Result The final result, either as the original term or transformed into a truth-functional form. -% @arg NamedVarsList The list of named variables associated with the term. -% @arg TF The truth-functional form when the term has no variables. -% -% @example -% % Example with no variables: -% ?- call_for_term_variables4v(foo, [], Result, Vars, true). -% Result = as_tf(foo, true), -% Vars = []. -% -call_for_term_variables4v(Term, [], as_tf(Term, TF), NamedVarsList, TF) :- - % Get global variable names for the term. - get_global_varnames(NamedVarsList), - % Succeed if no variables are present. - !. -% Handles the case when the term has one variable and passes the term as-is. -call_for_term_variables4v(Term, [X], Term, NamedVarsList, X) :- - % Get global variable names for the term. - get_global_varnames(NamedVarsList). %! balanced_parentheses(+Str) is semidet. % Checks if parentheses are balanced in a string or list of characters `Str`. @@ -604,9 +584,10 @@ % repl_read_next(NewAccumulated, Expr) :- % Concatenate the input with '.' and try to interpret it as an atom. - symbol_concat(Atom,'.',NewAccumulated), + symbol_concat(_Atom,'.',NewAccumulated), % Attempt to read the term from the atom, handle errors and retry if necessary. - catch_err((read_term_from_atom(Atom, Term, []), Expr = call(Term)), E, + open_string(NewAccumulated,Stream), + catch_err((read_prolog_syntax_unsafe(Stream, Term), Expr = call(Term)), E, (((fail, write('Syntax error: '), writeq(E), nl, repl_read_next(Expr))))), !. % Previously commented: repl_read_next(Str, Expr):- ((clause(t_l:s_reader_info(Expr),_,Ref),erase(Ref))). @@ -781,45 +762,6 @@ % Directive to set a global variable for variable names. :- nb_setval(variable_names, []). -%! call_for_term_variables5(+Term, +DC, +Vars1, +Vars2, -CallTerm, -DCVars, -TF) is det. -% -% Processes term variables and generates a call structure based on the provided term, -% handling cases with ground terms, single variables, and multiple variables. -% -% @arg Term The input term to process. -% @arg DC The direct constraints or variables list (can be empty). -% @arg Vars1 The first set of variables (e.g., `[Var=Value]` format). -% @arg Vars2 The second set of variables. -% @arg CallTerm The generated term call (e.g., `call_nth/2` or `as_tf/2`). -% @arg DCVars The combined list of variables or constraints. -% @arg TF The variable or value associated with the call. -% -% @example Handling a ground term: -% ?- call_for_term_variables5(hello, [], [], [], CallTerm, DCVars, TF). -% CallTerm = as_tf(hello, TF), -% DCVars = [], -% TF = _. -% -% @example Single variable case: -% ?- call_for_term_variables5(hello, [], [], [X=_], CallTerm, DCVars, TF). -% CallTerm = call_nth(hello, Count), -% DCVars = ['Count' = Count], -% TF = X. -% - % If the term is ground, return the as_tf form. -call_for_term_variables5(Term,[],[],[],as_tf(Term,TF),[],TF) :- ground(Term), !. - % If the term is ground, create a call_nth with the term. -call_for_term_variables5(Term,DC,[],[],call_nth(Term,TF),DC,TF) :- ground(Term), !. -% If there is one variable, set the term to call_nth. -call_for_term_variables5(Term,_,[],[_=Var],call_nth(Term,Count),['Count'=Count],Var). -% Similar case when the variable is reversed in arguments. -call_for_term_variables5(Term,_,[_=Var],[],call_nth(Term,Count),['Count'=Count],Var). -% If both term variables and equal variable are present, pass them along. -call_for_term_variables5(Term,_,Vars,[_=Var],Term,Vars,Var). -% Same case but with the variables reversed. -call_for_term_variables5(Term,_,[_=Var],Vars,Term,Vars,Var). -% Handle case with more than one variable, generating a call_nth. -call_for_term_variables5(Term,_,SVars,Vars,call_nth(Term,Count),[Vars,SVars],Count). %! is_interactive(+From) is nondet. % @@ -2038,12 +1980,18 @@ % This installs readline/editline support, allowing for line editing and history during input. :- dynamic(is_installed_readline_editline/1). :- volatile(is_installed_readline_editline/1). + +:- if(is_win64). +% dummy for on windows +install_readline_editline. +:-else. install_readline_editline :- % Get the current input stream. current_input(Input), % Install readline support for the current input. install_readline(Input), !. +:- endif. %! el_wrap_metta(+Input) is det. % diff --git a/prolog/metta_lang/metta_space.pl b/prolog/metta_lang/metta_space.pl index a3cc1efe46c..9d1a65eba2a 100755 --- a/prolog/metta_lang/metta_space.pl +++ b/prolog/metta_lang/metta_space.pl @@ -377,7 +377,8 @@ % @example Clear all atoms from a space: % ?- 'clear-atoms'('my_space'). % -'clear-atoms'(SpaceNameOrInstance) :- +'clear-atoms'(DynSpace) :- + into_top_self(DynSpace, SpaceNameOrInstance), % Log the operation of clearing atoms from the specified space. dout(space, ['clear-atoms', SpaceNameOrInstance]), % Retrieve the appropriate method for clearing the space based on its type. @@ -404,7 +405,8 @@ % @example Add an atom to a space: % ?- 'add-atom'('my_space', my_atom). % -'add-atom'(SpaceNameOrInstance, Atom) :- +'add-atom'(DynSpace, Atom) :- + into_top_self(DynSpace, SpaceNameOrInstance), % Retrieve the method for adding an atom based on the space type. ((space_type_method(Type, add_atom, Method), % Ensure the space type matches by calling the type predicate. @@ -447,7 +449,8 @@ % @example Remove an atom from a space: % ?- 'remove-atom'('my_space', my_atom). % -'remove-atom'(SpaceNameOrInstance, Atom) :- +'remove-atom'(DynSpace, Atom) :- + into_top_self(DynSpace, SpaceNameOrInstance), % Log the operation of removing an atom from the specified space. dout(space, ['remove-atom', SpaceNameOrInstance, Atom]), % Retrieve the method for removing an atom based on the space type. @@ -494,7 +497,8 @@ % @example Replace an atom in a space: % ?- 'replace-atom'('my_space', old_atom, new_atom). % -'replace-atom'(SpaceNameOrInstance, Atom, New) :- +'replace-atom'(DynSpace, Atom, New) :- + into_top_self(DynSpace, SpaceNameOrInstance), dout(space, ['replace-atom', SpaceNameOrInstance, Atom, New]), space_type_method(Type, replace_atom, Method), call(Type, SpaceNameOrInstance), @@ -536,7 +540,8 @@ % ?- 'atom-count'(env, Count). % Count = 10. % -'atom-count'(SpaceNameOrInstance, Count) :- +'atom-count'(DynSpace, Count) :- + into_top_self(DynSpace, SpaceNameOrInstance), dout(space, ['atom-count', SpaceNameOrInstance]), space_type_method(Type, atom_count, Method), call(Type, SpaceNameOrInstance), !, @@ -568,7 +573,8 @@ % ?- get-atoms('env1', Atoms). % Atoms = [atomA, atomB, atomC]. % -'get-atoms'(SpaceNameOrInstance, AtomsL) :- +'get-atoms'(DynSpace, AtomsL) :- + into_top_self(DynSpace, SpaceNameOrInstance), % Output a debug message indicating the 'get-atoms' request to the space. dout(space, ['get-atoms', SpaceNameOrInstance]), % Determine the method for retrieving atoms based on the space type. @@ -598,7 +604,8 @@ % @example Iterate over atoms in a space: % ?- 'atoms_iter'('my_space', Iter). % -'atoms_iter'(SpaceNameOrInstance, Iter) :- +'atoms_iter'(DynSpace, Iter) :- + into_top_self(DynSpace, SpaceNameOrInstance), dout(space, ['atoms_iter', SpaceNameOrInstance]), space_type_method(Type, atoms_iter, Method), call(Type, SpaceNameOrInstance), @@ -621,7 +628,8 @@ % @example Match atoms in a space: % ?- 'atoms_match'('my_space', Atoms, my_template, else_clause). % -'atoms_match'(SpaceNameOrInstance, Atoms, Template, Else) :- +'atoms_match'(DynSpace, Atoms, Template, Else) :- + into_top_self(DynSpace, SpaceNameOrInstance), space_type_method(Type, atoms_match, Method), call(Type, SpaceNameOrInstance), !, @@ -642,7 +650,8 @@ % @example Query a space for an atom: % ?- 'space_query'('my_space', query_atom, Result). % -'space_query'(SpaceNameOrInstance, QueryAtom, Result) :- +'space_query'(DynSpace, QueryAtom, Result) :- + into_top_self(DynSpace, SpaceNameOrInstance), space_type_method(Type, query, Method), call(Type, SpaceNameOrInstance), !, @@ -663,7 +672,8 @@ % ?- subst_pattern_template('example_space', some_pattern, Template). % Template = [substituted_atom1, substituted_atom2]. % -subst_pattern_template(SpaceNameOrInstance, Pattern, Template) :- +subst_pattern_template(DynSpace, Pattern, Template) :- + into_top_self(DynSpace, SpaceNameOrInstance), % Log the operation for traceability. dout(space, [subst_pattern_template, SpaceNameOrInstance, Pattern, Template]), % Match and substitute atoms in the given space according to the pattern. @@ -689,10 +699,12 @@ % ?- was_asserted_space('&self'). % true. % -was_asserted_space('&self'). +was_asserted_space('&self'):- current_self(X), (X=='&self'->true;was_asserted_space(X)). was_asserted_space('&stdlib'). was_asserted_space('&corelib'). was_asserted_space('&flybase'). +was_asserted_space('&top'). +was_asserted_space('&catalog'). /* was_asserted_space('&attentional_focus'). was_asserted_space('&belief_events'). @@ -1336,9 +1348,12 @@ % % Get the atom count for a loaded context. % ?- atom_count_provider(some_context, Count). % -atom_count_provider(Self, Count) :- + + +atom_count_provider(SpaceNameOrInstance, Count) :- + into_top_self(SpaceNameOrInstance, DynSpace), % Check if the context has been loaded into a knowledge base (KB). - user:loaded_into_kb(Self, Filename), + user:loaded_into_kb(DynSpace, Filename), % Retrieve the associated predicate for the given filename. once(user:asserted_metta_pred(Mangle, Filename)), % Derive a related predicate from the original. @@ -1355,8 +1370,9 @@ predicate_property(Data, number_of_rules(RC)), % Calculate the atom count as the difference between clauses and rules. Count is CC - RC. -atom_count_provider(KB, Count) :- +atom_count_provider(SpaceNameOrInstance, Count) :- must_det_ll(( + into_top_self(SpaceNameOrInstance, KB), % Predicate for asserted atoms. AMA = metta_atom_asserted, % Declare the predicate with arity 2. @@ -1406,7 +1422,8 @@ % % Iterate over atoms in 'example_kb' and retrieve them. % ?- metta_assertdb_iter('example_kb', Atom). % -metta_assertdb_iter(KB, Atoms) :- +metta_assertdb_iter(SpaceNameOrInstance, Atoms) :- + into_top_self(SpaceNameOrInstance, KB), % Dynamically construct the predicate for the given KB. MP =.. [metta_atom, KB, Atoms], % Call the constructed predicate to retrieve atoms. @@ -1427,7 +1444,8 @@ % % Execute a query against the KB and bind variables. % ?- metta_iter_bind('example_kb', my_query(X), Vars, ['X']). % -metta_iter_bind(KB, Query, Vars, VarNames) :- +metta_iter_bind(SpaceNameOrInstance, Query, Vars, VarNames) :- + into_top_self(SpaceNameOrInstance, KB), % Extract all variables from the query. term_variables(Query, QVars), % Align the provided variable names with the query variables. @@ -1460,7 +1478,8 @@ % % Query the KB and retrieve bound variables. % ?- space_query_vars('example_kb', my_query(X), Vars). % -space_query_vars(KB, Query, Vars) :- +space_query_vars(SpaceNameOrInstance, Query, Vars) :- + into_top_self(SpaceNameOrInstance, KB), % Check if the knowledge base is an asserted space. is_asserted_space(KB), !, % Declare the predicate for asserted atoms with arity 2. diff --git a/prolog/metta_lang/metta_subst.pl b/prolog/metta_lang/metta_subst.pl index 59b13682fd4..7e9f137ac6e 100755 --- a/prolog/metta_lang/metta_subst.pl +++ b/prolog/metta_lang/metta_subst.pl @@ -65,7 +65,7 @@ self_subst('True'). self_subst('False'). self_subst('F'). %' -:- nb_setval(self_space, '&self'). % ' +%:- nb_setval(self_space, '&self'). % ' substs_to(XX,Y):- Y==XX,!. substs_to(XX,Y):- Y=='True',!, is_True(XX),!. %' @@ -256,7 +256,7 @@ set_last_error(_). */ -subst_args1(Eq,RetType,Depth, Self, [OP|ARGS], Template):- +subst_args1(Eq,RetType,Depth, Self, [OP|ARGS], Template):- fail, is_space_op(OP), !, subst_args_as(Depth, Self, [OP|ARGS], Template). @@ -714,11 +714,11 @@ % user defined function -subst_args2(Eq,Depth,Self,[H|PredDecl],Res):- mnotrace(is_user_defined_head(Eq,Self,H)),!, +subst_args2(Eq,Depth,Self,[H|PredDecl],Res):- fail,mnotrace(is_user_defined_head(Eq,Self,H)),!, subst_args30(Eq,Depth,Self,[H|PredDecl],Res). % function inherited by system -subst_args2(Eq,Depth,Self,PredDecl,Res):- subst_args40(Eq,Depth,Self,PredDecl,Res). +subst_args2(Eq,Depth,Self,PredDecl,Res):- fail, subst_args40(Eq,Depth,Self,PredDecl,Res). /* last_element(T,E):- \+ compound(T),!,E=T. @@ -843,7 +843,7 @@ */ -subst_args30(Eq,Depth,Self,H,B):- (subst_args34(Depth,Self,H,B)*->true;subst_args37(Eq,Depth,Self,H,B)). +subst_args30(Eq,Depth,Self,H,B):- fail, (subst_args34(Depth,Self,H,B)*->true;subst_args37(Eq,Depth,Self,H,B)). subst_args34(_Dpth,Self,H,B):- (metta_eq_def(Eq,Self,H,B);(get_metta_atom(Eq,Self,H),B=H)). diff --git a/prolog/metta_lang/stdlib_mettalog.metta b/prolog/metta_lang/stdlib_mettalog.metta index 3bfb94a1a90..45bb95eb2ba 100644 --- a/prolog/metta_lang/stdlib_mettalog.metta +++ b/prolog/metta_lang/stdlib_mettalog.metta @@ -97,8 +97,11 @@ (= (If False $then) (let $n 0 (let $n 1 $n))) (= (If $cond $then $else) (if $cond $then $else)) -(iz predicate-arity MeTTaLog) +(@doc type-check + (@desc "The value of type-check determines MeTTa's type-checking behavior. Set via pragma!. When set to auto (i.e. !(pragma! type-check auto)), types are checked immediately on adding an expression to the space. By default, when unset (or set to anything other than auto), types are checked only on evaluation. For example !(+ 1 \"2\") would trigger a type violation, but (= (foo $x) (+ $x \"2\")) would not, unless type-check is set to auto, in which case both would trigger type violations.")) +(: type-check Symbol) +(iz predicate-arity MeTTaLog) (@doc predicate-arity (@desc "Specifies the arity (number of arguments) for a given predicate, allowing it to be queriable in the system's match framework. This is particularly useful for enabling built-in functions, such as `size-atom`, to be used as predicates in declarative contexts and run in reverse to compute inputs based on outputs. From 128129ff3bb1a11d2446d93c10c2d6f9f088b95a Mon Sep 17 00:00:00 2001 From: logicmoo Date: Sat, 21 Dec 2024 18:12:03 -0800 Subject: [PATCH 30/42] fixed == --- prolog/metta_lang/metta_eval.pl | 64 +++++++++++++++++++-------------- 1 file changed, 37 insertions(+), 27 deletions(-) diff --git a/prolog/metta_lang/metta_eval.pl b/prolog/metta_lang/metta_eval.pl index 7eaebd955f8..261f4760d3a 100755 --- a/prolog/metta_lang/metta_eval.pl +++ b/prolog/metta_lang/metta_eval.pl @@ -514,26 +514,32 @@ unified(X,Y):- eval(X,XX),X\=@=XX,unified(Y,XX). unified(X,Y):- eval(Y,YY),Y\=@=YY,unified(YY,X). -eval_until_unify(_Eq,_RetType,_Dpth,_Slf,X,X):- !. -eval_until_unify(Eq,RetType,Depth,Self,X,Y):- eval_until_eq(Eq,RetType,Depth,Self,X,Y),!. - -eval_until_eq(_Eq,_RetType,_Dpth,_Slf,X,Y):- notrace(catch_nowarn(X=:=Y)),!. -eval_until_eq(_Eq,_RetType,_Dpth,_Slf,X,Y):- notrace(catch_nowarn('#='(X,Y))),!. -eval_until_eq(Eq,RetType,_Dpth,_Slf,X,Y):- X=Y,check_returnval(Eq,RetType,Y). -%eval_until_eq(Eq,RetType,Depth,Self,X,Y):- var(Y),!,eval_in_steps_or_same(Eq,RetType,Depth,Self,X,XX),Y=XX. -%eval_until_eq(Eq,RetType,Depth,Self,Y,X):- var(Y),!,eval_in_steps_or_same(Eq,RetType,Depth,Self,X,XX),Y=XX. -eval_until_eq(Eq,RetType,Depth,Self,X,Y):- \+is_list(Y),!,eval_in_steps_some_change(Eq,RetType,Depth,Self,X,XX),Y=XX. -eval_until_eq(Eq,RetType,Depth,Self,Y,X):- \+is_list(Y),!,eval_in_steps_some_change(Eq,RetType,Depth,Self,X,XX),Y=XX. -eval_until_eq(Eq,RetType,Depth,Self,X,Y):- eval_in_steps_some_change(Eq,RetType,Depth,Self,X,XX),eval_until_eq(Eq,RetType,Depth,Self,Y,XX). -eval_until_eq(_Eq,_RetType,_Dpth,_Slf,X,Y):- length(X,Len), \+ length(Y,Len),!,fail. -eval_until_eq(Eq,RetType,Depth,Self,X,Y):- nth1(N,X,EX,RX), nth1(N,Y,EY,RY), - EX=EY,!, maplist(eval_until_eq(Eq,RetType,Depth,Self),RX,RY). -eval_until_eq(Eq,RetType,Depth,Self,X,Y):- nth1(N,X,EX,RX), nth1(N,Y,EY,RY), - ((var(EX);var(EY)),eval_until_eq(Eq,RetType,Depth,Self,EX,EY)), - maplist(eval_until_eq(Eq,RetType,Depth,Self),RX,RY). -eval_until_eq(Eq,RetType,Depth,Self,X,Y):- nth1(N,X,EX,RX), nth1(N,Y,EY,RY), - h((is_list(EX);is_list(EY)),eval_until_eq(Eq,RetType,Depth,Self,EX,EY)), - maplist(eval_until_eq(Eq,RetType,Depth,Self),RX,RY). +eval_until_unify([h_e|_],Eq,RetType,Depth,Self,X,Y):- var(Y),!,X==Y. +eval_until_unify([h_e|_],Eq,RetType,Depth,Self,X,Y):- var(X),!,X==Y. +eval_until_unify(Flags,Eq,RetType,Depth,Self,X,Y):- + eval_until_eq(Flags,Eq,RetType,Depth,Self,X,Y),!. + + +eval_until_eq(_Flags,Eq,RetType,_Dpth,_Slf,X,Y):- X==Y,!,check_returnval(Eq,RetType,Y). +eval_until_eq(_Flags,_Eq,_RetType,_Dpth,_Slf,X,Y):- notrace(catch_nowarn(X=:=Y)),!. +eval_until_eq(_Flags,_Eq,_RetType,_Dpth,_Slf,X,Y):- notrace(catch_nowarn('#='(X,Y))),!. +%eval_until_eq(Flags,Eq,RetType,_Dpth,_Slf,X,Y):- X\=@=Y,X=Y,!,check_returnval(Eq,RetType,Y). +eval_until_eq(_Flags,Eq,RetType,Depth,Self,X,Y):- \+is_list(Y),!,eval_in_steps_some_change(Eq,RetType,Depth,Self,X,XX),XX=Y. +eval_until_eq(_Flags,Eq,RetType,Depth,Self,X,Y):- \+is_list(X),!,eval_in_steps_some_change(Eq,RetType,Depth,Self,Y,YY),X=YY. +eval_until_eq(_Flags,Eq,RetType,_Dpth,_Slf,X,Y):- X=Y,!,check_returnval(Eq,RetType,Y). + +eval_until_eq(Flags,Eq,RetType,Depth,Self,X,Y):- eval_in_steps_some_change(Eq,RetType,Depth,Self,X,XX),eval_until_eq(Flags,Eq,RetType,Depth,Self,Y,XX),!. + + +eval_until_eq(Flags,_Eq,_RetType,_Dpth,_Slf,X,Y):- length(X,Len), \+ length(Y,Len),!,fail. +eval_until_eq(Flags,Eq,RetType,Depth,Self,X,Y):- nth1(N,X,EX,RX), nth1(N,Y,EY,RY), + EX=EY,!, maplist(eval_until_eq(Flags,Eq,RetType,Depth,Self),RX,RY). +eval_until_eq(Flags,Eq,RetType,Depth,Self,X,Y):- nth1(N,X,EX,RX), nth1(N,Y,EY,RY), + ((var(EX);var(EY)),eval_until_eq(Flags,Eq,RetType,Depth,Self,EX,EY)), + maplist(eval_until_eq(Flags,Eq,RetType,Depth,Self),RX,RY). +eval_until_eq(Flags,Eq,RetType,Depth,Self,X,Y):- nth1(N,X,EX,RX), nth1(N,Y,EY,RY), + h((is_list(EX);is_list(EY)),eval_until_eq(Flags,Eq,RetType,Depth,Self,EX,EY)), + maplist(eval_until_eq(Flags,Eq,RetType,Depth,Self),RX,RY). eval_1change(Eq,RetType,Depth,Self,EX,EXX):- eval_20(Eq,RetType,Depth,Self,EX,EXX), EX \=@= EXX. @@ -542,10 +548,14 @@ eval_args(Eq,RetType,Depth,Self,EX,EXX), EX \=@= EXX. eval_in_steps_some_change(_Eq,_RetType,_Dpth,_Slf,EX,_):- \+ is_list(EX),!,fail. -eval_in_steps_some_change(Eq,RetType,Depth,Self,EX,EXX):- eval_1change(Eq,RetType,Depth,Self,EX,EXX). -eval_in_steps_some_change(Eq,RetType,Depth,Self,X,Y):- append(L,[EX|R],X),is_list(EX), - eval_in_steps_some_change(Eq,RetType,Depth,Self,EX,EXX), EX\=@=EXX, - append(L,[EXX|R],XX),eval_in_steps_or_same(Eq,RetType,Depth,Self,XX,Y). +eval_in_steps_some_change(Eq,RetType,Depth,Self,EX,EXXO):- + eval_1change(Eq,RetType,Depth,Self,EX,EXX),!, + (eval_in_steps_some_change(Eq,RetType,Depth,Self,EXX,EXXO);EXXO=EXX). +eval_in_steps_some_change(Eq,RetType,Depth,Self,X,Y):- + append(L,[EX|R],X),is_list(EX), + eval_in_steps_some_change(Eq,RetType,Depth,Self,EX,EXX), EX\=@=EXX, + append(L,[EXX|R],XX), + eval_in_steps_or_same(Eq,RetType,Depth,Self,XX,Y). eval_in_steps_or_same(Eq,RetType,Depth,Self,X,Y):-eval_in_steps_some_change(Eq,RetType,Depth,Self,X,Y). eval_in_steps_or_same(Eq,RetType,_Dpth,_Slf,X,Y):- X=Y,check_returnval(Eq,RetType,Y). @@ -592,7 +602,7 @@ %eval_20(Eq,RetType,Depth,Self,['let',V,E,Body],BodyO):- !,eval_args(Eq,RetType,Depth,Self,E,V),eval_args(Eq,RetType,Depth,Self,Body,BodyO). eval_20(Eq,RetType,Depth,Self,['let*',[],Body],RetVal):- !, eval_args(Eq,RetType,Depth,Self,Body,RetVal). %eval_20(Eq,RetType,Depth,Self,['let*',[[Var,Val]|LetRest],Body],RetVal):- !, -% eval_until_unify(Eq,_RetTypeV,Depth,Self,Val,Var), +% eval_until_unify(Flags,Eq,_RetTypeV,Depth,Self,Val,Var), % eval_20(Eq,RetType,Depth,Self,['let*',LetRest,Body],RetVal). eval_20(Eq,RetType,Depth,Self,['let*',[[Var,Val]|LetRest],Body],RetVal):- !, eval_20(Eq,RetType,Depth,Self,['let',Var,Val,['let*',LetRest,Body]],RetVal). @@ -2275,11 +2285,11 @@ eval_20(Eq,RetType,Depth,Self,['==', X,Y],TF):- !, suggest_type(RetType,'Bool'), - as_tf(eval_until_unify(Eq,_SharedType,Depth,Self,X,Y), TF). + (eval_until_unify([h_e,'=='],Eq,_SharedType,Depth,Self,X,Y)->TF='True';TF='False'). eval_20(Eq,RetType,Depth,Self,_Slf,['===',X,Y],TF):- !, suggest_type(RetType,'Bool'), - as_tf(\+ \+ eval_until_unify(Eq,_SharedType,Depth,Self,X,Y), TF). + as_tf(\+ \+ eval_until_unify(['==='],Eq,_SharedType,Depth,Self,X,Y), TF). eval_20(_Eq,RetType,_Dpth,_Slf,['====',X,Y],TF):- !, suggest_type(RetType,'Bool'), From 6fedd5132054e1c29da7dc014178a585b74c15c6 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Sat, 21 Dec 2024 18:53:26 -0800 Subject: [PATCH 31/42] eval_until_unify_self --- prolog/metta_lang/metta_eval.pl | 27 +++++++++++++++++++-------- 1 file changed, 19 insertions(+), 8 deletions(-) diff --git a/prolog/metta_lang/metta_eval.pl b/prolog/metta_lang/metta_eval.pl index 261f4760d3a..7e92404e8a2 100755 --- a/prolog/metta_lang/metta_eval.pl +++ b/prolog/metta_lang/metta_eval.pl @@ -514,10 +514,13 @@ unified(X,Y):- eval(X,XX),X\=@=XX,unified(Y,XX). unified(X,Y):- eval(Y,YY),Y\=@=YY,unified(YY,X). -eval_until_unify([h_e|_],Eq,RetType,Depth,Self,X,Y):- var(Y),!,X==Y. -eval_until_unify([h_e|_],Eq,RetType,Depth,Self,X,Y):- var(X),!,X==Y. -eval_until_unify(Flags,Eq,RetType,Depth,Self,X,Y):- - eval_until_eq(Flags,Eq,RetType,Depth,Self,X,Y),!. +eval_until_unify(_Eq,_RetType,_Dpth,_Slf,X,X):- !. + + +eval_until_unify_self([h_e|_],Eq,RetType,Depth,Self,X,Y, Res):- var(Y),!,as_tf(X==Y, Res). +eval_until_unify_self([h_e|_],Eq,RetType,Depth,Self,X,Y, Res):- var(X),!,as_tf(X==Y, Res). +eval_until_unify_self(Flags,Eq,RetType,Depth,Self,X,Y):- + as_tf(eval_until_eq(Flags,Eq,RetType,Depth,Self,X,Y),Res). eval_until_eq(_Flags,Eq,RetType,_Dpth,_Slf,X,Y):- X==Y,!,check_returnval(Eq,RetType,Y). @@ -553,7 +556,7 @@ (eval_in_steps_some_change(Eq,RetType,Depth,Self,EXX,EXXO);EXXO=EXX). eval_in_steps_some_change(Eq,RetType,Depth,Self,X,Y):- append(L,[EX|R],X),is_list(EX), - eval_in_steps_some_change(Eq,RetType,Depth,Self,EX,EXX), EX\=@=EXX, + eval_in_steps_some_change(Eq,RetType,Depth,Self,EX,EXX), EX\=@=EXX, append(L,[EXX|R],XX), eval_in_steps_or_same(Eq,RetType,Depth,Self,XX,Y). @@ -602,7 +605,7 @@ %eval_20(Eq,RetType,Depth,Self,['let',V,E,Body],BodyO):- !,eval_args(Eq,RetType,Depth,Self,E,V),eval_args(Eq,RetType,Depth,Self,Body,BodyO). eval_20(Eq,RetType,Depth,Self,['let*',[],Body],RetVal):- !, eval_args(Eq,RetType,Depth,Self,Body,RetVal). %eval_20(Eq,RetType,Depth,Self,['let*',[[Var,Val]|LetRest],Body],RetVal):- !, -% eval_until_unify(Flags,Eq,_RetTypeV,Depth,Self,Val,Var), +% eval_until_unify_self(Flags,Eq,_RetTypeV,Depth,Self,Val,Var), % eval_20(Eq,RetType,Depth,Self,['let*',LetRest,Body],RetVal). eval_20(Eq,RetType,Depth,Self,['let*',[[Var,Val]|LetRest],Body],RetVal):- !, eval_20(Eq,RetType,Depth,Self,['let',Var,Val,['let*',LetRest,Body]],RetVal). @@ -2283,10 +2286,18 @@ */ %eval_40(Eq,RetType,_Dpth,_Slf,['==',X,Y],Res):- !, subst_args(Eq,RetType,_Dpth,_Slf,['==',X,Y],Res). -eval_20(Eq,RetType,Depth,Self,['==', X,Y],TF):- !, +eval_20(Eq,RetType,Depth,Self,['==', X,Y],Res):- suggest_type(RetType,'Bool'), - (eval_until_unify([h_e,'=='],Eq,_SharedType,Depth,Self,X,Y)->TF='True';TF='False'). + eval_until_unify_self([h_e,'=='],Eq,_SharedType,Depth,Self,X,Y, Res), + (Res=='False' -> (!, fail) ; fail). +%eval_40(Eq,RetType,_Depth,Self,[EQ,X,Y],TF):- fail, EQ=='==', !, +% suggest_type(RetType,'Bool'), +% as_tf(eval_until_unify(Eq,_SharedType, X, Y), TF). +eval_40(Eq,RetType,Depth,Self,['==',X,Y],TF):- !, + suggest_type(RetType,'Bool'), + as_tf(eval_until_eq(Eq,_SharedType, Depth,Self, X, Y), TF). + eval_20(Eq,RetType,Depth,Self,_Slf,['===',X,Y],TF):- !, suggest_type(RetType,'Bool'), as_tf(\+ \+ eval_until_unify(['==='],Eq,_SharedType,Depth,Self,X,Y), TF). From f3cdc3a9e7255ff8973db23cc4ba55a9f14fd0e4 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Sat, 21 Dec 2024 19:14:33 -0800 Subject: [PATCH 32/42] fixes for d4_type_prop.metta --- prolog/metta_lang/metta_types.pl | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/prolog/metta_lang/metta_types.pl b/prolog/metta_lang/metta_types.pl index 60cc59dd6e8..fab1a5f9edd 100755 --- a/prolog/metta_lang/metta_types.pl +++ b/prolog/metta_lang/metta_types.pl @@ -441,7 +441,8 @@ % Ensure no repeated types using no_repeats_var/1. no_repeats_var(NoRepeatType), % Retrieve the type of the value. - get_type_each(Depth, Self, Val, Type), Type\=='', + call_nth(get_type_each(Depth, Self, Val, Type),Nth), Type\=='', + (Nth >1 -> Type\== 'Atom' ; true), % Ensure the type matches the expected no-repeat type. NoRepeatType = Type, Type = TypeO, @@ -618,6 +619,7 @@ trace_get_type(How, Type, gt(Val))), (trace_get_type('FAILED', '', gt(Val)), fail)). + %! get_type_cmpd_2nd_non_nil(+Depth, +Self, +Val, -Type, -How) is nondet. % % Determines the type of a compound value, ensuring that if multiple types From afb6d79bc07c19c4864ed7bab3157ac7ed502bf9 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Sat, 21 Dec 2024 22:08:27 -0800 Subject: [PATCH 33/42] subst_args34 --- prolog/metta_lang/metta_subst.pl | 10 +++++----- prolog/metta_lang/metta_types.pl | 2 +- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/prolog/metta_lang/metta_subst.pl b/prolog/metta_lang/metta_subst.pl index 7e9f137ac6e..dca4c5c256f 100755 --- a/prolog/metta_lang/metta_subst.pl +++ b/prolog/metta_lang/metta_subst.pl @@ -256,7 +256,7 @@ set_last_error(_). */ -subst_args1(Eq,RetType,Depth, Self, [OP|ARGS], Template):- fail, +subst_args1(Eq,RetType,Depth, Self, [OP|ARGS], Template):- is_space_op(OP), !, subst_args_as(Depth, Self, [OP|ARGS], Template). @@ -714,11 +714,11 @@ % user defined function -subst_args2(Eq,Depth,Self,[H|PredDecl],Res):- fail,mnotrace(is_user_defined_head(Eq,Self,H)),!, +subst_args2(Eq,Depth,Self,[H|PredDecl],Res):- mnotrace(is_user_defined_head(Eq,Self,H)),!, subst_args30(Eq,Depth,Self,[H|PredDecl],Res). % function inherited by system -subst_args2(Eq,Depth,Self,PredDecl,Res):- fail, subst_args40(Eq,Depth,Self,PredDecl,Res). +subst_args2(Eq,Depth,Self,PredDecl,Res):- subst_args40(Eq,Depth,Self,PredDecl,Res). /* last_element(T,E):- \+ compound(T),!,E=T. @@ -843,7 +843,7 @@ */ -subst_args30(Eq,Depth,Self,H,B):- fail, (subst_args34(Depth,Self,H,B)*->true;subst_args37(Eq,Depth,Self,H,B)). +subst_args30(Eq,Depth,Self,H,B):- (subst_args34(Depth,Self,H,B)*->true;subst_args37(Eq,Depth,Self,H,B)). subst_args34(_Dpth,Self,H,B):- (metta_eq_def(Eq,Self,H,B);(get_metta_atom(Eq,Self,H),B=H)). @@ -854,7 +854,7 @@ mnotrace((ArgRes\==[H2|H2Args], append(Left,[ArgRes|Rest],NewArgs))), subst_args30(Eq,Depth,Self,[H1|NewArgs],Res). -subst_args37(Eq,Depth,Self,[[H|Start]|T1],Y):- +subst_args37(Eq,Depth,Self,[[H|Start]|T1],Y):- !, mnotrace((is_user_defined_head_f(Eq,Self,H),is_list(Start))), metta_eq_def(Eq,Self,[H|Start],Left), subst_args(Eq,RetType,Depth,Self,[Left|T1],Y). diff --git a/prolog/metta_lang/metta_types.pl b/prolog/metta_lang/metta_types.pl index fab1a5f9edd..e6c5c803d3b 100755 --- a/prolog/metta_lang/metta_types.pl +++ b/prolog/metta_lang/metta_types.pl @@ -442,7 +442,7 @@ no_repeats_var(NoRepeatType), % Retrieve the type of the value. call_nth(get_type_each(Depth, Self, Val, Type),Nth), Type\=='', - (Nth >1 -> Type\== 'Atom' ; true), + ((Nth > 1) -> Type\== 'Atom' ; true), % Ensure the type matches the expected no-repeat type. NoRepeatType = Type, Type = TypeO, From ad2b3812f3af8ce70deff83c8be216d94e0ed528 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Sat, 21 Dec 2024 22:22:17 -0800 Subject: [PATCH 34/42] top-self --- prolog/metta_lang/metta_eval.pl | 8 +------- prolog/metta_lang/metta_interp.pl | 4 ++-- 2 files changed, 3 insertions(+), 9 deletions(-) diff --git a/prolog/metta_lang/metta_eval.pl b/prolog/metta_lang/metta_eval.pl index 7e92404e8a2..20604499e43 100755 --- a/prolog/metta_lang/metta_eval.pl +++ b/prolog/metta_lang/metta_eval.pl @@ -2287,13 +2287,7 @@ %eval_40(Eq,RetType,_Dpth,_Slf,['==',X,Y],Res):- !, subst_args(Eq,RetType,_Dpth,_Slf,['==',X,Y],Res). eval_20(Eq,RetType,Depth,Self,['==', X,Y],Res):- - suggest_type(RetType,'Bool'), - eval_until_unify_self([h_e,'=='],Eq,_SharedType,Depth,Self,X,Y, Res), - (Res=='False' -> (!, fail) ; fail). - -%eval_40(Eq,RetType,_Depth,Self,[EQ,X,Y],TF):- fail, EQ=='==', !, -% suggest_type(RetType,'Bool'), -% as_tf(eval_until_unify(Eq,_SharedType, X, Y), TF). + (var(X);var(Y)),!,X\==Y,!, Res='False',suggest_type(RetType,'Bool'). eval_40(Eq,RetType,Depth,Self,['==',X,Y],TF):- !, suggest_type(RetType,'Bool'), as_tf(eval_until_eq(Eq,_SharedType, Depth,Self, X, Y), TF). diff --git a/prolog/metta_lang/metta_interp.pl b/prolog/metta_lang/metta_interp.pl index f4e32c23487..b8ec7f3778a 100755 --- a/prolog/metta_lang/metta_interp.pl +++ b/prolog/metta_lang/metta_interp.pl @@ -414,8 +414,8 @@ option_value_name_default_type_help('answer-format', 'show', ['rust', 'silent', 'detailed'], "Control how results are displayed", 'Output and Logging'). option_value_name_default_type_help('repeats', true, [true, false], "false to avoid repeated results", 'Miscellaneous'). option_value_name_default_type_help('time', true, [false, true], "Enable or disable timing for operations (in Rust compatibility mode, this is false)", 'Miscellaneous'). -option_value_name_default_type_help('vn', auto, [auto, true, false], "Enable or disable, (auto = enable but not if it breaks stuff) EXPERIMENTAL BUG-FIX where variable names are preserved (see https://github.com/trueagi-io/metta-wam/issues/221)", 'Miscellaneous'). -option_value_name_default_type_help('top-self', false, [true, false, auto], "When set, stop pretending &self==&top", 'Miscellaneous'). +option_value_name_default_type_help('vn', true, [true, auto, false], "Enable or disable, (auto = enable but not if it breaks stuff) EXPERIMENTAL BUG-FIX where variable names are preserved (see https://github.com/trueagi-io/metta-wam/issues/221)", 'Miscellaneous'). +option_value_name_default_type_help('top-self', true, [true, false, auto], "When set, stop pretending &self==&top", 'Miscellaneous'). % Testing and Validation option_value_name_default_type_help('synth-unit-tests', false, [false, true], "Synthesize unit tests", 'Testing and Validation'). From 4fe243bfda659050f4a17530c2beda4c82523bb1 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Sat, 21 Dec 2024 23:03:48 -0800 Subject: [PATCH 35/42] .github/workflows/ci.yml --- .github/workflows/ci.yml | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 39a8d28848a..2d2ce91f8d7 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -149,7 +149,7 @@ jobs: GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} GITHUB_REPOSITORY: ${{ github.repository }} run: | - cp current_test_results.txt previous-results/ + cd previous-results # Configure Git user information @@ -160,6 +160,10 @@ jobs: git remote set-url origin https://x-access-token:${GITHUB_TOKEN}@github.com/${GITHUB_REPOSITORY}.git git pull + + # overwrite test results + cp ../current_test_results.txt . + # Stage and commit changes git add current_test_results.txt git commit -m "Update test results" From f8ad112698488ccc007ada9ebf4bf7e397a880af Mon Sep 17 00:00:00 2001 From: logicmoo Date: Sat, 21 Dec 2024 23:05:53 -0800 Subject: [PATCH 36/42] simplified case and == --- prolog/metta_lang/metta_eval.pl | 43 ++++++++++++++++----------------- 1 file changed, 21 insertions(+), 22 deletions(-) diff --git a/prolog/metta_lang/metta_eval.pl b/prolog/metta_lang/metta_eval.pl index 20604499e43..9e99b968dd0 100755 --- a/prolog/metta_lang/metta_eval.pl +++ b/prolog/metta_lang/metta_eval.pl @@ -514,13 +514,12 @@ unified(X,Y):- eval(X,XX),X\=@=XX,unified(Y,XX). unified(X,Y):- eval(Y,YY),Y\=@=YY,unified(YY,X). -eval_until_unify(_Eq,_RetType,_Dpth,_Slf,X,X):- !. +%eval_until_unify(_Eq,_RetType,_Dpth,_Slf,X,X):- !. -eval_until_unify_self([h_e|_],Eq,RetType,Depth,Self,X,Y, Res):- var(Y),!,as_tf(X==Y, Res). -eval_until_unify_self([h_e|_],Eq,RetType,Depth,Self,X,Y, Res):- var(X),!,as_tf(X==Y, Res). -eval_until_unify_self(Flags,Eq,RetType,Depth,Self,X,Y):- - as_tf(eval_until_eq(Flags,Eq,RetType,Depth,Self,X,Y),Res). +%eval_until_unify_self([h_e|_],Eq,RetType,Depth,Self,X,Y, Res):- var(Y),!,as_tf(X==Y, Res). +%eval_until_unify_self([h_e|_],Eq,RetType,Depth,Self,X,Y, Res):- var(X),!,as_tf(X==Y, Res). +%eval_until_unify_self(Flags,Eq,RetType,Depth,Self,X,Y,Res):- as_tf(eval_until_eq(Flags,Eq,RetType,Depth,Self,X,Y),Res). eval_until_eq(_Flags,Eq,RetType,_Dpth,_Slf,X,Y):- X==Y,!,check_returnval(Eq,RetType,Y). @@ -534,7 +533,7 @@ eval_until_eq(Flags,Eq,RetType,Depth,Self,X,Y):- eval_in_steps_some_change(Eq,RetType,Depth,Self,X,XX),eval_until_eq(Flags,Eq,RetType,Depth,Self,Y,XX),!. -eval_until_eq(Flags,_Eq,_RetType,_Dpth,_Slf,X,Y):- length(X,Len), \+ length(Y,Len),!,fail. +eval_until_eq(_Flags,_Eq,_RetType,_Dpth,_Slf,X,Y):- length(X,Len), \+ length(Y,Len),!,fail. eval_until_eq(Flags,Eq,RetType,Depth,Self,X,Y):- nth1(N,X,EX,RX), nth1(N,Y,EY,RY), EX=EY,!, maplist(eval_until_eq(Flags,Eq,RetType,Depth,Self),RX,RY). eval_until_eq(Flags,Eq,RetType,Depth,Self,X,Y):- nth1(N,X,EX,RX), nth1(N,Y,EY,RY), @@ -551,10 +550,10 @@ eval_args(Eq,RetType,Depth,Self,EX,EXX), EX \=@= EXX. eval_in_steps_some_change(_Eq,_RetType,_Dpth,_Slf,EX,_):- \+ is_list(EX),!,fail. -eval_in_steps_some_change(Eq,RetType,Depth,Self,EX,EXXO):- +eval_in_steps_some_change(Eq,RetType,Depth,Self,EX,EXXO):- eval_1change(Eq,RetType,Depth,Self,EX,EXX),!, (eval_in_steps_some_change(Eq,RetType,Depth,Self,EXX,EXXO);EXXO=EXX). -eval_in_steps_some_change(Eq,RetType,Depth,Self,X,Y):- +eval_in_steps_some_change(Eq,RetType,Depth,Self,X,Y):- append(L,[EX|R],X),is_list(EX), eval_in_steps_some_change(Eq,RetType,Depth,Self,EX,EXX), EX\=@=EXX, append(L,[EXX|R],XX), @@ -1020,15 +1019,15 @@ eval_20(Eq,RetType,Depth,Self,[P,X|More],YY):- fail, is_list(X),X=[_,_,_],simple_math(X), eval_selfless_2(X,XX),X\=@=XX,!, eval_20(Eq,RetType,Depth,Self,[P,XX|More],YY). % if there is only a void then always return nothing for each Case -eval_20(Eq,_RetType,Depth,Self,['case',A,[[Void,_]]],Res):- - '%void%' == Void, - eval_args(Eq,_UnkRetType,Depth,Self,A,_),!,Res =[]. +%eval_20(Eq,_RetType,Depth,Self,['case',A,[[Void,_]]],Res):- +% ('%void%' == Void), +% eval_args(Eq,_UnkRetType,Depth,Self,A,_),!,Res =[]. % if there is nothing for case just treat like a collapse -eval_20(Eq,RetType,Depth,Self,['case',A,[]],NoResult):- !, - %forall(eval_args(Eq,_RetType2,Depth,Self,Expr,_),true), - once(eval_args(Eq,_RetType2,Depth,Self,A,_)), - make_nop(RetType,[],NoResult). +eval_20(Eq,_RetType,Depth,Self,['case',A,[]], _NoResult):- !, + forall(eval(Eq,_RetType2,Depth,Self,A,_),true),!, fail. + %once(eval_args(Eq,_RetType2,Depth,Self,A,_)), + %make_nop(RetType,[],NoResult). into_case_keys(_,[],[]). @@ -1048,10 +1047,10 @@ eval_case(Eq,CaseRetType,Depth,Self,A,KVs,Res):- if_trace((case),(writeqln('case'=A))), ((eval_args(Eq,_UnkRetType,Depth,Self,A,AA), - if_trace((case),writeqln('switch'=AA)), - (select_case(Depth,Self,AA,KVs,Value)->true;(member(Void -Value,KVs),Void=='%void%'))) - *->true;(member(Void -Value,KVs),Void=='%void%')), - eval_args(Eq,CaseRetType,Depth,Self,Value,Res). + if_trace((case),writeqln('switch'=AA))) + *-> (select_case(Depth,Self,AA,KVs,Value)->true;(member(Void -Value,KVs),Void=='%void%',!)) + ; (member(Void -Value,KVs),Void=='Empty',!)), + eval_args(Eq,CaseRetType,Depth,Self,Value,Res). select_case(Depth,Self,AA,Cases,Value):- (best_key(AA,Cases,Value) -> true ; @@ -2286,15 +2285,15 @@ */ %eval_40(Eq,RetType,_Dpth,_Slf,['==',X,Y],Res):- !, subst_args(Eq,RetType,_Dpth,_Slf,['==',X,Y],Res). -eval_20(Eq,RetType,Depth,Self,['==', X,Y],Res):- +eval_20(_Eq,RetType,_Depth,_Self,['==', X,Y],Res):- (var(X);var(Y)),!,X\==Y,!, Res='False',suggest_type(RetType,'Bool'). eval_40(Eq,RetType,Depth,Self,['==',X,Y],TF):- !, suggest_type(RetType,'Bool'), as_tf(eval_until_eq(Eq,_SharedType, Depth,Self, X, Y), TF). - + eval_20(Eq,RetType,Depth,Self,_Slf,['===',X,Y],TF):- !, suggest_type(RetType,'Bool'), - as_tf(\+ \+ eval_until_unify(['==='],Eq,_SharedType,Depth,Self,X,Y), TF). + as_tf(\+ \+ eval_until_eq(['==='],Eq,_SharedType,Depth,Self,X,Y), TF). eval_20(_Eq,RetType,_Dpth,_Slf,['====',X,Y],TF):- !, suggest_type(RetType,'Bool'), From 6e2e4cd024518ec201aa3165315cd4a552860707 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Sat, 21 Dec 2024 23:13:39 -0800 Subject: [PATCH 37/42] prolog/metta_lang/metta_compiler_roy.pl --- prolog/metta_lang/metta_compiler_lib_roy.pl | 107 ++++++++++---- prolog/metta_lang/metta_compiler_roy.pl | 146 ++++++++++++-------- 2 files changed, 165 insertions(+), 88 deletions(-) diff --git a/prolog/metta_lang/metta_compiler_lib_roy.pl b/prolog/metta_lang/metta_compiler_lib_roy.pl index c665da77e3c..9569d9476b9 100644 --- a/prolog/metta_lang/metta_compiler_lib_roy.pl +++ b/prolog/metta_lang/metta_compiler_lib_roy.pl @@ -1,55 +1,108 @@ -:- discontiguous get_type_sig/3. +:- dynamic(transpiler_clause_store/9). +:- discontiguous transpiler_clause_store/9. %%%%%%%%%%%%%%%%%%%%% arithmetic -% get_type_sig('+',['Number','Number'],'Number'). -'mc__+'(A,B,R) :- number(A),number(B),!,plus(A,B,R). -'mc__+'(A,B,['+',A,B]). +'mc_2__+'(A,B,R) :- number(A),number(B),!,plus(A,B,R). +'mc_2__+'(A,B,['+',A,B]). -'mc__-'(A,B,R) :- number(A),number(B),!,plus(B,R,A). -'mc__-'(A,B,['-',A,B]). +'mc_2__-'(A,B,R) :- number(A),number(B),!,plus(B,R,A). +'mc_2__-'(A,B,['-',A,B]). -'mc__*'(A,B,R) :- number(A),number(B),!,R is A*B. -'mc__*'(A,B,['*',A,B]). +'mc_2__*'(A,B,R) :- number(A),number(B),!,R is A*B. +'mc_2__*'(A,B,['*',A,B]). %%%%%%%%%%%%%%%%%%%%% logic -mc__and(A,B,B):- atomic(A), A\=='False', A\==0. -mc__and(_,_,'False'). +mc_2__and(A,B,B):- atomic(A), A\=='False', A\==0, !. +mc_2__and(_,_,'False'). -mc__or(A,B,B):- (\+ atomic(A); A='False'; A=0), !. -mc__or(_,_,'True'). +mc_2__or(A,B,B):- (\+ atomic(A); A='False'; A=0), !. +mc_2__or(_,_,'True'). + +mc_1__not(A,'False') :- atomic(A), A\=='False', A\==0, !. +mc_1__not(_,'True'). %%%%%%%%%%%%%%%%%%%%% comparison -'mc__=='(A,A,1) :- !. -'mc__=='(_,_,0). +'mc_2__=='(A,A,1) :- !. +'mc_2__=='(_,_,0). + +'mc_2__<'(A,B,R) :- number(A),number(B),!,(A R='True' ; R='False'). +'mc_2__<'(A,B,['<',A,B]). + +'mc_2__>'(A,B,R) :- number(A),number(B),!,(A>B -> R='True' ; R='False'). +'mc_2__>'(A,B,['>',A,B]). -'mc__<'(A,B,R) :- number(A),number(B),!,(A R=1 ; R=0). -'mc__<'(A,B,['<',A,B]). +'mc_2__>='(A,B,R) :- number(A),number(B),!,(A>=B -> R='True' ; R='False'). +'mc_2__>='(A,B,['>=',A,B]). -'mc__>'(A,B,R) :- number(A),number(B),!,(A>B -> R=1 ; R=0). -'mc__>'(A,B,['>',A,B]). +'mc_2__<='(A,B,R) :- number(A),number(B),!,(A= R='True' ; R='False'). % note that Prolog has a different syntax '=<' +'mc_2__<='(A,B,['<=',A,B]). %%%%%%%%%%%%%%%%%%%%% lists -'mc__car-atom'([H|_],H). +'mc_1__car-atom'([H|_],H). + +'mc_1__cdr-atom'([_|T],T). + +'mc_2__cons-atom'(A,B,[A|B]). -'mc__cdr-atom'([_|T],T). +'mc_1__decons-atom'([A|B],[A,B]). -'mc__cons-atom'(A,B,[A|B]). +%%%%%%%%%%%%%%%%%%%%% set + +lazy_member(R1,Code2,R2) :- call(Code2),R1=R2. + +transpiler_clause_store(subtraction, 3, 0, ['Atom','Atom'], 'Atom', [x(doeval,lazy),x(doeval,lazy)], x(doeval,eager), [], []). +'mc_2__subtraction'(is_p1(Code1,R1),is_p1(Code2,R2),R1) :- + call(Code1), + \+ lazy_member(R1,Code2,R2). + +transpiler_clause_store(union, 3, 0, ['Atom','Atom'], 'Atom', [x(doeval,lazy),x(doeval,lazy)], x(doeval,eager), [], []). +'mc_2__union'(U1,is_p1(Code2,R2),R) :- 'mc_2__subtraction'(U1,is_p1(Code2,R2),R) ; call(Code2),R=R2. %%%%%%%%%%%%%%%%%%%%% superpose, collapse -'mc__superpose'([H|_],H). -'mc__superpose'([_|T],R) :- 'mc__superpose'(T,R). +'mc_1__superpose'(S,R) :- member(R,S). + +% put a fake transpiler_clause_store here, just to force the argument to be lazy +transpiler_clause_store(collapse, 2, 0, ['Atom'], 'Expression', [x(doeval,lazy)], x(doeval,eager), [], []). +'mc_1__collapse'(is_p1(Code,Ret),R) :- fullvar(Ret),!,findall(Ret,Code,R). +'mc_1__collapse'(is_p1(true,X),[X]). + +%%%%%%%%%%%%%%%%%%%%% spaces + +'mc_2__add-atom'(Space,PredDecl,[]) :- 'add-atom'(Space,PredDecl). + +'mc_2__remove-atom'(Space,PredDecl,[]) :- 'remove-atom'(Space,PredDecl). + +'mc_1__get-atoms'(Space,Atoms) :- metta_atom(Space, Atoms). + +% put a fake transpiler_clause_store here, just to force the template to be lazy +transpiler_clause_store(match, 4, 0, ['Atom', 'Atom', 'Atom'], ' %Undefined%', [x(doeval,eager), x(doeval,eager), x(doeval,lazy)], x(doeval,eager), [], []). +'mc_3__match'(Space,Pattern,is_p1(TemplateCode,TemplateRet),TemplateRet) :- metta_atom(Space, Atom),Atom=Pattern,call(TemplateCode). + +% TODO FIXME: sort out the difference between unify and match +transpiler_clause_store(unify, 4, 0, ['Atom', 'Atom', 'Atom'], ' %Undefined%', [x(doeval,eager), x(doeval,eager), x(doeval,lazy)], x(doeval,eager), [], []). +'mc_3__unify'(Space,Pattern,is_p1(TemplateCode,TemplateRet),TemplateRet) :- metta_atom(Space, Atom),Atom=Pattern,call(TemplateCode). %%%%%%%%%%%%%%%%%%%%% misc -'mc__empty'(_) :- fail. +% put a fake transpiler_clause_store here, just to force the argument to be lazy +transpiler_clause_store(time, 2, 0, ['Atom'], 'Atom', [x(doeval,lazy)], x(doeval,eager), [], []). +'mc_1__time'(is_p1(Code,Ret),Ret) :- wtime_eval(Code). + +'mc_0__empty'(_) :- fail. + +'mc_1__eval'(X,R) :- transpile_eval(X,R). + +'mc_1__get-metatype'(X,Y) :- 'get-metatype'(X,Y). % use the code in the interpreter for now + +'mc_1__println!'(X,[]) :- println_impl(X). -'mc__stringToChars'(S,C) :- string_chars(S,C). +'mc_1__stringToChars'(S,C) :- string_chars(S,C). -'mc__charsToString'(C,S) :- string_chars(S,C). +'mc_1__charsToString'(C,S) :- string_chars(S,C). -mc__assertEqualToResult(A, B, C) :- u_assign([assertEqualToResult, A, B], C). +mc_2__assertEqualToResult(A, B, C) :- u_assign([assertEqualToResult, A, B], C). diff --git a/prolog/metta_lang/metta_compiler_roy.pl b/prolog/metta_lang/metta_compiler_roy.pl index 7562183ec5f..2da28b0656e 100755 --- a/prolog/metta_lang/metta_compiler_roy.pl +++ b/prolog/metta_lang/metta_compiler_roy.pl @@ -72,6 +72,7 @@ %:- ensure_loaded(metta_reader). :- ensure_loaded(metta_interp). :- ensure_loaded(metta_space). +:- dynamic(transpiler_clause_store/9). :- ensure_loaded(metta_compiler_lib). % ============================== @@ -94,14 +95,11 @@ :- initialization(mutex_create(transpiler_mutex_lock)). :- at_halt(mutex_destroy(transpiler_mutex_lock)). -%transpile_prefix(''). -transpile_prefix('mc__'). - %transpiler_enable_interpreter_calls. transpiler_enable_interpreter_calls :- fail. -transpiler_show_debug_messages. -%transpiler_show_debug_messages :- fail. +%transpiler_show_debug_messages. +transpiler_show_debug_messages :- fail. :- dynamic(transpiler_stub_created/1). % just so the transpiler_stub_created predicate always exists @@ -111,10 +109,12 @@ % just so the transpiler_depends_on predicate always exists transpiler_depends_on(dummy,0,dummy,0). -:- dynamic(transpiler_clause_store/8). % just so the transpiler_clause_store predicate always exists -% transpiler_clause_store(f,arity,types,rettype,lazy,retlazy,head,body) -transpiler_clause_store(dummy,0,[],'Any',[],eager,dummy,dummy). +% transpiler_clause_store(f,arity,clause_number,types,rettype,lazy,retlazy,head,body) +transpiler_clause_store(dummy,0,0,[],'Any',[],eager,dummy,dummy). + +:- dynamic(transpiler_stored_eval/3). +transpiler_stored_eval([],true,0). as_p1(is_p1(Code,Ret),Ret):- !, call(Code). @@ -158,7 +158,7 @@ % ?- compile_for_exec(RetResult, is(pi+pi), Converted). compile_for_exec(Res,I,O):- - %ignore(Res='$VAR'('RetResult')),` + %ignore(Res='$VAR'('RetResult')), compile_for_exec0(Res,I,O),!. compile_for_exec0(Res,I,eval_args(I,Res)):- is_ftVar(I),!. @@ -183,7 +183,7 @@ %ast_to_prolog(no_caller,[],[[native(trace)]|NextBody],NextBodyC). ast_to_prolog(no_caller,[],NextBody,NextBodyC). -arrange_lazy_args(N,Y,N-Y). +arrange_lazy_args(N,x(_,Y),N-Y). get_operator_typedef_props(X,FnName,Largs,Types,RetType) :- get_operator_typedef(X,FnName,Largs,Types,RetType),!. @@ -203,6 +203,10 @@ union_var(T,X,Y0), (member_var(H,X) -> Y=Y0 ; Y=[H|Y0]). +get_property_lazy(x(_,L),L). + +get_property_evaluate(x(E,_),E). + determine_eager_vars(lazy,lazy,A,[]) :- fullvar(A),!. determine_eager_vars(eager,eager,A,[A]) :- fullvar(A),!. determine_eager_vars(Lin,Lout,[if,If,Then,Else],EagerVars) :- !, @@ -226,9 +230,9 @@ determine_eager_vars(_,RetLazy,[Fn|Args],EagerVars) :- atom(Fn),!, length(Args,LenArgs), LenArgsPlus1 is LenArgs+1, - (transpiler_clause_store(Fn,LenArgsPlus1,_,_,ArgsLazy0,RetLazy0,_,_) -> - ArgsLazy=ArgsLazy0, - RetLazy=RetLazy0 + (transpiler_clause_store(Fn,LenArgsPlus1,_,_,_,ArgsLazy0,RetLazy0,_,_) -> + maplist(get_property_lazy,ArgsLazy0,ArgsLazy), + get_property_lazy(RetLazy0,RetLazy) ; RetLazy=eager, length(ArgsLazy, LenArgs), @@ -241,18 +245,29 @@ set_eager_or_lazy(Vlist,V,R) :- (member_var(V,Vlist) -> R=eager ; R=lazy). -combine_lazy_types_props(lazy,_-lazy,lazy) :- !. -combine_lazy_types_props(_,_,eager). +combine_lazy_types_props(lazy,x(E,lazy),x(E,lazy)) :- !. +combine_lazy_types_props(_,x(E,_),x(E,eager)). + +transpile_eval(Convert,Converted) :- + (transpiler_stored_eval(Convert,PrologCode0,Converted0) -> + PrologCode=PrologCode0, + Converted=Converted0 + ; + f2p([],[],Converted,eager,Convert,Code), + ast_to_prolog(no_caller,[],Code,PrologCode), + assertz(transpiler_stored_eval(Convert,PrologCode,Converted)) + ), + call(PrologCode). compile_for_assert(HeadIs, AsBodyFn, Converted) :- + %leash(-all),trace, HeadIs=[FnName|Args], length(Args,LenArgs), LenArgsPlus1 is LenArgs+1, % retract any stubs (transpiler_stub_created(FnName/LenArgsPlus1) -> retract(transpiler_stub_created(FnName/LenArgsPlus1)), - transpile_prefix(Prefix), - atom_concat(Prefix,FnName,FnNameWPrefix), + atomic_list_concat(['mc_',LenArgs,'__',FnName],FnNameWPrefix), findall(Atom0, (between(1, LenArgsPlus1, I0) ,Atom0='$VAR'(I0)), AtomList0), H=..[FnNameWPrefix|AtomList0], (transpiler_show_debug_messages -> format("Retracting stub: ~w\n",[H]) ; true), @@ -266,19 +281,23 @@ arg_eval_props(RetType0,RetProps), determine_eager_vars(lazy,ResultEager,AsBodyFn,EagerArgList), maplist(set_eager_or_lazy(EagerArgList),Args,EagerLazyList), + % EagerLazyList: eager/lazy + % TypeProps: x(doeval/noeval,eager/lazy) + % FinalLazyArgs: x(doeval/noeval,eager/lazy) maplist(combine_lazy_types_props,EagerLazyList,TypeProps,FinalLazyArgs), combine_lazy_types_props(ResultEager,RetProps,FinalLazyRet), - %format("\n##################################Eager args ~w ~w ~w\n\n",[EagerArgList,FinalLazyArgs,FinalLazyRet]), - %maplist(determine_eager(AsBodyFn),Args,) - assertz(transpiler_clause_store(FnName,LenArgsPlus1,Types0,RetType0,FinalLazyArgs,FinalLazyRet,HeadIs,AsBodyFn)), + findall(ClauseIDt,transpiler_clause_store(FnName,LenArgsPlus1,ClauseIDt,_,_,_,_,_,_),ClauseIdList), + (ClauseIdList=[] -> + ClauseId=0 + ; + max_list(ClauseIdList,ClauseIdm1),ClauseId is ClauseIdm1+1 + ), + assertz(transpiler_clause_store(FnName,LenArgsPlus1,ClauseId,Types0,RetType0,FinalLazyArgs,FinalLazyRet,HeadIs,AsBodyFn)), maplist(arrange_lazy_args,Args,FinalLazyArgs,LazyArgsList), - %leash(-all), - %trace, - f2p(HeadIs,LazyArgsList,HResult,FinalLazyRet,AsBodyFn,NextBody), + get_property_lazy(FinalLazyRet,FinalLazyOnlyRet), + f2p(HeadIs,LazyArgsList,HResult,FinalLazyOnlyRet,AsBodyFn,NextBody), %format("HeadIs:~w HResult:~w AsBodyFn:~w NextBody:~w\n",[HeadIs,HResult,AsBodyFn,NextBody]), - %format("HERE\n"), - %trace, %(var(HResult) -> (Result = HResult, HHead = Head) ; % funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head)), ast_to_prolog_aux(no_caller,[FnName/LenArgsPlus1],[assign,HResult,[call(FnName)|Args]],HeadC), @@ -291,6 +310,9 @@ ast_to_prolog(caller(FnName,LenArgsPlus1),[FnName/LenArgsPlus1],NextBody,NextBodyC), + %format("###########1 ~w",[Converted]), + %numbervars(Converted,0,_), + %format("###########2 ~w",[Converted]), output_language(prolog, (print_pl_source(Converted))), true )). @@ -497,15 +519,14 @@ A=..[F|Args1]. ast_to_prolog_aux(Caller,DontStub,[assign,A,[call(F)|Args0]],R) :- (fullvar(A);\+ compound(A)),atom(F),!, maplist(ast_to_prolog_aux(Caller,DontStub),Args0,Args1), - transpile_prefix(Prefix), - atom_concat(Prefix,F,Fp), length(Args0,LArgs), + atomic_list_concat(['mc_',LArgs,'__',F],Fp), LArgs1 is LArgs+1, append(Args1,[A],Args2), R=..[Fp|Args2], (Caller=caller(CallerInt,CallerSz),(CallerInt-CallerSz)\=(F-LArgs1),\+ transpiler_depends_on(CallerInt,CallerSz,F,LArgs1) -> assertz(transpiler_depends_on(CallerInt,CallerSz,F,LArgs1)), - (transpiler_show_debug_messages -> format("Asserting: transpiler_depends_on(~w,~w,~w,~w)\n",[CallerInt,CallerSz,F,LArgs1]) -> true) + (transpiler_show_debug_messages -> format("Asserting: transpiler_depends_on(~w,~w,~w,~w)\n",[CallerInt,CallerSz,F,LArgs1]) ; true) ; true), ((current_predicate(Fp/LArgs1);member(F/LArgs1,DontStub)) -> true @@ -528,8 +549,8 @@ combine_code_list_aux([H|T],[H|R]) :- combine_code_list_aux(T,R). check_supporting_predicates(Space,F/A) :- % already exists - transpile_prefix(Prefix), - atom_concat(Prefix,F,Fp), + A1 is A-1, + atomic_list_concat(['mc_',A1,'__',F],Fp), with_mutex(transpiler_mutex_lock, (current_predicate(Fp/A) -> true ; findall(Atom0, (between(1, A, I0) ,Atom0='$VAR'(I0)), AtomList0), @@ -537,17 +558,18 @@ Am1 is A-1, findall(Atom1, (between(1, Am1, I1), Atom1='$VAR'(I1)), AtomList1), B=..[u_assign,[F|AtomList1],'$VAR'(A)], - (transpiler_enable_interpreter_calls -> G=true;G=fail), - assertz(transpiler_stub_created(F/A)), - create_and_consult_temp_file(Space,Fp/A,[H:-(format("; % ######### warning: using stub for:~w\n",[F]),G,B)]))). +% (transpiler_enable_interpreter_calls -> G=true;G=fail), % assertz(transpiler_stub_created(F/A)), -% (transpiler_enable_interpreter_calls -> -% create_and_consult_temp_file(Space,Fp/A,[H:-(format("; % ######### warning: using stub for:~w\n",[F]),B)]) -% ; -% create_and_consult_temp_file(Space,Fp/A,[H:-'$VAR'(A)=[F|AtomList1]]) -% ) -% ) -% ). +% create_and_consult_temp_file(Space,Fp/A,[H:-(format("; % ######### warning: using stub for:~w\n",[F]),G,B)]))). + assertz(transpiler_stub_created(F/A)), + (transpiler_show_debug_messages -> format("; % ######### warning: creating stub for:~w\n",[F]) ; true), + (transpiler_enable_interpreter_calls -> + create_and_consult_temp_file(Space,Fp/A,[H:-(format("; % ######### warning: using stub for:~w\n",[F]),B)]) + ; + create_and_consult_temp_file(Space,Fp/A,[H:-('$VAR'(A)=[F|AtomList1])]) + ) + ) + ). % Predicate to create a temporary file and write the tabled predicate create_and_consult_temp_file(Space,F/A, PredClauses) :- @@ -683,20 +705,20 @@ append(CombinedNewCode,[Code],Converted0), lazy_impedance_match(eager,ResultLazy,RetResult0,Converted0,RetResult,Converted). -update_laziness(X-_,Y,X-Y). +update_laziness(x(X,_),x(_,Y),x(X,Y)). f2p(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- HeadIs\=@=Convert, Convert=[Fn|Args], atom(Fn),!, length(Args,Largs), LenArgsPlus1 is Largs+1, - (transpiler_clause_store(Fn,LenArgsPlus1,_,_,ArgsLazy0,RetLazy0,_,_) -> + (transpiler_clause_store(Fn,LenArgsPlus1,_,_,_,ArgsLazy0,x(_,RetLazy0),_,_) -> UpToDateArgsLazy=ArgsLazy0, RetLazy=RetLazy0 ; RetLazy=eager, length(UpToDateArgsLazy, Largs), - maplist(=(eager), UpToDateArgsLazy)), + maplist(=(x(doeval,eager)), UpToDateArgsLazy)), % get the evaluation/laziness based on the types, but then update from the actual signature using 'update_laziness' get_operator_typedef_props(_,Fn,Largs,Types0,_RetType0), maplist(arg_eval_props,Types0,EvalArgs0), @@ -731,19 +753,19 @@ lazy_impedance_match(eager,lazy,RetResult0,Converted0,RetResult,Converted) :- append(Converted0,[[assign,RetResult,[is_p1,[],RetResult0]]],Converted). -arg_eval_props('Number',doeval-eager) :- !. -arg_eval_props('Bool',doeval-eager) :- !. -arg_eval_props('LazyBool',doeval-lazy) :- !. -arg_eval_props('Any',doeval-eager) :- !. -arg_eval_props('Atom',doeval-lazy) :- !. -arg_eval_props('Expression',noeval-lazy) :- !. -arg_eval_props(_,doeval-eager). +arg_eval_props('Number',x(doeval,eager)) :- !. +arg_eval_props('Bool',x(doeval,eager)) :- !. +arg_eval_props('LazyBool',x(doeval,lazy)) :- !. +arg_eval_props('Any',x(doeval,eager)) :- !. +arg_eval_props('Atom',x(doeval,lazy)) :- !. +arg_eval_props('Expression',x(doeval,lazy)) :- !. +arg_eval_props(_,x(doeval,eager)). -do_arg_eval(_,_,Arg,noeval-_,Arg,[]). -do_arg_eval(HeadIs,LazyVars,Arg,doeval-lazy,[is_p1,SubCode,SubArg],Code) :- +do_arg_eval(_,_,Arg,x(noeval,_),Arg,[]). +do_arg_eval(HeadIs,LazyVars,Arg,x(doeval,lazy),[is_p1,SubCode,SubArg],Code) :- f2p(HeadIs,LazyVars,SubArg,eager,Arg,SubCode), Code=[]. -do_arg_eval(HeadIs,LazyVars,Arg,doeval-eager,NewArg,Code) :- f2p(HeadIs,LazyVars,NewArg,eager,Arg,Code). +do_arg_eval(HeadIs,LazyVars,Arg,x(doeval,eager),NewArg,Code) :- f2p(HeadIs,LazyVars,NewArg,eager,Arg,Code). :- discontiguous(compile_flow_control/6). @@ -796,8 +818,9 @@ is_clause_asserted(AC):- unnumbervars_clause(AC,UAC), expand_to_hb(UAC,H,B), H=..[Fh|Args], - transpile_prefix(Prefix), - atom_concat(Prefix,Fh,FPrefixed), + length(Args,N), + N1 is N-1, + atomic_list_concat(['mc_',N1,'__',Fh],FPrefixed), H2=..[FPrefixed|Args], clause(H2,B,Ref),clause(HH,BB,Ref), strip_m(HH,HHH),HHH=@=H2, @@ -831,10 +854,11 @@ if_t(N=2, (Set=[X,Y], numbervars(X), - numbervars(Y), - nl,display(X), - nl,display(Y), - nl)), + numbervars(Y) + %nl,display(X), + %nl,display(Y), + %nl + )), %wdmsg(list_to_set(F/A,N)), abolish(/*'&self':*/F/A), create_and_consult_temp_file(Space,F/A, Set) @@ -1128,7 +1152,7 @@ nop(ignore(Result = '$VAR'('HeadRes'))))),!. compile_for_assert(HeadIs, AsBodyFn, Converted) :- - format("~w ~w ~w\n",[HeadIs, AsBodyFn, Converted]), + %format("~w ~w ~w\n",[HeadIs, AsBodyFn, Converted]), AsFunction = HeadIs, must_det_ll(( Converted = (HeadC :- NextBodyC), % Create a rule with Head as the converted AsFunction and NextBody as the converted AsBodyFn @@ -1440,7 +1464,7 @@ compile_flow_control(HeadIs,RetResult,Convert,CodeForValueConverted) :- % TODO: Plus seems an odd name for a variable - get an idea why? - transpile_prefix(Prefix), + %transpile_prefix(Prefix), Convert =~ [Plus,N,Value], atom(Plus), atom_concat(Prefix,Plus,PrefixPlus), current_predicate(PrefixPlus/3), number(N), From a2f309a17e6d5e6d0495a6242ff025661fabc981 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Sun, 22 Dec 2024 01:19:41 -0800 Subject: [PATCH 38/42] void_or_empty_value --- prolog/metta_lang/metta_eval.pl | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/prolog/metta_lang/metta_eval.pl b/prolog/metta_lang/metta_eval.pl index 9e99b968dd0..7901b9c15a9 100755 --- a/prolog/metta_lang/metta_eval.pl +++ b/prolog/metta_lang/metta_eval.pl @@ -1019,9 +1019,9 @@ eval_20(Eq,RetType,Depth,Self,[P,X|More],YY):- fail, is_list(X),X=[_,_,_],simple_math(X), eval_selfless_2(X,XX),X\=@=XX,!, eval_20(Eq,RetType,Depth,Self,[P,XX|More],YY). % if there is only a void then always return nothing for each Case -%eval_20(Eq,_RetType,Depth,Self,['case',A,[[Void,_]]],Res):- -% ('%void%' == Void), -% eval_args(Eq,_UnkRetType,Depth,Self,A,_),!,Res =[]. +eval_20(Eq,_RetType,Depth,Self,['case',A,[[Void,Else]]],Res):- + ('%void%' == Void;'Empty' == Void),!, + (eval_args(Eq,_UnkRetType,Depth,Self,A,_) *-> (fail) ; Res=Else). % if there is nothing for case just treat like a collapse eval_20(Eq,_RetType,Depth,Self,['case',A,[]], _NoResult):- !, @@ -1044,19 +1044,22 @@ into_case_keys(1,CASES,KVs), eval_case(Eq,RetType,Depth,Self,A,KVs,Res). +void_or_empty_value(KVs,Value):- member(Void -Value,KVs),Void=='%void%',!. % still support void +void_or_empty_value(KVs,Value):- member(Void -Value,KVs),Void=='Empty',!. + eval_case(Eq,CaseRetType,Depth,Self,A,KVs,Res):- if_trace((case),(writeqln('case'=A))), ((eval_args(Eq,_UnkRetType,Depth,Self,A,AA), if_trace((case),writeqln('switch'=AA))) - *-> (select_case(Depth,Self,AA,KVs,Value)->true;(member(Void -Value,KVs),Void=='%void%',!)) - ; (member(Void -Value,KVs),Void=='Empty',!)), + *-> (select_case(Depth,Self,AA,KVs,Value)->true;(void_or_empty_value(KVs,Value),!)) + ; (void_or_empty_value(KVs,Value),!)), eval_args(Eq,CaseRetType,Depth,Self,Value,Res). select_case(Depth,Self,AA,Cases,Value):- (best_key(AA,Cases,Value) -> true ; (maybe_special_keys(Depth,Self,Cases,CasES), (best_key(AA,CasES,Value) -> true ; - (member(Void -Value,CasES),Void=='%void%')))). + (void_or_empty_value(CasES,Value))))). best_key(AA,Cases,Value):- member(Match-Value,Cases),AA = Match,!. best_key(AA,Cases,Value):- From 660c2219321dfdbf9a6b599ebf728c5c4732ee5b Mon Sep 17 00:00:00 2001 From: logicmoo Date: Sun, 22 Dec 2024 01:20:06 -0800 Subject: [PATCH 39/42] metta_compiler_lib_roy --- prolog/metta_lang/metta_compiler.pl | 466 ++++++++++++++---------- prolog/metta_lang/metta_compiler_lib.pl | 109 ++++-- 2 files changed, 355 insertions(+), 220 deletions(-) diff --git a/prolog/metta_lang/metta_compiler.pl b/prolog/metta_lang/metta_compiler.pl index 746c7a2f18e..0cff1f2d326 100755 --- a/prolog/metta_lang/metta_compiler.pl +++ b/prolog/metta_lang/metta_compiler.pl @@ -72,6 +72,7 @@ %:- ensure_loaded(metta_reader). :- ensure_loaded(metta_interp). :- ensure_loaded(metta_space). +:- dynamic(transpiler_clause_store/9). :- ensure_loaded(metta_compiler_lib). % ============================== @@ -106,24 +107,26 @@ :- dynamic(is_transpile_call_prefix/2). transpile_call_prefix(F,Fn):- is_transpile_call_prefix(F,Fn)*->true;(transpile_call_prefix(Prefix),atom_concat(Prefix,F,Fn),asserta(is_transpile_call_prefix(F,Fn))). -transpiler_enable_interpreter_calls. -%transpiler_enable_interpreter_calls :- fail. +%transpiler_enable_interpreter_calls. +transpiler_enable_interpreter_calls :- fail. -transpiler_show_debug_messages. -%transpiler_show_debug_messages :- fail. +%transpiler_show_debug_messages. +transpiler_show_debug_messages :- fail. -:- dynamic(transpiler_stub_created/3). +:- dynamic(transpiler_stub_created/1). % just so the transpiler_stub_created predicate always exists -transpiler_stub_created(space,dummy,0). +transpiler_stub_created(dummy). :- dynamic(transpiler_depends_on/4). % just so the transpiler_depends_on predicate always exists transpiler_depends_on(dummy,0,dummy,0). -:- dynamic(transpiler_clause_store/8). % just so the transpiler_clause_store predicate always exists -% transpiler_clause_store(f,arity,types,rettype,lazy,retlazy,head,body) -transpiler_clause_store(dummy,0,[],'Any',[],eager,dummy,dummy). +% transpiler_clause_store(f,arity,clause_number,types,rettype,lazy,retlazy,head,body) +transpiler_clause_store(dummy,0,0,[],'Any',[],eager,dummy,dummy). + +:- dynamic(transpiler_stored_eval/3). +transpiler_stored_eval([],true,0). as_p1(is_p1(_,Code,Ret),Ret):- !, call(Code). as_p1(is_p1(Code,Ret),Ret):- !, call(Code). @@ -148,8 +151,6 @@ '=~0'(A,B):- compound_non_cons(B),!,A=B. '=~0'(A,B):- '=..'(A,B). -x_assign(X,X). - %into_list_args(A,AA):- is_ftVar(A),AA=A. %into_list_args(C,[C]):- \+ compound(C),!. into_list_args(C,C):- \+ compound(C),!. @@ -230,11 +231,11 @@ Converted = (HeadC :- NextBodyC), % Create a rule with Head as the converted AsFunction and NextBody as the converted AsBodyFn f2p([exec0],[],HResult,eager,AsBodyFn,NextBody), %optimize_head_and_body(x_assign([exec0],HResult),NextBody,HeadC,NextBodyB), - ast_to_prolog(no_caller,fn_native(exec0,[HResult]),HeadC), - %ast_to_prolog(Caller,[[native(trace)]|NextBody],NextBodyC). - ast_to_prolog(HeadC,NextBody,NextBodyC))),!. + ast_to_prolog_aux(no_caller,[],[native(exec0),HResult],HeadC), + %ast_to_prolog(no_caller,[],[[native(trace)]|NextBody],NextBodyC). + ast_to_prolog(no_caller,[],NextBody,NextBodyC))). -arrange_lazy_args(N,Y,N-Y). +arrange_lazy_args(N,x(_,Y),N-Y). get_operator_typedef_props(X,FnName,Largs,Types,RetType) :- get_operator_typedef(X,FnName,Largs,Types,RetType),!. @@ -254,6 +255,10 @@ union_var(T,X,Y0), (member_var(H,X) -> Y=Y0 ; Y=[H|Y0]). +get_property_lazy(x(_,L),L). + +get_property_evaluate(x(E,_),E). + determine_eager_vars(lazy,lazy,A,[]) :- fullvar(A),!. determine_eager_vars(eager,eager,A,[A]) :- fullvar(A),!. determine_eager_vars(Lin,Lout,[if,If,Then,Else],EagerVars) :- !, @@ -277,9 +282,9 @@ determine_eager_vars(_,RetLazy,[Fn|Args],EagerVars) :- atom(Fn),!, length(Args,LenArgs), LenArgsPlus1 is LenArgs+1, - (transpiler_clause_store(Fn,LenArgsPlus1,_,_,ArgsLazy0,RetLazy0,_,_) -> - ArgsLazy=ArgsLazy0, - RetLazy=RetLazy0 + (transpiler_clause_store(Fn,LenArgsPlus1,_,_,_,ArgsLazy0,RetLazy0,_,_) -> + maplist(get_property_lazy,ArgsLazy0,ArgsLazy), + get_property_lazy(RetLazy0,RetLazy) ; RetLazy=eager, length(ArgsLazy, LenArgs), @@ -292,34 +297,37 @@ set_eager_or_lazy(Vlist,V,R) :- (member_var(V,Vlist) -> R=eager ; R=lazy). -combine_lazy_types_props(lazy,_-lazy,lazy):-!. -combine_lazy_types_props(_,_,eager). +combine_lazy_types_props(lazy,x(E,lazy),x(E,lazy)) :- !. +combine_lazy_types_props(_,x(E,_),x(E,eager)). -ensure_callee_site(Space,Fn,Arity):-transpiler_stub_created(Space,Fn,Arity),!. -ensure_callee_site(Space,Fn,Arity):- - must_det_ll(( - assertz(transpiler_stub_created(Space,Fn,Arity)), - transpile_call_prefix(Fn,CFn), - %trace, -((current_predicate(CFn/Arity) -> true ; - must_det_ll((( functor(CallP,CFn,Arity), - CallP=..[CFn|Args], - transpile_impl_prefix(Fn,IFn), CallI=..[IFn|Args], - %dynamic(IFn/Arity), - append(InArgs,[OutArg],Args), - Clause= (CallP:-((pred_uses_impl(Fn,Arity),CallI)*->true;(mc_fallback_unimpl(Fn,Arity,InArgs,OutArg)))), - output_prolog(Clause), - create_and_consult_temp_file(Space,CFn/Arity,[Clause])))))))),!. +transpile_eval(Convert,Converted) :- + (transpiler_stored_eval(Convert,PrologCode0,Converted0) -> + PrologCode=PrologCode0, + Converted=Converted0 + ; + f2p([],[],Converted,eager,Convert,Code), + ast_to_prolog(no_caller,[],Code,PrologCode), + assertz(transpiler_stored_eval(Convert,PrologCode,Converted)) + ), + call(PrologCode). % !(compile-for-assert (plus1 $x) (+ 1 $x) ) compile_for_assert(HeadIs, AsBodyFn, Converted) :- must_det_ll(( - %leash(-all), - %trace, - current_self(Space), - as_functor_args(HeadIs,FnName,LenArgs,Args), + %leash(-all),trace, + %current_self(Space), + HeadIs=[FnName|Args], + length(Args,LenArgs), LenArgsPlus1 is LenArgs+1, - %fail, + % retract any stubs + (transpiler_stub_created(FnName/LenArgsPlus1) -> + retract(transpiler_stub_created(FnName/LenArgsPlus1)), + atomic_list_concat(['mc_',LenArgs,'__',FnName],FnNameWPrefix), + findall(Atom0, (between(1, LenArgsPlus1, I0) ,Atom0='$VAR'(I0)), AtomList0), + H=..[FnNameWPrefix|AtomList0], + (transpiler_show_debug_messages -> format("Retracting stub: ~q\n",[H]) ; true), + retractall(H) + ; true))), %AsFunction = HeadIs, must_det_ll(( Converted = (HeadC :- NextBodyC), % Create a rule with Head as the converted AsFunction and NextBody as the converted AsBodyFn @@ -328,22 +336,26 @@ arg_eval_props(RetType0,RetProps), determine_eager_vars(lazy,ResultEager,AsBodyFn,EagerArgList), maplist(set_eager_or_lazy(EagerArgList),Args,EagerLazyList), + % EagerLazyList: eager/lazy + % TypeProps: x(doeval/noeval,eager/lazy) + % FinalLazyArgs: x(doeval/noeval,eager/lazy) maplist(combine_lazy_types_props,EagerLazyList,TypeProps,FinalLazyArgs), combine_lazy_types_props(ResultEager,RetProps,FinalLazyRet), - %format("\n##################################Eager args ~q ~q ~q\n\n",[EagerArgList,FinalLazyArgs,FinalLazyRet]), - %maplist(determine_eager(AsBodyFn),Args,) - assertz(transpiler_clause_store(FnName,LenArgsPlus1,Types0,RetType0,FinalLazyArgs,FinalLazyRet,HeadIs,AsBodyFn)), + findall(ClauseIDt,transpiler_clause_store(FnName,LenArgsPlus1,ClauseIDt,_,_,_,_,_,_),ClauseIdList), + (ClauseIdList=[] -> + ClauseId=0 + ; + max_list(ClauseIdList,ClauseIdm1),ClauseId is ClauseIdm1+1 + ), + assertz(transpiler_clause_store(FnName,LenArgsPlus1,ClauseId,Types0,RetType0,FinalLazyArgs,FinalLazyRet,HeadIs,AsBodyFn)), maplist(arrange_lazy_args,Args,FinalLazyArgs,LazyArgsList), - %leash(-all), - %trace, - f2p(HeadIs,LazyArgsList,HResult,FinalLazyRet,AsBodyFn,NextBody), + get_property_lazy(FinalLazyRet,FinalLazyOnlyRet), + f2p(HeadIs,LazyArgsList,HResult,FinalLazyOnlyRet,AsBodyFn,NextBody), %format("HeadIs:~q HResult:~q AsBodyFn:~q NextBody:~q\n",[HeadIs,HResult,AsBodyFn,NextBody]), - %format("HERE\n"), - %trace, %(var(HResult) -> (Result = HResult, HHead = Head) ; % funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head)), - ast_to_prolog(no_caller,fn_impl(FnName,Args,HResult),HeadC), + ast_to_prolog_aux(no_caller,[FnName/LenArgsPlus1],[assign,HResult,[call(FnName)|Args]],HeadC), output_language( ast, (( \+ \+ (( no_conflict_numbervars(HeadC + NextBody), @@ -352,12 +364,14 @@ true))))), - must_det_ll((ast_to_prolog(caller(FnName,LenArgsPlus1),NextBody,NextBodyC), - output_prolog(Converted))), - add_assertion(Space,Converted), - asserta_if_new(pred_uses_impl(FnName,LenArgsPlus1)), - ensure_callee_site(Space,FnName,LenArgsPlus1), - true)))). + ast_to_prolog(caller(FnName,LenArgsPlus1),[FnName/LenArgsPlus1],NextBody,NextBodyC), + %format("###########1 ~q",[Converted]), + %numbervars(Converted,0,_), + %format("###########2 ~q",[Converted]), + output_language(prolog, (print_pl_source(Converted))), + true + )). + output_prolog(Converted:-B):- !, %'#707084' @@ -389,7 +403,7 @@ % format("000000 ~q xxx ~q 000000\n\n",[Head,NextBody]), % optimize_head_and_body(Head,NextBody,HeadC,NextBodyB), % format("111111 ~q xxx ~q 111111\n\n",[HeadC,NextBodyB]), -% ast_to_prolog(Caller,[FnName/LenArgsPlus1],NextBodyB,NextBodyC), +% ast_to_prolog([FnName/LenArgsPlus1],NextBodyB,NextBodyC), % format("222222 ~q 222222\n\n",[NextBodyC]), % %fbug([convert(Convert),head_preconds_into_body(HeadC:-NextBodyC)]), % %if_t(((Head:-NextBody)\=@=(HeadC:-NextBodyC)),fbug(was(Head:-NextBody))), @@ -419,7 +433,7 @@ functs_to_preds0(I,OO):- sexpr_s2p(I, M), - f2p(_,vs(_),_,_Evaluated,M,O), + f2p(_,[],_,_Evaluated,M,O), expand_to_hb(O,H,B), head_preconds_into_body(H,B,HH,BB),!, OO = ':-'(HH,BB). @@ -550,6 +564,23 @@ fullvar(V) :- var(V), !. fullvar('$VAR'(_)). + +ensure_callee_site(Space,Fn,Arity):-transpiler_stub_created(Space,Fn,Arity),!. +ensure_callee_site(Space,Fn,Arity):- + must_det_ll(( + assertz(transpiler_stub_created(Space,Fn,Arity)), + transpile_call_prefix(Fn,CFn), + %trace, +((current_predicate(CFn/Arity) -> true ; + must_det_ll((( functor(CallP,CFn,Arity), + CallP=..[CFn|Args], + transpile_impl_prefix(Fn,IFn), CallI=..[IFn|Args], + %dynamic(IFn/Arity), + append(InArgs,[OutArg],Args), + Clause= (CallP:-((pred_uses_impl(Fn,Arity),CallI)*->true;(mc_fallback_unimpl(Fn,Arity,InArgs,OutArg)))), + output_prolog(Clause), + create_and_consult_temp_file(Space,CFn/Arity,[Clause])))))))),!. + prefix_impl_preds(Prefix,F,A):- prefix_impl_preds_pp(Prefix,F,A). prefix_impl_preds('mc__',F,A):- is_transpile_call_prefix(F,Fn),current_predicate(Fn/A), \+ prefix_impl_preds_pp(_,F,A). prefix_impl_preds('mi__',F,A):- is_transpile_impl_prefix(F,Fn),current_predicate(Fn/A), \+ prefix_impl_preds_pp(_,F,A). @@ -595,84 +626,6 @@ extract_caller(P,F,A):- \+ callable(P),!, F=P,A=0. extract_caller(P,F,A):- \+ is_list(P), functor(P,F,A). -ast_to_prolog(Caller,A,Result) :- - must_det_ll((ast_to_prolog_aux(Caller,A,Result))). - - -ast_to_prolog_aux(_Caller,A,A) :-fullvar(A),!. -%ast_to_prolog_aux(Caller,[],true). -ast_to_prolog_aux(_Caller,H,H):- \+ compound(H),!. -ast_to_prolog_aux(Caller,assign(A,X0),(A=X1)) :- !, ast_to_prolog_aux(Caller,X0,X1),!. -ast_to_prolog_aux(_Caller,'#\\'(A),A). - -% Roy's API -ast_to_prolog_aux(Caller,[assign,[call(F)|Args0],A],R):- ast_to_prolog_aux(Caller,fn_eval(F,Args0,A),R). -ast_to_prolog_aux(Caller,[native(F)|Args0],R):- ast_to_prolog_aux(Caller,fn_native(F,Args0),R). -ast_to_prolog_aux(Caller,[is_p1,Src,Code0,R],is_p1(Src,Code1,R)) :- !,ast_to_prolog(Caller,Code0,Code1). - - -ast_to_prolog_aux(Caller, if_or_else(If,Else),R):- ast_to_prolog_aux(Caller, (If*->true;Else),R). -ast_to_prolog_aux(Caller, Smack,R):- - compound(Smack), - Smack=..[NSF, _,_AnyRet, Six66,_Self, FArgs,Ret], - (NSF = eval_args;NSF = eval_20), - \+ atom_concat(find,_,NSF), - \+ atom_concat(_,e,NSF), - Six66 == 666, - ast_to_prolog_aux(Caller,eval(FArgs,Ret),R). -ast_to_prolog_aux(Caller, eval([F|Args],Ret),R):- atom(F),is_list(Args), - ast_to_prolog_aux(Caller,fn_eval(F,Args,Ret),R), !. - -ast_to_prolog_aux(Caller,(A),B) :- is_list(A),!,maplist(ast_to_prolog_aux(Caller),A,B). -ast_to_prolog_aux(Caller,[A],O) :- !, ast_to_prolog_aux(Caller,A,O). -ast_to_prolog_aux(Caller,list(A),B) :- is_list(A),!,maplist(ast_to_prolog_aux(Caller),A,B). -ast_to_prolog_aux(Caller,[prolog_if,If,Then,Else],R) :- !, - ast_to_prolog(Caller,If,If2), - ast_to_prolog(Caller,Then,Then2), - ast_to_prolog(Caller,Else,Else2), - R=((If2) *-> (Then2);(Else2)). -ast_to_prolog_aux(Caller,(If*->Then;Else),R) :- !, - ast_to_prolog(Caller,If,If2), - ast_to_prolog(Caller,Then,Then2), - ast_to_prolog(Caller,Else,Else2), - R=((If2) *-> (Then2);(Else2)). -ast_to_prolog_aux(Caller,fn_native(F,Args0),A) :- !, - %maplist(ast_to_prolog_aux(Caller),Args0,Args1), - F=..[Fn|Pre], % allow compound natives - append(Pre,Args0,ArgsNow), - A=..[Fn|ArgsNow], - notice_callee(Caller,A). - - - - - -ast_to_prolog_aux(Caller,fn_eval(F,Args00,A),R) :- atom(F), (fullvar(A); \+ compound(A)),!, - maybe_lazy_list(Caller,F,1,Args00,Args0), - transpile_call_prefix(F,Fp), - append(Args0,[A],Args1), - notice_callee(Caller,fn_eval(F,Args00,A)), - R=..[Fp|Args1]. -ast_to_prolog_aux(Caller,fn_impl(F,Args00,A),R) :- atom(F), (fullvar(A); \+ compound(A)),!, - maybe_lazy_list(Caller,F,1,Args00,Args0), - transpile_impl_prefix(F,Fp), - append(Args0,[A],Args1), - notice_callee(Caller,fn_impl(F,Args00,A)), - R=..[Fp|Args1]. -ast_to_prolog_aux(Caller,(True,T),R) :- True == true, ast_to_prolog_aux(Caller,T,R). -ast_to_prolog_aux(Caller,(T,True),R) :- True == true, ast_to_prolog_aux(Caller,T,R). -ast_to_prolog_aux(Caller,(H;T),(HH;TT)) :- ast_to_prolog_aux(Caller,H,HH),ast_to_prolog_aux(Caller,T,TT). -ast_to_prolog_aux(Caller,(H,T),(HH,TT)) :- ast_to_prolog_aux(Caller,H,HH),ast_to_prolog_aux(Caller,T,TT). -%ast_to_prolog_aux(Caller,[H],HH) :- ast_to_prolog_aux(Caller,H,HH). -%ast_to_prolog_aux(Caller,[H|T],(HH,TT)) :- ast_to_prolog_aux(Caller,H,HH),ast_to_prolog_aux(Caller,T,TT). -ast_to_prolog_aux(Caller,do_metta_runtime(T,G),do_metta_runtime(T,GGG)) :- !, ast_to_prolog_aux(Caller,G,GG),combine_code(GG,GGG). -ast_to_prolog_aux(Caller,loonit_assert_source_tf(T,G),loonit_assert_source_tf(T,GG)) :- !, ast_to_prolog_aux(Caller,G,GG). -ast_to_prolog_aux(Caller,findall(T,G,L),findall(T,GG,L)) :- !, ast_to_prolog_aux(Caller,G,GG). -ast_to_prolog_aux(Caller,FArgs,NewFArgs):- compound(FArgs),!, - compound_name_arguments(FArgs, Name, Args), - maplist(ast_to_prolog_aux(Caller),Args,NewArgs), - compound_name_arguments(NewCompound, Name, NewArgs),NewFArgs=NewCompound. -ast_to_prolog_aux(_,A,A). maybe_lazy_list(_,_,_,[],[]):-!. maybe_lazy_list(Caller,F,N,[Arg|Args],[ArgO|ArgsO]):- maybe_argo(Caller,F,N,Arg,ArgO), @@ -684,7 +637,39 @@ maybe_argo(Caller,_F,_N,Arg,ArgO):- ast_to_prolog_aux(Caller,Arg,ArgO). -/* +ast_to_prolog(Caller,DontStub,A,Result) :- + maplist(ast_to_prolog_aux(Caller,DontStub),A,B), + combine_code_list(B,Result). + +ast_to_prolog_aux(_,_,A,A) :- fullvar(A),!. +ast_to_prolog_aux(Caller,DontStub,list(A),B) :- !,maplist(ast_to_prolog_aux(Caller,DontStub),A,B). +ast_to_prolog_aux(Caller,DontStub,[prolog_if,If,Then,Else],R) :- !, + ast_to_prolog(Caller,DontStub,If,If2), + ast_to_prolog(Caller,DontStub,Then,Then2), + ast_to_prolog(Caller,DontStub,Else,Else2), + R=((If2) *-> (Then2);(Else2)). +ast_to_prolog_aux(Caller,DontStub,[is_p1,Code0,R],is_p1(Code1,R)) :- !,ast_to_prolog(Caller,DontStub,Code0,Code1). +ast_to_prolog_aux(Caller,DontStub,[native(F)|Args0],A) :- !, + maplist(ast_to_prolog_aux(Caller,DontStub),Args0,Args1), + A=..[F|Args1]. +ast_to_prolog_aux(Caller,DontStub,[assign,A,[call(F)|Args0]],R) :- (fullvar(A);\+ compound(A)),atom(F),!, + maplist(ast_to_prolog_aux(Caller,DontStub),Args0,Args1), + length(Args0,LArgs), + atomic_list_concat(['mc_',LArgs,'__',F],Fp), + LArgs1 is LArgs+1, + append(Args1,[A],Args2), + R=..[Fp|Args2], + (Caller=caller(CallerInt,CallerSz),(CallerInt-CallerSz)\=(F-LArgs1),\+ transpiler_depends_on(CallerInt,CallerSz,F,LArgs1) -> + assertz(transpiler_depends_on(CallerInt,CallerSz,F,LArgs1)), + (transpiler_show_debug_messages -> format("Asserting: transpiler_depends_on(~q,~q,~q,~q)\n",[CallerInt,CallerSz,F,LArgs1]) ; true) + ; true), + ((current_predicate(Fp/LArgs1);member(F/LArgs1,DontStub)) -> + true + ; check_supporting_predicates('&self',F/LArgs1)). +ast_to_prolog_aux(Caller,DontStub,[assign,A,X0],(A=X1)) :- ast_to_prolog_aux(Caller,DontStub,X0,X1),!. +ast_to_prolog_aux(_,_,'#\\'(A),A). +ast_to_prolog_aux(_,_,A,A). + combine_code_list(A,R) :- !, combine_code_list_aux(A,R0), (R0=[] -> R=true @@ -697,23 +682,29 @@ combine_code_list_aux([true|T],R) :- !,combine_code_list_aux(T,R). combine_code_list_aux([H|T],R) :- H=..[','|H0],!,append(H0,T,T0),combine_code_list_aux(T0,R). combine_code_list_aux([H|T],[H|R]) :- combine_code_list_aux(T,R). -*/ -/* check_supporting_predicates(Space,F/A) :- % already exists - transpile_prefix(Prefix), - atom_concat(Prefix,F,Fp), + A1 is A-1, + atomic_list_concat(['mc_',A1,'__',F],Fp), with_mutex(transpiler_mutex_lock, (current_predicate(Fp/A) -> true ; findall(Atom0, (between(1, A, I0) ,Atom0='$VAR'(I0)), AtomList0), H=..[Fp|AtomList0], Am1 is A-1, findall(Atom1, (between(1, Am1, I1), Atom1='$VAR'(I1)), AtomList1), - B=fn_eval(F,AtomList1,'$VAR'(A)), - % (transpiler_enable_interpreter_calls -> G=true;G=fail), + B=..[u_assign,[F|AtomList1],'$VAR'(A)], +% (transpiler_enable_interpreter_calls -> G=true;G=fail), +% assertz(transpiler_stub_created(F/A)), +% create_and_consult_temp_file(Space,Fp/A,[H:-(format("; % ######### warning: using stub for:~q\n",[F]),G,B)]))). assertz(transpiler_stub_created(F/A)), - create_and_consult_temp_file(Space,Fp/A,[H:-(format("; % ######### warning: using stub for:~q\n",[F]),trace,transpiler_enable_interpreter_calls,B)]))). -*/ + (transpiler_show_debug_messages -> format("; % ######### warning: creating stub for:~q\n",[F]) ; true), + (transpiler_enable_interpreter_calls -> + create_and_consult_temp_file(Space,Fp/A,[H:-(format("; % ######### warning: using stub for:~q\n",[F]),B)]) + ; + create_and_consult_temp_file(Space,Fp/A,[H:-('$VAR'(A)=[F|AtomList1])]) + ) + ) + ). % Predicate to create a temporary file and write the tabled predicate create_and_consult_temp_file(Space,F/A, PredClauses) :- @@ -827,14 +818,14 @@ f2p(_HeadIs, _LazyVars, RetResult, ResultLazy, Orig, Converted) :- Orig = '#\\'(Convert), (ResultLazy=eager -> RetResult=Convert, - Converted=true - ; Converted=assign(RetResult,is_p1(Orig,true,Convert))). + Converted=[] + ; Converted=[assign,RetResult,[is_p1,[],Convert]]). % If Convert is a number or an atom, it is considered as already converted. f2p(_HeadIs, _LazyVars, RetResult, ResultLazy, Convert, Converted) :- % HeadIs\=@=Convert, - once(number(Convert); atomic(Convert); data_term(Convert)), % Check if Convert is a number or an atom - (ResultLazy=eager -> C2=Convert ; C2=is_p1(Convert,true,Convert)), - Converted= true, RetResult =C2, + once(number(Convert); atom(Convert); data_term(Convert)), % Check if Convert is a number or an atom + (ResultLazy=eager -> C2=Convert ; C2=[is_p1,[],Convert]), + Converted=[[assign,RetResult,C2]], % For OVER-REACHING categorization of dataobjs % % wdmsg(data_term(Convert)), %trace_break, @@ -842,9 +833,9 @@ % If Convert is a number or an atom, it is considered as already converted. f2p(_HeadIs, _LazyVars, RetResult, ResultLazy, Convert, Converted) :- % HeadIs\=@=Convert, - once(number(Convert); atom(Convert); data_term(Convert)), % Check if Convert is a number or an atom + once(number(Convert); atomic(Convert); data_term(Convert)), % Check if Convert is a number or an atom (ResultLazy=eager -> C2=Convert ; C2=is_p1(Convert,true,Convert)), - Converted=assign(RetResult,C2), + Converted= true, RetResult =C2, % For OVER-REACHING categorization of dataobjs % % wdmsg(data_term(Convert)), %trace_break, @@ -906,12 +897,14 @@ length(Args, N), % create an eval-args list. TODO FIXME revisit this after working out how lists handle evaluation length(EvalArgs, N), - maplist(=(ResultLazy), EvalArgs), - maplist(f2p_skip_atom(HeadIs, LazyVars),NewArgs, EvalArgs, Args, NewCodes), - combine_code(NewCodes,assign(RetResult0,list(NewArgs)),Converted0), + maplist(=(eager), EvalArgs), + maplist(f2p(HeadIs, LazyVars),NewArgs, EvalArgs, Args, NewCodes), + append(NewCodes,CombinedNewCode), + Code=[assign,RetResult0,list(NewArgs)], + append(CombinedNewCode,[Code],Converted0), lazy_impedance_match(eager,ResultLazy,RetResult0,Converted0,RetResult,Converted). -update_laziness(X-_,Y,X-Y). +update_laziness(x(X,_),x(_,Y),x(X,Y)). f2p(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted):- Convert=[Fn|_], @@ -928,21 +921,23 @@ atom(Fn),!, length(Args,Largs), LenArgsPlus1 is Largs+1, - (transpiler_clause_store(Fn,LenArgsPlus1,_,_,ArgsLazy0,RetLazy0,_,_) -> + (transpiler_clause_store(Fn,LenArgsPlus1,_,_,_,ArgsLazy0,x(_,RetLazy0),_,_) -> UpToDateArgsLazy=ArgsLazy0, RetLazy=RetLazy0 ; RetLazy=eager, length(UpToDateArgsLazy, Largs), - maplist(=(eager), UpToDateArgsLazy)), + maplist(=(x(doeval,eager)), UpToDateArgsLazy)), % get the evaluation/laziness based on the types, but then update from the actual signature using 'update_laziness' get_operator_typedef_props(_,Fn,Largs,Types0,_RetType0), maplist(arg_eval_props,Types0,EvalArgs0), maplist(update_laziness,EvalArgs0,UpToDateArgsLazy,EvalArgs), maplist(do_arg_eval(HeadIs,LazyVars),Args,EvalArgs,NewArgs,NewCodes), - combine_code(NewCodes,CombinedNewCode), - combine_code(CombinedNewCode,fn_eval(Fn,NewArgs,RetResult0),Converted0), + append(NewCodes,CombinedNewCode), + Code=[assign,RetResult0,[call(Fn)|NewArgs]], + append(CombinedNewCode,[Code],Converted0), lazy_impedance_match(RetLazy,ResultLazy,RetResult0,Converted0,RetResult,Converted). + f2p(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted):- fail, Convert=[Fn|_], atom(Fn), @@ -962,7 +957,7 @@ length(EvalArgs, N), maplist(=(eager), EvalArgs), maplist(f2p_skip_atom(HeadIs, LazyVars),Converted,EvalArgs,Convert,Allcodes), - combine_code(Allcodes,true,Codes). + append(Allcodes,Codes). f2p_skip_atom(_HeadIs, _LazyVars,Converted, _EvalArgs, Convert,true):- \+ compound(Convert), !, Converted = Convert. @@ -970,33 +965,30 @@ f2p(HeadIs, LazyVars,Converted,EvalArgs,Convert,Allcodes). + f2p(HeadIs,LazyVars,_RetResult,EvalArgs,Convert,_Code):- format("Error in f2p ~q ~q ~q ~q\n",[HeadIs,LazyVars,Convert,EvalArgs]), trace,throw(0). -lazy_impedance_match(_,_,RetResult0,Converted0,RetResult0,Converted0):-!. lazy_impedance_match(L,L,RetResult0,Converted0,RetResult0,Converted0). lazy_impedance_match(lazy,eager,RetResult0,Converted0,RetResult,Converted) :- - combine_code(Converted0,fn_native(as_p1,[RetResult0,RetResult]),Converted). + append(Converted0,[[native(as_p1),RetResult0,RetResult]],Converted). lazy_impedance_match(eager,lazy,RetResult0,Converted0,RetResult,Converted) :- - combine_code(Converted0,assign(RetResult,is_p1(Converted0,true,RetResult0)),Converted). - - -arg_eval_props('Number',doeval-eager) :- !. -arg_eval_props('Bool',doeval-eager) :- !. -arg_eval_props('LazyBool',doeval-lazy) :- !. -arg_eval_props('Any',doeval-eager) :- !. -arg_eval_props('Expression',noeval-lazy) :- !. -arg_eval_props('Atom',noeval-lazy) :- !. -arg_eval_props('Evaluatable',doeval-lazy) :- !. -arg_eval_props(_,doeval-eager). - -%do_arg_eval(HeadIs,LazyVars,Arg,_DOELaz,NewArg,Code):- must_det_ll(is_var_set(LazyVars)),fail. -do_arg_eval(_,_,Arg,noeval-_,Arg,true). -do_arg_eval(HeadIs,LazyVars,Arg,doeval-lazy,is_p1(Arg,SubCode,SubArg),Code) :- + append(Converted0,[[assign,RetResult,[is_p1,[],RetResult0]]],Converted). + +arg_eval_props('Number',x(doeval,eager)) :- !. +arg_eval_props('Bool',x(doeval,eager)) :- !. +arg_eval_props('LazyBool',x(doeval,lazy)) :- !. +arg_eval_props('Any',x(doeval,eager)) :- !. +arg_eval_props('Atom',x(doeval,lazy)) :- !. +arg_eval_props('Expression',x(doeval,lazy)) :- !. +arg_eval_props(_,x(doeval,eager)). + +do_arg_eval(_,_,Arg,x(noeval,_),Arg,[]). +do_arg_eval(HeadIs,LazyVars,Arg,x(doeval,lazy),[is_p1,SubCode,SubArg],Code) :- f2p(HeadIs,LazyVars,SubArg,eager,Arg,SubCode), - Code=true. -do_arg_eval(HeadIs,LazyVars,Arg,doeval-eager,NewArg,Code) :- f2p(HeadIs,LazyVars,NewArg,eager,Arg,Code). + Code=[]. +do_arg_eval(HeadIs,LazyVars,Arg,x(doeval,eager),NewArg,Code) :- f2p(HeadIs,LazyVars,NewArg,eager,Arg,Code). :- discontiguous(compile_flow_control/6). :- discontiguous(compile_flow_control3/6). @@ -1005,6 +997,87 @@ +/* +ast_to_prolog(Caller,A,Result) :- + must_det_ll((ast_to_prolog_aux(Caller,A,Result))). + + +ast_to_prolog_aux(_Caller,A,A) :-fullvar(A),!. +%ast_to_prolog_aux(Caller,[],true). +ast_to_prolog_aux(_Caller,H,H):- \+ compound(H),!. +ast_to_prolog_aux(Caller,assign(A,X0),(A=X1)) :- !, ast_to_prolog_aux(Caller,X0,X1),!. +ast_to_prolog_aux(_Caller,'#\\'(A),A). + +% Roy's API +ast_to_prolog_aux(Caller,[assign,[call(F)|Args0],A],R):- ast_to_prolog_aux(Caller,fn_eval(F,Args0,A),R). +ast_to_prolog_aux(Caller,[native(F)|Args0],R):- ast_to_prolog_aux(Caller,fn_native(F,Args0),R). +ast_to_prolog_aux(Caller,[is_p1,Src,Code0,R],is_p1(Src,Code1,R)) :- !,ast_to_prolog(Caller,Code0,Code1). + + +ast_to_prolog_aux(Caller, if_or_else(If,Else),R):- ast_to_prolog_aux(Caller, (If*->true;Else),R). +ast_to_prolog_aux(Caller, Smack,R):- + compound(Smack), + Smack=..[NSF, _,_AnyRet, Six66,_Self, FArgs,Ret], + (NSF = eval_args;NSF = eval_20), + \+ atom_concat(find,_,NSF), + \+ atom_concat(_,e,NSF), + Six66 == 666, + ast_to_prolog_aux(Caller,eval(FArgs,Ret),R). +ast_to_prolog_aux(Caller, eval([F|Args],Ret),R):- atom(F),is_list(Args), + ast_to_prolog_aux(Caller,fn_eval(F,Args,Ret),R), !. + +ast_to_prolog_aux(Caller,(A),B) :- is_list(A),!,maplist(ast_to_prolog_aux(Caller),A,B). +ast_to_prolog_aux(Caller,[A],O) :- !, ast_to_prolog_aux(Caller,A,O). +ast_to_prolog_aux(Caller,list(A),B) :- is_list(A),!,maplist(ast_to_prolog_aux(Caller),A,B). +ast_to_prolog_aux(Caller,[prolog_if,If,Then,Else],R) :- !, + ast_to_prolog(Caller,If,If2), + ast_to_prolog(Caller,Then,Then2), + ast_to_prolog(Caller,Else,Else2), + R=((If2) *-> (Then2);(Else2)). +ast_to_prolog_aux(Caller,(If*->Then;Else),R) :- !, + ast_to_prolog(Caller,If,If2), + ast_to_prolog(Caller,Then,Then2), + ast_to_prolog(Caller,Else,Else2), + R=((If2) *-> (Then2);(Else2)). +ast_to_prolog_aux(Caller,fn_native(F,Args0),A) :- !, + %maplist(ast_to_prolog_aux(Caller),Args0,Args1), + F=..[Fn|Pre], % allow compound natives + append(Pre,Args0,ArgsNow), + A=..[Fn|ArgsNow], + notice_callee(Caller,A). + + + + + +ast_to_prolog_aux(Caller,fn_eval(F,Args00,A),R) :- atom(F), (fullvar(A); \+ compound(A)),!, + maybe_lazy_list(Caller,F,1,Args00,Args0), + transpile_call_prefix(F,Fp), + append(Args0,[A],Args1), + notice_callee(Caller,fn_eval(F,Args00,A)), + R=..[Fp|Args1]. +ast_to_prolog_aux(Caller,fn_impl(F,Args00,A),R) :- atom(F), (fullvar(A); \+ compound(A)),!, + maybe_lazy_list(Caller,F,1,Args00,Args0), + transpile_impl_prefix(F,Fp), + append(Args0,[A],Args1), + notice_callee(Caller,fn_impl(F,Args00,A)), + R=..[Fp|Args1]. +ast_to_prolog_aux(Caller,(True,T),R) :- True == true, ast_to_prolog_aux(Caller,T,R). +ast_to_prolog_aux(Caller,(T,True),R) :- True == true, ast_to_prolog_aux(Caller,T,R). +ast_to_prolog_aux(Caller,(H;T),(HH;TT)) :- ast_to_prolog_aux(Caller,H,HH),ast_to_prolog_aux(Caller,T,TT). +ast_to_prolog_aux(Caller,(H,T),(HH,TT)) :- ast_to_prolog_aux(Caller,H,HH),ast_to_prolog_aux(Caller,T,TT). +%ast_to_prolog_aux(Caller,[H],HH) :- ast_to_prolog_aux(Caller,H,HH). +%ast_to_prolog_aux(Caller,[H|T],(HH,TT)) :- ast_to_prolog_aux(Caller,H,HH),ast_to_prolog_aux(Caller,T,TT). +ast_to_prolog_aux(Caller,do_metta_runtime(T,G),do_metta_runtime(T,GGG)) :- !, ast_to_prolog_aux(Caller,G,GG),combine_code(GG,GGG). +ast_to_prolog_aux(Caller,loonit_assert_source_tf(T,G),loonit_assert_source_tf(T,GG)) :- !, ast_to_prolog_aux(Caller,G,GG). +ast_to_prolog_aux(Caller,findall(T,G,L),findall(T,GG,L)) :- !, ast_to_prolog_aux(Caller,G,GG). +ast_to_prolog_aux(Caller,FArgs,NewFArgs):- compound(FArgs),!, + compound_name_arguments(FArgs, Name, Args), + maplist(ast_to_prolog_aux(Caller),Args,NewArgs), + compound_name_arguments(NewCompound, Name, NewArgs),NewFArgs=NewCompound. +ast_to_prolog_aux(_,A,A). + +*/ in_type_set(Set,Type):- Set==Type,!. in_type_set(Set,Type):- compound(Set),arg(_,Set,Arg),in_type_set(Arg,Type). @@ -1037,7 +1110,7 @@ B=A,CodeNew=CodeOld ; var(A),fullvar(B) -> A=B,CodeNew=CodeOld - ; combine_code(CodeOld,[assign(A,B)],CodeNew)). + ; append(CodeOld,[[assign,A,B]],CodeNew)). compile_flow_control(_HeadIs,_LazyVars,_RetResult,_LazyEval,Convert,_):- \+ compound(Convert),!,fail. compile_flow_control(_HeadIs,_LazyVars,_RetResult,_LazyEval,Convert,_):- compound_name_arity(Convert,_,0),!,fail. @@ -1048,31 +1121,31 @@ %add_type(CondResult,'Bool',LazyVars), %add_type(Cond,'Bool',LazyVars), f2p(HeadIs,LazyVars,CondResult,eager,Cond,CondCode), - combine_code(CondCode,fn_native(is_True,[CondResult]),If), + append(CondCode,[[native(is_True),CondResult]],If), compile_test_then_else(RetResult,LazyVars,LazyEval,If,Then,Else,Converted). compile_test_then_else(RetResult,LazyVars,LazyEval,If,Then,Else,Converted):- f2p(HeadIs,LazyVars,ThenResult,LazyEval,Then,ThenCode), f2p(HeadIs,LazyVars,ElseResult,LazyEval,Else,ElseCode), % cannnot use add_assignment here as might not want to unify ThenResult and ElseResult - combine_code(ThenCode,assign(RetResult,ThenResult),T), - combine_code(ElseCode,assign(RetResult,ElseResult),E), - Converted=(If*->T;E). + append(ThenCode,[[assign,RetResult,ThenResult]],T), + append(ElseCode,[[assign,RetResult,ElseResult]],E), + Converted=[[prolog_if,If,T,E]]. compile_flow_control(HeadIs,LazyVars,RetResult,LazyEval,Convert, Converted) :- % dif_functors(HeadIs,Convert), - Convert =~ ['let',Var,Value1,Body],!, + Convert = ['let',Var,Value1,Body],!, f2p(HeadIs,LazyVars,ResValue1,eager,Value1,CodeForValue1), add_assignment(Var,ResValue1,CodeForValue1,CodeForValue2), f2p(HeadIs,LazyVars,RetResult,LazyEval,Body,BodyCode), - combine_code(CodeForValue2,BodyCode,Converted). + append(CodeForValue2,BodyCode,Converted). compile_flow_control(HeadIs,LazyVars,RetResult,LazyEval,Convert, Converted) :- %dif_functors(HeadIs,Convert), Convert =~ ['let*',Bindings,Body],!, must_det_ll(( maplist(compile_let_star(HeadIs,LazyVars),Bindings,CodeList), - combine_code(CodeList,Code), + append(CodeList,Code), f2p(HeadIs,LazyVars,RetResult,LazyEval,Body,BodyCode), - combine_code(Code,BodyCode,Converted))). + append(Code,BodyCode,Converted))). compile_let_star(HeadIs,LazyVars,[Var,Value1],Code) :- f2p(HeadIs,LazyVars,ResValue1,eager,Value1,CodeForValue1), @@ -1446,7 +1519,9 @@ is_clause_asserted(AC):- unnumbervars_clause(AC,UAC), expand_to_hb(UAC,H,B), H=..[Fh|Args], - transpile_impl_prefix(Fh,FPrefixed), + length(Args,N), + N1 is N-1, + atomic_list_concat(['mc_',N1,'__',Fh],FPrefixed), H2=..[FPrefixed|Args], clause(H2,B,Ref),clause(HH,BB,Ref), strip_m(HH,HHH),HHH=@=H2, @@ -1480,10 +1555,11 @@ if_t(N=2, (Set=[X,Y], numbervars(X), - numbervars(Y), - nl,display(X), - nl,display(Y), - nl)), + numbervars(Y) + %nl,display(X), + %nl,display(Y), + %nl + )), %wdmsg(list_to_set(F/A,N)), abolish(/*'&self':*/F/A), create_and_consult_temp_file(Space,F/A, Set) @@ -1575,6 +1651,8 @@ assign(X,list(Y)):- is_list(Y),!,X=Y. assign(X,X). +x_assign(X,X). + @@ -2572,7 +2650,7 @@ reverse(List,RevList),append(Left,[BE|Right],RevList), compound(BE),arg(Nth,BE,ArgRes),sub_var(Result,ArgRes), remove_funct_arg(BE, Nth, AsBodyFunction), - combine_code(Left,[eval_args(AsBodyFunction,Result)|Right],NewRevList), + append(Left,[eval_args(AsBodyFunction,Result)|Right],NewRevList), reverse(NewRevList,NewList), list_to_conjuncts(NewList,NewBody), preds_to_functs0(NewBody,ConvertedBody), diff --git a/prolog/metta_lang/metta_compiler_lib.pl b/prolog/metta_lang/metta_compiler_lib.pl index da17027118a..ff7e6061c87 100644 --- a/prolog/metta_lang/metta_compiler_lib.pl +++ b/prolog/metta_lang/metta_compiler_lib.pl @@ -1,3 +1,6 @@ +:- dynamic(transpiler_clause_store/9). +:- discontiguous transpiler_clause_store/9. + :- discontiguous get_type_sig/3. @@ -32,52 +35,106 @@ %%%%%%%%%%%%%%%%%%%%% arithmetic -% get_type_sig('+',['Number','Number'],'Number'). -'mc__+'(A,B,R) :- number(A),number(B),!,plus(A,B,R). -'mc__+'(A,B,['+',A,B]). +'mc_2__+'(A,B,R) :- number(A),number(B),!,plus(A,B,R). +'mc_2__+'(A,B,['+',A,B]). -'mc__-'(A,B,R) :- number(A),number(B),!,plus(B,R,A). -'mc__-'(A,B,['-',A,B]). +'mc_2__-'(A,B,R) :- number(A),number(B),!,plus(B,R,A). +'mc_2__-'(A,B,['-',A,B]). -'mc__*'(A,B,R) :- number(A),number(B),!,R is A*B. -'mc__*'(A,B,['*',A,B]). +'mc_2__*'(A,B,R) :- number(A),number(B),!,R is A*B. +'mc_2__*'(A,B,['*',A,B]). %%%%%%%%%%%%%%%%%%%%% logic -mc__and(A,B,B):- atomic(A), A\=='False', A\==0. -mc__and(_,_,'False'). +mc_2__and(A,B,B):- atomic(A), A\=='False', A\==0, !. +mc_2__and(_,_,'False'). + +mc_2__or(A,B,B):- (\+ atomic(A); A='False'; A=0), !. +mc_2__or(_,_,'True'). -mc__or(A,B,B):- (\+ atomic(A); A='False'; A=0), !. -mc__or(_,_,'True'). +mc_1__not(A,'False') :- atomic(A), A\=='False', A\==0, !. +mc_1__not(_,'True'). %%%%%%%%%%%%%%%%%%%%% comparison -'mc__=='(A,B,TF) :- (var(A);var(B)),!,A=B, TF='True'. -'mc__=='(A,B,TF) :- as_tf(A=B,TF). -%'mc__=='(_,_,0). +'mc_2__=='(A,A,1) :- !. +'mc_2__=='(_,_,0). + +'mc_2__<'(A,B,R) :- number(A),number(B),!,(A R='True' ; R='False'). +'mc_2__<'(A,B,['<',A,B]). -'mc__<'(A,B,R) :- number(A),number(B),!,(A R=1 ; R=0). -'mc__<'(A,B,['<',A,B]). +'mc_2__>'(A,B,R) :- number(A),number(B),!,(A>B -> R='True' ; R='False'). +'mc_2__>'(A,B,['>',A,B]). + +'mc_2__>='(A,B,R) :- number(A),number(B),!,(A>=B -> R='True' ; R='False'). +'mc_2__>='(A,B,['>=',A,B]). + +'mc_2__<='(A,B,R) :- number(A),number(B),!,(A= R='True' ; R='False'). % note that Prolog has a different syntax '=<' +'mc_2__<='(A,B,['<=',A,B]). %%%%%%%%%%%%%%%%%%%%% lists -'mc__car-atom'([H|_],H). +'mc_1__car-atom'([H|_],H). + +'mc_1__cdr-atom'([_|T],T). + +'mc_2__cons-atom'(A,B,[A|B]). + +'mc_1__decons-atom'([A|B],[A,B]). + +%%%%%%%%%%%%%%%%%%%%% set + +lazy_member(R1,Code2,R2) :- call(Code2),R1=R2. + +transpiler_clause_store(subtraction, 3, 0, ['Atom','Atom'], 'Atom', [x(doeval,lazy),x(doeval,lazy)], x(doeval,eager), [], []). +'mc_2__subtraction'(is_p1(Code1,R1),is_p1(Code2,R2),R1) :- + call(Code1), + \+ lazy_member(R1,Code2,R2). -'mc__cdr-atom'([_|T],T). +transpiler_clause_store(union, 3, 0, ['Atom','Atom'], 'Atom', [x(doeval,lazy),x(doeval,lazy)], x(doeval,eager), [], []). +'mc_2__union'(U1,is_p1(Code2,R2),R) :- 'mc_2__subtraction'(U1,is_p1(Code2,R2),R) ; call(Code2),R=R2. -'mc__cons-atom'(A,B,[A|B]). +%%%%%%%%%%%%%%%%%%%%% superpose, collapse -%%%%%%%%%%%%%%%%%%%%%superpose,collapse +'mc_1__superpose'(S,R) :- member(R,S). -'mi__superpose'([H|_],H). -'mi__superpose'([_|T],R):-'mi__superpose'(T,R). +% put a fake transpiler_clause_store here, just to force the argument to be lazy +transpiler_clause_store(collapse, 2, 0, ['Atom'], 'Expression', [x(doeval,lazy)], x(doeval,eager), [], []). +'mc_1__collapse'(is_p1(Code,Ret),R) :- fullvar(Ret),!,findall(Ret,Code,R). +'mc_1__collapse'(is_p1(true,X),[X]). + +%%%%%%%%%%%%%%%%%%%%% spaces + +'mc_2__add-atom'(Space,PredDecl,[]) :- 'add-atom'(Space,PredDecl). + +'mc_2__remove-atom'(Space,PredDecl,[]) :- 'remove-atom'(Space,PredDecl). + +'mc_1__get-atoms'(Space,Atoms) :- metta_atom(Space, Atoms). + +% put a fake transpiler_clause_store here, just to force the template to be lazy +transpiler_clause_store(match, 4, 0, ['Atom', 'Atom', 'Atom'], ' %Undefined%', [x(doeval,eager), x(doeval,eager), x(doeval,lazy)], x(doeval,eager), [], []). +'mc_3__match'(Space,Pattern,is_p1(TemplateCode,TemplateRet),TemplateRet) :- metta_atom(Space, Atom),Atom=Pattern,call(TemplateCode). + +% TODO FIXME: sort out the difference between unify and match +transpiler_clause_store(unify, 4, 0, ['Atom', 'Atom', 'Atom'], ' %Undefined%', [x(doeval,eager), x(doeval,eager), x(doeval,lazy)], x(doeval,eager), [], []). +'mc_3__unify'(Space,Pattern,is_p1(TemplateCode,TemplateRet),TemplateRet) :- metta_atom(Space, Atom),Atom=Pattern,call(TemplateCode). %%%%%%%%%%%%%%%%%%%%% misc -'mc__empty'(_) :- fail. +% put a fake transpiler_clause_store here, just to force the argument to be lazy +transpiler_clause_store(time, 2, 0, ['Atom'], 'Atom', [x(doeval,lazy)], x(doeval,eager), [], []). +'mc_1__time'(is_p1(Code,Ret),Ret) :- wtime_eval(Code). + +'mc_0__empty'(_) :- fail. + +'mc_1__eval'(X,R) :- transpile_eval(X,R). + +'mc_1__get-metatype'(X,Y) :- 'get-metatype'(X,Y). % use the code in the interpreter for now + +'mc_1__println!'(X,[]) :- println_impl(X). -'mc__stringToChars'(S,C) :- string_chars(S,C). +'mc_1__stringToChars'(S,C) :- string_chars(S,C). -'mc__charsToString'(C,S) :- string_chars(S,C). +'mc_1__charsToString'(C,S) :- string_chars(S,C). -mc__assertEqualToResult(A, B, C) :- u_assign([assertEqualToResult, A, B], C). +mc_2__assertEqualToResult(A, B, C) :- u_assign([assertEqualToResult, A, B], C). From 000f4b7db081290e5915a8fde3aefdefcc513717 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Sun, 22 Dec 2024 18:25:49 -0800 Subject: [PATCH 40/42] to allign --- prolog/metta_lang/metta_compiler.pl | 2172 +++++++++++------------ prolog/metta_lang/metta_compiler_lib.pl | 9 +- prolog/metta_lang/metta_printer.pl | 8 +- 3 files changed, 1006 insertions(+), 1183 deletions(-) diff --git a/prolog/metta_lang/metta_compiler.pl b/prolog/metta_lang/metta_compiler.pl index 0cff1f2d326..fcd9995b5a0 100755 --- a/prolog/metta_lang/metta_compiler.pl +++ b/prolog/metta_lang/metta_compiler.pl @@ -98,20 +98,11 @@ :- initialization(mutex_create_once(transpiler_mutex_lock)). :- at_halt(mutex_destroy(transpiler_mutex_lock)). -%transpile_prefix(''). -transpile_impl_prefix('mi__'). -:- dynamic(is_transpile_impl_prefix/2). -transpile_impl_prefix(F,Fn):- is_transpile_impl_prefix(F,Fn)*->true;(transpile_impl_prefix(Prefix),atom_concat(Prefix,F,Fn),asserta(is_transpile_impl_prefix(F,Fn))). - -transpile_call_prefix('mc__'). -:- dynamic(is_transpile_call_prefix/2). -transpile_call_prefix(F,Fn):- is_transpile_call_prefix(F,Fn)*->true;(transpile_call_prefix(Prefix),atom_concat(Prefix,F,Fn),asserta(is_transpile_call_prefix(F,Fn))). - %transpiler_enable_interpreter_calls. transpiler_enable_interpreter_calls :- fail. -%transpiler_show_debug_messages. -transpiler_show_debug_messages :- fail. +transpiler_show_debug_messages. +%transpiler_show_debug_messages :- fail. :- dynamic(transpiler_stub_created/1). % just so the transpiler_stub_created predicate always exists @@ -194,7 +185,7 @@ % !(compile-body! (+ 1 $x) ) % !(compile-body! (assertEqualToResult (Add (S (S Z)) (S (S (S Z)))) ((S (S (S (S (S Z))))))) ) compile_body(Body, Output):- - must_det_ll(( + must_det_lls(( term_variables(Body,BodyVars), maplist(cname_var('In_'),BodyVars), compile_for_exec(Ret, Body, Code), @@ -207,9 +198,8 @@ compile_for_exec(Res,I,OO):- %ignore(Res='$VAR'('RetResult')),` - must_det_ll(( - compile_for_exec0(Res,I,O), - ast_to_prolog(no_caller,O,OO))),!. + must_det_lls(( + compile_for_exec0(Res,I,OO))). compile_for_exec0(Res,I,eval_args(I,Res)):- is_ftVar(I),!. @@ -227,7 +217,7 @@ %compile_for_exec0(Res,I,O):- f2p(exec(),Res,I,O). compile_for_exec1(AsBodyFn, Converted) :- - must_det_ll(( + must_det_lls(( Converted = (HeadC :- NextBodyC), % Create a rule with Head as the converted AsFunction and NextBody as the converted AsBodyFn f2p([exec0],[],HResult,eager,AsBodyFn,NextBody), %optimize_head_and_body(x_assign([exec0],HResult),NextBody,HeadC,NextBodyB), @@ -300,22 +290,30 @@ combine_lazy_types_props(lazy,x(E,lazy),x(E,lazy)) :- !. combine_lazy_types_props(_,x(E,_),x(E,eager)). -transpile_eval(Convert,Converted) :- - (transpiler_stored_eval(Convert,PrologCode0,Converted0) -> +subst_varnames(Convert,Converted):- + subst_vars(Convert,Converted,[], NVL), + memorize_varnames(NVL). + +transpiler_stored_eval_lookup(Convert,PrologCode0,Converted0):- + transpiler_stored_eval(ConvertM,PrologCode0,Converted0), + ConvertM =@= Convert,ConvertM = Convert,!. + +transpile_eval(Convert0,Converted) :- + subst_varnames(Convert0,Convert), + (transpiler_stored_eval_lookup(Convert,PrologCode0,Converted0) -> PrologCode=PrologCode0, Converted=Converted0 ; f2p([],[],Converted,eager,Convert,Code), ast_to_prolog(no_caller,[],Code,PrologCode), - assertz(transpiler_stored_eval(Convert,PrologCode,Converted)) + compiler_assertz(transpiler_stored_eval(Convert,PrologCode,Converted)) ), call(PrologCode). % !(compile-for-assert (plus1 $x) (+ 1 $x) ) -compile_for_assert(HeadIs, AsBodyFn, Converted) :- - must_det_ll(( +compile_for_assert(HeadIsIn, AsBodyFnIn, Converted) :- + subst_varnames(HeadIsIn+AsBodyFnIn,HeadIs+AsBodyFn), %leash(-all),trace, - %current_self(Space), HeadIs=[FnName|Args], length(Args,LenArgs), LenArgsPlus1 is LenArgs+1, @@ -327,9 +325,9 @@ H=..[FnNameWPrefix|AtomList0], (transpiler_show_debug_messages -> format("Retracting stub: ~q\n",[H]) ; true), retractall(H) - ; true))), + ; true), %AsFunction = HeadIs, - must_det_ll(( + must_det_lls(( Converted = (HeadC :- NextBodyC), % Create a rule with Head as the converted AsFunction and NextBody as the converted AsBodyFn get_operator_typedef_props(_,FnName,LenArgs,Types0,RetType0), maplist(arg_eval_props,Types0,TypeProps), @@ -347,7 +345,7 @@ ; max_list(ClauseIdList,ClauseIdm1),ClauseId is ClauseIdm1+1 ), - assertz(transpiler_clause_store(FnName,LenArgsPlus1,ClauseId,Types0,RetType0,FinalLazyArgs,FinalLazyRet,HeadIs,AsBodyFn)), + compiler_assertz(transpiler_clause_store(FnName,LenArgsPlus1,ClauseId,Types0,RetType0,FinalLazyArgs,FinalLazyRet,HeadIs,AsBodyFn)), maplist(arrange_lazy_args,Args,FinalLazyArgs,LazyArgsList), get_property_lazy(FinalLazyRet,FinalLazyOnlyRet), f2p(HeadIs,LazyArgsList,HResult,FinalLazyOnlyRet,AsBodyFn,NextBody), @@ -355,29 +353,55 @@ %format("HeadIs:~q HResult:~q AsBodyFn:~q NextBody:~q\n",[HeadIs,HResult,AsBodyFn,NextBody]), %(var(HResult) -> (Result = HResult, HHead = Head) ; % funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head)), - ast_to_prolog_aux(no_caller,[FnName/LenArgsPlus1],[assign,HResult,[call(FnName)|Args]],HeadC), + HeadAst=[assign,HResult,[call(FnName)|Args]], + ast_to_prolog_aux(no_caller,[FnName/LenArgsPlus1],HeadAst,HeadC), output_language( ast, (( - \+ \+ (( no_conflict_numbervars(HeadC + NextBody), + \+ \+ (( %no_conflict_numbervars(HeadC + NextBody), %write_src_wi([=,HeadC,NextBody]), - print_tree_nl([=,HeadC,NextBody]), + nop( print_ast([=,HeadC,NextBody])), true))))), ast_to_prolog(caller(FnName,LenArgsPlus1),[FnName/LenArgsPlus1],NextBody,NextBodyC), + print_ast([=,HeadAst,NextBody]), %format("###########1 ~q",[Converted]), %numbervars(Converted,0,_), %format("###########2 ~q",[Converted]), - output_language(prolog, (print_pl_source(Converted))), + extract_constraints(Converted,EC), + \+ \+ (printable_vars(Converted+EC,PV+PC),output_prolog(PV),output_prolog(PC)), + true )). +compiler_assertz(Info):- assertz(Info),output_prolog(Info). + +output_prolog(Converted --> B):- !, ignore( \+ \+ color_g_mesg(cyan,output_language(prolog, (print_pl_source(Converted --> B))))). +output_prolog(:-B):- !, ignore( \+ \+ color_g_mesg(cyan,output_language(prolog, (print_pl_source(:-B))))). +output_prolog(Converted:-B):- !, ignore( \+ \+ color_g_mesg(cyan,output_language(prolog, (print_pl_source(Converted:-B))))). +output_prolog(Converted):- is_list(Converted), !, ignore( \+ \+ color_g_mesg(cyan,output_language(prolog, (maplist(writeln,Converted))))). +output_prolog(Converted):- ignore( \+ \+ color_g_mesg(cyan,output_language(prolog, (print_pl_source(Converted:-true), true)))). + +print_ast(HB):- printable_vars(HB,HBPN), print_ast_0(HBPN). +printable_vars(HB,HBPN):- + copy_term(HB,HBP), + set_vnames(HBP), + copy_term_nat(HBP,HBPN), + numbervars(HBPN,0,_,[]),!. -output_prolog(Converted:-B):- !, %'#707084' - color_g_mesg(cyan,output_language(prolog, (print_pl_source(Converted:-B)))). -output_prolog(Converted):- !, %'#707084' - color_g_mesg(cyan,output_language(prolog, (print_pl_source(Converted:-true)))). +set_vnames(HBP):- + term_variables(HBP,Vars), + maplist(only_names,Vars). + + +only_names(Var):- % del_attr(Var,cns), + ignore((get_attr(Var,vn,VN),Var = '$VAR'(VN))),!. +only_names(Var):- ignore(catch(del_attr(Var,cns),_,fail)), + ignore((get_attr(Var,vn,VN),nop(ignore(Var = '$VAR'(VN))))). + +%print_ast_0(HB):- output_language( ast, print_term(HB,[indent_arguments(true)])),!. +print_ast_0(HB):- output_language( ast, print_tree_nl(HB)). no_conflict_numbervars(Term):- findall(N,(sub_term(E,Term),compound(E), '$VAR'(N)=E, integer(N)),NL),!, @@ -390,7 +414,7 @@ % length(Args,LenArgs), % LenArgsPlus1 is LenArgs+1, % AsFunction = HeadIs, -% must_det_ll(( +% must_det_lls(( % Converted = (HeadC :- NextBodyC), % Create a rule with Head as the converted AsFunction and NextBody as the converted AsBodyFn % /*funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head),*/ % f2p(HeadIs,HResult,AsFunction,HHead), @@ -426,7 +450,7 @@ % eval_args(_C, RetResult)). % functs_to_preds(I,OO):- - must_det_ll(functs_to_preds0(I,OO)),!. + must_det_lls(functs_to_preds0(I,OO)),!. functs_to_preds0([Eq,H,B],OO):- Eq == '=', compile_for_assert(H, B, OO),!. functs_to_preds0(EqHB,OO):- compile_head_for_assert(EqHB,OO),!. @@ -567,12 +591,12 @@ ensure_callee_site(Space,Fn,Arity):-transpiler_stub_created(Space,Fn,Arity),!. ensure_callee_site(Space,Fn,Arity):- - must_det_ll(( - assertz(transpiler_stub_created(Space,Fn,Arity)), + must_det_lls(( + compiler_assertz(transpiler_stub_created(Space,Fn,Arity)), transpile_call_prefix(Fn,CFn), %trace, ((current_predicate(CFn/Arity) -> true ; - must_det_ll((( functor(CallP,CFn,Arity), + must_det_lls((( functor(CallP,CFn,Arity), CallP=..[CFn|Args], transpile_impl_prefix(Fn,IFn), CallI=..[IFn|Args], %dynamic(IFn/Arity), @@ -606,7 +630,7 @@ F \== exec0, CallerInt \== exec0, \+ (transpiler_depends_on(CallerInt,CallerSzU,F,LArgs1U), CallerSzU=@=CallerSz, LArgs1U=@=LArgs1), - assertz(transpiler_depends_on(CallerInt,CallerSz,F,LArgs1)), + compiler_assertz(transpiler_depends_on(CallerInt,CallerSz,F,LArgs1)), (transpiler_show_debug_messages -> format("; Asserting: transpiler_depends_on(~q,~q,~q,~q)\n",[CallerInt,CallerSz,F,LArgs1]) -> true), ignore((current_self(Space),ensure_callee_site(Space,CallerInt,CallerSz))), output_prolog(transpiler_depends_on(CallerInt,CallerSz,F,LArgs1)) )), @@ -636,9 +660,12 @@ maybe_argo(_Caller,_F,_N,Arg,Arg):- \+ compound(Arg),!. maybe_argo(Caller,_F,_N,Arg,ArgO):- ast_to_prolog_aux(Caller,Arg,ArgO). - ast_to_prolog(Caller,DontStub,A,Result) :- maplist(ast_to_prolog_aux(Caller,DontStub),A,B), + combine_code_list(B,Result),!. + +ast_to_prolog(Caller,DontStub,A,Result) :- + ast_to_prolog_aux(Caller,DontStub,A,B), combine_code_list(B,Result). ast_to_prolog_aux(_,_,A,A) :- fullvar(A),!. @@ -650,26 +677,110 @@ R=((If2) *-> (Then2);(Else2)). ast_to_prolog_aux(Caller,DontStub,[is_p1,Code0,R],is_p1(Code1,R)) :- !,ast_to_prolog(Caller,DontStub,Code0,Code1). ast_to_prolog_aux(Caller,DontStub,[native(F)|Args0],A) :- !, + must_det_lls(label_arg_types(F,1,Args0)), maplist(ast_to_prolog_aux(Caller,DontStub),Args0,Args1), + must_det_lls(label_arg_types(F,1,Args1)), A=..[F|Args1]. -ast_to_prolog_aux(Caller,DontStub,[assign,A,[call(F)|Args0]],R) :- (fullvar(A);\+ compound(A)),atom(F),!, +ast_to_prolog_aux(Caller,DontStub,[assign,A,[call(F)|Args0]],R) :- (fullvar(A); \+ compound(A)),atom(F),!, + must_det_lls(label_arg_types(F,1,Args0)), maplist(ast_to_prolog_aux(Caller,DontStub),Args0,Args1), length(Args0,LArgs), atomic_list_concat(['mc_',LArgs,'__',F],Fp), + must_det_lls(label_arg_types(F,0,[A|Args1])), LArgs1 is LArgs+1, append(Args1,[A],Args2), R=..[Fp|Args2], (Caller=caller(CallerInt,CallerSz),(CallerInt-CallerSz)\=(F-LArgs1),\+ transpiler_depends_on(CallerInt,CallerSz,F,LArgs1) -> - assertz(transpiler_depends_on(CallerInt,CallerSz,F,LArgs1)), + compiler_assertz(transpiler_depends_on(CallerInt,CallerSz,F,LArgs1)), (transpiler_show_debug_messages -> format("Asserting: transpiler_depends_on(~q,~q,~q,~q)\n",[CallerInt,CallerSz,F,LArgs1]) ; true) ; true), ((current_predicate(Fp/LArgs1);member(F/LArgs1,DontStub)) -> true ; check_supporting_predicates('&self',F/LArgs1)). -ast_to_prolog_aux(Caller,DontStub,[assign,A,X0],(A=X1)) :- ast_to_prolog_aux(Caller,DontStub,X0,X1),!. +ast_to_prolog_aux(Caller,DontStub,[assign,A,X0],(A=X1)) :- must_det_lls(label_type_assignment(A,X0)), ast_to_prolog_aux(Caller,DontStub,X0,X1),label_type_assignment(A,X1),!. ast_to_prolog_aux(_,_,'#\\'(A),A). +ast_to_prolog_aux(_,_,A=B,A=B):- must_det_lls(label_type_assignment(A,B)). + +ast_to_prolog_aux(Call,DontStub,(True,T),R) :- True == true, ast_to_prolog_aux(Call,DontStub,T,R). +ast_to_prolog_aux(Call,DontStub,(T,True),R) :- True == true, ast_to_prolog_aux(Call,DontStub,T,R). +ast_to_prolog_aux(Call,DontStub,(H;T),(HH;TT)) :- ast_to_prolog_aux(Call,DontStub,H,HH),ast_to_prolog_aux(Call,DontStub,T,TT). +ast_to_prolog_aux(Call,DontStub,(H,T),(HH,TT)) :- ast_to_prolog_aux(Call,DontStub,H,HH),ast_to_prolog_aux(Call,DontStub,T,TT). +%ast_to_prolog_aux(Call,DontStub,[H],HH) :- ast_to_prolog_aux(Call,DontStub,H,HH). +%ast_to_prolog_aux(Call,DontStub,[H|T],(HH,TT)) :- ast_to_prolog_aux(Call,DontStub,H,HH),ast_to_prolog_aux(Call,DontStub,T,TT). + ast_to_prolog_aux(_,_,A,A). +cns:attr_unify_hook(_V,_T):- true. + +%must_det_lls(G):- catch(G,E,(wdmsg(E),fail)),!. +%must_det_lls(G):- rtrace(G),!. +must_det_lls(G):- catch(G,E,(wdmsg(E),fail)),!. +must_det_lls(G):- notrace,nortrace,trace,call(G),!. + +extract_constraints(V,VS):- var(V),get_attr(V,vn,Name),get_attr(V,cns,Set),!,extract_constraints(Name,Set,VS),!. +extract_constraints(V,VS):- var(V),!,ignore(get_types_of(V,Types)),extract_constraints(V,Types,VS),!. +extract_constraints(Converted,VSS):- term_variables(Converted,Vars), + % assign_vns(0,Vars,_), + maplist(extract_constraints,Vars,VSS). +extract_constraints(V,[],V=[]):-!. +extract_constraints(V,Types,V=Types). + + +label_vns(S,G,E):- term_variables(G,Vars),assign_vns(S,Vars,E),!. +assign_vns(S,[],S):-!. +assign_vns(N,[V|Vars],O):- get_attr(V,vn,_),!, assign_vns(N,Vars,O). +assign_vns(N,[V|Vars],O):- format(atom(VN),'~w',['$VAR'(N)]), + put_attr(V,vn,VN), N2 is N+1, assign_vns(N2,Vars,O). + +label_arg_types(_,_,[]):-!. +label_arg_types(F,N,[A|Args]):- + label_arg_n_type(F,N,A),N2 is N+1, + label_arg_types(F,N2,Args). + +% label_arg_n_type(F,0,A):- !, label_type_assignment(A,F). +label_arg_n_type(F,N,A):- add_type_to(A,arg(F,N)),!. + +add_type_to(V,T):- is_list(T), !, maplist(add_type_to(V),T). +add_type_to(V,T):- T =@= val(V),!. +add_type_to(V,T):- ground(T),arg_type_hints(T,H),!,add_type_to(V,H). +add_type_to(V,T):- + must_det_lls(( + get_types_of(V,TV), + append([T],TV,TTV), + set_types_of(V,TTV))). + +label_type_assignment(V,O):- + must_det_lls(( + get_types_of(V,TV), get_types_of(O,TO), + add_type_to(V,val(O)), + add_type_to(O,val(V)), + add_type_to(V,TO), + add_type_to(O,TV))). + +is_functor_val(val(_)). + +arg_type_hints(arg(is_True,1),'Bool'). +arg_type_hints(arg(==,0),'Bool'). +arg_type_hints(arg(match,0),['Empty',arg(match,3)]). +arg_type_hints(arg(empty,0),'Empty'). +arg_type_hints(val('Empty'),'Empty'). +arg_type_hints(val('True'),'Bool'). +arg_type_hints(val('False'),'Bool'). +arg_type_hints(arg('println!',0),'UnitAtom'). + +get_just_types_of(V,Types):- get_types_of(V,VTypes),exclude(is_functor_val,VTypes,Types). + +get_types_of(V,Types):- attvar(V),get_attr(V,cns,Types),!. +get_types_of(V,Types):- compound(V),V=arg(_,_),!,Types=[V]. +get_types_of(V,Types):- findall(Type,get_type_for_args(V,Type),Types). + +get_type_for_args(V,Type):- get_type(V,Type), Type\==[], Type\=='%Undefined%', Type\=='list'. + +set_types_of(V,_Types):- nonvar(V),!. +set_types_of(V,Types):- list_to_set(Types,Set),put_attr(V,cns,Set), nop(wdmsg(V=Types)). + + + combine_code_list(A,R) :- !, combine_code_list_aux(A,R0), (R0=[] -> R=true @@ -694,9 +805,9 @@ findall(Atom1, (between(1, Am1, I1), Atom1='$VAR'(I1)), AtomList1), B=..[u_assign,[F|AtomList1],'$VAR'(A)], % (transpiler_enable_interpreter_calls -> G=true;G=fail), -% assertz(transpiler_stub_created(F/A)), +% compiler_assertz(transpiler_stub_created(F/A)), % create_and_consult_temp_file(Space,Fp/A,[H:-(format("; % ######### warning: using stub for:~q\n",[F]),G,B)]))). - assertz(transpiler_stub_created(F/A)), + compiler_assertz(transpiler_stub_created(F/A)), (transpiler_show_debug_messages -> format("; % ######### warning: creating stub for:~q\n",[F]) ; true), (transpiler_enable_interpreter_calls -> create_and_consult_temp_file(Space,Fp/A,[H:-(format("; % ######### warning: using stub for:~q\n",[F]),B)]) @@ -708,7 +819,7 @@ % Predicate to create a temporary file and write the tabled predicate create_and_consult_temp_file(Space,F/A, PredClauses) :- - must_det_ll(( + must_det_lls(( % Generate a unique temporary memory buffer tmp_file_stream(text, TempFileName, TempFileStream), % Write the tabled predicate to the temporary file @@ -795,12 +906,12 @@ quietlY(G):- call(G). unshebang(S,US):- symbol(S),(symbol_concat(US,'!',S)->true;US=S). -compile_maplist_p2(_,[],[],true). +compile_maplist_p2(_,[],[],[]). compile_maplist_p2(P2,[Var|Args],[Res|NewArgs],PreCode):- \+ fullvar(Var), call(P2,Var,Res), !, compile_maplist_p2(P2,Args,NewArgs,PreCode). compile_maplist_p2(P2,[Var|Args],[Res|NewArgs],TheCode):- compile_maplist_p2(P2,Args,NewArgs,PreCode), - combine_code(fn_native(P2,[Var,Res]),PreCode,TheCode). + append([[native(P2),Var,Res]],PreCode,TheCode). var_prop_lookup(_,[],eager). @@ -810,8 +921,8 @@ :- discontiguous f2p/6. -f2p(_HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- % must_det_ll(is_var_set(LazyVars)), - (is_ftVar(Convert);number(Convert)),!, % Check if Convert is a variable +f2p(_HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- % must_det_lls(is_var_set(LazyVars)), + (is_ftVar(Convert);number(Convert); string(Convert); \+ compound(Convert) ; \+ callable(Convert)),!, % Check if Convert is a variable var_prop_lookup(Convert,LazyVars,L), lazy_impedance_match(L,ResultLazy,Convert,[],RetResult,Converted). @@ -823,9 +934,9 @@ % If Convert is a number or an atom, it is considered as already converted. f2p(_HeadIs, _LazyVars, RetResult, ResultLazy, Convert, Converted) :- % HeadIs\=@=Convert, - once(number(Convert); atom(Convert); data_term(Convert)), % Check if Convert is a number or an atom - (ResultLazy=eager -> C2=Convert ; C2=[is_p1,[],Convert]), - Converted=[[assign,RetResult,C2]], + once(number(Convert);atomic(Convert);\+compound(Convert);data_term(Convert)),%CheckifConvertisanumberoranatom + (ResultLazy=eager->C2=Convert;C2=is_p1(Convert,true,Convert)), + Converted= [], RetResult=C2, % For OVER-REACHING categorization of dataobjs % % wdmsg(data_term(Convert)), %trace_break, @@ -833,9 +944,9 @@ % If Convert is a number or an atom, it is considered as already converted. f2p(_HeadIs, _LazyVars, RetResult, ResultLazy, Convert, Converted) :- % HeadIs\=@=Convert, - once(number(Convert); atomic(Convert); data_term(Convert)), % Check if Convert is a number or an atom - (ResultLazy=eager -> C2=Convert ; C2=is_p1(Convert,true,Convert)), - Converted= true, RetResult =C2, + once(number(Convert); atom(Convert); \+ compound(Convert) ; data_term(Convert)), % Check if Convert is a number or an atom + (ResultLazy=eager -> C2=Convert ; C2=[is_p1,[],Convert]), + Converted=[[assign,RetResult,C2]], % For OVER-REACHING categorization of dataobjs % % wdmsg(data_term(Convert)), %trace_break, @@ -849,11 +960,11 @@ % !(compile-body! (call-fn! compile_body (call-p writeln "666")) f2p(HeadIs, _LazyVars, RetResult, ResultLazy, Convert, Converted) :- HeadIs\=@=Convert, Convert=[Fn,Native|Args],atom(Fn),unshebang(Fn,'call-p'),!, - must_det_ll(( + must_det_lls(( compile_maplist_p2(as_prolog,Args,NewArgs,PreCode), %RetResult = 'True', compile_maplist_p2(from_prolog_args(ResultLazy),NewArgs,Args,PostCode), - combine_code((PreCode,fn_native(Native,NewArgs),assign(RetResult,'True')),PostCode,Converted))). + append([PreCode,[[native(Native),NewArgs],[assign,RetResult,'True']],PostCode],Converted))). % !(compile-body! (call-fn length $list)) f2p(HeadIs, _LazyVars, RetResult, ResultLazy, Convert, Converted) :- HeadIs\=@=Convert, @@ -861,7 +972,7 @@ compile_maplist_p2(as_prolog,Args,NewArgs,PreCode), append(NewArgs,[Result],CallArgs), compile_maplist_p2(from_prolog_args(maybe(ResultLazy)),[Result],[RetResult],PostCode), - combine_code(PreCode,(fn_native(Native,CallArgs),PostCode),Converted). + append([PreCode,[[native(Native),CallArgs]],PostCode],Converted). % !(compile-body! (call-fn-nth 0 wots version)) f2p(HeadIs, _LazyVars, RetResult, ResultLazy, Convert, Converted) :- HeadIs\=@=Convert, @@ -871,7 +982,7 @@ append(Left,Right,S), append(Left,[R|Right],Args),!, compile_maplist_p2(from_prolog_args(maybe(ResultLazy)),[R],[RetResult],PostCode), - combine_code(PreCode,(fn_native(Native,Args),PostCode),Converted). + append([PreCode,[[native(Native),Args]],PostCode],Converted). % !(compile-body! (length-p (a b c d) 4)) % !(compile-body! (format! "~q ~q ~q" (a b c))) @@ -880,7 +991,8 @@ compile_maplist_p2(as_prolog,Args,NewArgs,PreCode), %RetResult = 'True', compile_maplist_p2(from_prolog_args(maybe(ResultLazy)),NewArgs,Args,PostCode), - combine_code(PreCode,(fn_native(Native,NewArgs),(assign(RetResult,'True'),PostCode)),Converted). + append([PreCode,[[native(Native),NewArgs],[assign,RetResult,'True']],PostCode],Converted). + % !(compile-body! (length-fn (a b c d))) f2p(HeadIs, _LazyVars, RetResult, ResultLazy, Convert, Converted) :- HeadIs\=@=Convert, @@ -889,7 +1001,8 @@ compile_maplist_p2(as_prolog,Args,NewArgs,PreCode), append(NewArgs,[Result],CallArgs), compile_maplist_p2(from_prolog_args(maybe(ResultLazy)),[Result],[RetResult],PostCode), - combine_code(PreCode,(fn_native(Native,CallArgs),PostCode),Converted). + append([PreCode,[[native(Native),CallArgs]],PostCode],Converted). + f2p(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- HeadIs\=@=Convert, Convert=[Fn|_], \+ atom(Fn), @@ -906,11 +1019,13 @@ update_laziness(x(X,_),x(_,Y),x(X,Y)). -f2p(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted):- +% prememptive flow contols +f2p(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted):- fail, Convert=[Fn|_], atom(Fn), compile_flow_control1(HeadIs,LazyVars,RetResult,ResultLazy, Convert, Converted),!. +% unsupprted flow contols f2p(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted):- fail, Convert=[Fn|_], atom(Fn), @@ -938,20 +1053,19 @@ append(CombinedNewCode,[Code],Converted0), lazy_impedance_match(RetLazy,ResultLazy,RetResult0,Converted0,RetResult,Converted). -f2p(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted):- fail, - Convert=[Fn|_], - atom(Fn), - compile_flow_control3(HeadIs,LazyVars,RetResult,ResultLazy, Convert, Converted),!. +f2p(HeadIs,LazyVars,RetResult,ResultLazy,Convert,Converted):-fail, +Convert=[Fn|_], +atom(Fn), +compile_flow_control3(HeadIs,LazyVars,RetResult,ResultLazy,Convert,Converted),!. % The catch-all If no specific case is matched, consider Convert as already converted. -%f2p(_HeadIs, LazyVars, _RetResult, ResultLazy, x_assign(Convert,Res), x_assign(Convert,Res)):- !. -%f2p(_HeadIs, LazyVars, RetResult, ResultLazy, Convert, Code):- into_x_assign(Convert,RetResult,Code). +%f2p(_HeadIs,_RetResult,x_assign(Convert,Res), x_assign(Convert,Res)):- !. +%f2p(_HeadIs,RetResult,Convert, Code):- into_x_assign(Convert,RetResult,Code). -%f2p(HeadIs, LazyVars, list(Convert), ResultLazy, Convert, []) :- trace,HeadIs\=@=Convert, +%f2p(HeadIs, list(Convert), Convert, []) :- trace,HeadIs\=@=Convert, % is_list(Convert),!. -f2p(HeadIs, LazyVars, list(Converted), _ResultLazy, Convert, Codes) :- % HeadIs\=@=Convert, - is_list(Convert),!, +f2p(HeadIs, LazyVars, list(Converted), _ResultLazy, Convert, Codes) :- HeadIs\=@=Convert, is_list(Convert),!, length(Convert, N), % create an eval-args list. TODO FIXME revisit this after working out how lists handle evaluation length(EvalArgs, N), @@ -959,10 +1073,10 @@ maplist(f2p_skip_atom(HeadIs, LazyVars),Converted,EvalArgs,Convert,Allcodes), append(Allcodes,Codes). -f2p_skip_atom(_HeadIs, _LazyVars,Converted, _EvalArgs, Convert,true):- - \+ compound(Convert), !, Converted = Convert. -f2p_skip_atom(HeadIs, LazyVars,Converted,EvalArgs,Convert,Allcodes):- - f2p(HeadIs, LazyVars,Converted,EvalArgs,Convert,Allcodes). +f2p_skip_atom(_HeadIs,_LazyVars,Converted,_EvalArgs,Convert,true):- +\+compound(Convert),!,Converted=Convert. +f2p_skip_atom(HeadIs,LazyVars,Converted,EvalArgs,Convert,Allcodes):- +f2p(HeadIs,LazyVars,Converted,EvalArgs,Convert,Allcodes). @@ -996,114 +1110,31 @@ :- discontiguous(compile_flow_control1/6). +in_type_set(Set,Type):-Set==Type,!. +in_type_set(Set,Type):-compound(Set),arg(_,Set,Arg),in_type_set(Arg,Type). -/* -ast_to_prolog(Caller,A,Result) :- - must_det_ll((ast_to_prolog_aux(Caller,A,Result))). - - -ast_to_prolog_aux(_Caller,A,A) :-fullvar(A),!. -%ast_to_prolog_aux(Caller,[],true). -ast_to_prolog_aux(_Caller,H,H):- \+ compound(H),!. -ast_to_prolog_aux(Caller,assign(A,X0),(A=X1)) :- !, ast_to_prolog_aux(Caller,X0,X1),!. -ast_to_prolog_aux(_Caller,'#\\'(A),A). - -% Roy's API -ast_to_prolog_aux(Caller,[assign,[call(F)|Args0],A],R):- ast_to_prolog_aux(Caller,fn_eval(F,Args0,A),R). -ast_to_prolog_aux(Caller,[native(F)|Args0],R):- ast_to_prolog_aux(Caller,fn_native(F,Args0),R). -ast_to_prolog_aux(Caller,[is_p1,Src,Code0,R],is_p1(Src,Code1,R)) :- !,ast_to_prolog(Caller,Code0,Code1). - - -ast_to_prolog_aux(Caller, if_or_else(If,Else),R):- ast_to_prolog_aux(Caller, (If*->true;Else),R). -ast_to_prolog_aux(Caller, Smack,R):- - compound(Smack), - Smack=..[NSF, _,_AnyRet, Six66,_Self, FArgs,Ret], - (NSF = eval_args;NSF = eval_20), - \+ atom_concat(find,_,NSF), - \+ atom_concat(_,e,NSF), - Six66 == 666, - ast_to_prolog_aux(Caller,eval(FArgs,Ret),R). -ast_to_prolog_aux(Caller, eval([F|Args],Ret),R):- atom(F),is_list(Args), - ast_to_prolog_aux(Caller,fn_eval(F,Args,Ret),R), !. - -ast_to_prolog_aux(Caller,(A),B) :- is_list(A),!,maplist(ast_to_prolog_aux(Caller),A,B). -ast_to_prolog_aux(Caller,[A],O) :- !, ast_to_prolog_aux(Caller,A,O). -ast_to_prolog_aux(Caller,list(A),B) :- is_list(A),!,maplist(ast_to_prolog_aux(Caller),A,B). -ast_to_prolog_aux(Caller,[prolog_if,If,Then,Else],R) :- !, - ast_to_prolog(Caller,If,If2), - ast_to_prolog(Caller,Then,Then2), - ast_to_prolog(Caller,Else,Else2), - R=((If2) *-> (Then2);(Else2)). -ast_to_prolog_aux(Caller,(If*->Then;Else),R) :- !, - ast_to_prolog(Caller,If,If2), - ast_to_prolog(Caller,Then,Then2), - ast_to_prolog(Caller,Else,Else2), - R=((If2) *-> (Then2);(Else2)). -ast_to_prolog_aux(Caller,fn_native(F,Args0),A) :- !, - %maplist(ast_to_prolog_aux(Caller),Args0,Args1), - F=..[Fn|Pre], % allow compound natives - append(Pre,Args0,ArgsNow), - A=..[Fn|ArgsNow], - notice_callee(Caller,A). - - - - - -ast_to_prolog_aux(Caller,fn_eval(F,Args00,A),R) :- atom(F), (fullvar(A); \+ compound(A)),!, - maybe_lazy_list(Caller,F,1,Args00,Args0), - transpile_call_prefix(F,Fp), - append(Args0,[A],Args1), - notice_callee(Caller,fn_eval(F,Args00,A)), - R=..[Fp|Args1]. -ast_to_prolog_aux(Caller,fn_impl(F,Args00,A),R) :- atom(F), (fullvar(A); \+ compound(A)),!, - maybe_lazy_list(Caller,F,1,Args00,Args0), - transpile_impl_prefix(F,Fp), - append(Args0,[A],Args1), - notice_callee(Caller,fn_impl(F,Args00,A)), - R=..[Fp|Args1]. -ast_to_prolog_aux(Caller,(True,T),R) :- True == true, ast_to_prolog_aux(Caller,T,R). -ast_to_prolog_aux(Caller,(T,True),R) :- True == true, ast_to_prolog_aux(Caller,T,R). -ast_to_prolog_aux(Caller,(H;T),(HH;TT)) :- ast_to_prolog_aux(Caller,H,HH),ast_to_prolog_aux(Caller,T,TT). -ast_to_prolog_aux(Caller,(H,T),(HH,TT)) :- ast_to_prolog_aux(Caller,H,HH),ast_to_prolog_aux(Caller,T,TT). -%ast_to_prolog_aux(Caller,[H],HH) :- ast_to_prolog_aux(Caller,H,HH). -%ast_to_prolog_aux(Caller,[H|T],(HH,TT)) :- ast_to_prolog_aux(Caller,H,HH),ast_to_prolog_aux(Caller,T,TT). -ast_to_prolog_aux(Caller,do_metta_runtime(T,G),do_metta_runtime(T,GGG)) :- !, ast_to_prolog_aux(Caller,G,GG),combine_code(GG,GGG). -ast_to_prolog_aux(Caller,loonit_assert_source_tf(T,G),loonit_assert_source_tf(T,GG)) :- !, ast_to_prolog_aux(Caller,G,GG). -ast_to_prolog_aux(Caller,findall(T,G,L),findall(T,GG,L)) :- !, ast_to_prolog_aux(Caller,G,GG). -ast_to_prolog_aux(Caller,FArgs,NewFArgs):- compound(FArgs),!, - compound_name_arguments(FArgs, Name, Args), - maplist(ast_to_prolog_aux(Caller),Args,NewArgs), - compound_name_arguments(NewCompound, Name, NewArgs),NewFArgs=NewCompound. -ast_to_prolog_aux(_,A,A). - -*/ - -in_type_set(Set,Type):- Set==Type,!. -in_type_set(Set,Type):- compound(Set),arg(_,Set,Arg),in_type_set(Arg,Type). - -b_put_set(Set,Type):- functor(Set,_,Arg),!,b_put_nset(Set,Arg,Type). -b_put_nset(Set,_,Type):- in_type_set(Set,Type),!. -b_put_nset(Set,N,Type):- arg(N,Set,Arg), - (compound(Arg)->b_put_set(Arg,Type);b_setarg(N,Set,[Type|Arg])). +b_put_set(Set,Type):-functor(Set,_,Arg),!,b_put_nset(Set,Arg,Type). +b_put_nset(Set,_,Type):-in_type_set(Set,Type),!. +b_put_nset(Set,N,Type):-arg(N,Set,Arg), +(compound(Arg)->b_put_set(Arg,Type);b_setarg(N,Set,[Type|Arg])). is_type_set(Set):-compound(Set),Set=ts(_). -is_var_set(Set):- compound(Set),Set=vs(_). +is_var_set(Set):-compound(Set),Set=vs(_). foc_var(Cond,vs([Var-Set|LazyVars]),TypeSet):-!, - (var(Set)->(Cond=Var,TypeSet=Set,TypeSet=ts([])); - (Var==Cond -> TypeSet = Set ; - (nonvar(LazyVars) -> foc_var(Cond,vs(LazyVars),TypeSet); - (TypeSet=ts([]),LazyVars=[Var-TypeSet|_])))). +(var(Set)->(Cond=Var,TypeSet=Set,TypeSet=ts([])); +(Var==Cond->TypeSet=Set; +(nonvar(LazyVars)->foc_var(Cond,vs(LazyVars),TypeSet); +(TypeSet=ts([]),LazyVars=[Var-TypeSet|_])))). foc_var(Cond,Set,TSet):-add_type(Set,[Cond-TSet]),ignore(TSet=ts(List)),ignore(List=[]). -add_type(Cond,Type,LazyVars):-is_var_set(LazyVars),!,must_det_ll((foc_var(Cond,LazyVars,TypeSet),!,add_type(TypeSet,Type))). -add_type(Cond,Type,_LazyVars):- add_type(Cond,Type),!. +add_type(Cond,Type,LazyVars):-is_var_set(LazyVars),!,must_det_lls((foc_var(Cond,LazyVars,TypeSet),!,add_type(TypeSet,Type))). +add_type(Cond,Type,_LazyVars):-add_type(Cond,Type),!. -add_type(Cond,Type):-attvar(Cond),get_attr(Cond,ti,TypeSet),!,must_det_ll(add_type(TypeSet,Type)). -add_type(Cond,Type):-var(Cond),!,must_det_ll(put_attr(Cond,ti,ts(Type))),!. -add_type(Cond,Type):-is_type_set(Cond),!,must_det_ll(b_put_set(Cond,Type)),!. -add_type(Cond,Type):-is_var_set(Cond),!,must_det_ll(b_put_set(Cond,Type)),!. -add_type(Cond,Type):- dmsg(unable_to_add_type(Cond,Type)). +add_type(Cond,Type):-attvar(Cond),get_attr(Cond,ti,TypeSet),!,must_det_lls(add_type(TypeSet,Type)). +add_type(Cond,Type):-var(Cond),!,must_det_lls(put_attr(Cond,ti,ts(Type))),!. +add_type(Cond,Type):-is_type_set(Cond),!,must_det_lls(b_put_set(Cond,Type)),!. +add_type(Cond,Type):-is_var_set(Cond),!,must_det_lls(b_put_set(Cond,Type)),!. +add_type(Cond,Type):-dmsg(unable_to_add_type(Cond,Type)). add_assignment(A,B,CodeOld,CodeNew) :- (fullvar(A),var(B) -> @@ -1112,14 +1143,12 @@ A=B,CodeNew=CodeOld ; append(CodeOld,[[assign,A,B]],CodeNew)). -compile_flow_control(_HeadIs,_LazyVars,_RetResult,_LazyEval,Convert,_):- \+ compound(Convert),!,fail. -compile_flow_control(_HeadIs,_LazyVars,_RetResult,_LazyEval,Convert,_):- compound_name_arity(Convert,_,0),!,fail. +compile_flow_control(_HeadIs,_LazyVars,_RetResult,_LazyEval,Convert,_):- \+compound(Convert),!,fail. +compile_flow_control(_HeadIs,_LazyVars,_RetResult,_LazyEval,Convert,_):-compound_name_arity(Convert,_,0),!,fail. -compile_flow_control(HeadIs,LazyVars,RetResult,LazyEval,Convert, Converted) :- % must_det_ll(is_var_set(LazyVars)), - Convert =~ ['if',Cond,Then,Else],!, +compile_flow_control(HeadIs,LazyVars,RetResult,LazyEval,Convert, Converted) :- + Convert = ['if',Cond,Then,Else],!, %Test = is_True(CondResult), - %add_type(CondResult,'Bool',LazyVars), - %add_type(Cond,'Bool',LazyVars), f2p(HeadIs,LazyVars,CondResult,eager,Cond,CondCode), append(CondCode,[[native(is_True),CondResult]],If), compile_test_then_else(RetResult,LazyVars,LazyEval,If,Then,Else,Converted). @@ -1141,7 +1170,7 @@ compile_flow_control(HeadIs,LazyVars,RetResult,LazyEval,Convert, Converted) :- %dif_functors(HeadIs,Convert), Convert =~ ['let*',Bindings,Body],!, - must_det_ll(( + must_det_lls(( maplist(compile_let_star(HeadIs,LazyVars),Bindings,CodeList), append(CodeList,Code), f2p(HeadIs,LazyVars,RetResult,LazyEval,Body,BodyCode), @@ -1151,788 +1180,369 @@ f2p(HeadIs,LazyVars,ResValue1,eager,Value1,CodeForValue1), add_assignment(Var,ResValue1,CodeForValue1,Code). -:- op(700,xfx, =~). -compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, (Code1,Eval1Result=Result,Converted)) :- % dif_functors(HeadIs,Convert), - Convert =~ chain(Eval1,Result,Eval2),!, - f2p(HeadIs, LazyVars, Eval1Result, ResultLazy, Eval1,Code1), - f2p(HeadIs, LazyVars, RetResult, ResultLazy, Eval2,Converted). - -compile_flow_control2(HeadIs, LazyVars, ResValue2, ResultLazy, Convert, (CodeForValue1,Converted)) :- % dif_functors(HeadIs,Convert), - Convert =~ ['eval-in-space',Value1,Value2], - f2p(HeadIs, LazyVars, ResValue1, ResultLazy, Value1,CodeForValue1), - f2p(HeadIs, LazyVars, ResValue2, ResultLazy, Value2,CodeForValue2), - Converted = with_space(ResValue1,CodeForValue2). - -/* -compile_flow_control2(_HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- % dif_functors(HeadIs,Convert), - Convert =~ ['bind!',Var,Value],is_ftVar(Value),!, - Converted = eval_args(['bind!',Var,Value],RetResult). -compile_flow_control2(_HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- % dif_functors(HeadIs,Convert), - Convert =~ ['bind!',Var,Value], Value =~ ['new-space'],!, - Converted = eval_args(['bind!',Var,Value],RetResult). +unnumbervars_clause(Cl,ClU):- + copy_term_nat(Cl,AC),unnumbervars(AC,UA),copy_term_nat(UA,ClU). +% =============================== +% Compile in memory buffer +% =============================== +is_clause_asserted(AC):- unnumbervars_clause(AC,UAC), + expand_to_hb(UAC,H,B), + H=..[Fh|Args], + length(Args,N), + N1 is N-1, + atomic_list_concat(['mc_',N1,'__',Fh],FPrefixed), + H2=..[FPrefixed|Args], + clause(H2,B,Ref),clause(HH,BB,Ref), + strip_m(HH,HHH),HHH=@=H2, + strip_m(BB,BBB),BBB=@=B,!. -compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- % dif_functors(HeadIs,Convert), - Convert =~ ['bind!',Var,Value], - f2p(HeadIs, LazyVars, ValueResult, ResultLazy, Value,ValueCode), - Converted = (ValueCode,eval_args(['bind!',Var,ValueResult],RetResult)). +%get_clause_pred(UAC,F,A):- expand_to_hb(UAC,H,_),strip_m(H,HH),functor(HH,F,A). -compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- % dif_functors(HeadIs,Convert), - once(Convert =~ if(Cond,Then,Else);Convert =~ 'if'(Cond,Then,Else)), - !,Test = is_True(CondResult), - f2p(HeadIs, LazyVars, CondResult, ResultLazy, Cond,CondCode), - compile_test_then_else(RetResult,LazyVars,ResultLazy,(CondCode,Test),Then,Else,Converted). -compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- % dif_functors(HeadIs,Convert), - Convert =~ 'if-error'(Value,Then,Else),!,Test = is_Error(ValueResult), - f2p(HeadIs, LazyVars, ValueResult, ResultLazy, Value,ValueCode), - compile_test_then_else(RetResult,LazyVars,ResultLazy,(ValueCode,Test),Then,Else,Converted). +% :- dynamic(needs_tabled/2). -compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- % dif_functors(HeadIs,Convert), - Convert =~ 'if-empty'(Value,Then,Else),!,Test = is_Empty(ValueResult), - f2p(HeadIs, LazyVars, ValueResult, ResultLazy, Value,ValueCode), - compile_test_then_else(RetResult,LazyVars,ResultLazy,(ValueCode,Test),Then,Else,Converted). +add_assertion(Space,List):- is_list(List),!, + maplist(add_assertion(Space),List). +add_assertion(Space,AC):- unnumbervars_clause(AC,UAC), add_assertion1(Space,UAC). +add_assertion1(_,AC):- /*'&self':*/is_clause_asserted(AC),!. +%add_assertion1(_,AC):- get_clause_pred(AC,F,A), \+ needs_tabled(F,A), !, pfcAdd(/*'&self':*/AC),!. -compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- % dif_functors(HeadIs,Convert), - (Convert =~ 'if-non-empty-expression'(Value,Then,Else)),!, - (Test = ( \+ is_Empty(ValueResult))), - f2p(HeadIs, LazyVars, ValueResult, ResultLazy, Value,ValueCode), - compile_test_then_else(RetResult,LazyVars,ResultLazy,(ValueCode,Test),Then,Else,Converted). +add_assertion1(Space,ACC) :- + must_det_lls(( + copy_term(ACC,AC,_), + expand_to_hb(AC,H,_), + as_functor_args(H,F,A), as_functor_args(HH,F,A), + with_mutex(transpiler_mutex_lock,( + % assert(AC), + % Get the current clauses of my_predicate/1 + findall(HH:-B,clause(/*'&self':*/HH,B),Prev), + copy_term(Prev,CPrev,_), + % Create a temporary file and add the new assertion along with existing clauses + append(CPrev,[AC],NewList), + cl_list_to_set(NewList,Set), + length(Set,N), + if_t(N=2, + (Set=[X,Y], + numbervars(X), + numbervars(Y) + %nl,display(X), + %nl,display(Y), + %nl + )), + %wdmsg(list_to_set(F/A,N)), + abolish(/*'&self':*/F/A), + create_and_consult_temp_file(Space,F/A, Set) + )) +)). -compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- % dif_functors(HeadIs,Convert), - Convert =~ ['if-equals',Value1,Value2,Then,Else],!,Test = equal_enough(ResValue1,ResValue2), - f2p(HeadIs, LazyVars, ResValue1, ResultLazy, Value1,CodeForValue1), - f2p(HeadIs, LazyVars, ResValue2, ResultLazy, Value2,CodeForValue2), - compile_test_then_else(RetResult,LazyVars,ResultLazy,(CodeForValue1,CodeForValue2,Test),Then,Else,Converted). -*/ -compile_flow_control1(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- - Convert =~ ['assertEqual',Value1,Value2],!, - cname_var('Src_',Src), - cname_var('FA_',ResValue1), - cname_var('FA_',ResValue2), - cname_var('FARL_',L1), - cname_var('FARL_',L2), - f2p(HeadIs, LazyVars, ResValue1, ResultLazy, Value1,CodeForValue1), - f2p(HeadIs, LazyVars, ResValue2, ResultLazy, Value2,CodeForValue2), - Converted = - (Src = Convert, - loonit_assert_source_tf(Src, - (findall(ResValue1,CodeForValue1,L1), - findall(ResValue2,CodeForValue2,L2)), - equal_enough(L1,L2),RetResult)). +as_functor_args(AsPred,F,A):- as_functor_args(AsPred,F,A,_ArgsL),!. +as_functor_args(AsPred,F,A,ArgsL):-var(AsPred),!, + (is_list(ArgsL);(integer(A),A>=0)),!, + length(ArgsL,A), + (symbol(F)-> + AsPred =..[F|ArgsL] + ; + (AsPred = [F|ArgsL])). -compile_flow_control1(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- - Convert =~ ['assertEqualToResult',Value1,Value2],!, - f2p(HeadIs, LazyVars, ResValue1, ResultLazy, Value1,CodeForValue1), - ast_to_prolog(HeadIs,CodeForValue1,Prolog), - - Converted = loonit_assert_source_tf(Convert, - findall(ResValue1,Prolog,L1), - equal_enough(L1,Value2),RetResult). +%as_functor_args(AsPred,_,_,_Args):- is_ftVar(AsPred),!,fail. +as_functor_args(AsPred,F,A,ArgsL):- \+ iz_conz(AsPred), + AsPred=..List,!, as_functor_args(List,F,A,ArgsL),!. +%as_functor_args([Eq,R,Stuff],F,A,ArgsL):- (Eq == '='), +% into_list_args(Stuff,List),append(List,[R],AsPred),!, +% as_functor_args(AsPred,F,A,ArgsL). +as_functor_args([F|ArgsL],F,A,ArgsL):- length(ArgsL,A),!. +cl_list_to_set([A|List],Set):- + member(B,List),same_clause(A,B),!, + cl_list_to_set(List,Set). +cl_list_to_set([New|List],[New|Set]):-!, + cl_list_to_set(List,Set). +cl_list_to_set([A,B],[A]):- same_clause(A,B),!. +cl_list_to_set(List,Set):- list_to_set(List,Set). -compile_flow_control2(_HeadIs, _LazyVars, RetResult, _ResultLazy, Convert, Converted) :- - Convert =~ 'add-atom'(Where,What), !, - =(What,WhatP), - Converted = as_tf('add-atom'(Where,WhatP),RetResult). +same_clause(A,B):- A==B,!. +same_clause(A,B):- A=@=B,!. +same_clause(A,B):- unnumbervars_clause(A,AA),unnumbervars_clause(B,BB),same_clause1(AA,BB). +same_clause1(A,B):- A=@=B. +same_clause1(A,B):- expand_to_hb(A,AH,AB),expand_to_hb(B,BH,BB),AB=@=BB, AH=@=BH,!. -compile_flow_control2(_HeadIs, _LazyVars, RetResult, _ResultLazy, Convert, Converted) :- - Convert =~ 'add-atom'(Where,What,RetResult), !, - =(What,WhatP), - Converted = as_tf('add-atom'(Where,WhatP),RetResult). +%clause('is-closed'(X),OO1,Ref),clause('is-closed'(X),OO2,Ref2),Ref2\==Ref, OO1=@=OO2. +% Convert a list of conditions into a conjunction +list_to_conjunction(C,[CJ]):- \+ is_list(C), !, C = CJ. +list_to_conjunction([], true). +list_to_conjunction([Cond], Cond). +list_to_conjunction([H|T], RestConj) :- H == true, !, list_to_conjunction(T, RestConj). +list_to_conjunction([H|T], (H, RestConj)) :- + list_to_conjunction(T, RestConj). -compile_flow_control2(_HeadIs, _LazyVars, RetResult, _ResultLazy, Convert, (Converted)) :- - Convert =~ ['superpose',ValueL],is_ftVar(ValueL), - %maybe_unlistify(UValueL,ValueL,URetResult,RetResult), - Converted = eval_args(['superpose',ValueL],RetResult), - cname_var('MeTTa_SP_',ValueL). +% Utility: Combine and flatten a single term into a conjunction +combine_code(Term, Conjunction) :- + flatten_term(Term, FlatList), + list_to_conjunction(FlatList, Conjunction). -compile_flow_control2(HeadIs, _LazyVars, RetResult, _ResultLazy, Convert, (Converted)) :- - Convert =~ ['superpose',ValueL],is_list(ValueL), - %maybe_unlistify(UValueL,ValueL,URetResult,RetResult), - cname_var('SP_Ret',RetResult), - maplist(f2p_assign(HeadIs,RetResult),ValueL,CodeForValueL), - list_to_disjuncts(CodeForValueL,Converted),!. +% combine_code/3: Combines Guard and Body into a flat conjunction +combine_code(Guard, Body, Combined) :- + combine_code(Guard, FlatGuard), % Flatten Guard + combine_code(Body, FlatBody), % Flatten Body + combine_flattened(FlatGuard, FlatBody, Combined). +% Combine two flattened terms intelligently +combine_flattened(true, Body, Body) :- !. +combine_flattened(Guard, true, Guard) :- !. +combine_flattened(Guard, Body, (Guard, Body)). -maybe_unlistify([UValueL],ValueL,RetResult,[URetResult]):- fail, is_list(UValueL),!, - maybe_unlistify(UValueL,ValueL,RetResult,URetResult). -maybe_unlistify(ValueL,ValueL,RetResult,RetResult). +% Flatten terms into a flat list +flatten_term(C, CJ):- C==[],!,CJ=C. +flatten_term(C, [CJ]):- \+ compound(C), !, C = CJ. +flatten_term((A, B), FlatList) :- !, % If Term is a conjunction, flatten both sides + flatten_term(A, FlatA), + flatten_term(B, FlatB), + append(FlatA, FlatB, FlatList). +flatten_term(List, FlatList) :- is_list(List), + !, % If Term is a list, recursively flatten its elements + maplist(flatten_term, List, NestedLists), + append(NestedLists, FlatList). +flatten_term([A | B ], FlatList) :- !, % If Term is a conjunction, flatten both sides + flatten_term(A, FlatA), + flatten_term(B, FlatB), + append(FlatA, FlatB, FlatList). +flatten_term(Term, [Term]). % Base case: single term, wrap it in a list -list_to_disjuncts([],false). -list_to_disjuncts([A],A):- !. -list_to_disjuncts([A|L],(A;D)):- list_to_disjuncts(L,D). +fn_eval(Fn,Args,Res):- is_list(Args),symbol(Fn),transpile_call_prefix(Fn,Pred),Pre=..[Pred|Args], + catch(call(Pre,Res),error(existence_error(procedure,_/_),_),Res=[Fn|Args]). -%f2p_assign(_HeadIs,V,Value,is_True(V)):- Value=='True'. -f2p_assign(_HeadIs,ValueR,Value,ValueR=Value):- \+ compound(Value),!. -f2p_assign(_HeadIs,ValueR,Value,ValueR=Value):- is_ftVar(Value),!. -f2p_assign(HeadIs,ValueResult,Value,Converted):- - f2p(HeadIs, _LazyVars, ValueResultR, _ResultLazy, Value,CodeForValue), - %into_equals(ValueResultR,ValueResult,ValueResultRValueResult), - ValueResultRValueResult = (ValueResultR=ValueResult), - combine_code(CodeForValue,ValueResultRValueResult,Converted). +fn_native(Fn,Args):- apply(Fn,Args). +%fn_eval(Fn,Args,[Fn|Args]). -compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert,Converted) :- - Convert =~ ['println!',Value],!, - Converted = (ValueCode,eval_args(['println!',ValueResult], RetResult)), - f2p(HeadIs, LazyVars, ValueResult, ResultLazy, Value,ValueCode). +assign(X,list(Y)):- is_list(Y),!,X=Y. +assign(X,X). +x_assign(X,X). -compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- - Convert =~ ['case',Value,PNil],[]==PNil,!,Converted = (ValueCode,RetResult=[]), - f2p(HeadIs, LazyVars, _ValueResult, ResultLazy, Value,ValueCode). -compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, (ValueCode, Converted)) :- - Convert =~ ['case',Value|Options], \+ is_ftVar(Value),!, - cname_var('CASE_EVAL_',ValueResult), - compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, ['case',ValueResult|Options], Converted), - f2p(HeadIs, LazyVars, ValueResult, ResultLazy, Value,ValueCode). -compile_flow_control2(HeadIs, _LazyVars, RetResult, _ResultLazy, Convert, Converted) :- - Convert =~ ['case',Value,Options],!, - must_det_ll(( - maplist(compile_case_bodies(HeadIs),Options,Cases), - Converted = - (( AllCases = Cases, - once((member(caseStruct(MatchVar,MatchCode,BodyResult,BodyCode),AllCases), - (MatchCode,unify_enough(Value,MatchVar)))), - (BodyCode), - BodyResult=RetResult)))). -compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- - Convert =~ ['case',Value,[Opt|Options]],nonvar(Opt),!, - must_det_ll(( - compile_case_bodies(HeadIs,Opt,caseStruct(Value,If,RetResult,Then)), - Converted = ( If -> Then ; Else ), - ConvertCases =~ ['case',Value,Options], - compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, ConvertCases,Else))). +end_of_file. -/* -compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- - Convert =~ ['case',Value,Options],!, - must_det_ll(( - maplist(compile_case_bodies(HeadIs),Options,Cases), - Converted = - (( AllCases = Cases, - once((member(caseStruct(MatchVar,MatchCode,BodyResult,BodyCode),AllCases), - (MatchCode,unify_enough(Value,MatchVar)))), - (BodyCode), - BodyResult=RetResult)))). -compile_flow_control2(HeadIs, LazyVars, _, ResultLazy, Convert, Converted) :- - Convert =~ ['case',Value,Options,RetResult],!, - must_det_ll(( - f2p(HeadIs, LazyVars, ValueResult, ResultLazy, Value,ValueCode), - maplist(compile_case_bodies(HeadIs),Options,Cases), - Converted = - (( AllCases = Cases, - call(ValueCode), - once((member(caseStruct(MatchVar,MatchCode,BodyResult,BodyCode),AllCases), - both_of(ValueResult,MatchCode,unify_enough(ValueResult,MatchVar)))), - call(BodyCode), - BodyResult=RetResult)))). -both_of(Var,G1,G2):- nonvar(Var),!,call(G2),call(G1). -both_of(_Var,G1,G2):- call(G1),call(G2). -*/ -compile_case_bodies(HeadIs,[Match,Body],caseStruct(_,true,BodyResult,BodyCode)):- Match == '%void%',!, - f2p(HeadIs, _LazyVars, BodyResult, _ResultLazy, Body,BodyCode). -compile_case_bodies(HeadIs,[Match,Body],caseStruct(MatchResult,If,BodyResult,BodyCode)):- !, - f2p(HeadIs, LazyVars, MatchResultV, ResultLazy, Match,MatchCode), - combine_code(MatchCode,unify_enough(MatchResult,MatchResultV),If), - f2p(HeadIs, LazyVars, BodyResult, ResultLazy, Body,BodyCode). -compile_case_bodies(HeadIs,MatchBody,CS):- compound(MatchBody), MatchBody =~ MB,compile_case_bodies(HeadIs,MB,CS). -compile_flow_control4(HeadIs, LazyVars, RetResult, ResultLazy, Convert,CodeForValueConverted) :- - % TODO: Plus seems an odd name for a variable - get an idea why? - Convert =~ [Plus,N,Value], atom(Plus), - transpile_call_prefix(Plus,PrefixPlus), - current_predicate(PrefixPlus/3), number(N), - \+ number(Value), \+ is_ftVar(Value),!, - f2p(HeadIs, LazyVars, ValueResult, ResultLazy, Value,CodeForValue),!, - Converted =.. [PrefixPlus,N,ValueResult,RetResult], - combine_code(CodeForValue,Converted,CodeForValueConverted). -compound_equals(COL1,COL2):- COL1=@=COL2,!,COL1=COL2. -compound_equals(COL1,COL2):- compound_equals1(COL1,COL2). -compound_equals1(COL1,COL2):- is_ftVar(COL1),!,is_ftVar(COL2),ignore(COL1=COL2),!. -compound_equals1(COL1,COL2):- compound(COL1),!,compound(COL2), COL1=COL2. -compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- - Convert =~ ['superpose',COL],compound_equals(COL,'collapse'(Value1)), - f2p(HeadIs, LazyVars, ResValue1, ResultLazy, Value1,CodeForValue1), - Converted = (findall(ResValue1,CodeForValue1,Gathered),member(RetResult,Gathered)). - -compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- - Convert =~ ['collapse',Value1],!, - f2p(HeadIs, LazyVars, ResValue1, ResultLazy, Value1,CodeForValue1), - Converted = (findall(ResValue1,CodeForValue1,RetResult)). - -compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- - Convert =~ ['compose',Value1],!, - Convert2 =~ ['collapse',Value1],!, - compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert2, Converted). - -compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- % dif_functors(HeadIs,Convert), - Convert =~ ['unify',Value1,Value2,Then,Else],!,Test = metta_unify(ResValue1,ResValue2), - f2p(HeadIs, LazyVars, ResValue1, ResultLazy, Value1,CodeForValue1), - f2p(HeadIs, LazyVars, ResValue2, ResultLazy, Value2,CodeForValue2), - compile_test_then_else(RetResult,LazyVars,ResultLazy,(CodeForValue1,CodeForValue2,Test),Then,Else,Converted). - - -/* -% match(Space,f(1)=Y,Y) -compile_flow_control2(HeadIs, LazyVars, Y, ResultLazy, Convert,Converted) :- dif_functors(HeadIs,Convert), - Convert=~ match(Space,AsFunctionY,YY), - nonvar(AsFunctionY),( AsFunctionY =~ (AsFunction=Y)), nonvar(AsFunction), - !, Y==YY, - f2p(HeadIs, LazyVars, Y, ResultLazy, AsFunction,Converted),!. -*/ -compile_flow_control2(HeadIs, LazyVars, Atom, ResultLazy, Convert,Converted) :- - Convert=~ match(Space,Q,T),Q==T,Atom=Q,!, - compile_flow_control2(HeadIs, LazyVars, Atom, ResultLazy, 'get-atoms'(Space),Converted). - -compile_flow_control2(_HeadIs, _LazyVars, Match, _ResultLazy, Convert,Converted) :- - Convert=~ 'get-atoms'(Space), - Converted = metta_atom_iter(Space,Match). - -compile_flow_control2(HeadIs, _LazyVars, AtomsVar, _ResultLazy, Convert,Converted) :- - Convert=~ 'get-atoms'(Space), AtomsVar = Pattern, - compile_pattern(HeadIs,Space,Pattern,Converted). - -compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert,Converted) :- dif_functors(HeadIs,Convert), - Convert =~ 'match'(Space,Pattern,Template),!, - f2p(HeadIs, LazyVars, RetResult, ResultLazy, Template,TemplateCode), - compile_pattern(HeadIs,Space,Pattern,SpacePatternCode), - combine_code(SpacePatternCode,TemplateCode,Converted). - -compile_pattern(_HeadIs,Space,Match,SpaceMatchCode):- - SpaceMatchCode = metta_atom_iter(Space,Match). - -metta_atom_iter(Space,Match):- - metta_atom_iter('=',10,Space,Space,Match). - - - -make_with_space(Space,MatchCode,MatchCode):- Space=='&self',!. -make_with_space(Space,MatchCode,with_space(Space,MatchCode)):- Space\=='&self'. - -compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- dif_functors(HeadIs,Convert), - Convert =~ 'match'(_Space,Match,Template),!, - must_det_ll(( - f2p(HeadIs, LazyVars, _, ResultLazy, Match,MatchCode), - into_equals(RetResult,Template,TemplateCode), - combine_code(MatchCode,TemplateCode,Converted))). - -compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- dif_functors(HeadIs,Convert), - Convert =~ ['if-decons',Atom,Head,Tail,Then,Else],!,Test = unify_cons(AtomResult,ResHead,ResTail), - f2p(HeadIs, LazyVars, AtomResult, ResultLazy, Atom,AtomCode), - f2p(HeadIs, LazyVars, ResHead, ResultLazy, Head,CodeForHead), - f2p(HeadIs, LazyVars, ResTail, ResultLazy, Tail,CodeForTail), - compile_test_then_else(RetResult,LazyVars,ResultLazy,(AtomCode,CodeForHead,CodeForTail,Test),Then,Else,Converted). - - - -compile_flow_control1(_HeadIs, _LazyVars, RetResult, _ResultLazy, Convert,is_True(RetResult)) :- is_compiled_and(AND), - Convert =~ [AND],!. - -compile_flow_control1(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- is_compiled_and(AND), - Convert =~ [AND,Body],!, - f2p(HeadIs, LazyVars, RetResult, ResultLazy, Body,BodyCode), - compile_test_then_else(RetResult,LazyVars,ResultLazy,BodyCode,'True','False',Converted). - -compile_flow_control1(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- is_compiled_and(AND), - Convert =~ [AND,Body1,Body2],!, - f2p(HeadIs, LazyVars, B1Res, ResultLazy, Body1,Body1Code), - f2p(HeadIs, LazyVars, RetResult, ResultLazy, Body2,Body2Code), - into_equals(B1Res,'True',AE), - Converted = (Body1Code,AE,Body2Code),!. - - -compile_flow_control1(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- is_compiled_and(AND), - Convert =~ [AND,Body1,Body2],!, - f2p(HeadIs, LazyVars, B1Res, ResultLazy, Body1,Body1Code), - f2p(HeadIs, LazyVars, _, ResultLazy, Body2,Body2Code), - into_equals(B1Res,'True',AE), - compile_test_then_else(RetResult,LazyVars,ResultLazy,(Body1Code,AE,Body2Code),'True','False',Converted). - -compile_flow_control1(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- is_compiled_and(AND), - Convert =~ [AND,Body1,Body2|BodyMore],!, - And2 =~ [AND,Body2|BodyMore], - Next =~ [AND,Body1,And2], - compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Next, Converted). - -compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, sequential(Convert), Converted) :- !, - compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, transpose(Convert), Converted). - -compile_flow_control2(HeadIs, _LazyVars, RetResult, _ResultLazy, transpose(Convert), Converted,Code) :- !, - maplist(each_result(HeadIs,RetResult),Convert, Converted), - list_to_disjuncts(Converted,Code). - - -compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- % dif_functors(HeadIs,Convert), - Convert =~ if(Cond,Then),!, - f2p(HeadIs, LazyVars, CondResult, ResultLazy, Cond,CondCode), - f2p(HeadIs, LazyVars, RetResult, ResultLazy, Then,ThenCode), - Converted = ((CondCode,is_True(CondResult)),ThenCode). - -each_result(HeadIs,RetResult,Convert,Converted):- - f2p(HeadIs, _LazyVars, OneResult, _ResultLazy, Convert,Code1), - into_equals(OneResult,RetResult,Code2), - combine_code(Code1,Code2,Converted). - -compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Converter, Converted):- de_eval(Converter,Convert),!, - compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted). - -compile_flow_control2(HeadIs, LazyVars, _Result, ResultLazy, Convert, Converted) :- fail, - functor(Convert,Func,PA), - functional_predicate_arg(Func,PA,Nth), - Convert =~ [Func|PredArgs], - nth1(Nth,PredArgs,Result,FuncArgs), - RetResult = Result, - AsFunct =~ [Func|FuncArgs], - compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, AsFunct, Converted). - -dif_functors(HeadIs,_):- var(HeadIs),!,fail. -dif_functors(HeadIs,_):- \+ compound(HeadIs),!. -dif_functors(HeadIs,Convert):- compound(HeadIs),compound(Convert), - compound_name_arity(HeadIs,F,A),compound_name_arity(Convert,F,A). - -is_compiled_and(AND):- member(AND,[ (','), ('and'), ('and-seq')]). - -flowc. - - -unnumbervars_clause(Cl,ClU):- - copy_term_nat(Cl,AC),unnumbervars(AC,UA),copy_term_nat(UA,ClU). -% =============================== -% Compile in memory buffer -% =============================== -is_clause_asserted(AC):- unnumbervars_clause(AC,UAC), - expand_to_hb(UAC,H,B), - H=..[Fh|Args], - length(Args,N), - N1 is N-1, - atomic_list_concat(['mc_',N1,'__',Fh],FPrefixed), - H2=..[FPrefixed|Args], - clause(H2,B,Ref),clause(HH,BB,Ref), - strip_m(HH,HHH),HHH=@=H2, - strip_m(BB,BBB),BBB=@=B,!. - -%get_clause_pred(UAC,F,A):- expand_to_hb(UAC,H,_),strip_m(H,HH),functor(HH,F,A). - - -% :- dynamic(needs_tabled/2). - -add_assertion(Space,List):- is_list(List),!, - maplist(add_assertion(Space),List). -add_assertion(Space,AC):- unnumbervars_clause(AC,UAC), add_assertion1(Space,UAC). -add_assertion1(_,AC):- /*'&self':*/is_clause_asserted(AC),!. -%add_assertion1(_,AC):- get_clause_pred(AC,F,A), \+ needs_tabled(F,A), !, pfcAdd(/*'&self':*/AC),!. - -add_assertion1(Space,ACC) :- - must_det_ll(( - copy_term(ACC,AC,_), - expand_to_hb(AC,H,_), - as_functor_args(H,F,A), as_functor_args(HH,F,A), - with_mutex(transpiler_mutex_lock,( - % assert(AC), - % Get the current clauses of my_predicate/1 - findall(HH:-B,clause(/*'&self':*/HH,B),Prev), - copy_term(Prev,CPrev,_), - % Create a temporary file and add the new assertion along with existing clauses - append(CPrev,[AC],NewList), - cl_list_to_set(NewList,Set), - length(Set,N), - if_t(N=2, - (Set=[X,Y], - numbervars(X), - numbervars(Y) - %nl,display(X), - %nl,display(Y), - %nl - )), - %wdmsg(list_to_set(F/A,N)), - abolish(/*'&self':*/F/A), - create_and_consult_temp_file(Space,F/A, Set) - )) -)). - -as_functor_args(AsPred,F,A):- as_functor_args(AsPred,F,A,_ArgsL),!. - -as_functor_args(AsPred,F,A,ArgsL):-var(AsPred),!, - (is_list(ArgsL);(integer(A),A>=0)),!, - length(ArgsL,A), - (symbol(F)-> - AsPred =..[F|ArgsL] - ; - (AsPred = [F|ArgsL])). - -%as_functor_args(AsPred,_,_,_Args):- is_ftVar(AsPred),!,fail. -as_functor_args(AsPred,F,A,ArgsL):- \+ iz_conz(AsPred), - AsPred=..List,!, as_functor_args(List,F,A,ArgsL),!. -%as_functor_args([Eq,R,Stuff],F,A,ArgsL):- (Eq == '='), -% into_list_args(Stuff,List),append(List,[R],AsPred),!, -% as_functor_args(AsPred,F,A,ArgsL). -as_functor_args([F|ArgsL],F,A,ArgsL):- length(ArgsL,A),!. - -cl_list_to_set([A|List],Set):- - member(B,List),same_clause(A,B),!, - cl_list_to_set(List,Set). -cl_list_to_set([New|List],[New|Set]):-!, - cl_list_to_set(List,Set). -cl_list_to_set([A,B],[A]):- same_clause(A,B),!. -cl_list_to_set(List,Set):- list_to_set(List,Set). - -same_clause(A,B):- A==B,!. -same_clause(A,B):- A=@=B,!. -same_clause(A,B):- unnumbervars_clause(A,AA),unnumbervars_clause(B,BB),same_clause1(AA,BB). -same_clause1(A,B):- A=@=B. -same_clause1(A,B):- expand_to_hb(A,AH,AB),expand_to_hb(B,BH,BB),AB=@=BB, AH=@=BH,!. - -%clause('is-closed'(X),OO1,Ref),clause('is-closed'(X),OO2,Ref2),Ref2\==Ref, OO1=@=OO2. - -% Convert a list of conditions into a conjunction -list_to_conjunction(C,[CJ]):- \+ is_list(C), !, C = CJ. -list_to_conjunction([], true). -list_to_conjunction([Cond], Cond). -list_to_conjunction([H|T], RestConj) :- H == true, !, list_to_conjunction(T, RestConj). -list_to_conjunction([H|T], (H, RestConj)) :- - list_to_conjunction(T, RestConj). - -% Utility: Combine and flatten a single term into a conjunction -combine_code(Term, Conjunction) :- - flatten_term(Term, FlatList), - list_to_conjunction(FlatList, Conjunction). - -% combine_code/3: Combines Guard and Body into a flat conjunction -combine_code(Guard, Body, Combined) :- - combine_code(Guard, FlatGuard), % Flatten Guard - combine_code(Body, FlatBody), % Flatten Body - combine_flattened(FlatGuard, FlatBody, Combined). - -% Combine two flattened terms intelligently -combine_flattened(true, Body, Body) :- !. -combine_flattened(Guard, true, Guard) :- !. -combine_flattened(Guard, Body, (Guard, Body)). - -% Flatten terms into a flat list -flatten_term(C, CJ):- C==[],!,CJ=C. -flatten_term(C, [CJ]):- \+ compound(C), !, C = CJ. -flatten_term((A, B), FlatList) :- !, % If Term is a conjunction, flatten both sides - flatten_term(A, FlatA), - flatten_term(B, FlatB), - append(FlatA, FlatB, FlatList). -flatten_term(List, FlatList) :- is_list(List), - !, % If Term is a list, recursively flatten its elements - maplist(flatten_term, List, NestedLists), - append(NestedLists, FlatList). -flatten_term([A | B ], FlatList) :- !, % If Term is a conjunction, flatten both sides - flatten_term(A, FlatA), - flatten_term(B, FlatB), - append(FlatA, FlatB, FlatList). -flatten_term(Term, [Term]). % Base case: single term, wrap it in a list - - -fn_eval(Fn,Args,Res):- is_list(Args),symbol(Fn),transpile_call_prefix(Fn,Pred),Pre=..[Pred|Args], - catch(call(Pre,Res),error(existence_error(procedure,_/_),_),Res=[Fn|Args]). - -fn_native(Fn,Args):- apply(Fn,Args). -%fn_eval(Fn,Args,[Fn|Args]). - -assign(X,list(Y)):- is_list(Y),!,X=Y. -assign(X,X). - -x_assign(X,X). - - - - - - - - - - - - - - - end_of_file. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - end_of_file. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - end_of_file. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - end_of_file. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - end_of_file. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - end_of_file. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - end_of_file. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - end_of_file. +compile_head_variablization(Head, NewHead, HeadCode) :- + must_det_lls(( + as_functor_args(Head,Functor,A,Args), + % Find non-singleton variables in Args + fix_non_singletons(Args, NewArgs, Conditions), + list_to_conjunction(Conditions,HeadCode), + as_functor_args(NewHead,Functor,A,NewArgs))). +fix_non_singletons(Args, NewArgs, [Code|Conditions]) :- + sub_term_loc(Var, Args, Loc1), is_ftVar(Var), + sub_term_loc_replaced(==(Var), _Var2, Args, Loc2, ReplVar2, NewArgsM), + Loc1 \=@= Loc2, + Code = same(ReplVar2,Var), +fix_non_singletons(NewArgsM, NewArgs, Conditions). +fix_non_singletons(Args, Args, []):-!. +sub_term_loc(A,A,self). +sub_term_loc(E,Args,e(N,nth1)+Loc):- is_list(Args),!, nth1(N,Args,ST),sub_term_loc(E,ST,Loc). +sub_term_loc(E,Args,e(N,arg)+Loc):- compound(Args),arg(N,Args,ST),sub_term_loc(E,ST,Loc). +sub_term_loc_replaced(P1,E,Args,LOC,Var,NewArgs):- is_list(Args), !, sub_term_loc_l(nth1,P1,E,Args,LOC,Var,NewArgs). +sub_term_loc_replaced(P1,E,FArgs,LOC,Var,NewFArgs):- compound(FArgs), \+ is_ftVar(FArgs),!, + compound_name_arguments(FArgs, Name, Args), + sub_term_loc_l(arg,P1,E,Args,LOC,Var,NewArgs), + compound_name_arguments(NewCompound, Name, NewArgs),NewFArgs=NewCompound. + sub_term_loc_replaced(P1,A,A,self,Var,Var):- call(P1,A). +sub_term_loc_l(Nth,P1,E,Args,e(N,Nth)+Loc,Var,NewArgs):- + reverse(Args,RevArgs), + append(Left,[ST|Right],RevArgs), + sub_term_loc_replaced(P1,E,ST,Loc,Var,ReplaceST), + append(Left,[ReplaceST|Right],RevNewArgs), + reverse(RevNewArgs,NewArgs), + length([_|Right], N). +/* +as_functor_args(AsPred,F,A,ArgsL):- nonvar(AsPred),!,into_list_args(AsPred,[F|ArgsL]), length(ArgsL,A). +as_functor_args(AsPred,F,A,ArgsL):- + nonvar(F),length(ArgsL,A),AsPred = [F|ArgsL]. +*/ +compile_for_assert(HeadIs, AsBodyFn, Converted) :- (AsBodyFn =@= HeadIs ; AsBodyFn == []), !,/*trace,*/ compile_head_for_assert(HeadIs,Converted). +% If Convert is of the form (AsFunction=AsBodyFn), we perform conversion to obtain the equivalent predicate. +compile_for_assert(Head, AsBodyFn, Converted) :- + once(compile_head_variablization(Head, HeadC, CodeForHeadArgs)), + \+(atomic(CodeForHeadArgs)), !, + compile_for_assert(HeadC, + (CodeForHeadArgs,AsBodyFn), Converted). +compile_for_assert(HeadIs, AsBodyFn, Converted) :- is_ftVar(AsBodyFn), /*trace,*/ + AsFunction = HeadIs,!, + must_det_lls(( + Converted = (HeadC :- BodyC), % Create a rule with Head as the converted AsFunction and NextBody as the converted AsBodyFn + %funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head), + f2p(HeadIs, LazyVars, HResult, ResultLazy, AsFunction,HHead), + (var(HResult) -> (Result = HResult, HHead = Head) ; + funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head)), + NextBody = x_assign(AsBodyFn,Result), + optimize_head_and_body(Head,NextBody,HeadC,BodyC), + nop(ignore(Result = '$VAR'('HeadRes'))))),!. +% PLACEHOLDER +% If Convert is of the form (AsFunction=AsBodyFn), we perform conversion to obtain the equivalent predicate. +compile_for_assert(HeadIs, AsBodyFn, Converted) :- + AsFunction = HeadIs, Converted = (HeadCC :- BodyCC), + funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head), + compile_head_args(Head,HeadC,CodeForHeadArgs), + f2p(HeadIs, LazyVars, Result, ResultLazy, AsBodyFn,NextBody), + combine_code(CodeForHeadArgs,NextBody,BodyC),!, + optimize_head_and_body(HeadC,BodyC,HeadCC,BodyCC),!. +% =============================== +% COMPILER / OPTIMIZER +% Scryer Compiler vs PySWIP ASM Compiler +% +% PySWIP is 222 times faster per join +% =============================== +% Conversion is possible between a function and a predicate of arity when the result is at the nth arg +:- dynamic decl_functional_predicate_arg/3. +% Converion is possible between a function and predicate is tricky +functional_predicate_arg_tricky(is, 2, 1). % E.g. eval_args(is(+(1,2)),Result) converts to is(Result,+(1,2)). +% Defining standard mappings for some common functions/predicates +decl_functional_predicate_arg(append, 3, 3). +decl_functional_predicate_arg(+, 3, 3). +decl_functional_predicate_arg(pi, 1, 1). +decl_functional_predicate_arg('Empty', 1, 1). +decl_functional_predicate_arg(call,4,4). +decl_functional_predicate_arg(eval_args, 2, 2). +decl_functional_predicate_arg(edge, 2, 2). +decl_functional_predicate_arg('==', 2, 2). +decl_functional_predicate_arg('is-same', 2, 2). +decl_functional_predicate_arg(assertTrue, 2, 2). +decl_functional_predicate_arg(case, 3, 3). +decl_functional_predicate_arg(assertFalse, 2, 2). +decl_functional_predicate_arg('car-atom', 2, 2). +decl_functional_predicate_arg(match,4,4). +decl_functional_predicate_arg('TupleConcat',3,3). +decl_functional_predicate_arg('new-space',1,1). +decl_functional_predicate_arg(superpose, 2, 2). +do_predicate_function_canonical(F,FF):- predicate_function_canonical(F,FF),!. +do_predicate_function_canonical(F,F). +predicate_function_canonical(is_Empty,'Empty'). +pi(PI):- PI is pi. +% Retrieve Head of the List +'car-atom'(List, Head):- eval_H(['car-atom', List], Head). +% Mapping any current predicate F/A to a function, if it's not tricky +functional_predicate_arg(F, A, L):- decl_functional_predicate_arg(F, A, L). +functional_predicate_arg(F, A, L):- (atom(F)->true;trace), predicate_arity(F,A), + \+ functional_predicate_arg_tricky(F,A,_), L=A, + \+ decl_functional_predicate_arg(F, A, _). +functional_predicate_arg(F, A, L):- functional_predicate_arg_tricky(F, A, L). +predicate_arity(F,A):- metta_atom('&self',[:,F,[->|Args]]), length(Args,A). +predicate_arity(F,A):- current_predicate(F/A). +% Certain constructs should not be converted to functions. +not_function(P):- atom(P),!,not_function(P,0). +not_function(P):- callable(P),!,functor(P,F,A),not_function(F,A). +not_function(F,A):- is_arity_0(F,FF),!,not_function(FF,A). +not_function(!,0). +not_function(print,1). +not_function((':-'),2). +not_function((','),2). +not_function((';'),2). +not_function(('='),2). +not_function(('or'),2). +not_function('a',0). +not_function('b',0). +not_function(F,A):- is_control_structure(F,A). +not_function(A,0):- atom(A),!. +not_function('True',0). +not_function(F,A):- predicate_arity(F,A),AA is A+1, \+ decl_functional_predicate_arg(F,AA,_). - end_of_file. +needs_call_fr(P):- is_function(P,_Nth),functor(P,F,A),AA is A+1, \+ current_predicate(F/AA). +is_control_structure(F,A):- atom(F), atom_concat('if-',_,F),A>2. +'=='(A, B, Res):- as_tf(equal_enough(A, B),Res). +'or'(G1,G2):- G1 *-> true ; G2. +'or'(G1,G2,Res):- as_tf((G1 ; G2),Res). +% Function without arguments can be converted directly. +is_arity_0(AsFunction,F):- compound(AsFunction), compound_name_arity(AsFunction,F,0). +% Determines whether a given term is a function and retrieves the position +% in the predicate where the function Result is stored/retrieved +is_function(AsFunction, _):- is_ftVar(AsFunction),!,fail. +is_function(AsFunction, _):- AsFunction=='$VAR',!, trace, fail. +is_function(AsFunction, Nth) :- is_arity_0(AsFunction,F), \+ not_function(F,0), !,Nth=1. +is_function(AsFunction, Nth) :- is_arity_0(AsFunction,_), !,Nth=1. +is_function(AsFunction, Nth) :- + callable(AsFunction), + functor(AsFunction, Functor, A), + \+ not_function(Functor, A), + AA is A + 1, + functional_predicate_arg_maybe(Functor, AA, Nth). +functional_predicate_arg_maybe(F, AA, Nth):- functional_predicate_arg(F, AA, Nth),!. +functional_predicate_arg_maybe(F, AA, _):- A is AA - 1,functional_predicate_arg(F,A,_),!,fail. +functional_predicate_arg_maybe(F, Nth, Nth):- asserta(decl_functional_predicate_arg(F, Nth, Nth)),!. +% If Convert is of the form (AsFunction=AsBodyFn), we perform conversion to obtain the equivalent predicate. +compile_head_for_assert(HeadIs, (Head:-Body)):- + compile_head_for_assert(HeadIs, NewHeadIs,Converted), + head_preconds_into_body(NewHeadIs,Converted,Head,Body). +head_as_is(Head):- + as_functor_args(Head,Functor,A,_),!, + head_as_is(Functor,A). +head_as_is(if,3). +compile_head_for_assert(Head, Head, true):- + head_as_is(Head),!. +compile_head_for_assert(Head, NewestHead, HeadCode):- + compile_head_variablization(Head, NewHead, VHeadCode), + compile_head_args(NewHead, NewestHead, AHeadCode), + combine_code(VHeadCode,AHeadCode,HeadCode). +% Construct the new head and the match body +compile_head_args(Head, NewHead, HeadCode) :- + must_det_lls(( + as_functor_args(Head,Functor,A,Args), + maplist(f2p_assign(Head),NewArgs,Args,CodeL), + as_functor_args(NewHead,Functor,A,NewArgs), + list_to_conjuncts(CodeL,HeadCode))),!. @@ -1940,395 +1550,592 @@ +:- op(700,xfx,'=~'). +compile_for_assert(HeadIs, AsBodyFn, Converted) :- (AsBodyFn =@= HeadIs ; AsBodyFn == []), !,/*trace,*/ compile_head_for_assert(HeadIs,Converted). +% If Convert is of the form (AsFunction=AsBodyFn), we perform conversion to obtain the equivalent predicate. +compile_for_assert(Head, AsBodyFn, Converted) :- + once(compile_head_variablization(Head, HeadC, CodeForHeadArgs)), + \+(atomic(CodeForHeadArgs)), !, + compile_for_assert(HeadC, + (CodeForHeadArgs,AsBodyFn), Converted). +compile_for_assert(HeadIs, AsBodyFn, Converted) :- fail,is_ftVar(AsBodyFn), /*trace,*/ + AsFunction = HeadIs,!, + must_det_lls(( + Converted = (HeadC :- BodyC), % Create a rule with Head as the converted AsFunction and NextBody as the converted AsBodyFn + %funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head), + f2p(HeadIs, LazyVars, HResult, ResultLazy, AsFunction,HHead), + (var(HResult) -> (Result = HResult, HHead = Head) ; + funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head)), + NextBody = x_assign(AsBodyFn,Result), + optimize_head_and_body(Head,NextBody,HeadC,BodyC), + nop(ignore(Result = '$VAR'('HeadRes'))))),!. +compile_for_assert(HeadIs, AsBodyFn, Converted) :- + format("~q ~q ~q\n",[HeadIs, AsBodyFn, Converted]), + AsFunction = HeadIs, + must_det_lls(( + Converted = (HeadC :- NextBodyC), % Create a rule with Head as the converted AsFunction and NextBody as the converted AsBodyFn + /*funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head),*/ + f2p(HeadIs, LazyVars, HResult, ResultLazy, AsFunction,HHead), + (var(HResult) -> (Result = HResult, HHead = Head) ; + funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head)), + %verbose_unify(Converted), + f2p(HeadIs, LazyVars, Result, ResultLazy, AsBodyFn,NextBody), + %RetResult = Converted, + %RetResult = _, + optimize_head_and_body(Head,NextBody,HeadC,NextBodyC), + %fbug([convert(Convert),head_preconds_into_body(HeadC:-NextBodyC)]), + %if_t(((Head:-NextBody)\=@=(HeadC:-NextBodyC)),fbug(was(Head:-NextBody))), + nop(ignore(Result = '$VAR'('HeadRes'))))),!. +% If Convert is of the form (AsFunction=AsBodyFn), we perform conversion to obtain the equivalent predicate. +compile_for_assert(HeadIs, AsBodyFn, Converted) :- + AsFunction = HeadIs, Converted = (HeadCC :- BodyCC), + funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head), + compile_head_args(Head,HeadC,CodeForHeadArgs), + f2p(HeadIs, LazyVars, Result, ResultLazy, AsBodyFn,NextBody), + combine_code(CodeForHeadArgs,NextBody,BodyC),!, + optimize_head_and_body(HeadC,BodyC,HeadCC,BodyCC),!. +/* +*/ +metta_predicate(eval_args(evaluable,eachvar)). +metta_predicate(eval_true(matchable)). +metta_predicate(with_space(space,matchable)). +metta_predicate(limit(number,matchable)). +metta_predicate(findall(template,matchable,listvar)). +metta_predicate(match(space,matchable,template,eachvar)). +head_preconds_into_body(Head,Body,Head,Body):- \+ compound(Head),!. +head_preconds_into_body((PreHead,True),Converted,Head,Body):- True==true,!, + head_preconds_into_body(PreHead,Converted,Head,Body). +head_preconds_into_body((True,PreHead),Converted,Head,Body):- True==true,!, + head_preconds_into_body(PreHead,Converted,Head,Body). +head_preconds_into_body(PreHead,(True,Converted),Head,Body):- True==true,!, + head_preconds_into_body(PreHead,Converted,Head,Body). +head_preconds_into_body(PreHead,(Converted,True),Head,Body):- True==true,!, + head_preconds_into_body(PreHead,Converted,Head,Body). +head_preconds_into_body((AsPredO,Pre),Converted,Head,Body):- + head_preconds_into_body(Pre,(AsPredO,Converted),Head,Body). +head_preconds_into_body(AHead,Body,Head,BodyNew):- + assertable_head(AHead,Head), + optimize_body(Head,Body,BodyNew). +assertable_head(u_assign(FList,R),Head):- FList =~ [F|List], + append(List,[R],NewArgs), atom(F),!, Head=..[F|NewArgs]. +assertable_head(Head,Head). - end_of_file. +ok_to_append('$VAR'):- !, fail. +ok_to_append(_). +p2s(P,S):- into_list_args(P,S). +non_compound(S):- \+ compound(S). +did_optimize_conj(Head,B1,B2,B12):- optimize_conj(Head,B1,B2,B12), B12\=@=(B1,B2),!. +optimize_conjuncts(Head,(B1,B2,B3),BN):- B3\==(_,_), + did_optimize_conj(Head,B2,B3,B23), + optimize_conjuncts(Head,B1,B23,BN), !. +optimize_conjuncts(Head,(B1,B2,B3),BN):- + did_optimize_conj(Head,B1,B2,B12), + optimize_conjuncts(Head,B12,B3,BN),!. +%optimize_conjuncts(Head,(B1,B2),BN1):- optimize_conj(Head,B1,B2,BN1). +optimize_conjuncts(Head,(B1,B2),BN1):- did_optimize_conj(Head,B1,B2,BN1),!. +optimize_conjuncts(Head,B1,B2,(BN1,BN2)):- + must_optimize_body(Head,B1,BN1), must_optimize_body(Head,B2,BN2). +optimize_conj(_, x_assign(Term, C), x_assign(True,CC), eval_true(Term)):- 'True'==True, CC==C. +optimize_conj(_, x_assign(Term, C), is_True(CC), eval_true(Term)):- CC==C, !. +optimize_conj(_, B1,BT,B1):- assumed_true(BT),!. +optimize_conj(_, BT,B1,B1):- assumed_true(BT),!. +%optimize_conj(Head, x_assign(Term, C), x_assign(True,CC), Term):- 'True'==True, +% optimize_conj(Head, x_assign(Term, C), is_True(CC), CTerm). +%optimize_conj(Head,B1,BT,BN1):- assumed_true(BT),!, optimize_body(Head,B1,BN1). +%optimize_conj(Head,BT,B1,BN1):- assumed_true(BT),!, optimize_body(Head,B1,BN1). +optimize_conj(Head,B1,B2,(BN1,BN2)):- + optimize_body(Head,B1,BN1), optimize_body(Head,B2,BN2). +assumed_true(B2):- var(B2),!,fail. +assumed_true(eval_true(B2)):-!,assumed_true(B2). +assumed_true(B2):- B2== true,!. +assumed_true(B2):- B2==x_assign('True', '$VAR'('_')),!. +assumed_true(X==Y):- assumed_true(X=Y). +assumed_true(X=Y):- var(X),var(Y), X=Y. +assumed_true(X=Y):- is_ftVar(X),is_ftVar(Y), X=Y. +filter_head_arg(H,F):- var(H),!,H=F. +filter_head_arge(H,F):- H = F. +code_callable(Term,_CTerm):- var(Term),!,fail. +code_callable(Term, CTerm):- current_predicate(_,Term),!,Term=CTerm. +%code_callable(Term, CTerm):- current_predicate(_,Term),!,Term=CTerm. +%compile_flow_control(_HeadIs, LazyVars, RetResult, ResultLazy, Convert, x_assign(Convert,RetResult)) :- is_ftVar(Convert), var(RetResult),!. +compile_flow_control(_HeadIs,_RetResult,Convert,_):- \+ compound(Convert),!,fail. +compile_flow_control(_HeadIs,_RetResult,Convert,_):- compound_name_arity(Convert,_,0),!,fail. +:- op(700,xfx, =~). +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, (Code1,Eval1Result=Result,Converted)) :- % dif_functors(HeadIs,Convert), + Convert =~ chain(Eval1,Result,Eval2),!, + f2p(HeadIs, LazyVars, Eval1Result, ResultLazy, Eval1,Code1), + f2p(HeadIs, LazyVars, RetResult, ResultLazy, Eval2,Converted). +compile_flow_control2(HeadIs, LazyVars, ResValue2, ResultLazy, Convert, (CodeForValue1,Converted)) :- % dif_functors(HeadIs,Convert), + Convert =~ ['eval-in-space',Value1,Value2], + f2p(HeadIs, LazyVars, ResValue1, ResultLazy, Value1,CodeForValue1), + f2p(HeadIs, LazyVars, ResValue2, ResultLazy, Value2,CodeForValue2), + Converted = with_space(ResValue1,CodeForValue2). +/* +compile_flow_control2(_HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- % dif_functors(HeadIs,Convert), + Convert =~ ['bind!',Var,Value],is_ftVar(Value),!, + Converted = eval_args(['bind!',Var,Value],RetResult). +compile_flow_control2(_HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- % dif_functors(HeadIs,Convert), + Convert =~ ['bind!',Var,Value], Value =~ ['new-space'],!, + Converted = eval_args(['bind!',Var,Value],RetResult). +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- % dif_functors(HeadIs,Convert), + Convert =~ ['bind!',Var,Value], + f2p(HeadIs, LazyVars, ValueResult, ResultLazy, Value,ValueCode), + Converted = (ValueCode,eval_args(['bind!',Var,ValueResult],RetResult)). +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- % dif_functors(HeadIs,Convert), + once(Convert =~ if(Cond,Then,Else);Convert =~ 'if'(Cond,Then,Else)), + !,Test = is_True(CondResult), + f2p(HeadIs, LazyVars, CondResult, ResultLazy, Cond,CondCode), + compile_test_then_else(RetResult,LazyVars,ResultLazy,(CondCode,Test),Then,Else,Converted). +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- % dif_functors(HeadIs,Convert), + Convert =~ 'if-error'(Value,Then,Else),!,Test = is_Error(ValueResult), + f2p(HeadIs, LazyVars, ValueResult, ResultLazy, Value,ValueCode), + compile_test_then_else(RetResult,LazyVars,ResultLazy,(ValueCode,Test),Then,Else,Converted). +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- % dif_functors(HeadIs,Convert), + Convert =~ 'if-empty'(Value,Then,Else),!,Test = is_Empty(ValueResult), + f2p(HeadIs, LazyVars, ValueResult, ResultLazy, Value,ValueCode), + compile_test_then_else(RetResult,LazyVars,ResultLazy,(ValueCode,Test),Then,Else,Converted). +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- % dif_functors(HeadIs,Convert), + (Convert =~ 'if-non-empty-expression'(Value,Then,Else)),!, + (Test = ( \+ is_Empty(ValueResult))), + f2p(HeadIs, LazyVars, ValueResult, ResultLazy, Value,ValueCode), + compile_test_then_else(RetResult,LazyVars,ResultLazy,(ValueCode,Test),Then,Else,Converted). +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- % dif_functors(HeadIs,Convert), + Convert =~ ['if-equals',Value1,Value2,Then,Else],!,Test = equal_enough(ResValue1,ResValue2), + f2p(HeadIs, LazyVars, ResValue1, ResultLazy, Value1,CodeForValue1), + f2p(HeadIs, LazyVars, ResValue2, ResultLazy, Value2,CodeForValue2), + compile_test_then_else(RetResult,LazyVars,ResultLazy,(CodeForValue1,CodeForValue2,Test),Then,Else,Converted). +*/ +compile_flow_control1(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- + Convert =~ ['assertEqual',Value1,Value2],!, + cname_var('Src_',Src), + cname_var('FA_',ResValue1), + cname_var('FA_',ResValue2), + cname_var('FARL_',L1), + cname_var('FARL_',L2), + f2p(HeadIs, LazyVars, ResValue1, ResultLazy, Value1,CodeForValue1), + f2p(HeadIs, LazyVars, ResValue2, ResultLazy, Value2,CodeForValue2), + Converted = + (Src = Convert, + loonit_assert_source_tf(Src, + (findall(ResValue1,CodeForValue1,L1), + findall(ResValue2,CodeForValue2,L2)), + equal_enough(L1,L2),RetResult)). +compile_flow_control1(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- + Convert =~ ['assertEqualToResult',Value1,Value2],!, + f2p(HeadIs, LazyVars, ResValue1, ResultLazy, Value1,CodeForValue1), + ast_to_prolog(HeadIs,CodeForValue1,Prolog), + Converted = loonit_assert_source_tf(Convert, + findall(ResValue1,Prolog,L1), + equal_enough(L1,Value2),RetResult). -compile_head_variablization(Head, NewHead, HeadCode) :- - must_det_ll(( - as_functor_args(Head,Functor,A,Args), - % Find non-singleton variables in Args - fix_non_singletons(Args, NewArgs, Conditions), - list_to_conjunction(Conditions,HeadCode), - as_functor_args(NewHead,Functor,A,NewArgs))). +compile_flow_control2(_HeadIs, _LazyVars, RetResult, _ResultLazy, Convert, Converted) :- + Convert =~ 'add-atom'(Where,What), !, + =(What,WhatP), + Converted = as_tf('add-atom'(Where,WhatP),RetResult). -fix_non_singletons(Args, NewArgs, [Code|Conditions]) :- - sub_term_loc(Var, Args, Loc1), is_ftVar(Var), - sub_term_loc_replaced(==(Var), _Var2, Args, Loc2, ReplVar2, NewArgsM), - Loc1 \=@= Loc2, - Code = same(ReplVar2,Var), -fix_non_singletons(NewArgsM, NewArgs, Conditions). -fix_non_singletons(Args, Args, []):-!. +compile_flow_control2(_HeadIs, _LazyVars, RetResult, _ResultLazy, Convert, Converted) :- + Convert =~ 'add-atom'(Where,What,RetResult), !, + =(What,WhatP), + Converted = as_tf('add-atom'(Where,WhatP),RetResult). -sub_term_loc(A,A,self). -sub_term_loc(E,Args,e(N,nth1)+Loc):- is_list(Args),!, nth1(N,Args,ST),sub_term_loc(E,ST,Loc). -sub_term_loc(E,Args,e(N,arg)+Loc):- compound(Args),arg(N,Args,ST),sub_term_loc(E,ST,Loc). +compile_flow_control2(_HeadIs, _LazyVars, RetResult, _ResultLazy, Convert, (Converted)) :- + Convert =~ ['superpose',ValueL],is_ftVar(ValueL), + %maybe_unlistify(UValueL,ValueL,URetResult,RetResult), + Converted = eval_args(['superpose',ValueL],RetResult), + cname_var('MeTTa_SP_',ValueL). -sub_term_loc_replaced(P1,E,Args,LOC,Var,NewArgs):- is_list(Args), !, sub_term_loc_l(nth1,P1,E,Args,LOC,Var,NewArgs). -sub_term_loc_replaced(P1,E,FArgs,LOC,Var,NewFArgs):- compound(FArgs), \+ is_ftVar(FArgs),!, - compound_name_arguments(FArgs, Name, Args), - sub_term_loc_l(arg,P1,E,Args,LOC,Var,NewArgs), - compound_name_arguments(NewCompound, Name, NewArgs),NewFArgs=NewCompound. - sub_term_loc_replaced(P1,A,A,self,Var,Var):- call(P1,A). +compile_flow_control2(HeadIs, _LazyVars, RetResult, _ResultLazy, Convert, (Converted)) :- + Convert =~ ['superpose',ValueL],is_list(ValueL), + %maybe_unlistify(UValueL,ValueL,URetResult,RetResult), + cname_var('SP_Ret',RetResult), + maplist(f2p_assign(HeadIs,RetResult),ValueL,CodeForValueL), + list_to_disjuncts(CodeForValueL,Converted),!. -sub_term_loc_l(Nth,P1,E,Args,e(N,Nth)+Loc,Var,NewArgs):- - reverse(Args,RevArgs), - append(Left,[ST|Right],RevArgs), - sub_term_loc_replaced(P1,E,ST,Loc,Var,ReplaceST), - append(Left,[ReplaceST|Right],RevNewArgs), - reverse(RevNewArgs,NewArgs), - length([_|Right], N). +maybe_unlistify([UValueL],ValueL,RetResult,[URetResult]):- fail, is_list(UValueL),!, + maybe_unlistify(UValueL,ValueL,RetResult,URetResult). +maybe_unlistify(ValueL,ValueL,RetResult,RetResult). +list_to_disjuncts([],false). +list_to_disjuncts([A],A):- !. +list_to_disjuncts([A|L],(A;D)):- list_to_disjuncts(L,D). -/* -as_functor_args(AsPred,F,A,ArgsL):- nonvar(AsPred),!,into_list_args(AsPred,[F|ArgsL]), length(ArgsL,A). -as_functor_args(AsPred,F,A,ArgsL):- - nonvar(F),length(ArgsL,A),AsPred = [F|ArgsL]. -*/ -compile_for_assert(HeadIs, AsBodyFn, Converted) :- (AsBodyFn =@= HeadIs ; AsBodyFn == []), !,/*trace,*/ compile_head_for_assert(HeadIs,Converted). +%f2p_assign(_HeadIs,V,Value,is_True(V)):- Value=='True'. +f2p_assign(_HeadIs,ValueR,Value,ValueR=Value):- \+ compound(Value),!. +f2p_assign(_HeadIs,ValueR,Value,ValueR=Value):- is_ftVar(Value),!. +f2p_assign(HeadIs,ValueResult,Value,Converted):- + f2p(HeadIs, _LazyVars, ValueResultR, _ResultLazy, Value,CodeForValue), + %into_equals(ValueResultR,ValueResult,ValueResultRValueResult), + ValueResultRValueResult = (ValueResultR=ValueResult), + combine_code(CodeForValue,ValueResultRValueResult,Converted). -% If Convert is of the form (AsFunction=AsBodyFn), we perform conversion to obtain the equivalent predicate. -compile_for_assert(Head, AsBodyFn, Converted) :- - once(compile_head_variablization(Head, HeadC, CodeForHeadArgs)), - \+(atomic(CodeForHeadArgs)), !, - compile_for_assert(HeadC, - (CodeForHeadArgs,AsBodyFn), Converted). +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert,Converted) :- + Convert =~ ['println!',Value],!, + Converted = (ValueCode,eval_args(['println!',ValueResult], RetResult)), + f2p(HeadIs, LazyVars, ValueResult, ResultLazy, Value,ValueCode). -compile_for_assert(HeadIs, AsBodyFn, Converted) :- is_ftVar(AsBodyFn), /*trace,*/ - AsFunction = HeadIs,!, - must_det_ll(( - Converted = (HeadC :- BodyC), % Create a rule with Head as the converted AsFunction and NextBody as the converted AsBodyFn - %funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head), - f2p(HeadIs, LazyVars, HResult, ResultLazy, AsFunction,HHead), - (var(HResult) -> (Result = HResult, HHead = Head) ; - funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head)), - NextBody = x_assign(AsBodyFn,Result), - optimize_head_and_body(Head,NextBody,HeadC,BodyC), - nop(ignore(Result = '$VAR'('HeadRes'))))),!. -% PLACEHOLDER +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- + Convert =~ ['case',Value,PNil],[]==PNil,!,Converted = (ValueCode,RetResult=[]), + f2p(HeadIs, LazyVars, _ValueResult, ResultLazy, Value,ValueCode). -% If Convert is of the form (AsFunction=AsBodyFn), we perform conversion to obtain the equivalent predicate. -compile_for_assert(HeadIs, AsBodyFn, Converted) :- - AsFunction = HeadIs, Converted = (HeadCC :- BodyCC), - funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head), - compile_head_args(Head,HeadC,CodeForHeadArgs), - f2p(HeadIs, LazyVars, Result, ResultLazy, AsBodyFn,NextBody), - combine_code(CodeForHeadArgs,NextBody,BodyC),!, - optimize_head_and_body(HeadC,BodyC,HeadCC,BodyCC),!. +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, (ValueCode, Converted)) :- + Convert =~ ['case',Value|Options], \+ is_ftVar(Value),!, + cname_var('CASE_EVAL_',ValueResult), + compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, ['case',ValueResult|Options], Converted), + f2p(HeadIs, LazyVars, ValueResult, ResultLazy, Value,ValueCode). +compile_flow_control2(HeadIs, _LazyVars, RetResult, _ResultLazy, Convert, Converted) :- + Convert =~ ['case',Value,Options],!, + must_det_lls(( + maplist(compile_case_bodies(HeadIs),Options,Cases), + Converted = + (( AllCases = Cases, + once((member(caseStruct(MatchVar,MatchCode,BodyResult,BodyCode),AllCases), + (MatchCode,unify_enough(Value,MatchVar)))), + (BodyCode), + BodyResult=RetResult)))). -% =============================== -% COMPILER / OPTIMIZER -% Scryer Compiler vs PySWIP ASM Compiler -% -% PySWIP is 222 times faster per join -% =============================== +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- + Convert =~ ['case',Value,[Opt|Options]],nonvar(Opt),!, + must_det_lls(( + compile_case_bodies(HeadIs,Opt,caseStruct(Value,If,RetResult,Then)), + Converted = ( If -> Then ; Else ), + ConvertCases =~ ['case',Value,Options], + compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, ConvertCases,Else))). -% Conversion is possible between a function and a predicate of arity when the result is at the nth arg -:- dynamic decl_functional_predicate_arg/3. +/* +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- + Convert =~ ['case',Value,Options],!, + must_det_lls(( + maplist(compile_case_bodies(HeadIs),Options,Cases), + Converted = + (( AllCases = Cases, + once((member(caseStruct(MatchVar,MatchCode,BodyResult,BodyCode),AllCases), + (MatchCode,unify_enough(Value,MatchVar)))), + (BodyCode), + BodyResult=RetResult)))). -% Converion is possible between a function and predicate is tricky -functional_predicate_arg_tricky(is, 2, 1). % E.g. eval_args(is(+(1,2)),Result) converts to is(Result,+(1,2)). -% Defining standard mappings for some common functions/predicates -decl_functional_predicate_arg(append, 3, 3). -decl_functional_predicate_arg(+, 3, 3). -decl_functional_predicate_arg(pi, 1, 1). -decl_functional_predicate_arg('Empty', 1, 1). -decl_functional_predicate_arg(call,4,4). -decl_functional_predicate_arg(eval_args, 2, 2). -decl_functional_predicate_arg(edge, 2, 2). -decl_functional_predicate_arg('==', 2, 2). -decl_functional_predicate_arg('is-same', 2, 2). -decl_functional_predicate_arg(assertTrue, 2, 2). -decl_functional_predicate_arg(case, 3, 3). -decl_functional_predicate_arg(assertFalse, 2, 2). -decl_functional_predicate_arg('car-atom', 2, 2). -decl_functional_predicate_arg(match,4,4). -decl_functional_predicate_arg('TupleConcat',3,3). -decl_functional_predicate_arg('new-space',1,1). +compile_flow_control2(HeadIs, LazyVars, _, ResultLazy, Convert, Converted) :- + Convert =~ ['case',Value,Options,RetResult],!, + must_det_lls(( + f2p(HeadIs, LazyVars, ValueResult, ResultLazy, Value,ValueCode), + maplist(compile_case_bodies(HeadIs),Options,Cases), + Converted = + (( AllCases = Cases, + call(ValueCode), + once((member(caseStruct(MatchVar,MatchCode,BodyResult,BodyCode),AllCases), + both_of(ValueResult,MatchCode,unify_enough(ValueResult,MatchVar)))), + call(BodyCode), + BodyResult=RetResult)))). -decl_functional_predicate_arg(superpose, 2, 2). -do_predicate_function_canonical(F,FF):- predicate_function_canonical(F,FF),!. -do_predicate_function_canonical(F,F). -predicate_function_canonical(is_Empty,'Empty'). +both_of(Var,G1,G2):- nonvar(Var),!,call(G2),call(G1). +both_of(_Var,G1,G2):- call(G1),call(G2). -pi(PI):- PI is pi. +*/ -% Retrieve Head of the List -'car-atom'(List, Head):- eval_H(['car-atom', List], Head). +compile_case_bodies(HeadIs,[Match,Body],caseStruct(_,true,BodyResult,BodyCode)):- Match == '%void%',!, + f2p(HeadIs, _LazyVars, BodyResult, _ResultLazy, Body,BodyCode). +compile_case_bodies(HeadIs,[Match,Body],caseStruct(MatchResult,If,BodyResult,BodyCode)):- !, + f2p(HeadIs, LazyVars, MatchResultV, ResultLazy, Match,MatchCode), + combine_code(MatchCode,unify_enough(MatchResult,MatchResultV),If), + f2p(HeadIs, LazyVars, BodyResult, ResultLazy, Body,BodyCode). +compile_case_bodies(HeadIs,MatchBody,CS):- compound(MatchBody), MatchBody =~ MB,compile_case_bodies(HeadIs,MB,CS). +compile_flow_control4(HeadIs, LazyVars, RetResult, ResultLazy, Convert,CodeForValueConverted) :- + % TODO: Plus seems an odd name for a variable - get an idea why? + Convert =~ [Plus,N,Value], atom(Plus), + transpile_call_prefix(Plus,PrefixPlus), + current_predicate(PrefixPlus/3), number(N), + \+ number(Value), \+ is_ftVar(Value),!, + f2p(HeadIs, LazyVars, ValueResult, ResultLazy, Value,CodeForValue),!, + Converted =.. [PrefixPlus,N,ValueResult,RetResult], + combine_code(CodeForValue,Converted,CodeForValueConverted). -% Mapping any current predicate F/A to a function, if it's not tricky -functional_predicate_arg(F, A, L):- decl_functional_predicate_arg(F, A, L). -functional_predicate_arg(F, A, L):- (atom(F)->true;trace), predicate_arity(F,A), - \+ functional_predicate_arg_tricky(F,A,_), L=A, - \+ decl_functional_predicate_arg(F, A, _). -functional_predicate_arg(F, A, L):- functional_predicate_arg_tricky(F, A, L). +compound_equals(COL1,COL2):- COL1=@=COL2,!,COL1=COL2. +compound_equals(COL1,COL2):- compound_equals1(COL1,COL2). +compound_equals1(COL1,COL2):- is_ftVar(COL1),!,is_ftVar(COL2),ignore(COL1=COL2),!. +compound_equals1(COL1,COL2):- compound(COL1),!,compound(COL2), COL1=COL2. -predicate_arity(F,A):- metta_atom('&self',[:,F,[->|Args]]), length(Args,A). -predicate_arity(F,A):- current_predicate(F/A). -% Certain constructs should not be converted to functions. -not_function(P):- atom(P),!,not_function(P,0). -not_function(P):- callable(P),!,functor(P,F,A),not_function(F,A). -not_function(F,A):- is_arity_0(F,FF),!,not_function(FF,A). -not_function(!,0). -not_function(print,1). -not_function((':-'),2). -not_function((','),2). -not_function((';'),2). -not_function(('='),2). -not_function(('or'),2). +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- + Convert =~ ['superpose',COL],compound_equals(COL,'collapse'(Value1)), + f2p(HeadIs, LazyVars, ResValue1, ResultLazy, Value1,CodeForValue1), + Converted = (findall(ResValue1,CodeForValue1,Gathered),member(RetResult,Gathered)). -not_function('a',0). -not_function('b',0). -not_function(F,A):- is_control_structure(F,A). -not_function(A,0):- atom(A),!. -not_function('True',0). -not_function(F,A):- predicate_arity(F,A),AA is A+1, \+ decl_functional_predicate_arg(F,AA,_). +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- + Convert =~ ['collapse',Value1],!, + f2p(HeadIs, LazyVars, ResValue1, ResultLazy, Value1,CodeForValue1), + Converted = (findall(ResValue1,CodeForValue1,RetResult)). -needs_call_fr(P):- is_function(P,_Nth),functor(P,F,A),AA is A+1, \+ current_predicate(F/AA). +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- + Convert =~ ['compose',Value1],!, + Convert2 =~ ['collapse',Value1],!, + compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert2, Converted). -is_control_structure(F,A):- atom(F), atom_concat('if-',_,F),A>2. +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- % dif_functors(HeadIs,Convert), + Convert =~ ['unify',Value1,Value2,Then,Else],!,Test = metta_unify(ResValue1,ResValue2), + f2p(HeadIs, LazyVars, ResValue1, ResultLazy, Value1,CodeForValue1), + f2p(HeadIs, LazyVars, ResValue2, ResultLazy, Value2,CodeForValue2), + compile_test_then_else(RetResult,LazyVars,ResultLazy,(CodeForValue1,CodeForValue2,Test),Then,Else,Converted). -'=='(A, B, Res):- as_tf(equal_enough(A, B),Res). -'or'(G1,G2):- G1 *-> true ; G2. -'or'(G1,G2,Res):- as_tf((G1 ; G2),Res). -% Function without arguments can be converted directly. -is_arity_0(AsFunction,F):- compound(AsFunction), compound_name_arity(AsFunction,F,0). +/* +% match(Space,f(1)=Y,Y) +compile_flow_control2(HeadIs, LazyVars, Y, ResultLazy, Convert,Converted) :- dif_functors(HeadIs,Convert), + Convert=~ match(Space,AsFunctionY,YY), + nonvar(AsFunctionY),( AsFunctionY =~ (AsFunction=Y)), nonvar(AsFunction), + !, Y==YY, + f2p(HeadIs, LazyVars, Y, ResultLazy, AsFunction,Converted),!. +*/ +compile_flow_control2(HeadIs, LazyVars, Atom, ResultLazy, Convert,Converted) :- + Convert=~ match(Space,Q,T),Q==T,Atom=Q,!, + compile_flow_control2(HeadIs, LazyVars, Atom, ResultLazy, 'get-atoms'(Space),Converted). -% Determines whether a given term is a function and retrieves the position -% in the predicate where the function Result is stored/retrieved -is_function(AsFunction, _):- is_ftVar(AsFunction),!,fail. -is_function(AsFunction, _):- AsFunction=='$VAR',!, trace, fail. -is_function(AsFunction, Nth) :- is_arity_0(AsFunction,F), \+ not_function(F,0), !,Nth=1. -is_function(AsFunction, Nth) :- is_arity_0(AsFunction,_), !,Nth=1. -is_function(AsFunction, Nth) :- - callable(AsFunction), - functor(AsFunction, Functor, A), - \+ not_function(Functor, A), - AA is A + 1, - functional_predicate_arg_maybe(Functor, AA, Nth). +compile_flow_control2(_HeadIs, _LazyVars, Match, _ResultLazy, Convert,Converted) :- + Convert=~ 'get-atoms'(Space), + Converted = metta_atom_iter(Space,Match). -functional_predicate_arg_maybe(F, AA, Nth):- functional_predicate_arg(F, AA, Nth),!. -functional_predicate_arg_maybe(F, AA, _):- A is AA - 1,functional_predicate_arg(F,A,_),!,fail. -functional_predicate_arg_maybe(F, Nth, Nth):- asserta(decl_functional_predicate_arg(F, Nth, Nth)),!. +compile_flow_control2(HeadIs, _LazyVars, AtomsVar, _ResultLazy, Convert,Converted) :- + Convert=~ 'get-atoms'(Space), AtomsVar = Pattern, + compile_pattern(HeadIs,Space,Pattern,Converted). -% If Convert is of the form (AsFunction=AsBodyFn), we perform conversion to obtain the equivalent predicate. -compile_head_for_assert(HeadIs, (Head:-Body)):- - compile_head_for_assert(HeadIs, NewHeadIs,Converted), - head_preconds_into_body(NewHeadIs,Converted,Head,Body). +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert,Converted) :- dif_functors(HeadIs,Convert), + Convert =~ 'match'(Space,Pattern,Template),!, + f2p(HeadIs, LazyVars, RetResult, ResultLazy, Template,TemplateCode), + compile_pattern(HeadIs,Space,Pattern,SpacePatternCode), + combine_code(SpacePatternCode,TemplateCode,Converted). -head_as_is(Head):- - as_functor_args(Head,Functor,A,_),!, - head_as_is(Functor,A). -head_as_is(if,3). +compile_pattern(_HeadIs,Space,Match,SpaceMatchCode):- + SpaceMatchCode = metta_atom_iter(Space,Match). -compile_head_for_assert(Head, Head, true):- - head_as_is(Head),!. +metta_atom_iter(Space,Match):- + metta_atom_iter('=',10,Space,Space,Match). -compile_head_for_assert(Head, NewestHead, HeadCode):- - compile_head_variablization(Head, NewHead, VHeadCode), - compile_head_args(NewHead, NewestHead, AHeadCode), - combine_code(VHeadCode,AHeadCode,HeadCode). -% Construct the new head and the match body -compile_head_args(Head, NewHead, HeadCode) :- - must_det_ll(( - as_functor_args(Head,Functor,A,Args), - maplist(f2p_assign(Head),NewArgs,Args,CodeL), - as_functor_args(NewHead,Functor,A,NewArgs), - list_to_conjuncts(CodeL,HeadCode))),!. +make_with_space(Space,MatchCode,MatchCode):- Space=='&self',!. +make_with_space(Space,MatchCode,with_space(Space,MatchCode)):- Space\=='&self'. +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- dif_functors(HeadIs,Convert), + Convert =~ 'match'(_Space,Match,Template),!, + must_det_lls(( + f2p(HeadIs, LazyVars, _, ResultLazy, Match,MatchCode), + into_equals(RetResult,Template,TemplateCode), + combine_code(MatchCode,TemplateCode,Converted))). +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- dif_functors(HeadIs,Convert), + Convert =~ ['if-decons',Atom,Head,Tail,Then,Else],!,Test = unify_cons(AtomResult,ResHead,ResTail), + f2p(HeadIs, LazyVars, AtomResult, ResultLazy, Atom,AtomCode), + f2p(HeadIs, LazyVars, ResHead, ResultLazy, Head,CodeForHead), + f2p(HeadIs, LazyVars, ResTail, ResultLazy, Tail,CodeForTail), + compile_test_then_else(RetResult,LazyVars,ResultLazy,(AtomCode,CodeForHead,CodeForTail,Test),Then,Else,Converted). +compile_flow_control1(_HeadIs, _LazyVars, RetResult, _ResultLazy, Convert,is_True(RetResult)) :- is_compiled_and(AND), + Convert =~ [AND],!. -:- op(700,xfx,'=~'). +compile_flow_control1(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- is_compiled_and(AND), + Convert =~ [AND,Body],!, + f2p(HeadIs, LazyVars, RetResult, ResultLazy, Body,BodyCode), + compile_test_then_else(RetResult,LazyVars,ResultLazy,BodyCode,'True','False',Converted). +compile_flow_control1(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- is_compiled_and(AND), + Convert =~ [AND,Body1,Body2],!, + f2p(HeadIs, LazyVars, B1Res, ResultLazy, Body1,Body1Code), + f2p(HeadIs, LazyVars, RetResult, ResultLazy, Body2,Body2Code), + into_equals(B1Res,'True',AE), + Converted = (Body1Code,AE,Body2Code),!. -compile_for_assert(HeadIs, AsBodyFn, Converted) :- (AsBodyFn =@= HeadIs ; AsBodyFn == []), !,/*trace,*/ compile_head_for_assert(HeadIs,Converted). +compile_flow_control1(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- is_compiled_and(AND), + Convert =~ [AND,Body1,Body2],!, + f2p(HeadIs, LazyVars, B1Res, ResultLazy, Body1,Body1Code), + f2p(HeadIs, LazyVars, _, ResultLazy, Body2,Body2Code), + into_equals(B1Res,'True',AE), + compile_test_then_else(RetResult,LazyVars,ResultLazy,(Body1Code,AE,Body2Code),'True','False',Converted). -% If Convert is of the form (AsFunction=AsBodyFn), we perform conversion to obtain the equivalent predicate. -compile_for_assert(Head, AsBodyFn, Converted) :- - once(compile_head_variablization(Head, HeadC, CodeForHeadArgs)), - \+(atomic(CodeForHeadArgs)), !, - compile_for_assert(HeadC, - (CodeForHeadArgs,AsBodyFn), Converted). +compile_flow_control1(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- is_compiled_and(AND), + Convert =~ [AND,Body1,Body2|BodyMore],!, + And2 =~ [AND,Body2|BodyMore], + Next =~ [AND,Body1,And2], + compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Next, Converted). -compile_for_assert(HeadIs, AsBodyFn, Converted) :- fail,is_ftVar(AsBodyFn), /*trace,*/ - AsFunction = HeadIs,!, - must_det_ll(( - Converted = (HeadC :- BodyC), % Create a rule with Head as the converted AsFunction and NextBody as the converted AsBodyFn - %funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head), - f2p(HeadIs, LazyVars, HResult, ResultLazy, AsFunction,HHead), - (var(HResult) -> (Result = HResult, HHead = Head) ; - funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head)), - NextBody = x_assign(AsBodyFn,Result), - optimize_head_and_body(Head,NextBody,HeadC,BodyC), - nop(ignore(Result = '$VAR'('HeadRes'))))),!. +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, sequential(Convert), Converted) :- !, + compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, transpose(Convert), Converted). -compile_for_assert(HeadIs, AsBodyFn, Converted) :- - format("~q ~q ~q\n",[HeadIs, AsBodyFn, Converted]), - AsFunction = HeadIs, - must_det_ll(( - Converted = (HeadC :- NextBodyC), % Create a rule with Head as the converted AsFunction and NextBody as the converted AsBodyFn - /*funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head),*/ - f2p(HeadIs, LazyVars, HResult, ResultLazy, AsFunction,HHead), - (var(HResult) -> (Result = HResult, HHead = Head) ; - funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head)), - %verbose_unify(Converted), - f2p(HeadIs, LazyVars, Result, ResultLazy, AsBodyFn,NextBody), - %RetResult = Converted, - %RetResult = _, - optimize_head_and_body(Head,NextBody,HeadC,NextBodyC), - %fbug([convert(Convert),head_preconds_into_body(HeadC:-NextBodyC)]), - %if_t(((Head:-NextBody)\=@=(HeadC:-NextBodyC)),fbug(was(Head:-NextBody))), - nop(ignore(Result = '$VAR'('HeadRes'))))),!. +compile_flow_control2(HeadIs, _LazyVars, RetResult, _ResultLazy, transpose(Convert), Converted,Code) :- !, + maplist(each_result(HeadIs,RetResult),Convert, Converted), + list_to_disjuncts(Converted,Code). -% If Convert is of the form (AsFunction=AsBodyFn), we perform conversion to obtain the equivalent predicate. -compile_for_assert(HeadIs, AsBodyFn, Converted) :- - AsFunction = HeadIs, Converted = (HeadCC :- BodyCC), - funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head), - compile_head_args(Head,HeadC,CodeForHeadArgs), - f2p(HeadIs, LazyVars, Result, ResultLazy, AsBodyFn,NextBody), - combine_code(CodeForHeadArgs,NextBody,BodyC),!, - optimize_head_and_body(HeadC,BodyC,HeadCC,BodyCC),!. +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- % dif_functors(HeadIs,Convert), + Convert =~ if(Cond,Then),!, + f2p(HeadIs, LazyVars, CondResult, ResultLazy, Cond,CondCode), + f2p(HeadIs, LazyVars, RetResult, ResultLazy, Then,ThenCode), + Converted = ((CondCode,is_True(CondResult)),ThenCode). -/* -*/ -metta_predicate(eval_args(evaluable,eachvar)). -metta_predicate(eval_true(matchable)). -metta_predicate(with_space(space,matchable)). -metta_predicate(limit(number,matchable)). -metta_predicate(findall(template,matchable,listvar)). -metta_predicate(match(space,matchable,template,eachvar)). +each_result(HeadIs,RetResult,Convert,Converted):- + f2p(HeadIs, _LazyVars, OneResult, _ResultLazy, Convert,Code1), + into_equals(OneResult,RetResult,Code2), + combine_code(Code1,Code2,Converted). -head_preconds_into_body(Head,Body,Head,Body):- \+ compound(Head),!. -head_preconds_into_body((PreHead,True),Converted,Head,Body):- True==true,!, - head_preconds_into_body(PreHead,Converted,Head,Body). -head_preconds_into_body((True,PreHead),Converted,Head,Body):- True==true,!, - head_preconds_into_body(PreHead,Converted,Head,Body). -head_preconds_into_body(PreHead,(True,Converted),Head,Body):- True==true,!, - head_preconds_into_body(PreHead,Converted,Head,Body). -head_preconds_into_body(PreHead,(Converted,True),Head,Body):- True==true,!, - head_preconds_into_body(PreHead,Converted,Head,Body). -head_preconds_into_body((AsPredO,Pre),Converted,Head,Body):- - head_preconds_into_body(Pre,(AsPredO,Converted),Head,Body). +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Converter, Converted):- de_eval(Converter,Convert),!, + compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted). -head_preconds_into_body(AHead,Body,Head,BodyNew):- - assertable_head(AHead,Head), - optimize_body(Head,Body,BodyNew). +compile_flow_control2(HeadIs, LazyVars, _Result, ResultLazy, Convert, Converted) :- fail, + functor(Convert,Func,PA), + functional_predicate_arg(Func,PA,Nth), + Convert =~ [Func|PredArgs], + nth1(Nth,PredArgs,Result,FuncArgs), + RetResult = Result, + AsFunct =~ [Func|FuncArgs], + compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, AsFunct, Converted). +dif_functors(HeadIs,_):- var(HeadIs),!,fail. +dif_functors(HeadIs,_):- \+ compound(HeadIs),!. +dif_functors(HeadIs,Convert):- compound(HeadIs),compound(Convert), + compound_name_arity(HeadIs,F,A),compound_name_arity(Convert,F,A). -assertable_head(u_assign(FList,R),Head):- FList =~ [F|List], - append(List,[R],NewArgs), atom(F),!, Head=..[F|NewArgs]. -assertable_head(Head,Head). +is_compiled_and(AND):- member(AND,[ (','), ('and'), ('and-seq')]). -ok_to_append('$VAR'):- !, fail. -ok_to_append(_). +flowc. -p2s(P,S):- into_list_args(P,S). +%transpile_prefix(''). +transpile_impl_prefix('mi__'). +:- dynamic(is_transpile_impl_prefix/2). +transpile_impl_prefix(F,Fn):- is_transpile_impl_prefix(F,Fn)*->true;(transpile_impl_prefix(Prefix),atom_concat(Prefix,F,Fn),asserta(is_transpile_impl_prefix(F,Fn))). -non_compound(S):- \+ compound(S). +transpile_call_prefix('mc__'). +:- dynamic(is_transpile_call_prefix/2). +transpile_call_prefix(F,Fn):- is_transpile_call_prefix(F,Fn)*->true;(transpile_call_prefix(Prefix),atom_concat(Prefix,F,Fn),asserta(is_transpile_call_prefix(F,Fn))). -did_optimize_conj(Head,B1,B2,B12):- optimize_conj(Head,B1,B2,B12), B12\=@=(B1,B2),!. +/* +ast_to_prolog(Caller,A,Result) :- + must_det_lls((ast_to_prolog_aux(Caller,A,Result))). -optimize_conjuncts(Head,(B1,B2,B3),BN):- B3\==(_,_), - did_optimize_conj(Head,B2,B3,B23), - optimize_conjuncts(Head,B1,B23,BN), !. -optimize_conjuncts(Head,(B1,B2,B3),BN):- - did_optimize_conj(Head,B1,B2,B12), - optimize_conjuncts(Head,B12,B3,BN),!. -%optimize_conjuncts(Head,(B1,B2),BN1):- optimize_conj(Head,B1,B2,BN1). -optimize_conjuncts(Head,(B1,B2),BN1):- did_optimize_conj(Head,B1,B2,BN1),!. -optimize_conjuncts(Head,B1,B2,(BN1,BN2)):- - must_optimize_body(Head,B1,BN1), must_optimize_body(Head,B2,BN2). -optimize_conj(_, x_assign(Term, C), x_assign(True,CC), eval_true(Term)):- 'True'==True, CC==C. -optimize_conj(_, x_assign(Term, C), is_True(CC), eval_true(Term)):- CC==C, !. -optimize_conj(_, B1,BT,B1):- assumed_true(BT),!. -optimize_conj(_, BT,B1,B1):- assumed_true(BT),!. -%optimize_conj(Head, x_assign(Term, C), x_assign(True,CC), Term):- 'True'==True, -% optimize_conj(Head, x_assign(Term, C), is_True(CC), CTerm). -%optimize_conj(Head,B1,BT,BN1):- assumed_true(BT),!, optimize_body(Head,B1,BN1). -%optimize_conj(Head,BT,B1,BN1):- assumed_true(BT),!, optimize_body(Head,B1,BN1). -optimize_conj(Head,B1,B2,(BN1,BN2)):- - optimize_body(Head,B1,BN1), optimize_body(Head,B2,BN2). +ast_to_prolog_aux(_Caller,A,A) :-fullvar(A),!. +%ast_to_prolog_aux(Caller,[],true). +ast_to_prolog_aux(_Caller,H,H):- \+ compound(H),!. +ast_to_prolog_aux(Caller,assign(A,X0),(A=X1)) :- !, ast_to_prolog_aux(Caller,X0,X1),!. +ast_to_prolog_aux(_Caller,'#\\'(A),A). -assumed_true(B2):- var(B2),!,fail. -assumed_true(eval_true(B2)):-!,assumed_true(B2). -assumed_true(B2):- B2== true,!. -assumed_true(B2):- B2==x_assign('True', '$VAR'('_')),!. -assumed_true(X==Y):- assumed_true(X=Y). -assumed_true(X=Y):- var(X),var(Y), X=Y. -assumed_true(X=Y):- is_ftVar(X),is_ftVar(Y), X=Y. +% Roy's API +ast_to_prolog_aux(Caller,[assign,[call(F)|Args0],A],R):- ast_to_prolog_aux(Caller,fn_eval(F,Args0,A),R). +ast_to_prolog_aux(Caller,[native(F)|Args0],R):- ast_to_prolog_aux(Caller,fn_native(F,Args0),R). +ast_to_prolog_aux(Caller,[is_p1,Src,Code0,R],is_p1(Src,Code1,R)) :- !,ast_to_prolog(Caller,Code0,Code1). -filter_head_arg(H,F):- var(H),!,H=F. -filter_head_arge(H,F):- H = F. +ast_to_prolog_aux(Caller, if_or_else(If,Else),R):- ast_to_prolog_aux(Caller, (If*->true;Else),R). +ast_to_prolog_aux(Caller, Smack,R):- + compound(Smack), + Smack=..[NSF, _,_AnyRet, Six66,_Self, FArgs,Ret], + (NSF = eval_args;NSF = eval_20), + \+ atom_concat(find,_,NSF), + \+ atom_concat(_,e,NSF), + Six66 == 666, + ast_to_prolog_aux(Caller,eval(FArgs,Ret),R). +ast_to_prolog_aux(Caller, eval([F|Args],Ret),R):- atom(F),is_list(Args), + ast_to_prolog_aux(Caller,fn_eval(F,Args,Ret),R), !. -code_callable(Term,_CTerm):- var(Term),!,fail. -code_callable(Term, CTerm):- current_predicate(_,Term),!,Term=CTerm. -%code_callable(Term, CTerm):- current_predicate(_,Term),!,Term=CTerm. +ast_to_prolog_aux(Caller,(A),B) :- is_list(A),!,maplist(ast_to_prolog_aux(Caller),A,B). +ast_to_prolog_aux(Caller,[A],O) :- !, ast_to_prolog_aux(Caller,A,O). +ast_to_prolog_aux(Caller,list(A),B) :- is_list(A),!,maplist(ast_to_prolog_aux(Caller),A,B). +ast_to_prolog_aux(Caller,[prolog_if,If,Then,Else],R) :- !, + ast_to_prolog(Caller,If,If2), + ast_to_prolog(Caller,Then,Then2), + ast_to_prolog(Caller,Else,Else2), + R=((If2) *-> (Then2);(Else2)). +ast_to_prolog_aux(Caller,(If*->Then;Else),R) :- !, + ast_to_prolog(Caller,If,If2), + ast_to_prolog(Caller,Then,Then2), + ast_to_prolog(Caller,Else,Else2), + R=((If2) *-> (Then2);(Else2)). +ast_to_prolog_aux(Caller,fn_native(F,Args0),A) :- !, + %maplist(ast_to_prolog_aux(Caller),Args0,Args1), + F=..[Fn|Pre], % allow compound natives + append(Pre,Args0,ArgsNow), + A=..[Fn|ArgsNow], + notice_callee(Caller,A). -compile_flow_control(_HeadIs, LazyVars, RetResult, ResultLazy, Convert, x_assign(Convert,RetResult)) :- is_ftVar(Convert), var(RetResult),!. +ast_to_prolog_aux(Caller,fn_eval(F,Args00,A),R) :- atom(F), (fullvar(A); \+ compound(A)),!, + maybe_lazy_list(Caller,F,1,Args00,Args0), + transpile_call_prefix(F,Fp), + append(Args0,[A],Args1), + notice_callee(Caller,fn_eval(F,Args00,A)), + R=..[Fp|Args1]. +ast_to_prolog_aux(Caller,fn_impl(F,Args00,A),R) :- atom(F), (fullvar(A); \+ compound(A)),!, + maybe_lazy_list(Caller,F,1,Args00,Args0), + transpile_impl_prefix(F,Fp), + append(Args0,[A],Args1), + notice_callee(Caller,fn_impl(F,Args00,A)), + R=..[Fp|Args1]. +ast_to_prolog_aux(Caller,(True,T),R) :- True == true, ast_to_prolog_aux(Caller,T,R). +ast_to_prolog_aux(Caller,(T,True),R) :- True == true, ast_to_prolog_aux(Caller,T,R). +ast_to_prolog_aux(Caller,(H;T),(HH;TT)) :- ast_to_prolog_aux(Caller,H,HH),ast_to_prolog_aux(Caller,T,TT). +ast_to_prolog_aux(Caller,(H,T),(HH,TT)) :- ast_to_prolog_aux(Caller,H,HH),ast_to_prolog_aux(Caller,T,TT). +%ast_to_prolog_aux(Caller,[H],HH) :- ast_to_prolog_aux(Caller,H,HH). +%ast_to_prolog_aux(Caller,[H|T],(HH,TT)) :- ast_to_prolog_aux(Caller,H,HH),ast_to_prolog_aux(Caller,T,TT). +ast_to_prolog_aux(Caller,do_metta_runtime(T,G),do_metta_runtime(T,GGG)) :- !, ast_to_prolog_aux(Caller,G,GG),combine_code(GG,GGG). +ast_to_prolog_aux(Caller,loonit_assert_source_tf(T,G),loonit_assert_source_tf(T,GG)) :- !, ast_to_prolog_aux(Caller,G,GG). +ast_to_prolog_aux(Caller,findall(T,G,L),findall(T,GG,L)) :- !, ast_to_prolog_aux(Caller,G,GG). +ast_to_prolog_aux(Caller,FArgs,NewFArgs):- compound(FArgs),!, + compound_name_arguments(FArgs, Name, Args), + maplist(ast_to_prolog_aux(Caller),Args,NewArgs), + compound_name_arguments(NewCompound, Name, NewArgs),NewFArgs=NewCompound. +ast_to_prolog_aux(_,A,A). :- discontiguous f2p/4. @@ -2358,7 +2165,7 @@ % If Convert is an "eval_args" function, we convert it to the equivalent "is" predicate. f2p(HeadIs, LazyVars, RetResult, ResultLazy, EvalConvert,Converted):- EvalConvert =~ eval_args(Convert), !, - must_det_ll((f2p(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted))). + must_det_lls((f2p(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted))). % placeholder @@ -2374,7 +2181,7 @@ Nth==1,Nth2==1, HeadIs\=@=Convert, Convert = F,!, - must_det_ll(( + must_det_lls(( do_predicate_function_canonical(FP,F), compound_name_list(Converted,FP,[RetResult]))). @@ -2382,24 +2189,24 @@ % If Convert is an "is" function, we convert it to the equivalent "is" predicate. f2p(HeadIs, LazyVars, RetResult, ResultLazy, is(Convert),(Converted,is(RetResult,Result))):- !, - must_det_ll((f2p(HeadIs, LazyVars, Result, ResultLazy, Convert, Converted))). + must_det_lls((f2p(HeadIs, LazyVars, Result, ResultLazy, Convert, Converted))). % If Convert is an "or" function, we convert it to the equivalent ";" (or) predicate. f2p(HeadIs, LazyVars, RetResult, ResultLazy, or(AsPredI,Convert), (AsPredO *-> true; Converted)) :- fail, !, - must_det_ll((f2p(HeadIs, LazyVars, RetResult, ResultLazy, AsPredI, AsPredO), + must_det_lls((f2p(HeadIs, LazyVars, RetResult, ResultLazy, AsPredI, AsPredO), f2p(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted))). f2p(HeadIs, LazyVars, RetResult, ResultLazy, (AsPredI; Convert), (AsPredO; Converted)) :- !, - must_det_ll((f2p(HeadIs, LazyVars, RetResult, ResultLazy, AsPredI, AsPredO), + must_det_lls((f2p(HeadIs, LazyVars, RetResult, ResultLazy, AsPredI, AsPredO), f2p(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted))). f2p(HeadIs, LazyVars, RetResult, ResultLazy, SOR,or(AsPredO, Converted)) :- SOR =~ or(AsPredI, Convert), - must_det_ll((f2p(HeadIs, LazyVars, RetResult, ResultLazy, AsPredI, AsPredO), + must_det_lls((f2p(HeadIs, LazyVars, RetResult, ResultLazy, AsPredI, AsPredO), f2p(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted))),!. % If Convert is a "," (and) function, we convert it to the equivalent "," (and) predicate. f2p(HeadIs, LazyVars, RetResult, ResultLazy, (AsPredI, Convert), (AsPredO, Converted)) :- !, - must_det_ll((f2p(HeadIs, LazyVars, _RtResult, ResultLazy, AsPredI, AsPredO), + must_det_lls((f2p(HeadIs, LazyVars, _RtResult, ResultLazy, AsPredI, AsPredO), f2p(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted))). % If Convert is a ":-" (if) function, we convert it to the equivalent ":-" (if) predicate. @@ -2416,7 +2223,7 @@ f2p(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- fail, is_list(Convert), once((sexpr_s2p(Convert,IS), \+ IS=@=Convert)), !, % Check if Convert is a list and not in predicate form - must_det_ll((f2p(HeadIs, LazyVars, RetResult, ResultLazy, IS, Converted))). % Proceed with the conversion of the predicate form of the list. + must_det_lls((f2p(HeadIs, LazyVars, RetResult, ResultLazy, IS, Converted))). % Proceed with the conversion of the predicate form of the list. f2p(HeadIs, LazyVars, RetResult, ResultLazy, ConvertL, Converted) :- fail, is_list(ConvertL), @@ -2485,6 +2292,22 @@ +de_eval(eval(X),X):- compound(X),!. + +call1(G):- call(G). +call2(G):- call(G). +call3(G):- call(G). +call4(G):- call(G). +call5(G):- call(G). + +trace_break:- trace,break. + +:- if(debugging(metta(compiler_bugs))). +:- set_prolog_flag(gc,false). +:- endif. + +call_fr(G,Result,FA):- current_predicate(FA),!,call(G,Result). +call_fr(G,Result,_):- Result=G. % This predicate is responsible for converting functions to their equivalent predicates. % It takes a function 'AsFunction' and determines the predicate 'AsPred' which will be @@ -2720,7 +2543,7 @@ transform_and_combine_bodies(HeadBodiesList, NewHead, NewCombinedBodies)), \+ \+ ( Print=[converting=HeadBodiesList,newHead=NewHead], - numbervars(Print,0,_,[]),fbug(Print), + numbervars(Print,0,_,[attvar(skip)]),fbug(Print), nop(in_cmt(print_pl_source(( NewHead :- NewCombinedBodies))))),!. % Predicate to find the least general unified head (LGU) among the given list of heads. @@ -2799,7 +2622,10 @@ NewAcc = (Acc;TransformedBody), combine_bodies(T, NewHead, NewAcc, CombinedBodies). - +% combine_code/3 combines Guard and Body to produce either Guard, Body, or a conjunction of both, depending on the values of Guard and Body. +combine_code(Guard, Body, Guard) :- Body==true, !. +combine_code(Guard, Body, Body) :- Guard==true, !. +combine_code(Guard, Body, (Guard, Body)). % create_unifier/3 creates a unification code that unifies OneHead with NewHead. % If OneHead and NewHead are structurally equal, then they are unified and the unification Guard is 'true'. @@ -2835,9 +2661,3 @@ - - - - - - diff --git a/prolog/metta_lang/metta_compiler_lib.pl b/prolog/metta_lang/metta_compiler_lib.pl index ff7e6061c87..28dac039759 100644 --- a/prolog/metta_lang/metta_compiler_lib.pl +++ b/prolog/metta_lang/metta_compiler_lib.pl @@ -1,9 +1,6 @@ :- dynamic(transpiler_clause_store/9). :- discontiguous transpiler_clause_store/9. -:- discontiguous get_type_sig/3. - - from_prolog_args(_,X,X). :-dynamic(pred_uses_fallback/2). :-dynamic(pred_uses_impl/2). @@ -23,15 +20,15 @@ maybe_eval(Self,Types,Args,NewArgs). -'mc__:'(Obj, Type, [':',Obj, Type]):- current_self(Self), sync_type(10, Self, Obj, Type). %freeze(Obj, get_type(Obj,Type)),!. +'mc_2__:'(Obj, Type, [':',Obj, Type]):- current_self(Self), sync_type(10, Self, Obj, Type). %freeze(Obj, get_type(Obj,Type)),!. sync_type(D, Self, Obj, Type):- nonvar(Obj), nonvar(Type), !, arg_conform(D, Self, Obj, Type). sync_type(D, Self, Obj, Type):- nonvar(Obj), var(Type), !, get_type(D, Self, Obj, Type). sync_type(D, Self, Obj, Type):- nonvar(Type), var(Obj), !, set_type(D, Self, Obj, Type). %, freeze(Obj, arg_conform(D, Self, Obj, Type)). sync_type(D, Self, Obj, Type):- freeze(Type,sync_type(D, Self, Obj, Type)), freeze(Obj, sync_type(D, Self, Obj, Type)),!. -%'mc__get-type'(Obj,Type):- attvar(Obj),current_self(Self),!,trace,get_attrs(Obj,Atts),get_type(10, Self, Obj,Type). -'mc__get-type'(Obj,Type):- current_self(Self), !, get_type(10, Self, Obj,Type). +%'mc_1__get-type'(Obj,Type):- attvar(Obj),current_self(Self),!,trace,get_attrs(Obj,Atts),get_type(10, Self, Obj,Type). +'mc_1__get-type'(Obj,Type):- current_self(Self), !, get_type(10, Self, Obj,Type). %%%%%%%%%%%%%%%%%%%%% arithmetic diff --git a/prolog/metta_lang/metta_printer.pl b/prolog/metta_lang/metta_printer.pl index 466b3702aef..f2774ef1e14 100755 --- a/prolog/metta_lang/metta_printer.pl +++ b/prolog/metta_lang/metta_printer.pl @@ -274,12 +274,18 @@ % % @arg P The Prolog term to be printed. % -print_pl_source0(_) :- +print_pl_source0(_) :- fail, % Do not print if compatibility mode is enabled. pnotrace(is_compatio), !. print_pl_source0(_) :- % Do not print if silent loading mode is enabled. pnotrace(silent_loading), !. + +print_pl_source0(P) :-!, + format('~N'), + print_tree(P), + format('~N'), !. + print_pl_source0(P) :- % Check if P was just printed (avoid redundant printing). pnotrace((just_printed(PP), PP =@= P)), !. From 2fba6d5b8ad65a288f7dc5aa042a59cd62b7aa32 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Mon, 23 Dec 2024 19:51:51 -0800 Subject: [PATCH 41/42] support --exec=interp --- prolog/metta_lang/metta_interp.pl | 3 ++- prolog/metta_lang/metta_printer.pl | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/prolog/metta_lang/metta_interp.pl b/prolog/metta_lang/metta_interp.pl index b8ec7f3778a..05c91fbf70f 100755 --- a/prolog/metta_lang/metta_interp.pl +++ b/prolog/metta_lang/metta_interp.pl @@ -403,7 +403,7 @@ all_option_value_name_default_type_help('repl', auto, [false, true, auto], "Enter REPL mode (auto means true unless a file argument was supplied)", 'Execution and Control'). all_option_value_name_default_type_help('prolog', false, [false, true], "Enable or disable Prolog REPL mode", 'Compatibility and Modes'). option_value_name_default_type_help('devel', false, [false, true], "Developer mode", 'Compatibility and Modes'). -all_option_value_name_default_type_help('exec', noskip, [noskip, skip], "Controls execution during script loading: noskip or skip (don't-skip-include/binds) vs skip-all", 'Execution and Control'). +all_option_value_name_default_type_help('exec', noskip, [noskip, skip, interp], "Controls execution during script loading: noskip or skip (don't-skip-include/binds) vs skip-all", 'Execution and Control'). % Resource Limits option_value_name_default_type_help('stack-max', 500, [inf,1000,10_000], "Maximum stack depth allowed during execution", 'Resource Limits'). @@ -1664,6 +1664,7 @@ %ignore(discover_head(Self,Load,PredDecl)), color_g_mesg_ok('#ffa505',metta_anew(Load,Src,metta_atom(Self,PredDecl))). +never_compile(_):- option_value('exec',interp),!. never_compile(X):- always_exec(X). always_exec(W):- var(W),!,fail. diff --git a/prolog/metta_lang/metta_printer.pl b/prolog/metta_lang/metta_printer.pl index f2774ef1e14..154ee6a7c6e 100755 --- a/prolog/metta_lang/metta_printer.pl +++ b/prolog/metta_lang/metta_printer.pl @@ -281,7 +281,7 @@ % Do not print if silent loading mode is enabled. pnotrace(silent_loading), !. -print_pl_source0(P) :-!, +print_pl_source0(P) :- fail,!, format('~N'), print_tree(P), format('~N'), !. From 8feced6db7865f1cbe24cf0db2bd3bec1e0f8197 Mon Sep 17 00:00:00 2001 From: logicmoo Date: Mon, 23 Dec 2024 19:56:14 -0800 Subject: [PATCH 42/42] function/return --- prolog/metta_lang/metta_compiler.pl | 415 ++++++++++++++++++---------- 1 file changed, 269 insertions(+), 146 deletions(-) diff --git a/prolog/metta_lang/metta_compiler.pl b/prolog/metta_lang/metta_compiler.pl index fcd9995b5a0..63a8a3a2ae4 100755 --- a/prolog/metta_lang/metta_compiler.pl +++ b/prolog/metta_lang/metta_compiler.pl @@ -119,7 +119,6 @@ :- dynamic(transpiler_stored_eval/3). transpiler_stored_eval([],true,0). -as_p1(is_p1(_,Code,Ret),Ret):- !, call(Code). as_p1(is_p1(Code,Ret),Ret):- !, call(Code). % Meta-predicate that ensures that for every instance where G1 holds, G2 also holds. @@ -161,8 +160,151 @@ strip_m(M:BB,BB):- nonvar(BB),nonvar(M),!. strip_m(BB,BB). -cname_var(Sym,Src):- gensym(Sym,SrcV), ignore(Src='$VAR'(SrcV)), - debug_var(SrcV,Src). + +compiler_assertz(Info):- assertz(Info),output_prolog(Info). + +output_prolog(Converted):- output_prolog(cyan,Converted). +output_prolog(Color,Converted):- + inotrace((printable_vars(Converted,ConvertedC), + color_g_mesg(Color, output_language(prolog, output_prolog0(ConvertedC))))). + +output_prolog0(Converted):- is_list(Converted), maplist(output_prolog0,Converted). +output_prolog0(Converted --> B):- print_pl_source(Converted --> B). +output_prolog0(:-B):- !, print_pl_source(:-B). +output_prolog0(Converted:-B):- !, nl, print_pl_source(Converted:-B). +output_prolog0(Converted):- print_pl_source(Converted:-true). + +inotrace(G):- + ignore( \+ notrace(G)). + +print_ast(Color,HB):- + inotrace((printable_vars(HB,HBP), + color_g_mesg(Color, + output_language( ast, (writeln('Ast:======='), print_tree_nl(HBP)))))). + +printable_vars(HB,HBPN):- + copy_term(HB,HBP), + set_vnames(HBP), + copy_term_nat(HBP,HBPN), + numbervars(HBPN,0,_,[]),!. + +set_vnames(HBP):- + term_variables(HBP,Vars), + maplist(only_names,Vars). + + +only_names(Var):- % del_attr(Var,cns), + ignore((get_attr(Var,vn,VN),Var = '$VAR'(VN))),!. +only_names(Var):- ignore(catch(del_attr(Var,cns),_,fail)), + ignore((get_attr(Var,vn,VN),nop(ignore(Var = '$VAR'(VN))))). + + + +subst_varnames(Convert,Converted):- + subst_vars(Convert,Converted,[], NVL), + memorize_varnames(NVL). + + +cns:attr_unify_hook(_V,_T):- true. + +%must_det_lls(G):- catch(G,E,(wdmsg(E),fail)),!. +%must_det_lls(G):- rtrace(G),!. +must_det_lls(G):- catch(G,E,(wdmsg(E),fail)),!. +must_det_lls(G):- notrace,nortrace,trace,call(G),!. + +extract_constraints(V,VS):- var(V),get_attr(V,vn,Name),get_attr(V,cns,Set),!,extract_constraints(Name,Set,VS),!. +extract_constraints(V,VS):- var(V),!,ignore(get_types_of(V,Types)),extract_constraints(V,Types,VS),!. +extract_constraints(Converted,VSS):- term_variables(Converted,Vars), + % assign_vns(0,Vars,_), + maplist(extract_constraints,Vars,VSS). +extract_constraints(V,[],V=[]):-!. +extract_constraints(V,Types,V=Types). + + +label_vns(S,G,E):- term_variables(G,Vars),assign_vns(S,Vars,E),!. +assign_vns(S,[],S):-!. +assign_vns(N,[V|Vars],O):- get_attr(V,vn,_),!, assign_vns(N,Vars,O). +assign_vns(N,[V|Vars],O):- format(atom(VN),'~w',['$VAR'(N)]), + put_attr(V,vn,VN), N2 is N+1, assign_vns(N2,Vars,O). + +label_arg_types(_,_,[]):-!. +label_arg_types(F,N,[A|Args]):- + label_arg_n_type(F,N,A),N2 is N+1, + label_arg_types(F,N2,Args). + +% label_arg_n_type(F,0,A):- !, label_type_assignment(A,F). +label_arg_n_type(F,N,A):- compound(F),functor(F,Fn,Add),Is is Add+N, !, label_arg_n_type(Fn,Is,A). +label_arg_n_type(F,N,A):- add_type_to(A,arg(F,N)),!. + +add_type_to(V,T):- is_list(T), !, maplist(add_type_to(V),T). +add_type_to(V,T):- T =@= val(V),!. +add_type_to(V,T):- ground(T),arg_type_hints(T,H),!,add_1type_to(V,H). +add_type_to(V,T):- add_1type_to(V,T),!. + +add_1type_to(V,T):- is_list(T), !, maplist(add_1type_to(V),T). +add_1type_to(V,T):- + must_det_lls(( + get_types_of(V,TV), + append([T],TV,TTV), + set_types_of(V,TTV))). + +label_type_assignment(V,O):- + must_det_lls(( + get_types_of(V,TV), get_types_of(O,TO), + add_type_to(V,val(O)), + %add_type_to(O,val(V)), + add_type_to(V,TO), + add_type_to(O,TV), + !)). + +is_functor_val(val(_)). + +%(: if (-> False $_ $else $else)) +%(: if (-> False $T $T $T)) + +arg_type_hints(arg(is_True,1),'Bool'). +arg_type_hints(arg(==,0),'Bool'). +arg_type_hints(arg(match,0),['Empty','%Undefined%']). +arg_type_hints(arg(empty,0),'Empty'). +arg_type_hints(val('Empty'),'Empty'). +arg_type_hints(val('True'),'Bool'). +arg_type_hints(val('False'),'Bool'). +arg_type_hints(val(Val),[val(Val)|Types]):- findall(Type,get_val_type(Val,Type),List),merge_types(List,Types),Types\==[]. +arg_type_hints(arg('println!',0),'UnitAtom'). +arg_type_hints(arg(F,Arg),[arg(F,Arg)|Types]):- + findall(Type,get_farg_type(F,Arg,Type),List),merge_types(List,Types),Types\==[]. + +get_farg_type(F,Arg,Type):- get_type(F,Res),(Res=[Ar|List],Ar=='->'), (Arg==0->last(List,TypeM);nth1(Arg,List,TypeM)),(nonvar(TypeM)->TypeM=Type;Type='%Var'). +get_val_type(F,Type):- get_type(F,TypeM),(nonvar(TypeM)->TypeM=Type;Type='%Var'). + +merge_types(List,Types):- list_to_set(List,Types),!. + +get_just_types_of(V,Types):- get_types_of(V,VTypes),exclude(is_functor_val,VTypes,Types). + +get_types_of(V,Types):- attvar(V),get_attr(V,cns,Types),!. +get_types_of(V,Types):- compound(V),V=arg(_,_),!,Types=[V]. +get_types_of(V,Types):- findall(Type,get_type_for_args(V,Type),Types). + +get_type_for_args(V,Type):- get_type(V,Type), Type\==[], Type\=='%Undefined%', Type\=='list'. + +set_types_of(V,_Types):- nonvar(V),!. +set_types_of(V,Types):- list_to_set(Types,Set),put_attr(V,cns,Set), nop(wdmsg(V=Types)). + +precompute_typeinfo(HResult,HeadIs,AsBodyFn,Ast,Result) :- + must_det_lls(( + HeadIs = [FnName|Args], + LazyArgsList=[], FinalLazyOnlyRet = lazy, + f2p(HeadIs,LazyArgsList,HResult,FinalLazyOnlyRet,AsBodyFn,NextBody), + HeadAST=[assign,HResult,[call(FnName)|Args]], + Ast = [=,HeadIs,NextBody], + ast_to_prolog_aux(no_caller,[],HeadAST,_HeadC), + ast_to_prolog(no_caller,[],NextBody,_NextBodyC), + extract_constraints(Ast,Result))). + + +cname_var(Sym,Src):- gensym(Sym,SrcV), + put_attr(Src,vn,SrcV). + %ignore(Src='$VAR'(SrcV)), debug_var(SrcV,Src). de_eval(eval(X),X):- compound(X),!. @@ -191,20 +333,23 @@ compile_for_exec(Ret, Body, Code), Output = is_p1(Body,Code,Ret), cname_var('Out_',Ret), - guess_varnames(Code,PrintCode), + %transpile_eval(Body,Output), + guess_varnames(Output,PrintCode), print_tree_nl(out(Ret):-(PrintCode)))). % ?- compile_for_exec(RetResult, is(pi+pi), Converted). -compile_for_exec(Res,I,OO):- - %ignore(Res='$VAR'('RetResult')),` +compile_for_exec(Res,I,O):- + %ignore(Res='$VAR'('RetResult')), must_det_lls(( - compile_for_exec0(Res,I,OO))). - + compile_for_exec0(Res,I,O))). compile_for_exec0(Res,I,eval_args(I,Res)):- is_ftVar(I),!. compile_for_exec0(Res,(:- I),O):- !, compile_for_exec0(Res,I,O). +compile_for_exec0(Converted,I, PrologCode):- !, + must_det_lls((transpile_eval(I,Converted, PrologCode))). + compile_for_exec0(Res,I,BB):- compile_for_exec1(I, H:-BB), arg(1,H,Res). @@ -249,16 +394,33 @@ get_property_evaluate(x(E,_),E). +determine_eager_vars_case_aux(L,L,[],[]). +determine_eager_vars_case_aux(Lin,Lout,[[Match,Target]|Rest],EagerVars) :- + determine_eager_vars(eager,_,Match,EagerVarsMatch), + determine_eager_vars(Lin,LoutTarget,Target,EagerVarsTarget), + determine_eager_vars_case_aux(Lin,LoutRest,Rest,EagerVarsRest), + intersect_var(EagerVarsTarget,EagerVarsRest,EagerVars0), + union_var(EagerVarsMatch,EagerVars0,EagerVars), + (LoutTarget=eager,LoutRest=eager -> Lout=eager ; Lout=lazy). + determine_eager_vars(lazy,lazy,A,[]) :- fullvar(A),!. determine_eager_vars(eager,eager,A,[A]) :- fullvar(A),!. -determine_eager_vars(Lin,Lout,[if,If,Then,Else],EagerVars) :- !, +determine_eager_vars(Lin,Lout,['if',If,Then,Else],EagerVars) :- !, determine_eager_vars(eager,_,If,EagerVarsIf), determine_eager_vars(Lin,LoutThen,Then,EagerVarsThen), determine_eager_vars(Lin,LoutElse,Else,EagerVarsElse), intersect_var(EagerVarsThen,EagerVarsElse,EagerVars0), union_var(EagerVarsIf,EagerVars0,EagerVars), (LoutThen=eager,LoutElse=eager -> Lout=eager ; Lout=lazy). -determine_eager_vars(Lin,Lout,[let,V,Vbind,Body],EagerVars) :- !, +determine_eager_vars(Lin,Lout,['if',If,Then],EagerVars) :- !, + determine_eager_vars(eager,_,If,EagerVars), + determine_eager_vars(Lin,Lout,Then,_EagerVarsThen). +% for case, treat it as nested if then else +determine_eager_vars(Lin,Lout,['case',Val,Cases],EagerVars) :- !, + determine_eager_vars(eager,_,Val,EagerVarsVal), + determine_eager_vars_case_aux(Lin,Lout,Cases,EagarVarsCases), + union_var(EagerVarsVal,EagarVarsCases,EagerVars). +determine_eager_vars(Lin,Lout,['let',V,Vbind,Body],EagerVars) :- !, determine_eager_vars(eager,eager,Vbind,EagerVarsVbind), determine_eager_vars(Lin,Lout,Body,EagerVarsBody), union_var([V],EagerVarsVbind,EagerVars0), @@ -290,15 +452,15 @@ combine_lazy_types_props(lazy,x(E,lazy),x(E,lazy)) :- !. combine_lazy_types_props(_,x(E,_),x(E,eager)). -subst_varnames(Convert,Converted):- - subst_vars(Convert,Converted,[], NVL), - memorize_varnames(NVL). - transpiler_stored_eval_lookup(Convert,PrologCode0,Converted0):- transpiler_stored_eval(ConvertM,PrologCode0,Converted0), ConvertM =@= Convert,ConvertM = Convert,!. -transpile_eval(Convert0,Converted) :- +transpile_eval(Convert,Converted):- + transpile_eval(Convert,Converted,PrologCode),!, + call(PrologCode). + +transpile_eval(Convert0,Converted,PrologCode) :- subst_varnames(Convert0,Convert), (transpiler_stored_eval_lookup(Convert,PrologCode0,Converted0) -> PrologCode=PrologCode0, @@ -307,8 +469,7 @@ f2p([],[],Converted,eager,Convert,Code), ast_to_prolog(no_caller,[],Code,PrologCode), compiler_assertz(transpiler_stored_eval(Convert,PrologCode,Converted)) - ), - call(PrologCode). + ). % !(compile-for-assert (plus1 $x) (+ 1 $x) ) compile_for_assert(HeadIsIn, AsBodyFnIn, Converted) :- @@ -339,6 +500,7 @@ % FinalLazyArgs: x(doeval/noeval,eager/lazy) maplist(combine_lazy_types_props,EagerLazyList,TypeProps,FinalLazyArgs), combine_lazy_types_props(ResultEager,RetProps,FinalLazyRet), + findall(ClauseIDt,transpiler_clause_store(FnName,LenArgsPlus1,ClauseIDt,_,_,_,_,_,_),ClauseIdList), (ClauseIdList=[] -> ClauseId=0 @@ -348,60 +510,43 @@ compiler_assertz(transpiler_clause_store(FnName,LenArgsPlus1,ClauseId,Types0,RetType0,FinalLazyArgs,FinalLazyRet,HeadIs,AsBodyFn)), maplist(arrange_lazy_args,Args,FinalLazyArgs,LazyArgsList), get_property_lazy(FinalLazyRet,FinalLazyOnlyRet), + + precompute_typeinfo(HResult,HeadIs,AsBodyFn,Ast,TypeInfo), + + output_prolog(magenta,TypeInfo), + print_ast( green, Ast), + f2p(HeadIs,LazyArgsList,HResult,FinalLazyOnlyRet,AsBodyFn,NextBody), + + LazyEagerInfo=[resultEager:ResultEager,retProps:RetProps,finalLazyRet:FinalLazyRet,finalLazyOnlyRet:FinalLazyOnlyRet, + args_list:Args,lazyArgsList:LazyArgsList,eagerLazyList:EagerLazyList,typeProps:TypeProps,finalLazyArgs:FinalLazyArgs], + + output_prolog(LazyEagerInfo), + + %format("HeadIs:~q HResult:~q AsBodyFn:~q NextBody:~q\n",[HeadIs,HResult,AsBodyFn,NextBody]), %(var(HResult) -> (Result = HResult, HHead = Head) ; % funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head)), - HeadAst=[assign,HResult,[call(FnName)|Args]], - ast_to_prolog_aux(no_caller,[FnName/LenArgsPlus1],HeadAst,HeadC), - output_language( ast, (( - \+ \+ (( %no_conflict_numbervars(HeadC + NextBody), - %write_src_wi([=,HeadC,NextBody]), - nop( print_ast([=,HeadC,NextBody])), - true))))), + HeadAST=[assign,HResult,[call(FnName)|Args]], + ast_to_prolog_aux(no_caller,[FnName/LenArgsPlus1],HeadAST,HeadC), + + + print_ast( yellow, [=,HeadAST,NextBody]), ast_to_prolog(caller(FnName,LenArgsPlus1),[FnName/LenArgsPlus1],NextBody,NextBodyC), - print_ast([=,HeadAst,NextBody]), + %format("###########1 ~q",[Converted]), %numbervars(Converted,0,_), %format("###########2 ~q",[Converted]), extract_constraints(Converted,EC), - \+ \+ (printable_vars(Converted+EC,PV+PC),output_prolog(PV),output_prolog(PC)), + output_prolog([EC,Converted]), true )). -compiler_assertz(Info):- assertz(Info),output_prolog(Info). - -output_prolog(Converted --> B):- !, ignore( \+ \+ color_g_mesg(cyan,output_language(prolog, (print_pl_source(Converted --> B))))). -output_prolog(:-B):- !, ignore( \+ \+ color_g_mesg(cyan,output_language(prolog, (print_pl_source(:-B))))). -output_prolog(Converted:-B):- !, ignore( \+ \+ color_g_mesg(cyan,output_language(prolog, (print_pl_source(Converted:-B))))). -output_prolog(Converted):- is_list(Converted), !, ignore( \+ \+ color_g_mesg(cyan,output_language(prolog, (maplist(writeln,Converted))))). -output_prolog(Converted):- ignore( \+ \+ color_g_mesg(cyan,output_language(prolog, (print_pl_source(Converted:-true), true)))). - -print_ast(HB):- printable_vars(HB,HBPN), print_ast_0(HBPN). - -printable_vars(HB,HBPN):- - copy_term(HB,HBP), - set_vnames(HBP), - copy_term_nat(HBP,HBPN), - numbervars(HBPN,0,_,[]),!. - -set_vnames(HBP):- - term_variables(HBP,Vars), - maplist(only_names,Vars). - - -only_names(Var):- % del_attr(Var,cns), - ignore((get_attr(Var,vn,VN),Var = '$VAR'(VN))),!. -only_names(Var):- ignore(catch(del_attr(Var,cns),_,fail)), - ignore((get_attr(Var,vn,VN),nop(ignore(Var = '$VAR'(VN))))). - -%print_ast_0(HB):- output_language( ast, print_term(HB,[indent_arguments(true)])),!. -print_ast_0(HB):- output_language( ast, print_tree_nl(HB)). no_conflict_numbervars(Term):- findall(N,(sub_term(E,Term),compound(E), '$VAR'(N)=E, integer(N)),NL),!, @@ -677,16 +822,16 @@ R=((If2) *-> (Then2);(Else2)). ast_to_prolog_aux(Caller,DontStub,[is_p1,Code0,R],is_p1(Code1,R)) :- !,ast_to_prolog(Caller,DontStub,Code0,Code1). ast_to_prolog_aux(Caller,DontStub,[native(F)|Args0],A) :- !, - must_det_lls(label_arg_types(F,1,Args0)), + label_arg_types(F,1,Args0), maplist(ast_to_prolog_aux(Caller,DontStub),Args0,Args1), - must_det_lls(label_arg_types(F,1,Args1)), + label_arg_types(F,1,Args1), A=..[F|Args1]. ast_to_prolog_aux(Caller,DontStub,[assign,A,[call(F)|Args0]],R) :- (fullvar(A); \+ compound(A)),atom(F),!, - must_det_lls(label_arg_types(F,1,Args0)), + label_arg_types(F,1,Args0), maplist(ast_to_prolog_aux(Caller,DontStub),Args0,Args1), length(Args0,LArgs), atomic_list_concat(['mc_',LArgs,'__',F],Fp), - must_det_lls(label_arg_types(F,0,[A|Args1])), + label_arg_types(F,0,[A|Args1]), LArgs1 is LArgs+1, append(Args1,[A],Args2), R=..[Fp|Args2], @@ -698,6 +843,13 @@ true ; check_supporting_predicates('&self',F/LArgs1)). ast_to_prolog_aux(Caller,DontStub,[assign,A,X0],(A=X1)) :- must_det_lls(label_type_assignment(A,X0)), ast_to_prolog_aux(Caller,DontStub,X0,X1),label_type_assignment(A,X1),!. +ast_to_prolog_aux(Caller,DontStub,[prolog_match,A,X0],(A=X1)) :- ast_to_prolog_aux(Caller,DontStub,X0,X1),!. + +ast_to_prolog_aux(Caller,DontStub,[prolog_catch,Catch,Ex,Catcher],R) :- ast_to_prolog(Caller,DontStub,Catch,Catch2), R= catch(Catch2,Ex,Catcher). +ast_to_prolog_aux(_Caller,_DontStub,[prolog_inline,Prolog],R) :- !, R= Prolog. + + + ast_to_prolog_aux(_,_,'#\\'(A),A). ast_to_prolog_aux(_,_,A=B,A=B):- must_det_lls(label_type_assignment(A,B)). @@ -710,77 +862,6 @@ ast_to_prolog_aux(_,_,A,A). -cns:attr_unify_hook(_V,_T):- true. - -%must_det_lls(G):- catch(G,E,(wdmsg(E),fail)),!. -%must_det_lls(G):- rtrace(G),!. -must_det_lls(G):- catch(G,E,(wdmsg(E),fail)),!. -must_det_lls(G):- notrace,nortrace,trace,call(G),!. - -extract_constraints(V,VS):- var(V),get_attr(V,vn,Name),get_attr(V,cns,Set),!,extract_constraints(Name,Set,VS),!. -extract_constraints(V,VS):- var(V),!,ignore(get_types_of(V,Types)),extract_constraints(V,Types,VS),!. -extract_constraints(Converted,VSS):- term_variables(Converted,Vars), - % assign_vns(0,Vars,_), - maplist(extract_constraints,Vars,VSS). -extract_constraints(V,[],V=[]):-!. -extract_constraints(V,Types,V=Types). - - -label_vns(S,G,E):- term_variables(G,Vars),assign_vns(S,Vars,E),!. -assign_vns(S,[],S):-!. -assign_vns(N,[V|Vars],O):- get_attr(V,vn,_),!, assign_vns(N,Vars,O). -assign_vns(N,[V|Vars],O):- format(atom(VN),'~w',['$VAR'(N)]), - put_attr(V,vn,VN), N2 is N+1, assign_vns(N2,Vars,O). - -label_arg_types(_,_,[]):-!. -label_arg_types(F,N,[A|Args]):- - label_arg_n_type(F,N,A),N2 is N+1, - label_arg_types(F,N2,Args). - -% label_arg_n_type(F,0,A):- !, label_type_assignment(A,F). -label_arg_n_type(F,N,A):- add_type_to(A,arg(F,N)),!. - -add_type_to(V,T):- is_list(T), !, maplist(add_type_to(V),T). -add_type_to(V,T):- T =@= val(V),!. -add_type_to(V,T):- ground(T),arg_type_hints(T,H),!,add_type_to(V,H). -add_type_to(V,T):- - must_det_lls(( - get_types_of(V,TV), - append([T],TV,TTV), - set_types_of(V,TTV))). - -label_type_assignment(V,O):- - must_det_lls(( - get_types_of(V,TV), get_types_of(O,TO), - add_type_to(V,val(O)), - add_type_to(O,val(V)), - add_type_to(V,TO), - add_type_to(O,TV))). - -is_functor_val(val(_)). - -arg_type_hints(arg(is_True,1),'Bool'). -arg_type_hints(arg(==,0),'Bool'). -arg_type_hints(arg(match,0),['Empty',arg(match,3)]). -arg_type_hints(arg(empty,0),'Empty'). -arg_type_hints(val('Empty'),'Empty'). -arg_type_hints(val('True'),'Bool'). -arg_type_hints(val('False'),'Bool'). -arg_type_hints(arg('println!',0),'UnitAtom'). - -get_just_types_of(V,Types):- get_types_of(V,VTypes),exclude(is_functor_val,VTypes,Types). - -get_types_of(V,Types):- attvar(V),get_attr(V,cns,Types),!. -get_types_of(V,Types):- compound(V),V=arg(_,_),!,Types=[V]. -get_types_of(V,Types):- findall(Type,get_type_for_args(V,Type),Types). - -get_type_for_args(V,Type):- get_type(V,Type), Type\==[], Type\=='%Undefined%', Type\=='list'. - -set_types_of(V,_Types):- nonvar(V),!. -set_types_of(V,Types):- list_to_set(Types,Set),put_attr(V,cns,Set), nop(wdmsg(V=Types)). - - - combine_code_list(A,R) :- !, combine_code_list_aux(A,R0), (R0=[] -> R=true @@ -921,30 +1002,32 @@ :- discontiguous f2p/6. -f2p(_HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- % must_det_lls(is_var_set(LazyVars)), - (is_ftVar(Convert);number(Convert); string(Convert); \+ compound(Convert) ; \+ callable(Convert)),!, % Check if Convert is a variable +f2p(_HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- + (is_ftVar(Convert);number(Convert)),!, % Check if Convert is a variable var_prop_lookup(Convert,LazyVars,L), lazy_impedance_match(L,ResultLazy,Convert,[],RetResult,Converted). -f2p(_HeadIs, _LazyVars, RetResult, ResultLazy, Orig, Converted) :- Orig = '#\\'(Convert), +f2p(_HeadIs, _LazyVars, RetResult, ResultLazy, '#\\'(Convert), Converted) :- (ResultLazy=eager -> RetResult=Convert, Converted=[] ; Converted=[assign,RetResult,[is_p1,[],Convert]]). % If Convert is a number or an atom, it is considered as already converted. -f2p(_HeadIs, _LazyVars, RetResult, ResultLazy, Convert, Converted) :- % HeadIs\=@=Convert, +f2p(_HeadIs, _LazyVars, RetResult, _ResultLazy, Convert, Converted) :- fail, once(number(Convert);atomic(Convert);\+compound(Convert);data_term(Convert)),%CheckifConvertisanumberoranatom - (ResultLazy=eager->C2=Convert;C2=is_p1(Convert,true,Convert)), - Converted= [], RetResult=C2, + %(ResultLazy=eager -> C2=Convert ; C2=[is_p1,[],Convert]), + %Converted=[[assign,RetResult,C2]], + RetResult=Convert, Converted=[], % For OVER-REACHING categorization of dataobjs % % wdmsg(data_term(Convert)), %trace_break, !. % Set RetResult to Convert as it is already in predicate form + % If Convert is a number or an atom, it is considered as already converted. f2p(_HeadIs, _LazyVars, RetResult, ResultLazy, Convert, Converted) :- % HeadIs\=@=Convert, - once(number(Convert); atom(Convert); \+ compound(Convert) ; data_term(Convert)), % Check if Convert is a number or an atom + once(number(Convert); atom(Convert); data_term(Convert)), % Check if Convert is a number or an atom (ResultLazy=eager -> C2=Convert ; C2=[is_p1,[],Convert]), Converted=[[assign,RetResult,C2]], % For OVER-REACHING categorization of dataobjs % @@ -1070,16 +1153,9 @@ % create an eval-args list. TODO FIXME revisit this after working out how lists handle evaluation length(EvalArgs, N), maplist(=(eager), EvalArgs), - maplist(f2p_skip_atom(HeadIs, LazyVars),Converted,EvalArgs,Convert,Allcodes), + maplist(f2p(HeadIs, LazyVars),Converted,EvalArgs,Convert,Allcodes), append(Allcodes,Codes). -f2p_skip_atom(_HeadIs,_LazyVars,Converted,_EvalArgs,Convert,true):- -\+compound(Convert),!,Converted=Convert. -f2p_skip_atom(HeadIs,LazyVars,Converted,EvalArgs,Convert,Allcodes):- -f2p(HeadIs,LazyVars,Converted,EvalArgs,Convert,Allcodes). - - - f2p(HeadIs,LazyVars,_RetResult,EvalArgs,Convert,_Code):- format("Error in f2p ~q ~q ~q ~q\n",[HeadIs,LazyVars,Convert,EvalArgs]), trace,throw(0). @@ -1143,8 +1219,48 @@ A=B,CodeNew=CodeOld ; append(CodeOld,[[assign,A,B]],CodeNew)). -compile_flow_control(_HeadIs,_LazyVars,_RetResult,_LazyEval,Convert,_):- \+compound(Convert),!,fail. -compile_flow_control(_HeadIs,_LazyVars,_RetResult,_LazyEval,Convert,_):-compound_name_arity(Convert,_,0),!,fail. +compile_flow_control(HeadIs,LazyVars,RetResult,LazyEval,Convert, Converted) :- + Convert=['case',Value,Cases],!, + f2p(HeadIs,LazyVars,ValueResult,eager,Value,ValueCode), + compile_flow_control_case(HeadIs,LazyVars,RetResult,LazyEval,ValueResult,Cases,Converted0), + append(ValueCode,Converted0,Converted). + +compile_flow_control_case(_,_,RetResult,_,_,[],Converted) :- !,Converted=[[assign,RetResult,'Empty']]. +compile_flow_control_case(HeadIs,LazyVars,RetResult,LazyEval,ValueResult,[[Match,Target]|Rest],Converted) :- + f2p(HeadIs,LazyVars,MatchResult,eager,Match,MatchCode), + f2p(HeadIs,LazyVars,TargetResult,LazyEval,Target,TargetCode), + compile_flow_control_case(HeadIs,LazyVars,RestResult,LazyEval,ValueResult,Rest,RestCode), + append(TargetCode,[[assign,RetResult,TargetResult]],T), + append(RestCode,[[assign,RetResult,RestResult]],R), + append(MatchCode,[[prolog_if,[[prolog_match,ValueResult,MatchResult]],T,R]],Converted). + +compile_flow_control(HeadIs,LazyVars,RetResult,LazyEval,Convert, Converted) :- + Convert = ['case', Eval, CaseList],!, + f2p(HeadIs, LazyVars, Var, eager, Eval, CodeCanFail), + case_list_to_if_list(Var, CaseList, IfList, [empty], IfEvalFails), + compile_test_then_else(RetResult, LazyVars, LazyEval, CodeCanFail, IfList, IfEvalFails, Converted). + +case_list_to_if_list(_Var, [], [empty], EvalFailed, EvalFailed) :-!. +case_list_to_if_list(Var, [[Pattern, Result] | Tail], Next, _Empty, EvalFailed) :- + (Pattern=='Empty'; Pattern=='%void%'), !, % if the case Failed + case_list_to_if_list(Var, Tail, Next, Result, EvalFailed). +case_list_to_if_list(Var, [[Pattern, Result] | Tail], Out, IfEvalFailed, EvalFailed) :- + case_list_to_if_list(Var, Tail, Next, IfEvalFailed, EvalFailed), + Out = ['if', [case_match, Var, Pattern], Result, Next]. + + +% !(compile-body! (function 1)) +% !(compile-body! (function (throw 1))) +% !(compile-body! (superpose ((throw 1) (throw 2)))) +compile_flow_control(HeadIs,LazyVars,RetResult,LazyEval,Convert, Converted) :- + Convert = ['function', Body],!, + f2p(HeadIs,LazyVars,RetResult,LazyEval,Body,BodyCode), + Converted = [[prolog_catch,BodyCode,metta_return(FunctionResult),FunctionResult=RetResult]]. + +compile_flow_control(HeadIs,LazyVars,RetResult,LazyEval,Convert, Converted) :- + Convert = ['return',Body],!, + f2p(HeadIs,LazyVars,RetResult,LazyEval,Body,BodyCode), + append(BodyCode,[[prolog_inline,throw(metta_return(RetResult))]],Converted). compile_flow_control(HeadIs,LazyVars,RetResult,LazyEval,Convert, Converted) :- Convert = ['if',Cond,Then,Else],!, @@ -1153,6 +1269,13 @@ append(CondCode,[[native(is_True),CondResult]],If), compile_test_then_else(RetResult,LazyVars,LazyEval,If,Then,Else,Converted). +compile_flow_control(HeadIs,LazyVars,RetResult,LazyEval,Convert, Converted) :- + Convert = ['if',Cond,Then],!, + %Test = is_True(CondResult), + f2p(HeadIs,LazyVars,CondResult,eager,Cond,CondCode), + append(CondCode,[[native(is_True),CondResult]],If), + compile_test_then_else(RetResult,LazyVars,LazyEval,If,Then,'Empty',Converted). + compile_test_then_else(RetResult,LazyVars,LazyEval,If,Then,Else,Converted):- f2p(HeadIs,LazyVars,ThenResult,LazyEval,Then,ThenCode), f2p(HeadIs,LazyVars,ElseResult,LazyEval,Else,ElseCode),