tests/direct_comp/important/task1_whole.metta still works

prolog/metta_lang/metta_compiler_lib.pl

@@ -1,6 +1,38 @@
 :- 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,A,Fn),current_predicate(Fn/A).
+
+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_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
 
 'mc_2__+'(A,B,R) :- number(A),number(B),!,plus(A,B,R).
@@ -42,7 +74,7 @@
 
 %%%%%%%%%%%%%%%%%%%%% lists
 
-'mc_1__car-atom'([H|_],H).
+'mc_1__car-atom'(Cons,H):- Cons = [H|_] -> true ; throw(metta_type_error).
 
 'mc_1__cdr-atom'([_|T],T).
 
@@ -55,11 +87,15 @@
 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) :- !,
+    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(Code2,R2),R) :- 'mc_2__subtraction'(U1,is_p1(Code2,R2),R) ; call(Code2),R=R2.
 
 %%%%%%%%%%%%%%%%%%%%% superpose, collapse
@@ -68,6 +104,8 @@
 
 % 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(Code,Ret),R) :- fullvar(Ret),!,findall(Ret,Code,R).
 'mc_1__collapse'(is_p1(true,X),[X]).
 
@@ -81,16 +119,34 @@
 
 % 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).
 
+
+% 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
 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).
 
+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) :-
+    (unify_pattern(Space,Pattern)->call(SuccessCode);call(FailureCode)).
+
+% unify calls pattern matching if arg1 is a space
+unify_pattern(Space,Pattern):- is_metta_space(Space),!, match_pattern(Space, Pattern).
+% otherwise calls prolog unification (with occurs check later)
+unify_pattern(Atom, Pattern):- metta_unify(Atom, Pattern).
+
+metta_unify(Atom, Pattern):- Atom=Pattern.
+
 %%%%%%%%%%%%%%%%%%%%% 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(_Type,_Src,Code,Ret),Ret) :- wtime_eval(Code).
 'mc_1__time'(is_p1(Code,Ret),Ret) :- wtime_eval(Code).
 
 'mc_0__empty'(_) :- fail.