diff --git a/prolog/metta_lang/metta_eval.pl b/prolog/metta_lang/metta_eval.pl index f34644a424..de8842695f 100755 --- a/prolog/metta_lang/metta_eval.pl +++ b/prolog/metta_lang/metta_eval.pl @@ -169,19 +169,8 @@ eval_true(X):- eval_args(X,Y), once(var(Y) ; \+ is_False(Y)). eval(Depth,Self,X,Y):- eval('=',_,Depth,Self,X,Y). -eval(Eq,RetType,Depth,Self,X,O):- - eval_reducable(Eq,RetType,Depth,Self,X,eval_args(Eq,RetType,Depth,Self,X,Y),Y,O). - - -eval_reducable(Eq,RetType,Depth,Self,X,G,Y,O):- catch_metta_return(G,Y), return_x_g_y(Eq,RetType,Depth,Self,X,X,Y,O). - -return_x_g_y(_Eq,_RetType,_Depth,_Self,X,_,Y,R):- Y == 'NotReducable',!,R=X. -return_x_g_y(Eq,RetType,Depth, Self,X,M,Y,R):- M\=@=Y, !, eval_args(Eq,RetType,Depth,Self,Y,Z), return_x_g_y(Eq,RetType,Depth,Self,X,Y,Z,R). -return_x_g_y(_Eq,_RetType,_Depth,_Self,_X,_M,R,R). - -catch_metta_return(G,Y):- - catch(G,metta_return(Y),ignore(retract(thrown_metta_return(Y)))). - +eval(Eq,RetType,Depth,Self,X,Y):- + catch_metta_return(eval_args(Eq,RetType,Depth,Self,X,Y),Y). %:- set_prolog_flag(gc,false). /* @@ -238,7 +227,8 @@ eval_ret(Eq,RetType,Depth,Self,X,Y):- eval_00(Eq,RetType,Depth,Self,X,Y), is_returned(Y). - +catch_metta_return(G,Y):- + catch(G,metta_return(Y),ignore(retract(thrown_metta_return(Y)))). allow_repeats_eval_(_):- !. allow_repeats_eval_(_):- option_value(no_repeats,false),!. @@ -253,7 +243,7 @@ eval_00(Eq,RetType,Depth,Self,X,YO):- eval_01(Eq,RetType,Depth,Self,X,YO). eval_01(Eq,RetType,Depth,Self,X,YO):- - % X\==[empty], % speed up n-queens x60 but breaks other things + X\==[empty], % speed up n-queens x60 if_t((Depth<1, trace_on_overflow), debug(metta(eval_args))), notrace((Depth2 is Depth-1, copy_term(X, XX))), @@ -263,7 +253,7 @@ ;eval_01(Eq,RetType,Depth2,Self,M,Y)), eval_02(Eq,RetType,Depth2,Self,Y,YO))). -eval_02(Eq,RetType,Depth2,Self,Y,YO):- % Y\==[empty], % speed up n-queens x60 but breaks other things +eval_02(Eq,RetType,Depth2,Self,Y,YO):- Y\==[empty], % speed up n-queens x60 once(if_or_else((subst_args_here(Eq,RetType,Depth2,Self,Y,YO)), if_or_else((fail,finish_eval(Eq,RetType,Depth2,Self,Y,YO)), Y=YO))). @@ -278,8 +268,7 @@ % % 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):- - %subst_args(Eq,RetType,Depth2,Self,Y,YO), - Y =YO, + subst_args(Eq,RetType,Depth2,Self,Y,YO), notrace(if_t_else((wont_need_subst(Y),Y\=@=YO), (write_src_uo(needed_subst_args(Y,YO)),bt,sleep(1.0)), nop(write_src_uo(unneeded_subst_args(Y))))). @@ -1260,13 +1249,15 @@ eval_20(Eq,RetType,Depth,Self,['if',Cond,Then,Else],Res):- !, - (eval_args_true(Eq,'Bool',Depth,Self,Cond) - *-> eval_args(Eq,RetType,Depth,Self,Then,Res) + eval_args(Eq,'Bool',Depth,Self,Cond,TF), + (is_True(TF) + -> eval_args(Eq,RetType,Depth,Self,Then,Res) ; eval_args(Eq,RetType,Depth,Self,Else,Res)). eval_20(Eq,RetType,Depth,Self,['If',Cond,Then,Else],Res):- !, - (eval_args_true(Eq,'Bool',Depth,Self,Cond) - *-> eval_args(Eq,RetType,Depth,Self,Then,Res) + eval_args(Eq,'Bool',Depth,Self,Cond,TF), + (is_True(TF) + -> eval_args(Eq,RetType,Depth,Self,Then,Res) ; eval_args(Eq,RetType,Depth,Self,Else,Res)). eval_20(Eq,RetType,Depth,Self,['If',Cond,Then],Res):- !, @@ -1980,9 +1971,9 @@ (!,write_src(E),fail))),!. -%empty('Empty'). -%','(A,B,(AA,BB)):- eval_args(A,AA),eval_args(B,BB). -%':'(A,B,[':',A,B]). +empty('Empty'). +','(A,B,(AA,BB)):- eval_args(A,AA),eval_args(B,BB). +':'(A,B,[':',A,B]). '<'(A,B,TFO):- as_tf(A'(A,B,TFO):- as_tf(Atrue;S=[]. bagof_eval(_Eq,_RetType,_Dpth,_Slf,X,L):- self_eval(X),!,L=[X]. bagof_eval(_Eq,_RetType,_Dpth,_Slf,X,L):- typed_list(X,_Type,L),!. bagof_eval(Eq,RetType,Depth,Self,Funcall,L):- - bagof_ne(E,eval(Eq,RetType,Depth,Self,Funcall,E),L). + bagof_ne(E, + catch_metta_return(eval_args(Eq,RetType,Depth,Self,Funcall,E),E),L). setof_eval(Depth,Self,Funcall,L):- setof_eval('=',_RT,Depth,Self,Funcall,L). setof_eval(Eq,RetType,Depth,Self,Funcall,S):- findall_eval(Eq,RetType,Depth,Self,Funcall,L), @@ -2859,7 +2858,7 @@ ((eval_args(Eq,RetType,Depth,Self,Funcall,E)) *-> is_returned(E);(fail,E=Funcall)). -is_returned(E):- notrace( \+ is_empty(E)), nop(assertion(E \== 'NotReducable')). +is_returned(E):- notrace( \+ is_empty(E)). is_empty(E):- notrace(( nonvar(E), sub_var('Empty',E))),!.