diff --git a/prolog/metta_lang/metta_eval.pl b/prolog/metta_lang/metta_eval.pl index cabc3ce611..8962a1c57d 100755 --- a/prolog/metta_lang/metta_eval.pl +++ b/prolog/metta_lang/metta_eval.pl @@ -94,7 +94,7 @@ coerce('Bool',Value,Result):- Value=0, !, Result='False'. coerce('Bool',Value,Result):- Value='False', !, Result='False'. coerce('Bool',Value,Result):- is_list(Value), length(Value, 0), !, Result='False'. -coerce('Bool',Value,Result):- !, Result='True'. +coerce('Bool',_Valu,Result):- !, Result='True'. coerce('Number',Value,Result):- number(Value), !, Value=Result. coerce('Number',Value,Result):- string(Value), !, number_string(Result, Value). @@ -105,6 +105,12 @@ coerce('String', Value, Result):- string(Value), !, Value=Result. coerce('String', Value, Result):- term_string(Value,Result). +coerce(Type, Value, Result):- + (get_type(Value,ValuesType);ValuesType='Any'), + freeze(Nonvar,Nonvar='def-coerce'), + current_self(KB),metta_atom(KB,[Nonvar,ValuesType,Type,Function]),nonvar(Nonvar), + eval([Function,Value],Result),!. + set_list_value(Value,Result):- nb_setarg(1,Value,echo),nb_setarg(1,Value,[Result]). %is_self_eval_l_fa('S',1). % cheat to comment @@ -260,7 +266,7 @@ % % uncommented causes 7% failure but a 10x speedup % subst_args_here(Eq,RetType,Depth2,Self,Y,YO):- Y=YO. % % this next one at least causes no failures and 5x speedup -subst_args_here(Eq,RetType,Depth2,Self,Y,YO):- wont_need_subst(Y),!, Y=YO. +subst_args_here(_Eq,_RetType,_Depth2,_Self,Y,YO):- wont_need_subst(Y),!, Y=YO. subst_args_here(Eq,RetType,Depth2,Self,Y,YO):- subst_args(Eq,RetType,Depth2,Self,Y,YO), notrace(if_t_else((wont_need_subst(Y),Y\=@=YO), @@ -1120,12 +1126,13 @@ eval_20(_Eq,_RetType1,_Depth,_Self,['call!'|S], TF):- !, eval_call(S,TF). eval_20(_Eq,_RetType1,_Depth,_Self,['call-p!'|S], TF):- !, eval_call(S,TF). eval_20(_Eq,_RetType1,_Depth,_Self,['call-fn!'|S], R):- !, eval_call_fn(S,R). -eval_20(_Eq,_RetType1,_Depth,_Self,['call-fn-nth!',Nth,S], R):- +eval_20(_Eq,_RetType1,_Depth,_Self,['call-fn-nth!',Nth|S], R):- length(Left,Nth), append(Left,Right,S), append(Left,[R|Right],NewS),!, eval_call(NewS,_). + max_counting(F,Max):- flag(F,X,X+1), X true; (flag(F,_,10),!,fail). @@ -2228,19 +2235,27 @@ eval_70(Eq,RetType,Depth,Self,AEAdjusted,ResIn), check_returnval(Eq,RetType,ResOut). +eval_20(Eq,RetType,Depth,Self,PredDecl,Res):- + if_or_else(eval_30(Eq,RetType,Depth,Self,PredDecl,Res), + eval_31(Eq,RetType,Depth,Self,PredDecl,Res)). -eval_20(Eq,RetType,Depth,Self,X,Y):- +eval_31(Eq,RetType,Depth,Self,X,Y):- (eval_40(Eq,RetType,Depth,Self,X,M)*-> M=Y ; % finish_eval(Depth,Self,M,Y); (eval_failed(Depth,Self,X,Y)*->true;X=Y)). eval_40(Eq,RetType,Depth,Self,AEMore,ResOut):- eval_41(Eq,RetType,Depth,Self,AEMore,ResOut). eval_70(Eq,RetType,Depth,Self,PredDecl,Res):- - if_or_else(eval_maybe_python(Eq,RetType,Depth,Self,PredDecl,Res), - if_or_else(eval_maybe_host_predicate(Eq,RetType,Depth,Self,PredDecl,Res), - if_or_else(eval_maybe_host_function(Eq,RetType,Depth,Self,PredDecl,Res), + % if_or_else(eval_maybe_python(Eq,RetType,Depth,Self,PredDecl,Res), + % if_or_else(eval_maybe_host_predicate(Eq,RetType,Depth,Self,PredDecl,Res), + % if_or_else(eval_maybe_host_function(Eq,RetType,Depth,Self,PredDecl,Res), if_or_else(eval_maybe_defn(Eq,RetType,Depth,Self,PredDecl,Res), - eval_maybe_subst(Eq,RetType,Depth,Self,PredDecl,Res))))). + eval_maybe_subst(Eq,RetType,Depth,Self,PredDecl,Res)). + +eval_30(Eq,RetType,Depth,Self,PredDecl,Res):- + if_or_else(eval_maybe_python(Eq,RetType,Depth,Self,PredDecl,Res), + if_or_else(eval_maybe_host_predicate(Eq,RetType,Depth,Self,PredDecl,Res), + if_or_else(eval_maybe_host_function(Eq,RetType,Depth,Self,PredDecl,Res), fail))). eval_all_args:- true_flag. fail_missed_defn:- true_flag. @@ -2347,12 +2362,15 @@ %eval_80(_Eq,_RetType,_Dpth,_Slf,LESS,Res):- fake_notrace((once((eval_selfless(LESS,Res),fake_notrace(LESS\==Res))))),!. +is_host_predicate([AE|More],Pred,Len):- + is_system_pred(AE), + length(More,Len), + is_syspred(AE,Len,Pred), + \+ (atom(AE), atom_concat(_,'-fn',AE)). + % predicate inherited by system eval_maybe_host_predicate(Eq,RetType,_Depth,_Self,[AE|More],TF):- allow_host_functions, - once((is_system_pred(AE), - length(More,Len), - is_syspred(AE,Len,Pred))), - \+ (atom(AE), atom_concat(_,'-fn',AE)), + is_host_predicate([AE|More],Pred,_Len), %current_predicate(Pred/Len), %fake_notrace( \+ is_user_defined_goal(Self,[AE|More])),!, %adjust_args(Depth,Self,AE,More,Adjusted), @@ -2396,26 +2414,36 @@ s2ps(S,P):- S=='Nil',!,P=[]. s2ps(S,P):- \+ is_list(S),!,P=S. -s2ps([F|S],P):- atom(F),maplist(s2ps,S,SS),join_s2ps(F,SS,P),!. -s2ps([F|S],P):- is_list(F),maplist(s2ps,[F|S],SS),join_s2ps(call,SS,P),!. +s2ps([F|S],P):- atom(F),maplist(s2p1,S,SS),join_s2ps(F,SS,P),!. +s2ps([F|S],P):- is_list(F),maplist(s2p1,[F|S],SS),join_s2ps(call,SS,P),!. +%s2ps(S,P):- is_list(F),maplist(s2ps,[F|S],SS),join_s2ps(call,SS,P),!. s2ps(S,S):-!. + +s2p1(S,P):- S=='Nil',!,P=[]. +s2p1(S,P):- \+ is_list(S),!,P=S. +s2p1(['Cons',H,T],[HH|TT]):-!,s2p1(H,HH),s2p1(T,TT),!. +s2p1(S,S). + join_s2ps('Cons',[H,T],[H|T]):-!. join_s2ps(F,Args,P):-atom(F),P=..[F|Args]. eval_call(S,TF):- - s2ps(S,P), !, - fbug(eval_call(P,'$VAR'('TF'))),as_tf(P,TF). + s2ps(S,P), !, fbug(eval_call(P,'$VAR'('TF'))), + as_tf_tracabe(P,TF). eval_call_fn(S,R):- - s2ps(S,P), !, - fbug(eval_call_fn(P,'$VAR'('R'))),as_tf(call(P,R),TF),TF\=='False'. + s2ps(S,P), !, fbug(eval_call_fn(P,'$VAR'('R'))), + as_tf_tracabe(call(P,R),TF),TF\=='False'. -% function inherited from system -eval_maybe_host_function(Eq,RetType,_Depth,_Self,[AE|More],Res):- allow_host_functions, +is_host_function([AE|More],Pred,Len):- is_system_pred(AE), length([AE|More],Len), is_syspred(AE,Len,Pred), - \+ (symbol(AE), symbol_concat(_,'-p',AE)), % thus maybe -fn or ! + \+ (symbol(AE), symbol_concat(_,'-p',AE)). % thus maybe -fn or ! + +% function inherited from system +eval_maybe_host_function(Eq,RetType,_Depth,_Self,[AE|More],Res):- allow_host_functions, + is_host_function([AE|More],Pred,_Len), % thus maybe -fn or ! %fake_notrace( \+ is_user_defined_goal(Self,[AE|More])),!, %adjust_args(Depth,Self,AE,More,Adjusted),!, %Len1 is Len+1,