diff --git a/prolog/metta_lang/metta_compiler.pl b/prolog/metta_lang/metta_compiler.pl index 1e7d61ada2..e7235269ba 100755 --- a/prolog/metta_lang/metta_compiler.pl +++ b/prolog/metta_lang/metta_compiler.pl @@ -126,10 +126,23 @@ as_p1(X,X):- \+ compound(X),!. as_p1(is_p1(Code,Ret),Ret):- !, call(Code). -as_p1(is_p1(_Src,Code,Ret),Ret):-!,call(Code). -as_p1(is_p1(_Type,_Src,Code,Ret),Ret):-!,call(Code). +as_p1(is_p1(_Expr,Code,Ret),Ret):-!,call(Code). +as_p1(is_p1(_Type,_Expr,Code,Ret),Ret):-!,call(Code). as_p1(X,X). +%as_p1_exec(X,X):- \+ compound(X),!. +as_p1_exec(is_p1(Code,Ret),Ret):- !, call(Code). +as_p1_exec(is_p1(_,Code,Ret),Ret):- !, call(Code). +as_p1_exec(is_p1(_Type,_Expr,Code,Ret),Ret):-!, call(Code). +%as_p1_exec(X,X). + +%as_p1_expr(X,X):- \+ compound(X),!. +as_p1_expr(is_p1(Expression,_,_),Expression):-!. +as_p1_expr(is_p1(_Type,Expression,_,_),Expression):-!. +%as_p1_expr(X,X). + + + % Meta-predicate that ensures that for every instance where G1 holds, G2 also holds. :- meta_predicate(for_all(0,0)). for_all(G1,G2):- forall(G1,G2). @@ -357,9 +370,9 @@ unnumbervars_clause(Info,Assert), assertz(Assert),output_prolog(Info). -cname_var(Sym,Src):- gensym(Sym,SrcV), - put_attr(Src,vn,SrcV). - %ignore(Src='$VAR'(SrcV)), debug_var(SrcV,Src). +cname_var(Sym,Expr):- gensym(Sym,ExprV), + put_attr(Expr,vn,ExprV). + %ignore(Expr='$VAR'(ExprV)), debug_var(ExprV,Expr). output_prolog(Converted):- output_prolog(cyan,Converted). @@ -422,7 +435,7 @@ 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),'~q',['$VAR'(N)]), +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(_,_,[]):-!. @@ -939,13 +952,13 @@ compile_for_exec1(AsBodyFn, Converted) :- 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), + f2p([exec0],[],HResult,x(doeval,eager),AsBodyFn,NextBody), %optimize_head_and_body(x_assign([exec0],HResult),NextBody,HeadC,NextBodyB), 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,x(_,Y),N-Y). +arrange_lazy_args(N,x(E,Y),N-x(E,Y)). get_operator_typedef_props(X,FnName,Largs,Types,RetType) :- get_operator_typedef(X,FnName,Largs,Types,RetType),!. @@ -967,8 +980,6 @@ get_property_lazy(x(_,L),L). -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), @@ -980,7 +991,9 @@ determine_eager_vars(lazy,lazy,A,[]) :- fullvar(A),!. determine_eager_vars(eager,eager,A,[A]) :- fullvar(A),!. -determine_eager_vars(eager,eager,[Var|_],[]):- fullvar(Var),!. % avoid binding free var to 'if' +determine_eager_vars(_,eager,A,EagerVars) :- is_list(A),A=[Var|_],fullvar(Var),!, % avoid binding free var to 'if' + maplist(determine_eager_vars(eager),_,A,EagerVars0),foldl(union_var,EagerVars0,[],EagerVars). + determine_eager_vars(Lin,Lout,['if',If,Then,Else],EagerVars) :- !, determine_eager_vars(eager,_,If,EagerVarsIf), determine_eager_vars(Lin,LoutThen,Then,EagerVarsThen), @@ -1023,10 +1036,11 @@ maplist(determine_eager_vars(eager),_,A,EagerVars0),foldl(union_var,EagerVars0,[],EagerVars). determine_eager_vars(_,eager,_,[]). +set_eager_or_lazy(_,V,eager) :- \+ fullvar(V), !. set_eager_or_lazy(Vlist,V,R) :- (member_var(V,Vlist) -> R=eager ; R=lazy). -combine_lazy_types_props(lazy,x(E,lazy),x(E,lazy)) :- !. -combine_lazy_types_props(_,x(E,_),x(E,eager)). +combine_lazy_types_props(eager,x(doeval,_),x(doeval,eager)) :- !. +combine_lazy_types_props(_,X,X). transpiler_stored_eval_lookup(Convert,PrologCode0,Converted0):- transpiler_stored_eval(ConvertM,PrologCode0,Converted0), @@ -1042,16 +1056,16 @@ PrologCode=PrologCode0, Converted=Converted0 ; - f2p([],[],Converted,eager,Convert,Code), + f2p([],[],Converted,x(doeval,eager),Convert,Code), ast_to_prolog(no_caller,[],Code,PrologCode), compiler_assertz(transpiler_stored_eval(Convert,PrologCode,Converted)) ). % !(compile-for-assert (plus1 $x) (+ 1 $x) ) -compile_for_assert(HeadIs, AsBodyFn, Converted) :- +compile_for_assert(HeadIsIn, AsBodyFnIn, Converted) :- must_det_lls(( current_self(Space), - %subst_varnames(HeadIsIn+AsBodyFnIn,HeadIs+AsBodyFn), + subst_varnames(HeadIsIn+AsBodyFnIn,HeadIs+AsBodyFn), %leash(-all),trace, HeadIs=[FnName|Args], length(Args,LenArgs), @@ -1089,7 +1103,7 @@ ), 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), + %get_property_lazy(FinalLazyRet,FinalLazyOnlyRet), %precompute_typeinfo(HResult,HeadIs,AsBodyFn,Ast,TypeInfo), @@ -1108,12 +1122,11 @@ %output_prolog(magenta,TypeInfo), %print_ast( green, Ast), + %trace, + f2p(HeadIs,LazyArgsList,HResult,FinalLazyRet,AsBodyFn,NextBody), + %notrace, - f2p(HeadIs,LazyArgsList,HResult,FinalLazyOnlyRet,AsBodyFn,NextBody), - - - - LazyEagerInfo=[resultEager:ResultEager,retProps:RetProps,finalLazyRet:FinalLazyRet,finalLazyOnlyRet:FinalLazyOnlyRet, + LazyEagerInfo=[resultEager:ResultEager,retProps:RetProps,finalLazyRet:FinalLazyRet,finalLazyOnlyRet:FinalLazyRet, args_list:Args,lazyArgsList:LazyArgsList,eagerLazyList:EagerLazyList,typeProps:TypeProps,finalLazyArgs:FinalLazyArgs], output_prolog(LazyEagerInfo), @@ -1123,17 +1136,21 @@ %(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(no_caller,HeadAST,HeadC), - append(Args,[HResult],HArgs), - HeadC =.. [FnNameWPrefix|HArgs], - - + %append(Args,[HResult],HArgs), + %HeadC =.. [FnNameWPrefix|HArgs], + + + ast_to_prolog_aux(no_caller,[FnName/LenArgsPlus1],HeadAST,HeadC), print_ast( yellow, [=,HeadAST,NextBody]), + %leash(+all), - + %leash(-all),trace, ast_to_prolog(caller(FnName,LenArgsPlus1),[FnName/LenArgsPlus1],NextBody,NextBodyC), + %format("###########1 ~q",[Converted]), %numbervars(Converted,0,_), %format("###########2 ~q",[Converted]), @@ -1144,9 +1161,9 @@ if_t(Optimized\=@=Converted, output_prolog(green,Optimized)), -tree_deps(Space,FnName,LenArgsPlus1), - -show_recompile(Space,FnName,LenArgsPlus1), + tree_deps(Space,FnName,LenArgsPlus1), + + show_recompile(Space,FnName,LenArgsPlus1), true )))). @@ -1354,7 +1371,8 @@ 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,[is_p1,Type,Src,Code0,R],is_p1(Type,Src,Code1,R)) :- !,ast_to_prolog(Caller,DontStub,Code0,Code1). +ast_to_prolog_aux(Caller,DontStub,[is_p1,Expr,Code0,R],is_p1(Expr,Code1,R)) :- !,ast_to_prolog(Caller,DontStub,Code0,Code1). +ast_to_prolog_aux(Caller,DontStub,[is_p1,_Type,Expr,Code0,R],is_p1(Expr,Code1,R)) :- !,ast_to_prolog(Caller,DontStub,Code0,Code1). ast_to_prolog_aux(Caller,DontStub,[native(FIn)|ArgsIn],A) :- !, must_det_lls(( FIn=..[F|Pre], % allow compound natives @@ -1378,7 +1396,7 @@ 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)) -> @@ -1454,9 +1472,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)]) @@ -1524,12 +1542,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)/~q).~n', [metta_compiled_predicate, 3]), - format(TempFileStream, ':- dynamic((~q)/~q).~n', [metta_compiled_predicate, 3]), + format(TempFileStream, ':- multifile((~q)/~w).~n', [metta_compiled_predicate, 3]), + format(TempFileStream, ':- dynamic((~q)/~w).~n', [metta_compiled_predicate, 3]), format(TempFileStream, '~N~q.~n',[metta_compiled_predicate(Space,F,A)]), - format(TempFileStream, ':- multifile((~q)/~q).~n', [F, A]), - format(TempFileStream, ':- dynamic((~q)/~q).~n', [F, A]), + format(TempFileStream, ':- multifile((~q)/~w).~n', [F, A]), + format(TempFileStream, ':- dynamic((~q)/~w).~n', [F, A]), %if_t( \+ option_value('tabling',false), if_t(option_value('tabling','True'),format(TempFileStream,':- ~q.~n',[table(F/A)])), maplist(write_clause(TempFileStream), PredClauses), @@ -1538,7 +1556,7 @@ % Consult the temporary file % abolish(F/A), /*'&self':*/ - % sformat(CAT,'cat ~q',[TempFileName]), shell(CAT), + % sformat(CAT,'cat ~w',[TempFileName]), shell(CAT), consult(TempFileName), % listing(F/A), @@ -1606,7 +1624,7 @@ quietlY(G):- call(G). -var_prop_lookup(_,[],eager). +var_prop_lookup(_,[],x(doeval,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 @@ -1615,18 +1633,31 @@ f2p(_HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- is_ftVar(Convert),!, % Check if Convert is a variable - var_prop_lookup(Convert,LazyVars,L), - lazy_impedance_match(L,ResultLazy,Convert,[],RetResult,Converted). + var_prop_lookup(Convert,LazyVars,EL), + lazy_impedance_match(EL,ResultLazy,Convert,[],RetResult,Converted). f2p(_HeadIs, _LazyVars, RetResult, ResultLazy, '#\\'(Convert), Converted) :- - (ResultLazy=eager -> + (ResultLazy=x(_,eager) -> RetResult=Convert, Converted=[] ; Converted=[assign,RetResult,[is_p1,['Char'],'#\\'(Convert),[],Convert]]). -% If Convert is not expected to be evaluatble, it is considered as already converted. + +% If Convert is a number or an atomic, it is considered as already converted. f2p(_HeadIs, _LazyVars, RetResult, ResultLazy, Convert, Converted) :- % HeadIs\=@=Convert, + once(number(Convert); atom(Convert); atomic(Convert) /*; data_term(Convert)*/ ), % Check if Convert is a number or an atom + (ResultLazy=x(_,eager) -> C2=Convert ; C2=[is_p1,Convert,[],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 + + + +% If Convert is not expected to be evaluatble, it is considered as already converted. +f2p(_HeadIs, _LazyVars, RetResult, ResultLazy, Convert, Converted) :- fail, % HeadIs\=@=Convert, %once(number(Convert); atom(Convert); data_term(Convert)), % Check if Convert is a number or an atom once(number(Convert); atomic(Convert); \+compound(Convert); data_term(Convert)), must_det_lls(get_val_types(Convert,Types)->true;Types=['%NoValTypes%']), @@ -1696,19 +1727,18 @@ compile_maplist_p2(from_prolog_args(maybe(ResultLazy)),[Result],[RetResult],PostCode), append([PreCode,[[native(Native),CallArgs]],PostCode],Converted). - f2p(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- HeadIs\=@=Convert, Convert=[Fn|_], \+ atom(Fn), Args = Convert, length(Args, 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(HeadIs, LazyVars),NewArgs, EvalArgs, Args, NewCodes), + maplist(=(ResultLazy), EvalArgs), + maplist(do_arg_eval(HeadIs, LazyVars),Args, EvalArgs, NewArgs, NewCodes), append(NewCodes,CombinedNewCode), Code=[assign,RetResult0,list(NewArgs)], append(CombinedNewCode,[Code],Converted0), - lazy_impedance_match(eager,ResultLazy,RetResult0,Converted0,RetResult,Converted). + lazy_impedance_match(x(doeval,eager),ResultLazy,RetResult0,Converted0,RetResult,Converted). update_laziness(x(X,_),x(_,Y),x(X,Y)). @@ -1729,17 +1759,19 @@ atom(Fn),!, length(Args,Largs), LenArgsPlus1 is Largs+1, - (transpiler_clause_store(Fn,LenArgsPlus1,_,_,_,ArgsLazy0,x(_,RetLazy0),_,_) -> - UpToDateArgsLazy=ArgsLazy0, + (transpiler_clause_store(Fn,LenArgsPlus1,_,_,_,ArgsLazy0,RetLazy0,_,_) -> + % override whatever the get_operator_typedef_props returns with the signature defined in the library. + EvalArgs=ArgsLazy0, RetLazy=RetLazy0 ; - RetLazy=eager, + RetLazy=x(doeval,eager), length(UpToDateArgsLazy, Largs), - maplist(=(x(doeval,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(update_laziness,EvalArgs0,UpToDateArgsLazy,EvalArgs) + ), maplist(do_arg_eval(HeadIs,LazyVars),Args,EvalArgs,NewArgs,NewCodes), append(NewCodes,CombinedNewCode), Code=[assign,RetResult0,[call(Fn)|NewArgs]], @@ -1781,25 +1813,49 @@ Code=Convert. +lazy_impedance_match(x(_,L),x(_,L),RetResult0,Converted0,RetResult0,Converted0). +% lazy -> eager +lazy_impedance_match(x(_,lazy),x(doeval,eager),RetResult0,Converted0,RetResult,Converted) :- + append(Converted0,[[native(as_p1_exec),RetResult0,RetResult]],Converted). +lazy_impedance_match(x(_,lazy),x(noeval,eager),RetResult0,Converted0,RetResult,Converted) :- + append(Converted0,[[native(as_p1_expr),RetResult0,RetResult]],Converted). +% eager -> lazy +lazy_impedance_match(x(_,eager),x(_,lazy),RetResult0,Converted0,RetResult,Converted) :- + append(Converted0,[[assign,RetResult,[is_p1,RetResult0,[],RetResult0]]],Converted). lazy_impedance_match(L,L,RetResult0,Converted0,RetResult0,Converted0). lazy_impedance_match(lazy,eager,RetResult0,Converted0,RetResult,Converted) :- append(Converted0,[[native(as_p1),RetResult0,RetResult]],Converted). lazy_impedance_match(eager,lazy,RetResult0,Converted0,RetResult,Converted) :- append(Converted0,[[assign,RetResult,[is_p1,[],RetResult0]]],Converted). +arg_eval_props(Var,x(doeval,eager)):- fullvar(Var),!. 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('Atom',x(noeval,lazy)) :- !. +arg_eval_props('Expression',x(noeval,eager)) :- !. 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=[]. -do_arg_eval(HeadIs,LazyVars,Arg,x(doeval,eager),NewArg,Code) :- f2p(HeadIs,LazyVars,NewArg,eager,Arg,Code). +f2p(_HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- + (is_ftVar(Convert);number(Convert)),!, % Check if Convert is a variable + var_prop_lookup(Convert,LazyVars,EL), + lazy_impedance_match(EL,ResultLazy,Convert,[],RetResult,Converted). + +do_arg_eval(_,LazyVars,Arg,x(noeval,eager),RetArg,Converted) :- fullvar(Arg),!, + var_prop_lookup(Arg,LazyVars,EL), + lazy_impedance_match(EL,x(noeval,eager),Arg,[],RetArg,Converted). +do_arg_eval(HeadIs,LazyVars,RetArg,x(noeval,eager),Arg,Converted) :- + f2p(HeadIs,LazyVars,Arg,x(noeval,eager),RetArg,Converted). +do_arg_eval(HeadIs,LazyVars,Arg,x(E,lazy),RetArg,Converted) :- !, + var_prop_lookup(Arg,LazyVars,EL), + (EL=x(_,lazy) -> + lazy_impedance_match(EL,x(E,lazy),Arg,[],RetArg,Converted) + ; + f2p(HeadIs,LazyVars,SubArg,x(doeval,eager),Arg,SubCode), + Converted=[[assign,RetArg,[is_p1,Arg,SubCode,SubArg]]] + ). +do_arg_eval(HeadIs,LazyVars,Arg,x(doeval,eager),NewArg,Code) :- f2p(HeadIs,LazyVars,NewArg,x(doeval,eager),Arg,Code). :- discontiguous(compile_flow_control/6). :- discontiguous(compile_flow_control3/6). @@ -1809,21 +1865,21 @@ add_assignment(A,B,CodeOld,CodeNew) :- - (fullvar(A),var(B) -> + (fullvar(A),var(B),A==B -> B=A,CodeNew=CodeOld - ; var(A),fullvar(B) -> + ; var(A),fullvar(B),A==B -> A=B,CodeNew=CodeOld ; append(CodeOld,[[assign,A,B]],CodeNew)). compile_flow_control(HeadIs,LazyVars,RetResult,LazyEval,Convert, Converted) :- Convert=['case',Value,Cases],!, - f2p(HeadIs,LazyVars,ValueResult,eager,Value,ValueCode), + f2p(HeadIs,LazyVars,ValueResult,x(doeval,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,MatchResult,x(doeval,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), @@ -1833,7 +1889,7 @@ /* compile_flow_control(HeadIs,LazyVars,RetResult,LazyEval,Convert, Converted) :- Convert = ['case', Eval, CaseList],!, - f2p(HeadIs, LazyVars, Var, eager, Eval, CodeCanFail), + f2p(HeadIs, LazyVars, Var, x(doeval,eager), Eval, CodeCanFail), case_list_to_if_list(Var, CaseList, IfList, [empty], IfEvalFails), compile_test_then_else(RetResult, LazyVars, LazyEval, CodeCanFail, IfList, IfEvalFails, Converted). @@ -1859,27 +1915,27 @@ f2p(HeadIs,LazyVars,RetResult,LazyEval,Body,BodyCode), append(BodyCode,[[prolog_inline,throw(metta_return(RetResult))]],Converted). -compile_flow_control(HeadIs, LazyVars, RetResult, ResultLazy, Convert, CodeForSrc) :- % dif_functors(HeadIs,Convert), - Convert =~ ['eval', Src], - f2p(HeadIs, LazyVars, RetResult, ResultLazy, Src, CodeForSrc). +compile_flow_control(HeadIs, LazyVars, RetResult, ResultLazy, Convert, CodeForExpr) :- % dif_functors(HeadIs,Convert), + Convert =~ ['eval', Expr], + f2p(HeadIs, LazyVars, RetResult, ResultLazy, Expr, CodeForExpr). compile_flow_control(HeadIs, LazyVars, RetResult, ResultLazy, Convert, (CodeForSpace,Converted)) :- % dif_functors(HeadIs,Convert), - Convert =~ ['evalc', Src, Space], + Convert =~ ['evalc', Expr, Space], f2p(HeadIs, LazyVars, ResSpace, ResultLazy, Space,CodeForSpace), - f2p(HeadIs, LazyVars, RetResult, ResultLazy, Src,CodeForSrc), - Converted = with_space(ResSpace,CodeForSrc). + f2p(HeadIs, LazyVars, RetResult, ResultLazy, Expr,CodeForExpr), + Converted = with_space(ResSpace,CodeForExpr). compile_flow_control(HeadIs,LazyVars,RetResult,LazyEval,Convert, Converted) :- Convert = ['if',Cond,Then,Else],!, %Test = is_True(CondResult), - f2p(HeadIs,LazyVars,CondResult,eager,Cond,CondCode), + f2p(HeadIs,LazyVars,CondResult,x(doeval,eager),Cond,CondCode), 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), + f2p(HeadIs,LazyVars,CondResult,x(doeval,eager),Cond,CondCode), append(CondCode,[[native(is_True),CondResult]],If), compile_test_then_else(RetResult,LazyVars,LazyEval,If,Then,'Empty',Converted). @@ -1893,7 +1949,8 @@ 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), + %(fullvar(Value1) -> var_prop_lookup(Value1,LazyVars,x(E,_)) ; E=doeval), + f2p(HeadIs,LazyVars,ResValue1,x(doeval,eager),Value1,CodeForValue1), add_assignment(Var,ResValue1,CodeForValue1,CodeForValue2), f2p(HeadIs,LazyVars,RetResult,LazyEval,Body,BodyCode), append(CodeForValue2,BodyCode,Converted). @@ -1907,7 +1964,7 @@ append(Code,BodyCode,Converted))). compile_let_star(HeadIs,LazyVars,[Var,Value1],Code) :- - f2p(HeadIs,LazyVars,ResValue1,eager,Value1,CodeForValue1), + f2p(HeadIs,LazyVars,ResValue1,x(doeval,eager),Value1,CodeForValue1), add_assignment(Var,ResValue1,CodeForValue1,Code). @@ -1966,7 +2023,7 @@ */ compile_flow_control1(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- Convert =~ ['assertEqual',Value1,Value2],!, - cname_var('Src_',Src), + cname_var('Expr_',Expr), cname_var('FA_',ResValue1), cname_var('FA_',ResValue2), cname_var('FARL_',L1), @@ -1974,8 +2031,8 @@ f2p(HeadIs, LazyVars, ResValue1, ResultLazy, Value1,CodeForValue1), f2p(HeadIs, LazyVars, ResValue2, ResultLazy, Value2,CodeForValue2), Converted = - (Src = Convert, - loonit_assert_source_tf(Src, + (Expr = Convert, + loonit_assert_source_tf(Expr, (findall(ResValue1,CodeForValue1,L1), findall(ResValue2,CodeForValue2,L2)), equal_enough(L1,L2),RetResult)). @@ -2071,6 +2128,12 @@ 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). + compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- % dif_functors(HeadIs,Convert), Convert =~ ['unify-if',Value1,Value2,Then,Else],!,Test = metta_unify(ResValue1,ResValue2), f2p(HeadIs, LazyVars, ResValue1, ResultLazy, Value1,CodeForValue1), diff --git a/prolog/metta_lang/metta_compiler_lib.pl b/prolog/metta_lang/metta_compiler_lib.pl index a20cc4e0e0..94eab3b8ad 100644 --- a/prolog/metta_lang/metta_compiler_lib.pl +++ b/prolog/metta_lang/metta_compiler_lib.pl @@ -23,63 +23,89 @@ maybe_eval(Self,Types,Args,NewArgs). -'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_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)),!. +transpiler_clause_store('get-type', 2, 0, ['Atom'],'Atom', [x(noeval,eager)], x(doeval,eager), [], []). %'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 +transpiler_clause_store('+', 3, 0, ['Number', 'Number'],'Number', [x(doeval,eager), x(doeval,eager)], x(doeval,eager), [], []). 'mc_2__+'(A,B,R) :- number(A),number(B),!,plus(A,B,R). 'mc_2__+'(A,B,['+',A,B]). +transpiler_clause_store('-', 3, 0, ['Number', 'Number'],'Number', [x(doeval,eager), x(doeval,eager)], x(doeval,eager), [], []). 'mc_2__-'(A,B,R) :- number(A),number(B),!,plus(B,R,A). 'mc_2__-'(A,B,['-',A,B]). +transpiler_clause_store('*', 3, 0, ['Number', 'Number'],'Number', [x(doeval,eager), x(doeval,eager)], x(doeval,eager), [], []). 'mc_2__*'(A,B,R) :- number(A),number(B),!,R is A*B. 'mc_2__*'(A,B,['*',A,B]). %%%%%%%%%%%%%%%%%%%%% logic +%transpiler_clause_store('and', 3, 0, ['Bool', 'LazyBool'],'Bool', [x(doeval,eager), x(doeval,lazy)], x(doeval,eager), [], []). +%mc_2__and(A,is_p1(_,CodeB,B),B) :- atomic(A), A\=='False', A\==0, !, call(CodeB). +%mc_2__and(_,_,'False'). + +%transpiler_clause_store('or', 3, 0, ['Bool', 'LazyBool'],'Bool', [x(doeval,eager), x(doeval,lazy)], x(doeval,eager), [], []). +%mc_2__or(A,is_p1(_,CodeB,B),B):- (\+ atomic(A); A='False'; A=0), !, call(CodeB). +%mc_2__or(_,_,'True'). + +transpiler_clause_store('and', 3, 0, ['Bool', 'Bool'],'Bool', [x(doeval,eager), x(doeval,eager)], x(doeval,eager), [], []). mc_2__and(A,B,B):- atomic(A), A\=='False', A\==0, !. mc_2__and(_,_,'False'). +transpiler_clause_store('or', 3, 0, ['Bool', 'Bool'],'Bool', [x(doeval,eager), x(doeval,eager)], x(doeval,eager), [], []). mc_2__or(A,B,B):- (\+ atomic(A); A='False'; A=0), !. mc_2__or(_,_,'True'). +transpiler_clause_store('not', 2, 0, ['Bool'],'Bool', [x(doeval,eager)], x(doeval,eager), [], []). mc_1__not(A,'False') :- atomic(A), A\=='False', A\==0, !. mc_1__not(_,'True'). %%%%%%%%%%%%%%%%%%%%% comparison +% not sure about the signature for this one +transpiler_clause_store('==', 3, 0, ['Any', 'Any'],'Bool', [x(doeval,eager), x(doeval,eager)], x(doeval,eager), [], []). 'mc_2__=='(A,A,1) :- !. 'mc_2__=='(_,_,0). +transpiler_clause_store('<', 3, 0, ['Number', 'Number'],'Bool', [x(doeval,eager), x(doeval,eager)], x(doeval,eager), [], []). 'mc_2__<'(A,B,R) :- number(A),number(B),!,(A R='True' ; R='False'). 'mc_2__<'(A,B,['<',A,B]). +transpiler_clause_store('>', 3, 0, ['Number', 'Number'],'Bool', [x(doeval,eager), x(doeval,eager)], x(doeval,eager), [], []). 'mc_2__>'(A,B,R) :- number(A),number(B),!,(A>B -> R='True' ; R='False'). 'mc_2__>'(A,B,['>',A,B]). +transpiler_clause_store('>=', 3, 0, ['Number', 'Number'],'Bool', [x(doeval,eager), x(doeval,eager)], x(doeval,eager), [], []). 'mc_2__>='(A,B,R) :- number(A),number(B),!,(A>=B -> R='True' ; R='False'). 'mc_2__>='(A,B,['>=',A,B]). +transpiler_clause_store('<=', 3, 0, ['Number', 'Number'],'Bool', [x(doeval,eager), x(doeval,eager)], x(doeval,eager), [], []). '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_1__car-atom'(Cons,H):- Cons = [H|_] -> true ; throw(metta_type_error). +transpiler_clause_store('car-atom', 2, 0, ['Expression'],'Atom', [x(noeval,eager)], x(doeval,eager), [], []). +%'mc_1__car-atom'(Cons,H):- Cons = [H|_] -> true ; (fail,throw(metta_type_error)). +'mc_1__car-atom'([H|_],H). +transpiler_clause_store('cdr-atom', 2, 0, ['Expression'],'Expression', [x(noeval,eager)], x(doeval,eager), [], []). 'mc_1__cdr-atom'([_|T],T). +transpiler_clause_store('cons-atom', 2, 3, ['Atom', 'Expression'],'Expression', [x(noeval,eager), x(noeval,eager)], x(doeval,eager), [], []). 'mc_2__cons-atom'(A,B,[A|B]). +transpiler_clause_store('decons-atom', 2, 0, ['Expression'],'Expression', [x(noeval,eager)], x(doeval,eager), [], []). 'mc_1__decons-atom'([A|B],[A,B]). %%%%%%%%%%%%%%%%%%%%% set @@ -87,52 +113,62 @@ 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(_Type1,_Src1,Code1,R1),is_p1(_Type2,_Src2,Code2,R2),R1) :- !, +'mc_2__subtraction'(is_p1(_Type1,_Expr1,Code1,R1),is_p1(_Type2,_Expr2,Code2,R2),R1) :- !, call(Code1), \+ lazy_member(R1,Code2,R2). -'mc_2__subtraction'(is_p1(Code1,R1),is_p1(Code2,R2),R1) :- +'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(_Type1,_Src1,Code2,R2),R) :- !, 'mc_2__subtraction'(U1,is_p1(_Type2,_Src2,Code2,R2),R) ; call(Code2),R=R2. -'mc_2__union'(U1,is_p1(Code2,R2),R) :- 'mc_2__subtraction'(U1,is_p1(Code2,R2),R) ; call(Code2),R=R2. +'mc_2__union'(U1,is_p1(_Type1,_Expr1,Code2,R2),R) :- !, 'mc_2__subtraction'(U1,is_p1(_Type2,_Expr2,Code2,R2),R) ; call(Code2),R=R2. +'mc_2__union'(U1,is_p1(Expr,Code2,R2),R) :- 'mc_2__subtraction'(U1,is_p1(Expr,Code2,R2),R) ; call(Code2),R=R2. %%%%%%%%%%%%%%%%%%%%% superpose, collapse +transpiler_clause_store(superpose, 2, 0, ['Expression'], 'Atom', [x(doeval,eager)], x(doeval,eager), [], []). '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(_Type,_Src,Code,Ret),R) :- fullvar(Ret),!,findall(Ret,Code,R). -'mc_1__collapse'(is_p1(_Type,_Src,true,X),[X]) :- !. +'mc_1__collapse'(is_p1(_Type,_Expr,Code,Ret),R) :- fullvar(Ret),!,findall(Ret,Code,R). +'mc_1__collapse'(is_p1(_Type,_Expr,true,X),[X]) :- !. +'mc_1__collapse'(is_p1(_,Code,Ret),R) :- fullvar(Ret),!,findall(Ret,Code,R). +'mc_1__collapse'(is_p1(_,true,X),[X]). 'mc_1__collapse'(is_p1(Code,Ret),R) :- fullvar(Ret),!,findall(Ret,Code,R). 'mc_1__collapse'(is_p1(true,X),[X]). + %%%%%%%%%%%%%%%%%%%%% spaces +transpiler_clause_store('add-atom', 3, 0, ['Atom', 'Atom'], '%Undefined%', [x(doeval,eager), x(noeval,eager)], x(doeval,eager), [], []). 'mc_2__add-atom'(Space,PredDecl,[]) :- 'add-atom'(Space,PredDecl). +transpiler_clause_store('remove-atom', 3, 0, ['Atom', 'Atom'], '%Undefined%', [x(doeval,eager), x(noeval,eager)], x(doeval,eager), [], []). 'mc_2__remove-atom'(Space,PredDecl,[]) :- 'remove-atom'(Space,PredDecl). +transpiler_clause_store('get-atoms', 2, 0, ['Atom'], 'Atom', [x(noeval,eager)], x(noeval,eager), [], []). '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(_Type,_Src,TemplateCode,TemplateRet),TemplateRet) :- match_pattern(Space, Pattern), call(TemplateCode). -'mc_3__match'(Space,Pattern,is_p1(TemplateCode,TemplateRet),TemplateRet) :- metta_atom(Space, Atom),Atom=Pattern,call(TemplateCode). +'mc_3__match'(Space,Pattern,is_p1(_Type,_Expr,TemplateCode,TemplateRet),TemplateRet) :- match_pattern(Space, Pattern), call(TemplateCode). +'mc_3__match'(Space,Pattern,is_p1(_,TemplateCode,TemplateRet),TemplateRet) :- metta_atom(Space, Atom),Atom=Pattern,call(TemplateCode). % This allows match to supply hits to the correct metta_atom/2 (Rather than sending a variable -match_pattern(Space, Pattern):- functor(Pattern,F,A), functor(Atom,F,A), metta_atom(Space, Atom), Atom=Pattern. +match_pattern(Space, Pattern):- + if_t(compound(Pattern), + (functor(Pattern,F,A,Type), functor(Atom,F,A,Type))), + metta_atom(Space, Atom), Atom=Pattern. % 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(_TypeT,_SrcT,SuccessCode,RetVal),RetVal) :- !, unify_pattern(Space,Pattern), call(SuccessCode). -'mc_3__unify'(Space,Pattern,is_p1(TemplateCode,TemplateRet),TemplateRet) :- metta_atom(Space, Atom),Atom=Pattern,call(TemplateCode). +'mc_3__unify'(Space,Pattern,is_p1(_TypeT,_ExprT,SuccessCode,RetVal),RetVal) :- !, unify_pattern(Space,Pattern), call(SuccessCode). +'mc_3__unify'(Space,Pattern,is_p1(_,TemplateCode,TemplateRet),TemplateRet) :- metta_atom(Space, Atom),Atom=Pattern,call(TemplateCode). transpiler_clause_store(unify, 5, 0, ['Atom', 'Atom', 'Atom', 'Atom'], ' %Undefined%', [x(doeval,eager), x(doeval,eager), x(doeval,lazy), x(doeval,lazy)], x(doeval,eager), [], []). -'mc_4__unify'(Space,Pattern,is_p1(_TypeT,_SrcT,SuccessCode,RetVal),is_p1(_TypeF,_SrcF,FailureCode,RetVal),RetVal) :- +'mc_4__unify'(Space,Pattern,is_p1(_TypeT,_ExprT,SuccessCode,RetVal),is_p1(_TypeF,_ExprF,FailureCode,RetVal),RetVal) :- (unify_pattern(Space,Pattern)->call(SuccessCode);call(FailureCode)). % unify calls pattern matching if arg1 is a space @@ -146,19 +182,32 @@ % 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(_Type,_Src,Code,Ret),Ret) :- wtime_eval(Code). -'mc_1__time'(is_p1(Code,Ret),Ret) :- wtime_eval(Code). +'mc_1__time'(is_p1(_Type,_Expr,Code,Ret),Ret) :- !, wtime_eval(Code). +'mc_1__time'(is_p1(_,Code,Ret),Ret) :- wtime_eval(Code). +transpiler_clause_store(empty, 1, 0, [], '%Undefined', [], x(doeval,eager), [], []). 'mc_0__empty'(_) :- fail. +transpiler_clause_store('eval', 2, 0, ['Atom'], 'Atom', [x(noeval,eager)], x(doeval,eager), [], []). 'mc_1__eval'(X,R) :- transpile_eval(X,R). +transpiler_clause_store('get-metatype', 2, 0, ['Atom'], 'Atom', [x(noeval,eager)], x(doeval,eager), [], []). 'mc_1__get-metatype'(X,Y) :- 'get-metatype'(X,Y). % use the code in the interpreter for now +transpiler_clause_store('println!', 2, 0, ['%Undefined'], '%Undefined', [x(noeval,eager)], x(doeval,eager), [], []). 'mc_1__println!'(X,[]) :- println_impl(X). +transpiler_clause_store('stringToChars', 2, 0, ['String'], 'Expression', [x(doeval,eager)], x(doeval,eager), [], []). 'mc_1__stringToChars'(S,C) :- string_chars(S,C). +transpiler_clause_store('charsToString', 2, 0, ['Expression'], 'String', [x(doeval,eager)], x(doeval,eager), [], []). 'mc_1__charsToString'(C,S) :- string_chars(S,C). -mc_2__assertEqualToResult(A, B, C) :- u_assign([assertEqualToResult, A, B], C). +transpiler_clause_store('assertEqualToResult', 3, 0, ['Atom', 'Atom'], 'Atom', [x(doeval,eager),x(noeval,eager)], x(doeval,eager), [], []). +'mc_2__assertEqualToResult'(A, B, C) :- u_assign([assertEqualToResult, A, B], C). + +% this is a hack to make 'quote' behave as expected (noeval rather than eval). +% the reason for this is that stubs are currently created with x(doeval,eager) by default. +% once the check and recompile loop is done (using transpiler_predicate_store/4, stubs will be correctly created with x(neval,eager), and this can go away. +transpiler_clause_store('quote', 2, 0, ['Expression'], 'Expression', [x(noeval,eager)], x(noeval,eager), [], []). +'mc_1__quote'(A,['quote',A]). diff --git a/prolog/metta_lang/metta_compiler_lib_douglas.pl b/prolog/metta_lang/metta_compiler_lib_douglas.pl index 1d376e34a7..303cf29dcb 100755 --- a/prolog/metta_lang/metta_compiler_lib_douglas.pl +++ b/prolog/metta_lang/metta_compiler_lib_douglas.pl @@ -7,76 +7,104 @@ pred_uses_impl(F,A):- transpile_impl_prefix(F,A,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))),!, +use_interpreter:- fail. +mc_fallback_unimpl(Fn,Arity,Args,Res):- \+ use_interpreter, !, + (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. +%mc_fallback_unimpl(Fn,_Arity,Args,Res):- u_assign([Fn|Args], 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_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_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)),!. +transpiler_clause_store('get-type', 2, 0, ['Atom'],'Atom', [x(noeval,eager)], x(doeval,eager), [], []). %'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 +transpiler_clause_store('+', 3, 0, ['Number', 'Number'],'Number', [x(doeval,eager), x(doeval,eager)], x(doeval,eager), [], []). 'mc_2__+'(A,B,R) :- number(A),number(B),!,plus(A,B,R). 'mc_2__+'(A,B,['+',A,B]). +transpiler_clause_store('-', 3, 0, ['Number', 'Number'],'Number', [x(doeval,eager), x(doeval,eager)], x(doeval,eager), [], []). 'mc_2__-'(A,B,R) :- number(A),number(B),!,plus(B,R,A). 'mc_2__-'(A,B,['-',A,B]). +transpiler_clause_store('*', 3, 0, ['Number', 'Number'],'Number', [x(doeval,eager), x(doeval,eager)], x(doeval,eager), [], []). 'mc_2__*'(A,B,R) :- number(A),number(B),!,R is A*B. 'mc_2__*'(A,B,['*',A,B]). %%%%%%%%%%%%%%%%%%%%% logic +%transpiler_clause_store('and', 3, 0, ['Bool', 'LazyBool'],'Bool', [x(doeval,eager), x(doeval,lazy)], x(doeval,eager), [], []). +%mc_2__and(A,is_p1(_,CodeB,B),B) :- atomic(A), A\=='False', A\==0, !, call(CodeB). +%mc_2__and(_,_,'False'). + +%transpiler_clause_store('or', 3, 0, ['Bool', 'LazyBool'],'Bool', [x(doeval,eager), x(doeval,lazy)], x(doeval,eager), [], []). +%mc_2__or(A,is_p1(_,CodeB,B),B):- (\+ atomic(A); A='False'; A=0), !, call(CodeB). +%mc_2__or(_,_,'True'). + +transpiler_clause_store('and', 3, 0, ['Bool', 'Bool'],'Bool', [x(doeval,eager), x(doeval,eager)], x(doeval,eager), [], []). mc_2__and(A,B,B):- atomic(A), A\=='False', A\==0, !. mc_2__and(_,_,'False'). +transpiler_clause_store('or', 3, 0, ['Bool', 'Bool'],'Bool', [x(doeval,eager), x(doeval,eager)], x(doeval,eager), [], []). mc_2__or(A,B,B):- (\+ atomic(A); A='False'; A=0), !. mc_2__or(_,_,'True'). +transpiler_clause_store('not', 2, 0, ['Bool'],'Bool', [x(doeval,eager)], x(doeval,eager), [], []). mc_1__not(A,'False') :- atomic(A), A\=='False', A\==0, !. mc_1__not(_,'True'). %%%%%%%%%%%%%%%%%%%%% comparison +% not sure about the signature for this one +transpiler_clause_store('==', 3, 0, ['Any', 'Any'],'Bool', [x(doeval,eager), x(doeval,eager)], x(doeval,eager), [], []). 'mc_2__=='(A,A,1) :- !. 'mc_2__=='(_,_,0). +transpiler_clause_store('<', 3, 0, ['Number', 'Number'],'Bool', [x(doeval,eager), x(doeval,eager)], x(doeval,eager), [], []). 'mc_2__<'(A,B,R) :- number(A),number(B),!,(A R='True' ; R='False'). 'mc_2__<'(A,B,['<',A,B]). +transpiler_clause_store('>', 3, 0, ['Number', 'Number'],'Bool', [x(doeval,eager), x(doeval,eager)], x(doeval,eager), [], []). 'mc_2__>'(A,B,R) :- number(A),number(B),!,(A>B -> R='True' ; R='False'). 'mc_2__>'(A,B,['>',A,B]). +transpiler_clause_store('>=', 3, 0, ['Number', 'Number'],'Bool', [x(doeval,eager), x(doeval,eager)], x(doeval,eager), [], []). 'mc_2__>='(A,B,R) :- number(A),number(B),!,(A>=B -> R='True' ; R='False'). 'mc_2__>='(A,B,['>=',A,B]). +transpiler_clause_store('<=', 3, 0, ['Number', 'Number'],'Bool', [x(doeval,eager), x(doeval,eager)], x(doeval,eager), [], []). '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 +transpiler_clause_store('car-atom', 2, 0, ['Expression'],'Atom', [x(noeval,eager)], x(doeval,eager), [], []). 'mc_1__car-atom'(Cons,H):- Cons = [H|_] -> true ; throw(metta_type_error). +transpiler_clause_store('cdr-atom', 2, 0, ['Expression'],'Expression', [x(noeval,eager)], x(doeval,eager), [], []). 'mc_1__cdr-atom'([_|T],T). +transpiler_clause_store('cons-atom', 2, 3, ['Atom', 'Expression'],'Expression', [x(noeval,eager), x(noeval,eager)], x(doeval,eager), [], []). 'mc_2__cons-atom'(A,B,[A|B]). +transpiler_clause_store('decons-atom', 2, 0, ['Expression'],'Expression', [x(noeval,eager)], x(doeval,eager), [], []). 'mc_1__decons-atom'([A|B],[A,B]). %%%%%%%%%%%%%%%%%%%%% set @@ -84,44 +112,59 @@ 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(_Type1,_Src1,Code1,R1),is_p1(_Type2,_Src2,Code2,R2),R1) :- +'mc_2__subtraction'(is_p1(_Type1,_Expr1,Code1,R1),is_p1(_Type2,_Expr2,Code2,R2),R1) :- !, + call(Code1), + \+ lazy_member(R1,Code2,R2). +'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(_Type1,_Src1,Code2,R2),R) :- 'mc_2__subtraction'(U1,is_p1(_Type2,_Src2,Code2,R2),R) ; call(Code2),R=R2. +'mc_2__union'(U1,is_p1(_Type1,_Expr1,Code2,R2),R) :- !, 'mc_2__subtraction'(U1,is_p1(_Type2,_Expr2,Code2,R2),R) ; call(Code2),R=R2. +'mc_2__union'(U1,is_p1(Expr,Code2,R2),R) :- 'mc_2__subtraction'(U1,is_p1(Expr,Code2,R2),R) ; call(Code2),R=R2. %%%%%%%%%%%%%%%%%%%%% superpose, collapse +transpiler_clause_store(superpose, 2, 0, ['Expression'], 'Atom', [x(doeval,eager)], x(doeval,eager), [], []). '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(_Type,_Src,Code,Ret),R) :- fullvar(Ret),!,findall(Ret,Code,R). -'mc_1__collapse'(is_p1(_Type,_Src,true,X),[X]). +'mc_1__collapse'(is_p1(_Type,_Expr,Code,Ret),R) :- fullvar(Ret),!,findall(Ret,Code,R). +'mc_1__collapse'(is_p1(_Type,_Expr,true,X),[X]) :- !. +'mc_1__collapse'(is_p1(_,Code,Ret),R) :- fullvar(Ret),!,findall(Ret,Code,R). +'mc_1__collapse'(is_p1(_,true,X),[X]). +'mc_1__collapse'(is_p1(Code,Ret),R) :- fullvar(Ret),!,findall(Ret,Code,R). +'mc_1__collapse'(is_p1(true,X),[X]). %%%%%%%%%%%%%%%%%%%%% spaces +transpiler_clause_store('add-atom', 3, 0, ['Atom', 'Atom'], '%Undefined%', [x(doeval,eager), x(noeval,eager)], x(doeval,eager), [], []). 'mc_2__add-atom'(Space,PredDecl,[]) :- 'add-atom'(Space,PredDecl). +transpiler_clause_store('remove-atom', 3, 0, ['Atom', 'Atom'], '%Undefined%', [x(doeval,eager), x(noeval,eager)], x(doeval,eager), [], []). 'mc_2__remove-atom'(Space,PredDecl,[]) :- 'remove-atom'(Space,PredDecl). +transpiler_clause_store('get-atoms', 2, 0, ['Atom'], 'Atom', [x(noeval,eager)], x(noeval,eager), [], []). '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(_Type,_Src,TemplateCode,TemplateRet),TemplateRet) :- match_pattern(Space, Pattern), call(TemplateCode). +'mc_3__match'(Space,Pattern,is_p1(_Type,_Expr,TemplateCode,TemplateRet),TemplateRet) :- match_pattern(Space, Pattern), call(TemplateCode). +'mc_3__match'(Space,Pattern,is_p1(_,TemplateCode,TemplateRet),TemplateRet) :- metta_atom(Space, Atom),Atom=Pattern,call(TemplateCode). + % This allows match to supply hits to the correct metta_atom/2 (Rather than sending a variable match_pattern(Space, Pattern):- functor(Pattern,F,A), functor(Atom,F,A), metta_atom(Space, Atom), Atom=Pattern. -% TODO FIXME: sort out the difference between unify and match +% TODO FIXME: ssort 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(_TypeT,_SrcT,SuccessCode,RetVal),RetVal) :- unify_pattern(Space,Pattern), call(SuccessCode). +'mc_3__unify'(Space,Pattern,is_p1(_TypeT,_ExprT,SuccessCode,RetVal),RetVal) :- !, unify_pattern(Space,Pattern), call(SuccessCode). +'mc_3__unify'(Space,Pattern,is_p1(_,TemplateCode,TemplateRet),TemplateRet) :- metta_atom(Space, Atom),Atom=Pattern,call(TemplateCode). transpiler_clause_store(unify, 5, 0, ['Atom', 'Atom', 'Atom', 'Atom'], ' %Undefined%', [x(doeval,eager), x(doeval,eager), x(doeval,lazy), x(doeval,lazy)], x(doeval,eager), [], []). -'mc_4__unify'(Space,Pattern,is_p1(_TypeT,_SrcT,SuccessCode,RetVal),is_p1(_TypeF,_SrcF,FailureCode,RetVal),RetVal) :- +'mc_4__unify'(Space,Pattern,is_p1(_TypeT,_ExprT,SuccessCode,RetVal),is_p1(_TypeF,_ExprF,FailureCode,RetVal),RetVal) :- (unify_pattern(Space,Pattern)->call(SuccessCode);call(FailureCode)). % unify calls pattern matching if arg1 is a space @@ -135,18 +178,32 @@ % 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(_Type,_Src,Code,Ret),Ret) :- wtime_eval(Code). +'mc_1__time'(is_p1(_Type,_Expr,Code,Ret),Ret) :- wtime_eval(Code). +'mc_1__time'(is_p1(_,Code,Ret),Ret) :- wtime_eval(Code). +transpiler_clause_store(empty, 1, 0, [], '%Undefined', [], x(doeval,eager), [], []). 'mc_0__empty'(_) :- fail. +transpiler_clause_store('eval', 2, 0, ['Atom'], 'Atom', [x(noeval,eager)], x(doeval,eager), [], []). 'mc_1__eval'(X,R) :- transpile_eval(X,R). +transpiler_clause_store('get-metatype', 2, 0, ['Atom'], 'Atom', [x(noeval,eager)], x(doeval,eager), [], []). 'mc_1__get-metatype'(X,Y) :- 'get-metatype'(X,Y). % use the code in the interpreter for now +transpiler_clause_store('println!', 2, 0, ['%Undefined'], '%Undefined', [x(noeval,eager)], x(doeval,eager), [], []). 'mc_1__println!'(X,[]) :- println_impl(X). +transpiler_clause_store('stringToChars', 2, 0, ['String'], 'Expression', [x(doeval,eager)], x(doeval,eager), [], []). 'mc_1__stringToChars'(S,C) :- string_chars(S,C). +transpiler_clause_store('charsToString', 2, 0, ['Expression'], 'String', [x(doeval,eager)], x(doeval,eager), [], []). 'mc_1__charsToString'(C,S) :- string_chars(S,C). -mc_2__assertEqualToResult(A, B, C) :- u_assign([assertEqualToResult, A, B], C). +transpiler_clause_store('assertEqualToResult', 3, 0, ['Atom', 'Atom'], 'Atom', [x(doeval,eager),x(noeval,eager)], x(doeval,eager), [], []). +'mc_2__assertEqualToResult'(A, B, C) :- u_assign([assertEqualToResult, A, B], C). + +% this is a hack to make 'quote' behave as expected (noeval rather than eval). +% the reason for this is that stubs are currently created with x(doeval,eager) by default. +% once the check and recompile loop is done (using transpiler_predicate_store/4, stubs will be correctly created with x(neval,eager), and this can go away. +transpiler_clause_store('quote', 2, 0, ['Expression'], 'Expression', [x(noeval,eager)], x(noeval,eager), [], []). +'mc_1__quote'(A,['quote',A]). diff --git a/prolog/metta_lang/metta_compiler_lib_roy.pl b/prolog/metta_lang/metta_compiler_lib_roy.pl index 9569d9476b..0d46013210 100644 --- a/prolog/metta_lang/metta_compiler_lib_roy.pl +++ b/prolog/metta_lang/metta_compiler_lib_roy.pl @@ -1,53 +1,107 @@ :- dynamic(transpiler_clause_store/9). :- discontiguous transpiler_clause_store/9. +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_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)),!. + + +transpiler_clause_store('get-type', 2, 0, ['Atom'],'Atom', [x(noeval,eager)], x(doeval,eager), [], []). +%'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 +transpiler_clause_store('+', 3, 0, ['Number', 'Number'],'Number', [x(doeval,eager), x(doeval,eager)], x(doeval,eager), [], []). 'mc_2__+'(A,B,R) :- number(A),number(B),!,plus(A,B,R). 'mc_2__+'(A,B,['+',A,B]). +transpiler_clause_store('-', 3, 0, ['Number', 'Number'],'Number', [x(doeval,eager), x(doeval,eager)], x(doeval,eager), [], []). 'mc_2__-'(A,B,R) :- number(A),number(B),!,plus(B,R,A). 'mc_2__-'(A,B,['-',A,B]). +transpiler_clause_store('*', 3, 0, ['Number', 'Number'],'Number', [x(doeval,eager), x(doeval,eager)], x(doeval,eager), [], []). 'mc_2__*'(A,B,R) :- number(A),number(B),!,R is A*B. 'mc_2__*'(A,B,['*',A,B]). %%%%%%%%%%%%%%%%%%%%% logic -mc_2__and(A,B,B):- atomic(A), A\=='False', A\==0, !. +%transpiler_clause_store('and', 3, 0, ['Bool', 'LazyBool'],'Bool', [x(doeval,eager), x(doeval,lazy)], x(doeval,eager), [], []). +%mc_2__and(A,is_p1(_,CodeB,B),B) :- atomic(A), A\=='False', A\==0, !, call(CodeB). +%mc_2__and(_,_,'False'). + +%transpiler_clause_store('or', 3, 0, ['Bool', 'LazyBool'],'Bool', [x(doeval,eager), x(doeval,lazy)], x(doeval,eager), [], []). +%mc_2__or(A,is_p1(_,CodeB,B),B):- (\+ atomic(A); A='False'; A=0), !, call(CodeB). +%mc_2__or(_,_,'True'). + +transpiler_clause_store('and', 3, 0, ['Bool', 'Bool'],'Bool', [x(doeval,eager), x(doeval,eager)], x(doeval,eager), [], []). +mc_2__and(A,B,B) :- atomic(A), A\=='False', A\==0, !. mc_2__and(_,_,'False'). +transpiler_clause_store('or', 3, 0, ['Bool', 'Bool'],'Bool', [x(doeval,eager), x(doeval,eager)], x(doeval,eager), [], []). mc_2__or(A,B,B):- (\+ atomic(A); A='False'; A=0), !. mc_2__or(_,_,'True'). +transpiler_clause_store('not', 2, 0, ['Bool'],'Bool', [x(doeval,eager)], x(doeval,eager), [], []). mc_1__not(A,'False') :- atomic(A), A\=='False', A\==0, !. mc_1__not(_,'True'). %%%%%%%%%%%%%%%%%%%%% comparison +% not sure about the signature for this one +transpiler_clause_store('==', 3, 0, ['Any', 'Any'],'Bool', [x(doeval,eager), x(doeval,eager)], x(doeval,eager), [], []). 'mc_2__=='(A,A,1) :- !. 'mc_2__=='(_,_,0). +transpiler_clause_store('<', 3, 0, ['Number', 'Number'],'Bool', [x(doeval,eager), x(doeval,eager)], x(doeval,eager), [], []). 'mc_2__<'(A,B,R) :- number(A),number(B),!,(A R='True' ; R='False'). 'mc_2__<'(A,B,['<',A,B]). +transpiler_clause_store('>', 3, 0, ['Number', 'Number'],'Bool', [x(doeval,eager), x(doeval,eager)], x(doeval,eager), [], []). 'mc_2__>'(A,B,R) :- number(A),number(B),!,(A>B -> R='True' ; R='False'). 'mc_2__>'(A,B,['>',A,B]). +transpiler_clause_store('>=', 3, 0, ['Number', 'Number'],'Bool', [x(doeval,eager), x(doeval,eager)], x(doeval,eager), [], []). 'mc_2__>='(A,B,R) :- number(A),number(B),!,(A>=B -> R='True' ; R='False'). 'mc_2__>='(A,B,['>=',A,B]). +transpiler_clause_store('<=', 3, 0, ['Number', 'Number'],'Bool', [x(doeval,eager), x(doeval,eager)], x(doeval,eager), [], []). '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 +transpiler_clause_store('car-atom', 2, 0, ['Expression'],'Atom', [x(noeval,eager)], x(doeval,eager), [], []). 'mc_1__car-atom'([H|_],H). +transpiler_clause_store('cdr-atom', 2, 0, ['Expression'],'Expression', [x(noeval,eager)], x(doeval,eager), [], []). 'mc_1__cdr-atom'([_|T],T). +transpiler_clause_store('cons-atom', 2, 3, ['Atom', 'Expression'],'Expression', [x(noeval,eager), x(noeval,eager)], x(doeval,eager), [], []). 'mc_2__cons-atom'(A,B,[A|B]). +transpiler_clause_store('decons-atom', 2, 0, ['Expression'],'Expression', [x(noeval,eager)], x(doeval,eager), [], []). 'mc_1__decons-atom'([A|B],[A,B]). %%%%%%%%%%%%%%%%%%%%% set @@ -55,54 +109,68 @@ 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) :- +'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. +'mc_2__union'(U1,is_p1(Expr,Code2,R2),R) :- 'mc_2__subtraction'(U1,is_p1(Expr,Code2,R2),R) ; call(Code2),R=R2. %%%%%%%%%%%%%%%%%%%%% superpose, collapse +transpiler_clause_store(superpose, 2, 0, ['Expression'], 'Atom', [x(doeval,eager)], x(doeval,eager), [], []). '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]). +'mc_1__collapse'(is_p1(_,Code,Ret),R) :- fullvar(Ret),!,findall(Ret,Code,R). +'mc_1__collapse'(is_p1(_,true,X),[X]). %%%%%%%%%%%%%%%%%%%%% spaces +transpiler_clause_store('add-atom', 3, 0, ['Atom', 'Atom'], '%Undefined%', [x(doeval,eager), x(noeval,eager)], x(doeval,eager), [], []). 'mc_2__add-atom'(Space,PredDecl,[]) :- 'add-atom'(Space,PredDecl). +transpiler_clause_store('remove-atom', 3, 0, ['Atom', 'Atom'], '%Undefined%', [x(doeval,eager), x(noeval,eager)], x(doeval,eager), [], []). 'mc_2__remove-atom'(Space,PredDecl,[]) :- 'remove-atom'(Space,PredDecl). +transpiler_clause_store('get-atoms', 2, 0, ['Atom'], 'Atom', [x(noeval,eager)], x(noeval,eager), [], []). '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). +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). +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 -% 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_1__time'(is_p1(_,Code,Ret),Ret) :- wtime_eval(Code). +transpiler_clause_store(empty, 1, 0, [], '%Undefined', [], x(doeval,eager), [], []). 'mc_0__empty'(_) :- fail. +transpiler_clause_store('eval', 2, 0, ['Atom'], 'Atom', [x(noeval,eager)], x(doeval,eager), [], []). 'mc_1__eval'(X,R) :- transpile_eval(X,R). +transpiler_clause_store('get-metatype', 2, 0, ['Atom'], 'Atom', [x(noeval,eager)], x(doeval,eager), [], []). 'mc_1__get-metatype'(X,Y) :- 'get-metatype'(X,Y). % use the code in the interpreter for now +transpiler_clause_store('println!', 2, 0, ['%Undefined'], '%Undefined', [x(noeval,eager)], x(doeval,eager), [], []). 'mc_1__println!'(X,[]) :- println_impl(X). +transpiler_clause_store('stringToChars', 2, 0, ['String'], 'Expression', [x(doeval,eager)], x(doeval,eager), [], []). 'mc_1__stringToChars'(S,C) :- string_chars(S,C). +transpiler_clause_store('charsToString', 2, 0, ['Expression'], 'String', [x(doeval,eager)], x(doeval,eager), [], []). 'mc_1__charsToString'(C,S) :- string_chars(S,C). -mc_2__assertEqualToResult(A, B, C) :- u_assign([assertEqualToResult, A, B], C). +transpiler_clause_store('assertEqualToResult', 3, 0, ['Atom', 'Atom'], 'Atom', [x(doeval,eager),x(noeval,eager)], x(doeval,eager), [], []). +'mc_2__assertEqualToResult'(A, B, C) :- u_assign([assertEqualToResult, A, B], C). + +% this is a hack to make 'quote' behave as expected (noeval rather than eval). +% the reason for this is that stubs are currently created with x(doeval,eager) by default. +% once the check and recompile loop is done (using transpiler_predicate_store/4, stubs will be correctly created with x(neval,eager), and this can go away. +transpiler_clause_store('quote', 2, 0, ['Expression'], 'Expression', [x(noeval,eager)], x(noeval,eager), [], []). +'mc_1__quote'(A,['quote',A]). diff --git a/prolog/metta_lang/metta_compiler_roy.pl b/prolog/metta_lang/metta_compiler_roy.pl index fa58e26191..2a3ee0a107 100755 --- a/prolog/metta_lang/metta_compiler_roy.pl +++ b/prolog/metta_lang/metta_compiler_roy.pl @@ -111,12 +111,13 @@ % just so the transpiler_clause_store predicate always exists % transpiler_clause_store(f,arity,clause_number,types,rettype,lazy,retlazy,head,body) -transpiler_clause_store(dummy,0,0,[],'Any',[],eager,dummy,dummy). +transpiler_clause_store(dummy,0,0,[],'Any',[],x(doeval,eager),dummy,dummy). :- dynamic(transpiler_stored_eval/3). transpiler_stored_eval([],true,0). -as_p1(is_p1(Code,Ret),Ret):- !, call(Code). +as_p1_exec(is_p1(_,Code,Ret),Ret):- !, call(Code). +as_p1_expr(is_p1(Expression,_,_),Expression). % Meta-predicate that ensures that for every instance where G1 holds, G2 also holds. :- meta_predicate(for_all(0,0)). @@ -138,7 +139,6 @@ '=~0'(A,B):- compound_non_cons(B),!,A=B. '=~0'(A,B):- '=..'(A,B). - %into_list_args(A,AA):- is_ftVar(A),AA=A. %into_list_args(C,[C]):- \+ compound(C),!. into_list_args(C,C):- \+ compound(C),!. @@ -158,15 +158,195 @@ strip_m(M:BB,BB):- nonvar(BB),nonvar(M),!. strip_m(BB,BB). +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),!. + +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_lls(( + 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), + %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,O):- %ignore(Res='$VAR'('RetResult')), - compile_for_exec0(Res,I,O),!. + must_det_lls(( + 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). @@ -179,14 +359,15 @@ %compile_for_exec0(Res,I,O):- f2p(exec(),Res,I,O). compile_for_exec1(AsBodyFn, Converted) :- + 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), + f2p([exec0],[],HResult,x(doeval,eager),AsBodyFn,NextBody), %optimize_head_and_body(x_assign([exec0],HResult),NextBody,HeadC,NextBodyB), 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). + ast_to_prolog(no_caller,[],NextBody,NextBodyC))). -arrange_lazy_args(N,x(_,Y),N-Y). +arrange_lazy_args(N,x(E,Y),N-x(E,Y)). get_operator_typedef_props(X,FnName,Largs,Types,RetType) :- get_operator_typedef(X,FnName,Largs,Types,RetType),!. @@ -208,8 +389,6 @@ get_property_lazy(x(_,L),L). -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), @@ -221,29 +400,28 @@ determine_eager_vars(lazy,lazy,A,[]) :- fullvar(A),!. determine_eager_vars(eager,eager,A,[A]) :- fullvar(A),!. -determine_eager_vars(eager,eager,[Var|_],[]):- fullvar(Var),!. % avoid binding free var to 'if' -determine_eager_vars(Lin,Lout,['if',If,Then,Else],EagerVars) :- !, +determine_eager_vars(Lin,Lout,[IF,If,Then,Else],EagerVars) :- atom(IF),IF='if',!, 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,['if',If,Then],EagerVars) :- !, +determine_eager_vars(Lin,Lout,[IF,If,Then],EagerVars) :- atom(IF),IF='if',!, 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(Lin,Lout,[CASE,Val,Cases],EagerVars) :- atom(CASE),CASE='case',!, 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(Lin,Lout,[LET,V,Vbind,Body],EagerVars) :- atom(LET),LET='case',!, 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(Lin,Lout,[LETS,[],Body],EagerVars) :- atom(LETS),LETS='lets',!,determine_eager_vars(Lin,Lout,Body,EagerVars). +determine_eager_vars(Lin,Lout,[LETS,[[V,Vbind]|T],Body],EagerVars) :- atom(LETS),LETS='lets',!, determine_eager_vars(eager,eager,Vbind,EagerVarsVbind), determine_eager_vars(Lin,Lout,['let*',T,Body],EagerVarsBody), union_var([V],EagerVarsVbind,EagerVars0), @@ -264,23 +442,34 @@ maplist(determine_eager_vars(eager),_,A,EagerVars0),foldl(union_var,EagerVars0,[],EagerVars). determine_eager_vars(_,eager,_,[]). +set_eager_or_lazy(_,V,eager) :- \+ fullvar(V), !. set_eager_or_lazy(Vlist,V,R) :- (member_var(V,Vlist) -> R=eager ; R=lazy). -combine_lazy_types_props(lazy,x(E,lazy),x(E,lazy)) :- !. -combine_lazy_types_props(_,x(E,_),x(E,eager)). +combine_lazy_types_props(eager,x(doeval,_),x(doeval,eager)) :- !. +combine_lazy_types_props(_,X,X). + +transpiler_stored_eval_lookup(Convert,PrologCode0,Converted0):- + transpiler_stored_eval(ConvertM,PrologCode0,Converted0), + ConvertM =@= Convert,ConvertM = Convert,!. -transpile_eval(Convert,Converted) :- - (transpiler_stored_eval(Convert,PrologCode0,Converted0) -> +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, Converted=Converted0 ; - f2p([],[],Converted,eager,Convert,Code), + f2p([],[],Converted,x(doeval,eager),Convert,Code), ast_to_prolog(no_caller,[],Code,PrologCode), - assertz(transpiler_stored_eval(Convert,PrologCode,Converted)) - ), - call(PrologCode). + compiler_assertz(transpiler_stored_eval(Convert,PrologCode,Converted)) + ). -compile_for_assert(HeadIs, AsBodyFn, Converted) :- +% !(compile-for-assert (plus1 $x) (+ 1 $x) ) +compile_for_assert(HeadIsIn, AsBodyFnIn, Converted) :- + subst_varnames(HeadIsIn+AsBodyFnIn,HeadIs+AsBodyFn), %leash(-all),trace, HeadIs=[FnName|Args], length(Args,LenArgs), @@ -307,34 +496,47 @@ % 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 ; 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), + + %precompute_typeinfo(HResult,HeadIs,AsBodyFn,Ast,TypeInfo), + %output_prolog(magenta,TypeInfo), + %print_ast( green, Ast), + %trace, + f2p(HeadIs,LazyArgsList,HResult,FinalLazyRet,AsBodyFn,NextBody), + %notrace, + + LazyEagerInfo=[resultEager:ResultEager,retProps:RetProps,finalLazyRet:FinalLazyRet,finalLazyOnlyRet:FinalLazyRet, + 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)), - ast_to_prolog_aux(no_caller,[FnName/LenArgsPlus1],[assign,HResult,[call(FnName)|Args]],HeadC), - - output_language( ast, (( - \+ \+ (( no_conflict_numbervars(HeadC + NextBody), - %write_src_wi([=,HeadC,NextBody]), - print_tree_nl([=,HeadC,NextBody]), - true))))), + HeadAST=[assign,HResult,[call(FnName)|Args]], + ast_to_prolog_aux(no_caller,[FnName/LenArgsPlus1],HeadAST,HeadC), + print_ast( yellow, [=,HeadAST,NextBody]), + %leash(+all), + %leash(-all),trace, 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))), + extract_constraints(Converted,EC), + output_prolog([EC,Converted]), + true )). @@ -344,7 +546,7 @@ numbervars(Term,Start,_,[attvar(skip),singletons(true)]). %compile_for_assert(HeadIs, AsBodyFn, Converted) :- -% format("compile_for_assert: ~q ~q\n",[HeadIs, AsBodyFn]), +% format("compile_for_assert: ~w ~w\n",[HeadIs, AsBodyFn]), % HeadIs=[FnName|Args], % length(Args,LenArgs), % LenArgsPlus1 is LenArgs+1, @@ -359,7 +561,7 @@ % f2p(HeadIs,Result,AsBodyFn,NextBody), % %RetResult = Converted, % %RetResult = _, -% format("000000 ~q xxx ~q 000000\n\n",[Head,NextBody]), +% format("000000 ~w xxx ~w 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([FnName/LenArgsPlus1],NextBodyB,NextBodyC), @@ -399,7 +601,7 @@ optimize_head_and_body(Head,Body,HeadNewest,BodyNewest):- label_body_singles(Head,Body), - color_g_mesg('#707084',print_pl_source(( Head :- Body))), + color_g_mesg('#404064',print_pl_source(( Head :- Body))), (merge_and_optimize_head_and_body(Head,Body,HeadNew,BodyNew), % iterate to a fixed point (((Head,Body)=@=(HeadNew,BodyNew)) @@ -523,8 +725,83 @@ 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_lls(( + compiler_assertz(transpiler_stub_created(Space,Fn,Arity)), + transpile_call_prefix(Fn,CFn), + %trace, +((current_predicate(CFn/Arity) -> true ; + must_det_lls((( 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). + +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), + 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)) )), + 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). + + +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). + 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),!. @@ -534,27 +811,46 @@ 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,[is_p1,Expr,Code0,R],is_p1(Expr,Code1,R)) :- !,ast_to_prolog(Caller,DontStub,Code0,Code1). ast_to_prolog_aux(Caller,DontStub,[native(F)|Args0],A) :- !, + %label_arg_types(F,1,Args0), maplist(ast_to_prolog_aux(Caller,DontStub),Args0,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),!, +ast_to_prolog_aux(Caller,DontStub,[assign,A,[call(F)|Args0]],R) :- (fullvar(A); \+ compound(A)),atom(F),!, + %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), + %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(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)). + +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). combine_code_list(A,R) :- !, @@ -581,9 +877,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)]) @@ -599,12 +895,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)/~q).~n', [metta_compiled_predicate, 3]), - format(TempFileStream, ':- dynamic((~q)/~q).~n', [metta_compiled_predicate, 3]), + format(TempFileStream, ':- multifile((~q)/~w).~n', [metta_compiled_predicate, 3]), + format(TempFileStream, ':- dynamic((~q)/~w).~n', [metta_compiled_predicate, 3]), format(TempFileStream, '~N~q.~n',[metta_compiled_predicate(Space,F,A)]), - format(TempFileStream, ':- multifile((~q)/~q).~n', [F, A]), - format(TempFileStream, ':- dynamic((~q)/~q).~n', [F, A]), + format(TempFileStream, ':- multifile((~q)/~w).~n', [F, A]), + format(TempFileStream, ':- dynamic((~q)/~w).~n', [F, A]), %if_t( \+ option_value('tabling',false), if_t(option_value('tabling','True'),format(TempFileStream,':- ~q.~n',[table(F/A)])), maplist(write_clause(TempFileStream), PredClauses), @@ -613,7 +909,7 @@ % Consult the temporary file % abolish(F/A), /*'&self':*/ - % sformat(CAT,'cat ~q',[TempFileName]), shell(CAT), + % sformat(CAT,'cat ~w',[TempFileName]), shell(CAT), consult(TempFileName), % listing(F/A), @@ -680,8 +976,16 @@ 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). + +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), + append([[native(P2),Var,Res]],PreCode,TheCode). -var_prop_lookup(_,[],eager). +var_prop_lookup(_,[],x(doeval,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 @@ -690,19 +994,31 @@ 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). + var_prop_lookup(Convert,LazyVars,EL), + lazy_impedance_match(EL,ResultLazy,Convert,[],RetResult,Converted). f2p(_HeadIs, _LazyVars, RetResult, ResultLazy, '#\\'(Convert), Converted) :- - (ResultLazy=eager -> + (ResultLazy=x(_,eager) -> RetResult=Convert, Converted=[] - ; Converted=[assign,RetResult,[is_p1,[],Convert]]). + ; Converted=[assign,RetResult,[is_p1,Convert,[],Convert]]). + +% If Convert is a number or an atom, it is considered as already converted. +f2p(_HeadIs, _LazyVars, RetResult, _ResultLazy, Convert, Converted) :- fail, + once(number(Convert);atomic(Convert);\+compound(Convert);atomic(Convert)/*;data_term(Convert)*/),%CheckifConvertisanumberoranatom + %(ResultLazy=x(_,eager) -> C2=Convert ; C2=[is_p1,Convert,[],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); data_term(Convert)), % Check if Convert is a number or an atom - (ResultLazy=eager -> C2=Convert ; C2=[is_p1,[],Convert]), + once(number(Convert); atom(Convert);atomic(Convert)/*; data_term(Convert)*/), % Check if Convert is a number or an atom + (ResultLazy=x(_,eager) -> C2=Convert ; C2=[is_p1,Convert,[],Convert]), Converted=[[assign,RetResult,C2]], % For OVER-REACHING categorization of dataobjs % % wdmsg(data_term(Convert)), @@ -714,43 +1030,108 @@ atom(Fn), compile_flow_control(HeadIs,LazyVars,RetResult,ResultLazy, Convert, Converted),!. +% !(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_lls(( + compile_maplist_p2(as_prolog,Args,NewArgs,PreCode), + %RetResult = 'True', + compile_maplist_p2(from_prolog_args(ResultLazy),NewArgs,Args,PostCode), + 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, + 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), + append([PreCode,[[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), + 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))) +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), + 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, + 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), + append([PreCode,[[native(Native),CallArgs]],PostCode],Converted). + f2p(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- HeadIs\=@=Convert, Convert=[Fn|_], \+ atom(Fn), Args = Convert, length(Args, 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(HeadIs, LazyVars),NewArgs, EvalArgs, Args, NewCodes), + maplist(=(ResultLazy), EvalArgs), + maplist(do_arg_eval(HeadIs, LazyVars),Args, EvalArgs, NewArgs, NewCodes), append(NewCodes,CombinedNewCode), Code=[assign,RetResult0,list(NewArgs)], append(CombinedNewCode,[Code],Converted0), - lazy_impedance_match(eager,ResultLazy,RetResult0,Converted0,RetResult,Converted). + lazy_impedance_match(x(doeval,eager),ResultLazy,RetResult0,Converted0,RetResult,Converted). update_laziness(x(X,_),x(_,Y),x(X,Y)). +% 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), + compile_flow_control2(HeadIs,LazyVars,RetResult,ResultLazy, Convert, Converted),!. + 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,x(_,RetLazy0),_,_) -> - UpToDateArgsLazy=ArgsLazy0, + (transpiler_clause_store(Fn,LenArgsPlus1,_,_,_,ArgsLazy0,RetLazy0,_,_) -> + % override whatever the get_operator_typedef_props returns with the signature defined in the library. + EvalArgs=ArgsLazy0, RetLazy=RetLazy0 ; - RetLazy=eager, + RetLazy=x(doeval,eager), length(UpToDateArgsLazy, Largs), - 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(=(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), 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), +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,_RetResult,x_assign(Convert,Res), x_assign(Convert,Res)):- !. %f2p(_HeadIs,RetResult,Convert, Code):- into_x_assign(Convert,RetResult,Code). @@ -765,65 +1146,150 @@ maplist(f2p(HeadIs, LazyVars),Converted,EvalArgs,Convert,Allcodes), append(Allcodes,Codes). -f2p(HeadIs,LazyVars,_RetResult,EvalArgs,Convert,_Code):- - format("Error in f2p ~q ~q ~q ~q\n",[HeadIs,LazyVars,Convert,EvalArgs]), - throw(0). - -lazy_impedance_match(L,L,RetResult0,Converted0,RetResult0,Converted0). -lazy_impedance_match(lazy,eager,RetResult0,Converted0,RetResult,Converted) :- - append(Converted0,[[native(as_p1),RetResult0,RetResult]],Converted). -lazy_impedance_match(eager,lazy,RetResult0,Converted0,RetResult,Converted) :- - 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)) :- !. +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(user_error,"Error in f2p ~q ~q ~q ~q\n",[HeadIs,LazyVars,Convert,EvalArgs]), + user_io(print_ast(Convert)), + trace, throw(0), + Code=Convert. + + +lazy_impedance_match(x(_,L),x(_,L),RetResult0,Converted0,RetResult0,Converted0). +% lazy -> eager +lazy_impedance_match(x(_,lazy),x(doeval,eager),RetResult0,Converted0,RetResult,Converted) :- + append(Converted0,[[native(as_p1_exec),RetResult0,RetResult]],Converted). +lazy_impedance_match(x(_,lazy),x(noeval,eager),RetResult0,Converted0,RetResult,Converted) :- + append(Converted0,[[native(as_p1_expr),RetResult0,RetResult]],Converted). +% eager -> lazy +lazy_impedance_match(x(_,eager),x(_,lazy),RetResult0,Converted0,RetResult,Converted) :- + append(Converted0,[[assign,RetResult,[is_p1,RetResult0,[],RetResult0]]],Converted). + +arg_eval_props(N,x(doeval,eager)) :- atom(N),N='Number',!. +arg_eval_props(N,x(doeval,eager)) :- atom(N),N='Bool',!. +arg_eval_props(N,x(doeval,lazy)) :- atom(N),N='LazyBool',!. +arg_eval_props(N,x(doeval,eager)) :- atom(N),N='Any',!. +arg_eval_props(N,x(noeval,lazy)) :- atom(N),N='Atom',!. +arg_eval_props(N,x(noeval,eager)) :- atom(N),N='Expression',!. 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=[]. -do_arg_eval(HeadIs,LazyVars,Arg,x(doeval,eager),NewArg,Code) :- f2p(HeadIs,LazyVars,NewArg,eager,Arg,Code). +f2p(_HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- + (is_ftVar(Convert);number(Convert)),!, % Check if Convert is a variable + var_prop_lookup(Convert,LazyVars,EL), + lazy_impedance_match(EL,ResultLazy,Convert,[],RetResult,Converted). + +do_arg_eval(_,LazyVars,Arg,x(noeval,eager),RetArg,Converted) :- fullvar(Arg),!, + var_prop_lookup(Arg,LazyVars,EL), + lazy_impedance_match(EL,x(noeval,eager),Arg,[],RetArg,Converted). +do_arg_eval(HeadIs,LazyVars,RetArg,x(noeval,eager),Arg,Converted) :- + f2p(HeadIs,LazyVars,Arg,x(noeval,eager),RetArg,Converted). +do_arg_eval(HeadIs,LazyVars,Arg,x(E,lazy),RetArg,Converted) :- !, + var_prop_lookup(Arg,LazyVars,EL), + (EL=x(_,lazy) -> + lazy_impedance_match(EL,x(E,lazy),Arg,[],RetArg,Converted) + ; + f2p(HeadIs,LazyVars,SubArg,x(doeval,eager),Arg,SubCode), + Converted=[[assign,RetArg,[is_p1,Arg,SubCode,SubArg]]] + ). +do_arg_eval(HeadIs,LazyVars,Arg,x(doeval,eager),NewArg,Code) :- f2p(HeadIs,LazyVars,NewArg,x(doeval,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_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_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) -> + (fullvar(A),var(B),A==B -> B=A,CodeNew=CodeOld - ; var(A),fullvar(B) -> + ; var(A),fullvar(B),A==B -> A=B,CodeNew=CodeOld ; append(CodeOld,[[assign,A,B]],CodeNew)). compile_flow_control(HeadIs,LazyVars,RetResult,LazyEval,Convert, Converted) :- Convert=['case',Value,Cases],!, - f2p(HeadIs,LazyVars,ValueResult,eager,Value,ValueCode), + f2p(HeadIs,LazyVars,ValueResult,x(doeval,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,MatchResult,x(doeval,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, x(doeval,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],!, %Test = is_True(CondResult), - f2p(HeadIs,LazyVars,CondResult,eager,Cond,CondCode), + f2p(HeadIs,LazyVars,CondResult,x(doeval,eager),Cond,CondCode), 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), + f2p(HeadIs,LazyVars,CondResult,x(doeval,eager),Cond,CondCode), append(CondCode,[[native(is_True),CondResult]],If), compile_test_then_else(RetResult,LazyVars,LazyEval,If,Then,'Empty',Converted). @@ -836,22 +1302,23 @@ Converted=[[prolog_if,If,T,E]]. 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,LazyVars,RetResult,LazyEval,Body,BodyCode), - append(CodeForValue2,BodyCode,Converted). + Convert = ['let',Var,Value1,Body],!, + %(fullvar(Value1) -> var_prop_lookup(Value1,LazyVars,x(E,_)) ; E=doeval), + f2p(HeadIs,LazyVars,ResValue1,x(doeval,eager),Value1,CodeForValue1), + add_assignment(Var,ResValue1,CodeForValue1,CodeForValue2), + f2p(HeadIs,LazyVars,RetResult,LazyEval,Body,BodyCode), + append(CodeForValue2,BodyCode,Converted). compile_flow_control(HeadIs,LazyVars,RetResult,LazyEval,Convert, Converted) :- %dif_functors(HeadIs,Convert), - Convert =~ ['let*',Bindings,Body],!, - must_det_lls(( + Convert = ['let*',Bindings,Body],!, + must_det_lls(( maplist(compile_let_star(HeadIs,LazyVars),Bindings,CodeList), append(CodeList,Code), f2p(HeadIs,LazyVars,RetResult,LazyEval,Body,BodyCode), append(Code,BodyCode,Converted))). compile_let_star(HeadIs,LazyVars,[Var,Value1],Code) :- - f2p(HeadIs,LazyVars,ResValue1,eager,Value1,CodeForValue1), + f2p(HeadIs,LazyVars,ResValue1,x(doeval,eager),Value1,CodeForValue1), add_assignment(Var,ResValue1,CodeForValue1,Code). unnumbervars_clause(Cl,ClU):- @@ -943,6 +1410,65 @@ %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. @@ -992,11 +1518,6 @@ reverse(RevNewArgs,NewArgs), length([_|Right], N). -% Convert a list of conditions into a conjunction -list_to_conjunction([], true). -list_to_conjunction([Cond], Cond). -list_to_conjunction([H|T], (H, RestConj)) :- - list_to_conjunction(T, RestConj). /* as_functor_args(AsPred,F,A,ArgsL):- nonvar(AsPred),!,into_list_args(AsPred,[F|ArgsL]), length(ArgsL,A). @@ -1018,7 +1539,7 @@ 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,HResult,AsFunction,HHead), + 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), @@ -1033,7 +1554,7 @@ 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), + f2p(HeadIs, LazyVars, Result, ResultLazy, AsBodyFn,NextBody), combine_code(CodeForHeadArgs,NextBody,BodyC),!, optimize_head_and_body(HeadC,BodyC,HeadCC,BodyCC),!. @@ -1188,7 +1709,7 @@ 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,HResult,AsFunction,HHead), + 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), @@ -1196,16 +1717,16 @@ nop(ignore(Result = '$VAR'('HeadRes'))))),!. compile_for_assert(HeadIs, AsBodyFn, Converted) :- - %format("~q ~q ~q\n",[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,HResult,AsFunction,HHead), + 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,Result,AsBodyFn,NextBody), + f2p(HeadIs, LazyVars, Result, ResultLazy, AsBodyFn,NextBody), %RetResult = Converted, %RetResult = _, optimize_head_and_body(Head,NextBody,HeadC,NextBodyC), @@ -1218,7 +1739,7 @@ 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), + f2p(HeadIs, LazyVars, Result, ResultLazy, AsBodyFn,NextBody), combine_code(CodeForHeadArgs,NextBody,BodyC),!, optimize_head_and_body(HeadC,BodyC,HeadCC,BodyCC),!. @@ -1304,106 +1825,108 @@ -compile_flow_control(_HeadIs,RetResult,Convert, x_assign(Convert,RetResult)) :- is_ftVar(Convert), var(RetResult),!. +%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_control(HeadIs,RetResult,Convert, (Code1,Eval1Result=Result,Converted)) :- % dif_functors(HeadIs,Convert), +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, (Code1,Eval1Result=Result,Converted)) :- % dif_functors(HeadIs,Convert), Convert =~ chain(Eval1,Result,Eval2),!, - f2p(HeadIs,Eval1Result,Eval1,Code1), - f2p(HeadIs,RetResult,Eval2,Converted). + f2p(HeadIs, LazyVars, Eval1Result, ResultLazy, Eval1,Code1), + f2p(HeadIs, LazyVars, RetResult, ResultLazy, Eval2,Converted). -compile_flow_control(HeadIs,ResValue2,Convert, (CodeForValue1,Converted)) :- % dif_functors(HeadIs,Convert), +compile_flow_control2(HeadIs, LazyVars, ResValue2, ResultLazy, Convert, (CodeForValue1,Converted)) :- % dif_functors(HeadIs,Convert), Convert =~ ['eval-in-space',Value1,Value2], - f2p(HeadIs,ResValue1,Value1,CodeForValue1), - f2p(HeadIs,ResValue2,Value2,CodeForValue2), + f2p(HeadIs, LazyVars, ResValue1, ResultLazy, Value1,CodeForValue1), + f2p(HeadIs, LazyVars, ResValue2, ResultLazy, Value2,CodeForValue2), Converted = with_space(ResValue1,CodeForValue2). - -compile_flow_control(_HeadIs,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), +/* +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_control(_HeadIs,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), +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_control(HeadIs,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- % dif_functors(HeadIs,Convert), Convert =~ ['bind!',Var,Value], - f2p(HeadIs,ValueResult,Value,ValueCode), + f2p(HeadIs, LazyVars, ValueResult, ResultLazy, Value,ValueCode), Converted = (ValueCode,eval_args(['bind!',Var,ValueResult],RetResult)). -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), +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,CondResult,Cond,CondCode), - compile_test_then_else(RetResult,(CondCode,Test),Then,Else,Converted). + f2p(HeadIs, LazyVars, CondResult, ResultLazy, Cond,CondCode), + compile_test_then_else(RetResult,LazyVars,ResultLazy,(CondCode,Test),Then,Else,Converted). -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), +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,ValueResult,Value,ValueCode), - compile_test_then_else(RetResult,(ValueCode,Test),Then,Else,Converted). + f2p(HeadIs, LazyVars, ValueResult, ResultLazy, Value,ValueCode), + compile_test_then_else(RetResult,LazyVars,ResultLazy,(ValueCode,Test),Then,Else,Converted). -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), +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,ValueResult,Value,ValueCode), - compile_test_then_else(RetResult,(ValueCode,Test),Then,Else,Converted). + f2p(HeadIs, LazyVars, ValueResult, ResultLazy, Value,ValueCode), + compile_test_then_else(RetResult,LazyVars,ResultLazy,(ValueCode,Test),Then,Else,Converted). -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), +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,ValueResult,Value,ValueCode), - compile_test_then_else(RetResult,(ValueCode,Test),Then,Else,Converted). + f2p(HeadIs, LazyVars, ValueResult, ResultLazy, Value,ValueCode), + compile_test_then_else(RetResult,LazyVars,ResultLazy,(ValueCode,Test),Then,Else,Converted). -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), +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,ResValue1,Value1,CodeForValue1), - f2p(HeadIs,ResValue2,Value2,CodeForValue2), - compile_test_then_else(RetResult,(CodeForValue1,CodeForValue2,Test),Then,Else,Converted). - -cname_var(Sym,Src):- gensym(Sym,SrcV),Src='$VAR'(SrcV). -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- + 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,ResValue1,Value1,CodeForValue1), - f2p(HeadIs,ResValue2,Value2,CodeForValue2), + 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_control(HeadIs,RetResult,Convert, Converted) :- + + +compile_flow_control1(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- Convert =~ ['assertEqualToResult',Value1,Value2],!, - f2p(HeadIs,ResValue1,Value1,CodeForValue1), + f2p(HeadIs, LazyVars, ResValue1, ResultLazy, Value1,CodeForValue1), + ast_to_prolog(HeadIs,CodeForValue1,Prolog), + Converted = loonit_assert_source_tf(Convert, - findall(ResValue1,CodeForValue1,L1), + findall(ResValue1,Prolog,L1), equal_enough(L1,Value2),RetResult). -compile_flow_control(_HeadIs,RetResult,Convert, Converted) :- +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_control(_HeadIs,RetResult,Convert, Converted) :- +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_control(_HeadIs,RetResult,Convert, (Converted)) :- +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_control(HeadIs,RetResult,Convert, (Converted)) :- +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), @@ -1424,30 +1947,30 @@ 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), + f2p(HeadIs, _LazyVars, ValueResultR, _ResultLazy, Value,CodeForValue), %into_equals(ValueResultR,ValueResult,ValueResultRValueResult), ValueResultRValueResult = (ValueResultR=ValueResult), combine_code(CodeForValue,ValueResultRValueResult,Converted). -compile_flow_control(HeadIs,RetResult,Convert,Converted) :- +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert,Converted) :- Convert =~ ['println!',Value],!, Converted = (ValueCode,eval_args(['println!',ValueResult], RetResult)), - f2p(HeadIs,ValueResult,Value,ValueCode). + f2p(HeadIs, LazyVars, ValueResult, ResultLazy, Value,ValueCode). -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- Convert =~ ['case',Value,PNil],[]==PNil,!,Converted = (ValueCode,RetResult=[]), - f2p(HeadIs,_ValueResult,Value,ValueCode). + f2p(HeadIs, LazyVars, _ValueResult, ResultLazy, Value,ValueCode). -compile_flow_control(HeadIs,RetResult,Convert, (ValueCode, Converted)) :- +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, 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). + compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, ['case',ValueResult|Options], Converted), + f2p(HeadIs, LazyVars, ValueResult, ResultLazy, Value,ValueCode). -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- +compile_flow_control2(HeadIs, _LazyVars, RetResult, _ResultLazy, Convert, Converted) :- Convert =~ ['case',Value,Options],!, must_det_lls(( maplist(compile_case_bodies(HeadIs),Options,Cases), @@ -1458,17 +1981,17 @@ (BodyCode), BodyResult=RetResult)))). -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- +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_control(HeadIs,RetResult,ConvertCases,Else))). + compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, ConvertCases,Else))). /* -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- Convert =~ ['case',Value,Options],!, must_det_lls(( maplist(compile_case_bodies(HeadIs),Options,Cases), @@ -1479,10 +2002,10 @@ (BodyCode), BodyResult=RetResult)))). -compile_flow_control(HeadIs,_,Convert, Converted) :- +compile_flow_control2(HeadIs, LazyVars, _, ResultLazy, Convert, Converted) :- Convert =~ ['case',Value,Options,RetResult],!, must_det_lls(( - f2p(HeadIs,ValueResult,Value,ValueCode), + f2p(HeadIs, LazyVars, ValueResult, ResultLazy, Value,ValueCode), maplist(compile_case_bodies(HeadIs),Options,Cases), Converted = (( AllCases = Cases, @@ -1499,21 +2022,20 @@ */ compile_case_bodies(HeadIs,[Match,Body],caseStruct(_,true,BodyResult,BodyCode)):- Match == '%void%',!, - f2p(HeadIs,BodyResult,Body,BodyCode). + f2p(HeadIs, _LazyVars, BodyResult, _ResultLazy, Body,BodyCode). compile_case_bodies(HeadIs,[Match,Body],caseStruct(MatchResult,If,BodyResult,BodyCode)):- !, - f2p(HeadIs,MatchResultV,Match,MatchCode), + f2p(HeadIs, LazyVars, MatchResultV, ResultLazy, Match,MatchCode), combine_code(MatchCode,unify_enough(MatchResult,MatchResultV),If), - f2p(HeadIs,BodyResult,Body,BodyCode). + 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_control(HeadIs,RetResult,Convert,CodeForValueConverted) :- +compile_flow_control4(HeadIs, LazyVars, RetResult, ResultLazy, 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), + transpile_call_prefix(Plus,PrefixPlus), current_predicate(PrefixPlus/3), number(N), \+ number(Value), \+ is_ftVar(Value),!, - f2p(HeadIs,ValueResult,Value,CodeForValue),!, + f2p(HeadIs, LazyVars, ValueResult, ResultLazy, Value,CodeForValue),!, Converted =.. [PrefixPlus,N,ValueResult,RetResult], combine_code(CodeForValue,Converted,CodeForValueConverted). @@ -1522,51 +2044,51 @@ 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) :- +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- Convert =~ ['superpose',COL],compound_equals(COL,'collapse'(Value1)), - f2p(HeadIs,ResValue1,Value1,CodeForValue1), + f2p(HeadIs, LazyVars, ResValue1, ResultLazy, Value1,CodeForValue1), Converted = (findall(ResValue1,CodeForValue1,Gathered),member(RetResult,Gathered)). -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- Convert =~ ['collapse',Value1],!, - f2p(HeadIs,ResValue1,Value1,CodeForValue1), + f2p(HeadIs, LazyVars, ResValue1, ResultLazy, Value1,CodeForValue1), Converted = (findall(ResValue1,CodeForValue1,RetResult)). -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted) :- Convert =~ ['compose',Value1],!, Convert2 =~ ['collapse',Value1],!, - compile_flow_control(HeadIs,RetResult,Convert2, Converted). + compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert2, Converted). -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), +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,ResValue1,Value1,CodeForValue1), - f2p(HeadIs,ResValue2,Value2,CodeForValue2), - compile_test_then_else(RetResult,(CodeForValue1,CodeForValue2,Test),Then,Else,Converted). + 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_control(HeadIs,Y,Convert,Converted) :- dif_functors(HeadIs,Convert), +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,Y,AsFunction,Converted),!. + f2p(HeadIs, LazyVars, Y, ResultLazy, AsFunction,Converted),!. */ -compile_flow_control(HeadIs,Atom,Convert,Converted) :- +compile_flow_control2(HeadIs, LazyVars, Atom, ResultLazy, Convert,Converted) :- Convert=~ match(Space,Q,T),Q==T,Atom=Q,!, - compile_flow_control(HeadIs,Atom,'get-atoms'(Space),Converted). + compile_flow_control2(HeadIs, LazyVars, Atom, ResultLazy, 'get-atoms'(Space),Converted). -compile_flow_control(_HeadIs,Match,Convert,Converted) :- +compile_flow_control2(_HeadIs, _LazyVars, Match, _ResultLazy, Convert,Converted) :- Convert=~ 'get-atoms'(Space), Converted = metta_atom_iter(Space,Match). -compile_flow_control(HeadIs,AtomsVar,Convert,Converted) :- +compile_flow_control2(HeadIs, _LazyVars, AtomsVar, _ResultLazy, Convert,Converted) :- Convert=~ 'get-atoms'(Space), AtomsVar = Pattern, compile_pattern(HeadIs,Space,Pattern,Converted). -compile_flow_control(HeadIs,RetResult,Convert,Converted) :- dif_functors(HeadIs,Convert), +compile_flow_control2(HeadIs, LazyVars, RetResult, ResultLazy, Convert,Converted) :- dif_functors(HeadIs,Convert), Convert =~ 'match'(Space,Pattern,Template),!, - f2p(HeadIs,RetResult,Template,TemplateCode), + f2p(HeadIs, LazyVars, RetResult, ResultLazy, Template,TemplateCode), compile_pattern(HeadIs,Space,Pattern,SpacePatternCode), combine_code(SpacePatternCode,TemplateCode,Converted). @@ -1581,9 +2103,782 @@ make_with_space(Space,MatchCode,MatchCode):- Space=='&self',!. make_with_space(Space,MatchCode,with_space(Space,MatchCode)):- Space\=='&self'. -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- dif_functors(HeadIs,Convert), +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],!. + +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. + +%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))). + + +/* +ast_to_prolog(Caller,A,Result) :- + must_det_lls((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. + sub_term_loc_replaced(P1,A,A,self,Var,Var):- call(P1,A). + + +sub_term_loc_l(Nth,P1,E,Args,e(N,Nth)+Loc,Var,NewArgs):- + reverse(Args,RevArgs), + append(Left,[ST|Right],RevArgs), + sub_term_loc_replaced(P1,E,ST,Loc,Var,ReplaceST), + append(Left,[ReplaceST|Right],RevNewArgs), + reverse(RevNewArgs,NewArgs), + length([_|Right], N). + +% Convert a list of conditions into a conjunction +list_to_conjunction([], true). +list_to_conjunction([Cond], Cond). +list_to_conjunction([H|T], (H, RestConj)) :- + list_to_conjunction(T, RestConj). + +/* +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). + +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))),!. + + + + + + + +:- 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). + + +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_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). + +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). + +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). + +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). + + +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). + + +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). + +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),!. + + +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,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). + + + +compile_flow_control(HeadIs,RetResult,Convert, Converted) :- + Convert =~ ['case',Value,PNil],[]==PNil,!,Converted = (ValueCode,RetResult=[]), + f2p(HeadIs,_ValueResult,Value,ValueCode). + + +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). + +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)))). + +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))). + + +/* +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)))). + +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)))). + + +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,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). + +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). + + +/* +% 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_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). + +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_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))). @@ -1665,6 +2960,8 @@ is_compiled_and(AND):- member(AND,[ (','), ('and')]). flowc. +======= +ast_to_prolog_aux(_,A,A). :- discontiguous f2p/4. @@ -1693,8 +2990,8 @@ 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_lls((f2p(HeadIs,RetResult,Convert, Converted))). +f2p(HeadIs, LazyVars, RetResult, ResultLazy, EvalConvert,Converted):- EvalConvert =~ eval_args(Convert), !, + must_det_lls((f2p(HeadIs, LazyVars, RetResult, ResultLazy, Convert, Converted))). % placeholder @@ -1717,26 +3014,26 @@ % 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_lls((f2p(HeadIs,Result,Convert, Converted))). +f2p(HeadIs, LazyVars, RetResult, ResultLazy, is(Convert),(Converted,is(RetResult,Result))):- !, + 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,RetResult,or(AsPredI,Convert), (AsPredO *-> true; Converted)) :- fail, !, - must_det_lls((f2p(HeadIs,RetResult,AsPredI, AsPredO), - f2p(HeadIs,RetResult,Convert, Converted))). - -f2p(HeadIs,RetResult,(AsPredI; Convert), (AsPredO; Converted)) :- !, - must_det_lls((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_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_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_lls((f2p(HeadIs,RetResult,AsPredI, AsPredO), - f2p(HeadIs,RetResult,Convert, Converted))),!. + 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,RetResult,(AsPredI, Convert), (AsPredO, Converted)) :- !, - must_det_lls((f2p(HeadIs,_RtResult,AsPredI, AsPredO), - f2p(HeadIs,RetResult,Convert, Converted))). +f2p(HeadIs, LazyVars, RetResult, ResultLazy, (AsPredI, Convert), (AsPredO, Converted)) :- !, + 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. f2p(_HeadIs,RetResult, Convert, Converted) :- Convert =(H:-B),!, @@ -1752,7 +3049,7 @@ f2p(HeadIs,RetResult,Convert, Converted) :- fail, is_list(Convert), once((sexpr_s2p(Convert,IS), \+ IS=@=Convert)), !, % Check if Convert is a list and not in predicate form - must_det_lls((f2p(HeadIs,RetResult, 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,RetResult, ConvertL, Converted) :- fail, is_list(ConvertL),