merge

Author: Roy Ward

examples/games/GreedyChess.metta

@@ -344,19 +344,19 @@
 (rank p) 
 
 ; Chess symbols to display on console
-(s k ♔)
-(s q ♕)
-(s r ♖)
-(s b ♗)
-(s n ♘) 
-(s p ♙)
-
-(g k ♚)
-(g q ♛)
-(g r ♜) 
-(g b ♝)
-(g n ♞)
-(g p ♟)
+(g k ♔)
+(g q ♕)
+(g r ♖)
+(g b ♗)
+(g n ♘) 
+(g p ♙)
+
+(s k ♚)
+(s q ♛)
+(s r ♜) 
+(s b ♝)
+(s n ♞)
+(s p ♟)
 
 ;*******************************************************
 ; Declare initializing game state

prolog/metta_lang/metta_compiler.pl

@@ -405,7 +405,11 @@
 
 % !(compile-for-assert (plus1 $x) (+ 1 $x) )
 compile_for_assert(HeadIsIn, AsBodyFnIn, Converted) :-
-  compile_for_assert_3(HeadIsIn, AsBodyFnIn, Converted).
+  compile_for_assert_2(HeadIsIn, AsBodyFnIn, Converted).
+
+compile_for_assert_2(HeadIsIn, AsBodyFnIn, Converted) :-
+  metta_to_metta_macro(HeadIsIn, AsBodyFnIn, HeadIs, AsBodyFn),
+  compile_for_assert_3(HeadIs, AsBodyFn, Converted).
 
 compile_for_assert_3(HeadIsIn, AsBodyFnIn, Converted) :-
    %must_det_lls((
@@ -1244,7 +1248,7 @@
    %label_arg_types(F,0,[A|Args1]),
    %LenArgs1 is LenArgs+1,
    append(Args1,[A],Args2),
-   R ~.. [xxx(FIn),Fp|Args2],
+   R ~.. [f(FIn),Fp|Args2],
    (Caller=caller(CallerInt,CallerSz),(CallerInt-CallerSz)\=(F-LenArgs),\+ transpiler_depends_on(CallerInt,CallerSz,F,LenArgs) ->
       compiler_assertz(transpiler_depends_on(CallerInt,CallerSz,F,LenArgs)),
       transpiler_debug(2,format_e("Asserting: transpiler_depends_on(~q,~q,~q,~q)\n",[CallerInt,CallerSz,F,LenArgs]))
@@ -1279,7 +1283,7 @@
    create_mc_name(LenArgsAll,FIn,Fp),
    %label_arg_types(FIn,0,[A|Args1]),
    %LenArgs1 is LenArgs+1,
-   R0 ~.. [xxx(a),Fp|Args1],
+   R0 ~.. [xxx(4),Fp|Args1],
    %R1=R0),
    (Caller=caller(CallerInt,CallerSz),(CallerInt-CallerSz)\=(FIn-LenArgs),\+ transpiler_depends_on(CallerInt,CallerSz,FIn,LenArgs) ->
       compiler_assertz(transpiler_depends_on(CallerInt,CallerSz,FIn,LenArgs)),
@@ -1301,7 +1305,7 @@
    append(FixedPart,VariablePart,Args1),
    append(FixedPart,[VariablePart],Args1a),
    append(Args1a,[A],Args2),
-   R ~.. [xxx(c),Fp|Args2],
+   R ~.. [xxx(3),Fp|Args2],
    (Caller=caller(CallerInt,CallerSz),(CallerInt-CallerSz)\=(F-0),\+ transpiler_depends_on(CallerInt,CallerSz,F,0) ->
       compiler_assertz(transpiler_depends_on(CallerInt,CallerSz,F,0)),
       transpiler_debug(2,format_e("Asserting: transpiler_depends_on(~q,~q,~q,~q)\n",[CallerInt,CallerSz,F,0]))
@@ -1313,7 +1317,7 @@
 %   label_arg_types(F,1,Args0),
 %   maplist(ast_to_prolog_aux(Caller,DontStub),Args0,Args1),
 %   label_arg_types(F,1,Args1),
-%   A ~.. [xxx(d),F|Args1],
+%   A ~.. [xxx(2),F|Args1],
 %   notice_callee(Caller,A))).
 %ast_to_prolog_aux(Caller,DontStub,[assign,A,[call(FIn)|ArgsIn]],R) :- (fullvar(A); \+ compound(A)),callable(FIn),!,
 % must_det_lls((
@@ -1597,9 +1601,18 @@
 cmpd4lst(A,_):- nonvar(A),dmp_break,fail.
 cmpd4lst(_A,[Cmpd,_F|_Args]):- \+ compound(Cmpd),dmp_break,fail.
 cmpd4lst(_A,[_Cmpd,_F|Args]):- \+ is_list(Args),dmp_break,fail.
-cmpd4lst(A,[_Cmpd,F,Arg]):- F==is_True,!,A=is_True(Arg),!.
-cmpd4lst(call_fn_native(F,XXX,Args),[Cmpd,F|Args]):- compound(Cmpd),xxx(XXX)=Cmpd,!.
-cmpd4lst(call_fn_native(F,xxx(?),Args),[F|Args]):- !.
+%cmpd4lst(A,[_Cmpd,F|Args]):- atom(F),is_cmp_builtin(F),A=..[F|Args],!.
+%cmpd4lst(call_fn_native(F,XXX,Args),[Cmpd,F|Args]):- compound(Cmpd),f(XXX)=Cmpd,!.
+cmpd4lst(A,[_Cmpd,F|Args]):- atom(F),!,A=..[F|Args],!.
+cmpd4lst(call_fn_native_error(F,xxx(?),Args),[F|Args]):- !.
+
+is_cmp_builtin(is_True).
+is_cmp_builtin(as_p1_expr).
+is_cmp_builtin(as_p1_exec).
+is_cmp_builtin(ispeEnN).
+is_cmp_builtin(call_fn_native).
+
+
 /*
 cmpd4lst2(A,Info):- compound(A), A=call_fn_native(F,XXX,Args),!,cmpd4lst(F,XXX,Args,Info).
 cmpd4lst2(A,Info):- compound(A), compound_name_arguments(A,F,Args),!,cmpd4lst(F,xxx(?),Args,Info).
@@ -2940,6 +2953,7 @@
    ;
       (AsPred = [F|ArgsL])).
 
+as_functor_args(call_fn_native(F,_,ArgsL),F,A,ArgsL):- length(ArgsL,A),!.
 %as_functor_args(AsPred,_,_,_Args):- is_ftVar(AsPred),!,fail.
 as_functor_args(AsPred,F,A,ArgsL):- \+ iz_conz(AsPred),
   AsPred @.. List,!, as_functor_args(List,F,A,ArgsL),!.

prolog/metta_lang/metta_compiler_lib.pl

@@ -1,6 +1,7 @@
 :- dynamic(transpiler_predicate_store/7).
 :- discontiguous transpiler_predicate_store/7.
 :- discontiguous transpiler_predicate_nary_store/9.
+:- discontiguous compile_flow_control/8.
 
 from_prolog_args(_,X,X).
 :-dynamic(pred_uses_fallback/2).
@@ -243,6 +244,12 @@
 transpiler_predicate_store(builtin, 'decons-atom', [1], '@doc', '@doc', [x(noeval,eager,[list])], x(noeval,eager,[list])).
 'mc__1_1_decons-atom'([A|B],[A,B]).
 
+%transpiler_predicate_store(builtin, 'length', [1], '@doc', '@doc', [x(noeval,eager,[list])], x(noeval,eager,[number])).
+%'mc__1_1_length'(L,S) :- length(L,S).
+
+transpiler_predicate_store(builtin, 'size-atom', [1], '@doc', '@doc', [x(noeval,eager,[list])], x(noeval,eager,[number])).
+'mc__1_1_size-atom'(L,S) :- length(L,S).
+
 %%%%%%%%%%%%%%%%%%%%% set
 
 lazy_member(P,R2) :- as_p1_exec(R2,P).
@@ -315,11 +322,11 @@
 % This allows match to supply hits to the correct metta_atom/2 (Rather than sending a variable
 match_pattern(Space, Pattern):-
     if_t(compound(Pattern),
-       (functor(Pattern,F,A,Type), functor(Atom,F,A,Type))),    
-    metta_atom(Space, Atom), 
+       (functor(Pattern,F,A,Type), functor(Atom,F,A,Type))),
+    metta_atom(Space, Atom),
     %unify_with_occurs_check(Atom,Pattern). % 0.262 secs.
     Atom=Pattern. % 0.170 secs
-    %wocf(Atom=Pattern). 
+    %wocf(Atom=Pattern).
     %woc(Atom=Pattern). %  2.09 seconds.
 
 transpiler_predicate_store(builtin, match, [3], '@doc', '@doc', [x(doeval,eager,[]), x(noeval,eager,[]), x(doeval,lazy,[])], x(doeval,eager,[])).
@@ -351,9 +358,12 @@
 transpiler_predicate_nary_store(builtin, progn, 0, [], 'Atom', 'Atom', [], x(doeval,eager,[]), x(doeval,eager,[])).
 'mc_n_0__progn'(List,Ret) :- append(_,[Ret],List).
 
-transpiler_predicate_nary_store(builtin, 'call-fn!', 1, ['Atom'], 'Atom', 'Atom', [x(doeval,eager,[])], x(doeval,eager,[]), x(doeval,eager,[])).
+transpiler_predicate_nary_store(builtin, 'call-fn!', 1, ['Atom'], 'Atom', 'Atom', [x(noeval,eager,[])], x(noeval,eager,[]), x(doeval,eager,[])).
 'mc_n_1__call-fn!'(Fn,List,Ret) :- append(List,[Ret],List2),apply(Fn,List2).
 
+transpiler_predicate_nary_store(builtin, 'call-fn', 1, ['Atom'], 'Atom', 'Atom', [x(doeval,eager,[])], x(doeval,eager,[]), x(doeval,eager,[])).
+'mc_n_1__call-fn'(Fn,List,Ret) :- append(List,[Ret],List2),apply(Fn,List2).
+
 transpiler_predicate_nary_store(builtin, 'call-p!', 1, ['Atom'], 'Atom', 'Atom', [x(doeval,eager,[])], x(doeval,eager,[]), x(doeval,eager,[])).
 'mc_n_1__call-p!'(Fn,List,Ret) :- (apply(Fn,List)->Ret='True';Ret='False').
 
@@ -540,4 +550,52 @@
   predsort(listing_order,Unsorted,Sorted).
 
 
+metta_to_metta_macro(HeadIsN, AsBodyFnN, HeadIsC, AsBodyFnOut):-
+ must_det_lls((
+ copy_term(AsBodyFnN+HeadIsN,AsBodyFnC+HeadIsC,_),
+ number_vars_wo_conficts(AsBodyFnC+HeadIsC,AsBodyFn+HeadIs),
+ (AsBodyFnC+HeadIsC=AsBodyFn+HeadIs),
+    metta_body_macro(HeadIs, AsBodyFn, AsBodyFnOut),!,
+    \+ \+ if_t(AsBodyFn\=@=AsBodyFnOut,
+    ( debug_info(metta_macro_in,c(print_tree([=,HeadIs, AsBodyFn]))),!,
+      debug_info(metta_macro_out,c(print_tree([=,HeadIs, AsBodyFnOut]))))))),!.
+
+metta_body_macro(HeadIs, AsBodyFn, AsBodyFnOut):-
+   must_det_lls((metta_body_macro1(HeadIs, [], AsBodyFn, AsBodyFnE),
+    metta_body_macro2(HeadIs, [], AsBodyFnE, AsBodyFnMid),
+   (AsBodyFn =@= AsBodyFnMid -> AsBodyFnMid = AsBodyFnOut ;
+     metta_body_macro(HeadIs, AsBodyFnMid, AsBodyFnOut)))).
+
+metta_body_macro1(_HeadIs, _, AsBodyFn, AsBodyFn):- \+ compound(AsBodyFn), !.
+metta_body_macro1(_HeadIs, _, AsBodyFn, AsBodyFn):- \+ is_list(AsBodyFn), !.
+metta_body_macro1(HeadIs, Stack, [Op|AsBodyFn], AsBodyFnOut):- fail, \+ is_funcall_op(Op),  !, maplist(metta_body_macro1(HeadIs, Stack), [Op|AsBodyFn], AsBodyFnOut),!.
+metta_body_macro1(HeadIs, Stack, [Op|AsBodyFn], AsBodyFnOut):-
+   maplist(metta_body_macro1(HeadIs, [Op|Stack]), AsBodyFn, AsBodyFnMid),
+   [Op|AsBodyFnMid]=OpAsBodyMid,
+   copy_term(OpAsBodyMid,OpAsBodyMidCopy),
+   metta_body_macro_final1(HeadIs, Stack, OpAsBodyMid , AsBodyFnOut),
+   OpAsBodyMid=@=OpAsBodyMidCopy,!.
+
+metta_body_macro_final1(_HeadIs,_Stack, [NonOp|More], AsBodyFn):- \+ atom(NonOp),!,[NonOp|More]= AsBodyFn.
+metta_body_macro_final1(_HeadIs,_Stack, ['if-unify',Var1,Var2|Rest], [if,['metta-unify',Var1,Var2]|Rest]).
+metta_body_macro_final1(_HeadIs,_Stack, ['if-equal',Var1,Var2|Rest], [if,['metta-equal',Var1,Var2]|Rest]).
+metta_body_macro_final1(_HeadIs,_Stack, ['if-decons-expr',Expr,Head,Tail|Rest],[if,['decons-ht',Expr,Head,Tail]|Rest]).
+metta_body_macro_final1(_HeadIs,_Stack, ['if-decons',Expr,Head,Tail|Rest],[if,['decons-ht',Expr,Head,Tail]|Rest]).
+metta_body_macro_final1(_HeadIs,_Stack, ['chain',[Ceval,Eval],Var|Rest], ['let',Var,Eval|Rest]):- Ceval == eval,!.
+metta_body_macro_final1(_HeadIs,_Stack, ['chain',Eval,Var|Rest], ['let',Var,Eval|Rest]).
+%metta_body_macro_final1(_HeadIs,_Stack, [eval,Next], Next).
+metta_body_macro_final1(_HeadIs,_Stack, AsBodyFnOut, AsBodyFnOut).
+
+metta_body_macro2(_HeadIs, _, AsBodyFn, AsBodyFn):- \+ compound(AsBodyFn), !.
+metta_body_macro2(_HeadIs, _, AsBodyFn, AsBodyFn):- \+ is_list(AsBodyFn), !.
+metta_body_macro2(HeadIs, Stack, OpAsBody, AsBodyFnOutReally):-
+   copy_term(OpAsBody,OpAsBodyMidCopy),
+   metta_body_macro_final2(HeadIs, Stack, OpAsBody , AsBodyFnOut),
+   OpAsBody=@=OpAsBodyMidCopy,!,
+   maplist( metta_body_macro2(HeadIs, Stack), AsBodyFnOut,AsBodyFnOutReally).
+
+metta_body_macro_final2(_HeadIs,_Stack, [NonOp|More], AsBodyFn):- \+ atom(NonOp),!,[NonOp|More]= AsBodyFn.
+metta_body_macro_final2(_HeadIs,_Stack, [eval,Next], Next).
+metta_body_macro_final2(_HeadIs,_Stack, AsBodyFnOut, AsBodyFnOut).
+
 

prolog/metta_lang/metta_debug.pl

@@ -837,23 +837,25 @@
   mesg_color(Topic, TopicColor),
   mesg_color(Info,  InfoColor),
   \+ \+ (( % numbervars(Info,4123,_,[attvar(bind)]),
-  number_vars_wo_conficts(Info,RNVInfo),
+  %number_vars_wo_conficts(Info,RNVInfo),
+  if_t(var(RNVInfo),Info=RNVInfo),
   format(X,'~N ~@: ~@ ~n~n',[ansicall(TopicColor,write(Topic)),ansicall(InfoColor,debug_pp_info(RNVInfo))]))).
 
 debug_pp_info(Info):- compound(Info), compound_name_arguments(Info,F,Args),!,debug_pp_cmpd(Info,F,Args).
 debug_pp_info(Info):-  write_src(Info).
+debug_pp_cmpd(_Info,'c',[Call]):- !, nl, write('  '), call(Call).
 debug_pp_cmpd(Info,':-',_):- !, nl, write('  '), debug_pp_tree(Info).
-debug_pp_cmpd(Info,'[|]',_):- !, write_src(Info).
-debug_pp_cmpd(Info,_,_Args):- debug_pp_term(Info).
-debug_pp_now(Info):- pp_as_src(Info),!,debug_pp_src(Info).
+debug_pp_cmpd(Info,'[|]',_):- !, write_src(Info),!.
+debug_pp_cmpd(Info,_,_Args):- debug_pp_term(Info),!.
+debug_pp_now(Info):- pp_as_src(Info),!,debug_pp_src(Info),!.
 debug_pp_now(Info):- debug_pp_src(Info),!.
 debug_pp_now(Info):- debug_pp_tree(Info),!.
 
 
 %debug_pp_tree(Info):- ignore(catch(notrace(write_src_wi(Info)),E,((writeq(Info),nl,nop(((display(E=Info),bt))))))),!.
- debug_pp_src(Info):- ignore(catch(notrace( write_src(Info)),_,((debug_pp_tree(Info))))).
-debug_pp_tree(Info):- ignore(catch(notrace(print_tree(Info)),_,((debug_pp_term(Info))))).
-debug_pp_term(Info):- ignore(catch(notrace(print(Info)),E,((writeq(Info),nl,nop(((display(E=Info),bt))))))).
+ debug_pp_src(Info):- ignore(catch(notrace( write_src(Info)),_,((nl,writeln(err),nl,debug_pp_tree(Info))))),!.
+debug_pp_tree(Info):- ignore(catch(notrace(print_tree(Info)),_,((nl,writeln(err),nl,debug_pp_term(Info))))),!.
+debug_pp_term(Info):- ignore(catch(notrace(print(Info)),E,((writeq(Info),nl,writeln(err),nl,nop(((display(E=Info),bt))))))),!.
 
 pp_as_src(Info):- compound(Info), arg(_,Info,E),is_list(E),E=[H|_],is_list(H),!.
 

prolog/metta_lang/metta_eval.pl

@@ -767,10 +767,13 @@
    eval_10(Eq,RetType,Depth,Space,Eval,Result)*->true;(Eval=Result).
 
 
-eval_20(Eq,RetType,Depth,Self,['eval',X],Res):- !,
+eval_20(Eq,RetType,Depth,Self,['capture',X],Res):- !,
    eval_args(Eq,RetType,Depth,Self,X, Res).
 
 
+eval_20(Eq,RetType,Depth,Self,['eval',X],Res):- !,
+   eval_args(Eq,RetType,Depth,Self,X, Res).
+
 eval_20(Eq,RetType,Depth,Self,['eval-for',Type,X],Res):- !,
     ignore(Type=RetType),
     eval_args(Eq,Type,Depth,Self,X, Res).
@@ -2904,8 +2907,23 @@
     ).
 
 
-variant_by_type(X,Y):- var(X),!,X==Y.
-variant_by_type(X,Y):- X=@=Y.
+%variant_by_type(X,Y):- var(X),!,X==Y.
+variant_by_type(X,Y):- var(X),!, matching_vn_relaxed(X,Y).
+%variant_by_type(X,Y):- X=@=Y.
+variant_by_type(X, Y) :-
+    copy_term(X+Y, X1+Y1, _Gs),
+    X1 =@= Y1, X1 = Y1,
+    term_variables(X, VX),
+    term_variables(Y, VY),
+    maplist(matching_vn_relaxed, VX, VY), !,
+    X1 = X, Y1 = Y.
+
+
+matching_vn_relaxed(V1, V2) :-
+    ( get_attr(V1, vn, VN1) ->
+        ( get_attr(V2, vn, VN2) -> (VN1 == VN2, V1 = V2) ; (V1=V2) )
+    ; V1 == V2 ).
+
 
 call_as_p2(P2,X,Y):-
    once(eval([P2,X,Y],TF)),
@@ -2917,7 +2935,7 @@
 
 eval_20(Eq,RetType,Depth,Self,['unique',Eval],RetVal):- !,
    term_variables(Eval+RetVal,Vars),
-   no_repeats_var(YY),
+   no_repeats_var(variant_by_type,YY),
    eval_args(Eq,RetType,Depth,Self,Eval,RetVal),YY=Vars.
 
 eval_20(Eq,RetType,Depth,Self,['unique-by',P2,Eval],RetVal):- !,
@@ -3183,8 +3201,11 @@
 transpiler_peek(Sym,Len,Type,Fn):-
   transpiler_predicate_store(_, Sym, Len, _, _, _, _),
   if_t(var(Type),member(Type,['mx','mi','mc'])),
-  format(atom(Fn),'~w_~w__~w',[Type,Len,Sym]),
-  succ(Len,LenP1), current_predicate(Fn/LenP1).
+  format(atom(Fn),'~w__1_~w_~w',[Type,Len,Sym]),
+  succ(Len,LenP1), current_predicate(Fn/LenP1),
+  \+ transpiler_predicate_store(_,Sym,[Len],_,_,_,_),
+  % \+ transpiler_predicate_store(_,Sym,[Len],_,_,_,_).
+  \+ transpiler_clause_store(Sym,[Len],_,_,_,_,_,_,_).
 
 eval_20(Eq, RetType, Depth, Self, [Sym | Args], Res) :- symbol(Sym), is_list(Args),
     length(Args, Len),

prolog/metta_lang/metta_interp.pl

@@ -4091,7 +4091,7 @@
     debug_info(assert_hooks,load_hook_not_ready(Load, Self, Fact)),
     %fail,
     !,
-    nop(woc(load_hook_compiler(Load, Self, Fact))).
+    woc(load_hook_compiler(Load, Self, Fact)).
 
 load_hook1(Load, Self, Fact) :-
     % Ensure the Metta compiler is ready for use.