From b7a8e8ff2a58f5346c23c29e5be9c7189e5b3280 Mon Sep 17 00:00:00 2001 From: Douglas R Miles Date: Mon, 12 Feb 2024 10:37:00 -0800 Subject: [PATCH] git checkout bb49b80c423ea93a9ccfd259d593d35690a8e0ef metta_vspace/pyswip/ -f --- metta_vspace/pyswip/flybase_learn.pl | 20 +- metta_vspace/pyswip/metta_compiler.pl | 591 +--- metta_vspace/pyswip/metta_convert.pl | 265 +- metta_vspace/pyswip/metta_data.pl | 4559 ++++++------------------- metta_vspace/pyswip/metta_eval.pl | 142 +- metta_vspace/pyswip/metta_interp.pl | 1085 +++--- metta_vspace/pyswip/metta_printer.pl | 297 +- metta_vspace/pyswip/metta_python.pl | 10 +- metta_vspace/pyswip/metta_server.pl | 4 +- metta_vspace/pyswip/metta_space.pl | 174 +- metta_vspace/pyswip/metta_testing.pl | 4 +- metta_vspace/pyswip/metta_types.pl | 123 +- metta_vspace/pyswip/metta_utils.pl | 6 +- metta_vspace/pyswip/swi_support.pl | 14 +- 14 files changed, 1996 insertions(+), 5298 deletions(-) diff --git a/metta_vspace/pyswip/flybase_learn.pl b/metta_vspace/pyswip/flybase_learn.pl index 4a74f282..8427c681 100755 --- a/metta_vspace/pyswip/flybase_learn.pl +++ b/metta_vspace/pyswip/flybase_learn.pl @@ -438,16 +438,16 @@ numbervars(P,14,_,[attvar(bind),singletons(true)]). -/* -pp_fb(P):- format("~N "), \+ \+ (numbervars_w_singles(P), pp_fb1(P)), format("~N "),flush_output. -pp_fb1(P):- pp_fb2(print_tree,P). -pp_fb1(P):- pp_fb2(pp_ilp,P). -pp_fb1(P):- pp_fb2(pp_as,P). -pp_fb1(P):- pp_fb2(print,P). -pp_fb1(P):- pp_fb2(print,P). -pp_fb1(P):- pp_fb2(fbdebug1,P). -pp_fb2(F,P):- current_predicate(F/1), call(F,P). -*/ + +pp_fb(P):- format("~N "), \+ \+ (numbervars_w_singles(P), pp_fb1(P)),flush_output. +pp_fb1(P):- write_src(P),!,nl. +:- if(current_predicate(pp_ilp/1)). +pp_fb1(P):- pp_as(P),!,format("~N"),pp_ilp(P),!. +:- endif. +pp_fb1(P):- pp_as(P),!. +pp_fb1(P):- print(P),!,nl. +pp_fb1(P):- fbdebug1(P),!,nl. + fbgn_exons2affy1_overlaps_each(Gene,At):- fb_pred_nr(fbgn_exons2affy1_overlaps, Arity), diff --git a/metta_vspace/pyswip/metta_compiler.pl b/metta_vspace/pyswip/metta_compiler.pl index 4d57da1f..30b7bb8a 100755 --- a/metta_vspace/pyswip/metta_compiler.pl +++ b/metta_vspace/pyswip/metta_compiler.pl @@ -19,10 +19,9 @@ :- ensure_loaded(metta_reader). :- ensure_loaded(metta_interp). :- ensure_loaded(metta_space). - % ======================================= % TODO move non flybase specific code between here and the compiler -%:- ensure_loaded(flybase_main). +:- ensure_loaded(flybase_main). % ======================================= %:- set_option_value(encoding,utf8). @@ -31,7 +30,6 @@ for_all(G1,G2):- forall(G1,G2). :- op(700,xfx,'=~'). -:- op(690,xfx, =~ ). compound_non_cons(B):- compound(B), \+ B = [_|_]. iz_conz(B):- compound(B), B=[_|_]. @@ -74,14 +72,14 @@ :- dynamic decl_functional_predicate_arg/3. % Converion is possible between a function and predicate is tricky -functional_predicate_arg_tricky(is, 2, 1). % E.g. eval_args(is(+(1,2)),Result) converts to is(Result,+(1,2)). +functional_predicate_arg_tricky(is, 2, 1). % E.g. eval(is(+(1,2)),Result) converts to is(Result,+(1,2)). % Defining standard mappings for some common functions/predicates decl_functional_predicate_arg(append, 3, 3). decl_functional_predicate_arg(+, 3, 3). decl_functional_predicate_arg(pi, 1, 1). decl_functional_predicate_arg('Empty', 1, 1). decl_functional_predicate_arg(call,4,4). -decl_functional_predicate_arg(eval_args, 2, 2). +decl_functional_predicate_arg(eval, 2, 2). decl_functional_predicate_arg(edge, 2, 2). decl_functional_predicate_arg('==', 2, 2). decl_functional_predicate_arg('is-same', 2, 2). @@ -91,8 +89,6 @@ decl_functional_predicate_arg(match,4,4). decl_functional_predicate_arg('TupleConcat',3,3). decl_functional_predicate_arg('new-space',1,1). -decl_functional_predicate_arg('exec0',1,1). -decl_functional_predicate_arg('exec1',1,1). decl_functional_predicate_arg(superpose, 2, 2). @@ -100,9 +96,7 @@ do_predicate_function_canonical(F,F). predicate_function_canonical(is_Empty,'Empty'). -pi(PI):- PI is pi. - -% Mapping any current predicate F/A to a function, if it is not tricky +% Mapping any current predicate F/A to a function, if it's not tricky functional_predicate_arg(F, A, L):- decl_functional_predicate_arg(F, A, L). functional_predicate_arg(F, A, L):- (atom(F)->true;trace), predicate_arity(F,A), \+ functional_predicate_arg_tricky(F,A,_), L=A, @@ -135,7 +129,7 @@ is_control_structure(F,A):- atom(F), atom_concat('if-',_,F),A>2. '=='(A, B, Res):- as_tf(equal_enough(A, B),Res). -'or'(G1,G2):- G1 *-> true ; G2. +'or'(G1,G2):- once((G1 ; G2)). 'or'(G1,G2,Res):- as_tf((G1 ; G2),Res). % Function without arguments can be converted directly. @@ -172,376 +166,154 @@ % Converted = (pi(_A), % +(_A, _A, _B), % _C is _B, -% eval_args(_C, RetResult)). +% eval(_C, RetResult)). % -functs_to_preds(I,OO):- - must_det_ll(functs_to_preds0(I,OO)),!. -functs_to_preds0([Eq,H,B],OO):- Eq == '=', compile_for_assert(H, B, OO),!. -functs_to_preds0(EqHB,OO):- compile_head_for_assert(EqHB,OO),!. +functs_to_preds([Eq,H,B],OO):- Eq == '=', compile_for_assert(H, B, OO),!. +functs_to_preds(EqHB,OO):- compile_head_for_assert(EqHB,OO),!. -functs_to_preds0(I,OO):- +functs_to_preds(I,OO):- sexpr_s2p(I, M), + /*trace,*/ f2p(_,_,M,O), expand_to_hb(O,H,B), - optimize_head_and_body(H,B,HH,BB),!, - OO = ':-'(HH,BB). + head_preconds_into_body(H,B,HH,BB), + OO = (HH:-BB). -% ?- compile_for_exec(RetResult, is(pi+pi), Converted). -compile_for_exec(Res,I,O):- - %ignore(Res='$VAR'('RetResult')), - compile_for_exec0(Res,I,O),!. - -compile_for_exec0(Res,I,eval_args(I,Res)):- is_ftVar(I),!. -compile_for_exec0(Res,(:- I),O):- !, compile_for_exec0(Res,I,O). - -compile_for_exec0(Res,I,BB):- - %ignore(Res='$VAR'('RetResult')), - compound_name_arguments(EXEC1, exec1, []), - f2p(EXEC1,Res,I,O), - optimize_head_and_body(exec1(Res),O,_,BB). +% ?- compile_for_exec(RetResult, is(pi+pi), Converted). +compile_for_exec(Res,I,BB):- + HeadIs = [exec], + AsBodyFn = I, + compile_for_assert(HeadIs, AsBodyFn, Converted), + (Converted = (exec(Res):- BB)),!, + (portray_clause((Converted))),!. -compile_for_exec0(Res,I,BB):- fail, - compound_name_arguments(EXEC0, exec0, []), - compile_for_assert(EXEC0, I, H:-BB), - arg(1,H,Res). +compile_for_exec(Res,I,BB):- + =(I, M), + f2p(exec(),_,(exec()=M),O), + expand_to_hb(O,H,B), + head_preconds_into_body(H,B,HH,BB), + ignore(exec(Res)=HH), + (portray_clause((exec2(Res):- BB))),!. -%compile_for_exec0(Res,I,O):- f2p(exec(),Res,I,O). +compile_for_exec(Res,I,O):- + =(I, M), f2p(exec(),Res,M,O), + (portray_clause((exec1(Res):- O))),!. % If Convert is of the form (AsFunction=AsBodyFn), we perform conversion to obtain the equivalent predicate. -compile_fact_for_assert(HeadIs, (Head:-Body)):- - compile_head_for_assert(HeadIs, NewHeadIs,Converted), - optimize_head_and_body(NewHeadIs,Converted,Head,Body). - -head_as_is(Head):- - as_functor_args(Head,Functor,A,_),!, - head_as_is(Functor,A). -head_as_is(if,3). - -compile_head_for_assert(Head, Head, true):- head_as_is(Head),!. -compile_head_for_assert(Head, NewestHead, HeadCode):- - compile_head_variablization(Head, NewHead, VHeadCode), - compile_head_args(NewHead, NewestHead, AHeadCode), - combine_code(VHeadCode,AHeadCode,HeadCode). - -% Construct the new head and the match body -compile_head_args(Head, NewHead, HeadCode) :- - must_det_ll(( - as_functor_args(Head,Functor,A,Args), - maplist(f2p_assign(Head),NewArgs,Args,CodeL), - as_functor_args(NewHead,Functor,A,NewArgs), - list_to_conjuncts(CodeL,HeadCode))),!. - +compile_head_for_assert(HeadIs, (Head:-Body)):- + compile_head_for_assert(HeadIs, NewHeadIs,Converted), + head_preconds_into_body(NewHeadIs,Converted,Head,Body). - -compile_head_variablization(Head, NewHead, HeadCode) :- - must_det_ll(( - as_functor_args(Head,Functor,A,Args), - % Find non-singleton variables in Args - fix_non_singletons(Args, NewArgs, Conditions), - list_to_conjunction(Conditions,HeadCode), - as_functor_args(NewHead,Functor,A,NewArgs))). - -fix_non_singletons(Args, NewArgs, [Code|Conditions]) :- - sub_term_loc(Var, Args, Loc1), is_ftVar(Var), - sub_term_loc_replaced(==(Var), _Var2, Args, Loc2, ReplVar2, NewArgsM), - Loc1 \=@= Loc2, - Code = same(ReplVar2,Var), -fix_non_singletons(NewArgsM, NewArgs, Conditions). -fix_non_singletons(Args, Args, []):-!. - - -sub_term_loc(A,A,self). -sub_term_loc(E,Args,e(N,nth1)+Loc):- is_list(Args),!, nth1(N,Args,ST),sub_term_loc(E,ST,Loc). -sub_term_loc(E,Args,e(N,arg)+Loc):- compound(Args),arg(N,Args,ST),sub_term_loc(E,ST,Loc). - -sub_term_loc_replaced(P1,E,Args,LOC,Var,NewArgs):- is_list(Args), !, sub_term_loc_l(nth1,P1,E,Args,LOC,Var,NewArgs). -sub_term_loc_replaced(P1,E,FArgs,LOC,Var,NewFArgs):- compound(FArgs), \+ is_ftVar(FArgs),!, - compound_name_arguments(FArgs, Name, Args), - sub_term_loc_l(arg,P1,E,Args,LOC,Var,NewArgs), - compound_name_arguments(NewCompound, Name, NewArgs),NewFArgs=NewCompound. - sub_term_loc_replaced(P1,A,A,self,Var,Var):- call(P1,A). - - -sub_term_loc_l(Nth,P1,E,Args,e(N,Nth)+Loc,Var,NewArgs):- - reverse(Args,RevArgs), - append(Left,[ST|Right],RevArgs), - sub_term_loc_replaced(P1,E,ST,Loc,Var,ReplaceST), - append(Left,[ReplaceST|Right],RevNewArgs), - reverse(RevNewArgs,NewArgs), - length([_|Right], N). - - -% Convert a list of conditions into a conjunction -list_to_conjunction([], true). -list_to_conjunction([Cond], Cond). -list_to_conjunction([H|T], (H, RestConj)) :- - list_to_conjunction(T, RestConj). +compile_head_for_assert(HeadIs, NewHeadIs,Converted) :- /*trace,*/ + as_functor_args(HeadIs,F,A,ArgsL), + maplist(f2p_assign(HeadIs),NewArgs,ArgsL,CodeForValueL), + as_functor_args(NewHeadIs,F,A,NewArgs), + list_to_conjuncts(CodeForValueL,Converted),!. -:- op(700,xfx,'=~'). - +as_functor_args(AsPred,F,A,ArgsL):- nonvar(AsPred),!,into_list_args(AsPred,[F|ArgsL]),length(ArgsL,A). +as_functor_args(AsPred,F,A,ArgsL):- nonvar(F),length(ArgsL,A),AsPred =~ [F|ArgsL]. -as_functor_args(AsPred,F,A,ArgsL):- nonvar(AsPred),!,into_list_args(AsPred,[F|ArgsL]), length(ArgsL,A). -as_functor_args(AsPred,F,A,ArgsL):- - nonvar(F),length(ArgsL,A),AsPred = [F|ArgsL]. - -compile_for_assert(HeadIs, AsBodyFn, Converted) :- - (AsBodyFn =@= HeadIs ; AsBodyFn == []), !,/*trace,*/ - compile_fact_for_assert(HeadIs,Converted). - -% If Convert is of the form (AsFunction=AsBodyFn), we perform conversion to obtain the equivalent predicate. -compile_for_assert(Head, AsBodyFn, Converted) :- - once(compile_head_variablization(Head, HeadC, CodeForHeadArgs)), - \+(atomic(CodeForHeadArgs)), !, - compile_for_assert(HeadC, - (CodeForHeadArgs,AsBodyFn), Converted). +compile_for_assert(HeadIs, AsBodyFn, Converted) :- + (AsBodyFn =@= HeadIs ; AsBodyFn == []), !,/*trace,*/ + compile_head_for_assert(HeadIs,Converted). compile_for_assert(HeadIs, AsBodyFn, Converted) :- is_ftVar(AsBodyFn), /*trace,*/ - AsFunction = HeadIs,!, - must_det_ll(( - Converted = (HeadC :- BodyC), % Create a rule with Head as the converted AsFunction and NextBody as the converted AsBodyFn - %funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head), - f2p(HeadIs,HResult,AsFunction,HHead), - (var(HResult) -> (Result = HResult, HHead = Head) ; - funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head)), - NextBody = u_assign(AsBodyFn,Result), - optimize_head_and_body(Head,NextBody,HeadC,BodyC), - nop(ignore(Result = '$VAR'('HeadRes'))))),!. + AsFunction = HeadIs,!, + must_det_ll(( + Converted = (HeadC :- BodyC), % Create a rule with Head as the converted AsFunction and NextBody as the converted AsBodyFn + %funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head), + f2p(HeadIs,HResult,AsFunction,HHead), + (var(HResult) -> (Result = HResult, HHead = Head) ; + funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head)), + NextBody = u_assign(AsBodyFn,Result), + head_preconds_into_body(Head,NextBody,HeadC,BodyC), + nop(ignore(Result = '$VAR'('HeadRes'))))),!. compile_for_assert(HeadIs, AsBodyFn, Converted) :- - AsFunction = HeadIs, - must_det_ll(( - Converted = (HeadC :- NextBodyC), % Create a rule with Head as the converted AsFunction and NextBody as the converted AsBodyFn - /*funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head),*/ - f2p(HeadIs,HResult,AsFunction,HHead), - (var(HResult) -> (Result = HResult, HHead = Head) ; - funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head)), - %verbose_unify(Converted), - f2p(HeadIs,Result,AsBodyFn,NextBody), - %RetResult = Converted, - %RetResult = _, - optimize_head_and_body(Head,NextBody,HeadC,NextBodyC), - %fbug([convert(Convert),optimize_head_and_body(HeadC:-NextBodyC)]), - %if_t(((Head:-NextBody)\=@=(HeadC:-NextBodyC)),fbug(was(Head:-NextBody))), - nop(ignore(Result = '$VAR'('HeadRes'))))),!. + AsFunction = HeadIs, + must_det_ll(( + Converted = (HeadC :- NextBodyC), % Create a rule with Head as the converted AsFunction and NextBody as the converted AsBodyFn + %funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head), + f2p(HeadIs,HResult,AsFunction,HHead), + (var(HResult) -> (Result = HResult, HHead = Head) ; + funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head)), + verbose_unify(Convert), + f2p(HeadIs,Result,AsBodyFn,NextBody), + %RetResult = Converted, + %RetResult = _, + head_preconds_into_body(Head,NextBody,HeadC,NextBodyC), + fbug([convert(Convert),head_preconds_into_body(HeadC:-NextBodyC)]), + %if_t(((Head:-NextBody)\=@=(HeadC:-NextBodyC)),fbug(was(Head:-NextBody))), + + nop(ignore(Result = '$VAR'('HeadRes'))))),!. % If Convert is of the form (AsFunction=AsBodyFn), we perform conversion to obtain the equivalent predicate. compile_for_assert(HeadIs, AsBodyFn, Converted) :- AsFunction = HeadIs, Converted = (HeadCC :- BodyCC), - funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head), - compile_head_args(Head,HeadC,CodeForHeadArgs), + funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head), + as_functor_args(Head,F,A,ArgsL), + maplist(f2p_assign(HeadIs),NewArgs,ArgsL,CodeForValueL), + as_functor_args(HeadC,F,A,NewArgs), + list_to_conjuncts(CodeForValueL,CodeForHeadArgs), f2p(HeadIs,Result,AsBodyFn,NextBody), combine_code(CodeForHeadArgs,NextBody,BodyC),!, - optimize_head_and_body(HeadC,BodyC,HeadCC,BodyCC),!. + head_preconds_into_body(HeadC,BodyC,HeadCC,BodyCC),!. + /* */ -optimize_head_and_body(Head,Body,HeadNewest,BodyNewest):- - label_body_singles(Head,Body), - color_g_mesg('#404064',print_pl_source(( Head :- Body))), - (merge_and_optimize_head_and_body(Head,Body,HeadNew,BodyNew), - (((Head,Body)=@=(HeadNew,BodyNew)) - -> (HeadNew=HeadNewest,BodyNew=BodyNewest) - ; optimize_head_and_body(HeadNew,BodyNew,HeadNewest,BodyNewest))). - - - -merge_and_optimize_head_and_body(Head,Converted,HeadO,Body):- nonvar(Head), - Head = (PreHead,True),!, - merge_and_optimize_head_and_body(PreHead,(True,Converted),HeadO,Body). -merge_and_optimize_head_and_body(AHead,Body,Head,BodyNew):- - assertable_head(AHead,Head), - must_optimize_body(Head,Body,BodyNew). - -assertable_head(u_assign(FList,R),Head):- FList =~ [F|List], - append(List,[R],NewArgs), atom(F), Head=..[F|NewArgs],!. +head_preconds_into_body(Head,Body,Head,Body):- \+ compound(Head),!. +head_preconds_into_body((PreHead,True),Converted,Head,Body):- True==true,!, + head_preconds_into_body(PreHead,Converted,Head,Body). +head_preconds_into_body((True,PreHead),Converted,Head,Body):- True==true,!, + head_preconds_into_body(PreHead,Converted,Head,Body). +head_preconds_into_body(PreHead,(True,Converted),Head,Body):- True==true,!, + head_preconds_into_body(PreHead,Converted,Head,Body). +head_preconds_into_body(PreHead,(Converted,True),Head,Body):- True==true,!, + head_preconds_into_body(PreHead,Converted,Head,Body). +head_preconds_into_body((AsPredO,Pre),Converted,Head,Body):- + head_preconds_into_body(Pre,(AsPredO,Converted),Head,Body). +head_preconds_into_body(AHead,Body,Head,BodyNew):- + assertable_head(AHead,Head), + optimize_body(Head,Body,BodyNew). + +assertable_head(u_assign(FList,R),Head):- FList =~ [F|List], + append(List,[R],NewArgs), atom(F),!, Head=..[F|NewArgs]. assertable_head(Head,Head). -label_body_singles(Head,Body):- - term_singletons(Body+Head,BodyS), - maplist(label_body_singles_2(Head),BodyS). -label_body_singles_2(Head,Var):- sub_var(Var,Head),!. -label_body_singles_2(_,Var):- ignore(Var='$VAR'('_')). - - -must_optimize_body(A,B,CC):- once(optimize_body(A,B,C)), C \=@= B,!, must_optimize_body(A,C,CC). -must_optimize_body(_,B,C):- B =C. - - -metta_predicate(eval_args(evaluable,eachvar)). -metta_predicate(eval_true(matchable)). -metta_predicate(with_space(space,matchable)). -metta_predicate(limit(number,matchable)). -metta_predicate(findall(template,matchable,listvar)). -metta_predicate(match(space,matchable,template,eachvar)). - -optimize_body(_HB,Body,BodyNew):- is_ftVar(Body),!,Body=BodyNew. -%optimize_body( HB,eval_args(VT,R),eval_args(VT,R)):-!, must_optimize_body(HB,VT,VTT). -optimize_body( HB,with_space(V,T),with_space(V,TT)):-!, must_optimize_body(HB,T,TT). -optimize_body( HB,limit(V,T),limit(V,TT)):-!, must_optimize_body(HB,T,TT). -optimize_body( HB,findall(V,T,R),findall(V,TT,R)):-!, must_optimize_body(HB,T,TT). -optimize_body( HB,loonit_assert_source_tf(V,T,R3,R4), loonit_assert_source_tf(V,TT,R3,R4)):-!, - must_optimize_body(HB,T,TT). - -optimize_body( HB,(B1*->B2;B3),(BN1*->BN2;BN3)):-!, must_optimize_body(HB,B1,BN1), optimize_body(HB,B2,BN2), optimize_body(HB,B3,BN3). -optimize_body( HB,(B1->B2;B3),(BN1->BN2;BN3)):-!, must_optimize_body(HB,B1,BN1), must_optimize_body(HB,B2,BN2), must_optimize_body(HB,B3,BN3). -optimize_body( HB,(B1:-B2),(BN1:-BN2)):-!, optimize_body(HB,B1,BN1), optimize_body(HB,B2,BN2). -optimize_body( HB,(B1*->B2),(BN1*->BN2)):-!, must_optimize_body(HB,B1,BN1), optimize_body(HB,B2,BN2). -optimize_body( HB,(B1->B2),(BN1*->BN2)):-!, must_optimize_body(HB,B1,BN1), optimize_body(HB,B2,BN2). -optimize_body( HB,(B1;B2),(BN1;BN2)):-!, optimize_body(HB,B1,BN1), optimize_body(HB,B2,BN2). -optimize_body( HB,(B1,B2),(BN1)):- optimize_conjuncts(HB,(B1,B2),BN1). -%optimize_body(_HB,==(Var, C), Var=C):- self_eval(C),!. -optimize_body( HB,u_assign(A,B),R):- optimize_u_assign_1(HB,A,B,R),!. -%optimize_body(_HB,u_assign(A,B),u_assign(AA,B)):- p2s(A,AA),!. -optimize_body(_HB,Body,BodyNew):- Body=BodyNew. - -ok_to_append('$VAR'):- !, fail. -ok_to_append(_). - -number_wang(A,B,C):- - (numeric(C);numeric(A);numeric(B)),!, - maplist(numeric_or_var,[A,B,C]), - maplist(decl_numeric,[A,B,C]),!. - -optimize_u_assign_1(_,Var,_,_):- is_ftVar(Var),!,fail. -optimize_u_assign_1(HB,Compound,R,Code):- \+ compound(Compound),!, optimize_u_assign(HB,Compound,R,Code). -optimize_u_assign_1(HB,[H|T],R,Code):- !, optimize_u_assign(HB,[H|T],R,Code). -optimize_u_assign_1(HB,Compound,R,Code):- p2s(Compound,MeTTa), optimize_u_assign(HB,MeTTa,R,Code). -%optimize_u_assign_1(_,[Pred| ArgsL], R, u_assign([Pred| ArgsL],R)). - -optimize_u_assign(_,[Var|_],_,_):- is_ftVar(Var),!,fail. -optimize_u_assign(_,[Empty], _, (!,fail)):- Empty == empty,!. -optimize_u_assign(_,[+, A, B], C, plus(A , B, C)):- number_wang(A,B,C), !. -optimize_u_assign(_,[-, A, B], C, plus(B , C, A)):- number_wang(A,B,C), !. -optimize_u_assign(_,[+, A, B], C, +(A , B, C)):- !. -optimize_u_assign(_,[-, A, B], C, +(B , C, A)):- !. -optimize_u_assign(_,[*, A, B], C, *(A , B, C)):- number_wang(A,B,C), !. -optimize_u_assign(_,['/', A, B], C, *(B , C, A)):- number_wang(A,B,C), !. -optimize_u_assign(_,[*, A, B], C, *(A , B, C)):- !. -optimize_u_assign(_,['/', A, B], C, *(B , C, A)):- !. -optimize_u_assign(_,[fib, B], C, fib(B, C)):- !. -optimize_u_assign(_,[fib1, A,B,C,D], R, fib1(A, B, C, D, R)):- !. -optimize_u_assign(_,['pragma!',N,V],Empty,set_option_value_interp(N,V)):- - nonvar(N),ignore((fail,Empty='Empty')), !. -optimize_u_assign((H:-_),Filter,A,filter_head_arg(A,Filter)):- fail, compound(H), arg(_,H,HV), - HV==A, is_list(Filter),!. -optimize_u_assign(_,[+, A, B], C, '#='(C , A + B)):- number_wang(A,B,C), !. -optimize_u_assign(_,[-, A, B], C, '#='(C , A - B)):- number_wang(A,B,C), !. -optimize_u_assign(_,[match,KB,Query,Template], R, Code):- match(KB,Query,Template,R) = Code. - -optimize_u_assign(HB,MeTTaEvalP, R, Code):- \+ is_ftVar(MeTTaEvalP), - compound_non_cons(MeTTaEvalP), p2s(MeTTaEvalP,MeTTa), - MeTTa\=@=MeTTaEvalP,!, optimize_body(HB, u_assign(MeTTa, R), Code). - -% optimize_u_assign(_,_,_,_):- !,fail. -optimize_u_assign((H:-_),[Pred| ArgsL], R, Code):- var(R), atom(Pred), ok_to_append(Pred), - append([Pred| ArgsL],[R], PrednArgs),Code=..PrednArgs, - (H=..[Pred|_] -> nop(set_option_value('tabling',true)) ; current_predicate(_,Code)),!. - -p2s(P,S):- into_list_args(P,S). - -get_decl_type(N,DT):- attvar(N),get_atts(N,AV),sub_term(DT,AV),atom(DT). - -numeric(N):- number(N),!. -numeric(N):- get_attr(N,'Number','Number'). -numeric(N):- get_decl_type(N,DT),(DT=='Int',DT=='Number'). -decl_numeric(N):- numeric(N),!. -decl_numeric(N):- ignore((var(N),put_attr(N,'Number','Number'))). -numeric_or_var(N):- var(N),!. -numeric_or_var(N):- numeric(N),!. -numeric_or_var(N):- \+ compound(N),!,fail. -numeric_or_var('$VAR'(_)). - -non_compound(S):- \+ compound(S). - -did_optimize_conj(Head,B1,B2,B12):- optimize_conj(Head,B1,B2,B12), B12\=@=(B1,B2),!. - - -optimize_conjuncts(Head,(B1,B2,B3),BN):- B3\==(_,_), - did_optimize_conj(Head,B2,B3,B23), - optimize_conjuncts(Head,B1,B23,BN), !. -optimize_conjuncts(Head,(B1,B2,B3),BN):- - did_optimize_conj(Head,B1,B2,B12), - optimize_conjuncts(Head,B12,B3,BN),!. -%optimize_conjuncts(Head,(B1,B2),BN1):- optimize_conj(Head,B1,B2,BN1). -optimize_conjuncts(Head,(B1,B2),BN1):- did_optimize_conj(Head,B1,B2,BN1),!. -optimize_conjuncts(Head,B1,B2,(BN1,BN2)):- - must_optimize_body(Head,B1,BN1), must_optimize_body(Head,B2,BN2). - -optimize_conj(_, u_assign(Term, C), u_assign(True,CC), eval_true(Term)):- 'True'==True, CC==C. -optimize_conj(_, u_assign(Term, C), is_True(CC), eval_true(Term)):- CC==C, !. -optimize_conj(_, B1,BT,B1):- assumed_true(BT),!. -optimize_conj(_, BT,B1,B1):- assumed_true(BT),!. -%optimize_conj(Head, u_assign(Term, C), u_assign(True,CC), Term):- 'True'==True, -% optimize_conj(Head, u_assign(Term, C), is_True(CC), CTerm). -%optimize_conj(Head,B1,BT,BN1):- assumed_true(BT),!, optimize_body(Head,B1,BN1). -%optimize_conj(Head,BT,B1,BN1):- assumed_true(BT),!, optimize_body(Head,B1,BN1). -optimize_conj(Head,B1,B2,(BN1,BN2)):- - optimize_body(Head,B1,BN1), optimize_body(Head,B2,BN2). - -assumed_true(B2):- var(B2),!,fail. -assumed_true(eval_true(B2)):-!,assumed_true(B2). -assumed_true(B2):- B2== true,!. -assumed_true(B2):- B2==u_assign('True', '$VAR'('_')),!. -assumed_true(X==Y):- assumed_true(X=Y). -assumed_true(X=Y):- var(X),var(Y), X=Y. -assumed_true(X=Y):- is_ftVar(X),is_ftVar(Y), X=Y. - - -filter_head_arg(H,F):- var(H),!,H=F. -filter_head_arge(H,F):- H = F. - -code_callable(Term,_CTerm):- var(Term),!,fail. -code_callable(Term, CTerm):- current_predicate(_,Term),!,Term=CTerm. -%code_callable(Term, CTerm):- current_predicate(_,Term),!,Term=CTerm. +optimize_body(_Head,Body,BodyNew):- var(Body),!,Body=BodyNew. +optimize_body(Head,(B1*->B2;B3),(BN1*->BN2;BN3)):-!, optimize_body(Head,B1,BN1), optimize_body(Head,B2,BN2), optimize_body(Head,B3,BN3). +optimize_body(Head,(B1->B2;B3),(BN1->BN2;BN3)):-!, optimize_body(Head,B1,BN1), optimize_body(Head,B2,BN2), optimize_body(Head,B3,BN3). +optimize_body(Head,(B1,B2),(BN1)):- B2==true,!, optimize_body(Head,B1,BN1). +optimize_body(Head,(B2,B1),(BN1)):- B2==true,!, optimize_body(Head,B1,BN1). +optimize_body(Head,(B1,B2),(BN1,BN2)):-!, optimize_body(Head,B1,BN1), optimize_body(Head,B2,BN2). +optimize_body(Head,(B1:-B2),(BN1:-BN2)):-!, optimize_body(Head,B1,BN1), optimize_body(Head,B2,BN2). +optimize_body(Head,(B1;B2),(BN1;BN2)):-!, optimize_body(Head,B1,BN1), optimize_body(Head,B2,BN2). +optimize_body(_Head,Body,BodyNew):- Body=BodyNew. + compile_test_then_else(RetResult,If,Then,Else,Converted):- f2p(HeadIs,ThenResult,Then,ThenCode), f2p(HeadIs,ElseResult,Else,ElseCode), - Converted=(If*->(ThenCode,ThenResult=RetResult); - (ElseCode,ElseResult=RetResult)). + Converted=(If*->(ThenCode,ThenResult=RetResult);(ElseCode,ElseResult=RetResult)). :- discontiguous(compile_flow_control/4). - -compile_flow_control(_HeadIs,RetResult,Convert, u_assign(Convert,RetResult)) :- is_ftVar(Convert), var(RetResult),!. - compile_flow_control(_HeadIs,_RetResult,Convert,_):- \+ compound(Convert),!,fail. compile_flow_control(_HeadIs,_RetResult,Convert,_):- compound_name_arity(Convert,_,0),!,fail. - -:- op(700,xfx, =~). compile_flow_control(HeadIs,RetResult,Convert, (Code1,Eval1Result=Result,Converted)) :- % dif_functors(HeadIs,Convert), Convert =~ chain(Eval1,Result,Eval2),!, f2p(HeadIs,Eval1Result,Eval1,Code1), f2p(HeadIs,RetResult,Eval2,Converted). -compile_flow_control(HeadIs,ResValue2,Convert, (CodeForValue1,Converted)) :- % dif_functors(HeadIs,Convert), - Convert =~ ['eval-in-space',Value1,Value2], - f2p(HeadIs,ResValue1,Value1,CodeForValue1), - f2p(HeadIs,ResValue2,Value2,CodeForValue2), - Converted = with_space(ResValue1,CodeForValue2). - - -compile_flow_control(_HeadIs,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), - Convert =~ ['bind!',Var,Value],is_ftVar(Value),!, - Converted = eval_args(['bind!',Var,Value],RetResult). -compile_flow_control(_HeadIs,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), - Convert =~ ['bind!',Var,Value], Value =~ ['new-space'],!, - Converted = eval_args(['bind!',Var,Value],RetResult). - compile_flow_control(HeadIs,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), - Convert =~ ['bind!',Var,Value], - f2p(HeadIs,ValueResult,Value,ValueCode), - Converted = (ValueCode,eval_args(['bind!',Var,ValueResult],RetResult)). - -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- % dif_functors(HeadIs,Convert), - once(Convert =~ if(Cond,Then,Else);Convert =~ 'if'(Cond,Then,Else)), - !,Test = is_True(CondResult), + Convert =~ if(Cond,Then,Else),!,Test = is_True(CondResult), f2p(HeadIs,CondResult,Cond,CondCode), compile_test_then_else(RetResult,(CondCode,Test),Then,Else,Converted). @@ -602,21 +374,14 @@ Converted = as_tf('add-atom'(Where,WhatP),RetResult). -compile_flow_control(_HeadIs,RetResult,Convert, (Converted)) :- - Convert =~ ['superpose',ValueL],is_ftVar(ValueL), - %maybe_unlistify(UValueL,ValueL,URetResult,RetResult), - Converted = eval_args(['superpose',ValueL],RetResult), - cname_var('MeTTa_SP_',ValueL). - compile_flow_control(HeadIs,RetResult,Convert, (Converted)) :- - Convert =~ ['superpose',ValueL],is_list(ValueL), - %maybe_unlistify(UValueL,ValueL,URetResult,RetResult), - cname_var('SP_Ret',RetResult), - maplist(f2p_assign(HeadIs,RetResult),ValueL,CodeForValueL), + Convert =~ ['superpose',UValueL], + maybe_unlistify(UValueL,ValueL,URetResult,RetResult), + maplist(f2p_assign(HeadIs,URetResult),ValueL,CodeForValueL), list_to_disjuncts(CodeForValueL,Converted),!. -maybe_unlistify([UValueL],ValueL,RetResult,[URetResult]):- fail, is_list(UValueL),!, +maybe_unlistify([UValueL],ValueL,RetResult,[URetResult]):- is_list(UValueL),!, maybe_unlistify(UValueL,ValueL,RetResult,URetResult). maybe_unlistify(ValueL,ValueL,RetResult,RetResult). @@ -625,7 +390,7 @@ list_to_disjuncts([A|L],(A;D)):- list_to_disjuncts(L,D). -%f2p_assign(_HeadIs,V,Value,is_True(V)):- Value=='True'. +f2p_assign(_HeadIs,V,Value,is_True(V)):- Value=='True'. f2p_assign(_HeadIs,ValueR,Value,ValueR=Value):- \+ compound(Value),!. f2p_assign(_HeadIs,ValueR,Value,ValueR=Value):- is_ftVar(Value),!. f2p_assign(HeadIs,ValueResult,Value,Converted):- @@ -634,35 +399,14 @@ ValueResultRValueResult = (ValueResultR=ValueResult), combine_code(CodeForValue,ValueResultRValueResult,Converted). -compile_flow_control(HeadIs,RetResult,Convert,Converted) :- - Convert =~ ['println!',Value],!, - Converted = (ValueCode,eval_args(['println!',ValueResult], RetResult)), - f2p(HeadIs,ValueResult,Value,ValueCode). - - - -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- - Convert =~ ['case',Value,PNil],[]==PNil,!,Converted = (ValueCode,RetResult=[]), - f2p(HeadIs,_ValueResult,Value,ValueCode). - - compile_flow_control(HeadIs,RetResult,Convert, (ValueCode, Converted)) :- - Convert =~ ['case',Value|Options], \+ is_ftVar(Value),!, + Convert =~ ['case',Value|Options], + \+ is_ftVar(Value),!, cname_var('CASE_EVAL_',ValueResult), - compile_flow_control(HeadIs,RetResult,['case',ValueResult|Options], Converted), + ConvertCases =~ ['case',ValueResult|Options], + compile_flow_control(HeadIs,RetResult,ConvertCases, Converted), f2p(HeadIs,ValueResult,Value,ValueCode). -compile_flow_control(HeadIs,RetResult,Convert, Converted) :- - Convert =~ ['case',Value,Options],!, - must_det_ll(( - maplist(compile_case_bodies(HeadIs),Options,Cases), - Converted = - (( AllCases = Cases, - once((member(caseStruct(MatchVar,MatchCode,BodyResult,BodyCode),AllCases), - (MatchCode,unify_enough(Value,MatchVar)))), - (BodyCode), - BodyResult=RetResult)))). - compile_flow_control(HeadIs,RetResult,Convert, Converted) :- Convert =~ ['case',Value,[Opt|Options]],nonvar(Opt),!, must_det_ll(( @@ -671,6 +415,8 @@ ConvertCases =~ ['case',Value,Options], compile_flow_control(HeadIs,RetResult,ConvertCases,Else))). +compile_flow_control(_HeadIs,RetResult,Convert, Converted) :- + Convert =~ ['case',_Value,[]],!,Converted = (fail,RetResult=[]),!. /* compile_flow_control(HeadIs,RetResult,Convert, Converted) :- @@ -712,8 +458,7 @@ compile_case_bodies(HeadIs,MatchBody,CS):- compound(MatchBody), MatchBody =~ MB,compile_case_bodies(HeadIs,MB,CS). compile_flow_control(HeadIs,RetResult,Convert,CodeForValueConverted) :- - Convert =~ [Plus,N,Value], atom(Plus), current_predicate(Plus/3), number(N), - \+ number(Value), \+ is_ftVar(Value),!, + Convert =~ [Plus,N,Value], atom(Plus), current_predicate(Plus/3), number(N), \+ number(Value), \+ is_ftVar(Value),!, f2p(HeadIs,ValueResult,Value,CodeForValue),!, Converted =.. [Plus,N,ValueResult,RetResult], combine_code(CodeForValue,Converted,CodeForValueConverted). @@ -768,49 +513,25 @@ combine_code(Code,Eval1ResultVar,Converted)))))). -/* -% match(Space,f(1)=Y,Y) + +% match('&self',f(1)=Y,Y) compile_flow_control(HeadIs,Y,Convert,Converted) :- dif_functors(HeadIs,Convert), - Convert=~ match(Space,AsFunctionY,YY), - nonvar(AsFunctionY),( AsFunctionY =~ (AsFunction=Y)), nonvar(AsFunction), + Convert=~ match('&self',AsFunctionY,YY), nonvar(AsFunctionY),( AsFunctionY =~ (AsFunction=Y)), nonvar(AsFunction), !, Y==YY, f2p(HeadIs,Y,AsFunction,Converted),!. -*/ -compile_flow_control(HeadIs,Atom,Convert,Converted) :- - Convert=~ match(Space,Q,T),Q==T,Atom=Q,!, - compile_flow_control(HeadIs,Atom,'get-atoms'(Space),Converted). - -compile_flow_control(_HeadIs,Match,Convert,Converted) :- - Convert=~ 'get-atoms'(Space), - Converted = metta_atom_iter(Space,Match). - -compile_flow_control(HeadIs,AtomsVar,Convert,Converted) :- - Convert=~ 'get-atoms'(Space), AtomsVar = Pattern, - compile_pattern(HeadIs,Space,Pattern,Converted). compile_flow_control(HeadIs,RetResult,Convert,Converted) :- dif_functors(HeadIs,Convert), - Convert =~ 'match'(Space,Pattern,Template),!, + Convert =~ ['match',_Self,Pattern,Template],!, + f2p(HeadIs,_,Pattern,PatternCode), f2p(HeadIs,RetResult,Template,TemplateCode), - compile_pattern(HeadIs,Space,Pattern,SpacePatternCode), - combine_code(SpacePatternCode,TemplateCode,Converted). - -compile_pattern(_HeadIs,Space,Match,SpaceMatchCode):- - SpaceMatchCode = metta_atom_iter(Space,Match). - -metta_atom_iter(Space,Match):- - metta_atom_iter('=',10,Space,Space,Match). - - - -make_with_space(Space,MatchCode,MatchCode):- Space=='&self',!. -make_with_space(Space,MatchCode,with_space(Space,MatchCode)):- Space\=='&self'. + combine_code(PatternCode,TemplateCode,Converted). compile_flow_control(HeadIs,RetResult,Convert, Converted) :- dif_functors(HeadIs,Convert), - Convert =~ 'match'(_Space,Match,Template),!, + Convert =~ ['match',_Self,Pattern,Template],!, must_det_ll(( - f2p(HeadIs,_,Match,MatchCode), + f2p(HeadIs,_,Pattern,PatternCode), into_equals(RetResult,Template,TemplateCode), - combine_code(MatchCode,TemplateCode,Converted))). + combine_code(PatternCode,TemplateCode,Converted))). compile_flow_control(HeadIs,RetResult,Convert, Converted) :- dif_functors(HeadIs,Convert), Convert =~ ['if-decons',Atom,Head,Tail,Then,Else],!,Test = unify_cons(AtomResult,ResHead,ResTail), @@ -891,16 +612,16 @@ flowc. -:- discontiguous f2p/4. + :- discontiguous f2p/4. f2p(_HeadIs,Convert, Convert, true) :- (is_ftVar(Convert);number(Convert)),!.% Check if Convert is a variable -% If Convert is a variable, the corresponding predicate is just eval_args(Convert, RetResult) +% If Convert is a variable, the corresponding predicate is just eval(Convert, RetResult) f2p(_HeadIs,RetResult,Convert, RetResultConverted) :- is_ftVar(Convert),!,% Check if Convert is a variable into_equals(RetResult,Convert,RetResultConverted). - % Converted = eval_args(Convert, RetResult). % Set Converted to eval_args(Convert, RetResult) + % Converted = eval(Convert, RetResult). % Set Converted to eval(Convert, RetResult) f2p(_HeadIs,RetResult,Convert, RetResultConverted) :- number(Convert),!,into_equals(RetResult,Convert,RetResultConverted). @@ -913,8 +634,8 @@ maplist(f2p_assign(HeadIs),RetResultL,ConvertL, ConvertedL), list_to_conjuncts(ConvertedL,Converted).*/ -% If Convert is an "eval_args" function, we convert it to the equivalent "is" predicate. -f2p(HeadIs,RetResult,EvalConvert,Converted):- EvalConvert =~ eval_args(Convert), !, +% If Convert is an "eval" function, we convert it to the equivalent "is" predicate. +f2p(HeadIs,RetResult,EvalConvert,Converted):- EvalConvert =~ eval(Convert), !, must_det_ll((f2p(HeadIs,RetResult,Convert, Converted))). f2p(HeadIs,RetResult,Convert, Converted):- @@ -947,17 +668,12 @@ must_det_ll((f2p(HeadIs,Result,Convert, Converted))). % If Convert is an "or" function, we convert it to the equivalent ";" (or) predicate. -f2p(HeadIs,RetResult,or(AsPredI,Convert), (AsPredO *-> true; Converted)) :- fail, !, +f2p(HeadIs,RetResult,or(AsPredI,Convert), or(AsPredO, Converted)) :- !, must_det_ll((f2p(HeadIs,RetResult,AsPredI, AsPredO), f2p(HeadIs,RetResult,Convert, Converted))). - f2p(HeadIs,RetResult,(AsPredI; Convert), (AsPredO; Converted)) :- !, must_det_ll((f2p(HeadIs,RetResult,AsPredI, AsPredO), f2p(HeadIs,RetResult,Convert, Converted))). -f2p(HeadIs,RetResult,SOR,or(AsPredO, Converted)) :- - SOR =~ or(AsPredI, Convert), - must_det_ll((f2p(HeadIs,RetResult,AsPredI, AsPredO), - f2p(HeadIs,RetResult,Convert, Converted))),!. % If Convert is a "," (and) function, we convert it to the equivalent "," (and) predicate. f2p(HeadIs,RetResult,(AsPredI, Convert), (AsPredO, Converted)) :- !, @@ -1024,11 +740,11 @@ funct_with_result_is_nth_of_pred(HeadIs,AsFunction, RetResult, Nth, AsPred), \+ ( compound(AsFunction), arg(_,AsFunction, Arg), is_function(Arg,_)),!. -% If any sub-term of Convert is an eval_args/2, convert that sub-term and then proceed with the conversion. +% If any sub-term of Convert is an eval/2, convert that sub-term and then proceed with the conversion. f2p(HeadIs,RetResult,Convert, Converted) :- rev_sub_sterm0(ConvertFunction, Convert), % Get the deepest sub-term AsFunction of Convert callable(ConvertFunction), % Check if AsFunction is callable - ConvertFunction = eval_args(AsFunction,Result), + ConvertFunction = eval(AsFunction,Result), ignore(is_function(AsFunction, Nth)), funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, Nth, AsPred), % Convert AsFunction to a predicate AsPred subst(Convert, ConvertFunction, Result, Converting), % Substitute AsFunction by Result in Convert @@ -1064,38 +780,30 @@ call4(G):- call(G). call5(G):- call(G). - trace_break:- trace,break. -:- table(u_assign/2). -u_assign(FList,R):- is_list(FList),!,eval_args(FList,R). u_assign(FList,R):- var(FList),nonvar(R), !, u_assign(R,FList). u_assign(FList,R):- FList=@=R,!,FList=R. u_assign(FList,R):- number(FList), var(R),!,R=FList. u_assign(FList,R):- self_eval(FList), var(R),!,R=FList. u_assign(FList,R):- var(FList),!,/*trace,*/freeze(FList,u_assign(FList,R)). +u_assign([V|VI],[V|VO]):- nonvar(V),is_metta_data_functor(_Eq,V),!,maplist(eval_args,VI,VO). +u_assign((F:-List),R):- !, R = (F:-List). u_assign(FList,R):- \+ compound(FList), var(R),!,R=FList. u_assign([F|List],R):- F == ':-',!, trace_break,as_tf(clause(F,List),R). -u_assign(FList,RR):- (compound_non_cons(FList),u_assign_c(FList,RR))*->true;FList=~RR. -u_assign(FList,RR):- - u_assign_list1(FList,RR)*->true;u_assign_list2(FList,RR). - -u_assign_list1([F|List],R):- eval_args([F|List],R), nonvar(R), R\=@=[F|List]. -u_assign_list2([F|List],R):- atom(F),append(List,[R],ListR), +u_assign([F|List],R):- atom(F),append(List,[R],ListR), catch(quietly(apply(F,ListR)),error(existence_error(procedure,F/_),_), catch(quietly(as_tf(apply(F,List),R)),error(existence_error(procedure,F/_),_), - quietly(catch(eval_args([F|List],R),_, R=[F|List])))). - -%u_assign([V|VI],[V|VO]):- nonvar(V),is_metta_data_functor(_Eq,V),!,maplist(eval_args,VI,VO). + quietly(catch(eval_args([F|List],R),_, R=[F|List])))),!. +u_assign(FList,RR):- iz_conz(FList),!,as_tf(FList,RR). +u_assign(FList,RR):- (compound_non_cons(FList),u_assign_c(FList,RR))*->true;FList=~RR. -u_assign_c((F:-List),R):- !, R = (F:-List). u_assign_c(FList,RR):- functor(FList,F,_), (catch(quietlY(call(FList,R)),error(existence_error(procedure,F/_),_), catch(quietlY(as_tf(FList,R)),error(existence_error(procedure,F/_),_), quietlY((p2m(FList,[F|List]),catch(eval_args([F|List],R),_, R=~[F|List])))))),!,R=RR. -u_assign_c(FList,RR):- as_tf(FList,RR),!. -u_assign_c(FList,R):- compound(FList), !, FList=~R. +u_assign_c(FList,R):- compound(FList), FList=~R. quietlY(G):- call(G). @@ -1259,14 +967,14 @@ % Converts the rule (Head :- Body) to its function equivalent preds_to_functs0((Head:-Body), Converted) :- !, % The rule is converted by transforming Head to a function AsFunction and the Body to ConvertedBody - ( + ( pred_to_funct(Head, AsFunction, Result), %ignore(Result = '$VAR'('HeadRes')), conjuncts_to_list(Body,List), reverse(List,RevList),append(Left,[BE|Right],RevList), compound(BE),arg(Nth,BE,ArgRes),sub_var(Result,ArgRes), remove_funct_arg(BE, Nth, AsBodyFunction), - append(Left,[eval_args(AsBodyFunction,Result)|Right],NewRevList), + append(Left,[eval(AsBodyFunction,Result)|Right],NewRevList), reverse(NewRevList,NewList), list_to_conjuncts(NewList,NewBody), preds_to_functs0(NewBody,ConvertedBody), @@ -1283,8 +991,8 @@ subst(Convert, Result, AsFunction, Converting), preds_to_functs0(Converting, Converted). -% Handles the special case where eval_args/2 is used and returns the function represented by the first argument of eval_args/2 -preds_to_functs0(eval_args(AsFunction, _Result), AsFunction) :- !. +% Handles the special case where eval/2 is used and returns the function represented by the first argument of eval/2 +preds_to_functs0(eval(AsFunction, _Result), AsFunction) :- !. % Handles the general case where Convert is a conjunction. % It converts the predicates to functions inside a conjunction @@ -1292,7 +1000,7 @@ preds_to_functs0(Converting, Converted). % Handles the case where AsPred is a compound term that can be converted to a function -preds_to_functs0(AsPred, eval_args(AsFunction, Result)) :- +preds_to_functs0(AsPred, eval(AsFunction, Result)) :- pred_to_funct(AsPred, AsFunction, Result), !. % any other term remains unchanged @@ -1336,8 +1044,7 @@ transform_and_combine_bodies(HeadBodiesList, NewHead, NewCombinedBodies)), \+ \+ ( Print=[converting=HeadBodiesList,newHead=NewHead], - numbervars(Print,0,_,[]),fbug(Print), - nop(in_cmt(print_pl_source(( NewHead :- NewCombinedBodies))))),!. + numbervars(Print,0,_,[]),fbug(Print),in_cmt(portray_clause(( NewHead :- NewCombinedBodies)))),!. % Predicate to find the least general unified head (LGU) among the given list of heads. % Heads is a list of head terms, and LeastGeneralHead is the least general term that unifies all terms in Heads. @@ -1449,8 +1156,8 @@ % =============================== % Compile in memory buffer % =============================== -add_assertion(Space,List):- is_list(List),!,maplist(add_assertion(Space),List). -add_assertion(_Space,NewAssertion) :- + +add_assertion(NewAssertion) :- expand_to_hb(NewAssertion,H,_), functor(H,F,A), functor(HH,F,A), assert(NewAssertion), @@ -1468,7 +1175,7 @@ format(TempFileStream, ':- multifile((~q)/~w).~n', [PredName, Arity]), format(TempFileStream, ':- dynamic((~q)/~w).~n', [PredName, Arity]), %if_t( \+ option_value('tabling',false), - if_t(option_value('tabling','True'),format(TempFileStream,':- ~q.~n',[table(PredName/Arity)])), + if_t(option_value('tabling',true),format(TempFileStream,':- ~q.~n',[table(PredName/Arity)])), maplist(write_clause(TempFileStream), PredClauses), % Close the temporary file close(TempFileStream), diff --git a/metta_vspace/pyswip/metta_convert.pl b/metta_vspace/pyswip/metta_convert.pl index 46773caf..b45a8c4d 100755 --- a/metta_vspace/pyswip/metta_convert.pl +++ b/metta_vspace/pyswip/metta_convert.pl @@ -216,8 +216,6 @@ -into_hyphens(D,U):- atom(D),!,atomic_list_concat(L,'_',D),atomic_list_concat(L,'-',U). -into_hyphens(D,U):- descend_and_transform(into_hyphens,D,U),!. % p2m/2 is a translation utility to convert Prolog constructs to MeTTa constructs. % It handles a variety of cases, including different types of compound terms, @@ -226,86 +224,68 @@ % and the second argument is the output converted to MeTTa syntax. -p2m(I,O):- p2m([progn],I,O). - -p2m(_OC,NC, NC) :- var(NC), !. % If NC is a variable, do not translate. -p2m(_OC,NC, NC) :- is_ftVar(NC), !. % If NC is a free term variable, do not translate. -p2m(_OC,[], 'Nil'). % empty list -p2m(_OC,M:I, with_self(N,O)):- p2m(OC,M,N),p2m(I,O). +p2m(NC, NC) :- var(NC), !. % If NC is a variable, do not translate. +p2m(NC, NC) :- is_ftVar(NC), !. % If NC is a free term variable, do not translate. % Conversion for lists -p2m(OC,[H|T],['::'|L]):- is_list([H|T]),maplist(p2m(OC),[H|T],L). -p2m(OC,[H|T], 'Cons'(OH, OT)):- p2m(OC,H, OH), p2m(OC,T, OT). -p2m(OC,NC, OO) :- +p2m([], 'Nil'). % empty list +p2m([H|T], 'Cons'(OH, OT)):- p2m(H, OH), p2m(T, OT). +p2m(NC, OO) :- % If NC is a list, map each element of the list from Prolog to MeTTa is_list(NC),!, - maplist(p2m(OC), NC, OO). -p2m(_OC,!, ['set-det']). % Translate the cut operation directly. -p2m(_OC,!, '!'). % Translate the cut operation directly. -p2m(_OC,false, 'False'). -p2m([progn|_], (!,fail), [empty]). % Translate Prolog�s fail to MeTTa�s False. -% p2m(_OC,fail, 'False'). % Translate Prolog�s fail to MeTTa�s False. -p2m(_OC,true, 'True'). % Translate Prolog�s true to MeTTa�s True. -% p2m(_OC,prolog, meTTa). % Translate the atom prolog to meTTa. - -p2m(_OC,'[|]','Cons'). -p2m(_OC,( ';' ),or). -%p2m(_OC,( ',' ),and). -%p2m(_OC,( '\\+' ),unless). -%p2m(_OC,( ':-' ),entailed_by). -%p2m(_OC,'=..','atom_2_list'). + maplist(p2m, NC, OO). +p2m(!, '!'). % Translate the cut operation directly. +p2m(false, 'False'). +% p2m(fail, 'False'). % Translate Prolog’s fail to MeTTa’s False. +p2m(true, 'True'). % Translate Prolog’s true to MeTTa’s True. +% p2m(prolog, meTTa). % Translate the atom prolog to meTTa. + +p2m('[|]','Cons'). +p2m(( ';' ),or). +%p2m(( ',' ),and). +%p2m(( '\\+' ),unless). +%p2m(( ':-' ),entailed_by). +%p2m('=..','atom_2_list'). % Conversion for any atomic term -p2m(_OC,A, A):- string(A),!. -p2m([progn|_],A, [H]):- atom(A),into_hyphens(A,H),!. -p2m(_,A, H):- atom(A),into_hyphens(A,H),!. -p2m(_OC,A, A):- atomic(A). +p2m(A, A):- atomic(A). -p2m(_OC,NC,NC):- \+ compound(NC),!. -p2m(_OC,NC,[F]):- compound_name_arity(NC,F,0),!. +p2m(NC,NC):- \+ compound(NC),!. +p2m(NC,[F]):- compound_name_arity(NC,F,0),!. % Conversion for the negation as failure -p2m(_OC,(\+ A), O):- !, p2m(_OC,not(A), O). +p2m((\+ A), O):- !, p2m(not(A), O). -p2m(_OC,(G,E),O):- conjuncts_to_list((G,E),List),!,into_sequential(List,O),!. +p2m((G,E),O):- conjuncts_to_list((G,E),List),!,into_sequential(List,O),!. % Conversion for arithmetic evaluation -%p2m(_OC,is(A, B), O):- !, p2m(_OC,eval(B, A), O). -%p2m(_OC,is(V,Expr),let(V,Expr,'True')). -p2m(_OC,(Head:-Body),O):- Body == true,!, O = (=(Head,'True')). -p2m(_OC,(Head:-Body),O):- Body == fail,!, O = (=(Head,[empty])). -p2m(_OC,(Head:-Body),O):- - p2m(Head,H),conjuncts_to_list(Body,List),into_sequential(List,SP),!, - O = (=(H,SP)). - -p2m(_OC,(:-Body),O):- - conjuncts_to_list(Body,List),into_sequential(List,SP),!, O= exec(SP). - -%p2m(_OC,(Head:-Body),O):- conjuncts_to_list(Body,List),into_sequential(List,SP),!,O=(=(Head,SP)). +%p2m(is(A, B), O):- !, p2m(eval(B, A), O). +%p2m(is(V,Expr),let(V,Expr,'True')). +p2m((Head:-Body),O):- Body == true,!, O = (=(Head,'True')). +p2m((Head:-Body),O):- Body == fail,!, O = (=(Head,[empty])). +p2m((Head:-Body),O):- conjuncts_to_list(Body,List),into_sequential(List,SP),!,O=(=(Head,SP)). % Conversion for if-then-else constructs -p2m(_OC,(A->B;C),O):- !, p2m(_OC,if_then_else(A,B,C),O). -p2m(_OC,(A;B),O):- !, p2m(_OC,or(A,B),O). -p2m(_OC,(A*->B;C),O):- !, p2m(_OC,each_then_otherwise(A,B,C),O). -p2m(_OC,(A->B),O):- !, p2m(_OC,if_then(A,B),O). -p2m(_OC,(A*->B),O):- !, p2m(_OC,each_then(A,B),O). -p2m(_OC,metta_defn(Eq,Self,H,B),'add-atom'(Self,[Eq,H,B])). -p2m(_OC,metta_type,'add-atom'). -p2m(_OC,get_metta_atom,'add-atom'). -p2m(_OC,retractall(X),'remove-all-atoms'('&self',X)). -p2m(_OC,clause(H,B),'get-atoms'('&self',[=,H,B])). -p2m(_OC,retract(X),'remove-atom'('&self',X)). -p2m(_OC,assert(X),'add-atom'('&self',X)). +p2m((A->B;C),O):- !, p2m(if_then_else(A,B,C),O). +p2m((A;B),O):- !, p2m(or(A,B),O). +p2m((A*->B;C),O):- !, p2m(each_then_otherwise(A,B,C),O). +p2m((A->B),O):- !, p2m(if_then(A,B),O). +p2m((A*->B),O):- !, p2m(each_then(A,B),O). +p2m(metta_defn(Eq,Self,H,B),'add-atom'(Self,[Eq,H,B])). +p2m(metta_type,'add-atom'). +p2m(get_metta_atom,'add-atom'). +p2m(retractall(X),'remove-all-atoms'('&self',X)). +p2m(clause(H,B),'get-atoms'('&self',[=,H,B])). +p2m(retract(X),'remove-atom'('&self',X)). +p2m(assert(X),'add-atom'('&self',X)). % The catch-all case for the other compound terms. -%p2m(_OC,I,O):- I=..[F|II],maplist(p2m,[F|II],OO),O=..OO. +p2m(I,O):- I=..[F|II],maplist(p2m,[F|II],OO),O=..OO. % It will break down compound terms into their functor and arguments and apply p2m recursively -p2m(OC,I, O):- +p2m(I, O):- compound(I), I =.. [F|II], % univ operator to convert between a term and a list consisting of functor name and arguments - maplist(p2m([F|OC]), II, OO), % applying p2m recursively on each argument of the compound term - into_hyphens(F,FF), - O = [FF|OO]. % constructing the output term with the converted arguments - + maplist(p2m, II, OO), % applying p2m recursively on each argument of the compound term + sexpr_s2p([F|OO],O). % constructing the output term with the converted arguments % In the context of this conversion predicate, each branch of the p2m predicate % is handling a different type or structure of term, translating it into its @@ -315,7 +295,7 @@ % of Prolog and MeTTa being used. prolog_to_metta(V, D) :- % Perform the translation from Prolog to MeTTa - p2m([progn], V, D),!. + p2m(V, D),!. % Define predicates to support the transformation from Prolog to MeTTa syntax @@ -335,160 +315,5 @@ -% Entry point for printing to Metta format. It clears the screen, sets the working directory, -% expands the filenames with a specific extension, and processes each file. -print_to_metta :- - % cls, % Clears the screen (assumes a custom or system-specific implementation). - % with_pwd( - % '/opt/logicmoo_workspace/packs_sys/logicmoo_opencog/MeTTa/vspace-metta/examples/gpt2-like/language_models/', - %Filt = 'examples/gpt2-like/language_models/*.pl', - Filt = '/opt/logicmoo_workspace/packs_sys/logicmoo_opencog/MeTTa/vspace-metta/examples/performance/nondet_unify/*.pl', - - % Finds all Prolog files in the specified directory. - print_to_metta(Filt), % Processes each found file. - % MC = '/opt/logicmoo_workspace/packs_sys/logicmoo_opencog/MeTTa/vspace-metta/metta_vspace/pyswip/metta_convert.pl', - % print_to_metta(MC), % Processes each found file. - !. -% Example of a no-operation (nop) call for a specific file path, indicating a placeholder or unused example. -%$nop(print_to_metta('/opt/logicmoo_workspace/packs_sys/logicmoo_opencog/MeTTa/vspace-metta/metta_vspace/pyswip/metta_convert.pl')). - -% Processes a list of filenames, applying 'print_to_metta' to each. -with_file_lists(P1,FileSpec):- is_list(FileSpec),!,maplist(with_file_lists(P1),FileSpec). -with_file_lists(P1,Directory):- atom(Directory), exists_directory(Directory), - findall(File,directory_source_files(Directory, File, [recursive(true),if(true)]),Files), - maplist(with_file_lists(P1),Files). -with_file_lists(P1,Mask):- atom(Mask), \+ exists_file(Mask), - expand_file_name(Mask, Files), Files\==[],!,maplist(with_file_lists(P1),Files). -with_file_lists(P1,Filename):- ignore(call(P1,Filename)). - - -print_to_metta(Filename):- - ignore(print_to_metta_file(Filename)), - ignore(print_to_metta_console(Filename)),!. - - -% Processes a list of filenames, applying 'print_to_metta' to each. -print_to_metta_console(FileSpec):- with_file_lists(print_to_metta_now(user_output),FileSpec). -print_to_metta_file(FileSpec):- with_file_lists(print_to_metta_now(_Create),FileSpec). - -% Processes a single filename by opening the file, translating its content, and then closing the file. -print_to_metta_now(OutputIn,Filename):- - atom(Filename), % Verifies that the filename is an atom. - % Generate the new filename with .metta extension. - file_name_extension(Base, _OldExt, Filename), - file_name_extension(Base, metta, NewFilename), - % Setup step: open both the input and output files. - format('~N~n~w~n', [print_to_metta(Filename,NewFilename)]), % Prints the action being performed. - %Output = user_output, - copy_term(OutputIn,Output), - setup_call_cleanup( - open(Filename, read, Input, [encoding(utf8)]), - % Call step: perform the translation and write to the output file. - setup_call_cleanup( - (if_t(var(Output),open(NewFilename, write, Output, [encoding(utf8)]))), - with_output_to(Output,translate_to_metta(Input)), - % Cleanup step for the output file: close the output stream. - close(Output) - ), - % Cleanup step for the input file: close the input stream. - close(Input) - ). - -into_namings(N=V):- ignore(V='$VAR'(N)). - -% Recursively translates content, stopping at the end of the file. -translate_to_metta(Input):- - at_end_of_stream(Input), % Checks for the end of the file. - !, nl. - -% Processes whitespace characters, maintaining their presence in the output. -translate_to_metta(Input):- - peek_char(Input, Char), % Peeks at the next character without consuming it. - is_reprint_char(Char), !, - get_char(Input, _), % Consumes the character. - put_char(Char), % Prints the character. - translate_to_metta(Input). - -% Converts Prolog comments to Metta-style comments, then continues processing. -translate_to_metta(Input):- - peek_char(Input, Char), - Char == '%', % Checks for Prolog comment start. - get_char(Input, _), put_char(';'), - read_line_to_string(Input, Cmt), % Reads the comment line. - print_metta_comments(Cmt),nl, % Converts and prints the comment in Metta style. - translate_to_metta(Input). % Continues with the next line. - -% Reads a clause along with its metadata, then continues translation. -translate_to_metta(Input):- - read_clause_with_info(Input),!, - translate_to_metta(Input). - -% Helper predicates and processing functions follow... - -% Determines if a character should be reprinted (spaces and period). -is_reprint_char(Char):- char_type(Char, space). -is_reprint_char(Char):- Char == '.'. - -% Translates Prolog comments to Metta comments, applying string replacements. -translate_comment(Cmt,Str):- replace_in_string(["%"=";","prolog"="MeTTa","Prolog"="MeTTa"],Cmt,Str). - -% Reads a clause while capturing various pieces of metadata. -read_clause_with_info(Stream) :- - Options = [ variable_names(Bindings), - term_position(Pos), - subterm_positions(RawLayout), - syntax_errors(error), - comments(Comments), - module(trans_mod)], - read_term(Stream, Term, Options), - ( Term == end_of_file - -> true - ; b_setval('$term_position', Pos), - b_setval('$variable_names', Bindings), - display_term_info(Stream, Term, Bindings, Pos, RawLayout, Comments)). - -% Displays term information and processes comments. -display_term_info(Stream, Term, Bindings, Pos, RawLayout, Comments):- - maplist(into_namings,Bindings), - process_term(Term), - print_metta_comments(Comments). - - -print_metta_comments([]):-!. -print_metta_comments(_TP-Cmt):-!, print_metta_comments(Cmt). -print_metta_comments([Cmt|Cs]):- !, print_metta_comments(Cmt),nl,!, print_metta_comments(Cs). -print_metta_comments(Cmt):- translate_comment(Cmt,String),write(String). - -% Processes each term based on its type (directive or other). -process_term(end_of_file):- !. -process_term(Term):- - is_directive(Term), - ignore(maybe_call_directive(Term)), - !, print_directive(Term). -process_term(Term):- - expand_to_hb(Term,H,B), - p2m((H:-B),STerm), - push_term_ctx(Term), - write_src(STerm). - -maybe_call_directive((:- op(X,F,Y))):- trans_mod:op(X,F,Y). - -% Checks if a term is a directive. -is_directive((:- _)). - -push_term_ctx(X):- \+ compound(X),!, - (nb_current(term_ctx,Was)->true;Was=[]), - (Was =@= X -> true; (nb_setval(term_ctx,X),nl)). -push_term_ctx((X:-_)):- !, push_term_ctx(X). -push_term_ctx(X):- compound_name_arity(X,F,_A),push_term_ctx(F). -% Print a Prolog directive in a specific format. -print_directive((:- Directive)):- - push_term_ctx(exec), % pc - p2m(Directive,STerm), % p2m - write_exec(STerm). %we - - - - diff --git a/metta_vspace/pyswip/metta_data.pl b/metta_vspace/pyswip/metta_data.pl index 90fe9edb..009d4cbc 100755 --- a/metta_vspace/pyswip/metta_data.pl +++ b/metta_vspace/pyswip/metta_data.pl @@ -1,3612 +1,1163 @@ - -/* - LogicMOO Base FOL/PFC Setup -% Dec 13, 2035 -% Douglas Miles - -*/ -% :- if( \+ current_predicate(set_fileAssertMt/1)). - -:- set_prolog_flag(pfc_shared_module,user). -%:- set_prolog_flag(pfc_shared_module,baseKB). - - -control_arg_types(A,B):- once(control_arg_types1([],A,B)),A\==B,!. - -%:- listing(control_arg_types/2). - -control_arg_types1(_,A,B):- \+ compound(A),!,A=B. -control_arg_types1(_,A,B):- (current_predicate(check_args/2)->check_args(A,B)->A\=@=B),!. -control_arg_types1(Pre,A,B):- - compound_name_arguments(A,F,AA), - length(AA,N), - do_control_arg_types1(F/N,1,Pre,AA,BB), - compound_name_arguments(B,F,BB). - -do_control_arg_types1(_FofN,_ArgNp1,_Pre,[],[]):-!. -do_control_arg_types1(FofN,ArgN,Pre,[A|AA],[B|BB]):- - do_control_1arg_type(FofN,ArgN,Pre,A,B), - ArgNp1 is ArgN+1, - do_control_arg_types1(FofN,ArgNp1,Pre,AA,BB). - -do_control_1arg_type(_FN,_N,_Pre,A,B):- var(A),!,B=A. -do_control_1arg_type(F/_, N,_Pre,A,B):- arg_n_isa(F,N,ISA),into_type(ISA,A,B),!. -do_control_1arg_type(FofN,_,Pre,A,B):- control_arg_types1([FofN|Pre],A,B). - - -arg_n_isa(_F,_N,_ISA):- fail. -arg_n_isa(F,N,ISA):- clause_b(argIsa(F,N,ISA)). - -save_pfc_state:- - %tell(pfcState), - forall((pfcStateTerm(F/A),current_predicate(F/A)),listing(F/A)), - %told. - !. - -pfcDoAll(Goal):- forall(call(Goal),true). - -pfcStateTerm(F/A):- pfcDatabaseTerm(F/A). -pfcStateTerm(F/A):- - member((F/A),[ - fcUndoMethod/2, - fcAction/2, - fcTmsMode/1, - pfcQueue/1, - pfcCurrentDb/1, - pfcHaltSignal/1, - pfcDebugging/0, - pfcSelect/1, - pfcSearch/1]). - - - -:- if(( current_prolog_flag(xref,true) ; - ('$current_source_module'(SM),'context_module'(M),'$current_typein_module'(CM), - current_prolog_flag(pfc_shared_module,BaseKB),asserta(BaseKB:'wusing_pfc'(M,CM,SM,pfc_rt))))). -:- endif. -:- if(current_prolog_flag(xref,true)). -%:- module(pfc_rt,[]). -:- endif. -:- if((prolog_load_context(source,File),prolog_load_context(file,File))). -%:- prolog_load_context(file,File),unload_file(File). -:- use_module(library(logicmoo_utils)). -:- endif. -%:- pfc_lib:use_module(pfc_lib). -:- if( \+ current_prolog_flag(xref,true)). -:- current_prolog_flag(pfc_shared_module,BaseKB), - must(retract(BaseKB:'wusing_pfc'(M,CM,SM,pfc_rt))), - nop(fbugio(BaseKB:'chusing_pfc'(M,CM,SM,pfc_rt))), - (M==SM -> - (nop(maybe_ensure_abox(SM)),nop((M:ain(genlMt(SM,BaseKB))))); - nop(fbugio(BaseKB:'lusing_pfc'(M,CM,SM,pfc_rt)))), - assert(BaseKB:'$using_pfc'(M,CM,SM,pfc_rt)), - asserta(SM:'$does_use_pfc_mod'(M,CM,SM,pfc_rt)). - %backtrace(200). - -/* -:- multifile '$exported_op'/3. -:- dynamic '$exported_op'/3. -:- discontiguous '$exported_op'/3. -'$exported_op'(_,_,_):- fail. -*/ - -:- multifile '$pldoc'/4. -:- dynamic '$pldoc'/4. -:- discontiguous '$pldoc'/4. -'$pldoc'(_,_,_,_):- fail. - -:- multifile '$autoload'/3. -:- discontiguous '$autoload'/3. -:- dynamic '$autoload'/3. -'$autoload'(_,_,_):- fail. - -:- system:use_module(library(make)). -%:- set_prolog_flag(retry_undefined, kb_shared). -%:- set_prolog_flag(pfc_ready, true). -:- set_prolog_flag(expect_pfc_file,unknown). -:- endif. - -:- ifprolog:import(date:day_of_the_week/2). -:- ifprolog:import(date:day_of_the_year/2). - - -tilded_negation. - -bagof_or_nil(T,G,L):- bagof(T,G,L)*->true;L=[]. -setof_or_nil(T,G,L):- setof(T,G,L)*->true;L=[]. - -call_u(G):- pfcCallSystem(G). -clause_u(H,B):- clause(H,B). - -mpred_ain(P):- arc_assert(P). -arc_assert(P:-True):- True==true,!,arc_assert(P). -arc_assert(P):- % fbugio(arc_assert(P)), - must(current_why_UU(UU)),nop(fbugio(pfcAdd(P, UU))),!, pfcAdd(P, UU),asserta_if_new(P). - -pfc_retract(P):- fbugio(pfc_retract(P)),pfcRetract(P). -pfc_retractall(P):- fbugio(pfc_retractall(P)),pfcRetractAll(P). - -:- dynamic((~)/1). -~(_):- fail. -must_ex(X):-must(X). -quietly_ex(X):-call(X). - -add(X):- pfcAdd(X). - - -mpred_test(call_u(X)):- nonvar(X),!,pfcCallSystem(X),pfcWhy(X). -mpred_test(\+ call_u(X)):- nonvar(X),!, (call_u(X)-> (fbugio(warn(failed(mpred_test(\+ call_u(X))))),mpred_test_why(X)); mpred_test_why(~(X))). -mpred_test(X):- (mpred_test_why(X) *-> true ; mpred_test_why(~(X))). - -:- thread_local t_l:shown_child/1. -:- thread_local t_l:shown_dep/2. - -pfc_info(X):- mpred_info(X). -mpred_info(X):- - retractall(t_l:shown_child(_)), - retractall(t_l:shown_dep(_,_)), - ignore(( - forall(mpred_test_why(X),true), - forall(mpred_child_info(X),true))). - -mpred_child_info(P):- - retractall(t_l:shown_child(_)), - show_child_info(P),!, - printLine. - -show_child_info(P):- - pfcChildren(P,L), - show_child_info(P,L),!. - -show_child_info(P,_):- t_l:shown_child(Q),P=@=Q,!. -show_child_info(P,_):- asserta(t_l:shown_child(P)),fail. -show_child_info(_,[]):-!. -show_child_info(P,L):- list_to_set(L,S), - format("~N~nChildren for ",[]), - ansi_format([fg(green)],'~@',[pp(P)]), - format(" :~n",[]), - forall((member(D,S), \+ t_l:shown_dep(P,D)),(asserta(t_l:shown_dep(P,D)),ansi_format([fg(yellow)],'~N ~@. ~n',[pp(D)]))), - my_maplist(show_child_info,S). - -mpred_why(X):- mpred_test_why(X). - -mpred_test_why(X):- - pfcCallSystem(X)*->pfcTF1(X);pfcTF1(X). - -mpred_literal(X):- pfcLiteral(X). -mpred_positive_literal(X):- pfcPositiveLiteral(X). -pfcAtom(X):- pfcLiteral(X). -rem(X):- pfcWithdraw(X). -rem2(X):- pfcRemove(X). -remove(X):- pfcBlast(X). - -% :- mpred_ain_in_thread. -% :- current_thread_pool(ain_pool)->true;thread_pool_create(ain_pool,20,[]). -:- multifile thread_pool:create_pool/1. -:- dynamic thread_pool:create_pool/1. -thread_pool:create_pool(ain_pool) :- - thread_pool_create(ain_pool, 50, [detached(true)] ). - -:- use_module(library(http/thread_httpd)). -:- use_module(library(thread_pool)). - -is_ain_pool_empty:- thread_pool_property(ain_pool,running(N)),!,N==0. -is_ain_pool_empty. - -show_ain_pool:- forall(thread_pool_property(ain_pool,PP),fmt(show_ain_pool(PP))). - -await_ain_pool:- is_ain_pool_empty->true;(repeat, sleep(0.005), is_ain_pool_empty). - -ain_in_thread(MAIN):- strip_module(MAIN,M,AIN), call_in_thread(M:pfcAdd(AIN)). - -call_in_thread(MG):- strip_module(MG,M,G), notrace((copy_term(M:G,GG,_),numbervars(GG,0,_,[attvar(skip),singletons(true)]),term_to_atom(GG,TN))), - call_in_thread(TN,M,G), - dmsg_pretty(call_in_thread(TN,M,G)). - -call_in_thread(TN,M,G):- thread_property(_,alias(TN)),!,dmsg_pretty(already_queued(M,G)). -call_in_thread(TN,M,G):- must(current_why(Why)), thread_create_in_pool(ain_pool,call_in_thread_code(M,G,Why,TN),_Id,[alias(TN)]). - -call_in_thread_code(M,G,Why,TN):- - with_only_current_why(Why, - catch(( M:G-> nop(dmsg_pretty(suceeded(exit,TN)));dmsg_pretty(failed(exit,TN))),E, dmsg_pretty(error(E-->TN)))). - -%:- call_in_thread(fbugio(call_in_thread)). -% why_dmsg(Why,Msg):- with_current_why(Why,dmsg_pretty(Msg)). - -% File : pfc -% Author : Tim Finin, finin@umbc.edu -% Updated: 10/11/87, ... -% Purpose: consult system file for ensure - -pfcVersion(3.0). - -/* -pfcFile('pfcsyntax'). % operator declarations. -pfcFile('pfccore'). % core of Pfc. -pfcFile('pfcsupport'). % support maintenance -pfcFile('pfcdb'). % predicates to manipulate database. -pfcFile('pfcdebug'). % debugging aids (e.g. tracing). -pfcFile('pfcjust'). % predicates to manipulate justifications. -pfcFile('pfcwhy'). % interactive exploration of justifications. - -pfcLoad :- pfcFile(F), ensure_loaded(F), fail. -pfcLoad. -*/ - -%pfcFcompile :- pfcFile(F), compile(F), fail. -%pfcFcompile. - -%:- pfcLoad. - -% File : pfccompile.pl -% Author : Tim Finin, finin@prc.unisys.com -% Updated: 10/11/87, ... -% Purpose: compile system file for Pfc -/* -:- compile(pfcsyntax). -:- compile(pfccore). -:- compile(pfcdb). -:- compile(pfcjust). -:- compile(pfcwhy). -:- compile(pfcdebug). -*/ - -% File : pfcsyntax.pl -% Author : Tim Finin, finin@prc.unisys.com -% Purpose: syntactic sugar for Pfc - operator definitions and term expansions. - -:- op(500,fx,'~'). -:- op(1050,xfx,('==>')). -:- op(1050,xfx,'<==>'). -:- op(1050,xfx,('<-')). -:- op(1100,fx,('==>')). -:- op(1150,xfx,('::::')). - - -:- dynamic(pfctmp:knows_will_table_as/2). - -will_table_as(Stuff,As):- pfctmp:knows_will_table_as(Stuff,As),!. -will_table_as(Stuff,As):- assert(pfctmp:knows_will_table_as(Stuff,As)), - must(react_tabling(Stuff,As)),!,fail. - -react_tabling(Stuff,_):- dynamic(Stuff). - -:- dynamic(lmconf:is_treated_like_pfc_file/1). -:- dynamic(lmconf:is_pfc_module/1). -if_pfc_indicated :- source_location(F,_),(sub_string(F, _, _, _, '.pfc')->true;lmconf:is_treated_like_pfc_file(F)),!. -if_pfc_indicated :- prolog_load_context(module, M),lmconf:is_pfc_module(M),!. - -skip_pfc_term_expansion(Var):- var(Var),!. -skip_pfc_term_expansion(begin_of_file). -skip_pfc_term_expansion(end_of_file). - -:- export(pfc_term_expansion/2). -:- system:import(pfc_term_expansion/2). -pfc_term_expansion(I,O):- skip_pfc_term_expansion(I),!, I=O. -pfc_term_expansion((:- table Stuff as Type), [:- pfcAdd(tabled_as(Stuff,Type)),(:- table Stuff as Type)]):- nonvar(Stuff), !, if_pfc_indicated, \+ will_table_as(Stuff, Type). -pfc_term_expansion((:- table Stuff ), [:- pfcAdd(tabled_as(Stuff,incremental)),(:- table Stuff as incremental)]):- if_pfc_indicated, \+ will_table_as(Stuff,incremental). -pfc_term_expansion((:- _),_):- !, fail. -pfc_term_expansion((P==>Q),(:- pfcAdd((P==>Q)))). -%term_expansion((P==>Q),(:- pfcAdd(('<-'(Q,P))))). % speed-up attempt -pfc_term_expansion(('<-'(P,Q)),(:- pfcAdd(('<-'(P,Q))))). -pfc_term_expansion((P<==>Q),(:- pfcAdd((P<==>Q)))). -pfc_term_expansion((RuleName :::: Rule),(:- pfcAdd((RuleName :::: Rule)))). -pfc_term_expansion((==>P),(:- pfcAdd(P))). -pfc_term_expansion(I,I):- I == end_of_file,!. -pfc_term_expansion( P ,(:- pfcAdd(P))):- if_pfc_indicated. - -%use_pfc_term_expansion:- current_prolog_flag(pfc_term_expansion,false),!,fail. -% maybe switch to prolog_load_context(file,...)? -%use_pfc_term_expansion:- source_location(File,_), atom_concat(_,'.pfc.pl',File). - -term_subst(P,O):- term_subst(clause,P,O),!. - -term_subst(_, P,O):- \+ compound(P),!,O=P. - -term_subst(tilded_negation,P,O):- !, term_subst( - [(not)-(~), - (=>)-(==>), - (<=>)-(<==>), - (<=)-(<-)],P,O). - -term_subst(Subst,P,O):- - compound_name_arguments(P,F,Args), - my_maplist(term_subst(Subst),Args,ArgsL), - termf_subst(Subst,F,F2), - compound_name_arguments(O,F2,ArgsL). - -termf_subst(Subst,F,F2):-member(F-F2,Subst)->true;F=F2. - - -% File : pfccore.pl -% Author : Tim Finin, finin@prc.unisys.com -% Updated: 10/11/87, ... -% 4/2/91 by R. McEntire: added calls to valid_dbref as a -% workaround for the Quintus 3.1 -% bug in the recorded database. -% Purpose: core Pfc predicates. - -:- use_module(library(lists)). - - -%==>(_). - -% ==>(G):- arc_assert(G). - -%:- multifile ('<-')/2. -%:- dynamic ('<-')/2. -%:- discontiguous(('<-')/2). -%'<-'(_,_). - -%:- multifile ('==>')/2. -%:- dynamic ('==>')/2. -%:- discontiguous(('==>')/2). -%'==>'(_,_). - -%:- multifile ('==>')/2. -%:- dynamic ('::::')/2. -%:- dynamic '<==>'/2. -:- dynamic '$pt$'/2. -:- dynamic '$nt$'/3. -:- dynamic '$bt$'/2. -:- dynamic fcUndoMethod/2. -:- dynamic fcAction/2. -:- dynamic fcTmsMode/1. -:- dynamic pfcQueue/1. -:- dynamic pfcCurrentDb/1. -:- dynamic pfcHaltSignal/1. -:- dynamic pfcDebugging/0. -:- dynamic pfcSelect/1. -:- dynamic pfcSearch/1. - -:- thread_local(t_l:pfcSearchTL/1). - -:- dynamic '$spft$'/3. - -% % % initialization of global assertons - -pfcSetVal(Stuff):- - duplicate_term(Stuff,DStuff), - functor(DStuff,_,N), - setarg(N,DStuff,_), - retractall(DStuff), - assert(Stuff). - -% % pfcDefault/1 initialized a global assertion. -% % pfcDefault(P,Q) - if there is any fact unifying with P, then do -% % nothing, else assert Q. - -pfcDefault(GeneralTerm,Default) :- - clause(GeneralTerm,true) -> true ; assert(Default). - -% % fcTmsMode is one of {none,local,cycles} and controles the tms alg. -:- pfcDefault(fcTmsMode(_), fcTmsMode(cycles)). - -% Pfc Search strategy. pfcSearch(X) where X is one of {direct,depth,breadth} -:- pfcDefault(pfcSearch(_), pfcSearch(direct)). - - -% - -% % pfcAdd/2 and pfcPost/2 are the main ways to assert new clauses into the -% % database and have forward reasoning done. - -% % pfcAdd(P,S) asserts P into the dataBase with support from S. - -pfcAdd(P) :- must(current_why_UU(UU)), with_current_why(P, pfcAdd(P, UU)). - -pfcAdd((==>P),S) :- !, pfcAdd(P,S). - -pfcAdd(P,S) :- - pfcPost(P,S), - pfcRun,!. - -%pfcAdd(_,_). -pfcAdd(P,S) :- pfcWarn("pfcAdd(~p,~p) failed",[P,S]). - - -% pfcPost(+Ps,+S) tries to add a fact or set of fact to the database. For -% each fact (or the singelton) pfcPost1 is called. It always succeeds. - -pfcPost(List,S):- pfcPost_rev(S,List). - -pfcPost_rev(S,Term) :- - is_list(Term) - -> my_maplist(pfcPost_rev(S),Term) - ; pfcPost1(Term,S). - - -% pfcPost1(+P,+S) tries to add a fact to the database, and, if it succeeded, -% adds an entry to the pfc queue for subsequent forward chaining. -% It always succeeds. - -pfcPost1(Fact,S) :- control_arg_types(Fact,Fixed),!,pfcPost1(Fixed,S). - -pfcPost1(P,S) :- - % % db pfcAddDbToHead(P,P2), - % pfcRemoveOldVersion(P), - must(pfcAddSupport(P,S)), - (pfcUnique(post, P)-> pfcPost2(P,S) ; true). - -pfcPost2(P,S):- - must(assert(P)), - must(pfcTraceAdd(P,S)), - !, - must(pfcEnqueue(P,S)), - !. - -%pfcPost1(_,_). -%pfcPost1(P,S) :- - %pfcWarn("pfcPost1: ~p\n (support: ~p) failed",[P,S]). - -% % pfcAddDbToHead(+P,-NewP) is semidet. -% talkes a fact P or a conditioned fact -% (P:-C) and adds the Db context. -% - -pfcAddDbToHead(P,NewP) :- - pfcCallSystem(pfcCurrentDb(Db)), - (Db=true -> NewP = P; - P=(Head:-Body) -> NewP = (Head :- (Db,Body)); - true -> NewP = (P :- Db)). - -:- dynamic(pfcCurrentDb/1). -pfcCurrentDb(true). - -% % pfcUnique(X) is det. -% -% is true if there is no assertion X in the prolog db. -% - -pfcUnique(_Type,(Head:-Tail)) :- - !, - \+ clause(Head,Tail). -pfcUnique(_Type, P) :- - \+ clause(P,true). - - -% % pfcEnqueue(P,Q) is det. -% -% Enqueu according to settings -% -pfcSetSearch(Mode):- pfcSetVal(pfcSearch(Mode)). - -pfcGetSearch(Mode):- (t_l:pfcSearchTL(ModeT)->true;pfcSearch(ModeT))->Mode=ModeT. - -pfcEnqueue(P,S) :- - pfcGetSearch(Mode) - -> (Mode=direct -> pfcFwd(P) ; - Mode=thread -> pfcThreadFwd(P,S) ; - Mode=depth -> pfcAsserta(pfcQueue(P),S) ; - Mode=breadth -> pfcAssert(pfcQueue(P),S) ; - true -> pfcWarn("Unrecognized pfcSearch mode: ~p", Mode)) - ; pfcWarn("No pfcSearch mode"). - - - -% % pfcRemoveOldVersion(+Rule) is det. -% -% if there is a rule of the form Identifier ::: Rule then delete it. - -pfcRemoveOldVersion((Identifier::::Body)) :- - % this should never happen. - (var(Identifier) - -> - pfcWarn("variable used as an rule name in ~p :::: ~p", - [Identifier,Body]); - pfcRemoveOldVersion0(Identifier::::Body)). - - -pfcRemoveOldVersion0((Identifier::::Body)) :- - nonvar(Identifier), - clause((Identifier::::OldBody),_), - \+(Body=OldBody), - pfcWithdraw((Identifier::::OldBody)), - !. -pfcRemoveOldVersion0(_). - - -% % with_fc_mode(+Mode,:Goal) is semidet. -% -% Temporariliy changes to forward chaining propagation mode while running the Goal -% -with_fc_mode(Mode,Goal):- locally(t_l:pfcSearchTL(Mode),Goal). - - -pfcThreadFwd(S,P):- - with_only_current_why(S, - % maybe keep `thread` mode? - call_in_thread(with_fc_mode(thread, (pfcFwd(P))))). - -% in_fc_call(Goal):- with_fc_mode( thread, Goal). -%in_fc_call(Goal):- with_fc_mode( direct, Goal). -% in_fc_call(Goal):- !, pfcCallSystem(Goal). - - - - -% - -% pfcRun compute the deductive closure of the current database. -% How this is done depends on the searching mode: -% direct - fc has already done the job. -% depth or breadth - use the pfcQueue mechanism. - -pfcRun :- - (\+ pfcGetSearch(direct)), - pfcStep, - pfcRun. -pfcRun. - - -% pfcStep removes one entry from the pfcQueue and reasons from it. - - -pfcStep :- - % if pfcHaltSignal(Msg) is true, reset it and fail, thereby stopping inferencing. - pfcRetract(pfcHaltSignal(Msg)), - pfcTraceMsg(removing(pfcHaltSignal(Msg))), - !, - fail. - -pfcStep :- - % draw immediate conclusions from the next fact to be considered. - % fails iff the queue is empty. - get_next_fact(P), - pfcdo(pfcFwd(P)), - !. - -get_next_fact(P) :- - %identifies the nect fact to fc from and removes it from the queue. - select_next_fact(P), - remove_selection(P). - -remove_selection(P) :- - pfcRetract(pfcQueue(P)), - pfcRemoveSupportsQuietly(pfcQueue(P)), - !. -remove_selection(P) :- - brake(pfcPrintf("pfc:get_next_fact - selected fact not on Queue: ~p", - [P])). - - -% select_next_fact(P) identifies the next fact to reason from. -% It tries the user defined predicate first and, failing that, -% the default mechanism. - -select_next_fact(P) :- - pfcSelect(P), - !. -select_next_fact(P) :- - defaultpfcSelect(P), - !. - -% the default selection predicate takes the item at the froint of the queue. -defaultpfcSelect(P) :- pfcCallSystem(pfcQueue(P)),!. - -% pfcHalt stops the forward chaining. -pfcHalt :- pfcHalt("unknown_reason",[]). - -pfcHalt(Format) :- pfcHalt(Format,[]). - -pfcHalt(Format,Args) :- - format(string(Msg),Format,Args), - (pfcHaltSignal(Msg) -> - pfcWarn("pfcHalt finds pfcHaltSignal(~w) already set",[Msg]) - ; assert(pfcHaltSignal(Msg))). - - -% % -% % -% % predicates for manipulating triggers -% % - -pfcAddTrigger('$pt$'(Trigger,Body),Support) :- - !, - pfcTraceMsg(' Adding positive trigger(+) ~p~n', - ['$pt$'(Trigger,Body)]), - pfcAssert('$pt$'(Trigger,Body),Support), - copy_term('$pt$'(Trigger,Body),Tcopy), - pfc_call(Trigger), - with_current_why(Trigger,fcEvalLHS(Body,(Trigger,Tcopy))), - fail. - - -pfcAddTrigger('$nt$'(Trigger,Test,Body),Support) :- - !, - pfcTraceMsg(' Adding negative trigger(-): ~p~n test: ~p~n body: ~p~n', - [Trigger,Test,Body]), - copy_term(Trigger,TriggerCopy), - pfcAssert('$nt$'(TriggerCopy,Test,Body),Support), - \+ pfc_call(Test), - with_current_why(\+ pfc_call(Test), fcEvalLHS(Body,((\+Trigger),'$nt$'(TriggerCopy,Test,Body)))). - -pfcAddTrigger('$bt$'(Trigger,Body),Support) :- - !, - pfcAssert('$bt$'(Trigger,Body),Support), - pfcBtPtCombine(Trigger,Body,Support). - -pfcAddTrigger(X,_Support) :- - pfcWarn("Unrecognized trigger(?) to pfcAddtrigger: ~p",[X]). - - -pfcBtPtCombine(Head,Body,Support) :- - % % a backward trigger(?) ('$bt$') was just added with head and Body and support Support - % % find any '$pt$'(s) with unifying heads and add the instantied '$bt$' body. - pfcGetTriggerQuick('$pt$'(Head,_PtBody)), - fcEvalLHS(Body,Support), - fail. -pfcBtPtCombine(_,_,_) :- !. - -pfcGetTriggerQuick(Trigger) :- clause(Trigger,true)*->true;pfc_call(Trigger). -pfcCallSystem(Trigger) :- pfc_call(Trigger). - -% % -% % -% % predicates for manipulating action traces. -% % - -pfcAddActionTrace(Action,Support) :- - % adds an action trace and it''s support. - pfcAddSupport(pfcAction(Action),Support). - -pfcRemActionTrace(pfcAction(A)) :- - fcUndoMethod(A,UndoMethod), - pfcCallSystem(UndoMethod), - !. - - -% % -% % predicates to remove pfc facts, triggers, action traces, and queue items -% % from the database. -% % - -pfcRetract(X) :- - % % retract an arbitrary thing. - pfcType(X,Type), - pfcRetractType(Type,X), - !. - -pfcRetractType(fact(_),X) :- - % % db - pfcAddDbToHead(X,X2)-> retract(X2) ; retract(X). - -pfcRetractType(rule(_),X) :- - % % db - pfcAddDbToHead(X,X2) -> retract(X2) ; retract(X). - -pfcRetractType(trigger(Pos),X) :- - retract(X) - -> unFc(X) - ; pfcWarn("Trigger(~p) not found to retract: ~p",[Pos,X]). - -pfcRetractType(action,X) :- pfcRemActionTrace(X). - - -% % pfcAddType1(X) adds item X to some database - -pfcAddType1(X) :- - % what type of X do we have? - pfcType(X,Type), - pfcAddDbToHead(X,X2), - % call the appropriate predicate. - pfcAddType(Type,X2). - -pfcAddType(fact(Type),X) :- - pfcUnique(fact(Type),X), - assert(X),!. -pfcAddType(rule(Type),X) :- - pfcUnique(rule(Type),X), - assert(X),!. -pfcAddType(trigger(Pos),X) :- - pfcUnique(trigger(Pos),X) -> assert(X) ; - (pfcWarn(not_pfcUnique(X)),assert(X)). - -pfcAddType(action,_Action) :- !. - - - - -% pfcWithdraw/1 withdraws any "direct" support for P. -% If a list, iterates down the list -pfcWithdraw(P) :- is_list(P),!,my_maplist(pfcWithdraw,P). -pfcWithdraw(P) :- matches_why_UU(UU), pfcWithdraw(P,UU). -% % pfcWithdraw(P,S) removes support S from P and checks to see if P is still supported. -% % If it is not, then the fact is retractred from the database and any support -% % relationships it participated in removed. -pfcWithdraw(P,S) :- - % pfcDebug(pfcPrintf("removing support ~p from ~p",[S,P])), - pfcGetSupport(P,S), - matterialize_support_term(S,Sup), - pfcTraceMsg(' Withdrawing direct support: ~p \n From: ~p~n',[Sup,P]), - (pfcRemOneSupportOrQuietlyFail(P,S) - -> pfcTraceMsg(' Success removing support: ~p \n From: ~p~n',[Sup,P]) - ; pfcWarn("pfcRemOneSupport/2 Could not find support ~p thus\n Did not pfcRemOneSupport: ~p", - [Sup,P])), - removeIfUnsupported(P). - -pfcWithdraw(P,S) :- - matterialize_support_term(S,Sup), - pfcTraceMsg(' No support matching: ~p \n For: ~p~n',[Sup,P]),!, - removeIfUnsupported(P). - -% pfcRetractAll/1 withdraws any "direct" and "indirect" support for P. -% If a list, iterates down the list -pfcRetractAll(P) :- is_list(P),!,my_maplist(pfcRetractAll,P). -pfcRetractAll(P) :- matches_why_UU(UU), pfcRetractAll(P,UU). - -% % pfcRetractAll(P,S) removes support S from P and checks to see if P is still supported. -% % If it is not, then the fact is retreactred from the database and any support -% % relationships it participated in removed. - -pfcRetractAll(Fact,S) :- control_arg_types(Fact,Fixed),!,pfcRetractAll(Fixed,S). -pfcRetractAll(P,S) :- - \+ \+ pfcWithdraw(P,S), - fail. -pfcRetractAll(P,S) :- - pfcGetSupport(P,(P2,_)), - pfcType(P2,fact(_)), - pfcSupportedBy(P2,S,_How), - pfcRetractAll(P2), - \+ fcSupported(P),!, - fcUndo(P). -pfcRetractAll(P,S) :- - pfcGetSupport( P,(_,T)), - pfcGetSupport(T,(P2,_)), - pfcSupportedBy(P2,S,_How), - pfcType(P2,fact(_)), - pfcRetractAll(P2), - \+ fcSupported(P),!, - fcUndo(P). -pfcRetractAll(P,S) :- - fcSupported(P), - pfcGetSupport(P,(P2,_)), - pfcSupportedBy(P2,S,_How), - pfcType(P2,rule(_)), - pfcRetractAll(P2), - \+ fcSupported(P), - fcUndo(P),!. -pfcRetractAll(P,_S0) :- - removeIfUnsupported(P), - fail. -pfcRetractAll(_,_). - - -pfcSupportedBy(P,S,How):- - pfcGetSupport(P,(F,T)), - (pfcSupportedBy(F,S,_)->How=F; - pfcSupportedBy(T,S,How)). - -pfcSupportedBy(P,S,How):-P=S,How=S. - -pfcRetractAll_v2(P,S0) :- - \+ \+ pfcWithdraw(P,S0), - pfcGetSupport(P,(S,RemoveIfTrigger)), - % pfcDebug(pfcPrintf("removing support ~p from ~p",[S,P])), - matterialize_support_term((S,RemoveIfTrigger),Sup), - pfcTraceMsg(' Removing support: ~p \n From: ~p~n',[Sup,P]), - (pfcRemOneSupportOrQuietlyFail(P,(S,RemoveIfTrigger)) - -> pfcTraceMsg(' Success removing support: ~p \n From: ~p~n',[Sup,P]) - ; (pfcWarn("pfcRemOneSupport/2 Could not find support ~p thus\n Did not yet pfcRetractAll_v2: ~p", - [Sup,P]))), - pfcRetractAll_v2(S, S0), - fail. - -pfcRetractAll_v2(P,_):- removeIfUnsupported(P). - -% pfcRemove/1 is the user''s interface - it withdraws user support for P. -% -% pfcRemove is like pfcRetractAll, but if P is still in the DB after removing the -% user's support, it is retracted by more forceful means (e.g. pfcBlast). -% -pfcRemove(Fact) :- control_arg_types(Fact,Fixed),!,pfcRemove(Fixed). -pfcRemove(P) :- - pfcRetractAll(P), - pfc_call(P) - -> pfcBlast(P) - ; true. - - -% % pfcBlast(+F) is det -% -% retracts fact F from the DB and removes any dependent facts -% - -pfcBlast(F) :- - pfcRemoveSupports(F), - fcUndo(F). - - -% removes any remaining supports for fact F, complaining as it goes. - -pfcRemoveSupports(F) :- - pfcRemOneSupport(F,S), - pfcWarn("~p was still supported by ~p (but no longer)",[F,S]), - fail. -pfcRemoveSupports(_). - -pfcRemoveSupportsQuietly(F) :- - pfcRemOneSupport(F,_), - fail. -pfcRemoveSupportsQuietly(_). - -% fcUndo(X) undoes X. - - -fcUndo(pfcAction(A)) :- - % undo an action by finding a method and successfully executing it. - !, - pfcRemActionTrace(pfcAction(A)). - -fcUndo('$pt$'(/*Key,*/Head,Body)) :- - % undo a positive trigger(+). - % - !, - (retract('$pt$'(/*Key,*/Head,Body)) - -> unFc('$pt$'(Head,Body)) - ; pfcWarn("Trigger not found to retract: ~p",['$pt$'(Head,Body)])). - -fcUndo('$nt$'(Head,Condition,Body)) :- - % undo a negative trigger(-). - !, - (retract('$nt$'(Head,Condition,Body)) - -> unFc('$nt$'(Head,Condition,Body)) - ; pfcWarn("Trigger not found to retract: ~p",['$nt$'(Head,Condition,Body)])). - -fcUndo(Fact) :- - % undo a random fact, printing out the trace, if relevant. - retract(Fact), - pfcTraceRem(Fact), - unFc(Fact). - - -% % unFc(P) is det. -% -% unFc(P) "un-forward-chains" from fact f. That is, fact F has just -% been removed from the database, so remove all dependant relations it -% participates in and check the things that they support to see if they -% should stayu in the database or should also be removed. - - -unFc(F) :- - pfcRetractDependantRelations(F), - unFc1(F). - -unFc1(F) :- - pfcUnFcCheckTriggers(F), - % is this really the right place for pfcRun pfcRemOneSupport(P,(_,Fact)) - ; pfcRemOneSupportOrQuietlyFail(P,(Fact,_))), - removeIfUnsupported(P), - fail. -pfcRetractDependantRelations(_). - - - -% % removeIfUnsupported(+P) checks to see if P is supported and removes -% % it from the DB if it is not. - -removeIfUnsupported(P) :- - fcSupported(P) -> pfcTraceMsg(fcSupported(P)) ; fcUndo(P). - - -% % fcSupported(+P) succeeds if P is "supported". What this means -% % depends on the TMS mode selected. - -fcSupported(P) :- - must(fcTmsMode(Mode)), - supported(Mode,P). - -supported(local,P) :- !, pfcGetSupport(P,_). -supported(cycles,P) :- !, wellFounded(P). -supported(_,_P) :- true. - - -% % -% % a fact is well founded if it is supported by the user -% % or by a set of facts and a rules, all of which are well founded. -% % - -wellFounded(Fact) :- wf(Fact,[]). - -wf(F,_) :- - % supported by user (axiom) or an "absent" fact (assumption). - (axiom(F) ; assumption(F)), - !. - -wf(F,Descendants) :- - % first make sure we aren't in a loop. - (\+ memberchk(F,Descendants)), - % find a justification. - supports(F,Supporters), - % all of whose members are well founded. - wflist(Supporters,[F|Descendants]), - !. - -% % wflist(L) simply maps wf over the list. - -wflist([],_). -wflist([X|Rest],L) :- - wf(X,L), - wflist(Rest,L). - - - -% supports(+F,-ListofSupporters) where ListOfSupports is a list of the -% supports for one justification for fact F -- i.e. a list of facts which, -% together allow one to deduce F. One of the facts will typically be a rule. -% The supports for a user-defined fact are: [user]. - -supports(F,[Fact|MoreFacts]) :- - pfcGetSupport(F,(Fact,Trigger)), - triggerSupports(Trigger,MoreFacts). - -triggerSupports(U,[]) :- axiomatic_supporter(U),!. - -triggerSupports(Trigger,AllSupport):- - triggerSupports1(Trigger,AllSupport)*->true;triggerSupports2(Trigger,AllSupport). - -triggerSupports1(Trigger,AllSupport) :- - pfcGetSupport(Trigger,(Fact,AnotherTrigger)), - (triggerSupports(AnotherTrigger,MoreFacts)*->true;MoreFacts=[AnotherTrigger]), - [Fact|MoreFacts] = AllSupport. - -triggerSupports2(Trigger,AllSupport) :- fail, - pfcGetSupport(Trigger,(Fact,AnotherTrigger)), - (triggerSupports(AnotherTrigger,MoreFacts)*->true;MoreFacts=[AnotherTrigger]), - [Fact|MoreFacts] = AllSupport. - -axiomatic_supporter(Var):-is_ftVar(Var),!,fail. -axiomatic_supporter(is_ftVar(_)). -axiomatic_supporter(clause_u(_)). -axiomatic_supporter(user(_)). -axiomatic_supporter(U):- is_file_ref(U),!. -axiomatic_supporter(ax):-!. - -is_file_ref(A):-compound(A),A=mfl4(_VarNameZ,_,_,_). - -triggerSupports(_,Var,[is_ftVar(Var)]):-is_ftVar(Var),!. -triggerSupports(_,U,[]):- axiomatic_supporter(U),!. -triggerSupports(FactIn,Trigger,OUT):- - pfcGetSupport(Trigger,(Fact,AnotherTrigger))*-> - (triggerSupports(Fact,AnotherTrigger,MoreFacts),OUT=[Fact|MoreFacts]); - triggerSupports1(FactIn,Trigger,OUT). - -triggerSupports1(_,X,[X]):- may_cheat. -may_cheat:- fail. - - - -% % -% % -% % pfcFwd(X) forward chains from a fact or a list of facts X. -% % -pfcFwd(Fact) :- control_arg_types(Fact,Fixed),!,pfcFwd(Fixed). -pfcFwd(Fact) :- is_list(List)->my_maplist(pfcFwd1,List);pfcFwd1(Fact). - -% fc1(+P) forward chains for a single fact. - - -pfcFwd1(Fact) :- - (fc_rule_check(Fact)*->true;true), - copy_term(Fact,F), - % check positive triggers - ignore(fcpt(Fact,F)), - % check negative triggers - ignore(fcnt(Fact,F)). - - -% % -% % fc_rule_check(P) does some special, built in forward chaining if P is -% % a rule. -% % - -fc_rule_check((Name::::P==>Q)) :- - !, - processRule(P,Q,(Name::::P==>Q)). -fc_rule_check((Name::::P<==>Q)) :- - !, - processRule(P,Q,((Name::::P<==>Q))), - processRule(Q,P,((Name::::P<==>Q))). - - - -fc_rule_check((P==>Q)) :- - !, - processRule(P,Q,(P==>Q)). -fc_rule_check((P<==>Q)) :- - !, - processRule(P,Q,(P<==>Q)), - processRule(Q,P,(P<==>Q)). - -fc_rule_check(('<-'(P,Q))) :- - !, - pfcDefineBcRule(P,Q,('<-'(P,Q))). - -fc_rule_check(_). - - -fcpt(Fact,F) :- - pfcGetTriggerQuick('$pt$'(F,Body)), - pfcTraceMsg(' Found positive trigger(+): ~p~n body: ~p~n', - [F,Body]), - pfcGetSupport('$pt$'(F,Body),Support), %fbugio(pfcGetSupport('$pt$'(F,Body),Support)), - with_current_why(Support,with_current_why(Fact,fcEvalLHS(Body,(Fact,'$pt$'(F,Body))))), - fail. - -%fcpt(Fact,F) :- -% pfcGetTriggerQuick('$pt$'(presently(F),Body)), -% fcEvalLHS(Body,(presently(Fact),'$pt$'(presently(F),Body))), -% fail. - -fcpt(_,_). - -fcnt(_Fact,F) :- - pfc_spft(X,_,'$nt$'(F,Condition,Body)), - pfcCallSystem(Condition), - pfcRem_S(X,(_,'$nt$'(F,Condition,Body))), - fail. -fcnt(_,_). - - -% % pfcRem_S(P,S) removes support S from P and checks to see if P is still supported. -% % If it is not, then the fact is retreactred from the database and any support -% % relationships it participated in removed. -pfcRem_S(P,S) :- - % pfcDebug(pfcPrintf("removing support ~p from ~p",[S,P])), - pfcTraceMsg(' Removing support: ~p from ~p~n',[S,P]), - pfcRemOneSupport(P,S) - -> removeIfUnsupported(P) - ; pfcWarn("pfcRem_S/2 Could not find support ~p to remove from fact ~p", - [S,P]). - - - -% % pfcDefineBcRule(+Head,+Body,+ParentRule) -% -% defines a backward -% chaining rule and adds the corresponding '$bt$' triggers to the database. -% - -pfcDefineBcRule(Head,_Body,ParentRule) :- - (\+ pfcLiteral(Head)), - pfcWarn("Malformed backward chaining rule. ~p not atomic literal.",[Head]), - pfcError("caused by rule: ~p",[ParentRule]), - !, - fail. - -pfcDefineBcRule(Head,Body,ParentRule) :- - copy_term(ParentRule,ParentRuleCopy), - buildRhs(Head,Rhs), - current_why_U(USER), % @TODO REVIEW _U - pfcForEach(pfc_nf(Body,Lhs), - (buildTrigger(Lhs,rhs(Rhs),Trigger), - pfcAdd('$bt$'(Head,Trigger),(ParentRuleCopy,USER)))). -get_bc_clause(Head,(HeadC:- BodyC)):- get_bc_clause(Head,HeadC,BodyC). - -get_bc_clause(HeadIn, ~HeadC, Body):- compound(HeadIn), HeadIn = ~Head,!, - Body = ( awc, - ( nonvar(HeadC)-> (HeadC = Head,!) ; (HeadC = Head)), - pfc_bc_and_with_pfc(~Head)). -get_bc_clause(Head, Head, Body):- % % :- is_ftNonvar(Head). - Body = ( awc, !, pfc_bc_and_with_pfc(Head)). - -:- thread_initialization(nb_setval('$pfc_current_choice',[])). - -push_current_choice:- current_prolog_flag(pfc_support_cut,false),!. -push_current_choice:- prolog_current_choice(CP),push_current_choice(CP),!. -push_current_choice(CP):- nb_current('$pfc_current_choice',Was)->b_setval('$pfc_current_choice',[CP|Was]);b_setval('$pfc_current_choice',[CP]). - -cut_c:- current_prolog_flag(pfc_support_cut,false),!. -cut_c:- must(nb_current('$pfc_current_choice',[CP|_WAS])),prolog_cut_to(CP). - - -% % -% % -% % eval something on the LHS of a rule. -% % - - -fcEvalLHS((Test->Body),Support) :- - !, - pfcDoAll(pfcCallSystem(Test) -> (fcEvalLHS(Body,Support))), - !. - -fcEvalLHS((Test*->Body),Support) :- - !, - pfcDoAll(pfcCallSystem(Test) *-> (fcEvalLHS(Body,Support))). - -fcEvalLHS(rhs(X),Support) :- - !, - pfcDoAll(pfc_eval_rhs(X,Support)), - !. - -fcEvalLHS(X,Support) :- - pfcType(X,trigger(_Pos)), - !, - pfcAddTrigger(X,Support), - !. - -%fcEvalLHS(snip(X),Support) :- -% snip(Support), -% fcEvalLHS(X,Support). - -fcEvalLHS(X,_) :- - pfcWarn("Unrecognized item found in trigger body, namely ~p.",[X]). - - -% % -% % eval something on the RHS of a rule. -% % - -pfc_eval_rhs([],_) :- !. -pfc_eval_rhs([Head|Tail],Support) :- - pfc_eval_rhs1(Head,Support), - pfc_eval_rhs(Tail,Support). - - -pfc_eval_rhs1(Fact,S) :- control_arg_types(Fact,Fixed),!,pfc_eval_rhs1(Fixed,S). - -pfc_eval_rhs1({Action},Support) :- - % evaluable Prolog code. - !, - fcEvalAction(Action,Support). - -pfc_eval_rhs1(P,_Support) :- - % predicate to remove. - pfcNegatedLiteral(P), - !, - pfcWithdraw(P). - -pfc_eval_rhs1([X|Xrest],Support) :- - % embedded sublist. - !, - pfc_eval_rhs([X|Xrest],Support). - -pfc_eval_rhs1(Assertion,Support) :- - % an assertion to be added. - (must(pfcPost1(Assertion,Support))*->true ; pfcWarn("Malformed rhs of a rule: ~p",[Assertion])). - - -% % -% % evaluate an action found on the rhs of a rule. -% % - -fcEvalAction(Action,Support) :- - pfcCallSystem(Action), - (undoable(Action) - -> pfcAddActionTrace(Action,Support) - ; true). - - -% % -% % -% % - -trigger_trigger(Trigger,Body,_Support) :- - trigger_trigger1(Trigger,Body). -trigger_trigger(_,_,_). - - -%trigger_trigger1(presently(Trigger),Body) :- -% !, -% copy_term(Trigger,TriggerCopy), -% pfc_call(Trigger), -% fcEvalLHS(Body,(presently(Trigger),'$pt$'(presently(TriggerCopy),Body))), -% fail. - -trigger_trigger1(Trigger,Body) :- - copy_term(Trigger,TriggerCopy), - pfc_call(Trigger), - with_current_why(Trigger,fcEvalLHS(Body,(Trigger,'$pt$'(TriggerCopy,Body)))), - fail. - - -% % pfc_call(F) is nondet. -% -% pfc_call(F) is true iff F is a fact available for forward chaining. -% Note that this has the side effect of catching unsupported facts and -% assigning them support from God. -% - -%pfc_call(F) :- var(F), !, pfc_call(F). -pfc_call(P) :- var(P), !, pfcFact(P). -pfc_call(P) :- \+ callable(P), throw(pfc_call(P)). -pfc_call((!)) :-!,cut_c. -pfc_call(true):-!. -pfc_call((A->B;C)) :-!, pfc_call(A)->pfc_call(B);pfc_call(C). -pfc_call((A*->B;C)) :-!, pfc_call(A)*->pfc_call(B);pfc_call(C). -pfc_call((A->B)) :-!, pfc_call(A)->pfc_call(B). -pfc_call((A*->B)) :-!, pfc_call(A)*->pfc_call(B). -pfc_call((A,B)) :-!, pfc_call(A),pfc_call(B). -pfc_call((A;B)) :-!, pfc_call(A);pfc_call(B). -pfc_call(\+ (A)) :-!, \+ pfc_call(A). -pfc_call((A is B)) :-!, A is B. -pfc_call(clause(A,B)) :-!, clause(A,B). -pfc_call(clause(A,B,Ref)) :-!, clause(A,B,Ref). -% we really need to check for system predicates as well. -% this is probably not advisable due to extreme inefficiency. -pfc_call(P) :- - % trigger(?) any bc rules. - '$bt$'(P,Trigger), - pfcGetSupport('$bt$'(P,Trigger),S), - % @TODO REVIEW _U - fcEvalLHS(Trigger,S), - fail. -%pfc_call(P) :- var(P), !, pfcFact(P). -pfc_call(P) :- predicate_property(P,imported_from(system)), !, call(P). -pfc_call(P) :- predicate_property(P,built_in), !, call(P). -pfc_call(P) :- \+ predicate_property(P,_), functor(P,F,A), dynamic(F/A), !, call(P). -pfc_call(P) :- \+ predicate_property(P,number_of_clauses(_)), !, call(P). -pfc_call(P) :- - setup_call_cleanup( - nb_current('$pfc_current_choice',Was), - (prolog_current_choice(CP), push_current_choice(CP), clause(P,Condition), pfc_call(Condition)), - nb_setval('$pfc_current_choice',Was)). - -/* -pfc_call(P) :- - clause(P,true)*-> true ; (clause(P,Condition), Condition\==true, - pfc_call(Condition)). -*/ - -% an action is undoable if there exists a method for undoing it. -undoable(A) :- fcUndoMethod(A,_). - -pfc_cache_bc(P) :- - % trigger(?) any bc rules. - forall('$bt$'(P,Trigger), - forall(pfcGetSupport('$bt$'(P,Trigger),S), - % @TODO REVIEW _U - fcEvalLHS(Trigger,S))). - - -% % -% % -% % defining fc rules -% % - -% % pfc_nf(+In,-Out) maps the LHR of a pfc rule In to one normal form -% % Out. It also does certain optimizations. Backtracking into this -% % predicate will produce additional clauses. - - -pfc_nf(LHS,List) :- - pfc_nf1(LHS,List2), - pfc_nf_negations(List2,List). - - -% % pfc_nf1(+In,-Out) maps the LHR of a pfc rule In to one normal form -% % Out. Backtracking into this predicate will produce additional clauses. - -% handle a variable. - -pfc_nf1(P,[P]) :- var(P), !. - -% these next two rules are here for upward compatibility and will go -% away eventually when the P/Condition form is no longer used anywhere. - -pfc_nf1(P/Cond,[( \+P )/Cond]) :- pfcNegatedLiteral(P), !. - -pfc_nf1(P/Cond,[P/Cond]) :- pfcLiteral(P), !. - -% % handle a negated form - -pfc_nf1(NegTerm,NF) :- - pfc_unnegate(NegTerm,Term), - !, - pfc_nf1_negation(Term,NF). - -% % disjunction. - -pfc_nf1((P;Q),NF) :- - !, - (pfc_nf1(P,NF) ; pfc_nf1(Q,NF)). - - -% % conjunction. - -pfc_nf1((P,Q),NF) :- - !, - pfc_nf1(P,NF1), - pfc_nf1(Q,NF2), - append(NF1,NF2,NF). - -% % handle a random atom. - -pfc_nf1(P,[P]) :- - pfcLiteral(P), - !. - -/*% % % shouln't we have something to catch the rest as errors?*/ -pfc_nf1(Term,[Term]) :- - pfcWarn("pfc_nf doesn''t know how to normalize ~p (accepting though)",[Term]). - - -% % pfc_nf1_negation(P,NF) is true if NF is the normal form of \+P. -pfc_nf1_negation((P/Cond),[(\+(P))/Cond]) :- !. - -pfc_nf1_negation((P;Q),NF) :- - !, - pfc_nf1_negation(P,NFp), - pfc_nf1_negation(Q,NFq), - append(NFp,NFq,NF). - -pfc_nf1_negation((P,Q),NF) :- - % this code is not correct! twf. - !, - pfc_nf1_negation(P,NF) - ; - (pfc_nf1(P,Pnf), - pfc_nf1_negation(Q,Qnf), - append(Pnf,Qnf,NF)). - -pfc_nf1_negation(P,[\+P]). - - -% % pfc_nf_negations(List2,List) sweeps through List2 to produce List, -% % changing ~{...} to {\+...} -% % % ? is this still needed? twf 3/16/90 - -pfc_nf_negations(X,X) :- !. % I think not! twf 3/27/90 - -pfc_nf_negations([],[]). - -pfc_nf_negations([H1|T1],[H2|T2]) :- - pfc_nf_negation(H1,H2), - pfc_nf_negations(T1,T2). - -% Maybe \+ tilded_negation ? - -pfc_nf_negation(Form,{\+ X}) :- - nonvar(Form), - Form=(~({X})), - !. -pfc_nf_negation(Form,{\+ X}) :- tilded_negation, - nonvar(Form), - Form=(-({X})), - !. -pfc_nf_negation(Form,{\+ X}) :- tilded_negation, - nonvar(Form), - Form=( \+ ({X})), - !. -pfc_nf_negation(X,X). - - - - % % constrain_meta(+Lhs, ?Guard) is semidet. - % - % Creates a somewhat sane Guard. - % - % To turn this feature off... - % ?- set_prolog_flag(constrain_meta,false). - % - % - constrain_meta(_,_):- current_prolog_flag(constrain_meta,false),!,fail. - % FACT - constrain_meta(P,mpred_positive_fact(P)):- is_ftVar(P),!. - % NEG chaining - constrain_meta(~ P, CP):- !, constrain_meta(P,CP). - constrain_meta(\+ P, CP):- !, constrain_meta(P,CP). - % FWD chaining - constrain_meta((_==>Q),nonvar(Q)):- !, is_ftVar(Q). - % EQV chaining - constrain_meta((P<==>Q),(nonvar(Q);nonvar(P))):- (is_ftVar(Q);is_ftVar(P)),!. - % BWD chaining - constrain_meta((Q <- _),mpred_literal(Q)):- is_ftVar(Q),!. - constrain_meta((Q <- _),CQ):- !, constrain_meta(Q,CQ). - % CWC chaining - constrain_meta((Q :- _),mpred_literal(Q)):- is_ftVar(Q),!. - constrain_meta((Q :- _),CQ):- !, constrain_meta(Q,CQ). - - - - - - is_simple_lhs(ActN):- is_ftVar(ActN),!,fail. - is_simple_lhs( \+ _ ):-!,fail. - is_simple_lhs( ~ _ ):-!,fail. - is_simple_lhs( _ / _ ):-!,fail. - is_simple_lhs((Lhs1,Lhs2)):- !,is_simple_lhs(Lhs1),is_simple_lhs(Lhs2). - is_simple_lhs((Lhs1;Lhs2)):- !,is_simple_lhs(Lhs1),is_simple_lhs(Lhs2). - is_simple_lhs(ActN):- is_active_lhs(ActN),!,fail. - is_simple_lhs((Lhs1/Lhs2)):- !,fail, is_simple_lhs(Lhs1),is_simple_lhs(Lhs2). - is_simple_lhs(_). - - - is_active_lhs(ActN):- var(ActN),!,fail. - is_active_lhs(!). - is_active_lhs(cut_c). - is_active_lhs(actn(_Act)). - is_active_lhs('{}'(_Act)). - is_active_lhs((Lhs1/Lhs2)):- !,is_active_lhs(Lhs1);is_active_lhs(Lhs2). - is_active_lhs((Lhs1,Lhs2)):- !,is_active_lhs(Lhs1);is_active_lhs(Lhs2). - is_active_lhs((Lhs1;Lhs2)):- !,is_active_lhs(Lhs1);is_active_lhs(Lhs2). - - - add_lhs_cond(Lhs1/Cond,Lhs2,Lhs1/(Cond,Lhs2)):-!. - add_lhs_cond(Lhs1,Lhs2,Lhs1/Lhs2). - - - -% % -% % buildRhs(+Conjunction,-Rhs) -% % - -buildRhs(X,[X]) :- - var(X), - !. - -buildRhs((A,B),[A2|Rest]) :- - !, - pfcCompileRhsTerm(A,A2), - buildRhs(B,Rest). - -buildRhs(X,[X2]) :- - pfcCompileRhsTerm(X,X2). - -pfcCompileRhsTerm((P/C),((P:-C))) :- !. - -pfcCompileRhsTerm(P,P). - - -% % pfc_unnegate(N,P) is true if N is a negated term and P is the term -% % with the negation operator stripped. - -pfc_unnegate(P,_):- var(P),!,fail. -pfc_unnegate((~P),P):- \+ tilded_negation. -pfc_unnegate((-P),P). -pfc_unnegate((\+(P)),P). - -pfcNegatedLiteral(P) :- - callable(P), - pfc_unnegate(P,Q), - pfcPositiveLiteral(Q). - -pfcLiteral(X) :- pfcNegatedLiteral(X). -pfcLiteral(X) :- pfcPositiveLiteral(X). - -pfcPositiveLiteral(X) :- - callable(X), - functor(X,F,_), - \+ pfcConnective(F). - -pfcConnective(';'). -pfcConnective(','). -pfcConnective('/'). -pfcConnective('|'). -pfcConnective(('==>')). -pfcConnective(('<-')). -pfcConnective('<==>'). - -pfcConnective('-'). -pfcConnective('~'):- \+ tilded_negation. -pfcConnective(( \+ )). - -is_implicitly_prolog(Callable):- \+ callable(Callable),!, fail. -is_implicitly_prolog(_ is _). - -processRule(Lhs,Rhs,ParentRule) :- - copy_term(ParentRule,ParentRuleCopy), - buildRhs(Rhs,Rhs2), - current_why_U(USER), % @TODO REVIEW _U - pfcForEach(pfc_nf(Lhs,Lhs2), - buildRule(Lhs2,rhs(Rhs2),(ParentRuleCopy,USER))). - -buildRule(Lhs,Rhs,Support) :- - buildTrigger(Lhs,Rhs,Trigger), - fcEvalLHS(Trigger,Support). - -buildTrigger([],Consequent,Consequent). - -buildTrigger([Test|Triggers],Consequent,(Test *-> X)) :- is_implicitly_prolog(Test), - !, - buildTrigger(Triggers,Consequent,X). - -buildTrigger([V|Triggers],Consequent,'$pt$'(V,X)) :- - var(V), - !, - buildTrigger(Triggers,Consequent,X). - -buildTrigger([(T1/Test)|Triggers],Consequent,'$nt$'(T2,Test2,X)) :- - pfc_unnegate(T1,T2), - !, - buildNtTest(T2,Test,Test2), - buildTrigger(Triggers,Consequent,X). - -buildTrigger([(T1)|Triggers],Consequent,'$nt$'(T2,Test,X)) :- - pfc_unnegate(T1,T2), - !, - buildNtTest(T2,true,Test), - buildTrigger(Triggers,Consequent,X). - -buildTrigger([{Test}|Triggers],Consequent,(Test *-> X)) :- - !, - buildTrigger(Triggers,Consequent,X). - -buildTrigger([T/Test|Triggers],Consequent,'$pt$'(T,X)) :- - !, - buildTest(Test,Test2), - buildTrigger([{Test2}|Triggers],Consequent,X). - - -%buildTrigger([snip|Triggers],Consequent,snip(X)) :- -% !, -% buildTrigger(Triggers,Consequent,X). - -buildTrigger([T|Triggers],Consequent,'$pt$'(T,X)) :- - !, - buildTrigger(Triggers,Consequent,X). - -% % -% % buildNtTest(+,+,-). -% % -% % builds the test used in a negative trigger(-) ('$nt$'/3). This test is a -% % conjunction of the check than no matching facts are in the db and any -% % additional test specified in the rule attached to this ~ term. -% % - % tilded_negation. -buildNtTest(T,Testin,Testout) :- - buildTest(Testin,Testmid), - pfcConjoin((pfc_call(T)),Testmid,Testout). - - -% this just strips away any currly brackets. - -buildTest({Test},Test) :- !. -buildTest(Test,Test). - -% % - - -% % pfcType(+VALUE1, ?Type) is semidet. -% -% PFC Database Type. -% -% simple typeing for Pfc objects -% - - -pfcType(Var,Type):- var(Var),!, Type=fact(_FT). -pfcType(_:X,Type):- !, pfcType(X,Type). -pfcType(~_,Type):- !, Type=fact(_FT). -pfcType(('==>'(_,_)),Type):- !, Type=rule(fwd). -pfcType( '==>'(X),Type):- !, pfcType(X,Type), pfcWarn(pfcType( '==>'(X), Type)). -pfcType(('<==>'(_,_)),Type):- !, Type=rule(<==>). -pfcType(('<-'(_,_)),Type):- !, Type=rule(bwc). -pfcType((':-'(_,_)),Type):- !, Type=rule(cwc). -pfcType('$pt$'(_,_,_),Type):- !, Type=trigger(+). -pfcType('$pt$'(_,_),Type):- !, Type=trigger(+). -pfcType('$nt$'(_,_,_),Type):- !, Type=trigger(-). -pfcType('$bt$'(_,_),Type):- !, Type=trigger(?). -pfcType(pfcAction(_),Type):- !, Type=action. -pfcType((('::::'(_,X))),Type):- !, pfcType(X,Type). -pfcType(_,fact(_FT)):- - % if it''s not one of the above, it must_ex be a fact! - !. - -pfcAssert(P,Support) :- - (pfc_clause(P) ; assert(P)), - !, - pfcAddSupport(P,Support). - -pfcAsserta(P,Support) :- - (pfc_clause(P) ; asserta(P)), - !, - pfcAddSupport(P,Support). - -pfcAssertz(P,Support) :- - (pfc_clause(P) ; assertz(P)), - !, - pfcAddSupport(P,Support). - -pfc_clause((Head :- Body)) :- - !, - copy_term(Head,Head_copy), - copy_term(Body,Body_copy), - clause(Head,Body), - variant(Head,Head_copy), - variant(Body,Body_copy). - -pfc_clause(Head) :- - % find a unit clause identical to Head by finding one which unifies, - % and then checking to see if it is identical - copy_term(Head,Head_copy), - clause(Head_copy,true), - variant(Head,Head_copy). - -pfcForEach(Binder,Body) :- Binder,pfcdo(Body),fail. -pfcForEach(_,_). - -% pfcdo(X) executes X once and always succeeds. -pfcdo(X) :- X,!. -pfcdo(_). - - -% % pfcUnion(L1,L2,L3) - true if set L3 is the result of appending sets -% % L1 and L2 where sets are represented as simple lists. - -pfcUnion([],L,L). -pfcUnion([Head|Tail],L,Tail2) :- - memberchk(Head,L), - !, - pfcUnion(Tail,L,Tail2). -pfcUnion([Head|Tail],L,[Head|Tail2]) :- - pfcUnion(Tail,L,Tail2). - - -% % pfcConjoin(+Conjunct1,+Conjunct2,?Conjunction). -% % arg3 is a simplified expression representing the conjunction of -% % args 1 and 2. - -pfcConjoin(true,X,X) :- !. -pfcConjoin(X,true,X) :- !. -pfcConjoin(C1,C2,(C1,C2)). - - -% File : pfcdb.pl -% Author : Tim Finin, finin@prc.unisys.com -% Author : Dave Matuszek, dave@prc.unisys.com -% Author : Dan Corpron -% Updated: 10/11/87, ... -% Purpose: predicates to manipulate a pfc database (e.g. save, -% % restore, reset, etc.0 - -% pfcDatabaseTerm(P/A) is true iff P/A is something that pfc adds to -% the database and should not be present in an empty pfc database - -pfcDatabaseTerm('$spft$'/3). -pfcDatabaseTerm('$pt$'/2). -pfcDatabaseTerm('$bt$'/2). -pfcDatabaseTerm('$nt$'/3). -pfcDatabaseTerm('==>'/2). -pfcDatabaseTerm('<==>'/2). -pfcDatabaseTerm('<-'/2). -pfcDatabaseTerm(pfcQueue/1). - -% removes all forward chaining rules and justifications from db. - -pfcReset :- - pfc_spft(P,F,Trigger), - pfcRetractOrWarn(P), - pfcRetractOrWarn('$spft$'(P,F,Trigger)), - fail. -pfcReset :- - (pfcDatabaseItem(T)*-> - (pfcError("Pfc database not empty after pfcReset, e.g., ~p.~n",[T]),fail) - ; true). - - -% true if there is some pfc crud still in the database. -pfcDatabaseItem(Term:-Body) :- - pfcDatabaseTerm(P/A), - functor(Term,P,A), - clause(Term,Body). - -pfcRetractOrWarn(X) :- retract(X), !. -pfcRetractOrWarn(X) :- - pfcWarn("Couldn't retract ~p.",[X]),dumpST,pfcWarn("Couldn't retract ~p.",[X]),!. - -pfcRetractOrQuietlyFail(X) :- retract(X), !. -pfcRetractOrQuietlyFail(X) :- - nop((pfcTraceMsg("Trace: Couldn't retract ~p.",[X]),dumpST,pfcWarn("Couldn't retract ~p.",[X]))), - !,fail. - - - -% File : pfcdebug.pl -% Author : Tim Finin, finin@prc.unisys.com -% Author : Dave Matuszek, dave@prc.unisys.com -% Updated: -% Purpose: provides predicates for examining the database and debugginh -% for Pfc. - -:- dynamic pfcTraced/1. -:- dynamic pfcSpied/2. -:- dynamic pfcTraceExecution/0. -:- dynamic pfcWarnings/1. - -:- pfcDefault(pfcWarnings(_), pfcWarnings(true)). - -% % predicates to examine the state of pfc - -pfcQueue :- listing(pfcQueue/1). - -pfcPrintDB :- - pfcPrintFacts, - pfcPrintRules, - pfcPrintTriggers, - pfcPrintSupports,!. - -printLine:- ansi_format([underline],"~N=========================================~n",[]). - -% % pfcPrintFacts ... - -pfcPrintFacts :- pfcPrintFacts(_,true). - - -pfcPrintFacts(Pattern) :- pfcPrintFacts(Pattern,true). - -pfcPrintFacts(P,C) :- - pfcFacts(P,C,L), - pfcClassifyFacts(L,User,Pfc,_Rule), - printLine, - pfcPrintf("User added facts:~n",[]), - pfcPrintitems(User), - printLine, - pfcPrintf("Pfc added facts:~n",[]), - pfcPrintitems(Pfc), - printLine,!. - - -% % printitems clobbers it''s arguments - beware! - -pfcPrintitems([]). -pfcPrintitems([H|T]) :- - % numbervars(H,0,_), - %format('~N ~p.',[H]), - \+ \+ ( pretty_numbervars(H,H1),format(" ",[]),portray_clause_w_vars(H1)), - pfcPrintitems(T). - -pfcClassifyFacts([],[],[],[]). - -pfcClassifyFacts([H|T],User,Pfc,[H|Rule]) :- - pfcType(H,rule), - !, - pfcClassifyFacts(T,User,Pfc,Rule). - -pfcClassifyFacts([H|T],[H|User],Pfc,Rule) :- - matches_why_UU(UU), - pfcGetSupport(H,UU), - !, - pfcClassifyFacts(T,User,Pfc,Rule). - -pfcClassifyFacts([H|T],User,[H|Pfc],Rule) :- - pfcClassifyFacts(T,User,Pfc,Rule). - -pfcPrintRules :- - printLine, - pfcPrintf("Rules:...~n",[]), - bagof_or_nil((P==>Q),clause((P==>Q),true),R1), - pfcPrintitems(R1), - bagof_or_nil((P<==>Q),clause((P<==>Q),true),R2), - pfcPrintitems(R2), - bagof_or_nil((P<-Q),clause((P<-Q),true),R3), - pfcPrintitems(R3), - printLine. - -pfcGetTrigger(Trigger):- pfc_call(Trigger). - - -% % pfcPrintTriggers is semidet. -% -% Pretty Print Triggers. -% -pfcPrintTriggers :- - print_db_items("Positive triggers", '$pt$'(_,_)), - print_db_items("Negative triggers", '$nt$'(_,_,_)), - print_db_items("Goal triggers",'$bt$'(_,_)). - -pp_triggers:-pfcPrintTriggers. -%= - -% % pfcPrintSupports is semidet. -% -% Pretty Print Supports. -% -pfcPrintSupports :- - % temporary hack. - draw_line, - fmt("Supports ...~n",[]), - setof_or_nil((P =< S), (pfcGetSupport(P,S), \+ pp_filtered(P)),L), - pp_items('Support',L), - draw_line,!. -pp_supports:- pfcPrintSupports. - -pp_filtered(P):-var(P),!,fail. -pp_filtered(_:P):- !, pp_filtered(P). -pp_filtered(P):- safe_functor(P,F,A),F\==(/),!,pp_filtered(F/A). -pp_filtered(F/_):-F==pfc_prop. - - - -pfcFact(P) :- pfcFact(P,true). - -% % pfcFact(P,C) is true if fact P was asserted into the database via -% % pfcAdd and contdition C is satisfied. For example, we might do: -% % -% % pfcFact(X,pfcUserFact(X)) -% % - -pfcFact(P,C) :- - pfcGetSupport(P,_), - pfcType(P,fact(_)), - pfcCallSystem(C). - -% % pfcFacts(-ListofPfcFacts) returns a list of facts added. - -pfcFacts(L) :- pfcFacts(_,true,L). - -pfcFacts(P,L) :- pfcFacts(P,true,L). - -% % pfcFacts(Pattern,Condition,-ListofPfcFacts) returns a list of facts added. - -pfcFacts(P,C,L) :- setof_or_nil(P,pfcFact(P,C),L). - -brake(X) :- X, ibreak. - -% % -% % -% % predicates providing a simple tracing facility -% % - -pfcTraceAdd(P) :- - % this is here for upward compat. - should go away eventually. - pfcTraceAdd(P,(o,o)). - -pfcTraceAdd('$pt$'(_,_),_) :- - % hack for now - never trace triggers. - !. -pfcTraceAdd('$nt$'(_,_),_) :- - % hack for now - never trace triggers. - !. - -pfcTraceAdd(P,S) :- - pfcTraceAddPrint(P,S), - pfcTraceBreak(P,S). - - -pfcTraceAddPrint(P,S) :- - pfcIsTraced(P), - !, - pretty_numbervars(P,Pcopy), - % numbervars(Pcopy,0,_), - matches_why_UU(UU), - (S=UU - -> pfcPrintf("Adding (u) ~@",[fmt_cl(Pcopy)]) - ; pfcPrintf("Adding ~@",[fmt_cl(Pcopy)])). - -pfcTraceAddPrint(_,_). - - -pfcTraceBreak(P,_S) :- - pfcSpied(P,+) -> - (pretty_numbervars(P,Pcopy), - % numbervars(Pcopy,0,_), - pfcPrintf("Breaking on pfcAdd(~p)",[Pcopy]), - ibreak) - ; true. - -pfcTraceRem('$pt$'(_,_)) :- - % hack for now - never trace triggers. - !. -pfcTraceRem('$nt$'(_,_)) :- - % hack for now - never trace triggers. - !. - -pfcTraceRem(P) :- - (pfcIsTraced(P) - -> pfcPrintf("Removing: ~p.",[P]) - ; true), - (pfcSpied(P,-) - -> (pfcPrintf("Breaking on pfcRem(~p)",[P]), - ibreak) - ; true). - -pfcIsTraced(P):- pfcTraced(P). - -mpred_trace_exec:- pfcWatch,pfcTrace. -mpred_notrace_exec:- pfcNoTrace,pfcNoWatch. - -pfcTrace :- pfcTrace(_). - -pfcTrace(Form) :- - assert(pfcTraced(Form)). - -pfcTrace(Form,Condition) :- - assert((pfcTraced(Form) :- Condition)). - -pfcSpy(Form) :- pfcSpy(Form,[+,-],true). - -pfcSpy(Form,Modes) :- pfcSpy(Form,Modes,true). - -pfcSpy(Form,[H|T],Condition) :- - !, - pfcSpy1(Form,H,Condition), - pfcSpy(Form,T,Condition). - -pfcSpy(Form,Mode,Condition) :- - pfcSpy1(Form,Mode,Condition). - -pfcSpy1(Form,Mode,Condition) :- - assert((pfcSpied(Form,Mode) :- Condition)). - -pfcNospy :- pfcNospy(_,_,_). - -pfcNospy(Form) :- pfcNospy(Form,_,_). - -pfcNospy(Form,Mode,Condition) :- - clause(pfcSpied(Form,Mode), Condition, Ref), - erase(Ref), - fail. -pfcNospy(_,_,_). - -pfcNoTrace :- pfcUntrace. -pfcUntrace :- pfcUntrace(_). -pfcUntrace(Form) :- retractall(pfcTraced(Form)). - -% needed: pfcTraceRule(Name) ... - - -% if the correct flag is set, trace exection of Pfc - -pfcTraceMsg(Msg):- pfcTraceMsg('~p',[Msg]). -pfcTraceMsg(Msg,Args) :- - pfcTraceExecution, - !, - pfcPrintf(user_output, Msg, Args). -pfcTraceMsg(_Msg,_Args). - - -pfcPrintf(Msg,Args) :- - pfcPrintf(user_output, Msg,Args). - -pfcPrintf(Where,Msg,Args) :- - format(Where,'~N',[]), - format(Where,Msg,Args). - - - -pfcWatch :- assert(pfcTraceExecution). - -pfcNoWatch :- retractall(pfcTraceExecution). - -pfcError(Msg) :- pfcError(Msg,[]). - -pfcError(Msg,Args) :- - format("~N~nERROR/Pfc: ",[]), - format(Msg,Args). - -% % -% % These control whether or not warnings are printed at all. -% % pfcWarn. -% % nopfcWarn. -% % -% % These print a warning message if the flag pfcWarnings is set. -% % pfcWarn(+Message) -% % pfcWarn(+Message,+ListOfArguments) -% % - -pfcWarn :- - retractall(pfcWarnings(_)), - assert(pfcWarnings(true)). - -nopfcWarn :- - retractall(pfcWarnings(_)), - assert(pfcWarnings(false)). - -pfcWarn(Msg) :- pfcWarn('~p',[Msg]). - -pfcWarn(Msg,Args) :- - pfcWarnings(true), - !, - ansi_format([underline,fg(red)],"~N==============WARNING/Pfc================~n",[]), - ansi_format([fg(yellow)],Msg,Args), - printLine. -pfcWarn(_,_). - -% % -% % pfcWarnings/0 sets flag to cause pfc warning messages to print. -% % pfcNoWarnings/0 sets flag to cause pfc warning messages not to print. -% % - -pfcWarnings :- - retractall(pfcWarnings(_)), - assert(pfcWarnings(true)). - -pfcNoWarnings :- - retractall(pfcWarnings(_)). - -% File : pfcjust.pl -% Author : Tim Finin, finin@prc.unisys.com -% Author : Dave Matuszek, dave@prc.unisys.com -% Updated: -% Purpose: predicates for accessing Pfc justifications. -% Status: more or less working. -% Bugs: - -%= *** predicates for exploring supports of a fact ***** - - -:- use_module(library(lists)). - -justification(F,J) :- supports(F,J). - -justifications(F,Js) :- bagof(J,justification(F,J),Js). - - - -% % base(P,L) - is true iff L is a list of "base" facts which, taken -% % together, allows us to deduce P. A base fact is an axiom (a fact -% % added by the user or a raw Prolog fact (i.e. one w/o any support)) -% % or an assumption. - -base(F,[F]) :- (axiom(F) ; assumption(F)),!. - -base(F,L) :- - % i.e. (reduce 'append (map 'base (justification f))) - justification(F,Js), - bases(Js,L). - - -% % bases(L1,L2) is true if list L2 represents the union of all of the -% % facts on which some conclusion in list L1 is based. - -bases([],[]). -bases([X|Rest],L) :- - base(X,Bx), - bases(Rest,Br), - pfcUnion(Bx,Br,L). - -axiom(F) :- - matches_why_UU(UU), - pfcGetSupport(F,UU); - pfcGetSupport(F,(god,god)). - -% % an assumption is a failed goal, i.e. were assuming that our failure to -% % prove P is a proof of not(P) - -assumption(P) :- pfc_unnegate(P,_). - -% % assumptions(X,As) if As is a set of assumptions which underly X. - -assumptions(X,[X]) :- assumption(X). -assumptions(X,[]) :- axiom(X). -assumptions(X,L) :- - justification(X,Js), - assumptions1(Js,L). - -assumptions1([],[]). -assumptions1([X|Rest],L) :- - assumptions(X,Bx), - assumptions1(Rest,Br), - pfcUnion(Bx,Br,L). - - -% % pfcProofTree(P,T) the proof tree for P is T where a proof tree is -% % of the form -% % -% % [P , J1, J2, ;;; Jn] each Ji is an independent P justifier. -% % ^ and has the form of -% % [J11, J12,... J1n] a list of proof trees. - - -% pfcChild(P,Q) is true iff P is an immediate justifier for Q. -% mode: pfcChild(+,?) - -pfcChild(P,Q) :- - pfcGetSupport(Q,(P,_)). - -pfcChild(P,Q) :- - pfcGetSupport(Q,(_,Trig)), - pfcType(Trig,trigger(_Pos)), - pfcChild(P,Trig). - -pfcChildren(P,L) :- bagof_or_nil(C,pfcChild(P,C),L). - -% pfcDescendant(P,Q) is true iff P is a justifier for Q. - -pfcDescendant(P,Q) :- - pfcDescendant1(P,Q,[]). - -pfcDescendant1(P,Q,Seen) :- - pfcChild(X,Q), - (\+ member(X,Seen)), - (P=X ; pfcDescendant1(P,X,[X|Seen])). - -pfcDescendants(P,L) :- - bagof_or_nil(Q,pfcDescendant1(P,Q,[]),L). - - - -/* -current_why_U(U):- must(current_why(Why)), U = user(Why). -current_why_UU(UU):- current_why_U(U), UU= (U,U). -matches_why_U(U):- freeze(U,U=user(_)). -matches_why_UU(UU):- matches_why_U(U1),matches_why_U(U2), freeze(UU,UU=(U1,U2)). -*/ -current_why_U(U):- get_why_uu((U,_)).% must(current_why(Why)), U = user(Why). -current_why_UU(UU):- get_why_uu(UU). % current_why_U(U), UU= (U,U). -matches_why_U(U):- nop((current_why_U(Y), freeze(U,\+ \+ (U=Y;true)))). -matches_why_UU(UU):- nop(only_is_user_reason(UU)). % matches_why_U(U1),matches_why_U(U2),freeze(UU,UU=(U1,U2)). - - -matterialize_support_term(S,Sup):- term_attvars(S,Atts), Atts\==[] -> copy_term(S,_,Goals),Sup= S+Goals,!. -matterialize_support_term(SS,SS). - -% % -% % -% % predicates for manipulating support relationships -% % - -% % pfcAddSupport(+Fact,+Support) - -pfcAddSupport(P,(Fact,Trigger)) :- assert('$spft$'(P,Fact,Trigger)). - -pfcGetSupport(P,(Fact,Trigger)) :- pfc_spft(P,Fact,Trigger). - -pfc_spft(P,F,T) :- pfcCallSystem('$spft$'(P,F,T)). - -% There are three of these to try to efficiently handle the cases -% where some of the arguments are not bound but at least one is. - -pfcRemOneSupport(P,(Fact,Trigger)) :- - must(callable(P);callable(Fact);callable(Trigger)), - pfcRetractOrWarn('$spft$'(P,Fact,Trigger)). - -pfcRemOneSupportOrQuietlyFail(P,(Fact,Trigger)) :- - must(callable(P);callable(Fact);callable(Trigger)), - pfcRetractOrQuietlyFail('$spft$'(P,Fact,Trigger)). - - -pfc_collect_supports(Tripples) :- - bagof(Tripple, pfc_support_relation(Tripple), Tripples), - !. -pfc_collect_supports([]). - -pfc_support_relation((P,F,T)) :- - pfc_spft(P,F,T). - - - -pfc_make_supports((P,S1,S2)) :- - pfcAddSupport(P,(S1,S2)), - (pfcAddType1(P); true), - !. - -% % pfcTriggerKey(+Trigger,-Key) -% % -% % Arg1 is a trigger. Key is the best term to index it on. - -pfcTriggerKey('$pt$'(Key,_),Key). -pfcTriggerKey('$pt$'(Key,_,_),Key). -pfcTriggerKey('$nt$'(Key,_,_),Key). -pfcTriggerKey(Key,Key). - - -% % ^L -% % Get a key from the trigger that will be used as the first argument of -% % the trigger base clause that stores the trigger. -% % - -pfc_trigger_key(X,X) :- var(X), !. -pfc_trigger_key(chart(word(W),_L),W) :- !. -pfc_trigger_key(chart(stem([Char1|_Rest]),_L),Char1) :- !. -pfc_trigger_key(chart(Concept,_L),Concept) :- !. -pfc_trigger_key(X,X). - -% File : pfcwhy.pl -% Author : Tim Finin, finin@prc.unisys.com -% Updated: -% Purpose: predicates for interactively exploring Pfc justifications. - -% ***** predicates for brousing justifications ***** - -:- use_module(library(lists)). - -:- dynamic(t_l:whybuffer/2). - - - -pfcWhy :- - t_l:whybuffer(P,_), - pfcWhy(P). - -pfcTF(P):- pfc_call(P)*->foreach(pfcTF1(P),true);pfcTF1(P). -pfcTF1(P):- - ansi_format([underline],"~N=========================================",[]), - (ignore(pfcWhy(P))), ignore(pfcWhy(~P)), - printLine. - - -pfcWhy(N) :- - number(N), - !, - t_l:whybuffer(P,Js), - pfcWhyCommand(N,P,Js). - -pfcWhy(P) :- - justifications(P,Js), - retractall(t_l:whybuffer(_,_)), - assert(t_l:whybuffer(P,Js)), - pfcWhyBrouse(P,Js). - -pfcWhy1(P) :- - justifications(P,Js), - pfcWhyBrouse(P,Js). - -pfcWhy2(P,N) :- - justifications(P,Js), pfcShowJustification1(Js,N). - -pfcWhyBrouse(P,Js) :- - % rtrace(pfc_pp_db_justifications(P,Js)), - pfcShowJustifications(P,Js), - nop((pfcAsk(' >> ',Answer), - pfcWhyCommand(Answer,P,Js))). - -pfcWhyCommand(q,_,_) :- !. -pfcWhyCommand(h,_,_) :- - !, - format("~n -Justification Brouser Commands: - q quit. - N focus on Nth justification. - N.M brouse step M of the Nth justification - u up a level -",[]). - -pfcWhyCommand(N,_P,Js) :- - float(N), - !, - pfcSelectJustificationNode(Js,N,Node), - pfcWhy1(Node). - -pfcWhyCommand(u,_,_) :- - % u=up - !. - -pfcCommand(N,_,_) :- - integer(N), - !, - pfcPrintf("~p is a yet unimplemented command.",[N]), - fail. - -pfcCommand(X,_,_) :- - pfcPrintf("~p is an unrecognized command, enter h. for help.",[X]), - fail. - -pfcShowJustifications(P,Js) :- - show_current_source_location, - reset_shown_justs, - %color_line(yellow,1), - format("~N~nJustifications for ",[]), - ansi_format([fg(green)],'~@',[pp(P)]), - format(" :~n",[]), - pfcShowJustification1(Js,1),!, - printLine. - -pfcShowJustification1([],_):-!. -pfcShowJustification1([J|Js],N) :- !, - % show one justification and recurse. - %reset_shown_justs, - pfcShowSingleJust(N,step(1),J),!, - N2 is N+1, - pfcShowJustification1(Js,N2). - -pfcShowJustification1(J,N) :- - %reset_shown_justs, % nl, - pfcShowSingleJust(N,step(1),J),!. - -incrStep(StepNo,Step):- compound(StepNo),arg(1,StepNo,Step),X is Step+1,nb_setarg(1,StepNo,X). - -pfcShowSingleJust(JustNo,StepNo,C):- is_ftVar(C),!,incrStep(StepNo,Step), - ansi_format([fg(cyan)],"~N ~w.~w ~w ",[JustNo,Step,C]),!, maybe_more_c(C). -pfcShowSingleJust(_JustNo,_StepNo,[]):-!. -pfcShowSingleJust(JustNo,StepNo,(P,T)):-!, - pfcShowSingleJust(JustNo,StepNo,P), - pfcShowSingleJust(JustNo,StepNo,T). -pfcShowSingleJust(JustNo,StepNo,(P,F,T)):-!, - pfcShowSingleJust1(JustNo,StepNo,P), - pfcShowSingleJust(JustNo,StepNo,F), - pfcShowSingleJust1(JustNo,StepNo,T). -pfcShowSingleJust(JustNo,StepNo,(P*->T)):-!, - pfcShowSingleJust1(JustNo,StepNo,P),format(' *-> ',[]), - pfcShowSingleJust1(JustNo,StepNo,T). - -pfcShowSingleJust(JustNo,StepNo,(P:-T)):-!, - pfcShowSingleJust1(JustNo,StepNo,P),format(':- ~p.',[T]). - -pfcShowSingleJust(JustNo,StepNo,(P : -T)):-!, - pfcShowSingleJust1(JustNo,StepNo,P),format(' :- ',[]), - pfcShowSingleJust(JustNo,StepNo,T). - -pfcShowSingleJust(JustNo,StepNo,(P :- T) ):- !, - pfcShowSingleJust1(JustNo,StepNo,call(T)), - pfcShowSingleJust1(JustNo,StepNo,P). - - -pfcShowSingleJust(JustNo,StepNo,[P|T]):-!, - pfcShowSingleJust(JustNo,StepNo,P), - pfcShowSingleJust(JustNo,StepNo,T). - -pfcShowSingleJust(JustNo,StepNo,'$pt$'(P,Body)):- !, - pfcShowSingleJust1(JustNo,StepNo,'$pt$'(P)), - pfcShowSingleJust(JustNo,StepNo,Body). - -pfcShowSingleJust(JustNo,StepNo,C):- - pfcShowSingleJust1(JustNo,StepNo,C). - -fmt_cl(P):- \+ \+ (pretty_numbervars(P,PP),numbervars(PP,126,_,[attvar(skip),singletons(true)]), write_term(PP,[portray(true),portray_goal(fmt_cl)])),write('.'). -fmt_cl(S,_):- term_is_ansi(S), !, write_keeping_ansi(S). -fmt_cl(G,_):- is_grid(G),write('"'),user:print_grid(G),write('"'),!. -% fmt_cl(P,_):- catch(arc_portray(P),_,fail),!. -fmt_cl(P,_):- is_list(P),catch(p_p_t_no_nl(P),_,fail),!. -%ptg(PP,Opts):- is_list(PP),select(portray_goal(ptg),Opts,Never),write_term(PP,Never). - -unwrap_litr(C,CCC+VS):- copy_term(C,CC,VS), - numbervars(CC+VS,0,_), - unwrap_litr0(CC,CCC),!. -unwrap_litr0(call(C),CC):-unwrap_litr0(C,CC). -unwrap_litr0('$pt$'(C),CC):-unwrap_litr0(C,CC). -unwrap_litr0(body(C),CC):-unwrap_litr0(C,CC). -unwrap_litr0(head(C),CC):-unwrap_litr0(C,CC). -unwrap_litr0(C,C). - -:- thread_local t_l:shown_why/1. - -pfcShowSingleJust1(_,_,MFL):- is_mfl(MFL),!. -pfcShowSingleJust1(JustNo,StepNo,C):- unwrap_litr(C,CC),!,pfcShowSingleJust4(JustNo,StepNo,C,CC). -pfcShowSingleJust4(_,_,_,MFL):- is_mfl(MFL),!. -pfcShowSingleJust4(_,_,_,CC):- t_l:shown_why(C),C=@=CC,!. -pfcShowSingleJust4(JustNo,StepNo,C,CC):- assert(t_l:shown_why(CC)),!, - incrStep(StepNo,Step), - ansi_format([fg(cyan)],"~N ~w.~w ~@ ",[JustNo,Step,user:fmt_cl(C)]), - pfcShowSingleJust_C(C),!, - format('~N'), - ignore((maybe_more_c(C))), - format('~N'),!. - -is_mfl(MFL):- compound(MFL), MFL = mfl4(_,_,_,_). - -maybe_more_c(MFL):- is_mfl(MFL),!. -maybe_more_c(_):- t_l:shown_why(no_recurse). -maybe_more_c(C):- t_l:shown_why(more(C)),!. -maybe_more_c(C):- t_l:shown_why((C)),!. -maybe_more_c(C):- assert(t_l:shown_why(more(C))),assert(t_l:shown_why((C))), - locally(t_l:shown_why(no_recurse), - locally(t_l:shown_why((C)),locally(t_l:shown_why(more(C)), - ignore(catch(pfcWhy2(C,1.1),E,fbugio(E)))))),!. - -pfcShowSingleJust_C(C):-is_file_ref(C),!. -pfcShowSingleJust_C(C):-find_mfl(C,MFL),assert(t_l:shown_why(MFL)),!,pfcShowSingleJust_MFL(MFL). -pfcShowSingleJust_C(_):-ansi_format([hfg(black)]," % [no_mfl] ",[]),!. - -short_filename(F,FN):- atomic_list_concat([_,FN],'/pack/',F),!. -short_filename(F,FN):- atomic_list_concat([_,FN],swipl,F),!. -short_filename(F,FN):- F=FN,!. - -pfcShowSingleJust_MFL(MFL):- MFL=mfl4(VarNameZ,_M,F,L),atom(F),short_filename(F,FN),!,varnames_load_context(VarNameZ), - ansi_format([hfg(black)]," % [~w:~w] ",[FN,L]). - -pfcShowSingleJust_MFL(MFL):- MFL=mfl4(V,M,F,L),my_maplist(var,[V,M,F,L]),!. -pfcShowSingleJust_MFL(MFL):- ansi_format([hfg(black)]," % [~w] ",[MFL]),!. - -pfcAsk(Msg,Ans) :- - format("~n~w",[Msg]), - read(Ans). - -pfcSelectJustificationNode(Js,Index,Step) :- - JustNo is integer(Index), - nth1(JustNo,Js,Justification), - StepNo is 1+ integer(Index*10 - JustNo*10), - nth1(StepNo,Justification,Step). - - - - - - - - - - - - - - - - - - - - - - -:- set_prolog_flag(expect_pfc_file,unknown). - -% ======================================================= -/* -% -%= predicates to examine the state of pfc -% interactively exploring Pfc justifications. -% -% Logicmoo Project PrologMUD: A MUD server written in Prolog -% Maintainer: Douglas Miles -% Dec 13, 2035 -% -*/ -% ======================================================= -% File: /opt/PrologMUD/pack/logicmoo_base/prolog/logicmoo/mpred/pfc_list_triggers.pl -:- if(( ( \+ ((current_prolog_flag(logicmoo_include,Call),Call))) )). -pfc_listing_module:- nop( module(pfc_listing, - [ draw_line/0, - loop_check_just/1, - pinfo/1, - pp_items/2, - pp_item/2, - pp_filtered/1, - pp_facts/2, - pp_facts/1, - pp_facts/0, - pfc_list_triggers_types/1, - pfc_list_triggers_nlc/1, - pfc_list_triggers_1/1, - pfc_list_triggers_0/1, - pfc_list_triggers/1, - pfc_contains_term/2, - pfc_classify_facts/4, - lqu/0, - get_clause_vars_for_print/2, - %pfcWhyBrouse/2, - %pfcWhy1/1, - %pfcWhy/1, - %pfcWhy/0, - pp_rules/0, - pfcPrintSupports/0, - pfcPrintTriggers/0, - print_db_items/1, - print_db_items/2, - print_db_items/3, - print_db_items/4, - print_db_items_and_neg/3, - show_pred_info/1, - show_pred_info_0/1, - pfc_listing_file/0 - ])). - -%:- include('pfc_header.pi'). - -:- endif. - -% :- use_module(logicmoo(util/logicmoo_util_preddefs)). - - - -:- multifile(( - user:portray/1, - user:prolog_list_goal/1, - user:prolog_predicate_name/2, - user:prolog_clause_name/2)). - -:- dynamic - user:portray/1. - -% :- dynamic(whybuffer/2). - - - -%= - -% % lqu is semidet. -% -% Lqu. -% -lqu :- listing(que/2). - - - - -%= - -% % pp_facts is semidet. -% -% Pretty Print Facts. -% -pp_facts :- pp_facts(_,true). - - -%= - -% % pp_facts( ?Pattern) is semidet. -% -% Pretty Print Facts. -% -pp_facts(Pattern) :- pp_facts(Pattern,true). - - -%= - -% % pp_facts( ?P, ?C) is semidet. -% -% Pretty Print Facts. -% -pp_facts(P,C) :- - pfcFacts(P,C,L), - pfc_classify_facts(L,User,Pfc,_Rule), - draw_line, - fmt("User added facts:",[]), - pp_items(user,User), - draw_line, - draw_line, - fmt("Pfc added facts:",[]), - pp_items(system,Pfc), - draw_line. - - - -%= - -% % pp_items( ?Type, :TermH) is semidet. -% -% Pretty Print Items. -% -pp_items(_Type,[]):-!. -pp_items(Type,[H|T]) :- - ignore(pp_item(Type,H)),!, - pp_items(Type,T). -pp_items(Type,H) :- ignore(pp_item(Type,H)). - -:- thread_local(t_l:print_mode/1). - -%= - -% % pp_item( ?MM, :TermH) is semidet. -% -% Pretty Print Item. -% -pp_item(_M,H):-pp_filtered(H),!. -pp_item(MM,(H:-B)):- B ==true,pp_item(MM,H). -pp_item(MM,H):- flag(show_asserions_offered,X,X+1),find_and_call(get_print_mode(html)), ( \+ \+ if_defined(pp_item_html(MM,H))),!. - - -pp_item(MM,'$spft$'(W0,U,ax)):- W = (_KB:W0),!,pp_item(MM,U:W). -pp_item(MM,'$spft$'(W0,F,U)):- W = (_KB:W0),atom(U),!, fmt('~N%~n',[]),pp_item(MM,U:W), fmt('rule: ~p~n~n', [F]),!. -pp_item(MM,'$spft$'(W0,F,U)):- W = (_KB:W0), !, fmt('~w~nd: ~p~nformat: ~p~n', [MM,W,F]),pp_item(MM,U). -pp_item(MM,'$nt$'(Trigger0,Test,Body)) :- Trigger = (_KB:Trigger0), !, fmt('~w n-trigger(-): ~p~ntest: ~p~nbody: ~p~n', [MM,Trigger,Test,Body]). -pp_item(MM,'$pt$'(F0,Body)):- F = (_KB:F0), !,fmt('~w p-trigger(+):~n', [MM]), pp_item('',(F:-Body)). -pp_item(MM,'$bt$'(F0,Body)):- F = (_KB:F0), !,fmt('~w b-trigger(?):~n', [MM]), pp_item('',(F:-Body)). - - -pp_item(MM,U:W):- !,format(string(S),'~w ~w:',[MM,U]),!, pp_item(S,W). -pp_item(MM,H):- \+ \+ (( get_clause_vars_for_print(H,HH),fmt("~w ~p~N",[MM,HH]))). - - -%= - -% % get_clause_vars_for_print( ?HB, ?HB) is semidet. -% -% Get Clause Variables For Print. -% -get_clause_vars_for_print(HB,HB):- ground(HB),!. -get_clause_vars_for_print(I,I):- is_listing_hidden(skipVarnames),!. -get_clause_vars_for_print(H0,MHB):- get_clause_vars_copy(H0,MHB),!. -get_clause_vars_for_print(HB,HB). - -%= - -% % pfc_classify_facts( :TermH, ?User, :TermPfc, ?H) is semidet. -% -% Managed Predicate Classify Facts. -% -pfc_classify_facts([],[],[],[]). - -pfc_classify_facts([H|T],User,Pfc,[H|Rule]) :- - pfcType(H,rule), - !, - pfc_classify_facts(T,User,Pfc,Rule). - -pfc_classify_facts([H|T],[H|User],Pfc,Rule) :- - pfcGetSupport(H,(mfl4(_VarNameZ,_,_,_),ax)), - !, - pfc_classify_facts(T,User,Pfc,Rule). - -pfc_classify_facts([H|T],User,[H|Pfc],Rule) :- - pfc_classify_facts(T,User,Pfc,Rule). - - - -%= - -% % print_db_items( ?T, ?I) is semidet. -% -% Print Database Items. -% -print_db_items(T, I):- - draw_line, - fmt("~N~w ...~n",[T]), - print_db_items(I), - draw_line,!. - - -%= - -% % print_db_items( ?I) is semidet. -% -% Print Database Items. -% -print_db_items(F/A):-number(A),!,safe_functor(P,F,A),!,print_db_items(P). -print_db_items(H):- bagof(H,clause(H,true),R1),pp_items((:),R1),R1\==[],!. -print_db_items(H):- \+ current_predicate(_,H),!. -print_db_items(H):- catch( ('$find_predicate'(H,_),call_u(listing(H))),_,true),!,nl,nl. - - -%= - -% % pp_rules is semidet. -% -% Pretty Print Rules. -% -pp_rules :- - print_db_items("Forward Rules",(_ ==> _)), - print_db_items("Bidirectional Rules",(_ <==> _)), - print_db_items("Implication Rules",=>(_ , _)), - print_db_items("Bi-conditional Rules",<=>(_ , _)), - print_db_items("Backchaining Rules",(_ <- _)), - print_db_items("Positive Facts",(==>(_))), - print_db_items("Negative Facts",(~(_))). +typed_list(Cmpd,Type,List):- compound(Cmpd), Cmpd\=[_|_], compound_name_arguments(Cmpd,Type,[List|_]),is_list(List). +is_syspred(H,Len,Pred):- notrace(is_syspred0(H,Len,Pred)). +is_syspred0(H,_Ln,_Prd):- \+ atom(H),!,fail. +is_syspred0(H,_Ln,_Prd):- upcase_atom(H,U),downcase_atom(H,U),!,fail. +is_syspred0(H,Len,Pred):- current_predicate(H/Len),!,Pred=H. +is_syspred0(H,Len,Pred):- atom_concat(Mid,'!',H), H\==Mid, is_syspred0(Mid,Len,Pred),!. +is_syspred0(H,Len,Pred):- atom_concat(Mid,'-p',H), H\==Mid, is_syspred0(Mid,Len,Pred),!. +is_syspred0(H,Len,Pred):- atom_concat(Mid,'-fn',H), H\==Mid, is_syspred0(Mid,Len,Pred),!. +is_syspred0(H,Len,Pred):- into_underscores(H,Mid), H\==Mid, is_syspred0(Mid,Len,Pred),!. +%is_function(F):- atom(F). +is_metta_data_functor(_Eq,_Othr,H):- trace, clause(is_data_functor(H),_). +is_metta_data_functor(Eq,Other,H):- H\=='Right', H\=='Something', + % metta_type(Other,H,_), % fail, + \+ get_metta_atom(Eq,Other,[H|_]), + \+ metta_defn(Eq,Other,[H|_],_), + \+ is_metta_builtin(H), + \+ is_comp_op(H,_), + \+ is_math_op(H,_,_). + + +:- if( \+ current_predicate(mnotrace/1) ). + mnotrace(G):- once(G). +:- endif. -%= +%is_decl_type(ST):- metta_type(_,_,[_|Type]),is_list(Type),sub_sterm(T,Type),nonvar(T),T=@=ST, \+ nontype(ST). +is_decl_type([ST|_]):- !, atom(ST),is_decl_type_l(ST). +is_decl_type(ST):- \+ atom(ST),!,fail. +is_decl_type('%Undefined%'). is_decl_type('Number'). +is_decl_type('String'). is_decl_type('Bool'). +is_decl_type('Type'). is_decl_type('Symbol'). +is_decl_type('Expression'). +is_decl_type('Any'). is_decl_type('Atom'). +is_decl_type(Type):- is_decl_type_l(Type). +is_decl_type_l('StateMonad'). is_decl_type_l('List'). + + +last_type(List,Type):- is_list(List),last(List,Type),is_type(Type). +last_type(Type,Type):- is_type(Type),!. + +is_type(Type):- nontype(Type),!,fail. +is_type(Type):- is_decl_type(Type). +is_type(Type):- atom(Type). + +nontype(Type):- var(Type),!. +nontype('->'). +nontype(N):- number(N). + +needs_eval(EvalMe):- is_list(EvalMe),!. + + +args_violation(_Dpth,_Slf,Args,List):- ( \+ iz_conz(Args); \+ iz_conz(List)), !, fail. +args_violation(Depth,Self,[A|Args],[L|List]):- once(arg_violation(Depth,Self,A,L) ; args_violation(Depth,Self,Args,List)). +arg_violation(Depth,Self,A,L):- fail, + \+ (get_type0(Depth,Self,A,T), \+ type_violation(T,L)). +%arg_violation(Depth,Self,A,_):- get_type(Depth,Self,A,_),!. + +type_violation(T,L):- \+ \+ (is_nonspecific_type(T);is_nonspecific_type(L)),!,fail. +type_violation(T,L):- T\=L. + + +not_arg_violation(Depth,Self,Arg,Type):- + \+ arg_violation(Depth,Self,Arg,Type), + arg_conform(Depth,Self,Arg,Type). + + +args_conform(_Dpth,_Slf,Args,List):- ( \+ iz_conz(Args); \+ iz_conz(List)), !. +args_conform(Depth,Self,[A|Args],[L|List]):- arg_conform(Depth,Self,A,L) , args_conform(Depth,Self,Args,List). +arg_conform(Depth,Self,A,L):- get_type(Depth,Self,A,T), type_conform(T,L),!. +arg_conform(_Dpth,_Slf,_,_). +%arg_conform(Depth,Self,A,_):- get_type(Depth,Self,A,_),!. +type_conform(T,L):- T=L,!. +type_conform(T,L):- \+ \+ (is_nonspecific_type(T);is_nonspecific_type(L)),!. -% % draw_line is semidet. -% -% Draw Line. -% -draw_line:- \+ thread_self_main,!. -draw_line:- printLine,!. -draw_line:- (t_l:print_mode(H)->true;H=unknown),fmt("~N% % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % %~n",[]),H=H. +is_nonspecific_type(Var):- var(Var),!. +is_nonspecific_type('%Undefined%'). +is_nonspecific_type([]). +is_nonspecific_type('Atom'). +is_nonspecific_type('Any'). - :- meta_predicate loop_check_just(0). +%get_type(Depth,Self,Val,Type):- get_type01(Depth,Self,Val,Type). +get_type(Depth,Self,Val,TypeO):- no_repeats(TypeT,(get_type9(Depth,Self,Val,Type),TypeT=Type)),Type=TypeO. -%= +get_type9(_Dpth,_Slf,Expr,'hyperon::space::DynSpace'):- is_dynaspace(Expr),!. +get_type9(Depth,Self,Val,Type):- get_type0(Depth,Self,Val,Type). +get_type9(Depth,Self,Val,Type):- get_type1(Depth,Self,Val,Type), ground(Type),Type\==[], Type\==Val,!. +%get_type9(_Depth,_Self,Val,Type):- symbol(Val),atom_contains(Val,' '),!,Type='String'. +get_type9(Depth,Self,Val,Type):- get_type2(Depth,Self,Val,Type), ( is_list(Type)->! ; true). +get_type9(_Dpth,_Slf,_Vl,[]). -% % loop_check_just( :GoalG) is semidet. -% -% Loop Check Justification. -% -loop_check_just(G):- loop_check(G,ignore(arg(1,G,[]))). +get_type2(Depth,_Slf,Type,Type):- Depth<1,!. +%get_type(Depth,Self,Val,Type):- is_debugging(eval), !, +% ftrace(get_type0(Depth,Self,Val,Type)). +get_type2(Depth,Self,Val,Type):- get_type0(Depth,Self,Val,Type). +get_type2(Depth,Self,Val,Type):- get_type1(Depth,Self,Val,Type). -%= +is_space_type(Space,is_asserted_space):- was_asserted_space(Space),!. +is_space_type(Space,Test):- no_repeats(Test,space_type_method(Test,_,_)),call(Test,Space),!. -% % show_pred_info( ?F) is semidet. -% -% Show Predicate Info. -% -/* -show_pred_info(PI):- - (( - pi_to_head_l(PI,Head), - % doall(show_call(why,call_u(isa(Head,_)))), - safe_functor(Head,F,_), - doall(show_call(why,call_u(isa(F,_)))), - ((current_predicate(_,M:Head), (\+ predicate_property(M:Head,imported_from(_)))) - -> show_pred_info_0(M:Head); - wdmsg_pretty(cannot_show_pred_info(Head))))),!. -*/ - -%= - -% % show_pred_info_0( ?Head) is semidet. -% -% show Predicate info Primary Helper. -% -show_pred_info_0(Head):- - doall(show_call(why,predicate_property(Head,_))), - (has_cl(Head)->doall((show_call(why,clause(Head,_))));quietly((listing(Head)))),!. +is_state_type(State,Test):- no_repeats(Test,state_type_method(Test,_,_)),call(Test,State),!. +%is_dynaspace(Expr):- \+ is_list(Expr), callable(Expr), is_space_type(Expr,_). +is_dynaspace(S):- var(S),!,fail. +is_dynaspace(S):- was_asserted_space(S). +is_dynaspace(S):- py_named_space(S). +is_dynaspace(S):- typed_list(S,'hyperon::space::DynSpace',_). +% notrace( is_space_type(Expr,_)),!. +get_type0(_Dpth,_Slf,Expr,'hyperon::space::DynSpace'):- is_dynaspace(Expr),!. +get_type0(Depth,Self,Expr,['StateMonad',Type]):- notrace( is_valid_nb_state(Expr)),!, 'get-state'(Expr,Val),!, + ((state_decltype(Expr,Type),nonvar(Type)); (Depth2 is Depth-1, get_type(Depth2,Self,Val,Type))). +get_type0(Depth,Self,Val,Type):- \+ compound(Val),!,get_type01(Depth,Self,Val,Type),!. +get_type0(Depth,Self,Val,Type):- get_type03(Depth,Self,Val,Type),!. -% =================================================== -% Pretty Print Formula -% =================================================== +get_type01(_Dpth,_Slf,Var,'%Undefined%'):- var(Var),!. +get_type01(_Dpth,_Slf, [],'%Undefined%'):- !. +get_type01(_Dpth,Self,Op,Type):- metta_type(Self,Op,Type),!. +get_type01(_Dpth,_Slf,Val,'Number'):- number(Val). +get_type01(_Dpth,_Slf,Val,'Integer'):- integer(Val). +get_type01(_Dpth,_Slf,Val,'Decimal'):- float(Val). +get_type01(_Dpth,_Slf,Val,'Rational'):- rational(Val). +get_type01(_Dpth,_Slf,Val,'Bool'):- (Val=='False';Val=='True'),!. +%get_type01(_Dpth,_Slf,Val,Type):- string(Val),!,(Type='String';Type='Symbol'). +get_type01(_Dpth,_Slf,Expr,_):- \+ atom(Expr),!,fail. +get_type01(_Dpth,_Slf,Val,Type):- is_decl_type(Val),(Type=Val;Type='Type'). +get_type01(_Dpth,_Slf,Val,Type):- atomic_list_concat([Type,_|_],'@',Val). +get_type01(_Dpth,_Slf,Val,Type):- atomic_list_concat([Type,_|_],':',Val). +get_type01(Depth,Self,Op,Type):- Depth2 is Depth-1, eval_args(Depth2,Self,Op,Val),Op\=@=Val,!, get_type(Depth2,Self,Val,Type). +%get_type01(_Dpth,_Slf,Expr,'hyperon::space::DynSpace'):- \+ is_list(Expr), callable(Expr), is_space_type(Expr,_). +%get_type01(_Dpth,_Slf,_Val,'String'). +%get_type01(_Dpth,_Slf,_Val,'Symbol'). -%= +get_type02(_Dpth,Self,Expr,Type):- metta_type(Self,TExpr,Type), TExpr == Expr. +get_type02(_Dpth,Self,Expr,Type):- metta_type(Self,TExpr,Type), TExpr =@= Expr. +get_type02(Depth,Self,[Op|Expr],Type):- maplist(get_type(Depth,Self),Expr,Types), + metta_type(Self,[Op|Types],Type). -% % print_db_items( ?Title, ?Mask, ?What) is semidet. -% -% Print Database Items. -% -print_db_items(Title,Mask,What):-print_db_items(Title,Mask,Mask,What). -%= +get_type03(Depth,Self,[[Op|Args]|Arg],Type):- symbol(Op), + get_type03(Depth,Self,[Op|Args],Type1), + get_type(Depth,Self,Arg,ArgType), + ignore(sub_var(ArgType,Type1)->true;(sub_term(ST,Type1),var(ST),ST=ArgType)), + last(Type1,Type). -% % print_db_items( ?Title, ?Mask, ?SHOW, ?What0) is semidet. -% -% Print Database Items. -% -print_db_items(Title,Mask,SHOW,What0):- - get_pi(Mask,H),get_pi(What0,What), - format(atom(Showing),'~p for ~p...',[Title,What]), - statistics(cputime,Now),Max is Now + 2,!, - gripe_time(1.0, - doall((once(statistics(cputime,NewNow)),NewNow Type=RetType ; (Type=[],!)). -%= +get_type03(Depth,Self,Expr,Type):- get_type02(Depth,Self,Expr,Type). + +get_type03(Depth,Self,EvalMe,Type):- needs_eval(EvalMe),Depth2 is Depth-1, + eval_args(Depth2,Self,EvalMe,Val), + \+ needs_eval(Val),!, + get_type(Depth2,Self,Val,Type). + +get_type03(Depth,Self,Expr,Type):- Depth2 is Depth-1, + eval_args(Depth2, Self,Expr,Val), Expr\=@=Val,!, + get_type(Depth2,Self,Val,Type). + +get_type03(_Dpth,_Slf,Val,Type):- is_decl_type(Val),(Type=Val;Type='Type'). + +get_type03(_Dpth,_Slf,Expr,'Expression'):- is_list(Expr),!. + +get_type03(Depth,Self,List,Types):- List\==[], is_list(List), + Depth2 is Depth-1,maplist(get_type(Depth2,Self),List,Types). + + +get_type03(_Dpth,_Slf,Cmpd,Type):- compound(Cmpd),!, \+ ground(Cmpd),!,Type=[]. + +%get_type0(_Dpth,Self,List,Type):- is_list(List),metta_type(Self,Type,['->'|List]). +%get_type(Depth,Self,Op,Type):- nonvar(Op),metta_type(Self,Op,Type2),Depth2 is Depth-1,get_type(Depth2,Self,Type2,Type). +%get_type(Depth,Self,Op,Type):- Depth>0,nonvar(Op),metta_type(Self,Type,Op),!. %,!,last_element(List,Type). +%get_type(Depth,Self,[T|List],['List',Type]):- Depth2 is Depth-1, is_list(List),get_type(Depth2,Self,T,Type),!, +% forall((member(Ele,List),nonvar(Ele)),get_type(Depth2,Self,Ele,Type)),!. +%get_type(Depth,_Slf,Cmpd,Type):- compound(Cmpd), functor(Cmpd,Type,1),!. +%get_type0(_Dpth,_Slf,_,'%Undefined%'):- fail. + +state_decltype(Expr,Type):- functor(Expr,_,A),arg(A,Expr,Type),once(var(Type);is_decl_type(Type)). + + +get_type1(_Dpth,_Slf,Var,'%Undefined%'):- var(Var),!. +get_type1(_Dpth,_Slf,Val,'Number'):- number(Val),!. +get_type1(Depth,Self,Expr,['StateMonad',Type]):- is_valid_nb_state(Expr),'get-state'(Expr,Val),!, + get_type1(Depth,Self,Val,Type). -% % pfc_contains_term( ?What, ?VALUE2) is semidet. -% -% Managed Predicate Contains Term. -% -pfc_contains_term(What,_):-is_ftVar(What),!. -pfc_contains_term(What,Inside):- compound(What),!,(\+ \+ ((copy_term_nat(Inside,Inside0),snumbervars(Inside0),occurs:contains_term(What,Inside0)))),!. -pfc_contains_term(What,Inside):- (\+ \+ once((subst(Inside,What,foundZadooksy,Diff),Diff \=@= Inside ))),!. + +get_type1(Depth,Self,EvalMe,Type):- needs_eval(EvalMe), + eval_args(Depth,Self,EvalMe,Val), \+ needs_eval(Val),!, + get_type1(Depth,Self,Val,Type). + +get_type1(_Dpth,Self,[Fn|_],Type):- symbol(Fn),metta_type(Self,Fn,List),last_element(List,Type), nonvar(Type), + is_type(Type). +get_type1(_Dpth,Self,List,Type):- is_list(List),metta_type(Self,List,LType),last_element(LType,Type), nonvar(Type), + is_type(Type). + +get_type1(Depth,_Slf,Type,Type):- Depth<1,!. +get_type1(_Dpth,Self,List,Type):- is_list(List),metta_type(Self,Type,['->'|List]). +get_type1(Depth,Self,List,Types):- List\==[], is_list(List),Depth2 is Depth-1,maplist(get_type1(Depth2,Self),List,Types). +get_type1(_Dpth,Self,Fn,Type):- symbol(Fn),metta_type(Self,Fn,Type),!. +%get_type1(Depth,Self,Fn,Type):- nonvar(Fn),metta_type(Self,Fn,Type2),Depth2 is Depth-1,get_type1(Depth2,Self,Type2,Type). +%get_type1(Depth,Self,Fn,Type):- Depth>0,nonvar(Fn),metta_type(Self,Type,Fn),!. %,!,last_element(List,Type). + +get_type1(Depth,Self,Expr,Type):-Depth2 is Depth-1, + eval_args(Depth2,Self,Expr,Val), + Expr\=@=Val,get_type1(Depth2,Self,Val,Type). +get_type1(_Dpth,_Slf,Val,'String'):- string(Val),!. +get_type1(_Dpth,_Slf,Val,Type):- is_decl_type(Val),Type=Val. +get_type1(_Dpth,_Slf,Val,'Bool'):- (Val=='False';Val=='True'),!. +% get_type1(_Dpth,_Slf,Val,'Symbol'):- symbol(Val). +%get_type1(Depth,Self,[T|List],['List',Type]):- Depth2 is Depth-1, is_list(List),get_type1(Depth2,Self,T,Type),!, +% forall((member(Ele,List),nonvar(Ele)),get_type1(Depth2,Self,Ele,Type)),!. +%get_type1(Depth,_Slf,Cmpd,Type):- compound(Cmpd), functor(Cmpd,Type,1),!. +get_type1(_Dpth,_Slf,Cmpd,Type):- \+ ground(Cmpd),!,Type=[]. +get_type1(_Dpth,_Slf,_,'%Undefined%'):- fail. +%get_type1(Depth,Self,Val,Type):- Depth2 is Depth-1, get_type0(Depth2,Self,Val,Type). -%= -% % hook_pfc_listing( ?What) is semidet. -% -% Hook To [baseKB:hook_pfc_listing/1] For Module Mpred_listing. -% Hook Managed Predicate Listing. -% -:- current_prolog_flag(pfc_shared_module,BaseKB), - assert_if_new((BaseKB:hook_pfc_listing(What):- on_x_debug(pfc_list_triggers(What)))). -:- thread_local t_l:pfc_list_triggers_disabled/0. -% listing(L):-locally(t_l:pfc_list_triggers_disabled,listing(L)). +as_prolog(_Dpth,_Slf,I,O):- \+ iz_conz(I),!,I=O. +as_prolog(Depth,Self,[H|T],O):- H=='::',!,maplist(as_prolog(Depth,Self),T,L),!, O = L. +as_prolog(Depth,Self,[H|T],O):- H=='@',!,maplist(as_prolog(Depth,Self),T,L),!, O =.. L. +as_prolog(Depth,Self,I,O):- is_list(I),!,maplist(as_prolog(Depth,Self),I,O). +as_prolog(_Dpth,_Slf,I,I). -%= -% % pfc_list_triggers( ?What) is semidet. -% -% Managed Predicate List Triggers. -% -pfc_list_triggers(_):-t_l:pfc_list_triggers_disabled,!. -pfc_list_triggers(What):-loop_check(pfc_list_triggers_nlc(What)). +try_adjust_arg_types(_Eq,RetType,Depth,Self,Params,X,Y):- + as_prolog(Depth,Self,X,M), + args_conform(Depth,Self,M,Params),!, + set_type(Depth,Self,Y,RetType), + into_typed_args(Depth,Self,Params,M,Y). +%adjust_args(Eq,RetType,Depth,Self,_,X,Y):- is_list(X), !, maplist(eval_args(Depth,Self),X,Y). +%adjust_args(Eq,RetType,Depth,Self,_,X,Y):- is_list(X), !, maplist(as_prolog(Depth,Self),X,Y),!. -:- meta_predicate(pfc_list_triggers_nlc(?)). +adjust_args(_Eq,_RetType,_Dpth,Self,F,X,Y):- (X==[] ; is_special_op(Self,F); \+ iz_conz(X)),!,Y=X. +adjust_args(Eq,RetType,Depth,Self,Op,X,Y):- + adjust_argsA(Eq,RetType,Depth,Self,Op,X,Y)*->true; adjust_argsB(Eq,RetType,Depth,Self,Op,X,Y). +adjust_argsA(Eq,RetType,Depth,Self,Op,X,Y):- + %trace, + get_operator_typedef(Self,Op,Params,RetType), + try_adjust_arg_types(Eq,RetType,Depth,Self,Params,X,Y). +%adjust_args(_Eq,_RetType,Depth,Self,_,X,Y):- as_prolog(Depth,Self,X,Y). +adjust_argsB(_Eq,_RetType,_Depth,_Self,_,X,Y):- X = Y. -%= +into_typed_args(_Dpth,_Slf,T,M,Y):- (\+ iz_conz(T); \+ iz_conz(M)),!, M=Y. +into_typed_args(Depth,Self,[T|TT],[M|MM],[Y|YY]):- + into_typed_arg(Depth,Self,T,M,Y), + into_typed_args(Depth,Self,TT,MM,YY). -% % pfc_list_triggers_nlc( ?What) is semidet. -% -% Managed Predicate List Triggers Nlc. -% -pfc_list_triggers_nlc(MM:What):-atom(MM),!,MM:pfc_list_triggers(What). -pfc_list_triggers_nlc(What):-loop_check(pfc_list_triggers_0(What),true). +into_typed_arg(_Dpth,Self,T,M,Y):- var(M),!,put_attr(M,metta_type,Self=T),put_attr(Y,metta_type,Self=T),Y=M. +into_typed_arg(Depth,Self,T,M,Y):- into_typed_arg0(Depth,Self,T,M,Y)*->true;M=Y. +into_typed_arg0(Depth,Self,T,M,Y):- var(T), !, get_type(Depth,Self,M,T), + (wants_eval_kind(T)->eval_args(Depth,Self,M,Y);Y=M). -%= +into_typed_arg0(Depth,Self,T,M,Y):- is_pro_eval_kind(T),!,eval_args(Depth,Self,M,Y). +into_typed_arg0(Depth,Self,T,M,Y):- ground(M),!, \+ arg_violation(Depth,Self,M,T),Y=M. +into_typed_arg0(_Dpth,_Slf,T,M,Y):- is_non_eval_kind(T),!,M=Y. +into_typed_arg0(Depth,Self,_,M,Y):- eval_args(Depth,Self,M,Y). + +set_type(Depth,Self,Var,Type):- nop(set_type(Depth,Self,Var,Type)),!. +set_type(Depth,Self,Var,Type):- get_type(Depth,Self,Var,Was) + *->Was=Type + ; if_t(var(Var),put_attr(Var,metta_type,Self=Type)). + +metta_type:attr_unify_hook(Self=Type,NewValue):- + get_type(20,Self,NewValue,Was), + can_assign(Was,Type). + +can_assign(Was,Type):- Was=Type,!. +can_assign(Was,Type):- (is_nonspecific_type(Was);is_nonspecific_type(Type)),!. +can_assign(_Ws,_Typ). + +is_non_eval_kind(Type):- is_nonspecific_type(Type),!. +is_non_eval_kind('Atom'). + +is_pro_eval_kind('Number'). +is_pro_eval_kind('Symbol'). +is_pro_eval_kind('Bool'). + +is_feo_f('Cons'). + +is_seo_f('{...}'). +is_seo_f('[...]'). +is_seo_f('{}'). +is_seo_f('[]'). +is_seo_f('StateMonad'). +is_seo_f('State'). +is_seo_f('Event'). +is_seo_f('Concept'). +is_seo_f(N):- number(N),!. + +%is_user_defined_goal(Self,[H|_]):- is_user_defined_head(Eq,Self,H). + +is_user_defined_head(Other,H):- is_user_defined_head(=,Other,H). +is_user_defined_head(Eq,Other,H):- mnotrace(is_user_defined_head0(Eq,Other,H)). +is_user_defined_head0(Eq,Other,[H|_]):- !, nonvar(H),!, is_user_defined_head_f(Eq,Other,H). +is_user_defined_head0(Eq,Other,H):- callable(H),!,functor(H,F,_), is_user_defined_head_f(Eq,Other,F). +is_user_defined_head0(Eq,Other,H):- is_user_defined_head_f(Eq,Other,H). + +is_user_defined_head_f(Other,H):- is_user_defined_head_f(=,Other,H). +is_user_defined_head_f(Eq,Other,H):- is_user_defined_head_f1(Eq,Other,H). +is_user_defined_head_f(Eq,Other,H):- is_user_defined_head_f1(Eq,Other,[H|_]). + +%is_user_defined_head_f1(Eq,Other,H):- metta_type(Other,H,_). +%s_user_defined_head_f1(Other,H):- get_metta_atom(Eq,Other,[H|_]). +is_user_defined_head_f1(Other,H):- is_user_defined_head_f1(=,Other,H). +is_user_defined_head_f1(Eq,Other,H):- metta_defn(Eq,Other,[H|_],_). +%is_user_defined_head_f(Eq,_,H):- is_metta_builtin(H). + + + +is_special_op(Op):- current_self(Self),is_special_op(Self,Op). + +is_special_op(_Slf,F):- \+ atom(F), \+ var(F), !, fail. +is_special_op(Self,Op):- get_operator_typedef(Self,Op,Params,_RetType), + maplist(is_non_eval_kind,Params). +is_special_op(_Slf,Op):- is_special_builtin(Op). + + + +get_operator_typedef(Self,Op,Params,RetType):- + get_operator_typedef1(Self,Op,Params,RetType)*->true; + get_operator_typedef2(Self,Op,Params,RetType). +get_operator_typedef1(Self,Op,Params,RetType):- + metta_type(Self,Op,['->'|List]), + append(Params,[RetType],List). +get_operator_typedef2(Self,Op,Params,RetType):- + nop(wdmsg(missing(get_operator_typedef2(Self,Op,Params,RetType)))),!,fail. + +is_metta_data_functor(Eq,F):- + current_self(Self),is_metta_data_functor(Eq,Self,F). + + +is_special_builtin('case'). +is_special_builtin(':'). + +%is_special_builtin('='). +is_special_builtin('->'). +is_special_builtin('bind!'). +%is_special_builtin('new-space'). +is_special_builtin('let'). +is_special_builtin('let*'). +is_special_builtin('if'). +is_special_builtin('rtrace'). +is_special_builtin('or'). +is_special_builtin('and'). +is_special_builtin('not'). +is_special_builtin('match'). +is_special_builtin('call'). +is_special_builtin('let'). +is_special_builtin('let*'). +is_special_builtin('nop'). +is_special_builtin('assertEqual'). +is_special_builtin('assertEqualToResult'). +is_special_builtin('collapse'). +is_special_builtin('superpose'). +%is_special_builtin('=='). + +is_metta_builtin(Special):- is_special_builtin(Special). + +is_metta_builtin('=='). +is_metta_builtin(F):- once(atom(F);var(F)), current_op(_,yfx,F). +is_metta_builtin('println!'). +is_metta_builtin('transfer!'). +is_metta_builtin('compile!'). +is_metta_builtin('+'). +is_metta_builtin('-'). +is_metta_builtin('*'). +is_metta_builtin('/'). +is_metta_builtin('%'). +is_metta_builtin('=='). +is_metta_builtin('<'). +is_metta_builtin('>'). +is_metta_builtin('all'). +is_metta_builtin('import!'). +is_metta_builtin('pragma!'). + +% Comparison Operators in Prolog +% is_comp_op('=', 2). % Unification +is_comp_op('\\=', 2). % Not unifiable +is_comp_op('==', 2). % Strict equality +is_comp_op('\\==', 2). % Strict inequality +is_comp_op('@<', 2). % Term is before +is_comp_op('@=<', 2). % Term is before or equal +is_comp_op('@>', 2). % Term is after +is_comp_op('@>=', 2). % Term is after or equal +is_comp_op('=<', 2). % Less than or equal +is_comp_op('<', 2). % Less than +is_comp_op('>=', 2). % Greater than or equal +is_comp_op('>', 2). % Greater than +is_comp_op('is', 2). % Arithmetic equality +is_comp_op('=:=', 2). % Arithmetic exact equality +is_comp_op('=\\=', 2). % Arithmetic inequality + +% Arithmetic Operations +is_math_op('*', 2, exists). % Multiplication +is_math_op('**', 2, exists). % Exponentiation +is_math_op('+', 1, exists). % Unary Plus +is_math_op('+', 2, exists). % Addition +is_math_op('-', 1, exists). % Unary Minus +is_math_op('-', 2, exists). % Subtraction +is_math_op('.', 2, exists). % Array Indexing or Member Access (Depends on Context) +is_math_op('/', 2, exists). % Division +is_math_op('//', 2, exists). % Floor Division +is_math_op('///', 2, exists). % Alternative Division Operator (Language Specific) +is_math_op('/\\', 2, exists). % Bitwise AND +is_math_op('<<', 2, exists). % Bitwise Left Shift +is_math_op('>>', 2, exists). % Bitwise Right Shift +is_math_op('\\', 1, exists). % Bitwise NOT +is_math_op('\\/', 2, exists). % Bitwise OR +is_math_op('^', 2, exists). % Bitwise XOR +is_math_op('abs', 1, exists). % Absolute Value +is_math_op('acos', 1, exists). % Arc Cosine +is_math_op('acosh', 1, exists). % Hyperbolic Arc Cosine +is_math_op('asin', 1, exists). % Arc Sine +is_math_op('asinh', 1, exists). % Hyperbolic Arc Sine +is_math_op('atan', 1, exists). % Arc Tangent +is_math_op('atan2', 2, exists). % Two-Argument Arc Tangent +is_math_op('atanh', 1, exists). % Hyperbolic Arc Tangent +is_math_op('cbrt', 1, exists). % Cube Root +is_math_op('ceil', 1, exists). % Ceiling Function +is_math_op('ceiling', 1, exists). % Ceiling Value +is_math_op('cmpr', 2, exists). % Compare Two Values (Language Specific) +is_math_op('copysign', 2, exists). % Copy the Sign of a Number +is_math_op('cos', 1, exists). % Cosine Function +is_math_op('cosh', 1, exists). % Hyperbolic Cosine +is_math_op('cputime', 0, exists). % CPU Time +is_math_op('degrees', 1, exists). % Convert Radians to Degrees +is_math_op('denominator', 1, exists). % Get Denominator of Rational Number +is_math_op('div', 2, exists). % Integer Division +is_math_op('e', 0, exists). % Euler's Number +is_math_op('epsilon', 0, exists). % Machine Epsilon +is_math_op('erf', 1, exists). % Error Function +is_math_op('erfc', 1, exists). % Complementary Error Function +is_math_op('eval', 1, exists). % Evaluate Expression +is_math_op('exp', 1, exists). % Exponential Function +is_math_op('expm1', 1, exists). % exp(x) - 1 +is_math_op('fabs', 1, exists). % Absolute Value (Floating-Point) +is_math_op('float', 1, exists). % Convert Rational to Float +is_math_op('float_fractional_part', 1, exists). % Fractional Part of Float +is_math_op('float_integer_part', 1, exists). % Integer Part of Float +is_math_op('floor', 1, exists). % Floor Value +is_math_op('fmod', 2, exists). % Floating-Point Modulo Operation +is_math_op('frexp', 2, exists). % Get Mantissa and Exponent +is_math_op('fsum', 1, exists). % Accurate Floating Point Sum +is_math_op('gamma', 1, exists). % Gamma Function +is_math_op('gcd', 2, exists). % Greatest Common Divisor +is_math_op('getbit', 2, exists). % Get Bit at Position +is_math_op('hypot', 2, exists). % Euclidean Norm, Square Root of Sum of Squares +is_math_op('inf', 0, exists). % Positive Infinity +is_math_op('integer', 1, exists). % Convert Float to Integer +is_math_op('isinf', 1, exists). % Check for Infinity +is_math_op('isnan', 1, exists). % Check for Not a Number +is_math_op('lcm', 2, exists). % Least Common Multiple +is_math_op('ldexp', 2, exists). % Load Exponent of a Floating Point Number +is_math_op('lgamma', 1, exists). % Log Gamma +is_math_op('log', 1, exists). % Logarithm Base e +is_math_op('log10', 1, exists). % Base 10 Logarithm +is_math_op('log1p', 1, exists). % log(1 + x) +is_math_op('log2', 1, exists). % Base 2 Logarithm +is_math_op('lsb', 1, exists). % Least Significant Bit +is_math_op('max', 2, exists). % Maximum of Two Values +is_math_op('maxr', 2, exists). % Maximum Rational Number (Language Specific) +is_math_op('min', 2, exists). % Minimum of Two Values +is_math_op('minr', 2, exists). % Minimum Rational Number (Language Specific) +is_math_op('mod', 2, exists). % Modulo Operation +is_math_op('modf', 2, exists). % Return Fractional and Integer Parts +is_math_op('msb', 1, exists). % Most Significant Bit +is_math_op('nan', 0, exists). % Not a Number +is_math_op('nexttoward', 2, exists). % Next Representable Floating-Point Value +is_math_op('numerator', 1, exists). % Get Numerator of Rational Number +is_math_op('pi', 0, exists). % Pi +is_math_op('popcount', 1, exists). % Count of Set Bits +is_math_op('pow', 2, exists). % Exponentiation +is_math_op('powm', 3, exists). % Modulo Exponentiation +is_math_op('radians', 1, exists). % Convert Degrees to Radians +is_math_op('remainder', 2, exists). % Floating-Point Remainder +is_math_op('remquo', 3, exists). % Remainder and Part of Quotient +is_math_op('round', 1, exists). % Round to Nearest Integer +is_math_op('roundeven', 1, exists). % Round to Nearest Even Integer +is_math_op('setbit', 2, exists). % Set Bit at Position +is_math_op('signbit', 1, exists). % Sign Bit of Number +is_math_op('sin', 1, exists). % Sine Function +is_math_op('sinh', 1, exists). % Hyperbolic Sine +is_math_op('sqrt', 1, exists). % Square Root +is_math_op('tan', 1, exists). % Tangent Function +is_math_op('tanh', 1, exists). % Hyperbolic Tangent +is_math_op('testbit', 2, exists). % Test Bit at Position +is_math_op('trunc', 1, exists). % Truncate Decimal to Integer +is_math_op('ulogb', 1, exists). % Unbiased Exponent of a Floating-Point Value +is_math_op('xor', 2, exists). % Exclusive OR +is_math_op('zerop', 1, exists). % Test for Zero -% % pfc_list_triggers_0( ?What) is semidet. -% -% Managed Predicate list triggers Primary Helper. -% -pfc_list_triggers_0(What):-get_pi(What,PI),PI\=@=What,pfc_list_triggers(PI). -pfc_list_triggers_0(What):-nonvar(What),What= ~(Then),!, \+ \+ pfc_list_triggers_1(Then), \+ \+ pfc_list_triggers_1(What). -pfc_list_triggers_0(What):- \+ \+ pfc_list_triggers_1(~(What)), \+ \+ pfc_list_triggers_1(What). -%= +end_of_file. -% % pfc_list_triggers_types( ?VALUE1) is semidet. -% -% Managed Predicate list triggers Types. -% -pfc_list_triggers_types('Triggers'). -pfc_list_triggers_types('Instances'). -pfc_list_triggers_types('Subclasses'). -pfc_list_triggers_types('ArgTypes'). -pfc_list_triggers_types('Arity'). -pfc_list_triggers_types('Forward'). -pfc_list_triggers_types('Bidirectional'). -pfc_list_triggers_types('Backchaining'). -pfc_list_triggers_types('Negative'). -pfc_list_triggers_types('Sources'). -pfc_list_triggers_types('Supports'). -pfc_list_triggers_types('Edits'). - -% print_db_items_and_neg(Title,Fact,What):-nonvar(Fact),Fact= ~(_),!,fail. - -%= - -% % print_db_items_and_neg( ?Title, ?Fact, ?What) is semidet. -% -% Print Database Items And Negated. -% -print_db_items_and_neg(Title,Fact,What):-print_db_items(Title,Fact,What). -print_db_items_and_neg(Title,Fact,What):-print_db_items(Title,~(Fact),What). -%= +% # 1. Length of a List +% % Normal Recursive +% prolog +len([], 0). +len([_|T], N) :- + len(T, X), + N is X + 1. +% + +% % With Accumulator +% prolog +len_acc(L, N) :- + len_acc(L, 0, N). -% % pfc_list_triggers_1( ?What) is semidet. -% -% Managed Predicate list triggers Secondary Helper. -% -pfc_list_triggers_1(What):-var(What),!. -pfc_list_triggers_1(~(What)):- var(What),!. -pfc_list_triggers_1(~(_What)):-!. -pfc_list_triggers_1(What):- - print_db_items('Supports User',spft_precanonical(P,mfl4(VarNameZ,_,_,_),ax),'$spft$'(P,mfl4(VarNameZ,_,_,_),ax),What), - print_db_items('Forward Facts',(nesc(F)),F,What), - print_db_items('Forward Rules',(_==>_),What), - ignore((What\= ~(_),safe_functor(What,IWhat,_), - print_db_items_and_neg('Instance Of',isa(IWhat,_),IWhat), - print_db_items_and_neg('Instances: ',isa(_,IWhat),IWhat), - print_db_items_and_neg('Subclass Of',genls(IWhat,_),IWhat), - print_db_items_and_neg('Subclasses: ',genls(_,IWhat),IWhat))), - forall(suggest_m(M),print_db_items('PFC Watches', pfc_prop(M,_,_,_),What)), - print_db_items('Triggers Negative', '$nt$'(_,_,_,_),What), - print_db_items('Triggers Goal','$bt$'(_,_,_),What), - print_db_items('Triggers Positive','$pt$'(_,_,_),What), - print_db_items('Bidirectional Rules',(_<==>_),What), - dif(A,B),print_db_items('Supports Deduced',spft_precanonical(P,A,B),'$spft$'(P,A,B),What), - dif(G,ax),print_db_items('Supports Nonuser',spft_precanonical(P,G,G),'$spft$'(P,G,G),What), - print_db_items('Backchaining Rules',(_<-_),What), - % print_db_items('Edits',is_disabled_clause(_),What), - print_db_items('Edits',is_edited_clause(_,_,_),What), - print_db_items('Instances',isa(_,_),What), - print_db_items('Subclasses',genls(_,_),What), - print_db_items('Negative Facts',~(_),What), - - print_db_items('ArgTypes',argGenls(_,_,_),What), - print_db_items('ArgTypes',argIsa(_,_,_),What), - print_db_items('ArgTypes',argQuotedIsa(_,_,_),What), - print_db_items('ArgTypes',meta_argtypes(_),What), - print_db_items('ArgTypes',predicate_property(G,meta_predicate(G)),What), - print_db_items('ArgTypes',resultGenls(_,_),What), - print_db_items('ArgTypes',resultIsa(_,_),What), - print_db_items('Arity',arity(_,_),What), - print_db_items('Arity',current_predicate(_),What), - print_db_items('MetaFacts Predicate',predicate_property(_,_),What), - print_db_items('Sources',module_property(_,_),What), - print_db_items('Sources',predicateConventionMt(_,_),What), - print_db_items('Sources',source_file(_,_),What), - print_db_items('Sources',_:man_index(_,_,_,_,_),What), - print_db_items('Sources',_:'$pldoc'(_,_,_,_),What), - print_db_items('Sources',_:'$pred_option'(_,_,_,_),What), - print_db_items('Sources',_:'$mode'(_,_),What), - !. - - -pinfo(F/A):- listing(F/A),safe_functor(P,F,A),findall(Prop,predicate_property(P,Prop),List),wdmsg_pretty(pinfo(F/A)==List),!. - - - -% % pp_DB is semidet. -% -% Pretty Print All. +len_acc([], Acc, Acc). +len_acc([_|T], Acc, N) :- + NewAcc is Acc + 1, + len_acc(T, NewAcc, N). % -%pp_DB:- defaultAssertMt(M),clause_b(mtHybrid(M)),!,pp_DB(M). -%pp_DB:- forall(clause_b(mtHybrid(M)),pp_DB(M)). - -pp_DB:- prolog_load_context(module,M),pp_DB(M). - -with_exact_kb(M,G):- M:call(G). - -pp_DB(M):- - with_exact_kb(M, - M:must_det_l(( - pp_db_facts, - pp_db_rules, - pp_db_triggers, - pp_db_supports))). - -pp_db_facts:- context_module(M), pp_db_facts(M). -pp_db_rules:- context_module(M), pp_db_rules(M). -pp_db_triggers:- context_module(M), pp_db_triggers(M). -pp_db_supports:- context_module(M), pp_db_supports(M). - - -:- system:import(pp_DB/0). -:- system:export(pp_DB/0). - -% pp_db_facts ... - -pp_db_facts(MM):- ignore(pp_db_facts(MM,_,true)). - -pp_db_facts(MM,Pattern):- pp_db_facts(MM,Pattern,true). - -pp_db_facts(MM,P,C):- - pfc_facts_in_kb(MM,P,C,L), - pfc_classifyFacts(L,User,Pfc,_ZRule), - length(User,UserSize),length(Pfc,PfcSize), - format("~N~nUser added facts in [~w]: ~w",[MM,UserSize]), - pp_db_items(User), - format("~N~nSystem added facts in [~w]: ~w",[MM,PfcSize]), - pp_db_items(Pfc). - -% printitems clobbers it''s arguments - beware! - - -pp_db_items(Var):-var(Var),!,format("~N ~p",[Var]). -pp_db_items([]):-!. -pp_db_items([H|T]):- !, - % numbervars(H,0,_), - format("~N ~p",[H]), - nonvar(T),pp_db_items(T). - -pp_db_items((P >= FT)):- is_hidden_pft(P,FT),!. - -pp_db_items(Var):- - format("~N ~p",[Var]). - - -is_hidden_pft(_,(mfl4(_VarNameZ,BaseKB,_,_),ax)):- current_prolog_flag(pfc_shared_module,BaseKB),!. -is_hidden_pft(_,(why_marked(_),ax)). - -pp_mask(Type,MM,Mask):- - bagof_or_nil(Mask,lookup_kb(MM,Mask),Nts), - list_to_set_variant(Nts,NtsSet),!, - pp_mask_list(Type,MM,NtsSet). - -pp_mask_list(Type,MM,[]):- !, - format("~N~nNo ~ws in [~w]...~n",[Type,MM]). -pp_mask_list(Type,MM,NtsSet):- length(NtsSet,Size), !, - format("~N~n~ws (~w) in [~w]...~n",[Type,Size,MM]), - pp_db_items(NtsSet). - -pfc_classifyFacts([],[],[],[]). - -pfc_classifyFacts([H|T],User,Pfc,[H|Rule]):- - pfcType(H,rule(_)), - !, - pfc_classifyFacts(T,User,Pfc,Rule). - -pfc_classifyFacts([H|T],[H|User],Pfc,Rule):- - % get_source_uu(UU), - get_first_user_reason(H,_UU), - !, - pfc_classifyFacts(T,User,Pfc,Rule). - -pfc_classifyFacts([H|T],User,[H|Pfc],Rule):- - pfc_classifyFacts(T,User,Pfc,Rule). - - -pp_db_rules(MM):- - pp_mask("Forward Rule",MM,==>(_,_)), - pp_mask("Bidirectional Rule",MM,<==>(_,_)), - pp_mask("Backchaining Rule",MM,<-(_,_)), - pp_mask("Implication Rule",MM,=>(_,_)), - pp_mask("Bi-conditional Rule",MM,<=>(_,_)), - pp_mask("Negative Fact",MM,(~(_))), - % pp_mask("Material-impl Rule",MM,<=(_,_)), - % pp_mask("Prolog Rule",MM,:-(_,_)), - !. - - -pp_db_triggers(MM):- - pp_mask("Positive trigger(+)",MM,'$pt$'(_,_)), - pp_mask("Negative trigger(-)",MM,'$nt$'(_,_,_)), - pp_mask("Goal trigger(?)",MM,'$bt$'(_,_)),!. - -pp_db_supports(MM):- - % temporary hack. - format("~N~nSupports in [~w]...~n",[MM]), - with_exact_kb(MM, bagof_or_nil((P >= S), pfcGetSupport(P,S),L)), - list_to_set_variant(L,LS), - pp_db_items(LS),!. - - -list_to_set_variant(List, Unique) :- - list_unique_1(List, [], Unique),!. - -list_unique_1([], _, []). -list_unique_1([X|Xs], So_far, Us) :- - memberchk_variant(X, So_far),!, - list_unique_1(Xs, So_far, Us). -list_unique_1([X|Xs], So_far, [X|Us]) :- - list_unique_1(Xs, [X|So_far], Us). - - -% % memberchk_variant(+Val, +List) +% # 2. Sum of a List +% % Normal Recursive +% prolog +sum([], 0). +sum([H|T], S) :- + sum(T, X), + S is X + H. % -% Deterministic check of membership using =@= rather than -% unification. -memberchk_variant(X, [Y|Ys]) :- - ( X =@= Y - -> true - ; memberchk_variant(X, Ys) - ). +% % With Accumulator +% prolog +sum_acc(L, S) :- + sum_acc(L, 0, S). -lookup_kb(MM,MHB):- strip_module(MHB,M,HB), - expand_to_hb(HB,H,B), - (MM:clause(M:H,B,Ref)*->true; M:clause(MM:H,B,Ref)), - %clause_ref_module(Ref), - clause_property(Ref,module(MM)). - - -% % has_cl( +H) is semidet. +sum_acc([], Acc, Acc). +sum_acc([H|T], Acc, S) :- + NewAcc is Acc + H, + sum_acc(T, NewAcc, S). % -% Has Clause. -% -has_cl(H):-predicate_property(H,number_of_clauses(_)). - - -% % clause_or_call( +H, ?B) is semidet. -% -% Clause Or Call. +% # 3. Factorial +% % Normal Recursive +% prolog +factorial(0, 1). +factorial(N, F) :- + N > 0, + X is N - 1, + factorial(X, Y), + F is N * Y. % -% PFC2.0 clause_or_call(M:H,B):-is_ftVar(M),!,no_repeats(M:F/A,(f_to_mfa(H,M,F,A))),M:clause_or_call(H,B). -% PFC2.0 clause_or_call(isa(I,C),true):-!,call_u(isa_asserted(I,C)). -% PFC2.0 clause_or_call(genls(I,C),true):-!,on_x_log_throw(call_u(genls(I,C))). -clause_or_call(H,B):- clause(src_edit(_Before,H),B). -clause_or_call(H,B):- predicate_property(H,number_of_clauses(C)),predicate_property(H,number_of_rules(R)),((R*2 (clause(H,B)*->!;fail) ; clause(H,B)). -% PFC2.0 clause_or_call(H,true):- call_u(should_call_for_facts(H)),no_repeats(on_x_log_throw(H)). - - /* - +% % With Accumulator +% prolog +factorial_acc(N, F) :- + factorial_acc(N, 1, F). - -% as opposed to simply using clause(H,true). - -% % should_call_for_facts( +H) is semidet. -% -% Should Call For Facts. -% -should_call_for_facts(H):- get_functor(H,F,A),call_u(should_call_for_facts(H,F,A)). - -% % should_call_for_facts( +VALUE1, ?F, ?VALUE3) is semidet. -% -% Should Call For Facts. +factorial_acc(0, Acc, Acc). +factorial_acc(N, Acc, F) :- + N > 0, + NewAcc is Acc * N, + NewN is N - 1, + factorial_acc(NewN, NewAcc, F). % -should_call_for_facts(_,F,_):- a(prologSideEffects,F),!,fail. -should_call_for_facts(H,_,_):- modulize_head(H,HH), \+ predicate_property(HH,number_of_clauses(_)),!. -should_call_for_facts(_,F,A):- clause_b(pfc_prop(_M,F,A,pfcRHS)),!,fail. -should_call_for_facts(_,F,A):- clause_b(pfc_prop(_M,F,A,pfcMustFC)),!,fail. -should_call_for_facts(_,F,_):- a(prologDynamic,F),!. -should_call_for_facts(_,F,_):- \+ a(pfcControlled,F),!. - */ - -% % no_side_effects( +P) is semidet. -% -% No Side Effects. +% # 4. Reverse List +% % Normal Recursive +% prolog +reverse_list([], []). +reverse_list([H|T], R) :- + reverse_list(T, RevT), + append(RevT, [H], R). % -%no_side_effects(P):- (\+ is_side_effect_disabled->true;(get_functor(P,F,_),a(prologSideEffects,F))). -pfc_facts_in_kb(MM,P,C,L):- with_exact_kb(MM,setof_or_nil(P,pfcFact(P,C),L)). +% % With Accumulator +% prolog +reverse_list_acc(L, R) :- + reverse_list_acc(L, [], R). -lookup_spft(P,F,T):-pfcGetSupport(P,(F,T)). -% why_dmsg(Why,Msg):- with_current_why(Why,dmsg_pretty(Msg)). - -u_to_uu(U,(U,ax)):- var(U),!. -u_to_uu(U,U):- nonvar(U),U=(_,_),!. -u_to_uu([U|More],UU):-list_to_conjuncts([U|More],C),!,u_to_uu(C,UU). -u_to_uu(U,(U,ax)):-!. - -% % get_source_uu( :TermU) is det. +reverse_list_acc([], Acc, Acc). +reverse_list_acc([H|T], Acc, R) :- + reverse_list_acc(T, [H|Acc], R). % -% Get Source Ref (Current file or User) -% -:- module_transparent((get_source_uu)/1). -get_source_uu(UU):- must(((get_source_ref1(U),u_to_uu(U,UU)))),!. - -get_source_ref1(U):- quietly_ex(((current_why(U),nonvar(U)));ground(U)),!. -get_source_ref1(U):- quietly_ex(((get_source_mfl(U)))),!. - - -:- module_transparent((get_why_uu)/1). -get_why_uu(UU):- findall(U,current_why(U),Whys),Whys\==[],!,u_to_uu(Whys,UU). -get_why_uu(UU):- get_source_uu(UU),!. - - -get_startup_uu(UU):- - prolog_load_context(module,CM), - u_to_uu((isRuntime,mfl4(VarNameZ,CM, user_input, _)),UU),varnames_load_context(VarNameZ). - -is_user_reason((_,U)):-atomic(U). -only_is_user_reason((U1,U2)):- freeze(U2,is_user_reason((U1,U2))). - -is_user_fact(P):-get_first_user_reason(P,UU),is_user_reason(UU). - - -get_first_real_user_reason(P,UU):- nonvar(P), UU=(F,T), - quietly_ex(( ((((lookup_spft(P,F,T))),is_user_reason(UU))*-> true; - ((((lookup_spft(P,F,T))), \+ is_user_reason(UU))*-> (!,fail) ; fail)))). - -get_first_user_reason(P,(F,T)):- - UU=(F,T), - ((((lookup_spft(P,F,T))),is_user_reason(UU))*-> true; - ((((lookup_spft(P,F,T))), \+ is_user_reason(UU))*-> (!,fail) ; - (clause_asserted(P),get_source_uu(UU),is_user_reason(UU)))),!. -get_first_user_reason(_,UU):- get_why_uu(UU),is_user_reason(UU),!. -get_first_user_reason(_,UU):- get_why_uu(UU),!. -get_first_user_reason(P,UU):- must_ex(ignore(((get_first_user_reason0(P,UU))))),!. -get_first_user_reason0(_,(M,ax)):-get_source_mfl(M). - -%get_first_user_reason(_,UU):- get_source_uu(UU),\+is_user_reason(UU). % ignore(get_source_uu(UU)). - -%:- export(pfc_at_box:defaultAssertMt/1). -%:- system:import(defaultAssertMt/1). -%:- pfc_lib:import(pfc_at_box:defaultAssertMt/1). - -:- module_transparent((get_source_mfl)/1). -get_source_mfl(M):- current_why(M), nonvar(M) , M =mfl4(_VarNameZ,_,_,_). -get_source_mfl(mfl4(VarNameZ,M,F,L)):- defaultAssertMt(M), current_source_location(F,L),varnames_load_context(VarNameZ). - -get_source_mfl(mfl4(VarNameZ,M,F,L)):- defaultAssertMt(M), current_source_file(F:L),varnames_load_context(VarNameZ). -get_source_mfl(mfl4(VarNameZ,M,F,_L)):- defaultAssertMt(M), current_source_file(F),varnames_load_context(VarNameZ). -get_source_mfl(mfl4(VarNameZ,M,_F,_L)):- defaultAssertMt(M), varnames_load_context(VarNameZ). -%get_source_mfl(M):- (defaultAssertMt(M)->true;(atom(M)->(module_property(M,class(_)),!);(var(M),module_property(M,class(_))))). -get_source_mfl(M):- fail,dtrace, - ((defaultAssertMt(M) -> !; - (atom(M)->(module_property(M,class(_)),!); - pfcError(no_source_ref(M))))). - -is_source_ref1(_). - -defaultAssertMt(M):- prolog_load_context(module, M). - - - -pfc_pp_db_justifications(P,Js):- - show_current_source_location, - must_ex(quietly_ex(( format("~NJustifications for ~p:",[P]), - pfc_pp_db_justification1('',Js,1)))). - -pfc_pp_db_justification1(_Prefix,[],_). - -pfc_pp_db_justification1(Prefix,[J|Js],N):- - % show one justification and recurse. - nl, - pfc_pp_db_justifications2(Prefix,J,N,1), - %reset_shown_justs, - N2 is N+1, - pfc_pp_db_justification1(Prefix,Js,N2). - -pfc_pp_db_justifications2(_Prefix,[],_,_). - -pfc_pp_db_justifications2(Prefix,[C|Rest],JustNo,StepNo):- -(nb_hasval('$last_printed',C)-> dmsg_pretty(chasVal(C)) ; -( - (StepNo==1->fmt('~N~n',[]);true), - backward_compatibility:sformat(LP,' ~w.~p.~p',[Prefix,JustNo,StepNo]), - nb_pushval('$last_printed',LP), - format("~N ~w ~p",[LP,C]), - ignore(loop_check(pfcWhy_sub_sub(C))), - StepNext is 1+StepNo, - pfc_pp_db_justifications2(Prefix,Rest,JustNo,StepNext))). - - -pfcWhy_sub_sub(P):- - justifications(P,Js), - clear_proofs, - % retractall_u(t_l:whybuffer(_,_)), - (nb_hasval('$last_printed',P)-> dmsg_pretty(hasVal(P)) ; - (( - assertz(t_l:whybuffer(P,Js)), - nb_getval('$last_printed',LP), - ((pfc_pp_db_justification1(LP,Js,1),fmt('~N~n',[])))))). - -nb_pushval(Name,Value):-nb_current(Name,Before)->nb_setval(Name,[Value|Before]);nb_setval(Name,[Value]). -nb_peekval(Name,Value):-nb_current(Name,[Value|_Before]). -nb_hasval(Name,Value):-nb_current(Name,List),member(Value,List). -nb_popval(Name,Value):-nb_current(Name,[Value|Before])->nb_setval(Name,Before). - -reset_shown_justs:- retractall(t_l:shown_why(_)),nop(color_line(red,1)). -clear_proofs:- retractall(t_l:whybuffer(_P,_Js)),nop(color_line(cyan,1)). - - -lookup_spft_match(A,B,C):- copy_term(A,AA),lookup_spft(A,B,C),A=@=AA. -lookup_spft_match_deeper(H,Fact,Trigger):- - copy_term(H,HH), - lookup_spft((H:- _B),Fact,Trigger), - H=@=HH. - -lookup_spft_match_first(A,B,C):- nonvar(A),!, - no_repeats(((lookup_spft_match(A,B,C);lookup_spft(A,B,C)))). - -lookup_spft_match_first(A,B,C):- lookup_spft(A,B,C). - - -% % pfc_is_info( :TermC) is semidet. +% # 5. Fibonacci +% % Normal Recursive +% prolog +fibonacci(0, 0). +fibonacci(1, 1). +fibonacci(N, F) :- + N > 1, + N1 is N - 1, + N2 is N - 2, + fibonacci(N1, F1), + fibonacci(N2, F2), + F is F1 + F2. % -% PFC If Is A Info. -% -pfc_is_info((CWC,Info)):- (atom(CWC),is_a_info(CWC));pfc_is_info(Info). -pfc_is_info(pfc_bc_only(C)):-is_ftNonvar(C),!. -pfc_is_info(infoF(C)):-is_ftNonvar(C),!. -pfc_is_info(inherit_above(_,_)). - - -is_a_info(fail). -is_a_info(CWC):- is_pfc_chained(CWC). - -is_pfc_chained(cwc). -is_pfc_chained(awc). -is_pfc_chained(zwc). -is_pfc_chained(fwc). -is_pfc_chained(bwc). -is_pfc_chained(wac). - -:- forall(is_pfc_chained(Op),assert_if_new(Op)). - -reserved_body(B):-var(B),!,fail. -reserved_body(attr_bind(_)). -reserved_body(attr_bind(_,_)). -reserved_body(B):-reserved_body_helper(B). - -reserved_body_helper(B):- \+ compound(B),!,fail. -reserved_body_helper((ZAWC,_)):- atom(ZAWC),is_pfc_chained(ZAWC). - -call_only_based_mfl(H,mfl4(_VarNameZ,M,F,L)):- - ignore(predicate_property(H,imported_from(M));predicate_property(H,module(M))), - ignore(predicate_property(H,line_count(L))), - ignore(source_file(M:H,F);predicate_property(H,file(F));(predicate_property(H,foreign),F=foreign)). - -uses_call_only(H):- predicate_property(H,foreign),!. -uses_call_only(H):- predicate_property(H,_), \+ predicate_property(H,interpreted),!. - -clause_match(H,_B,uses_call_only(H)):- uses_call_only(H),!. -clause_match(H,B,Ref):- clause_asserted(H,B,Ref),!. -clause_match(H,B,Ref):- ((copy_term(H,HH),clause(H,B,Ref),H=@=HH)*->true;clause(H,B,Ref)), \+ reserved_body_helper(B). - -find_mfl(C,MFL):- lookup_spft_match(C,MFL,ax). -find_mfl(C,MFL):- unwrap_litr0(C,UC) -> C\==UC -> find_mfl(UC,MFL). -find_mfl(C,MFL):- expand_to_hb(C,H,B), - find_hb_mfl(H,B,_Ref,MFL)->true; (clause_match(H,B,Ref),find_hb_mfl(H,B,Ref,MFL)). - -find_hb_mfl(_H,_B,Ref,mfl4(_VarNameZ,M,F,L)):- atomic(Ref),clause_property(Ref,line_count(L)), - clause_property(Ref,file(F)),clause_property(Ref,module(M)). -find_hb_mfl(H,B,_,mfl4(VarNameZ,M,F,L)):- lookup_spft_match_first( (H:-B),mfl4(VarNameZ,M,F,L),_),!. -find_hb_mfl(H,B,_Ref,mfl4(VarNameZ,M,F,L)):- lookup_spft_match_first(H,mfl4(VarNameZ,M,F,L),_),ground(B). -find_hb_mfl(H,_B,uses_call_only(H),MFL):- !,call_only_based_mfl(H,MFL). -:- fixup_exports. -%:- current_prolog_flag(pfc_shared_module,BaseKB),fixup_module_exports_into(BaseKB). -:- fixup_module_exports_into(system). +% % With Accumulator +% prolog +fibonacci_acc(N, F) :- + fibonacci_acc(N, 0, 1, F). -mpred_rule_hb(C,_):- \+ compound(C),!,fail. -mpred_rule_hb((H:-B),H,B):- !. -mpred_rule_hb((H<-B),H,B):- !. -mpred_rule_hb((B==>H),H,B):- !. -mpred_rule_hb((==>H),H,true):- !. -mpred_rule_hb((HB1<==>HB2),(H1,H2),(B1,B2)):- !, (mpred_rule_hb((HB1==>HB2),H2,B2);mpred_rule_hb((HB2==>HB1),H1,B1)). - -:- module_transparent( (get_assertion_head_arg)/3). -get_assertion_head_arg(N,P,E):-get_assertion_head_unnegated(P,PP),!,arg(N,PP,E). - -get_assertion_head_unnegated(P,PP):- mpred_rule_hb(P,H,_), (pfc_unnegate(H,PP)->true;H==PP). -replace_arg(Q,N,NEW,R):- duplicate_term(Q,R),Q=R,nb_setarg(N,R,NEW). - -%% if_missing_mask( +Q, ?R, ?Test) is semidet. -% -% If Missing Mask. +fibonacci_acc(0, A, _, A). +fibonacci_acc(N, A, B, F) :- + N > 0, + NewN is N - 1, + NewB is A + B, + fibonacci_acc(NewN, B, NewB, F). % -if_missing_mask(M:Q,M:R,M:Test):- nonvar(Q),!,if_missing_mask(Q,R,Test). -if_missing_mask(Q,~Q,\+Q):- \+ is_ftCompound(Q),!. -%if_missing_mask(ISA, ~ ISA, \+ ISA):- functor(ISA,F,1),(F==tSwim;call_u(functorDeclares(F))),!. -if_missing_mask(HB,RO,TestO):- once(mpred_rule_hb(HB,H,B)),B\==true,HB\==H,!, - if_missing_mask(H,R,TestO),subst(HB,H,R,RO). -if_missing_mask(ISA, ISA, \+ ISA):- functor(ISA, _F,1),!.% (F==tSwim;call_u(functorDeclares(F))),!. - -if_missing_mask(Q,R,Test):- - which_missing_argnum(Q,N), - if_missing_n_mask(Q,N,R,Test),!. - -if_missing_mask(ISA, ~ ISA, \+ ISA). - -%% if_missing_n_mask( +Q, ?N, ?R, ?Test) is semidet. -% -% If Missing Mask. +% 6. Find an Element in a List +% # Normal Recursive +% prolog +element_in_list(X, [X|_]). +element_in_list(X, [_|T]) :- element_in_list(X, T). % -if_missing_n_mask(Q,N,R,Test):- - get_assertion_head_arg(N,Q,Was), - (nonvar(R)-> (which_missing_argnum(R,RN),get_assertion_head_arg(RN,R,NEW));replace_arg(Q,N,NEW,R)),!, - Test=dif:dif(Was,NEW). - -/* -Old version -if_missing_mask(Q,N,R,dif:dif(Was,NEW)):- - must((is_ftNonvar(Q),acyclic_term(Q),acyclic_term(R),functor(Q,F,A),functor(R,F,A))), - (singleValuedInArg(F,N) -> - (get_assertion_head_arg(N,Q,Was),replace_arg(Q,N,NEW,R)); - ((get_assertion_head_arg(N,Q,Was),is_ftNonvar(Was)) -> replace_arg(Q,N,NEW,R); - (N=A,get_assertion_head_arg(N,Q,Was),replace_arg(Q,N,NEW,R)))). -*/ - - -%% which_missing_argnum( +VALUE1, ?VALUE2) is semidet. -% -% Which Missing Argnum. -% -which_missing_argnum(Q,N):- compound(Q),\+ compound_name_arity(Q,_,0), - must((acyclic_term(Q),is_ftCompound(Q),get_functor(Q,F,A))), - F\=t, - (call_u(singleValuedInArg(F,N)) -> true; which_missing_argnum(Q,F,A,N)). - -which_missing_argnum(_,_,1,_):-!,fail. -which_missing_argnum(Q,_F,A,N):- between(A,1,N),get_assertion_head_arg(N,Q,Was),is_ftNonvar(Was). - -:- set_prolog_flag(pfc_term_expansion,false). - -:- multifile(system:term_expansion/4). -system:term_expansion(I,S0,O,S1):- %use_pfc_term_expansion, % trace, - ( \+ current_prolog_flag(pfc_term_expansion,false), - ( \+ \+ (source_location(File,_), atom_concat(_,'.pfc.pl',File)) ; current_prolog_flag(pfc_term_expansion,true))) -> - prolog_load_context('term',T)->(T==I->pfc_term_expansion(I,O)-> I\=@=O->S0=S1, fbugio(I-->O)). - - -% :- endif. - -end_of_file. - - - - - - - - - - - - - - - +% # With Accumulator +% prolog +element_in_list_acc(X, L) :- element_in_list_acc(X, L, false). - - - - -%% is_fc_body( +P) is semidet. -% -% If Is A Forward Chaining Body. -% -is_fc_body(P):- has_body_atom(fwc,P). - -%% is_bc_body( +P) is semidet. -% -% If Is A Backchaining Body. +element_in_list_acc(X, [], Acc) :- Acc. +element_in_list_acc(X, [X|_], _) :- true. +element_in_list_acc(X, [_|T], Acc) :- element_in_list_acc(X, T, Acc). % -is_bc_body(P):- has_body_atom(bwc,P). -%% is_action_body( +P) is semidet. +% 7. Check if a List is a Palindrome +% # Normal Recursive +% prolog +is_palindrome(L) :- reverse(L, L). % -% If Is A Action Body. -% -is_action_body(P):- has_body_atom(wac,P). - +% # With Accumulator +% prolog +is_palindrome_acc(L) :- reverse_acc(L, [], L). -%% has_body_atom( +WAC, ?P) is semidet. +reverse_acc([], Acc, Acc). +reverse_acc([H|T], Acc, R) :- reverse_acc(T, [H|Acc], R). % -% Has Body Atom. -% -has_body_atom(WAC,P):- call( - WAC==P -> true ; (is_ftCompound(P),get_assertion_head_arg(1,P,E),has_body_atom(WAC,E))),!. - -/* -has_body_atom(WAC,P,Rest):- call(WAC==P -> Rest = true ; (is_ftCompound(P),functor(P,F,A),is_atom_body_pfa(WAC,P,F,A,Rest))). -is_atom_body_pfa(WAC,P,F,2,Rest):-get_assertion_head_arg(1,P,E),E==WAC,get_assertion_head_arg(2,P,Rest),!. -is_atom_body_pfa(WAC,P,F,2,Rest):-get_assertion_head_arg(2,P,E),E==WAC,get_assertion_head_arg(1,P,Rest),!. -*/ - -same_functors(Head1,Head2):-must_det(get_unnegated_functor(Head1,F1,A1)),must_det(get_unnegated_functor(Head2,F2,A2)),!,F1=F2,A1=A2. - -%% mpred_update_literal( +P, ?N, ?Q, ?R) is semidet. +% 8. Calculate the Product of All Elements in a List +% # Normal Recursive +% prolog +product_list([], 1). +product_list([H|T], P) :- + product_list(T, Temp), + P is H * Temp. % -% PFC Update Literal. -% -mpred_update_literal(P,N,Q,R):- - get_assertion_head_arg(N,P,UPDATE),call(replace_arg(P,N,Q_SLOT,Q)), - must(call_u(Q)),update_value(Q_SLOT,UPDATE,NEW), - replace_arg(Q,N,NEW,R). - -% '$spft'(MZ,5,5,5). +% # With Accumulator +% prolog +product_list_acc(L, P) :- product_list_acc(L, 1, P). -%% update_single_valued_arg(+Module, +P, ?N) is semidet. +product_list_acc([], Acc, Acc). +product_list_acc([H|T], Acc, P) :- + NewAcc is Acc * H, + product_list_acc(T, NewAcc, P). +% + +% 9. Find the Nth Element of a List +% # Normal Recursive +% prolog +nth_element(1, [H|_], H). +nth_element(N, [_|T], X) :- + N > 1, + M is N - 1, + nth_element(M, T, X). % -% Update Single Valued Argument. -% -:- module_transparent( (update_single_valued_arg)/3). - -update_single_valued_arg(M,M:Pred,N):-!,update_single_valued_arg(M,Pred,N). -update_single_valued_arg(_,M:Pred,N):-!,update_single_valued_arg(M,Pred,N). - -update_single_valued_arg(world,P,N):- !, current_prolog_flag(pfc_shared_module,BaseKB), update_single_valued_arg(BaseKB,P,N). -update_single_valued_arg(M,P,N):- ibreak, \+ clause_b(mtHybrid(M)), trace, clause_b(mtHybrid(M2)),!, - update_single_valued_arg(M2,P,N). - -update_single_valued_arg(M,P,N):- - get_assertion_head_arg(N,P,UPDATE), - is_relative(UPDATE),!, - dtrace, - ibreak, - replace_arg(P,N,OLD,Q), - must_det_l((clause_u(Q),update_value(OLD,UPDATE,NEW),\+ is_relative(NEW), replace_arg(Q,N,NEW,R))),!, - update_single_valued_arg(M,R,N). - - -update_single_valued_arg(M,P,N):- - call_u((must_det_l(( - - call_u(mtHybrid(M)), - mpred_type_args \= M, - mpred_kb_ops \= M, - get_assertion_head_arg(N,P,UPDATE), - replace_arg(P,N,Q_SLOT,Q), - var(Q_SLOT), - same_functors(P,Q), - % current_why(U), - must_det_l(( - % rtrace(attvar_op(assert_if_new,M:'$spft'(MZ,P,U,ax))), - % (call_u(P)->true;(assertz_mu(P))), - assertz(M:P), - doall(( - lookup_u(M:Q,E), - UPDATE \== Q_SLOT, - erase(E), - mpred_unfwc1(M:Q))))))))). - -% ======================= -% utils -% ======================= - -%% map_literals( +P, ?G) is semidet. -% -% Map Literals. -% -map_literals(P,G):-map_literals(P,G,[]). - -%% map_literals( +VALUE1, :TermH, ?VALUE3) is semidet. +% # With Accumulator +% prolog +nth_element_acc(N, L, X) :- nth_element_acc(N, L, 1, X). + +nth_element_acc(N, [H|_], N, H). +nth_element_acc(N, [_|T], Acc, X) :- + NewAcc is Acc + 1, + nth_element_acc(N, T, NewAcc, X). % -% Map Literals. -% -map_literals(_,H,_):-is_ftVar(H),!. % skip over it -map_literals(_,[],_) :- !. -map_literals(Pred,(H,T),S):-!, apply(Pred,[H|S]), map_literals(Pred,T,S). -map_literals(Pred,[H|T],S):-!, apply(Pred,[H|S]), map_literals(Pred,T,S). -map_literals(Pred,H,S):- mpred_literal(H),must(apply(Pred,[H|S])),!. -map_literals(_Pred,H,_S):- \+ is_ftCompound(H),!. % skip over it -map_literals(Pred,H,S):-H=..List,!,map_literals(Pred,List,S),!. - - -%% map_unless( :PRED1Test, ?Pred, ?H, ?S) is semidet. -% -% Map Unless. +% 10. Count the Occurrences of an Element in a List +% # Normal Recursive +% prolog +count_occurrences(_, [], 0). +count_occurrences(X, [X|T], N) :- + count_occurrences(X, T, M), + N is M + 1. +count_occurrences(X, [Y|T], N) :- + X \= Y, + count_occurrences(X, T, N). % -map_unless(Test,Pred,H,S):- call(Test,H),ignore(apply(Pred,[H|S])),!. -map_unless(_Test,_,[],_) :- !. -map_unless(_Test,_Pred,H,_S):- \+ is_ftCompound(H),!. % skip over it -map_unless(Test,Pred,(H,T),S):-!, apply(Pred,[H|S]), map_unless(Test,Pred,T,S). -map_unless(Test,Pred,[H|T],S):-!, apply(Pred,[H|S]), map_unless(Test,Pred,T,S). -map_unless(Test,Pred,H,S):-H=..List,!,map_unless(Test,Pred,List,S),!. +% # With Accumulator +% prolog +count_occurrences_acc(X, L, N) :- count_occurrences_acc(X, L, 0, N). -:- meta_predicate(map_first_arg(*,+)). -%% map_first_arg( +Pred, ?List) is semidet. +count_occurrences_acc(_, [], Acc, Acc). +count_occurrences_acc(X, [X|T], Acc, N) :- + NewAcc is Acc + 1, + count_occurrences_acc(X, T, NewAcc, N). +count_occurrences_acc(X, [Y|T], Acc, N) :- + X \= Y, + count_occurrences_acc(X, T, Acc, N). % -% PFC Maptree. -% -map_first_arg(CMPred,List):- strip_module(CMPred,CM,Pred), map_first_arg(CM,Pred,List,[]). -:- meta_predicate(map_first_arg(+,*,+,+)). -%% map_first_arg( +Pred, :TermH, ?S) is semidet. -% -% PFC Maptree. +% 11. Calculate the Greatest Common Divisor of Two Numbers +% # Normal Recursive +% prolog +gcd(A, 0, A) :- A > 0. +gcd(A, B, GCD) :- + B > 0, + R is A mod B, + gcd(B, R, GCD). % -map_first_arg(CM,Pred,H,S):-is_ftVar(H),!,CM:apply(Pred,[H|S]). -map_first_arg(_,_,[],_) :- !. -map_first_arg(CM,Pred,(H,T),S):-!, map_first_arg(CM,Pred,H,S), map_first_arg(CM,Pred,T,S). -map_first_arg(CM,Pred,(H;T),S):-!, map_first_arg(CM,Pred,H,S) ; map_first_arg(CM,Pred,T,S). -map_first_arg(CM,Pred,[H|T],S):-!, CM:apply(Pred,[H|S]), map_first_arg(CM,Pred,T,S). -map_first_arg(CM,Pred,H,S):- CM:apply(Pred,[H|S]). - -%:- fixup_exports. - -% % :- ensure_loaded(logicmoo(util/rec_lambda)). -%example pfcVerifyMissing(mpred_isa(I,D), mpred_isa(I,C), ((mpred_isa(I,C), {D==C});-mpred_isa(I,C))). -%example pfcVerifyMissing(mudColor(I,D), mudColor(I,C), ((mudColor(I,C), {D==C});-mudColor(I,C))). - - -%% pfcVerifyMissing( +GC, ?GO, ?GO) is semidet. +% # With Accumulator +% prolog +gcd_acc(A, B, GCD) :- gcd_acc(A, B, 1, GCD). + +gcd_acc(A, 0, Acc, Acc) :- A > 0. +gcd_acc(A, B, Acc, GCD) :- + B > 0, + R is A mod B, + NewAcc is B * Acc, + gcd_acc(B, R, NewAcc, GCD). % -% Prolog Forward Chaining Verify Missing. -% -pfcVerifyMissing(GC, GO, ((GO, {D==C});\+ GO) ):- GC=..[F,A|Args],append(Left,[D],Args),append(Left,[C],NewArgs),GO=..[F,A|NewArgs],!. - -%example mpred_freeLastArg(mpred_isa(I,C),~(mpred_isa(I,C))):-is_ftNonvar(C),!. -%example mpred_freeLastArg(mpred_isa(I,C),(mpred_isa(I,F),C\=F)):-!. -%% mpred_freeLastArg( +G, ?GG) is semidet. +% 12. Check if a Number is Prime +% # Normal Recursive +% prolog +is_prime(2). +is_prime(N) :- + N > 2, + \+ (between(2, sqrt(N), X), N mod X =:= 0). +% + +% # With Accumulator +% prolog +is_prime_acc(N) :- is_prime_acc(N, 2). + +is_prime_acc(2, 2). +is_prime_acc(N, Acc) :- + N > 2, + ( + (Acc * Acc > N, !); + (N mod Acc =\= 0, NewAcc is Acc + 1, is_prime_acc(N, NewAcc)) + ). +% + +% 13. Merge Two Sorted Lists into a Sorted List +% # Normal Recursive +% prolog +merge_sorted([], L, L). +merge_sorted(L, [], L). +merge_sorted([H1|T1], [H2|T2], [H1|M]) :- + H1 =< H2, + merge_sorted(T1, [H2|T2], M). +merge_sorted([H1|T1], [H2|T2], [H2|M]) :- + H1 > H2, + merge_sorted([H1|T1], T2, M). +% + +% # With Accumulator +% prolog +merge_sorted_acc(L1, L2, L) :- merge_sorted_acc(L1, L2, [], L). + +merge_sorted_acc([], L, Acc, L) :- reverse(Acc, L), !. +merge_sorted_acc(L, [], Acc, L) :- reverse(Acc, L), !. +merge_sorted_acc([H1|T1], [H2|T2], Acc, [H|M]) :- + H1 =< H2, + merge_sorted_acc(T1, [H2|T2], [H1|Acc], M). +merge_sorted_acc([H1|T1], [H2|T2], Acc, [H|M]) :- + H1 > H2, + merge_sorted_acc([H1|T1], T2, [H2|Acc], M). + +% + +% 14. Find the Last Element of a List +% # Normal Recursive +% prolog +last_element([H], H). +last_element([_|T], X) :- last_element(T, X). +% + +% # With Accumulator +% prolog +last_element_acc([H|T], X) :- last_element_acc(T, H, X). + +last_element_acc([], Acc, Acc). +last_element_acc([H|T], _, X) :- last_element_acc(T, H, X). +% + +% 15. Remove Duplicate Elements from a List +% # Normal Recursive +% prolog +remove_duplicates([], []). +remove_duplicates([H|T], [H|T1]) :- \+ member(H, T), remove_duplicates(T, T1). +remove_duplicates([_|T], T1) :- remove_duplicates(T, T1). +% + +% # With Accumulator +% prolog +remove_duplicates_acc(L, R) :- remove_duplicates_acc(L, [], R). + +remove_duplicates_acc([], Acc, Acc). +remove_duplicates_acc([H|T], Acc, R) :- + (member(H, Acc) -> remove_duplicates_acc(T, Acc, R); + remove_duplicates_acc(T, [H|Acc], R)). +% + +% 16. Check if a Binary Tree is Balanced +% # Normal Recursive +% prolog +is_balanced(null). +is_balanced(tree(L, _, R)) :- + height(L, Hl), + height(R, Hr), + D is Hl - Hr, + abs(D) =< 1, + is_balanced(L), + is_balanced(R). +% + +% # With Accumulator +% prolog +is_balanced_acc(T) :- is_balanced_acc(T, 0). + +is_balanced_acc(null, 0). +is_balanced_acc(tree(L, _, R), H) :- + is_balanced_acc(L, Hl), + is_balanced_acc(R, Hr), + D is Hl - Hr, + abs(D) =< 1, + H is max(Hl, Hr) + 1. +% + +% 17. Calculate the Height of a Binary Tree +% # Normal Recursive +% prolog +height(null, 0). +height(tree(L, _, R), H) :- + height(L, Hl), + height(R, Hr), + H is max(Hl, Hr) + 1. +% + +% # With Accumulator +% prolog +height_acc(T, H) :- height_acc(T, 0, H). + +height_acc(null, Acc, Acc). +height_acc(tree(L, _, R), Acc, H) :- + NewAcc is Acc + 1, + height_acc(L, NewAcc, Hl), + height_acc(R, NewAcc, Hr), + H is max(Hl, Hr). +% + +% 18. Search for an Element in a Binary Search Tree +% # Normal Recursive +% prolog +search_bst(tree(_, X, _), X). +search_bst(tree(L, Y, _), X) :- + X < Y, + search_bst(L, X). +search_bst(tree(_, Y, R), X) :- + X > Y, + search_bst(R, X). +% + +% # With Accumulator +% prolog +% The accumulator is not very useful here, as the search path is already determined by the BST property. +search_bst_acc(Tree, X) :- search_bst(Tree, X). +% + +% 19. Insert an Element into a Binary Search Tree +% # Normal Recursive +% prolog +insert_bst(null, X, tree(null, X, null)). +insert_bst(tree(L, Y, R), X, tree(L1, Y, R)) :- + X < Y, + insert_bst(L, X, L1). +insert_bst(tree(L, Y, R), X, tree(L, Y, R1)) :- + X > Y, + insert_bst(R, X, R1). +% + +% # With Accumulator +% prolog +% The accumulator is not very useful here, as the insertion path is already determined by the BST property. +insert_bst_acc(Tree, X, NewTree) :- insert_bst(Tree, X, NewTree). +% + +% 20. Delete an Element from a Binary Search Tree +% # Normal Recursive +% prolog +delete_bst(Tree, X, NewTree) :- + remove_bst(Tree, X, NewTree). + +remove_bst(tree(L, X, R), X, Merged) :- merge_trees(L, R, Merged), !. +remove_bst(tree(L, Y, R), X, tree(L1, Y, R)) :- + X < Y, + remove_bst(L, X, L1). +remove_bst(tree(L, Y, R), X, tree(L, Y, R1)) :- + X > Y, + remove_bst(R, X, R1). + +merge_trees(null, Tree, Tree). +merge_trees(Tree, null, Tree). +merge_trees(tree(L1, X, R1), tree(L2, Y, R2), tree(Merged, Y, R2)) :- + merge_trees(tree(L1, X, R1), L2, Merged). +% + +% # With Accumulator +% prolog +% The accumulator is not very useful here, as the deletion path is already determined by the BST property. +delete_bst_acc(Tree, X, NewTree) :- delete_bst(Tree, X, NewTree). +% + +% 21. Find the Lowest Common Ancestor in a Binary Search Tree +% # Normal Recursive +% prolog +lowest_common_ancestor(tree(_, Y, _), X, Z, Y) :- + X < Y, Z > Y; + X > Y, Z < Y. +lowest_common_ancestor(tree(L, Y, _), X, Z, LCA) :- + X < Y, Z < Y, + lowest_common_ancestor(L, X, Z, LCA). +lowest_common_ancestor(tree(_, Y, R), X, Z, LCA) :- + X > Y, Z > Y, + + + lowest_common_ancestor(R, X, Z, LCA). +% + +% # With Accumulator +% prolog +% The accumulator is not very useful here, as the search path is already determined by the BST property. +lowest_common_ancestor_acc(Tree, X, Z, LCA) :- lowest_common_ancestor(Tree, X, Z, LCA). +% + +% 22. Check if a Graph is Cyclic +% For graphs, it's better to represent them in a Prolog-friendly format, such as adjacency lists. I will use a representation where each node has a list of its neighbors. +% # Normal Recursive +% prolog +is_cyclic(Graph) :- + member(Vertex-_, Graph), + dfs(Vertex, Graph, [Vertex], _), !. + +dfs(Vertex, Graph, Visited, [Vertex|Visited]) :- + member(Vertex-Neighbors, Graph), + member(Neighbor, Neighbors), + member(Neighbor, Visited), !. +dfs(Vertex, Graph, Visited, FinalVisited) :- + member(Vertex-Neighbors, Graph), + member(Neighbor, Neighbors), + \+ member(Neighbor, Visited), + dfs(Neighbor, Graph, [Neighbor|Visited], FinalVisited). +% + +% # With Accumulator +% prolog +% Due to the way depth-first search works, a typical accumulator wouldn't be very effective. +% The visited list already acts like an accumulator. +is_cyclic_acc(Graph) :- is_cyclic(Graph). % -% PFC Free Last Argument. -% -mpred_freeLastArg(G,GG):- G=..[F,A|Args],append(Left,[_],Args),append(Left,[_],NewArgs),GG=..[F,A|NewArgs],!. -mpred_freeLastArg(_G,false). - -%% mpred_current_op_support( +VALUE1) is semidet. +% 23. Perform a Depth-First Search on a Graph +% # Normal Recursive +% prolog +dfs_graph(Vertex, Graph) :- dfs_vertex(Vertex, Graph, []). + +dfs_vertex(Vertex, _, Visited) :- member(Vertex, Visited), !. +dfs_vertex(Vertex, Graph, Visited) :- + write(Vertex), nl, + member(Vertex-Neighbors, Graph), + dfs_neighbors(Neighbors, Graph, [Vertex|Visited]). + +dfs_neighbors([], _, _). +dfs_neighbors([Neighbor|Neighbors], Graph, Visited) :- + dfs_vertex(Neighbor, Graph, Visited), + dfs_neighbors(Neighbors, Graph, Visited). +% + +% # With Accumulator +% prolog +% The visited list acts as an accumulator. +dfs_graph_acc(Vertex, Graph) :- dfs_graph(Vertex, Graph). +% + +% 24. Perform a Breadth-First Search on a Graph +% # Normal Recursive +% prolog +bfs_graph(Vertex, Graph) :- + bfs([Vertex], Graph, [Vertex]). + +bfs([], _, _). +bfs([Vertex|Vertices], Graph, Visited) :- + write(Vertex), nl, + member(Vertex-Neighbors, Graph), + filter_unvisited(Neighbors, Visited, NewNeighbors, NewVisited), + append(Vertices, NewNeighbors, NewVertices), + bfs(NewVertices, Graph, NewVisited). + +filter_unvisited([], Visited, [], Visited). +filter_unvisited([Neighbor|Neighbors], Visited, NewNeighbors, NewVisited) :- + (member(Neighbor, Visited) -> + filter_unvisited(Neighbors, Visited, NewNeighbors, NewVisited); + filter_unvisited(Neighbors, [Neighbor|Visited], NewNeighbors, [Neighbor|NewVisited]) + ). +% + +% # With Accumulator +% prolog +% The visited list acts as an accumulator. +bfs_graph_acc(Vertex, Graph) :- bfs_graph(Vertex, Graph). +% + +% 25. Check if a Graph is Connected +% # Normal Recursive +% prolog +is_connected(Graph) :- + Graph = [Vertex-_|_], + dfs_graph(Vertex, Graph), + \+ (member(OtherVertex-_, Graph), \+ member(OtherVertex, Visited)), !. +% + +% # With Accumulator +% prolog +% The visited list acts as an accumulator. +is_connected_acc(Graph) :- is_connected(Graph). +% + +% 26. Find the Shortest Path between Two Nodes in a Graph +% # Normal Recursive +% prolog +shortest_path(Start, End, Graph, Path) :- + shortest_path([Start], End, Graph, [Start], Path). + +shortest_path(_, End, _, Visited, ReversePath) :- + reverse(ReversePath, [End|_]), !. +shortest_path(Vertices, End, Graph, Visited, Path) :- + adjacent_unvisited(Vertices, Graph, Visited, Adjacent), + append(Visited, Adjacent, NewVisited), + append(Vertices, Adjacent, NewVertices), + shortest_path(NewVertices, End, Graph, NewVisited, Path). +% + +% # With Accumulator +% prolog +% The visited list and the list of vertices to explore act as accumulators. +shortest_path_acc(Start, End, Graph, Path) :- shortest_path(Start, End, Graph, Path). +% + +% 27. Check if a String is a Palindrome +% # Normal Recursive +% prolog +is_string_palindrome(Str) :- string_chars(Str, Chars), is_palindrome(Chars). % -% PFC Current Oper. Support. + +% # With Accumulator +% prolog +is_string_pal + +indrome_acc(Str) :- string_chars(Str, Chars), is_palindrome_acc(Chars, []). +% + +% 28. Compute the Edit Distance between Two Strings +% # Normal Recursive +% prolog +edit_distance([], [], 0). +edit_distance([_|T1], [], D) :- + edit_distance(T1, [], D1), + D is D1 + 1. +edit_distance([], [_|T2], D) :- + edit_distance([], T2, D1), + D is D1 + 1. +edit_distance([H1|T1], [H2|T2], D) :- + edit_distance(T1, T2, D1), + D is D1 + (H1 \= H2). % -mpred_current_op_support((p,p)):-!. - -%% pfcVersion( +VALUE1) is semidet. -% -% Prolog Forward Chaining Version. +% # With Accumulator +% prolog +edit_distance_acc(S1, S2, D) :- edit_distance_acc(S1, S2, 0, D). + +edit_distance_acc([], [], Acc, Acc). +edit_distance_acc([_|T1], [], Acc, D) :- NewAcc is Acc + 1, edit_distance_acc(T1, [], NewAcc, D). +edit_distance_acc([], [_|T2], Acc, D) :- NewAcc is Acc + 1, edit_distance_acc([], T2, NewAcc, D). +edit_distance_acc([H1|T1], [H2|T2], Acc, D) :- + NewAcc is Acc + (H1 \= H2), + edit_distance_acc(T1, T2, NewAcc, D). +% + +% 29. Find the Longest Common Subsequence of Two Strings +% # Normal Recursive +% prolog +lcs([], _, []). +lcs(_, [], []). +lcs([H|T1], [H|T2], [H|Lcs]) :- lcs(T1, T2, Lcs), !. +lcs(S1, [_|T2], Lcs) :- lcs(S1, T2, Lcs). +lcs([_|T1], S2, Lcs) :- lcs(T1, S2, Lcs). % -%pfcVersion(6.6). +% # With Accumulator +% prolog +lcs_acc(S1, S2, Lcs) :- lcs_acc(S1, S2, [], Lcs). -% % :- '$set_source_module'(mpred_kb_ops). - -%% correctify_support( +S, ?S) is semidet. -% -% Correctify Support. +lcs_acc([], _, Acc, Lcs) :- reverse(Acc, Lcs). +lcs_acc(_, [], Acc, Lcs) :- reverse(Acc, Lcs). +lcs_acc([H|T1], [H|T2], Acc, Lcs) :- lcs_acc(T1, T2, [H|Acc], Lcs). +lcs_acc(S1, [_|T2], Acc, Lcs) :- lcs_acc(S1, T2, Acc, Lcs). +lcs_acc([_|T1], S2, Acc, Lcs) :- lcs_acc(T1, S2, Acc, Lcs). % -correctify_support(U,(U,ax)):-var(U),!. -correctify_support((U,U),(U,ax)):-!. -correctify_support((S,T),(S,T)):-!. -correctify_support((U,_UU),(U,ax)):-!. -correctify_support([U],S):-correctify_support(U,S). -correctify_support(U,(U,ax)). +% 30. Find the Longest Common Substring of Two Strings +% # Normal Recursive +% prolog +longest_common_substring(S1, S2, Lcs) :- + findall(Sub, (substring(S1, Sub), substring(S2, Sub)), Subs), + longest_string(Subs, Lcs). -%% clause_asserted_local( :TermABOX) is semidet. -% -% Clause Asserted Local. -% -clause_asserted_local(MCL):- - strip_mz(MCL,MZ,CL), - must(CL='$spft'(MZ,P,Fact,Trigger )),!, - clause_u('$spft'(MZ,P,Fact,Trigger),true,Ref), - clause_u('$spft'(MZ,UP,UFact,UTrigger),true,Ref), - (((UP=@=P,UFact=@=Fact,UTrigger=@=Trigger))). - +substring(Str, Sub) :- + append(_, Rest, Str), + append(Sub, _, Rest). +longest_string([H|T], Longest) :- + longest_string(T, H, Longest). + +longest_string([], Acc, Acc). +longest_string([H|T], Acc, Longest) :- + length(H, LenH), + length(Acc, LenAcc), + (LenH > LenAcc -> longest_string(T, H, Longest); longest_string(T, Acc, Longest)). +% + +% # With Accumulator +% prolog +longest_common_substring_acc(S1, S2, Lcs) :- + findall(Sub, (substring(S1, Sub), substring(S2, Sub)), Subs), + longest_string_acc(Subs, [], Lcs). -%% is_already_supported( +P, ?S, ?UU) is semidet. -% -% If Is A Already Supported. +longest_string_acc([], Acc, Acc). +longest_string_acc([H|T], Acc, Longest) :- + length(H, LenH), + length(Acc, LenAcc), + (LenH > LenAcc -> longest_string_acc(T, H, Longest); longest_string_acc(T, Acc, Longest)). % -is_already_supported(P,(S,T),(S,T)):- clause_asserted_local('$spft'(_MZ,P,S,T)),!. -is_already_supported(P,_S,UU):- clause_asserted_local('$spft'(_MZ,P,US,UT)),must(get_source_uu(UU)),UU=(US,UT). - -% TOO UNSAFE -% is_already_supported(P,_S):- copy_term_and_varnames(P,PC),sp ftY(PC,_,_),P=@=PC,!. - - -if_missing1(Q):- mpred_literal_nv(Q), call_u( \+ ~ Q), if_missing_mask(Q,R,Test),!, lookup_u(R), Test. - - -mpred_run_pause:- asserta(t_l:mpred_run_paused). -mpred_run_resume:- retractall(t_l:mpred_run_paused). - -fwithout_running(G):- (t_l:mpred_run_paused->G;locally_tl(mpred_run_pause,G)). diff --git a/metta_vspace/pyswip/metta_eval.pl b/metta_vspace/pyswip/metta_eval.pl index f7fb0657..f46d369e 100755 --- a/metta_vspace/pyswip/metta_eval.pl +++ b/metta_vspace/pyswip/metta_eval.pl @@ -1,6 +1,6 @@ % % post match modew -%:- style_check(-singleton:- ensure_loaded(swi_support). +%:- style_check(-singleton). self_eval0(X):- \+ callable(X),!. self_eval0(X):- is_valid_nb_state(X),!. @@ -16,22 +16,13 @@ self_eval0('Empty'). self_eval0(X):- atom(X),!, \+ nb_current(X,_),!. -coerce(Type,Value,Result):- nonvar(Value),Value=[Echo|EValue], Echo == echo, EValue = [RValue],!,coerce(Type,RValue,Result). -coerce(Type,Value,Result):- var(Type), !, Value=Result, freeze(Type,coerce(Type,Value,Result)). -coerce('Atom',Value,Result):- !, Value=Result. -coerce('Bool',Value,Result):- var(Value), !, Value=Result, freeze(Value,coerce('Bool',Value,Result)). -coerce('Bool',Value,Result):- is_list(Value),!,as_tf(call_true(Value),Result), -set_list_value(Value,Result). - -set_list_value(Value,Result):- nb_setarg(1,Value,echo),nb_setarg(1,Value,[Result]). - is_self_eval_l_fa('S',1). % eval_20(Eq,RetType,Depth,Self,['quote',Eval],RetVal):- !, Eval = RetVal, check_returnval(Eq,RetType,RetVal). is_self_eval_l_fa('quote',_). is_self_eval_l_fa('{...}',_). is_self_eval_l_fa('[...]',_). -self_eval(X):- notrace(self_eval0(X)). +self_eval(X):- fake_notrace(self_eval0(X)). :- set_prolog_flag(access_level,system). hyde(F/A):- functor(P,F,A), redefine_system_predicate(P),'$hide'(F/A), '$iso'(F/A). @@ -68,8 +59,7 @@ 'get_type'(Arg,Type):- 'get-type'(Arg,Type). -eval_true(X):- compound(X), !, call(X). -eval_true(X):- eval_args(X,Y), once(var(Y) ; \+ is_False(Y)). + eval_args(X,Y):- current_self(Self), eval_args(100,Self,X,Y). eval_args(Depth,Self,X,Y):- eval_args('=',_,Depth,Self,X,Y). @@ -85,7 +75,7 @@ %eval(Eq,RetType,Depth,_Self,X,_Y):- forall(between(6,Depth,_),write(' ')),writeqln(eval(Eq,RetType,X)),fail. eval(Depth,Self,X,Y):- eval('=',_RetType,Depth,Self,X,Y). -%eval(_Eq,_RetType,_Dpth,_Slf,X,Y):- var(X),nonvar(Y),!,X=Y. +eval(Eq,RetType,_Dpth,_Slf,X,Y):- var(X),nonvar(Y),!,X=Y. eval(_Eq,_RetType,_Dpth,_Slf,X,Y):- notrace(self_eval(X)),!,Y=X. eval(Eq,RetType,Depth,Self,X,Y):- notrace(nonvar(Y)), var(RetType), get_type(Depth,Self,Y,RetType), !, @@ -131,11 +121,10 @@ :- nodebug(metta(eval)). -w_indent(Depth,Goal):- \+ \+ notrace( - ignore((( +w_indent(Depth,Goal):- + \+ \+ fake_notrace(ignore((( format('~N'), setup_call_cleanup(forall(between(Depth,101,_),write(' ')),Goal, format('~N')))))). - indentq(Depth,Term):- \+ \+ fake_notrace(ignore((( format('~N'), @@ -204,6 +193,7 @@ Y=YO))). + eval_11(_Eq,_RetType,_Dpth,_Slf,X,Y):- self_eval(X),!,Y=X. eval_11(Eq,RetType,Depth,Self,X,Y):- fail, \+ is_debugging((eval)),!, D1 is Depth-1, @@ -237,9 +227,11 @@ -% eval_15(Eq,RetType,Depth,Self,X,Y):- !, eval_20(Eq,RetType,Depth,Self,X,Y). +eval_15(Eq,RetType,Depth,Self,X,Y):- !, + eval_20(Eq,RetType,Depth,Self,X,Y). -eval_15(Eq,RetType,Depth,Self,X,Y):- ((eval_20(Eq,RetType,Depth,Self,X,Y), +eval_15(Eq,RetType,Depth,Self,X,Y):- + ((eval_20(Eq,RetType,Depth,Self,X,Y), if_t(var(Y),fbug((eval_20(Eq,RetType,Depth,Self,X,Y),var(Y)))), nonvar(Y))*->true;(eval_failed(Depth,Self,X,Y),fail)). @@ -256,8 +248,10 @@ %:- discontiguous eval_31/5. %:- discontiguous eval_60/5. -eval_20(Eq,RetType,_Dpth,_Slf,Name,Y):- atom(Name), !, - (nb_current(Name,X)->do_expander(Eq,RetType,X,Y); Y = Name). +eval_20(Eq,RetType,_Dpth,_Slf,Name,Y):- + atom(Name), !, + (nb_current(Name,X)->do_expander(Eq,RetType,X,Y); + Y = Name). eval_20(Eq,RetType,_Dpth,_Slf,X,Y):- self_eval(X),!,do_expander(Eq,RetType,X,Y). @@ -288,8 +282,6 @@ eval_20(Eq,_RetType,Depth,Self,[V|VI],[V|VO]):- var(V),is_list(VI),!,maplist(eval(Eq,_ArgRetType,Depth,Self),VI,VO). -eval_20(_,_,_,_,['echo',Value],Value):- !. -eval_20(=,Type,_,_,['coerce',Type,Value],Result):- !, coerce(Type,Value,Result). % ================================================================= % ================================================================= @@ -396,7 +388,7 @@ %s_empty(X):- var(X),!. s_empty(X):- var(X),!,fail. is_empty('Empty'). -is_empty([]). % +is_empty([]). is_empty([X]):-!,is_empty(X). has_let_star(Y):- sub_var('let*',Y). @@ -407,7 +399,6 @@ equal_enouf(R,V):- is_ftVar(R), is_ftVar(V), R=V,!. equal_enouf(X,Y):- is_empty(X),!,is_empty(Y). -equal_enouf(X,Y):- symbol(X),symbol(Y),atom_concat('&',_,X),atom_concat('Grounding',_,Y). equal_enouf(R,V):- R=@=V, R=V, !. equal_enouf(_,V):- V=@='...',!. equal_enouf(L,C):- is_list(L),into_list_args(C,CC),!,equal_enouf_l(CC,L). @@ -605,6 +596,9 @@ nb_setarg(1,Do_more_defs,false), (DET==true -> ! ; true). +eval_21(_Eq,_RetType,_Depth,_Self,['fb-member',Res,List],TF):-!, as_tf(fb_member(Res,List),TF). +eval_21(_Eq,_RetType,_Depth,_Self,['fb-member',List],Res):-!, fb_member(Res,List). + eval_21(Eq,RetType,Depth,Self,['CollapseCardinality',List],Len):-!, bagof_eval(Eq,RetType,Depth,Self,List,Res), @@ -613,10 +607,12 @@ eval_21(_Eq,_RetType,_Depth,_Self,['TupleCount', [N]],N):- number(N),!. +*/ eval_21(Eq,RetType,Depth,Self,['TupleCount',List],Len):-!, bagof_eval(Eq,RetType,Depth,Self,List,Res), length(Res,Len). -*/ +eval_21(_Eq,_RetType,_Depth,_Self,['tuple-count',List],Len):-!, + length(List,Len). %[superpose,[1,2,3]] eval_20(Eq,RetType,Depth,Self,['superpose',List],Res):- !, @@ -1263,30 +1259,6 @@ is_system_pred(S):- atom(S),atom_concat(_,'-fn',S). is_system_pred(S):- atom(S),atom_concat(_,'-p',S). -% eval_80/6: Evaluates a Python function call within MeTTa. -% Parameters: -% - Eq: denotes get-type, match, or interpret call. -% - RetType: Expected return type of the MeTTa function. -% - Depth: Recursion depth or complexity control. -% - Self: Context or environment for the evaluation. -% - [MyFun|More]: List with MeTTa function and additional arguments. -% - RetVal: Variable to store the result of the Python function call. -eval_80(Eq, RetType, Depth, Self, [MyFun|More], RetVal) :- - % MyFun as a registered Python function with its module and function name. - metta_atom(Self, ['registered-python-function', PyModule, PyFun, MyFun]), - % Tries to fetch the type definition for MyFun, ignoring failures. - (( get_operator_typedef(Self, MyFun, Params, RetType), - try_adjust_arg_types(RetType, Depth, Self, [RetType|Params], [RetVal|More], [MVal|Adjusted]) - )->true; (maplist(as_prolog, More , Adjusted), MVal=RetVal)), - % Constructs a compound term for the Python function call with adjusted arguments. - compound_name_arguments(Call, PyFun, Adjusted), - % Optionally prints a debug tree of the Python call if tracing is enabled. - if_trace(host;python, print_tree(py_call(PyModule:Call, RetVal))), - % Executes the Python function call and captures the result in MVal which propagates to RetVal. - py_call(PyModule:Call, MVal), - % Checks the return value against the expected type and criteria. - check_returnval(Eq, RetType, RetVal). - %eval_80(_Eq,_RetType,_Dpth,_Slf,LESS,Res):- fake_notrace((once((eval_selfless(LESS,Res),fake_notrace(LESS\==Res))))),!. @@ -1300,8 +1272,7 @@ current_predicate(Pred/Len), %fake_notrace( \+ is_user_defined_goal(Self,[AE|More])),!, %adjust_args(Depth,Self,AE,More,Adjusted), - maplist(as_prolog, More , Adjusted), - if_trace(host;prolog,print_tree(apply(Pred,Adjusted))), + More = Adjusted, catch_warn(efbug(show_call,eval_call(apply(Pred,Adjusted),TF))), check_returnval(Eq,RetType,TF). @@ -1353,11 +1324,10 @@ \+ (atom(AE), atom_concat(_,'-p',AE)), %fake_notrace( \+ is_user_defined_goal(Self,[AE|More])),!, %adjust_args(Depth,Self,AE,More,Adjusted),!, + More = Adjusted, Len1 is Len+1, current_predicate(Pred/Len1), - maplist(as_prolog,More,Adjusted), - append(Adjusted,[Res],Args),!, - if_trace(host;prolog,print_tree(apply(Pred,Args))), + append(Adjusted,[Res],Args),!, efbug(show_call,catch_warn(apply(Pred,Args))), check_returnval(Eq,RetType,Res). @@ -1403,19 +1373,11 @@ eval_selfless(E,R):- eval_selfless_0(E,R). - -eval_selfless_0a(F,X,Y,TF):- X=Y,!, TF='True'. -eval_selfless_0a(F,X,Y,TF):- var(X),!,as_tf(X=Y,TF). -eval_selfless_0a(F,X,Y,TF):- var(Y),!,as_tf(X=Y,TF). -eval_selfless_0a(F,X,Y,TF):- - notrace(args_to_mathlib([X,Y],Lib)),!, eval_selfless3(Lib,['=',X,Y],TF). - - -eval_selfless_0([F,X,XY],TF):- is_assignment(F), !, eval_selfless_0a(F,X,XY,TF). - eval_selfless_0([F|XY],TF):- eval_selfless_1([F|XY],TF),!. +eval_selfless_0([F,X,XY],TF):- is_assignment(F), fake_notrace(args_to_mathlib([X,XY],Lib)),!,eval_selfless3(Lib,['=',X,XY],TF). +eval_selfless_0([F|XY],TF):- eval_selfless_1([F|XY],TF),!. eval_selfless_0(E,R):- eval_selfless_2(E,R). -eval_selfless_1([F|XY],TF):- \+ ground(XY),!,notrace(args_to_mathlib(XY,Lib)),!,eval_selfless3(Lib,[F|XY],TF). +eval_selfless_1([F|XY],TF):- \+ ground(XY),!,fake_notrace(args_to_mathlib(XY,Lib)),!,eval_selfless3(Lib,[F|XY],TF). eval_selfless_1(['>',X,Y],TF):-!,as_tf(X>Y,TF). eval_selfless_1(['<',X,Y],TF):-!,as_tf(X',X,Y],TF):-!,as_tf(X>=Y,TF). @@ -1423,43 +1385,41 @@ eval_selfless_1(['\\=',X,Y],TF):-!,as_tf(dif(X,Y),TF). eval_selfless_2(['%',X,Y],TF):-!,eval_selfless_2(['mod',X,Y],TF). -eval_selfless_2(LIS,Y):- notrace(( ground(LIS), +eval_selfless_2(LIS,Y):- fake_notrace(( ground(LIS), LIS=[F,_,_], atom(F), catch_warn(current_op(_,yfx,F)), - LIS\=[_], s2ps(LIS,IS))), notrace(catch((Y is IS),_,fail)),!. + LIS\=[_], s2ps(LIS,IS))), fake_notrace(catch((Y is IS),_,fail)),!. eval_selfless3(Lib,FArgs,TF):- maplist(s2ps,FArgs,Next),!,compare_selfless0(Lib,Next,TF). - +:- use_module(library(clpfd)). :- clpq:use_module(library(clpq)). :- clpr:use_module(library(clpr)). -:- use_module(library(clpfd)). compare_selfless0(_,[F|_],_TF):- \+ atom(F),!,fail. -compare_selfless0(LIB,[SharpF,X,Y],TF):- atom_concat('#',F,SharpF),!, - compare_selfless1(LIB,[F,X,Y],TF). -compare_selfless0(Lib,[F|Stuff],TF):- compare_selfless1(Lib,[F|Stuff],TF). - -compare_selfless1(LIB,['=>',X,Y],TF):-!,compare_selfless2(LIB,['>=',X,Y],TF). -compare_selfless1(LIB,['<=',X,Y],TF):-!,compare_selfless2(LIB,['=<',X,Y],TF). -compare_selfless1(Lib,[F|Stuff],TF):- compare_selfless2(Lib,[F|Stuff],TF). - -compare_selfless2(cplfd,[F|Stuff],TF):- !,atom_concat('#',F,SharpF), - P=..[SharpF|Stuff],!,as_tf(P,TF). -compare_selfless2(Lib,[F|Stuff],TF):- Lib\==clpfd, P=..[F|Stuff],!,as_tf(Lib:{P},TF). - -sub_ele(E,Args):- is_list(Args),!, member(ST,Args),sub_ele(E,ST). -sub_ele(A,A). -sub_ele(E,Args):- compound(Args),arg(_,Args,ST),sub_ele(E,ST). - -args_to_mathlib(XY,Lib):- sub_ele(T,XY), var(T),get_attrs(T,XX),get_attrlib(XX,Lib),!. -args_to_mathlib(XY,clpr):- once((sub_ele(T,XY), float(T))),!. % Reals -args_to_mathlib(XY,clpq):- once((sub_ele(Rat,XY),compound(Rat),Rat='/'(_,_))). +compare_selfless0(cplfd,['=',X,Y],TF):-!,as_tf(X#=Y,TF). +compare_selfless0(cplfd,['\\=',X,Y],TF):-!,as_tf(X #\=Y,TF). +compare_selfless0(cplfd,['>',X,Y],TF):-!,as_tf(X#>Y,TF). +compare_selfless0(cplfd,['<',X,Y],TF):-!,as_tf(X#',X,Y],TF):-!,as_tf(X#>=Y,TF). +compare_selfless0(cplfd,['<=',X,Y],TF):-!,as_tf(X#=',X,Y],TF):-!,as_tf(Lib:{X>Y},TF). +compare_selfless0(Lib,['<',X,Y],TF):-!,as_tf(Lib:{X',X,Y],TF):-!,as_tf(Lib:{X>=Y},TF). +compare_selfless0(Lib,['<=',X,Y],TF):-!,as_tf(Lib:{X=true;current_output(Out),asserta(original_user_output(Out)). -unnullify_output:- original_user_output(MFS), set_prolog_IO(user_input,MFS,MFS). - -null_output(MFS):- use_module(library(memfile)), new_memory_file(MF),open_memory_file(MF,append,MFS). -:- dynamic(null_user_output/1). -:- null_user_output(_)->true;(null_output(MFS),asserta(null_user_output(MFS))). -nullify_output:- null_user_output(MFS), set_prolog_IO(user_input,MFS,MFS). - -set_output_stream :- is_mettalog, !. -set_output_stream :- is_compatio -> nullify_output; unnullify_output. -%:- nullify_output. -:- set_output_stream. - -do_show_os_argv:- is_compatio,!. -do_show_os_argv:- current_prolog_flag(os_argv,ArgV),write('; libswipl: '),writeln(ArgV). +show_os_argv:- is_compatio,!. +show_os_argv:- current_prolog_flag(os_argv,ArgV),write('; libswipl: '),writeln(ArgV). is_pyswip:- current_prolog_flag(os_argv,ArgV),member( './',ArgV). :- multifile(is_metta_data_functor/1). :- dynamic(is_metta_data_functor/1). @@ -65,14 +36,21 @@ :- dynamic(is_nb_space/1). %:- '$set_source_module'('user'). :- use_module(library(filesex)). -:- use_module(library(system)). :- use_module(library(shell)). %:- use_module(library(tabling)). - +:- use_module(library(system)). +:- ensure_loaded(metta_compiler). +:- ensure_loaded(metta_printer). +:- ensure_loaded(metta_convert). +%:- ensure_loaded(metta_types). +:- ensure_loaded(metta_data). +:- ensure_loaded(metta_space). +:- ensure_loaded(metta_eval). :- nb_setval(self_space, '&self'). current_self(Self):- ((nb_current(self_space,Self),Self\==[])->true;Self='&self'). :- nb_setval(repl_mode, '+'). +%:- set_stream(user_input,tty(true)). %:- set_stream(user_input,tty(true)). :- use_module(library(readline)). %:- use_module(library(editline)). @@ -80,16 +58,6 @@ :- set_prolog_flag(encoding,utf8). %:- set_output(user_error). %:- set_prolog_flag(encoding,octet). - - -:- ensure_loaded(swi_support). -:- ensure_loaded(metta_printer). -:- ensure_loaded(metta_utils). -:- ensure_loaded(flybase_main). - -:- ensure_loaded(library(logicmoo_utils)). - - /* Now PASSING NARS.TEC:\opt\logicmoo_workspace\packs_sys\logicmoo_opencog\MeTTa\vspace-metta\metta_vspace\pyswip\metta_interp.pl C:\opt\logicmoo_workspace\packs_sys\logicmoo_opencog\MeTTa\vspace-metta\metta_vspace\pyswip1\metta_interp.pl @@ -117,64 +85,44 @@ %option_value_def('repl',auto). option_value_def('prolog',false). option_value_def('compat',auto). -option_value_def('compatio',true). -%option_value_def('compatio',false). -%option_value_def('compile',false). -%option_value_def('compile',true). -option_value_def('compile',full). -option_value_def('tabling',true). -option_value_def('optimize',true). +option_value_def('compatio',auto). +option_value_def('compile',false). +option_value_def('table',false). option_value_def(no_repeats,false). option_value_def('time',true). +option_value_def('exec',true). option_value_def('test',false). option_value_def('html',false). option_value_def('python',false). %option_value_def('halt',false). option_value_def('doing_repl',false). option_value_def('test-retval',false). -option_value_def('exeout','./Sav.gitlab.MeTTaLog'). +option_value_def('trace-length',100). +option_value_def('stack-max',100). +option_value_def('trace-on-overtime',20.0). +option_value_def('trace-on-overflow',false). +option_value_def('exeout','./Sav.godlike.MeTTaLog'). -option_value_def('trace-length',10_000). -option_value_def('stack-max',10_000). -option_value_def('trace-on-overtime',20.0). -option_value_def('trace-on-overflow',false). option_value_def('trace-on-error',true). +%option_value_def('trace-on-load',true). +option_value_def('load',debug). +option_value_def('trace-on-exec',true). +option_value_def('trace-on-eval',true). option_value_def('trace-on-fail',false). option_value_def('trace-on-pass',false). -option_value_def('trace-on-exec',false). -option_value_def('exec',true). % vs skip - -option_value_def('trace-on-load',true). -option_value_def('load',show). - -option_value_def('trace-on-eval',false). -option_value_def('eval',silent). - -option_value_def('transpiler',silent). -option_value_def('result',show). - - - - -fbugio(_,_):- is_compatio,!. -fbugio(TF,P):-!, ignore(( TF,!,fbug(P))). -fbugio(IO):-fbugio(true,IO). - -different_from(N,V):- \+ \+ option_value_def(N,V),!,fail. -different_from(N,V):- \+ \+ nb_current(N,V),!,fail. -different_from(_,_). +fbugio(_):- is_compatio,!. +fbugio(P):- fbug(P). set_option_value_interp(N,V):- atom(N), atomic_list_concat(List,',',N),List\=[_],!, forall(member(E,List),set_option_value_interp(E,V)). - set_option_value_interp(N,V):- - (different_from(N,V)->Note=true;Note=false), - fbugio(Note,set_option_value(N,V)),set_option_value(N,V), - ignore((if_t((atom(N), atom_concat('trace-on-',F,N),fbugio(Note,set_debug(F,V))),set_debug(F,V)))), - ignore((if_t((atom(V), is_debug_like(V,TF),fbugio(Note,set_debug(N,TF))),set_debug(N,TF)))),!. + set_option_value(N,V), + fbugio(set_option_value(N,V)), + ignore((if_t((atom(N), atom_concat('trace-on-',F,N),fbugio(set_debug(F,V))),set_debug(F,V)))), + ignore((if_t((atom(V), is_debug_like(V,TF),fbugio(set_debug(N,TF))),set_debug(N,TF)))),!. is_debug_like(trace, true). is_debug_like(notrace, false). @@ -192,33 +140,30 @@ %set_option_value_interp('trace-on-load',TF), set_option_value_interp('trace-on-exec',TF), set_option_value_interp('trace-on-eval',TF), - if_t( \+ TF , set_prolog_flag(debug_on_interrupt,true)), + !. -%fake_notrace(G):- tracing,!,notrace(G). -%fake_notrace(G):- !,once(G). +fake_notrace(G):- tracing,!,notrace(G). +fake_notrace(G):- !,once(G). fake_notrace(G):- quietly(G),!. - real_notrace(G):- notrace(G). -user_io(G):- original_user_output(Out), - current_output(COut), - setup_call_cleanup(set_prolog_IO(user_input,Out,user_error), G, set_prolog_IO(user_input,COut,user_error)), - set_prolog_IO(user_input,COut,user_error). -if_compatio(G):- if_t(is_compatio,user_io(G)). -not_compatio(G):- if_t( \+ is_compatio, G). +if_compat_io(G):- if_t(is_compatio,G). +not_compat_io(G):- if_t( \+ is_compatio, G). + -:- if_compatio(writeln("Hello")). +:- set_is_unit_test(false). trace_on_fail:- option_value('trace-on-fail',true). trace_on_overflow:- option_value('trace-on-overflow',true). trace_on_pass:- option_value('trace-on-pass',true). doing_repl:- option_value('doing_repl',true). if_repl(Goal):- doing_repl->call(Goal);true. -any_floats(S):- member(E,S),float(E),!. -:- prolog_load_context(source,File), assert(interpreter_source_file(File)). +show_options_values:- + forall((nb_current(N,V), \+((atom(N),atom_concat('$',_,N)))),write_src_nl(['pragma!',N,V])). + +any_floats(S):- member(E,S),float(E),!. - % ============================ % %%%% Arithmetic Operations % ============================ @@ -273,7 +218,7 @@ % Actual: The value that is being checked against the Expected value. % Result: The result of the evaluation of the equality. % Example: `assertEqual(5, 5, Result).` would succeed, setting Result to true (or some success indicator). -%'assertEqual'(Expected, Actual, Result):- is_transpiling,!,as_tf((Expected=Actual),Result). +%'assertEqual'(Expected, Actual, Result):- use_metta_compiler,!,as_tf((Expected=Actual),Result). 'assertEqual'(Expected, Actual, Result):- ignore(Expected=Actual), eval_H(['assertEqual', Expected, Actual], Result). % `assertEqualToResult` Predicate @@ -353,31 +298,16 @@ 'get-type'(Value, Type):- eval_H(['get-type', Value], Type). -metta_argv(Args):- current_prolog_flag(metta_argv, Args),!. -metta_argv(Before):- current_prolog_flag(os_argv,OSArgv), append(_,['--args'|AArgs],OSArgv), - before_arfer_dash_dash(AArgs,Before,_),!,set_metta_argv(Before). -argv_metta(Nth,Value):- metta_argv(Args),nth1(Nth,Args,Value). - -set_metta_argv(Before):- maplist(read_argv,Before,Args),set_prolog_flag(metta_argv, Args),!. -read_argv(AArg,Arg):- \+ atom(AArg),!,AArg=Arg. -read_argv(AArg,Arg):- atom_string(AArg,S),read_metta(S,Arg),!. - metta_cmd_args(Rest):- current_prolog_flag(late_metta_opts,Rest),!. -metta_cmd_args(Rest):- current_prolog_flag(os_argv,P),append(_,['--'|Rest],P),!. metta_cmd_args(Rest):- current_prolog_flag(argv,P),append(_,['--'|Rest],P),!. +metta_cmd_args(Rest):- current_prolog_flag(os_argv,P),append(_,['--'|Rest],P),!. metta_cmd_args(Rest):- current_prolog_flag(argv,Rest). - -:- dynamic(has_run_cmd_args/0). -:- volatile(has_run_cmd_args/0). -run_cmd_args_prescan:- has_run_cmd_args, !. -run_cmd_args_prescan:- assert(has_run_cmd_args), do_cmdline_load_metta(prescan). - -run_cmd_args:- do_cmdline_load_metta(execute). +run_cmd_args:- metta_cmd_args(Rest), !, do_cmdline_load_metta('&self',Rest). metta_make_hook:- loonit_reset, option_value(not_a_reload,true),!. metta_make_hook:- - metta_cmd_args(Rest), into_reload_options(Rest,Reload), do_cmdline_load_metta(reload,'&self',Reload). + metta_cmd_args(Rest), into_reload_options(Rest,Reload), cmdline_load_metta('&self',Reload). :- multifile(prolog:make_hook/2). :- dynamic(prolog:make_hook/2). @@ -411,77 +341,52 @@ %process_late_opts:- halt(7). process_late_opts. - -do_cmdline_load_metta(Phase):- metta_cmd_args(Rest), !, do_cmdline_load_metta(Phase,'&self',Rest). - -%do_cmdline_load_metta(Phase,_Slf,Rest):- select('--prolog',Rest,RRest),!, +%do_cmdline_load_metta(_Slf,Rest):- select('--prolog',Rest,RRest),!, % set_option_value_interp('prolog',true), % set_prolog_flag(late_metta_opts,RRest). -do_cmdline_load_metta(Phase,Self,Rest):- +do_cmdline_load_metta(Self,Rest):- set_prolog_flag(late_metta_opts,Rest), forall(process_option_value_def,true), - cmdline_load_metta(Phase,Self,Rest),!, + cmdline_load_metta(Self,Rest),!, forall(process_late_opts,true). load_metta_file(Self,Filemask):- atom_concat(_,'.metta',Filemask),!, load_metta(Self,Filemask). load_metta_file(_Slf,Filemask):- load_flybase(Filemask). catch_abort(From,Goal):- - catch_abort(From,Goal,Goal). + catch_abort(From,Goal,Goal). catch_abort(From,TermV,Goal):- - catch(Goal,'$aborted',fbug(aborted(From,TermV))). + catch(Goal,'$aborted',fbug(aborted(From,TermV))). % done +cmdline_load_metta(_,Nil):- Nil==[],!. -before_arfer_dash_dash(Rest,Args,NewRest):- - append(Args,['--'|NewRest],Rest)->true;([]=NewRest,Args=Rest). - -cmdline_load_metta(_,_,Nil):- Nil==[],!. +cmdline_load_metta(Self,['--repl'|Rest]):- !, repl,cmdline_load_metta(Self,Rest). +cmdline_load_metta(Self,[Filemask|Rest]):- atom(Filemask), \+ atom_concat('-',_,Filemask), + Src=user:load_metta_file(Self,Filemask), + catch_abort(Src, + (must_det_ll((nl,write('; '),write_src(Src),nl,catch_red(Src),!,flush_output)))), + cmdline_load_metta(Self,Rest). -cmdline_load_metta(Phase,Self,['--'|Rest]):- !, - cmdline_load_metta(Phase,Self,Rest). +cmdline_load_metta(Self,['-g',M|Rest]):- + catch_abort(['-g',M],((read_term_from_atom(M, Term, []),ignore(call(Term))))), + cmdline_load_metta(Self,Rest). -cmdline_load_metta(Phase,Self,['--args'|Rest]):- !, - before_arfer_dash_dash(Rest,Before,NewRest),!, - set_metta_argv(Before), - cmdline_load_metta(Phase,Self,NewRest). - -cmdline_load_metta(Phase,Self,['--repl'|Rest]):- !, - if_phase(Phase,execute,repl), - cmdline_load_metta(Phase,Self,Rest). -cmdline_load_metta(Phase,Self,[Filemask|Rest]):- atom(Filemask), \+ atom_concat('-',_,Filemask), - if_phase(Phase,execute,cmdline_load_file(Self,Filemask)), - cmdline_load_metta(Phase,Self,Rest). - -cmdline_load_metta(Phase,Self,['-g',M|Rest]):- !, - if_phase(Phase,execute,catch_abort(['-g',M],((read_term_from_atom(M, Term, []),ignore(call(Term)))))), - cmdline_load_metta(Phase,Self,Rest). - -cmdline_load_metta(Phase,Self,['-G',Str|Rest]):- !, +cmdline_load_metta(Self,['-G',Str|Rest]):- !, current_self(Self), - if_phase(Phase,execute,catch_abort(['-G',Str],ignore(call_sexpr('!',Self,Str,_S,_Out)))), - cmdline_load_metta(Phase,Self,Rest). - -cmdline_load_metta(Phase,Self,[M|Rest]):- - m_opt(M,Opt), - is_cmd_option(Opt,M,TF), - fbug(is_cmd_option(Phase,Opt,M,TF)), - set_option_value_interp(Opt,TF), !, - %set_tty_color_term(true), - cmdline_load_metta(Phase,Self,Rest). - -cmdline_load_metta(Phase,Self,[M|Rest]):- - 'format'('~N'), fbug(unused_cmdline_option(Phase,M)), !, - cmdline_load_metta(Phase,Self,Rest). - - -cmdline_load_file(Self,Filemask):- - Src=user:load_metta_file(Self,Filemask), - catch_abort(Src, - (must_det_ll(( - not_compatio((nl,write('; '),write_src(Src),nl)), - catch_red(Src),!,flush_output)))),!. - -if_phase(Current,Phase,Goal):- ignore((sub_var(Current,Phase),!, Goal)). + catch_abort(['-G',Str],ignore(call_sexpr('!',Self,Str,_S,_Out))), + cmdline_load_metta(Self,Rest). + +cmdline_load_metta(Self,[M|Rest]):- + m_opt(M,Opt),!, + is_cmd_option(Opt,M,TF),!, + fbug(is_cmd_option(Opt,M,TF)), !, set_option_value_interp(Opt,TF), + set_tty_color_term(true), + cmdline_load_metta(Self,Rest). + +cmdline_load_metta(Self,[M|Rest]):- + format('~N'),write('; unused '), write_src(M), nl, !, + cmdline_load_metta(Self,Rest). + set_tty_color_term(TF):- current_output(X),set_stream(X,tty(TF)), @@ -560,9 +465,9 @@ exists_file(RelFilename),!, absolute_file_name(RelFilename,Filename), must_det_ll((setup_call_cleanup(open(Filename,read,In, [encoding(utf8)]), - ((directory_file_path(Directory, _, Filename), - assert(metta_file(Self,Filename,Directory)), - with_cwd(Directory, + ((directory_file_path(Directory, _, Filename), + assert(metta_file(Self,Filename,Directory)), + with_cwd(Directory, must_det_ll( load_metta_file_stream(Filename,Self,In))))),close(In)))))). load_metta_file_stream(Filename,Self,In):- @@ -570,9 +475,9 @@ with_option(loading_file,Filename, %current_exec_file(Filename), ((must_det_ll(( - set_exec_num(Filename,1), - load_answer_file(Filename), - set_exec_num(Filename,0))), + set_exec_num(Filename,1), + load_answer_file(Filename), + set_exec_num(Filename,0))), load_metta_file_stream_fast(Size,P2,Filename,Self,In)))). @@ -595,12 +500,12 @@ I==end_of_file,!. load_metta_file_stream_fast(_Size,P2,Filename,Self,In):- - repeat, + repeat, current_read_mode(file,Mode), call(P2, In,Expr), %write_src(read_metta=Expr),nl, once((((do_metta(file(Filename),Mode,Self,Expr,_O)))->true; pp_m(unknown_do_metta(file(Filename),Mode,Self,Expr)))), - flush_output, - at_end_of_stream(In),!. + flush_output, + at_end_of_stream(In),!. clear_spaces:- clear_space(_). clear_space(S):- @@ -645,18 +550,20 @@ into_underscores(D,U):- atom(D),!,atomic_list_concat(L,'-',D),atomic_list_concat(L,'_',U). into_underscores(D,U):- descend_and_transform(into_underscores,D,U),!. +into_hyphens(D,U):- atom(D),!,atomic_list_concat(L,'_',D),atomic_list_concat(L,'-',U). +into_hyphens(D,U):- descend_and_transform(into_hyphens,D,U),!. descend_and_transform(P2, Input, Transformed) :- - ( var(Input) - -> Transformed = Input % Keep variables as they are - ; compound(Input) - -> (compound_name_arguments(Input, Functor, Args), + ( var(Input) + -> Transformed = Input % Keep variables as they are + ; compound(Input) + -> (compound_name_arguments(Input, Functor, Args), maplist(descend_and_transform(P2), Args, TransformedArgs), compound_name_arguments(Transformed, Functor, TransformedArgs)) - ; (atom(Input),call(P2,Input,Transformed)) - -> true % Transform atoms using xform_atom/2 - ; Transformed = Input % Keep other non-compound terms as they are - ). + ; (atom(Input),call(P2,Input,Transformed)) + -> true % Transform atoms using xform_atom/2 + ; Transformed = Input % Keep other non-compound terms as they are + ). /* is_syspred(H,Len,Pred):- notrace(is_syspred0(H,Len,Pred)). @@ -666,7 +573,7 @@ is_syspred0(H,Len,Pred):- atom_concat(Mid,'!',H), H\==Mid, is_syspred0(Mid,Len,Pred),!. is_syspred0(H,Len,Pred):- into_underscores(H,Mid), H\==Mid, is_syspred0(Mid,Len,Pred),!. -fn_append(List,X,Call):- +fn_append(List,X,Call):- fn_append1(List,X,ListX), into_fp(ListX,Call). @@ -718,9 +625,9 @@ balanced_parentheses([H|T], N) :- H \= '(', H \= ')', balanced_parentheses(T, N). % Recursive function to read lines until parentheses are balanced. repl_read(NewAccumulated, Expr):- - atom_concat(Atom, '.', NewAccumulated), - catch_err((read_term_from_atom(Atom, Term, []), Expr=call(Term)), E, - (write('Syntax error: '), writeq(E), nl, repl_read(Expr))),!. + atom_concat(Atom, '.', NewAccumulated), + catch_err((read_term_from_atom(Atom, Term, []), Expr=call(Term)), E, + (write('Syntax error: '), writeq(E), nl, repl_read(Expr))),!. %repl_read(Str, Expr):- ((clause(t_l:s_reader_info(Expr),_,Ref),erase(Ref))). @@ -731,16 +638,16 @@ repl_read(Str, Expr):- atom_concat('@',_,Str),!,atom_string(Expr,Str). repl_read(Str, _Expr):- atom_concat(')',_,Str),!,fbug(repl_read_syntax(Str)),throw(restart_reading). repl_read(NewAccumulated, Expr):- - normalize_space(string(Renew),NewAccumulated), - Renew \== NewAccumulated, !, - repl_read(Renew, Expr). + normalize_space(string(Renew),NewAccumulated), + Renew \== NewAccumulated, !, + repl_read(Renew, Expr). %repl_read(Str, 'add-atom'('&self',Expr)):- atom_concat('+',W,Str),!,repl_read(W,Expr). %repl_read(NewAccumulated,exec(Expr)):- string_concat("!",Renew,NewAccumulated), !, repl_read(Renew, Expr). repl_read(NewAccumulated, Expr):- string_chars(NewAccumulated, Chars), - balanced_parentheses(Chars), length(Chars, Len), Len > 0, - parse_sexpr_metta(NewAccumulated, Expr), !, - normalize_space(string(Renew),NewAccumulated), - add_history_string(Renew). + balanced_parentheses(Chars), length(Chars, Len), Len > 0, + parse_sexpr_metta(NewAccumulated, Expr), !, + normalize_space(string(Renew),NewAccumulated), + add_history_string(Renew). repl_read(Accumulated, Expr) :- read_line_to_string(current_input, Line), repl_read(Accumulated, Line, Expr). repl_read(_, end_of_file, end_of_file):- throw(end_of_input). @@ -748,12 +655,12 @@ repl_read(Accumulated, "", Expr):- !, repl_read(Accumulated, Expr). repl_read(_Accumulated, Line, Expr):- Line == end_of_file, !, Expr = Line. repl_read(Accumulated, Line, Expr) :- atomics_to_string([Accumulated," ",Line], NewAccumulated), !, - repl_read(NewAccumulated, Expr). + repl_read(NewAccumulated, Expr). repl_read(O2):- clause(t_l:s_reader_info(O2),_,Ref),erase(Ref). repl_read(Expr) :- repeat, remove_pending_buffer_codes(_,Was),text_to_string(Was,Str), - repl_read(Str, Expr), + repl_read(Str, Expr), % once(((atom(Expr1),atom_concat('@',_,Expr1), \+ atom_contains(Expr1,"="), repl_read(Expr2)) -> Expr=[Expr1,Expr2] ; Expr1 = Expr)), % this cutrs the repeat/0 ((peek_pending_codes(_,Peek),Peek==[])->!;true). @@ -790,11 +697,11 @@ % Predicate to check if a stream is a file stream and get its size. is_file_stream_and_size(Stream, Size) :- - % Check if the stream is associated with a file. - stream_property(Stream, file_name(FileName)), - % Check if the file is accessible and get its size. - exists_file(FileName), - size_file(FileName, Size). + % Check if the stream is associated with a file. + stream_property(Stream, file_name(FileName)), + % Check if the file is accessible and get its size. + exists_file(FileName), + size_file(FileName, Size). maybe_read_pl(In,Expr):- @@ -812,7 +719,7 @@ read_sform(S,F):- read_sform1([],S,F1), ( F1\=='!' -> F=F1 ; - (read_sform1([],S,F2), F = exec(F2))). + (read_sform1([],S,F2), F = exec(F2))). read_sform2(S,F1):- !, read_metta2(S,F1). @@ -890,8 +797,6 @@ parse_sexpr_metta1(I,O):- parse_sexpr_untyped(I,U),trly(untyped_to_metta,U,O). - -write_comment(_):- is_compatio,!. write_comment(_):- silent_loading,!. write_comment(Cmt):- connlf,format(';;~w~n',[Cmt]). do_metta_cmt(_,'$COMMENT'(Cmt,_,_)):- write_comment(Cmt),!. @@ -903,10 +808,10 @@ %untyped_to_metta(I,exec(O)):- compound(I),I=exec(M),!,untyped_to_metta(M,O). untyped_to_metta(I,O):- - must_det_ll(( - trly(mfix_vars1,I,M), - trly(cons_to_c,M,OM), - trly(cons_to_l,OM,O))). + must_det_ll(( + trly(mfix_vars1,I,M), + trly(cons_to_c,M,OM), + trly(cons_to_l,OM,O))). trly(P2,A,B):- once(call(P2,A,M)),A\=@=M,!,trly(P2,M,B). @@ -930,7 +835,7 @@ mfix_vars1([H|T],O):- H=='[', is_list(T), last(T,L),L==']',append(List,[L],T), !, O = ['[...]',List]. mfix_vars1([H|T],O):- H=='{', is_list(T), last(T,L),L=='}',append(List,[L],T), !, O = ['{...}',List]. mfix_vars1([H|T],O):- is_list(T), last(T,L),L=='}',append(List,[L],T), - append(Left,['{'|R],List),append([H|Left],[['{}',R]],NewList),mfix_vars1(NewList,O). + append(Left,['{'|R],List),append([H|Left],[['{}',R]],NewList),mfix_vars1(NewList,O). mfix_vars1('$OBJ'(claz_bracket_vector,List),O):- is_list(List),!, O = ['[...]',List]. mfix_vars1(I,O):- I = ['[', X, ']'], nonvar(X), !, O = ['[...]',X]. mfix_vars1(I,O):- I = ['{', X, '}'], nonvar(X), !, O = ['{...}',X]. @@ -1005,85 +910,64 @@ maybe_set_var_names(NamedVarsList). subst_vars(TermWDV, NewTerm, NamedVarsList) :- - subst_vars(TermWDV, NewTerm, [], NamedVarsList). + subst_vars(TermWDV, NewTerm, [], NamedVarsList). subst_vars(Term, Term, NamedVarsList, NamedVarsList) :- var(Term), !. subst_vars([], [], NamedVarsList, NamedVarsList):- !. subst_vars([TermWDV|RestWDV], [Term|Rest], Acc, NamedVarsList) :- !, - subst_vars(TermWDV, Term, Acc, IntermediateNamedVarsList), - subst_vars(RestWDV, Rest, IntermediateNamedVarsList, NamedVarsList). + subst_vars(TermWDV, Term, Acc, IntermediateNamedVarsList), + subst_vars(RestWDV, Rest, IntermediateNamedVarsList, NamedVarsList). subst_vars('$VAR'('_'), _, NamedVarsList, NamedVarsList) :- !. subst_vars('$VAR'(VName), Var, Acc, NamedVarsList) :- nonvar(VName), svar_fixvarname_dont_capitalize(VName,Name), !, - (memberchk(Name=Var, Acc) -> NamedVarsList = Acc ; ( !, Var = _, NamedVarsList = [Name=Var|Acc])). + (memberchk(Name=Var, Acc) -> NamedVarsList = Acc ; ( !, Var = _, NamedVarsList = [Name=Var|Acc])). subst_vars(Term, Var, Acc, NamedVarsList) :- atom(Term),atom_concat('$',DName,Term), dvar_name(DName,Name),!,subst_vars('$VAR'(Name), Var, Acc, NamedVarsList). subst_vars(TermWDV, NewTerm, Acc, NamedVarsList) :- - compound(TermWDV), !, - compound_name_arguments(TermWDV, Functor, ArgsWDV), - subst_vars(ArgsWDV, Args, Acc, NamedVarsList), - compound_name_arguments(NewTerm, Functor, Args). + compound(TermWDV), !, + compound_name_arguments(TermWDV, Functor, ArgsWDV), + subst_vars(ArgsWDV, Args, Acc, NamedVarsList), + compound_name_arguments(NewTerm, Functor, Args). subst_vars(Term, Term, NamedVarsList, NamedVarsList). :- nb_setval(variable_names,[]). -assert_preds(Self,Load,List):- is_list(List),!,maplist(assert_preds(Self,Load),List). -%assert_preds(_Self,_Load,_Preds):- \+ show_transpiler,!. -assert_preds(Self,Load,Preds):- + +assert_preds(_Self,_Load,_Preds):- \+ preview_compiler,!. +assert_preds(_Self,Load,Preds):- expand_to_hb(Preds,H,_B),functor(H,F,A), - if_t((show_transpiler), - color_g_mesg_ok('#005288',( - ignore(( - % \+ predicate_property(H,defined), - %if_t(is_transpiling,catch_i(dynamic(F,A))), - if_t( \+ predicate_property(H,defined), - not_compatio(format(' :- ~q.~n',[dynamic(F/A)]))), - if_t(option_value('tabling','True'), - not_compatio(format(' :- ~q.~n',[table(F/A)]))))), - not_compatio(format('~N~n ~@',[portray_clause(Preds)]))))), - - - if_t(is_transpiling, - if_t(\+ predicate_property(H,static),add_assertion(Self,Preds))), - nop(metta_anew1(Load,Preds)). + color_g_mesg('#005288',( + ignore(( + \+ predicate_property(H,defined), + if_t(use_metta_compiler,catch_i(dynamic(F,A))), + format(' :- ~q.~n',[dynamic(F/A)]), + if_t(option_value('tabling',true), format(' :- ~q.~n',[table(F/A)])))), + if_t((preview_compiler), + format('~N~n ~@',[portray_clause(Preds)])), + if_t(use_metta_compiler,if_t(\+ predicate_property(H,static),add_assertion(Preds))))), + nop(metta_anew1(Load,Preds)). %load_hook(_Load,_Hooked):- !. -load_hook(Load,Hooked):- - ignore(( \+ ((forall(load_hook0(Load,Hooked),true))))),!. - +load_hook(Load,Hooked):- ignore(( \+ ((forall(load_hook0(Load,Hooked),true))))),!. - -assertion_hb(metta_defn(=,Self,H,B),Self,H,B). -assertion_hb(asserted_metta_atom(Self,[=,H,B]),Self,H,B). - -load_hook0(_,_):- \+ show_transpiler, \+ is_transpiling, !. -load_hook0(Load,Assertion):- assertion_hb(Assertion,Self,H,B), - functs_to_preds([=,H,B],Preds), - assert_preds(Self,Load,Preds). load_hook0(_,_):- \+ current_prolog_flag(metta_interp,ready),!. +load_hook0(_,_):- \+ preview_compiler,!. +load_hook0(Load,metta_defn(=,Self,H,B)):- + functs_to_preds([=,H,B],Preds), + assert_preds(Self,Load,Preds). /* load_hook0(Load,get_metta_atom(Eq,Self,H)):- B = 'True', - H\=[':'|_], functs_to_preds([=,H,B],Preds), - assert_preds(Self,Load,Preds). + H\=[':'|_], functs_to_preds([=,H,B],Preds), + assert_preds(Self,Load,Preds). */ -is_transpiling:- notrace(option_value('compile','full')), !. -%show_transpiler:- is_transpiling,!. -show_transpiler:- option_value('code',Something), Something\==silent,!. - -do_show_options_values:- - forall((nb_current(N,V), \+((atom(N),atom_concat('$',_,N)))),write_src_nl(['pragma!',N,V])), - do_show_option_switches. - -option_switch_pred(F):- - current_predicate(F/0),interpreter_source_file(File), - source_file(F, File), \+ \+ (member(Prefix,[is_,show_,trace_on_]), atom_concat(Prefix,_,F)). +use_metta_compiler:- notrace(option_value('compile','full')), !. +preview_compiler:- \+ option_value('compile',false), !. +%preview_compiler:- use_metta_compiler,!. -do_show_option_switches :- - forall(option_switch_pred(F),(call(F)-> writeln(yes(F)); writeln(not(F)))). op_decl('pragma!', [ 'Atom', 'Atom'], 'EmptyType'). @@ -1152,7 +1036,7 @@ type_decl('Symbol'). type_decl('MemoizedState'). type_decl('Type'). -type_decl('%Undefined%'). +type_decl('%Undefined%'). type_decl('Variable'). :- dynamic(get_metta_atom/2). @@ -1160,9 +1044,8 @@ :- multifile(asserted_metta/4). :- dynamic(asserted_metta/4). metta_atom_stdlib(_):-!,fail. -metta_atom_stdlib(X):- metta_atom_stdlib_types(X). -metta_atom_stdlib_types([':', Type, 'Type']):- type_decl(Type). -metta_atom_stdlib_types([':', Op, [->|List]]):- op_decl(Op,Params,ReturnType),append(Params,[ReturnType],List). +metta_atom_stdlib([':', Type, 'Type']):- type_decl(Type). +metta_atom_stdlib([':', Op, [->|List]]):- op_decl(Op,Params,ReturnType),append(Params,[ReturnType],List). %get_metta_atom(Eq,KB, [F|List]):- KB='&flybase',fb_pred(F, Len), length(List,Len),apply(F,List). @@ -1182,11 +1065,7 @@ metta_atom(KB,Atom):- get_metta_atom_from(KB,Atom). metta_defn(KB,Head,Body):- metta_defn(_Eq,KB,Head,Body). metta_defn(Eq,KB,Head,Body):- ignore(Eq = '='), get_metta_atom_from(KB,[Eq,Head,Body]). - -metta_type(S,H,B):- - if_or_else(get_metta_atom_from(S,[':',H,B]), - metta_atom_stdlib_types([':',H,B])). - +metta_type(S,H,B):- get_metta_atom_from(S,[':',H,B]). %typed_list(Cmpd,Type,List):- compound(Cmpd), Cmpd\=[_|_], compound_name_arguments(Cmpd,Type,[List|_]),is_list(List). @@ -1205,9 +1084,9 @@ metta_anew1(unload,OBO):- OBO= metta_atom(Space,Atom),!,'remove-atom'(Space, Atom). metta_anew1(load,OBO):- !, must_det_ll((load_hook(load,OBO), - subst_vars(OBO,Cl),pfcAdd(Cl))). %to_metta(Cl). + subst_vars(OBO,Cl),assertz(Cl))). %to_metta(Cl). metta_anew1(load,OBO):- !, must_det_ll((load_hook(load,OBO), - subst_vars(OBO,Cl),show_failure(pfcAdd(Cl)))). %to_metta(Cl). + subst_vars(OBO,Cl),show_failure(assertz(Cl)))). %to_metta(Cl). metta_anew1(unload,OBO):- subst_vars(OBO,Cl),load_hook(unload,OBO), expand_to_hb(Cl,Head,Body), predicate_property(Head,number_of_clauses(_)), @@ -1258,11 +1137,11 @@ assert_to_metta(_):- reached_file_max,!. assert_to_metta(OBO):- - must_det_ll((OBO=..[Fn|DataLL], - maplist(better_arg,DataLL,DataL), - into_datum(Fn, DataL, Data), - functor(Data,Fn,A),decl_fb_pred(Fn,A), - real_assert(Data),!, + must_det_ll((OBO=..[Fn|DataLL], + maplist(better_arg,DataLL,DataL), + into_datum(Fn, DataL, Data), + functor(Data,Fn,A),decl_fb_pred(Fn,A), + real_assert(Data),!, incr_file_count(_))). assert_to_metta(OBO):- @@ -1277,12 +1156,12 @@ real_assert(Data), incr_file_count(_), ignore((((should_show_data(X), - ignore((fail,OldData\==Data,write('; oldData '),write_src(OldData),format(' ; ~w ~n',[X]))), - write_src(Data),format(' ; ~w ~n',[X]))))), + ignore((fail,OldData\==Data,write('; oldData '),write_src(OldData),format(' ; ~w ~n',[X]))), + write_src(Data),format(' ; ~w ~n',[X]))))), ignore(( - fail, option_value(output_stream,OutputStream), - is_stream(OutputStream), - should_show_data(X1),X1<1000,must_det_ll((display(OutputStream,Data),writeln(OutputStream,'.'))))))))))))),!. + fail, option_value(output_stream,OutputStream), + is_stream(OutputStream), + should_show_data(X1),X1<1000,must_det_ll((display(OutputStream,Data),writeln(OutputStream,'.'))))))))))))),!. assert_MeTTa(OBO):- !, assert_to_metta(OBO). %assert_MeTTa(OBO):- !, assert_to_metta(OBO),!,heartbeat. @@ -1291,7 +1170,7 @@ decl_fb_pred(F,A), incr_file_count(_), ignore((((should_show_data(X), - write(newData(X)),write(=),write_src(Data))))), + write(newData(X)),write(=),write_src(Data))))), assert(Data),!. */ @@ -1323,13 +1202,10 @@ write_exec(Exec):- notrace(write_exec0(Exec)). %write_exec0(Exec):- atom(Exec),!,write_exec0([Exec]). - -write_exec0(_):- is_compatio,!. write_exec0(Exec):- wots(S,write_src(exec(Exec))), nb_setval(exec_src,Exec), - format('~N'), - ignore((notrace((color_g_mesg('#0D6328',writeln(S)))))). + ignore((notrace((color_g_mesg_ok('#0D6328',(format('~N'),writeln(S))))))). @@ -1371,9 +1247,9 @@ asserted_do_metta2(Self,Load,[EQ,Head,Result], Src):- EQ=='=', !, must_det_ll(( - discover_head(Self,Load,Head), - color_g_mesg_ok('#ffa500',metta_anew(Load,Src,metta_defn(EQ,Self,Head,Result))), - discover_body(Self,Load,Result))). + discover_head(Self,Load,Head), + color_g_mesg_ok('#ffa500',metta_anew(Load,Src,metta_defn(EQ,Self,Head,Result))), + discover_body(Self,Load,Result))). asserted_do_metta2(Self,Load,PredDecl, Src):- ignore(discover_head(Self,Load,PredDecl)), @@ -1390,8 +1266,6 @@ always_exec(['assertEqual'|_]):-!,fail. always_exec(_):-!,fail. % everything else -file_hides_results([W|_]):- W== 'pragma!'. - if_t(A,B,C):- trace,if_t((A,B),C). @@ -1414,7 +1288,7 @@ if_t( ( \+ is_unit_test_exec(Exec)), ((equal_enough(Val,Ans) -> write_pass_fail_result_now(TestName,exec,Exec,'PASS',Ans,Val) - ; write_pass_fail_result_now(TestName,exec,Exec,'FAIL',Ans,Val)))))). + ; write_pass_fail_result_now(TestName,exec,Exec,'FAIL',Ans,Val)))))). write_pass_fail_result_now(TestName,exec,Exec,PASS_FAIL,Ans,Val):- (PASS_FAIL=='PASS'->flag(loonit_success, X, X+1);flag(loonit_failure, X, X+1)), @@ -1456,9 +1330,9 @@ call_sexpr(How,Self,Tax,_S,Out):- (atom(Tax);string(Tax)), - normalize_space(string(TaxM),Tax), - convert_tax(How,Self,TaxM,Expr,NewHow),!, - show_call(do_metta(python,NewHow,Self,Expr,Out)). + normalize_space(string(TaxM),Tax), + convert_tax(How,Self,TaxM,Expr,NewHow),!, + show_call(do_metta(python,NewHow,Self,Expr,Out)). do_metta(File,Load,Self,Cmt,Out):- if_trace(do_metta, fbug(do_metta(File,Load,Self,Cmt,Out))),fail. @@ -1475,9 +1349,9 @@ ignore(( atomic(Cmt),atomic_list_concat([_,Src],'MeTTaLog: ',Cmt),!,atom_string(Src,SrcCode),do_metta(mettalog_only(From),Load,Self,SrcCode,Out))),!. do_metta(From,How,Self,Src,Out):- string(Src),!, - normalize_space(string(TaxM),Src), - convert_tax(How,Self,TaxM,Expr,NewHow),!, - do_metta(From,NewHow,Self,Expr,Out). + normalize_space(string(TaxM),Src), + convert_tax(How,Self,TaxM,Expr,NewHow),!, + do_metta(From,NewHow,Self,Expr,Out). do_metta(From,_,Self,exec(Expr),Out):- !, do_metta(From,exec,Self,Expr,Out). do_metta(From,_,Self, call(Expr),Out):- !, do_metta(From,call,Self,Expr,Out). @@ -1492,14 +1366,14 @@ do_metta(file(Filename),exec,Self,TermV,Out):- notrace(( inc_exec_num(Filename), - must_det_ll(( + must_det_ll(( get_exec_num(Filename,Nth), Nth>0)), file_answers(Filename, Nth, Ans), check_answers_for(TermV,Ans),!, must_det_ll(( - color_g_mesg_ok('#ffa500', - (writeln(';; In file as: '), + color_g_mesg_ok('#ffa500', + (writeln(';; In file as: '), color_g_mesg([bold,fg('#FFEE58')], write_src(exec(TermV))), write(';; To unit test case:'))))),!, do_metta_exec(file(Filename),Self,['assertEqualToResult',TermV,Ans],Out))). @@ -1508,9 +1382,8 @@ do_metta_exec(From,Self,TermV,FOut):- Output = X, - not_compatio(write_exec(TermV)), notrace(into_metta_callable(Self,TermV,Term,X,NamedVarsList,Was)),!, - user:interactively_do_metta_exec(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut),!. + user:interactively_do_metta_exec(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut). call_for_term_variables(TermV,catch_red(show_failure(Term)),NamedVarsList,X):- @@ -1521,8 +1394,7 @@ call_for_term_variables5(TermV, DCAllVars, Singletons, NonSingletons, Term,NamedVarsList,X),!, must_be(callable,Term). -into_metta_callable(_Self,TermV,Term,X,NamedVarsList,Was):- - is_transpiling, !, +into_metta_callable(_Self,TermV,Term,X,NamedVarsList,Was):- use_metta_compiler, !, must_det_ll(((( % ignore(Res = '$VAR'('ExecRes')), @@ -1531,13 +1403,13 @@ subst_vars(Res+ExecGoal,Res+Term,NamedVarsList), copy_term(NamedVarsList,Was), term_variables(Term,Vars), - notrace((color_g_mesg('#114411',print_pl_source(answer(Res):-ExecGoal)))), + notrace((color_g_mesg('#114411',print_tree(exec(Res):-ExecGoal)))), %nl,writeq(Term),nl, ((\+ \+ ((numbervars(v(TermV,Term,NamedVarsList,Vars),999,_,[attvar(bind)]), %nb_current(variable_names,NamedVarsList), %nl,print(subst_vars(Term,NamedVarsList,Vars)), - nop(nl))))), + nl)))), nop(maplist(verbose_unify,Vars)), %NamedVarsList=[_=RealRealRes|_], var(RealRes), X = RealRes)))),!. @@ -1547,7 +1419,7 @@ option_else('stack-max',StackMax,100), CALL = eval_H(StackMax,Self,Term,X), notrace(( must_det_ll(( - if_t(show_transpiler,write_compiled_exec(TermV,_Goal)), + if_t(preview_compiler,write_compiled_exec(TermV,_Goal)), subst_vars(TermV,Term,NamedVarsList), copy_term(NamedVarsList,Was) %term_variables(Term,Vars), @@ -1558,28 +1430,22 @@ %nop(maplist(verbose_unify,Vars)))))),!. )))),!. - - -eval_S(Self,Form):- nonvar(Form), - current_self(SelfS),SelfS==Self,!, - do_metta(true,exec,Self,Form,_Out). -eval_H(Term,X):- eval_args(Term,X). - eval_H(StackMax,Self,Term,X):- eval_args('=',_,StackMax,Self,Term,X). +eval_H(Term,X):- eval_args(Term,X). /* eval_H(StackMax,Self,Term,X). eval_H(StackMax,Self,Term,X):- Time = 90.0, ((always_exec(Term)) -> - if_or_else(t1('=',_,StackMax,Self,Term,X), + if_or_else(t1('=',_,StackMax,Self,Term,X), (t2('=',_,StackMax,Self,Term,X))); - call_max_time(t1('=',_,StackMax,Self,Term,X), Time, + call_max_time(t1('=',_,StackMax,Self,Term,X), Time, (t2('=',_,StackMax,Self,Term,X)))). eval_H(Term,X):- - current_self(Self), StackMax = 100, - if_or_else((t1('=',_,StackMax,Self,Term,X),X\==Term),(t2('=',_,StackMax,Self,Term,X),nop(X\==Term))). + current_self(Self), StackMax = 100, + if_or_else((t1('=',_,StackMax,Self,Term,X),X\==Term),(t2('=',_,StackMax,Self,Term,X),nop(X\==Term))). t1('=',_,StackMax,Self,Term,X):- eval_args('=',_,StackMax,Self,Term,X). @@ -1602,7 +1468,7 @@ call_max_time(Goal,_MaxTime, Else) :- interacting,!, if_or_else(Goal,Else). call_max_time(Goal,_MaxTime, Else) :- !, if_or_else(Goal,Else). call_max_time(Goal, MaxTime, Else) :- - catch(if_or_else(call_with_time_limit(MaxTime, Goal),Else), time_limit_exceeded, Else). + catch(if_or_else(call_with_time_limit(MaxTime, Goal),Else), time_limit_exceeded, Else). catch_err(G,E,C):- catch(G,E,(notrace(if_t(atom(E),throw(E))),C)). @@ -1615,33 +1481,34 @@ %repl:- setup_call_cleanup(flag(repl_level,Was,Was+1),repl0, % (flag(repl_level,_,Was),(Was==0 -> maybe_halt(7) ; true))). - -repl:- install_readline_editline, catch(repl2,end_of_input,true). +repl:- catch(repl2,end_of_input,true). repl1:- - with_option('doing_repl',true, - with_option(repl,true,repl2)). %catch((repeat, repl2, fail)'$aborted',true). + with_option('doing_repl',true, + with_option(repl,true,repl2)). %catch((repeat, repl2, fail)'$aborted',true). repl2:- - repeat, - %set_prolog_flag(gc,true), - garbage_collect, - %set_prolog_flag(gc,false), - %with_option(not_a_reload,true,make), + %notrace((current_input(In),nop(catch(load_history,_,true)))), + % ignore(install_readline(In)), + repeat, + %set_prolog_flag(gc,true), + garbage_collect, + %set_prolog_flag(gc,false), + %with_option(not_a_reload,true,make), ignore(catch(once(repl3),restart_reading,true)), %set_prolog_flag(gc,true), fail. repl3:- - notrace(( flag(eval_num,_,0), + notrace(( flag(eval_num,_,0), current_self(Self), current_read_mode(repl,Mode), %ignore(shell('stty sane ; stty echo')), %current_input(In), - %format(atom(P2),'metta> ',[]), + %format(atom(P2),'metta> ',[]), format(atom(P),'metta ~w ~w> ',[Self, Mode]))), setup_call_cleanup( - notrace(prompt(Was,P)), - notrace((ttyflush,repl_read(Expr),ttyflush)), - notrace(prompt(_,Was))), + notrace(prompt(Was,P)), + notrace((ttyflush,repl_read(Expr),ttyflush)), + notrace(prompt(_,Was))), if_trace(replt,fbug(repl_read(Mode,Expr))), %fbug(repl_read(Expr)), notrace(if_t(Expr==end_of_file,throw(end_of_input))), @@ -1655,8 +1522,8 @@ check_has_directive(NEV):- atom(NEV), atomic_list_concat([N,V],'=',NEV), set_directive(N,V). check_has_directive([AtEq,Value]):-atom(AtEq),atom_concat('@',Name,AtEq), set_directive(Name,Value). check_has_directive(ModeChar):- atom(ModeChar),metta_interp_mode(ModeChar,_Mode),!,set_directive(repl_mode,ModeChar). -check_has_directive('@'):- do_show_options_values,!,notrace(throw(restart_reading)). -check_has_directive(AtEq):-atom(AtEq),atom_concat('@',NEV,AtEq),option_value(NEV,Foo),fbug(NEV=Foo),!,notrace(throw(restart_reading)). +check_has_directive('@'):- show_options_values,nl,!,notrace(throw(restart_reading)). +check_has_directive(AtEq):-atom(AtEq),atom_concat('@',NEV,AtEq),option_value(NEV,Foo),print(NEV=Foo),nl,!,notrace(throw(restart_reading)). check_has_directive(_). set_directive(N,V):- atom_concat('@',NN,N),!,set_directive(NN,V). set_directive(N,V):- N==mode,!,set_directive(repl_mode,V). @@ -1683,7 +1550,7 @@ include(not_in_eq(DontCares), NonSingletons, CNonSingletons), include(not_in_eq(DontCares), Singletons, CSingletons), maplist(into_named_vars,[DontCares, CSingletons, CNonSingletons], - [DontCaresN, CSingletonsN, CNonSingletonsN]), + [DontCaresN, CSingletonsN, CNonSingletonsN]), writeqln([DontCaresN, CSingletonsN, CNonSingletonsN]). term_dont_cares(Term, DontCares):- @@ -1705,7 +1572,7 @@ get_global_varnames(VNs):- prolog_load_context(variable_names,VNs),!. maybe_set_var_names(List):- List==[],!. maybe_set_var_names(List):- % fbug(maybe_set_var_names(List)), - is_list(List),!,nb_linkval(variable_names,List). + is_list(List),!,nb_linkval(variable_names,List). maybe_set_var_names(_). name_for_var_vn(V,N=V):- name_for_var(V,N). @@ -1733,14 +1600,15 @@ is_interactive0(From):- From = true,!. +:- set_prolog_flag(history, 20). inside_assert(Var,Var):- \+ compound(Var),!. inside_assert([H,IA,_],IA):- atom(H),atom_concat('assert',_,H),!. inside_assert(Conz,Conz):- is_conz(Conz),!. inside_assert(exec(I),O):- !, inside_assert(I,O). inside_assert(Eval,O):- functor(Eval,eval_H,A), A1 is A-1, arg(A1,Eval,I),!, inside_assert(I,O). -%inside_assert(eval_H(I,C),eval_H(O,C)):- !, inside_assert(I,O). -%inside_assert(eval_H(A,B,I,C),eval_H(A,B,O,C)):- !, inside_assert(I,O). +inside_assert(eval_H(A,B,I,C),eval_H(A,B,O,C)):- !, inside_assert(I,O). +inside_assert(eval_H(I,C),eval_H(O,C)):- !, inside_assert(I,O). inside_assert(call(I),O):- !, inside_assert(I,O). inside_assert( ?-(I), O):- !, inside_assert(I,O). inside_assert( :-(I), O):- !, inside_assert(I,O). @@ -1752,32 +1620,38 @@ eval(all(Form)):- nonvar(Form), !, forall(eval(Form,_),true). -eval(Form):- current_self(Self), do_metta(true,exec,Self,Form,_Out). -eval(Form,Out):-current_self(Self),eval(Self,Form,Out). -eval(Self,Form,Out):- do_metta(prolog,exec,Self,Form,Out). +eval(Form):- + current_self(Self), + do_metta(true,exec,Self,Form,_Out). + +eval(Self,Form):- + current_self(SelfS),SelfS==Self,!, + do_metta(true,exec,Self,Form,_Out). +eval(Form,Out):- + current_self(Self), + eval(Self,Form,Out). -name_vars(P):- ignore(name_vars0(P)). -name_vars0(X=Y):- X==Y,!. -name_vars0(X='$VAR'(X)). +eval(Self,Form,Out):- + do_metta(prolog,exec,Self,Form,Out). + +name_vars(X='$VAR'(X)). interactively_do_metta_exec(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut):- catch(interactively_do_metta_exec0(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut),'$aborted',fbug(aborted(From,TermV))). - -%interactively_do_metta_exec0(file(_),Self,_TermV,Term,X,_NamedVarsList,_Was,_Output,_FOut):- file_hides_results(Term),!,eval_args(Self,Term,X). -interactively_do_metta_exec0(From,Self,_TermV,Term,X,NamedVarsList,Was,Output,FOut):- +interactively_do_metta_exec0(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut):- notrace(( - Result = res(FOut), - inside_assert(Term,BaseEval), - (is_compatio - -> option_else(answer,Leap,leap) + Result = res(FOut), + inside_assert(Term,BaseEval), + (is_compatio + -> option_else(answer,Leap,leap) ; option_else(answer,Leap,each)), - Control = contrl(inf,Leap), - Skipping = _, - % Initialize Control as a compound term with 'each' as its argument. - %GG = interact(['Result'=X|NamedVarsList],Term,trace_off), - (((From = file(_Filename), option_value('exec',skip), \+ always_exec(BaseEval))) + Control = contrl(inf,Leap), + Skipping = _, + % Initialize Control as a compound term with 'each' as its argument. + %GG = interact(['Result'=X|NamedVarsList],Term,trace_off), + (((From = file(_Filename), option_value('exec',skip), \+ always_exec(BaseEval))) -> (GG = (skip(Term),deterministic(Complete)), %Output = %FOut = "Skipped", @@ -1790,53 +1664,51 @@ ; GG = %$ locally(set_prolog_flag(gc,false), ( (( (Term),deterministic(Complete), nb_setarg(1,Result,Output)))), - !, % metta_toplevel + !, % metta_toplevel flag(result_num,_,0), PL=eval(Self,BaseEval,X), ( % with_indents(true, \+ \+ ( - user:maplist(name_vars,NamedVarsList), - user:name_vars('OUT'=X), - % add_history_src(exec(BaseEval)), - if_t(Skipping==1,writeln(' ; SKIPPING')), - %if_t(TermV\=BaseEval,color_g_mesg('#fa90f6', (write('; '), with_indents(false,write_src(exec(BaseEval)))))), - if_t((is_interactive(From);Skipping==1), + maplist(name_vars,NamedVarsList), + name_vars('OUT'=X), + % add_history_src(exec(BaseEval)), + not_compat_io(write_exec(TermV)), + if_t(Skipping==1,writeln(' ; SKIPPING')), + if_t(TermV\=BaseEval,color_g_mesg('#fa90f6', (write('; '), with_indents(false,write_src(exec(BaseEval)))))), + if_t((is_interactive(From);Skipping==1), ( if_t( \+ option_value(doing_repl,true), if_t( \+ option_value(repl,true), if_t( option_value(prolog,true), add_history_pl(PL)))), if_t(option_value(repl,true), add_history_src(exec(BaseEval))))), - prolog_only((color_g_mesg('#da70d6', (write('% DEBUG: '), writeq(PL),writeln('.'))))), - true))))), - if_compatio(write('[')), + prolog_only((color_g_mesg('#da70d6', (write('% DEBUG: '), writeq(PL),writeln('.'))))), + true))))), + (forall_interactive( - From, WasInteractive,Complete, %may_rtrace + From, WasInteractive,Complete, %may_rtrace (timed_call(GG,Seconds)), ((Complete==true->!;true), - %repeat, - set_option_value(interactive,WasInteractive), - Control = contrl(Max,DoLeap), - nb_setarg(1,Result,Output), - current_input(CI), - read_pending_codes(CI,_,[]), - flag(result_num,R,R+1), - flag(result_num,ResNum,ResNum), + %repeat, + set_option_value(interactive,WasInteractive), + Control = contrl(Max,DoLeap), + nb_setarg(1,Result,Output), + current_input(CI), + read_pending_codes(CI,_,[]), + flag(result_num,R,R+1), + flag(result_num,ResNum,ResNum), if_t(ResNum=(not_compatio(format('~NDeterministic: ', [])), !); %or Nondet - ( Complete==true -> (not_compatio(format('~NLast Result(~w): ',[ResNum])),! ); - not_compatio(format('~NNDet Result(~w): ',[ResNum]))))), - color_g_mesg_ok(yellow, ignore((( not_compatio(if_t( \+ atomic(Output), nl)), - if_compatio((if_t(ResNum> 1,write(', ')),with_indents(false,write_asrc(Output)))),not_compatio(write_asrc(Output)), not_compatio(nl))))), - - not_compatio(with_output_to(user_error,give_time('Execution',Seconds))), - %not_compatio(give_time('Execution',Seconds), - color_g_mesg(green, - ignore((NamedVarsList \=@= Was ->(not_compatio(( maplist(print_var,NamedVarsList), nl))) ; true))))), - ( + ((((ResNum==1,Complete==true)->(not_compat_io(format('~NDeterministic: ', [])), !); %or Nondet + ( Complete==true -> (not_compat_io(format('~NLast Result(~w): ',[ResNum])),! ); + not_compat_io(format('~NNDet Result(~w): ',[ResNum]))))), + color_g_mesg(yellow, ignore((( if_t( \+ atomic(Output), nl), write_asrc(Output), nl)))), + not_compat_io(give_time('Execution',Seconds)), + if_compat_io(with_output_to(user_error,give_time('Execution',Seconds))), + color_g_mesg(green, + ignore((NamedVarsList \=@= Was ->(not_compat_io(( maplist(print_var,NamedVarsList), nl))) ; true))))), + ( (Complete\==true, WasInteractive, DoLeap\==leap, ResNum - (write("press ';' for more solutions "),get_single_char_key(C), - not_compatio((writeq(key=C),nl)), + (write("press ';' for more solutions "),get_single_char_key(C), writeq(key=C),nl, (C=='b' -> (once(repl),fail) ; (C=='m' -> make ; (C=='t' -> (nop(set_debug(eval,true)),rtrace) ; @@ -1847,11 +1719,10 @@ (C=='l' -> nb_setarg(2, Control, leap) ; (((C=='\n');(C=='\r')) -> (!,fail); (!,fail)))))))))))); - (Complete\==true, \+ WasInteractive, Control = contrl(Max,leap)) -> true ; + (Complete\==true, \+ WasInteractive, Control = contrl(Max,leap)) -> true ; (((Complete==true ->! ; true))))) *-> (ignore(Result = res(FOut)),ignore(Output = (FOut))) - ; (flag(result_num,ResNum,ResNum),(ResNum==0->(not_compatio(format('~N~n~n')),!,true);true))), - if_compatio(write(']\n')), + ; (flag(result_num,ResNum,ResNum),(ResNum==0->(format('~N~n~n'),!,true);true))), ignore(Result = res(FOut)). @@ -1859,10 +1730,10 @@ mqd:- forall(metta_atom(_KB,['query-info',E,T,Q]), (writeln(E), - term_variables(T,TVs), - term_variables(Q,QVs), - intersection(TVs,QVs,_,_,SVs), - notrace(eval(['match','&flybase',Q,T],SVs)))). + term_variables(T,TVs), + term_variables(Q,QVs), + intersection(TVs,QVs,_,_,SVs), + notrace(eval(['match','&flybase',Q,T],SVs)))). get_single_char_key(O):- get_single_char(C),get_single_char_key(C,O). @@ -1873,16 +1744,11 @@ forall_interactive(prolog,false,Complete,Goal,After):- !, Goal, (Complete == true -> ! ; true), quietly(After). forall_interactive(From,WasInteractive,Complete,Goal,After):- (is_interactive(From) -> WasInteractive = true ; WasInteractive = false),!, - Goal, (Complete==true -> ( quietly(After),!) ; ( quietly( \+ After) )). + Goal, (Complete==true -> ( quietly(After),!) ; ( quietly( \+ After) )). print_var(Name=Var) :- print_var(Name,Var). %print_var(Name,_Var) :- atom_concat('Num',Rest,Name),atom_number(Rest,_),!. - -write_var(V):- var(V), !, write_dvar(V),!. -write_var('$VAR'(S)):- !, write_dvar(S),!. -write_var(V):- write_dvar(V),!. - -print_var(Name,Var):- write_var(Name), write(' = '), write_asrc(Var), nl. +print_var(Name,Var):- write_src('$VAR'(Name)), write(' = '), write_asrc(Var), nl. write_asrc(Var):- copy_term(Var,Copy,Goals),Var=Copy,write_asrc(Var,Goals). write_asrc(Var,[]):- write_src(Var). @@ -1893,79 +1759,42 @@ % Entry point for the user to call with tracing enabled toplevel_goal(Goal) :- term_variables(Goal,Vars), - trace_goal(Vars, Goal, trace_off). + trace_goal(Vars, Goal, trace_off). % Entry point for the user to call with tracing enabled trace_goal(Goal) :- - trace_goal(Goal, trace_on). + trace_goal(Goal, trace_on). % Handle tracing trace_goal(Goal, Tracing) :- - (Tracing == trace_on -> writeln('Entering goal:'), writeln(Goal) ; true), - term_variables(Goal, Variables), - ( call(Goal) -> + (Tracing == trace_on -> writeln('Entering goal:'), writeln(Goal) ; true), + term_variables(Goal, Variables), + ( call(Goal) -> (Tracing == trace_on -> writeln('Goal succeeded with:'), writeln(Variables) ; true), interact(Variables, Goal, Tracing) - ; (Tracing == trace_on -> writeln('Goal failed.') ; true), + ; (Tracing == trace_on -> writeln('Goal failed.') ; true), false - ). + ). % Interaction with the user interact(Variables, Goal, Tracing) :- - call(Goal),write('Solution: '), write_src(Variables), - write(' [;next]?'), - get_single_char(Code), - (command(Code, Command) -> + call(Goal),write('Solution: '), write_src(Variables), + write(' [;next]?'), + get_single_char(Code), + (command(Code, Command) -> handle_command(Command, Variables, Goal, Tracing) - ; writeln('Unknown command.'), interact(Variables, Goal, Tracing) % handle unknown commands - ). + ; writeln('Unknown command.'), interact(Variables, Goal, Tracing) % handle unknown commands + ). +install_readline(Input):- + add_history_string("!(pfb3)"), + add_history_string("!(load-flybase-full)"), + add_history_string("!(obo-alt-id $X BS:00063)"), + add_history_string("!(and (total-rows $T TR$) (unique-values $T2 $Col $TR))"), + nop(ignore(editline:el_wrap)), + nop(ignore(editline:add_prolog_commands(Input))). -:- dynamic(is_installed_readline_editline/1). -:- volatile(is_installed_readline_editline/1). -install_readline_editline:- current_input(Input), install_readline(Input),!. -install_readline(Input):- is_installed_readline_editline(Input),!. -install_readline(_):- is_compatio,!. -install_readline(_):-!. -install_readline(Input):- - assert(is_installed_readline_editline(Input)), - install_readline_editline1, - use_module(library(readline)), - use_module(library(editline)), - nop(catch(load_history,_,true)), - add_history_string("!(pfb3)"), - add_history_string("!(load-flybase-full)"), - add_history_string("!(obo-alt-id $X BS:00063)"), - add_history_string("!(and (total-rows $T TR$) (unique-values $T2 $Col $TR))"), - nop(ignore(editline:el_wrap)), - nop(ignore(editline:add_prolog_commands(Input))). - - -:- dynamic setup_done/0. -:- volatile setup_done/0. - -install_readline_editline1 :- - setup_done, - !. -install_readline_editline1 :- - asserta(setup_done), - '$toplevel':( - '$clean_history', - apple_setup_app, - '$run_initialization', - '$load_system_init_file', - set_toplevel, - '$set_file_search_paths', - init_debug_flags, - start_pldoc, - opt_attach_packs, - load_init_file, - catch(setup_backtrace, E1, print_message(warning, E1)), - catch(setup_readline, E2, print_message(warning, E2)), - catch(setup_history, E3, print_message(warning, E3)), - catch(setup_colors, E4, print_message(warning, E4))), - install_readline(user_input). % Command descriptions @@ -1989,92 +1818,92 @@ % Command implementations handle_command(make, Variables, Goal, Tracing) :- - writeln('Recompiling...'), - % Insert the logic to recompile the code. - % This might involve calling `make/0` or similar. - make, % This is assuming your Prolog environment has a `make` predicate. - fail. % interact(Variables, Goal, Tracing). + writeln('Recompiling...'), + % Insert the logic to recompile the code. + % This might involve calling `make/0` or similar. + make, % This is assuming your Prolog environment has a `make` predicate. + fail. % interact(Variables, Goal, Tracing). handle_command(compile, Variables, Goal, Tracing) :- - writeln('Compiling new executable...'), - % Insert the logic to compile a new executable. - % This will depend on how you compile Prolog programs in your environment. - % For example, you might use `qsave_program/2` to create an executable. - % Pseudocode: compile_executable(ExecutableName) - fail. % interact(Variables, Goal, Tracing). + writeln('Compiling new executable...'), + % Insert the logic to compile a new executable. + % This will depend on how you compile Prolog programs in your environment. + % For example, you might use `qsave_program/2` to create an executable. + % Pseudocode: compile_executable(ExecutableName) + fail. % interact(Variables, Goal, Tracing). handle_command(alternatives, Variables, Goal, Tracing) :- - writeln('Showing alternatives...'), - % Here you would include the logic for displaying the alternatives. - % For example, showing other clauses that could be tried for the current goal. - writeln('Alternatives for current goal:'), - writeln(Goal), - % Pseudocode: find_alternatives(Goal, Alternatives) - % Pseudocode: print_alternatives(Alternatives) - fail. % interact(Variables, Goal, Tracing). + writeln('Showing alternatives...'), + % Here you would include the logic for displaying the alternatives. + % For example, showing other clauses that could be tried for the current goal. + writeln('Alternatives for current goal:'), + writeln(Goal), + % Pseudocode: find_alternatives(Goal, Alternatives) + % Pseudocode: print_alternatives(Alternatives) + fail. % interact(Variables, Goal, Tracing). % Extend the command handling with the 'help' command implementation handle_command(help, Variables, Goal, Tracing) :- - print_help, - fail. % interact(Variables, Goal, Tracing). + print_help, + fail. % interact(Variables, Goal, Tracing). handle_command(abort, _, _, _) :- - writeln('Aborting...'), abort. + writeln('Aborting...'), abort. handle_command(break, Variables, Goal, Tracing) :- - writeln('Breakpoint set.'), % Here you should define what 'setting a breakpoint' means in your context - fail. % interact(Variables, Goal, Tracing). + writeln('Breakpoint set.'), % Here you should define what 'setting a breakpoint' means in your context + fail. % interact(Variables, Goal, Tracing). handle_command(creep, Variables, Goal, Tracing) :- - writeln('Creeping...'), % Here you should define how to 'creep' (step by step execution) through the code - trace. % interact(Variables, Goal, Tracing). + writeln('Creeping...'), % Here you should define how to 'creep' (step by step execution) through the code + trace. % interact(Variables, Goal, Tracing). handle_command(retry, Variables, Goal, Tracing) :- - writeln('Continuing...'),!. - %trace_goal(Goal, Tracing). + writeln('Continuing...'),!. + %trace_goal(Goal, Tracing). handle_command(skip, Variables, Goal, Tracing) :- - writeln('Skipping...'). + writeln('Skipping...'). handle_command(leap, _, _, _) :- - writeln('Leaping...'), nontrace. % Cut to ensure we stop the debugger + writeln('Leaping...'), nontrace. % Cut to ensure we stop the debugger handle_command(goals, Variables, Goal, Tracing) :- - writeln('Current goal:'), writeln(Goal), - writeln('Current variables:'), writeln(Variables), - bt,fail. % interact(Variables, Goal, Tracing). + writeln('Current goal:'), writeln(Goal), + writeln('Current variables:'), writeln(Variables), + bt,fail. % interact(Variables, Goal, Tracing). handle_command(fail, _, _, _) :- - writeln('Forcing failure...'), fail. + writeln('Forcing failure...'), fail. handle_command(trace, Variables, Goal, Tracing) :- - (Tracing == trace_on -> + (Tracing == trace_on -> NewTracing = trace_off, writeln('Tracing disabled.') - ; NewTracing = trace_on, writeln('Tracing enabled.') - ), - interact(Variables, Goal, NewTracing). + ; NewTracing = trace_on, writeln('Tracing enabled.') + ), + interact(Variables, Goal, NewTracing). handle_command(up, Variables, Goal, Tracing) :- - writeln('Continuing up...'), - repeat, - ( trace_goal(Goal, Tracing) -> true ; !, fail ). + writeln('Continuing up...'), + repeat, + ( trace_goal(Goal, Tracing) -> true ; !, fail ). handle_command(exit, _, _, _) :- - writeln('Exiting debugger...'), !. % Cut to ensure we exit the debugger + writeln('Exiting debugger...'), !. % Cut to ensure we exit the debugger :- style_check(+singleton). % Help description print_help :- - writeln('Debugger commands:'), - writeln('(;) next - Retry with next solution.'), - writeln('(g) goal - Show the current goal.'), - writeln('(u) up - Finish this goal without interruption.'), - writeln('(s) skip - Skip to the next solution.'), - writeln('(c) creep or - Proceed step by step.'), - writeln('(l) leap - Leap over (the debugging).'), - writeln('(f) fail - Force the current goal to fail.'), - writeln('(B) back - Go back to the previous step.'), - writeln('(t) trace - Toggle tracing on or off.'), - writeln('(e) exit - Exit the debugger.'), - writeln('(a) abort - Abort the current operation.'), - writeln('(b) break - Break to a new sub-REPL.'), - writeln('(h) help - Display this help message.'), - writeln('(A) alternatives - Show alternative solutions.'), - writeln('(m) make - Recompile/Update the current running code.'), - writeln('(C) compile - Compile a fresh executable (based on the running state).'), - writeln('(E) error msg - Show the latest error messages.'), - writeln('(r) retry - Retry the previous command.'), - writeln('(I) info - Show information about the current state.'), - !. + writeln('Debugger commands:'), + writeln('(;) next - Retry with next solution.'), + writeln('(g) goal - Show the current goal.'), + writeln('(u) up - Finish this goal without interruption.'), + writeln('(s) skip - Skip to the next solution.'), + writeln('(c) creep or - Proceed step by step.'), + writeln('(l) leap - Leap over (the debugging).'), + writeln('(f) fail - Force the current goal to fail.'), + writeln('(B) back - Go back to the previous step.'), + writeln('(t) trace - Toggle tracing on or off.'), + writeln('(e) exit - Exit the debugger.'), + writeln('(a) abort - Abort the current operation.'), + writeln('(b) break - Break to a new sub-REPL.'), + writeln('(h) help - Display this help message.'), + writeln('(A) alternatives - Show alternative solutions.'), + writeln('(m) make - Recompile/Update the current running code.'), + writeln('(C) compile - Compile a fresh executable (based on the running state).'), + writeln('(E) error msg - Show the latest error messages.'), + writeln('(r) retry - Retry the previous command.'), + writeln('(I) info - Show information about the current state.'), + !. @@ -2083,7 +1912,7 @@ % !(pragma! exec rtrace) may_rtrace(Goal):- really_trace,!, really_rtrace(Goal). may_rtrace(Goal):- Goal*->true;( \+ tracing, trace,really_rtrace(Goal)). -really_rtrace(Goal):- is_transpiling,!,rtrace(call(Goal)). +really_rtrace(Goal):- use_metta_compiler,!,rtrace(call(Goal)). really_rtrace(Goal):- with_debug((eval),with_debug((exec),Goal)). rtrace_on_existence_error(G):- !, catch_err(G,E, (fbug(E=G), \+ tracing, trace, rtrace(G))). @@ -2092,18 +1921,17 @@ %prolog_only(Goal):- !,Goal. prolog_only(Goal):- if_trace(prolog,Goal). - write_compiled_exec(Exec,Goal):- % ignore(Res = '$VAR'('ExecRes')), compile_for_exec(Res,Exec,Goal), - notrace((color_g_mesg('#114411',print_pl_source(answer2(Res):-Goal)))). + notrace((color_g_mesg('#114411',portray_clause(exec(Res):-Goal)))). verbose_unify(Term):- verbose_unify(trace,Term). verbose_unify(What,Term):- term_variables(Term,Vars),maplist(verbose_unify0(What),Vars),!. verbose_unify0(What,Var):- put_attr(Var,verbose_unify,What). verbose_unify:attr_unify_hook(Attr, Value) :- - format('~N~q~n',[verbose_unify:attr_unify_hook(Attr, Value)]), - vu(Attr,Value). + format('~N~q~n',[verbose_unify:attr_unify_hook(Attr, Value)]), + vu(Attr,Value). vu(_Attr,Value):- is_ftVar(Value),!. vu(fail,_Value):- !, fail. vu(true,_Value):- !. @@ -2141,13 +1969,12 @@ time_eval(Goal):- time_eval('Evaluation',Goal). time_eval(What,Goal) :- - timed_call(Goal,Seconds), - give_time(What,Seconds). + timed_call(Goal,Seconds), + give_time(What,Seconds). -give_time(_What,_Seconds):- is_compatio,!. give_time(What,Seconds):- - Milliseconds is Seconds * 1_000, - (Seconds > 2 + Milliseconds is Seconds * 1_000, + (Seconds > 2 -> format('~N; ~w took ~2f seconds.~n~n', [What, Seconds]) ; (Milliseconds >= 1 -> format('~N; ~w took ~3f secs. (~2f milliseconds) ~n~n', [What, Seconds, Milliseconds]) @@ -2155,15 +1982,14 @@ format('~N; ~w took ~6f secs. (~2f microseconds) ~n~n', [What, Seconds, Micro])))). timed_call(Goal,Seconds):- - statistics(cputime, Start), - call(Goal), - statistics(cputime, End), - Seconds is End - Start. + statistics(cputime, Start), + call(Goal), + statistics(cputime, End), + Seconds is End - Start. %:- nb_setval(cmt_override,lse('; ',' !(" ',' ") ')). :- abolish(fbug/1). -fbug(_):- is_compatio,!. fbug(Info):- notrace(in_cmt(color_g_mesg('#2f2f2f',write_src(Info)))). example0(_):- fail. example1(a). example1(_):- fail. @@ -2182,7 +2008,7 @@ XX=Prev, (Det==yes -> (!, (XX=Prev;XX=X)) ; (((var(Nth) -> ( ! , Prev\==dead) ; - true), + true), (Nth==1 -> ! ; true)))). call_nth(USol,XX,Nth,Det,Prev):- @@ -2218,13 +2044,13 @@ %print_preds_to_functs:-preds_to_functs_src(factorial_tail_basic) ggtrace(G):- call(G). ggtrace0(G):- ggtrace, - leash(-all), + leash(-all), visible(-all), - % debug, + % debug, %visible(+redo), visible(+call), visible(+exception), - maybe_leash(+exception), + maybe_leash(+exception), setup_call_cleanup(trace,G,notrace). :- dynamic(began_loon/1). loon:- loon(typein). @@ -2251,20 +2077,17 @@ maplist(catch_red_ignore,[ %if_t(is_compiled,ensure_metta_learner), - install_readline_editline, - % nts, - metta_final, - nop(load_history), - set_prolog_flag(history, 3), - (set_output_stream), - update_changed_files, + nts, + metta_final, + load_history, + update_changed_files, run_cmd_args, maybe_halt(7)]))),!. need_interaction:- \+ option_value('had_interaction',true), \+ is_converting, \+ is_compiling, \+ is_pyswip,!, - option_value('prolog',false), option_value('repl',false), \+ metta_file(_Self,_Filename,_Directory). + option_value('prolog',false), option_value('repl',false), \+ metta_file(_Self,_Filename,_Directory). pre_halt1:- is_compiling,!,fail. pre_halt1:- loonit_report,fail. @@ -2292,43 +2115,43 @@ %needs_repl:- \+ is_converting, \+ is_pyswip, \+ is_compiling, \+ has_file_arg. % libswipl: ['./','-q',--home=/usr/local/lib/swipl] -:- initialization(do_show_os_argv). +:- initialization(show_os_argv). :- initialization(loon(program),program). :- initialization(loon(default)). ensure_mettalog_system:- - abolish(began_loon/1), - dynamic(began_loon/1), - system:use_module(library(quasi_quotations)), - system:use_module(library(hashtable)), - system:use_module(library(gensym)), - system:use_module(library(sort)), - system:use_module(library(writef)), - system:use_module(library(rbtrees)), - system:use_module(library(dicts)), - system:use_module(library(shell)), - system:use_module(library(edinburgh)), + abolish(began_loon/1), + dynamic(began_loon/1), + system:use_module(library(quasi_quotations)), + system:use_module(library(hashtable)), + system:use_module(library(gensym)), + system:use_module(library(sort)), + system:use_module(library(writef)), + system:use_module(library(rbtrees)), + system:use_module(library(dicts)), + system:use_module(library(shell)), + system:use_module(library(edinburgh)), % system:use_module(library(lists)), - system:use_module(library(statistics)), - system:use_module(library(nb_set)), - system:use_module(library(assoc)), - system:use_module(library(pairs)), - user:use_module(library(swi_ide)), - user:use_module(library(prolog_profile)), - %metta_python, - %ensure_loaded('./metta_vspace/pyswip/flybase_convert'), - %ensure_loaded('./metta_vspace/pyswip/flybase_main'), - ensure_loaded(library(metta_python)), - ensure_loaded(library(flybase_convert)), - ensure_loaded(library(flybase_main)), - autoload_all, - make, - autoload_all, - %pack_install(predicate_streams, [upgrade(true),global(true)]), - %pack_install(logicmoo_utils, [upgrade(true),global(true)]), - %pack_install(dictoo, [upgrade(true),global(true)]), - !. + system:use_module(library(statistics)), + system:use_module(library(nb_set)), + system:use_module(library(assoc)), + system:use_module(library(pairs)), + user:use_module(library(swi_ide)), + user:use_module(library(prolog_profile)), + %metta_python, + %ensure_loaded('./metta_vspace/pyswip/flybase_convert'), + %ensure_loaded('./metta_vspace/pyswip/flybase_main'), + ensure_loaded(library(metta_python)), + ensure_loaded(library(flybase_convert)), + ensure_loaded(library(flybase_main)), + autoload_all, + make, + autoload_all, + %pack_install(predicate_streams, [upgrade(true),global(true)]), + %pack_install(logicmoo_utils, [upgrade(true),global(true)]), + %pack_install(dictoo, [upgrade(true),global(true)]), + !. file_save_name(E,_):- \+ atom(E),!,fail. file_save_name(E,Name):- file_base_name(E,BN),BN\==E,!,file_save_name(BN,Name). @@ -2346,27 +2169,21 @@ atomic(SavMeTTaLog),atom_length(SavMeTTaLog,Len),Len>1,!. next_save_name('Sav.MeTTaLog'). qcompile_mettalog:- - ensure_mettalog_system, - option_value(exeout,Named), - catch_err(qsave_program(Named, + ensure_mettalog_system, + option_value(exeout,Named), + catch_err(qsave_program(Named, [class(development),autoload(true),goal(loon(goal)), toplevel(loon(toplevel)), stand_alone(true)]),E,writeln(E)), - halt(0). + halt(0). qsave_program:- ensure_mettalog_system, next_save_name(Name), - catch_err(qsave_program(Name, + catch_err(qsave_program(Name, [class(development),autoload(true),goal(loon(goal)), toplevel(loon(toplevel)), stand_alone(false)]),E,writeln(E)), - !. + !. + -:- include(metta_data). -:- ensure_loaded(metta_compiler). -:- ensure_loaded(metta_convert). -:- ensure_loaded(metta_types). -:- ensure_loaded(metta_space). -:- ensure_loaded(metta_eval). :- ensure_loaded(flybase_main). :- ensure_loaded(metta_server). :- ensure_loaded(metta_python). :- initialization(update_changed_files,restore). -:- set_prolog_flag(history, 3). nts:- !. nts:- redefine_system_predicate(system:notrace/1), @@ -2374,54 +2191,22 @@ meta_predicate(system:notrace(0)), asserta((system:notrace(G):- (!,once(G)))). -override_portray:- - forall( - clause(user:portray(List), Where:Body, Cl), - (assert(user:portray_prev(List):- Where:Body), - erase(Cl))), - asserta((user:portray(List) :- metta_portray(List))). - - message_hook(A, B, C) :- - user: - ( B==error, - fbug(user:message_hook(A, B, C)), - fail - ). - -override_message_hook:- - forall( - clause(user:message_hook(A,B,C), Where:Body, Cl), - (assert(user:message_hook(A,B,C):- Where:Body), erase(Cl))), - asserta((user:message_hook(A,B,C) :- metta_message_hook(A,B,C))). - -fix_message_hook:- - clause(message_hook(A, B, C), - user: - ( B==error, - fbug(user:message_hook(A, B, C)), - fail - ), Cl),erase(Cl). - - - :- ignore((( \+ prolog_load_context(reloading,true), - set_is_unit_test(false), - initialization(loon(restore),restore), - % nts, + initialization(loon(restore),restore), + nts, metta_final ))). :- set_prolog_flag(metta_interp,ready). - :- use_module(library(clpr)). % Import the CLP(R) library % Define a predicate to relate the likelihoods of three events complex_relationship3_ex(Likelihood1, Likelihood2, Likelihood3) :- - { Likelihood1 = 0.3 * Likelihood2 }, - { Likelihood2 = 0.5 * Likelihood3 }, - { Likelihood3 < 1.0 }, - { Likelihood3 > 0.0 }. + { Likelihood1 = 0.3 * Likelihood2 }, + { Likelihood2 = 0.5 * Likelihood3 }, + { Likelihood3 < 1.0 }, + { Likelihood3 > 0.0 }. % Example query to find the likelihoods that satisfy the constraints %?- complex_relationship(L1, L2, L3). diff --git a/metta_vspace/pyswip/metta_printer.pl b/metta_vspace/pyswip/metta_printer.pl index d54735d9..70ed5d82 100755 --- a/metta_vspace/pyswip/metta_printer.pl +++ b/metta_vspace/pyswip/metta_printer.pl @@ -44,237 +44,6 @@ % 'pp_metta' rule is responsible for pretty-printing metta terms. pp_metta(P):- pretty_numbervars(P,PP),with_option(concepts=false,pp_fb(PP)). -string_height(Pt1,H1):- split_string(Pt1,"\r\n", "\s\t\n\n", L),length(L,H1). - -:- dynamic(just_printed/1). -% 'print_pl_source' rule is responsible for printing the source of a Prolog term. - - -print_pl_source(P):- run_pl_source(print_pl_source0(P)). - - -run_pl_source(G):- notrace(catch(G,_,fail)),!. -run_pl_source(G):- ignore(rtrace(G)), trace. - - -print_pl_source0(_):- notrace(is_compatio),!. -print_pl_source0(_):- notrace(silent_loading),!. -print_pl_source0(P):- notrace((just_printed(PP), PP=@=P)),!. -print_pl_source0(P):- - Actions = [print_tree, portray_clause, pp_fb1], % List of actions to apply - findall(H-Pt, - (member(Action, Actions), - must_det_ll(( - run_pl_source(with_output_to(string(Pt), call(Action, P))), - string_height(Pt, H)))), HeightsAndOutputs), - sort(HeightsAndOutputs, Lst), last(Lst, _-Pt), writeln(Pt), - retractall(just_printed(_)), - assert(just_printed(P)), - !. - - -pp_fb(P):- format("~N "), \+ \+ (numbervars_w_singles(P), pp_fb1(P)), format("~N "),flush_output. - -pp_fb1(P):- pp_fb2(print_tree,P). -pp_fb1(P):- pp_fb2(pp_ilp,P). -pp_fb1(P):- pp_fb2(pp_as,P). -pp_fb1(P):- pp_fb2(portray_clause,P). -pp_fb1(P):- pp_fb2(print,P). -pp_fb1(P):- pp_fb2(fbdebug1,P). -pp_fb1(P):- pp_fb2(fmt0(P)). -pp_fb2(F,P):- atom(F),current_predicate(F/1), call(F,P). - - - -pp_sax(V) :- is_final_write(V),!. -pp_sax(S) :- \+ allow_concepts,!, write_src(S). -pp_sax(S) :- is_englishy(S),!,print_concept("StringValue",S). -pp_sax(S) :- symbol_length(S,1),symbol_string(S,SS),!,print_concept("StringValue",SS). -pp_sax(S) :- is_an_arg_type(S,T),!,print_concept("TypeNode",T). -pp_sax(S) :- has_type(S,T),!,format('(~wValueNode "~w")',[T,S]). -pp_sax(S) :- sub_atom(S,0,4,Aft,FB),flybase_identifier(FB,Type),!,(Aft>0->format('(~wValueNode "~w")',[Type,S]);format('(TypeNode "~w")',[Type])). -pp_sax(S) :- print_concept("ConceptNode",S). - -%print_concept( CType,V):- allow_concepts, !, write("("),write(CType),write(" "),ignore(with_concepts(false,write_src(V))),write(")"). -print_concept(_CType,V):- ignore(write_src(V)). -write_val(V):- number(V),!, write_src(V). -write_val(V):- compound(V),!, write_src(V). -write_val(V):- write('"'),write(V),write('"'). - - -% Handling the final write when the value is a variable or a '$VAR' structure. -is_final_write(V):- var(V), !, write_dvar(V),!. -is_final_write('$VAR'(S)):- !, write_dvar(S),!. -is_final_write([VAR,V|T]):- '$VAR'==VAR, T==[], !, write_dvar(V). -is_final_write([]):- write('Nil'). -is_final_write('[|]'):- write('Cons'). - - -write_dvar(S):- S=='_', !, write_dname(S). -write_dvar(S):- S=='__', !, write('$'). -write_dvar(S):- var(S), get_var_name(S,N),write_dname(N),!. -write_dvar(S):- var(S), !, format('$~p',[S]). -write_dvar(S):- atom(S), atom_concat('_',N,S),write_dname(N). -write_dvar(S):- string(S), atom_concat('_',N,S),write_dname(N). -%write_dvar(S):- number(S), write_dname(S). -write_dvar(S):- write_dname(S). -write_dname(S):- write('$'),write(S). - -pp_as(V) :- \+ \+ pp_sex(V),flush_output. -pp_sex_nc(V):- with_no_quoting_symbols(true,pp_sex(V)),!. - - - -unlooped_fbug(Mesg):- nb_current(fbug_message_hook,true),!,print(Mesg),nl. -unlooped_fbug(Mesg):- - setup_call_cleanup(nb_setval(fbug_message_hook,true), - once(fbug(Mesg)),nb_setval(fbug_message_hook,false)). - - -write_src(V):- quietly(pp_sex(V)),!. - -pp_sex(V):- is_dict(V),!,print(V). -pp_sex(V):- pp_sexi(V),!. -% Various 'write_src' and 'pp_sex' rules are handling the writing of the source, -% dealing with different types of values, whether they are lists, atoms, numbers, strings, compounds, or symbols. -pp_sexi(V):- is_final_write(V),!. -pp_sexi(V):- allow_concepts,!,with_concepts('False',pp_sex(V)),flush_output. -pp_sexi('Empty') :- !. -pp_sexi('') :- !, writeq(''). -% Handling more cases for 'pp_sex', when the value is a number, a string, a symbol, or a compound. -%pp_sex('') :- format('(EmptyNode null)',[]). -pp_sexi(V):- number(V),!, writeq(V). -pp_sexi(V):- string(V),!, writeq(V). -pp_sexi(S):- string(S),!, print_concept('StringValue',S). -pp_sexi(V):- symbol(V), should_quote(V),!, symbol_string(V,S), write("'"),write(S),write("'"). -% Base case: atoms are printed as-is. -%pp_sexi(S):- symbol(S), always_dash_functor(S,D), D \=@= S, pp_sax(D),!. -pp_sexi(V):- symbol(V),!,write(V). -pp_sexi(V) :- (number(V) ; is_dict(V)), !, print_concept('ValueAtom',V). -%pp_sex((Head:-Body)) :- !, print_metta_clause0(Head,Body). -%pp_sex(''):- !, write('()'). - -% Continuing with 'pp_sex', 'write_mobj', and related rules, -% handling different cases based on the value�s type and structure, and performing the appropriate writing action. -% Lists are printed with parentheses. -pp_sexi(V) :- \+ compound(V), !, format('~p',[V]). -pp_sexi(V):- \+ is_list(V),!, pp_sex_c(V). -%pp_sex(V) :- (symbol(V),symbol_number(V,N)), !, print_concept('ValueAtom',N). -%pp_sex(V) :- V = '$VAR'(_), !, format('$~p',[V]). -pp_sexi(V) :- no_src_indents,!,pp_sex_c(V). - -pp_sexi(V) :- w_proper_indent(2,w_in_p(pp_sex_c(V))). - -write_mobj(H,_):- \+ symbol(H),!,fail. -write_mobj('$VAR',[S]):- write_dvar(S). -write_mobj(exec,[V]):- !, write('!'),write_src(V). -write_mobj('$OBJ',[_,S]):- write('['),write_src(S),write(' ]'). -write_mobj('{}',[S]):- write('{'),write_src(S),write(' }'). -write_mobj('{...}',[S]):- write('{'),write_src(S),write(' }'). -write_mobj('[...]',[S]):- write('['),write_src(S),write(' ]'). -write_mobj('$STRING',[S]):- !, writeq(S). -write_mobj(F,Args):- fail, mlog_sym(K),!,pp_sex_c([K,F|Args]). -%write_mobj(F,Args):- pp_sex_c([F|Args]). - -pp_sex_l(V):- pp_sexi_l(V),!. -pp_sexi_l(V) :- is_final_write(V),!. -pp_sexi_l([F|V]):- symbol(F), is_list(V),write_mobj(F,V),!. -pp_sexi_l([H|T]):-T ==[],!,write('('), pp_sex_nc(H),write(')'). -pp_sexi_l([H,S]):-H=='[...]', write('['),print_items_list(S),write(' ]'). -pp_sexi_l([H,S]):-H=='{...}', write('{'),print_items_list(S),write(' }'). -%pp_sex_l(X):- \+ compound(X),!,write_src(X). -%pp_sex_l('$VAR'(S))):- -pp_sexi_l([=,H,B]):- - write('(= '), with_indents(false,write_src(H)), nl, write(' '), - with_indents(true,write_src(B)),write(')'). -pp_sexi_l([H|T]) :- \+ no_src_indents, symbol(H),member(H,['If','cond','let','let*']),!, - with_indents(true,w_proper_indent(2,w_in_p(pp_sex_c([H|T])))). - -pp_sexi_l([H|T]) :- is_list(T), length(T,Args),Args =< 2, fail, - wots(SS,((with_indents(false,(write('('), pp_sex_nc(H), write(' '), print_list_as_sexpression(T), write(')')))))), - ((atom_length(SS,Len),Len < 20) ->write(SS); - with_indents(true,w_proper_indent(2,w_in_p(pp_sex_c([H|T]))))),!. -/* - -pp_sexi_l([H|T]) :- is_list(T),symbol(H),upcase_atom(H,U),downcase_atom(H,U),!, - with_indents(false,(write('('), pp_sex_nc(H), write(' '), print_list_as_sexpression(T), write(')'))). - -%pp_sex([H,B,C|T]) :- T==[],!, -% with_indents(false,(write('('), pp_sex(H), print_list_as_sexpression([B,C]), write(')'))). -*/ -pp_sexi_l([H,H2]):- write('('), pp_sex_nc(H), write(' '), with_indents(false,print_list_as_sexpression([H2])), write(')'). -pp_sexi_l([H|T]):- write('('), pp_sex_nc(H), write(' '), print_list_as_sexpression(T), write(')'). - -print_items_list(X):- is_list(X),!,print_list_as_sexpression(X). -print_items_list(X):- write_src(X). - -pp_sex_c(V):- pp_sexi_c(V),!. -pp_sexi_c(V) :- is_final_write(V),!. -pp_sexi_c([H|T]) :- is_list(T),!,pp_sex_l([H|T]). -pp_sexi_c(=(H,B)):- !, pp_sex_l([=,H,B]). -pp_sexi_c(V):- compound_name_list(V,F,Args),write_mobj(F,Args),!. -% Compound terms. -%pp_sex(Term) :- compound(Term), Term =.. [Functor|Args], write('('),format('(~w ',[Functor]), write_args_as_sexpression(Args), write(')'). -%pp_sex(Term) :- Term =.. ['=',H|Args], length(Args,L),L>2, write('(= '), pp_sex(H), write('\n\t\t'), maplist(pp_sex(2),Args). -pp_sexi_c(V):- ( \+ compound(V) ; is_list(V)),!, pp_sex(V). -pp_sexi_c(listOf(S,_)) :- !,write_mobj(listOf(S)). -pp_sexi_c(listOf(S)) :- !,format('(ListValue ~@)',[pp_sex(S)]). -pp_sexi_c('!'(V)) :- write('!'),!,pp_sex(V). -%pp_sex_c('exec'(V)) :- write('!'),!,pp_sex(V). -pp_sexi_c('='(N,V)):- allow_concepts, !, format("~N;; ~w == ~n",[N]),!,pp_sex(V). -%pp_sex_c(V):- writeq(V). - -pp_sexi_c(Term) :- compound_name_arity(Term,F,0),!,pp_sex_c([F]). -pp_sexi_c(Term) :- Term =.. [Functor|Args], always_dash_functor(Functor,DFunctor), format('(~w ',[DFunctor]), write_args_as_sexpression(Args), write(')'),!. -pp_sexi_c(Term) :- allow_concepts, Term =.. [Functor|Args], format('(EvaluationLink (PredicateNode "~w") (ListLink ',[Functor]), write_args_as_sexpression(Args), write('))'),!. -pp_sexi_c(Term) :- - Term =.. [Functor|Args], - always_dash_functor(Functor,DFunctor), format('(~w ',[DFunctor]), - write_args_as_sexpression(Args), write(')'),!. - -pp_sexi(2,Result):- write('\t\t'),pp_sex(Result). - - -current_column(Column) :- current_output(Stream), line_position(Stream, Column),!. -current_column(Column) :- stream_property(current_output, position(Position)), stream_position_data(column, Position, Column). -min_indent(Sz):- current_column(Col),Col>Sz,nl,indent_len(Sz). -min_indent(Sz):- current_column(Col),Need is Sz-Col,indent_len(Need),!. -min_indent(Sz):- nl, indent_len(Sz). -indent_len(Need):- forall(between(1,Need,_),write(' ')). - -w_proper_indent(N,G):- - flag(w_in_p,X,X), %(X==0->nl;true), - XX is (X*2)+N,setup_call_cleanup(min_indent(XX),G,true). -w_in_p(G):- setup_call_cleanup(flag(w_in_p,X,X+1),G,flag(w_in_p,_,X)). - - -always_dash_functor(A,B):- once(dash_functor(A,B)),A\=@=B,!. -always_dash_functor(A,A). - -dash_functor(A,C):- \+ symbol(A),!,C=A. -%dash_functor(A,C):- p2m(A,B),A\==B,!,always_dash_functor(B,C). -dash_functor(Functor,DFunctor):- - symbol(Functor), atomic_list_concat(L,'-',Functor), L\=[_],maplist(always_dash_functor,L,LL), - atomic_list_concat(LL,'-',DFunctor). -dash_functor(Functor,DFunctor):- fail, - symbol(Functor), atomic_list_concat(L,'_',Functor), L\=[_],maplist(always_dash_functor,L,LL), - atomic_list_concat(LL,'-',DFunctor). -dash_functor(Functor,DFunctor):- - symbol(Functor), atomic_list_concat(L,'_',Functor), L\=[_],maplist(always_dash_functor,L,LL), - atomic_list_concat(LL,'_',DFunctor). - -% Print arguments of a compound term. -write_args_as_sexpression([]). -write_args_as_sexpression([H|T]) :- write(' '), pp_sex(H), write_args_as_sexpression(T). - -% Print the rest of the list. -print_list_as_sexpression([]). -print_list_as_sexpression([H]):- pp_sex(H). -%print_list_as_sexpression([H]):- w_proper_indent(pp_sex(H)),!. -print_list_as_sexpression([H|T]):- pp_sex(H), write(' '), print_list_as_sexpression(T). - - - % The predicate with_indents/2 modifies the src_indents option value during the execution of a goal. % The first argument is the desired value for src_indents, % and the second argument is the Goal to be executed with the given src_indents setting. @@ -282,17 +51,6 @@ % Set the value of the `src_indents` option to TF and then execute the Goal with_option(src_indents, TF, Goal). - -no_src_indents:- option_else(src_indents,TF,true),!,TF=='False'. - - - -no_quoting_symbols:- option_else(no_quoting_symbols,TF,true),!,TF=='True'. - -with_no_quoting_symbols(TF, Goal) :- - % Set the value of the `no_src_indents` option to TF and then execute the Goal - with_option(no_quoting_symbols, TF, Goal). - % The predicate allow_concepts/0 checks whether the use of concepts is allowed. % It does this by checking the value of the concepts option and ensuring it is not false. allow_concepts :- !, fail, @@ -307,14 +65,63 @@ % Set the value of the `concepts` option to TF and then execute the Goal with_option(concepts, TF, Goal). + +% Various 'write_src' and 'write_src0' rules are handling the writing of the source, +% dealing with different types of values, whether they are lists, atoms, numbers, strings, compounds, or symbols. +write_src(V):- notrace(write_src0(V)). +write_src0(V):- V ==[],!,write('()'). +write_src0(V):- allow_concepts,!,with_concepts('False',write_src1(V)),flush_output. +write_src0(V):- is_list(V),!,pp_sexi(V). +write_src0(V):- write_src1(V),!. + +% Handling the final write when the value is a variable or a '$VAR' structure. +is_final_write(V):- var(V), !, format('$~p',[V]). +is_final_write('$VAR'(S)):- S=='_', !, write('$'),write(S). +is_final_write('$VAR'(S)):- S=='__', !, write('$'). +is_final_write('$VAR'(S)):- var(S), write('$'),write(S). +is_final_write('$VAR'(S)):- number(S), write('$'),write(S). +is_final_write('$VAR'(S)):- atom(S), atom_concat('_',N,S),write('$'),write(N). +is_final_write('$VAR'(S)):- string(S), atom_concat('_',N,S),write('$'),write(N). + + +% Handling more cases for 'write_src1', when the value is a number, a string, a symbol, or a compound. +write_src1(V) :- is_final_write(V),!. +write_src1([F|V]):- atom(F), is_list(V),write_mobj(F,V),!. +write_src1((Head:-Body)) :- !, print_metta_clause0(Head,Body). +write_src1(''):- !, write('()'). +write_src1(V):- number(V),!, writeq(V). +write_src1(V):- string(V),!, writeq(V). + +% Continuing with 'write_src1', 'write_mobj', and related rules, +% handling different cases based on the value’s type and structure, and performing the appropriate writing action. +write_src1(V):- symbol(V), should_quote(V),!, + symbol_string(V,S),writeq(S). +write_src1(V):- symbol(V),!,write(V). +write_src1(V):- compound(V), \+ is_list(V),!,write_mobj(V). +write_src1(V):- pp_sex(V),!. + +write_mobj(V) :- is_final_write(V),!. +write_mobj(V):- ( \+ compound(V) ; is_list(V)),!, write_src0(V). + +write_mobj(V):- compound_name_list(V,F,Args),write_mobj(F,Args),!. +write_mobj(V):- writeq(V). +write_mobj(exec,[V]):- !, write('!'),write_src(V). +write_mobj('$OBJ',[_,S]):- write('['),write_src(S),write(' ]'). +write_mobj('{}',[S]):- write('{'),write_src(S),write(' }'). +write_mobj('{...}',[S]):- write('{'),write_src(S),write(' }'). +write_mobj('[...]',[S]):- write('['),write_src(S),write(' ]'). +write_mobj('$STRING',[S]):- !, writeq(S). +write_mobj(F,Args):- fail, mlog_sym(K),!,pp_sexi([K,F|Args]). +write_mobj(F,Args):- pp_sexi([F|Args]). + % Rules for determining when a symbol needs to be quoted in metta. dont_quote(Atom):- atom_length(Atom,1), !, char_type(Atom,punct). -dont_quote(Atom):- symbol(Atom),upcase_atom(Atom,Atom),downcase_atom(Atom,Atom). +dont_quote(Atom):- atom(Atom),upcase_atom(Atom,Atom),downcase_atom(Atom,Atom). -should_quote(Atom) :- \+ symbol(Atom), \+ string(Atom),!,fail. +should_quote(Atom) :- \+ atom(Atom), \+ string(Atom),!,fail. should_quote(Atom) :- \+ dont_quote(Atom), - % symbol(Atom), % Ensure that the input is an symbol + % atom(Atom), % Ensure that the input is an atom atom_chars(Atom, Chars), once(should_quote_chars(Chars);should_quote_atom_chars(Atom,Chars)). diff --git a/metta_vspace/pyswip/metta_python.pl b/metta_vspace/pyswip/metta_python.pl index bebce642..fea68909 100755 --- a/metta_vspace/pyswip/metta_python.pl +++ b/metta_vspace/pyswip/metta_python.pl @@ -2,10 +2,6 @@ :- flush_output. :- setenv('RUST_BACKTRACE',full). %:- '$set_source_module'('user'). -:- set_prolog_flag(py_backtrace_depth,10). -:- set_prolog_flag(py_backtrace, true). -:- set_prolog_flag(py_argv,[]). -%:- set_prolog_flag(argv,[]). /* # Core in Rust In the original version, the core logic and functionalities of the MeTTa system are implemented in Rust. Rust is known for its performance and safety features, making it a suitable choice for building robust, high-performance systems. @@ -337,9 +333,7 @@ setenv('PYTHONPATH', NewPythonPath). +:- set_prolog_flag(py_backtrace_depth,10). +:- set_prolog_flag(py_backtrace, true). %:- initialization(on_restore1,restore). %:- initialization(on_restore2,restore). - - - -% py_initialize(, +Argv, +Options) diff --git a/metta_vspace/pyswip/metta_server.pl b/metta_vspace/pyswip/metta_server.pl index 434f52c7..ac44b38e 100755 --- a/metta_vspace/pyswip/metta_server.pl +++ b/metta_vspace/pyswip/metta_server.pl @@ -43,7 +43,7 @@ tcp_socket(Socket), tcp_bind(Socket, Port), tcp_listen(Socket, 5), tcp_open_socket(Socket, ListenFd), - not_compatio(fbugio(run_vspace_service(MSpace,Port))), + fbugio(run_vspace_service(MSpace,Port)), retractall(vspace_port(_)), assert(vspace_port(Port)), accept_vspace_connections(MSpace,ListenFd). @@ -282,5 +282,5 @@ retractall(result(Tag, _, _, _)). -% :- initialization(start_vspace_service). +:- initialization(start_vspace_service). diff --git a/metta_vspace/pyswip/metta_space.pl b/metta_vspace/pyswip/metta_space.pl index fbb15ffc..c63a1c27 100755 --- a/metta_vspace/pyswip/metta_space.pl +++ b/metta_vspace/pyswip/metta_space.pl @@ -8,8 +8,7 @@ :- multifile(is_pre_statistic/2). :- dynamic(is_pre_statistic/2). -save_pre_statistic(Name):- is_pre_statistic(Name,_)-> true; (statistics(Name,AS),term_number(AS,FN), - pfcAdd(is_pre_statistic(Name,FN))). +save_pre_statistic(Name):- is_pre_statistic(Name,_)-> true; (statistics(Name,AS),term_number(AS,FN),assert(is_pre_statistic(Name,FN))). pre_statistic(N,V):- is_pre_statistic(N,V)-> true ; V = 0. post_statistic(N,V):- statistics(N,VV),term_number(VV,FV),pre_statistic(N,WV), V0 is FV-WV, (V0<0 -> V = 0 ; V0=V). term_number(T,N):- sub_term(N,T),number(N). @@ -23,25 +22,24 @@ :- dynamic(repeats/1). :- dynamic(not_repeats/1). assert_new(P):- call(P),!,assert_new1(repeats(P)). -assert_new(P):- pfcAdd(P), flag(assert_new,TA,TA+1),assert_new1(not_repeats(P)),!. +assert_new(P):- assert(P), flag(assert_new,TA,TA+1),assert_new1(not_repeats(P)),!. retract1(P):- \+ call(P),!. retract1(P):- ignore(\+ retract(P)). assert_new1(P):- \+ \+ call(P),!. -assert_new1(P):- pfcAdd(P). +assert_new1(P):- assert(P). :- dynamic(fb_pred/3). :- dynamic(mod_f_a/3). decl_m_fb_pred(Mod,Fn,A):- var(Mod),!,mod_f_a(Mod,Fn,A). -decl_m_fb_pred(Mod,Fn,A):- mod_f_a(Mod,Fn,A)->true;(dynamic(Mod:Fn/A), - pfcAdd(mod_f_a(Mod,Fn,A))). +decl_m_fb_pred(Mod,Fn,A):- mod_f_a(Mod,Fn,A)->true;(dynamic(Mod:Fn/A),assert(mod_f_a(Mod,Fn,A))). :- dynamic(fb_pred_file/3). decl_fb_pred(Fn,A):- - (fb_pred(Fn,A)-> true; (dynamic(Fn/A),pfcAdd(fb_pred(Fn,A)))), + (fb_pred(Fn,A)-> true; (dynamic(Fn/A),assert(fb_pred(Fn,A)))), ignore((nb_current(loading_file,File), - (fb_pred_file(Fn,A,File)-> true; pfcAdd(fb_pred_file(Fn,A,File))))). + (fb_pred_file(Fn,A,File)-> true; assert(fb_pred_file(Fn,A,File))))). % Import necessary libraries :- use_module(library(readutil)). @@ -308,39 +306,26 @@ %:- dynamic(for_metta/2). %for_metta(_,T):- fb_pred(F,A),functor(T,F,A),call(T). -metta_assertdb_ls(KB):- - AMA = asserted_metta_atom, - decl_m_fb_pred(user,AMA,2), - MP =.. [AMA,KB,_], - listing(MP). - -metta_assertdb_add(KB,AtomIn):- - must_det_ll((subst_vars(AtomIn,Atom), - AMA = asserted_metta_atom, - decl_m_fb_pred(user,AMA,2), - MP =.. [AMA,KB,Atom], - assert_new(MP))). +metta_assertdb_ls(KB):-listing(metta_atom(KB,_)). +metta_assertdb_add(KB,Atom):- subst_vars(Atom,New), + decl_m_fb_pred(user,get_metta_atom,2), + MP = metta_atom(KB,New), + assert_new(MP). metta_assertdb_rem(KB,Old):- metta_assertdb_del(KB,Old). -metta_assertdb_del(KB,Atom):- subst_vars(Atom,Old), decl_m_fb_pred(user,asserted_metta_atom,2), MP = metta_atom(KB,Old), +metta_assertdb_del(KB,Atom):- subst_vars(Atom,Old), decl_m_fb_pred(user,get_metta_atom,2), MP = metta_atom(KB,Old), copy_term(MP,Copy), clause(MP,true,Ref), MP=@= Copy, !, erase(Ref). % ,metta_assertdb('DEL',Old). metta_assertdb_replace(KB,Old,New):- metta_assertdb_del(KB,Old), metta_assertdb_add(KB,New). metta_assertdb_count(KB,Count):- must_det_ll(( - AMA = asserted_metta_atom, - decl_m_fb_pred(user,AMA,2), - MP =.. [AMA,KB,_], + decl_m_fb_pred(user,get_metta_atom,2), full_symbol_count(SL1), + MP = metta_atom(KB,_), predicate_property(MP,number_of_clauses(SL2)), predicate_property(MP,number_of_rules(SL3)), %metta_assertdb_ls(KB), - full_symbol_count(SL1), Count is SL1 + SL2 - SL3)),!. metta_assertdb_count(_KB,0):-!. %metta_assertdb_count(KB,Count):- writeln(metta_assertdb_count_in(KB,Count)), findall(Atom,for_metta(KB,Atom),AtomsL),length(AtomsL,Count),writeln(metta_assertdb_count_out(KB,Count)). -metta_assertdb_iter(KB,Atoms):- - AMA = asserted_metta_atom, - decl_m_fb_pred(user,AMA,2), - MP =.. [AMA,KB,Atoms], - call(MP). +metta_assertdb_iter(KB,Atoms):- decl_m_fb_pred(user,get_metta_atom,2), metta_atom(KB,Atoms). @@ -358,22 +343,19 @@ % Query from hyperon.base.GroundingSpace space_query_vars(KB,Query,Vars):- is_asserted_space(KB),!, + decl_m_fb_pred(user,get_metta_atom,2), call_metta(KB,Query,Vars), debug_metta('RES',space_query_vars(KB,Query,Vars)). -metta_assertdb_get_atoms(KB,AtomsL):- decl_m_fb_pred(user,asserted_metta_atom,2), findall(Atom,metta_atom(KB,Atom),AtomsL). +metta_assertdb_get_atoms(KB,AtomsL):- decl_m_fb_pred(user,get_metta_atom,2), findall(Atom,metta_atom(KB,Atom),AtomsL). /* -%metta_assertdb_iter_bind(KB,Query,Template,AtomsL):- decl_m_fb_pred(user,asserted_metta_atom,2), findall(Template,metta_atom(KB,Query),AtomsL). +%metta_assertdb_iter_bind(KB,Query,Template,AtomsL):- decl_m_fb_pred(user,get_metta_atom,2), findall(Template,metta_atom(KB,Query),AtomsL). metta_assertdb_iter_bind(KB,Query,Vars):- ignore(term_variables(Query,Vars)), print(metta_assertdb(['match',KB,Query,Vars])),nl, - AMA = asserted_metta_atom, - decl_m_fb_pred(user,AMA,2), - MP =.. [AMA,KB,Query], - - (MP*->true;call_metta_assertdb(KB,Query,Vars)), + decl_m_fb_pred(user,get_metta_atom,2), (metta_atom(KB,Query)*->true;call_metta_assertdb(KB,Query,Vars)), metta_assertdb('RES',metta_assertdb_iter_bind(KB,Query,Vars)). %metta_assertdb_iter_bind(KB,Atom,Template):- metta_assertdb_stats, findall(Template,metta_assertdb_iter(KB,Atom),VarList). @@ -428,6 +410,116 @@ % is a quine 'AtomDef'(X,['AtomDef',X]). +% =============================== +% PRINTERS +% =============================== + + +pp_sax(V) :- is_final_write(V),!. +pp_sax(S) :- \+ allow_concepts,!, write_src(S). +pp_sax(S) :- is_englishy(S),!,print_concept("StringValue",S). +pp_sax(S) :- symbol_length(S,1),symbol_string(S,SS),!,print_concept("StringValue",SS). +pp_sax(S) :- is_an_arg_type(S,T),!,print_concept("TypeNode",T). +pp_sax(S) :- has_type(S,T),!,format('(~wValueNode "~w")',[T,S]). +pp_sax(S) :- sub_atom(S,0,4,Aft,FB),flybase_identifier(FB,Type),!,(Aft>0->format('(~wValueNode "~w")',[Type,S]);format('(TypeNode "~w")',[Type])). +pp_sax(S) :- print_concept("ConceptNode",S). + +print_concept( CType,V):- allow_concepts, !, write("("),write(CType),write(" "),ignore(with_concepts(false,write_src(V))),write(")"). +print_concept(_CType,V):- ignore(write_src(V)). +write_val(V):- number(V),!, write_src(V). +write_val(V):- compound(V),!, write_src(V). +write_val(V):- write('"'),write(V),write('"'). + +% Base case: atoms are printed as-is. +pp_as(V) :- \+ \+ pp_sex(V),flush_output. +pp_sex(V) :- is_final_write(V),!. +pp_sex('!'(V)) :- write('!'),!,pp_sex(V). +pp_sex('exec'(V)) :- write('!'),!,pp_sex(V). +%pp_sex('') :- format('(EmptyNode null)',[]). +pp_sex('') :- !, format('""',[]). +pp_sex([]):- !, write('()'). +pp_sex('='(N,V)):- allow_concepts, !, format("~N;; ~w == ~n",[N]),!,pp_sex(V). +pp_sex(V) :- (number(V) ; is_dict(V)), !, print_concept('ValueAtom',V). +%pp_sex(V) :- (symbol(V),symbol_number(V,N)), !, print_concept('ValueAtom',N). +pp_sex(S) :- symbol(S), always_dash_functor(S,D), pp_sax(D),!. +pp_sex(S) :- string(S),!, print_concept('StringValue',S). +% Lists are printed with parentheses. +pp_sex(V) :- \+ compound(V), !, format('~p',[V]). +pp_sex(V) :- V = '$VAR'(_), !, format('$~p',[V]). +pp_sex('!'(V)) :- write('!'),!,pp_sex(V). +pp_sex(listOf(S,_)) :- !,pp_sex(listOf(S)). +pp_sex(listOf(S)) :- !,format('(ListValue ~@)',[pp_sex(S)]). + +pp_sex([H|T]) :- \+ no_src_indents, atom(H),member(H,['If','cond','let','let*']),!, + with_indents(true,w_proper_indent(2,w_in_p(pp_sexi([H|T])))). + +pp_sex([H|T]) :- is_list(T), length(T,Args),Args =< 2, fail, + wots(SS,((with_indents(false,(write('('), pp_sex(H), print_list_as_sexpression(T), write(')')))))), + ((atom_length(SS,Len),Len < 20) ->write(SS); + with_indents(true,w_proper_indent(2,w_in_p(pp_sexi([H|T]))))),!. +/* + +pp_sex([H|T]) :- is_list(T),atom(H),upcase_atom(H,U),downcase_atom(H,U),!, + with_indents(false,(write('('), pp_sex(H), print_list_as_sexpression(T), write(')'))). + +%pp_sex([H,B,C|T]) :- T==[],!, +% with_indents(false,(write('('), pp_sex(H), print_list_as_sexpression([B,C]), write(')'))). +*/ +pp_sex(V) :- no_src_indents,!,pp_sexi(V). + +pp_sex(V) :- w_proper_indent(2,w_in_p(pp_sexi(V))). + +no_src_indents:- option_else(src_indents,TF,true),!,TF=='False'. + +pp_sexi_l([H,S]):-H=='[...]', write('['),print_items_list(S),write(' ]'). +pp_sexi_l([H,S]):-H=='{...}', write('{'),print_items_list(S),write(' }'). +pp_sexi_l([H|T]):-write('('), pp_sex(H), print_list_as_sexpression(T), write(')'). + +print_items_list(X):- is_list(X),!,print_list_as_sexpression(X). +print_items_list(X):- write_src(X). + +pp_sexi(V) :- is_final_write(V),!. +pp_sexi([H|T]) :- is_list(T),!,pp_sexi_l([H|T]). +% Compound terms. +%pp_sex(Term) :- compound(Term), Term =.. [Functor|Args], write('('),format('(~w ',[Functor]), write_args_as_sexpression(Args), write(')'). +%pp_sex(Term) :- Term =.. ['=',H|Args], length(Args,L),L>2, write('(= '), pp_sex(H), write('\n\t\t'), maplist(pp_sex(2),Args). +pp_sexi(Term) :- Term==[],!,write('()'). +pp_sexi(Term) :- compound_name_arity(Term,F,0),!,pp_sexi([F]). +pp_sexi(Term) :- Term =.. [Functor|Args], always_dash_functor(Functor,DFunctor), format('(~w ',[DFunctor]), write_args_as_sexpression(Args), write(')'),!. +pp_sexi(Term) :- allow_concepts, Term =.. [Functor|Args], format('(EvaluationLink (PredicateNode "~w") (ListLink ',[Functor]), write_args_as_sexpression(Args), write('))'),!. +pp_sexi(Term) :- Term =.. [Functor|Args], + always_dash_functor(Functor,DFunctor), format('(~w ',[DFunctor]), write_args_as_sexpression(Args), write(')'),!. + +pp_sex(2,Result):- write('\t\t'),pp_sex(Result). + + +current_column(Column) :- current_output(Stream), line_position(Stream, Column),!. +current_column(Column) :- stream_property(current_output, position(Position)), stream_position_data(column, Position, Column). +min_indent(Sz):- current_column(Col),Col>Sz,nl,indent_len(Sz). +min_indent(Sz):- current_column(Col),Need is Sz-Col,indent_len(Need),!. +min_indent(Sz):- nl, indent_len(Sz). +indent_len(Need):- forall(between(1,Need,_),write(' ')). + +w_proper_indent(N,G):- + flag(w_in_p,X,X), %(X==0->nl;true), + XX is (X*2)+N,setup_call_cleanup(min_indent(XX),G,true). +w_in_p(G):- setup_call_cleanup(flag(w_in_p,X,X+1),G,flag(w_in_p,_,X)). + + +always_dash_functor(A,B):- once(dash_functor(A,B)),A\=@=B,!. +always_dash_functor(A,A). + +dash_functor(A,C):- \+ symbol(A),!,C=A. +dash_functor(A,C):- p2m(A,B),A\==B,!,always_dash_functor(B,C). +dash_functor(Functor,DFunctor):- + symbol(Functor), atomic_list_concat(L,'-',Functor), L\=[_],maplist(always_dash_functor,L,LL), + atomic_list_concat(LL,'-',DFunctor). +dash_functor(Functor,DFunctor):- fail, + symbol(Functor), atomic_list_concat(L,'_',Functor), L\=[_],maplist(always_dash_functor,L,LL), + atomic_list_concat(LL,'-',DFunctor). +dash_functor(Functor,DFunctor):- + symbol(Functor), atomic_list_concat(L,'_',Functor), L\=[_],maplist(always_dash_functor,L,LL), + atomic_list_concat(LL,'_',DFunctor). sort_on(C,R,A,B):- (A==B-> R= (=) ; must_det_ll((call(C,A,AA),call(C,B,BB),!,compare(R,AA+A,BB+B)))),!. tokens(X,VL):- unaccent_atom(X,A),!, findall(E,(is_tokenizer(T),call(T,A,E)),L),predsort(sort_on(length_fw_len),L,S),last(S,VL). @@ -456,6 +548,14 @@ is_an_arg_type(S,T):- flybase_identifier(S,T),!. has_type(S,Type):- sub_atom(S,0,4,Aft,FB),flybase_identifier(FB,Type),!,Aft>0. +% Print arguments of a compound term. +write_args_as_sexpression([]). +write_args_as_sexpression([H|T]) :- write(' '), pp_sex(H), write_args_as_sexpression(T). + +% Print the rest of the list. +print_list_as_sexpression([]). +%print_list_as_sexpression([H]):- w_proper_indent(pp_sex(H)),!. +print_list_as_sexpression([H|T]):- write(' '), pp_sex(H), print_list_as_sexpression(T). call_sexpr(S):- writeln(call=S). %call_sexpr(Space,Expr,Result):- diff --git a/metta_vspace/pyswip/metta_testing.pl b/metta_vspace/pyswip/metta_testing.pl index 24a5d150..dfd51a7a 100755 --- a/metta_vspace/pyswip/metta_testing.pl +++ b/metta_vspace/pyswip/metta_testing.pl @@ -58,10 +58,8 @@ format(string(TestName), "~w.~w.~w", [NoUnderscoreParent, NoUnderscore, NS]). -color_g_mesg(_,_):- is_compatio,!. -color_g_mesg(_,_):- silent_loading,!. +%color_g_mesg(C,G):- silent_loading,!. color_g_mesg(C,G):- notrace((nop(check_silent_loading),color_g_mesg_ok(C,G))). -color_g_mesg_ok(_,G):- is_compatio,!,call(G). color_g_mesg_ok(C,G):- quietly(( wots(S,must_det_ll(user:G)), diff --git a/metta_vspace/pyswip/metta_types.pl b/metta_vspace/pyswip/metta_types.pl index 85ac68b8..a69b5da3 100755 --- a/metta_vspace/pyswip/metta_types.pl +++ b/metta_vspace/pyswip/metta_types.pl @@ -1,31 +1,9 @@ -typed_list(Cmpd,Type,List):- compound(Cmpd), Cmpd\=[_|_], compound_name_arguments(Cmpd,Type,[List|_]),is_list(List). -is_syspred(H,Len,Pred):- notrace(is_syspred0(H,Len,Pred)). -is_syspred0(H,_Ln,_Prd):- \+ atom(H),!,fail. -is_syspred0(H,_Ln,_Prd):- upcase_atom(H,U),downcase_atom(H,U),!,fail. -is_syspred0(H,Len,Pred):- current_predicate(H/Len),!,Pred=H. -is_syspred0(H,Len,Pred):- atom_concat(Mid,'!',H), H\==Mid, is_syspred0(Mid,Len,Pred),!. -is_syspred0(H,Len,Pred):- atom_concat(Mid,'-p',H), H\==Mid, is_syspred0(Mid,Len,Pred),!. -is_syspred0(H,Len,Pred):- atom_concat(Mid,'-fn',H), H\==Mid, is_syspred0(Mid,Len,Pred),!. -is_syspred0(H,Len,Pred):- into_underscores(H,Mid), H\==Mid, is_syspred0(Mid,Len,Pred),!. -%is_function(F):- atom(F). -is_metta_data_functor(_Eq,_Othr,H):- trace, clause(is_data_functor(H),_). -is_metta_data_functor(Eq,Other,H):- H\=='Right', H\=='Something', - % metta_type(Other,H,_), % fail, - \+ get_metta_atom(Eq,Other,[H|_]), - \+ metta_defn(Eq,Other,[H|_],_), - \+ is_metta_builtin(H), - \+ is_comp_op(H,_), - \+ is_math_op(H,_,_). - -:- if( \+ current_predicate(mnotrace/1) ). - mnotrace(G):- once(G). -:- endif. -'Number':attr_unify_hook(_,NewValue):- numeric(NewValue). +mnotrace(G):- once(G). -%is_decl_type(ST):- metta_type(_,_,[_|Type]),is_list(Type),sub_sterm(T,Type),nonvar(T),T=@=ST, \+ nontype(ST). +is_decl_type(ST):- metta_type(_,_,Type),sub_sterm(T,Type),T=@=ST, \+ nontype(ST). is_decl_type([ST|_]):- !, atom(ST),is_decl_type_l(ST). is_decl_type(ST):- \+ atom(ST),!,fail. is_decl_type('%Undefined%'). is_decl_type('Number'). @@ -53,8 +31,7 @@ args_violation(_Dpth,_Slf,Args,List):- ( \+ iz_conz(Args); \+ iz_conz(List)), !, fail. args_violation(Depth,Self,[A|Args],[L|List]):- once(arg_violation(Depth,Self,A,L) ; args_violation(Depth,Self,Args,List)). -arg_violation(Depth,Self,A,L):- fail, - \+ (get_type0(Depth,Self,A,T), \+ type_violation(T,L)). +arg_violation(Depth,Self,A,L):- \+ (get_type0(Depth,Self,A,T), \+ type_violation(T,L)). %arg_violation(Depth,Self,A,_):- get_type(Depth,Self,A,_),!. type_violation(T,L):- \+ \+ (is_nonspecific_type(T);is_nonspecific_type(L)),!,fail. @@ -82,26 +59,11 @@ is_nonspecific_type('Any'). %get_type(Depth,Self,Val,Type):- get_type01(Depth,Self,Val,Type). -get_type(_Depth,Self,Val,Type):- Val = [Curry, Op| T],T==[],symbol(Curry), - metta_type(Self,Curry,['->',OpArgTypes, ArgTypesNew]), - metta_type(Self,Op,OpArgTypes), - Type = ArgTypesNew,!. -get_type(Depth,Self,Val,TypeO):- - no_repeats(TypeT,(get_type9(Depth,Self,Val,Type),TypeT=Type)),Type=TypeO. - - -% (: curry (-> (-> $a $b $c) (-> $a (-> $b $c)))) -get_type9(Depth,Self,Val,Type):- Val = [ [Curry, Op| T], Arg1 ],T==[],symbol(Curry), - metta_type(Self,Curry,['->',OpArgTypes, ArgTypesNew]), - metta_type(Self,Op,OpArgTypes), - get_type(Depth,Self,Arg1,Arg1Type), - ArgTypesNew = ['->',Arg1Type,Type],!. +get_type(Depth,Self,Val,TypeO):- no_repeats(TypeT,(get_type9(Depth,Self,Val,Type),TypeT=Type)),Type=TypeO. get_type9(_Dpth,_Slf,Expr,'hyperon::space::DynSpace'):- is_dynaspace(Expr),!. -%get_type9(_Depth,Self,Val,Type):- symbol(Val),metta_type(Self,Val,Type). get_type9(Depth,Self,Val,Type):- get_type0(Depth,Self,Val,Type). get_type9(Depth,Self,Val,Type):- get_type1(Depth,Self,Val,Type), ground(Type),Type\==[], Type\==Val,!. -%get_type9(_Depth,_Self,Val,Type):- symbol(Val),atom_contains(Val,' '),!,Type='String'. get_type9(Depth,Self,Val,Type):- get_type2(Depth,Self,Val,Type), ( is_list(Type)->! ; true). get_type9(_Dpth,_Slf,_Vl,[]). @@ -129,23 +91,31 @@ get_type0(Depth,Self,Val,Type):- \+ compound(Val),!,get_type01(Depth,Self,Val,Type),!. get_type0(Depth,Self,Val,Type):- get_type03(Depth,Self,Val,Type),!. +typed_list(Cmpd,Type,List):- compound(Cmpd), Cmpd\=[_|_], compound_name_arguments(Cmpd,Type,[List|_]),is_list(List). +/* +(: Left + (-> %Undefined% Either)) + +(: (Left %Undefined%) Either) + +*/ get_type01(_Dpth,_Slf,Var,'%Undefined%'):- var(Var),!. get_type01(_Dpth,_Slf, [],'%Undefined%'):- !. -get_type01(_Dpth,Self,Op,Type):- metta_type(Self,Op,Type),!. get_type01(_Dpth,_Slf,Val,'Number'):- number(Val). get_type01(_Dpth,_Slf,Val,'Integer'):- integer(Val). get_type01(_Dpth,_Slf,Val,'Decimal'):- float(Val). get_type01(_Dpth,_Slf,Val,'Rational'):- rational(Val). get_type01(_Dpth,_Slf,Val,'Bool'):- (Val=='False';Val=='True'),!. -%get_type01(_Dpth,_Slf,Val,Type):- string(Val),!,(Type='String';Type='Symbol'). +get_type01(_Dpth,_Slf,Val,Type):- string(Val),!,(Type='String';Type='Symbol'). get_type01(_Dpth,_Slf,Expr,_):- \+ atom(Expr),!,fail. +get_type01(_Dpth,Self,Op,Type):- metta_type(Self,Op,Type). get_type01(_Dpth,_Slf,Val,Type):- is_decl_type(Val),(Type=Val;Type='Type'). get_type01(_Dpth,_Slf,Val,Type):- atomic_list_concat([Type,_|_],'@',Val). get_type01(_Dpth,_Slf,Val,Type):- atomic_list_concat([Type,_|_],':',Val). get_type01(Depth,Self,Op,Type):- Depth2 is Depth-1, eval_args(Depth2,Self,Op,Val),Op\=@=Val,!, get_type(Depth2,Self,Val,Type). %get_type01(_Dpth,_Slf,Expr,'hyperon::space::DynSpace'):- \+ is_list(Expr), callable(Expr), is_space_type(Expr,_). -%get_type01(_Dpth,_Slf,_Val,'String'). -%get_type01(_Dpth,_Slf,_Val,'Symbol'). +get_type01(_Dpth,_Slf,_Val,'String'). +get_type01(_Dpth,_Slf,_Val,'Symbol'). @@ -183,7 +153,7 @@ get_type03(_Dpth,_Slf,Val,Type):- is_decl_type(Val),(Type=Val;Type='Type'). -%get_type03(_Dpth,_Slf,Expr,'Expression'):- is_list(Expr),!. +get_type03(_Dpth,_Slf,Expr,'Expression'):- is_list(Expr),!. get_type03(Depth,Self,List,Types):- List\==[], is_list(List), Depth2 is Depth-1,maplist(get_type(Depth2,Self),List,Types). @@ -232,7 +202,7 @@ get_type1(_Dpth,_Slf,Val,'String'):- string(Val),!. get_type1(_Dpth,_Slf,Val,Type):- is_decl_type(Val),Type=Val. get_type1(_Dpth,_Slf,Val,'Bool'):- (Val=='False';Val=='True'),!. -% get_type1(_Dpth,_Slf,Val,'Symbol'):- symbol(Val). +get_type1(_Dpth,_Slf,Val,'Symbol'):- symbol(Val). %get_type1(Depth,Self,[T|List],['List',Type]):- Depth2 is Depth-1, is_list(List),get_type1(Depth2,Self,T,Type),!, % forall((member(Ele,List),nonvar(Ele)),get_type1(Depth2,Self,Ele,Type)),!. %get_type1(Depth,_Slf,Cmpd,Type):- compound(Cmpd), functor(Cmpd,Type,1),!. @@ -242,33 +212,27 @@ -as_prolog(I,O):- as_prolog(10,'&self',I,O). as_prolog(_Dpth,_Slf,I,O):- \+ iz_conz(I),!,I=O. -as_prolog(Depth,Self,[Cons,H,T],[HH|TT]):- Cons=='Cons',as_prolog(Depth,Self,H,HH),as_prolog(Depth,Self,T,TT). -as_prolog(Depth,Self,[List,H|T],O):- List=='::',!,maplist(as_prolog(Depth,Self),[H|T],L),!, O = L. -as_prolog(Depth,Self,[At,H|T],O):- At=='@',!,maplist(as_prolog(Depth,Self),[H|T],[HH|L]),atom(H),!, O =.. [HH|L]. -as_prolog(Depth,Self,[H|T],O):- is_list(T),!,maplist(as_prolog(Depth,Self),[H|T],[HH|L]),atom(H),!, compound_name_arguments(O,HH,L). -as_prolog(_Dpth,_Slf,I,I). +as_prolog(Depth,Self,[H|T],O):- H=='::',!,maplist(as_prolog(Depth,Self),T,L),!, O = L. +as_prolog(Depth,Self,[H|T],O):- H=='@',!,maplist(as_prolog(Depth,Self),T,L),!, O =.. L. +as_prolog(Depth,Self,[H|T],[HH|TT]):- as_prolog(Depth,Self,H,HH),as_prolog(Depth,Self,T,TT). + -try_adjust_arg_types(_Eq,RetType,Depth,Self,Params,X,Y):- - as_prolog(Depth,Self,X,M), +adjust_args(_Dpth,Self,F,X,X):- (is_special_op(Self,F); \+ iz_conz(X)),!. +adjust_args(Depth,Self,Op,X,Y):- + get_operator_typedef(Self,Op,Params,RetType), + try_adjust_arg_types(RetType,Depth,Self,Params,X,Y). + +try_adjust_arg_types(RetType,Depth,Self,Params,X,Y):- + %s_prolog(Depth,Self,X,M), + X= M, args_conform(Depth,Self,M,Params),!, set_type(Depth,Self,Y,RetType), into_typed_args(Depth,Self,Params,M,Y). -%adjust_args(Eq,RetType,Depth,Self,_,X,Y):- is_list(X), !, maplist(eval_args(Depth,Self),X,Y). -%adjust_args(Eq,RetType,Depth,Self,_,X,Y):- is_list(X), !, maplist(as_prolog(Depth,Self),X,Y),!. - -adjust_args(_Eq,_RetType,_Dpth,Self,F,X,Y):- (X==[] ; is_special_op(Self,F); \+ iz_conz(X)),!,Y=X. -adjust_args(Eq,RetType,Depth,Self,Op,X,Y):- - adjust_argsA(Eq,RetType,Depth,Self,Op,X,Y)*->true; adjust_argsB(Eq,RetType,Depth,Self,Op,X,Y). - -adjust_argsA(Eq,RetType,Depth,Self,Op,X,Y):- - %trace, - get_operator_typedef(Self,Op,Params,RetType), - try_adjust_arg_types(Eq,RetType,Depth,Self,Params,X,Y). -%adjust_args(_Eq,_RetType,Depth,Self,_,X,Y):- as_prolog(Depth,Self,X,Y). -adjust_argsB(_Eq,_RetType,_Depth,_Self,_,X,Y):- X = Y. +%adjust_args(Depth,Self,_,X,Y):- is_list(X), !, maplist(eval_args(Depth,Self),X,Y). +%adjust_args(Depth,Self,_,X,Y):- is_list(X), !, maplist(as_prolog(Depth,Self),X,Y),!. +adjust_args(Depth,Self,_,X,Y):- as_prolog(Depth,Self,X,Y). into_typed_args(_Dpth,_Slf,T,M,Y):- (\+ iz_conz(T); \+ iz_conz(M)),!, M=Y. into_typed_args(Depth,Self,[T|TT],[M|MM],[Y|YY]):- @@ -320,19 +284,16 @@ %is_user_defined_goal(Self,[H|_]):- is_user_defined_head(Eq,Self,H). -is_user_defined_head(Other,H):- is_user_defined_head(=,Other,H). is_user_defined_head(Eq,Other,H):- mnotrace(is_user_defined_head0(Eq,Other,H)). is_user_defined_head0(Eq,Other,[H|_]):- !, nonvar(H),!, is_user_defined_head_f(Eq,Other,H). is_user_defined_head0(Eq,Other,H):- callable(H),!,functor(H,F,_), is_user_defined_head_f(Eq,Other,F). is_user_defined_head0(Eq,Other,H):- is_user_defined_head_f(Eq,Other,H). -is_user_defined_head_f(Other,H):- is_user_defined_head_f(=,Other,H). is_user_defined_head_f(Eq,Other,H):- is_user_defined_head_f1(Eq,Other,H). is_user_defined_head_f(Eq,Other,H):- is_user_defined_head_f1(Eq,Other,[H|_]). %is_user_defined_head_f1(Eq,Other,H):- metta_type(Other,H,_). %s_user_defined_head_f1(Other,H):- get_metta_atom(Eq,Other,[H|_]). -is_user_defined_head_f1(Other,H):- is_user_defined_head_f1(=,Other,H). is_user_defined_head_f1(Eq,Other,H):- metta_defn(Eq,Other,[H|_],_). %is_user_defined_head_f(Eq,_,H):- is_metta_builtin(H). @@ -345,6 +306,21 @@ maplist(is_non_eval_kind,Params). is_special_op(_Slf,Op):- is_special_builtin(Op). +is_syspred(H,Len,Pred):- notrace(is_syspred0(H,Len,Pred)). +is_syspred0(H,_Ln,_Prd):- \+ atom(H),!,fail. +is_syspred0(H,_Ln,_Prd):- upcase_atom(H,U),downcase_atom(H,U),!,fail. +is_syspred0(H,Len,Pred):- current_predicate(H/Len),!,Pred=H. +is_syspred0(H,Len,Pred):- atom_concat(Mid,'!',H), H\==Mid, is_syspred0(Mid,Len,Pred),!. +is_syspred0(H,Len,Pred):- into_underscores(H,Mid), H\==Mid, is_syspred0(Mid,Len,Pred),!. +%is_function(F):- atom(F). +is_metta_data_functor(Eq,_Othr,H):- clause(is_data_functor(H),_). +is_metta_data_functor(Eq,Other,H):- H\=='Right', H\=='Something', + % metta_type(Other,H,_), % fail, + \+ get_metta_atom(Eq,Other,[H|_]), + \+ metta_defn(Eq,Other,[H|_],_), + \+ is_metta_builtin(H), + \+ is_comp_op(H,_), + \+ is_math_op(H,_,_). get_operator_typedef(Self,Op,Params,RetType):- @@ -404,6 +380,7 @@ is_metta_builtin('import!'). is_metta_builtin('pragma!'). + % Comparison Operators in Prolog % is_comp_op('=', 2). % Unification is_comp_op('\\=', 2). % Not unifiable @@ -1177,3 +1154,5 @@ (LenH > LenAcc -> longest_string_acc(T, H, Longest); longest_string_acc(T, Acc, Longest)). % + + diff --git a/metta_vspace/pyswip/metta_utils.pl b/metta_vspace/pyswip/metta_utils.pl index 791765f8..32eb8161 100755 --- a/metta_vspace/pyswip/metta_utils.pl +++ b/metta_vspace/pyswip/metta_utils.pl @@ -11,7 +11,7 @@ :- ensure_loaded(library(logicmoo_utils)). :- endif. :- if(exists_source(library(dictoo))). -%:- ensure_loaded(library(dictoo)). +:- ensure_loaded(library(dictoo)). :- endif. cleanup_debug:- @@ -221,9 +221,7 @@ :- multifile(user:message_hook/3). :- dynamic(user:message_hook/3). %user:message_hook(Term, Kind, Lines):- error==Kind, itrace,fbug(user:message_hook(Term, Kind, Lines)),trace,fail. -user:message_hook(Term, Kind, Lines):- error==Kind, - unlooped_fbug(user:message_hook(Term, Kind, Lines)),fail. - +user:message_hook(Term, Kind, Lines):- error==Kind, fbug(user:message_hook(Term, Kind, Lines)),fail. :- meta_predicate(must_det_ll(0)). :- meta_predicate(must_det_ll1(1,0)). diff --git a/metta_vspace/pyswip/swi_support.pl b/metta_vspace/pyswip/swi_support.pl index 76db5d63..ef6289e8 100755 --- a/metta_vspace/pyswip/swi_support.pl +++ b/metta_vspace/pyswip/swi_support.pl @@ -6,9 +6,7 @@ :- abolish((system:'$exported_op'/3)). :- assert((system:'$exported_op'(_,_,_):- fail)). -fbug(_):- is_compatio,!. -fbug(P) :- format("~N"), current_predicate(write_src/1), - with_output_to(user_error,in_cmt(pp_fb(P))),!. +fbug(P) :- format("~N"), current_predicate(write_src/1),with_output_to(user_error,in_cmt(pp_fb(P))),!. fbug(N=V) :- nonvar(N), !, fbdebug1(N:-V). fbug(V) :- compound(V),functor(V,F,_A),!,fbdebug1(F:-V). fbug(V) :- fbdebug1(debug:-V). @@ -52,13 +50,9 @@ option_else0(_N,V, Else):- !,V=Else. %option_value( N,V):- var(V), !, (was_option_value( N,V)->true;trace). -option_value(N,V):- V==true,option_value0(N,'True'),!. -option_value(N,V):- V==false,option_value0(N,'False'),!. -option_value(N,V):- notrace(once(((p2mE(V,VV),option_value0(N,VV))))). - - +option_value(N,V):- notrace(option_value0(N,V)). option_value0( N,V):- var(V), !, was_option_value( N,V). -option_value0( N,V):- nonvar(V), option_value0( N,VV), once((p2m(VV,V2),p2m(V,V1))), V1=V2. +option_value0( N,V):- nonvar(V), option_value0( N,VV), !, p2m(VV,V1),p2m(V,V2),!,V1=V2.%equal_enough(V1,V2). option_value0( N,V):- option_else0( N,V ,[]). p2mE(NA,NA):- \+ atom(NA),!. @@ -92,7 +86,7 @@ symbol_length(S,N):- atom_length(S,N). symbol_concat(A,B,C):- atom_concat(A,B,C). symbolic_list_concat(A,B,C):- atomic_list_concat(A,B,C). -symbol_contains(T,TT):- atom_contains(T,TT). +symbol_contains(T,TT):- atom_contains(T,TT). :- prolog_load_context(file, File), absolute_file_name('../../data/ftp.flybase.org/releases/current/',Dir,[relative_to(File),file_type(directory)]),