closer to original .. still 74_0 69_7

Author: TeamSPoon

prolog/metta_lang/metta_compiler.pl

@@ -74,8 +74,12 @@
 :- ensure_loaded(metta_space).
 :- ensure_loaded(metta_compiler_print).
 :- dynamic(transpiler_clause_store/9).
+:- multifile(transpiler_predicate_store/7).
 :- dynamic(transpiler_predicate_store/7).
+:- dynamic(transpiler_predicate_nary_store/9).
+:- discontiguous transpiler_predicate_nary_store/9.
 :- discontiguous(compile_flow_control/8).
+:- multifile(compile_flow_control/8).
 :- ensure_loaded(metta_compiler_lib).
 :- ensure_loaded(metta_compiler_lib_stdlib).
 
@@ -212,6 +216,7 @@
 as_p1_exec(ispeEnNC(ERet,ECode,_,_,CCode),ERet) :- !, call(CCode),call(ECode).
 as_p1_exec(X,X) :- !.
 
+
 as_p1_expr(ispu(URet),URet) :- !.
 as_p1_expr(ispuU(URet,UCode),URet) :- !, call(UCode).
 as_p1_expr(ispeEn(_,_,NRet),NRet).
@@ -240,6 +245,92 @@
    partial_combine_lists(L1,L2,Lcomb,L1a,L2a).
 partial_combine_lists(L1,L2,[],L1,L2).
 
+is_proper_arg(O):- compound(O),iz_conz(O), \+ is_list(O),!,bt, trace.
+is_proper_arg(_).
+% This hook is called when an attributed var is unified
+proper_list_attr:attr_unify_hook(_, Value) :- \+ compound(Value),!.
+proper_list_attr:attr_unify_hook(_, Value) :- is_list(Value),!.
+proper_list_attr:attr_unify_hook(_, Value) :- iz_conz(Value),!,trace.
+proper_list_attr:attr_unify_hook(_, _Value).
+% Attach the attribute if not already present and not already a proper list
+ensure_proper_list_var(Var) :- var(Var),!, put_attr(Var, proper_list_attr, is_proper_arg).
+ensure_proper_list_var(Var) :- is_proper_arg(Var),!.
+
+
+eval_at(_Fn,Where):- nb_current('eval_in_only',NonNil),NonNil\==[],!,Where=NonNil.
+eval_at( Fn,Where):- use_evaluator(fa(Fn, _), Only, only),!,Only=Where.
+eval_at(_Fn,Where):- option_value(compile,false),!,Where=interp.
+eval_at( Fn,Where):- use_evaluator(fa(Fn, _), Where, enabled),!.
+eval_at( Fn,Where):- nb_current(disable_compiler,WasDC),member(Fn,WasDC), Where==compiler,!,fail.
+eval_at( Fn,Where):- nb_current(disable_interp,WasDC),member(Fn,WasDC), Where==interp,!,fail.
+eval_at(_Fn,Where):- option_value(compile,full),!,Where=compiler.
+eval_at(_Fn, _Any):- !.
+
+must_use_interp(Fn, only_interp(Fn), true):- use_evaluator(fa(Fn, _), interp, only).
+must_use_interp(_ , eval_in_only(compiler), never):- nb_current('eval_in_only',compiler).
+must_use_interp(_ , eval_in_only(interp), true):- nb_current('eval_in_only',interp).
+must_use_interp(Fn, disable_compiler(Fn), true):- nb_current(disable_compiler,WasDC), member(Fn,WasDC).
+must_use_interp(Fn,compiler_disabled(Fn), true):- use_evaluator(fa(Fn, _), compiler, disabled).
+must_use_interp(Fn,unknown(Fn), unknown).
+
+must_use_compiler(_ ,eval_in_only(compiler)):- nb_current('eval_in_only',compiler).
+must_use_compiler(_ ,eval_in_only(interp)):- nb_current('eval_in_only',interp), fail.
+must_use_compiler(Fn,only_compiler(Fn)):- use_evaluator(fa(Fn, _), compiler, only).
+must_use_compiler(Fn,disable_interp(Fn)):- nb_current(disable_interp,WasDC), member(Fn,WasDC).
+must_use_compiler(Fn,interp_disabled(Fn)):- use_evaluator(fa(Fn, _), interp, disabled).
+
+% Compiler is Disabled for Fn
+ci(PreInterp,Fn,Len,Eval,RetVal,_PreComp,_Compiled):- fail,
+    once(must_use_interp(Fn,Why,TF)),
+    TF \== unknown, TF \== never,
+    debug_info(must_use_interp,why(Why,Fn=TF)),
+    TF == true, !,
+
+    % \+ nb_current(disable_interp,WasDI),member(Fn,WasDI),
+    call(PreInterp),
+    maplist(lazy_eval_to_src,Eval,Src),
+    if_t(Eval\=@=Src,
+       debug_info(lazy_eval_to_src,ci(Fn,Len,Eval,RetVal))),
+    %eval_fn_disable(Fn,disable_compiler,interp,((call(PreComp),call(Compiled)))),
+    debug_info(Why,eval_args(Src,RetVal)),!,
+    eval_args(Src,RetVal).
+
+ci(_PreInterp,Fn,Len,_Eval,_RetVal,PreComp,Compiled):-
+    %(nb_current(disable_interp,WasDI),member(Fn,WasDI);
+    %\+ nb_current(disable_compiler,WasDC),member(Fn,WasDC)),!,
+    %\+ \+ (maplist(lazy_eval_to_src,Eval,Src),
+    %       if_t(Eval\=@=Src, debug_info(lazy_eval_to_src,ci(Fn,Len,Eval,RetVal)))),
+    if_t(false,debug_info(call_in_only_compiler,ci(Fn,Len,Compiled))),!,
+    % eval_fn_disable(Fn,disable_compiler,eval_args(EvalM,Ret))
+    %show_eval_into_src(PreInterp,Eval,_EvalM),
+    (call(PreComp),call(Compiled)),
+    %eval_fn_disable(Fn,disable_compiler,(call(PreComp),call(Compiled))),
+    true.
+
+eval_fn_disable(Fn,DisableCompiler,Call):-
+   (nb_current(DisableCompiler,Was)->true;Was=[]),
+   (New = [Fn|Was]),
+   Setup = nb_setval(DisableCompiler,New),
+   Restore = nb_setval(DisableCompiler,Was),
+   redo_call_cleanup(Setup,Call,Restore).
+
+
+lazy_eval_to_src(A,O):- nonvar(O),trace,A=O.
+%lazy_eval_to_src(A,O):- var(A),!,O=A,ensure_proper_list_var(A).
+lazy_eval_to_src(A,O):- \+ compound(A),!,O=A.
+%lazy_eval_to_src(A,P):- is_list(A), maplist(lazy_eval_to_src,A,P),!.
+lazy_eval_to_src(A,P):- [H|T] = A, lazy_eval_to_src(H,HH),lazy_eval_to_src(T,TT),!,P= [HH|TT].
+lazy_eval_to_src(A,P):- as_p1_expr(A,P),!.
+
+delistify(L,D):- is_list(L),L=[D],!.
+delistify(L,L).
+
+create_prefixed_name(Prefix,LenArgs,FnName,String) :-
+   %(sub_string(FnName, 0, _, _, "f") -> break ; true),
+   length(LenArgs,L),
+   append([Prefix,L|LenArgs],[FnName],Parts),
+   atomic_list_concat(Parts,'_',String).
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %%%%%%%%%%%%%%%%% Evaluation (!)
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -352,7 +443,7 @@
    invert_curried_structure(F,LenArgs,ArgsFirst,Result).
 
 
-recompile_from_depends(FnName,LenArgs) :- skip_redef_fa(FnName,LenArgs),!,debug_info(recompile_from_depends,skip_redef_fa(FnName,LenArgs)),!.
+recompile_from_depends(FnName,LenArgs) :- skip_redef_fa(FnName,LenArgs),!,debug_info(recompile_code_from_depends,skip_redef_fa(FnName,LenArgs)),!.
 recompile_from_depends(FnName,LenArgs) :-
    transpiler_debug(2,(format_e("recompile_from_depends ~w/~w\n",[FnName,LenArgs]))),
    %LenArgs is LenArgsPlus1-1,
@@ -768,6 +859,11 @@
 f2p(HeadIs, LazyVars, RetResult, RetResultN, ResultLazy, T, Converted, ConvertedN) :- compound(T),T=exec(X),!,
    f2p(HeadIs, LazyVars, RetResult, RetResultN, ResultLazy, [eval,X], Converted, ConvertedN).
 
+f2p(HeadIs, LazyVars, RetResult, RetResultN, ResultLazy, Convert, Converted, ConvertedN) :- fail,
+   atom(Convert), nb_bound(Convert,_),!, % TODO might need to look this up at evaluation time instead
+   atom_string(Convert,SConvert),
+   f2p(HeadIs, LazyVars, RetResult, RetResultN, ResultLazy, ['eval-string',SConvert], Converted, ConvertedN),!.
+
 f2p(HeadIs, LazyVars, RetResult, RetResultN, ResultLazy, Convert, Converted, ConvertedN) :-
    nb_bound(Convert,X),!, % TODO might need to look this up at evaluation time instead
    f2p(HeadIs, LazyVars, RetResult, RetResultN, ResultLazy, X, Converted, ConvertedN).
@@ -817,7 +913,8 @@
 
 % 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
+    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=[ispu,Convert]),
     Converted=[[assign,RetResult,C2]],
     % For OVER-REACHING categorization of dataobjs %
@@ -1719,6 +1816,7 @@
 %must_det_lls(G):- rtrace(G),!.
 %user:numbervars(Term):- varnumbers:numbervars(Term).
 
+must_det_lls(G):- is_nodebug,!,call(G). % is_mettalog_rt or is_user_repl
 must_det_lls(G):- tracing,!,call(G). % already tracing
 must_det_lls((A,B)):- !, must_det_lls(A),must_det_lls(B).
 %must_det_lls(G):- call(G). % already tracing
@@ -1730,6 +1828,7 @@
 must_det_lls(G):- ignore((notrace,nortrace,trace_break(must_det_lls(G)))),rtrace(G),!.
 
 extract_constraints(V,VS):- var(V),get_attr(V,cns,_Self=Set),!,extract_constraints(_Name,Set,VS),!.
+extract_constraints(V,VS):- var(V),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,_),
@@ -2104,15 +2203,15 @@
 remove_stub(Space,Fn,Arity):- retract(transpiler_stub_created(Space,Fn,Arity)),!,
   transpile_impl_prefix(Fn,Arity,IFn),abolish(IFn/Arity),!.
 
-% !(compiled-info! cdr-atom)
-transpiler_predicate_store(builtin, 'compiled-info', [1], [], '', [x(doeval,eager,[])], x(doeval,eager,[])).
-'mc__1_1_compiled-info'(S,RetVal):-
+% !(listing!! cdr-atom)
+transpiler_predicate_store(builtin, 'listing!', [1], [], '', [x(doeval,eager,[])], x(doeval,eager,[])).
+'mc__1_1_listing!'(S,RetVal):-
   find_compiled_refs(S, Refs),
-  print_refs(Refs),!,
+  locally(nb_setval(focal_symbol,S),print_refs(Refs)),!,
   length(Refs,RetVal).
 
 'compiled_info'(S):-
-  'mc__1_1_compiled-info'(S,_RetVal).
+  'mc__1_1_listing!'(S,_RetVal).
 
 print_refs(Refs):- is_list(Refs),!,maplist(print_refs,Refs).
 print_refs(Refs):- atomic(Refs),clause(M:H,B,Refs),!,print_itree(((M:H):-B)).
@@ -2125,8 +2224,13 @@
 
 nl_print_tree(PT):-
   stream_property(Err, file_no(2)),
-  with_output_to(Err,(format('~N'),ppt(PT),format('~N'))).
+  mesg_color(PT, Color),
+  maybe_subcolor(PT,CPT),
+  with_output_to(Err,(format('~N'),ansicall(Color,ppt(CPT)),format('~N'))).
 
+maybe_subcolor(PT,CPT):- fail, nb_current(focal_symbol,S), mesg_color(PT, Color), wots(Str,ansicall(Color,ppt1(S))),
+   subst001(PT,S,Str,CPT),!.
+maybe_subcolor(PT,PT).
 
 find_compiled_refs(S, Refs):-
    atom_concat('_',S,Dashed),
@@ -2144,9 +2248,17 @@
     \+ \+ predicate_property(M:P,_), \+ predicate_property(M:P,imported_from(_)),
     clause(M:P,_,Ref)),Refs).
 
-compiled_refs(Symbol,F,A,Info):- functor(P,F,A),clause(P,B,Ref),call(B), \+ \+ (arg(_,P,S),S==Symbol),
+compiled_refs(Symbol,F,A,Info):- functor(P,F,A),clause(P,B,Ref), (\+ compiler_data_no_call(F/A) -> call(B)), symbol_in(2,Symbol,P),
    (B==true->Info=Ref;Info=P).
 
+
+symbol_in(_, Symbol, P):-Symbol=@=P,!.
+symbol_in(N, Symbol, P):- N>0, compound(P), N2 is N-1, symbol_in_sub(N2, Symbol, P).
+symbol_in_sub(N, Symbol, P):- is_list(P),P=[S1,S2,_|_],!,symbol_in_sub(N, Symbol, [S1,S2]).
+symbol_in_sub(N, Symbol, P):- is_list(P),!,member(S,P),symbol_in(N, Symbol, S).
+symbol_in_sub(N, Symbol, P):- arg(_,P,S),symbol_in(N, Symbol, S).
+
+
 compiler_data(metta_compiled_predicate/3).
 compiler_data(is_transpile_call_prefix/3).
 compiler_data(is_transpile_impl_prefix/3).
@@ -2159,6 +2271,11 @@
 compiler_data(metta_atom/2).
 compiler_data(metta_type/3).
 compiler_data(metta_defn/3).
+compiler_data(eval_20/6).
+compiler_data_no_call(eval_20/6).
+
+%compiler_data(metta_atom_asserted/2).
+
 %compiler_data(metta_file_buffer/7).
 
 ensure_callee_site(Space,Fn,Arity):- check_supporting_predicates(Space,Fn/Arity),!.
@@ -2294,6 +2411,7 @@
 call_fr(G,Result,FA):- current_predicate(FA),!,call(G,Result).
 call_fr(G,Result,_):- Result=G.
 
+transpile_eval(Convert,Converted) :- nb_current('eval_in_only', interp),!, eval(Convert,Converted).
 transpile_eval(Convert,Converted) :-
   transpile_eval(Convert,Converted,PrologCode),!,
   call(PrologCode).
@@ -2305,13 +2423,15 @@
    %   PrologCode=PrologCode0,
    %   LiConverted=Converted0
    %;
-      f2p(null,[],Converted,_,LE,Convert,Code1,_),
+      metta_to_metta_body_macro_recurse('transpile_eval',Convert,ConvertMacr),
+      f2p(null,[],Converted,_,LE,ConvertMacr,Code1,_),
       lazy_impedance_match(LE,x(doeval,eager,_),Converted,Code1,Converted,Code1,LiConverted,Code),
       ast_to_prolog(no_caller,[],Code,PrologCode),
       compiler_assertz(transpiler_stored_eval(Convert,PrologCode,LiConverted))
    %)
    .
 
+transpile_eval_nocache(Convert,Converted,true) :- nb_current('eval_in_only', interp),!, eval(Convert,Converted).
 transpile_eval_nocache(Convert0,LiConverted,PrologCode) :-
    %leash(-all),trace,
    subst_varnames(Convert0,Convert),
@@ -4044,3 +4164,4 @@
 
 
 
+