diff --git a/prolog/metta_lang/metta_compiler_lib.pl b/prolog/metta_lang/metta_compiler_lib.pl index 9569d9476b..a20cc4e0e0 100644 --- a/prolog/metta_lang/metta_compiler_lib.pl +++ b/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.