/* * Project: MeTTaLog - A MeTTa to Prolog Transpiler/Interpreter * Description: This file is part of the source code for a transpiler designed to convert * MeTTa language programs into Prolog, utilizing the SWI-Prolog compiler for * optimizing and transforming function/logic programs. It handles different * logical constructs and performs conversions between functions and predicates. * * Author: Douglas R. Miles * Contact: logicmoo@gmail.com / dmiles@logicmoo.org * License: LGPL * Repository: https://github.com/trueagi-io/metta-wam * https://github.com/logicmoo/hyperon-wam * Created Date: 8/23/2023 * Last Modified: $LastChangedDate$ # You will replace this with Git automation * * Usage: This file is a part of the transpiler that transforms MeTTa programs into Prolog. For details * on how to contribute or use this project, please refer to the repository README or the project documentation. * * Contribution: Contributions are welcome! For contributing guidelines, please check the CONTRIBUTING.md * file in the repository. */ % ============================== % MeTTa to Prolog transpilation (which uses the Host SWI-Prolog compiler) % Aimed at compiling/optimizing and transforming % Prolog predicates to functional equivalents and vice versa, with special attention % to handling different logical constructs and performing conversions between % functions and predicates. % ============================== % Loading various library files :- ensure_loaded(swi_support). :- ensure_loaded(metta_testing). :- ensure_loaded(metta_utils). :- ensure_loaded(metta_parser). :- ensure_loaded(metta_interp). :- ensure_loaded(metta_space). :- ensure_loaded(metta_compiler_inlining). :- ensure_loaded(metta_mizer). % ======================================= % TODO move non flybase specific code between here and the compiler %:- ensure_loaded(flybase_main). % ======================================= eopfc:- ensure_loaded(mettalog('metta_ontology.pfc.pl')). :- dynamic(metta_compiled_predicate/2). :- multifile(metta_compiled_predicate/2). :- dynamic(metta_compiled_predicate/3). :- multifile(metta_compiled_predicate/3). w_cl(P1,F):- atom(F),!,w_cl(P1,F/_). w_cl(P1,F/A):- atom(F),integer(A),!,functor(P,F,A),w_cl(P1,P). w_cl(P1,F/A):- forall((current_predicate(F/A),A>0),w_cl(P1,F/A)). w_cl(P1,P):- call(P1,P). dedupe_p1(P):- current_predicate(_,P), forall((copy_term(P,P2), clause(P,Bd,Ref), clause(P2,Bd2,Ref2), Ref@', % \+ file_decl_arity(F,_), length(Args,AA),!,A=AA. function_arity(F,A):- current_self(KB), function_arity(KB,F,A). defined_arity(F,A):- predicate_arity(F,A). defined_arity(F,A):- current_predicate(F/A), \+ predicate_arity(F,_). % defined as (= .. .....) decl_arity(F,A):- metta_atom_file_buffer([Eq,[FF|Len]|_]), Eq=='=',nonvar(FF),F==FF,is_list(Len),length([FF|Len],A). import_arity(_,_):- fail, todo(metta_file_buffer(_Atom,_NamedVarsList,_Filename,_LineCount)). is_data_functor(DataFunctor,DenotationalArity):- nonvar(DataFunctor), metta_atom_file_buffer(['DataFunctor',DataFunctor,DenotationalArity]). is_data_functor(F,_):- \+ import_arity(F,_), \+ decl_arity(F,_). % Certain constructs should not be converted to functions. not_function(P):- symbol(P),!,not_function(P,0). not_function(P):- callable(P),!,as_functor_args(P,F,A),not_function(F,A). not_function(F,A):- is_arity_0(F,FF),!,not_function(FF,A). not_function(!,0). not_function(print,1). not_function((':-'),2). not_function((','),2). not_function((';'),2). not_function(('='),2). not_function(('or'),2). not_function('a',0). not_function('b',0). not_function(F,A):- is_control_structure(F,A). not_function(A,0):- symbol(A),!. not_function('True',0). not_function(F,A):- predicate_arity(F,A),AA is A+1, \+ decl_functional_predicate_arg(F,AA,_). needs_call_fr(P):- is_function(P,_Nth),as_functor_args(P,F,A),AA is A+1, \+ current_predicate(F/AA). is_control_structure(F,A):- symbol(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,Res):- as_tf((G1 ; G2),Res). % Function without arguments can be converted directly. is_arity_0(AsFunction,F):- compound(AsFunction), compound_name_arity(AsFunction,F,0). % Determines whether a given term is a function and retrieves the position % in the predicate where the function Result is stored/retrieved is_function(AsFunction, _):- is_ftVar(AsFunction),!,fail. is_function(AsFunction, _):- AsFunction=='$VAR',!, trace, fail. is_function(AsFunction, Nth) :- is_arity_0(AsFunction,F), \+ not_function(F,0), !,Nth=1. is_function(AsFunction, Nth) :- is_arity_0(AsFunction,_), !,Nth=1. is_function([F|Function], Nth) :- is_list(Function),length(Function,N), functional_predicate_arg_maybe(F, N, Nth). is_function(AsFunction, Nth) :- callable(AsFunction), as_functor_args(AsFunction, Functor, A), \+ not_function(Functor, A), AA is A + 1, functional_predicate_arg_maybe(Functor, AA, Nth). functional_predicate_arg_maybe(F, _, _):- \+ symbol(F),!,fail. functional_predicate_arg_maybe(F, AA, Nth):- functional_predicate_arg(F, AA, Nth),!. functional_predicate_arg_maybe(F, AA, _):- A is AA - 1,functional_predicate_arg(F,A,_),!,fail. functional_predicate_arg_maybe(F, Nth, Nth):- asserta(decl_functional_predicate_arg(F, Nth, Nth)),!. % -------------------------------- % FUNCTS_TO_PREDS EXPLANATION % -------------------------------- % functs_to_preds is a predicate that converts all Term functions to their equivalent predicates. % It takes three arguments - RetResult, which will hold the result of the function evaluation, % Convert, which is the function that needs to be converted, and Converted, which will hold the equivalent predicate. % Example: % % ?- functs_to_preds(RetResult, is(pi+pi), Converted). % % Converted = (pi(_A), % +(_A, _A, _B), % _C is _B, % u_assign(_C, RetResult)). % functs_to_preds(I,OO):- notrace(is_html->true; non_compat_io(color_g_mesg('yellow', (write_src(I),nl)))), must_det_ll(functs_to_preds0(I,OO)),!. functs_to_preds0(I,OO):- \+ compound(I),!,OO=I. %functs_to_preds0(I,OO):- data_term(I),!,OO=I. functs_to_preds0(I,OO):- \+ is_conz(I), once(into_list_args(I,II)), I\=@=II, functs_to_preds(II,OO),!. functs_to_preds0([Eq,H,B],OO):- Eq == '=', !, compile_for_assert(H, B, OO),!. functs_to_preds0(=(H,B),OO):- !, compile_for_assert(H, B, OO),!. functs_to_preds0(EqHB,OO):- compile_for_assert(EqHB,(X==X),OO),!. functs_to_preds0(I,OO):- must_det_ll(( sexpr_s2p(I, M), f2p(_,_,M,O), expand_to_hb(O,H,B), optimize_head_and_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,u_assign(I,Res)):- is_ftVar(I),!. compile_for_exec0(Res,(:- I),O):- !, compile_for_exec0(Res,I,O). 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_exec0(Res,I,BB):- fail, compound_name_arguments(EXEC0, exec0, []), compile_for_assert(EXEC0, I, H:-BB), arg(1,H,Res). compile_metta_defn(_KB,_F,_Len,Args,_BodyFn,_Clause):- \+ is_list(Args),!,fail. %compile_metta_defn(_KB,_F,_Len,_Args,BodyFn,_Clause):- var(BodyFn),!,fail. compile_metta_defn(KB,F,Len,Args,[WB|AL],ClauseU):- 'wam-body'==WB,!, must_det_ll(( if_t(var(Len), ignore((function_arity(KB,F,Len)))), if_t(var(Arity),ignore((is_non_absorbed_return(KB,F,Len,_), ignore(Arity is Len+1)))), if_t(var(Arity),ignore((is_absorbed_return(KB,F,Arity,_), ignore(Len is Arity)))), if_t(var(Arity),ignore((predicate_arity(KB,F,Arity)))), if_t(var(Arity),length(Args,Arity)), if_t(var(Len),ignore(Len is Arity-1)), if_t(var(Len),if_t(integer(SLen),Len = SLen)), pfcAdd(metta_compiled_predicate(KB,F,Len)), Clause=(H:-B), s2c([F|Args],H), maplist(s2c,AL,ALB), list_to_conjuncts(ALB,B), %nl,print_tree(Clause),nl, add_unnumbered_clause(KB,F,Len,Clause,ClauseU))),!. compile_metta_defn(KB,F,Len,Args,BodyFn,ClauseU):- must_det_ll(( if_t(var(Len),length(Args,Len)), pfcAdd(metta_compiled_predicate(KB,F,Len)), compile_for_assert([F|Args],BodyFn,Clause), add_unnumbered_clause(KB,F,Len,Clause,ClauseU))). add_unnumbered_clause(KB,F,Len,ClauseN,Clause):- must_det_ll(( unnumbervars_clause(ClauseN,Clause), pfcAdd(metta_compiled_predicate(KB,F,Len)), add_assertion(KB,Clause))),!. merge_structures([F|HeadAsFunction0], AsBodyFn0,A,B,(=(NewVar,Cept),C)):- fail, append(Left,[Merge|Right],HeadAsFunction0), nonvar(Merge), append(Left,[Cept|Right],HeadAsFunctionM), %HeadAsFunctionM=REPH, HeadAsFunction0=REPH, subst(AsBodyFn0+REPH,Merge,NewVar,NextBodyFn+NextHead), NextBodyFn+NextHead \=@= AsBodyFn0+HeadAsFunctionM, merge_structures([F|NextHead], NextBodyFn,A,B,C), Cept=Merge. merge_structures(A,B,A,B,true). % 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). rewrite_sym(S,F):- \+ atomic(S),!,F=S. rewrite_sym(':',F):- var(F),!, 'iz' == F,!. rewrite_sym(F,F). as_functor_args(AsPred,F,A):- as_functor_args(AsPred,F,A,_ArgsL),!. as_functor_args(AsPred,F,A,ArgsL):-var(AsPred),!, (is_list(ArgsL);(integer(A),A>=0)),!, length(ArgsL,A), (symbol(F)->AsPred =..[F|ArgsL]; (AsPred = [F|ArgsL])). as_functor_args(AsPred,_,_,_Args):- is_ftVar(AsPred),!,fail. as_functor_args(AsPred,F,A,ArgsL):- \+ iz_conz(AsPred), AsPred=..List,!, as_functor_args(List,F,A,ArgsL),!. %as_functor_args([Eq,R,Stuff],F,A,ArgsL):- (Eq == '='), % into_list_args(Stuff,List),append(List,[R],AsPred),!, % as_functor_args(AsPred,F,A,ArgsL). as_functor_args([F|ArgsL],F,A,ArgsL):- length(ArgsL,A),!. compile_for_assert(HeadAsFunction0, AsBodyFn0, ConvertedO) :- must_det_ll(( call(ensure_compiler_ready), merge_structures(HeadAsFunction0, AsBodyFn0,HeadAsFunction, AsBodyFn,PreCode), as_functor_args(HeadAsFunction,_F,Len), h2p(Which,HeadAsFunction,ResultToHead,HeadAsPred), compile_head_for_assert(Which,HeadAsPred,HeadC,_SupposedRT, Len, NarrowRetType,ResultToHead, ResultFromBody,HeadCode,ResultCode), f2p(HeadC,NarrowRetType,ResultFromBody,AsBodyFn,NextBody), combine_code([PreCode,HeadCode,NextBody,ResultCode],BodyC),!, optimize_head_and_body(HeadC,BodyC,HeadCC,BodyCC), Convert = (HeadCC :- BodyCC), fix_equals_in_head(Convert,Converted),!, continue_opimize(Converted,ConvertedO))). compile_head_for_assert(Which,Head, NewHead, SupposedRT, Len, NarrowRetType,ResultToHead,ResultFromBody,PreBodyCode,ResultCode):- \+ is_list(Head), as_functor_args(Head,F,_,ArgsL),!, compile_head_for_assert(Which,[F|ArgsL], NewHead, SupposedRT, Len, NarrowRetType,ResultToHead,ResultFromBody,PreBodyCode,ResultCode),!. % compile_head_for_assert(Head, Head, true):- head_as_is(Head),!. compile_head_for_assert(_Which,HeadAsPred,NewestHead,SupposedRT,Len,NarrowRetType, ResultToHead,ResultFromBody, PreBodyCode,ResultCode):- must_det_ll(( HeadAsPred=[F|PredArgs], length(PredArgs,Arity), length(NewPredArgs,Arity), length(ParamTypes,Len), length(FunctionArgs,Len),length(NewFunctionArgs,Len), append(FunctionArgs,RetL,PredArgs), append(NewFunctionArgs,RetL,NewPredArgs), (RetL==[] -> true ; RetL=[ResultFromBody|_]), get_operator_typedef(Self,F,ParamTypes,BodyRetType), narrow_types(SupposedRT,BodyRetType,NarrowRetType), compile_head_args(20,HeadAsPred,Self,F,1,ParamTypes,FunctionArgs,NewFunctionArgs,ParamCode), FutureHead = [F|NewPredArgs], compile_head_variablization(FutureHead, NewestHead, VHeadCode), combine_code([ParamCode,VHeadCode],PreBodyCode), ResultCode = eval_for(ret,BodyRetType,ResultFromBody,ResultToHead))). % Construct the new head args compile_head_args(Depth,HeadIs,Self,F,Nth,[PT|ParamTypes],[A|Args],[N|NewArgs],CCode):- !, compile_one_head_arg(Depth,HeadIs,Self,F,Nth,PT,A,N,C),!, Nth1 is Nth+1, compile_head_args(Depth,HeadIs,Self,F,Nth1,ParamTypes,Args,NewArgs,Code),!, combine_code(C,Code,CCode). compile_head_args(_Depth,_HeadIs,_Slf,_F,_Nth,[],Args,Args,true). compile_head_args(_Depth,_HeadIs,_Slf,_F,_Nth,_ParamTypes,[],[],true). %compile_one_head_arg(_Head, NewArg, Arg, (NewArg=~Arg)):- data_term(Arg),!. %compile_one_head_arg(_Head, NewArg, Arg, (NewArg=~Arg)):- !. %compile_one_head_arg(Head, NewArg, Arg, Code):- f2p_assign(10,Head,NewArg,Arg,Code). compile_one_head_arg(_Depth,_HeadIs,_Slf,_F,_Nth,_PT,Arg,NewArg,eval_true(NewArg)):- Arg=='True',!. compile_one_head_arg(_Depth,_HeadIs,_Slf,_F,_Nth,_PT,Arg,NewArg,eval_false(NewArg)):- Arg=='False',!. compile_one_head_arg(_Depth,_HeadIs,_Slf,_F,_Nth,PT,A,N,eval_for(h5,PT,N,A)):- PT\=='Atom', is_list(A),!. compile_one_head_arg(Depth,HeadIs,Slf,F,Nth,RetType,Arg,NewArgO,CodeOut):- \+ is_list(Arg), compound(Arg), as_functor_args(Arg,AF,_A,Args), Compile = [AF|Args], !, compile_one_head_arg(Depth,HeadIs,Slf,F,Nth,RetType,Compile,NewArgO,CodeOut),!. compile_one_head_arg(_Depth,_HeadIs,_Slf,_F,_Nth,PT,A,N,eval_for(h5,PT,N,A)):- PT\=='Atom', is_list(A),!. compile_one_head_arg(_Depth,_HeadIs,_Slf,_F,_Nth,PT,A,N,eval_for(h5,PT,N,A)):- is_list(A),!. compile_one_head_arg(_Depth,_HeadIs,_Slf,F,Nth,PT,A,N,eval_for(h4(Nth,F),PT,N,A)):- var(PT), var(A),!. compile_one_head_arg(_Depth,_HeadIs,_Slf,_F,_Nth,PT,A,N,eval_for(h3,PT,N,A)):- var(PT), nonvar(A), get_type(A,PT),nonvar(PT),!. compile_one_head_arg(_Depth,_HeadIs,_Slf,_F,_Nth,PT,A,N,once(get_type(A,PT))):- A=N,var(PT), !. compile_one_head_arg(_Depth,_HeadIs,_Slf,_F,_Nth,_PT,A,A,true). compile_head_variablization(Head, NewHead, PreBodyCode) :- 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,PreBodyCode), as_functor_args(NewHead,Functor,A,NewArgs))),!. is_f('S'):- fail. is_mf(','). is_mf(';'). is_mf('call'). is_lf(':'). s2c(Args,true):- Args==[],!. s2c(Args,call(Args)):- \+ iz_conz(Args),!. s2c([F|Args],C):- \+ symbol(F), !, C=[F|Args]. s2c([F|Args],C):- is_lf(F), !, C=[F|Args]. s2c([At,F|Args],C):- symbol(F), At== '@', is_list(Args),!,maplist(s2c,Args,ArgsL), compound_name_arguments(C,F,ArgsL). s2c([F|Args],C):- is_f(F), is_list(Args),!,maplist(s2ca,Args,ArgsL), compound_name_arguments(C,F,ArgsL). s2c([F|Args],C):- is_mf(F), is_list(Args),!,maplist(s2c,Args,ArgsL), compound_name_arguments(C,F,ArgsL). s2c([F|Args],C):- is_list(Args),!,maplist(s2ca,Args,ArgsL), compound_name_arguments(C,F,ArgsL). s2c(C,call(C)). s2ca(Args,Args):- \+ iz_conz(Args),!. s2ca([H|T],[HH|TT]):- \+ symbol(H), !, s2ca(H,HH),s2ca(T,TT). s2ca([F|Args],C):- is_lf(F), !, C=[F|Args]. s2ca([At,F|Args],C):- symbol(F), At== '@', is_list(Args),!,maplist(s2ca,Args,ArgsL), compound_name_arguments(C,F,ArgsL). s2ca([F|Args],C):- is_f(F), is_list(Args),!,maplist(s2ca,Args,ArgsL), compound_name_arguments(C,F,ArgsL). s2ca([F|Args],C):- is_mf(F), is_list(Args),!,maplist(s2c,Args,ArgsL), compound_name_arguments(C,F,ArgsL). s2ca([H|T],[HH|TT]):- s2ca(H,HH),s2ca(T,TT). fix_non_singletons(Args, NewArgs, [Code|Conditions]) :- sub_term_loc(Var, Args, Loc1), is_nsVar(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_nsVar(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], RestConj) :- H==true, list_to_conjunction(T, RestConj). list_to_conjunction([H|T], (H, RestConj)) :- list_to_conjunction(T, RestConj),!. fix_equals_in_head(Convert,Convert):- \+ compound(Convert),!. fix_equals_in_head(Convert:-Vert,Comp:-Vert):-!, fix_equals_in_head(Convert,Converted), as_compound_head(Converted,Comp). fix_equals_in_head(R=C,Converted):- append_term(C,R,Converted). fix_equals_in_head((A:B),iz(A,B)):- !. fix_equals_in_head(Convert,Convert). as_compound_head([F|Converted],Comp):- symbol(F),!,compound_name_arguments(Comp,F,Converted). as_compound_head(Comp,Comp). :- op(700,xfx,'=~'). compile_for_assert_eq('=',HeadInC, AsBodyFnC, Converted):- subst_vars(['=',HeadInC, AsBodyFnC],['=',HeadIn, AsBodyFn],NamedVarsList), maplist(cname_var,NamedVarsList),!, compile_for_assert(HeadIn, AsBodyFn, Converted). compile_for_assert_eq(':-',HeadIn, BodyIn, Converted):- call(ensure_compiler_ready), Converted=(H:-B), s2p(HeadIn,H), s2p(BodyIn,B),!. ensure_compiler_ready:- ensure_loaded(mettalog('metta_ontology.pfc.pl')), ensure_corelib_types. %ensure_compiler_ready:- eopfc. /* compile_for_assert_01(HeadIs, AsBodyFn, Converted) :- ( AsBodyFn =@= HeadIs ; AsBodyFn == [] ), !, 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_01(Head, AsBodyFn, Converted) :- once(compile_head_variablization(Head, HeadC, HeadCode)), \+ atomic(HeadCode), !, compile_for_assert_01(HeadC, (HeadCode,AsBodyFn), Converted),!. compile_for_assert_01(HeadIn, AsBodyFn, Converted) :- r2p(HeadIn,HResult,Head), compile_for_assert_02(HResult,Head, AsBodyFn, Converted),!. compile_for_assert_01(HeadIn, AsBodyFn, Converted) :- compile_for_assert_02(_HResult, HeadIn, AsBodyFn, Converted),!. compile_for_assert_02(HResult,HeadIs, AsBodyFn, Converted) :- is_nsVar(AsBodyFn), 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), cname_var('HEAD_RES',Result))),!. compile_for_assert_02(HResult,HeadIs, AsBodyFn, Converted) :- h2p(HeadIs,HResult,NewHead), 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(NewHead,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))), cname_var('HEAD_RES',Result))),!. % If Convert is of the form (AsFunction=AsBodyFn), we perform conversion to obtain the equivalent predicate. compile_for_assert_02(HResult,HeadIs, AsBodyFn, Converted) :- Result = HResult, AsFunction = HeadIs, Converted = (HeadCC :- BodyCC), funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, Head), compile_head_args(Head,HeadC,HeadCode), f2p(HeadIs,Result,AsBodyFn,NextBody), combine_code(HeadCode,NextBody,BodyC),!, optimize_head_and_body(HeadC,BodyC,HeadCC,BodyCC),!. */ 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. compile_test_then_else(Depth,RetResult,If,Then,Else,Converted):- f2p(Depth,HeadIs,RetType,ThenResult,Then,ThenCode), f2p(Depth,HeadIs,RetType,ElseResult,Else,ElseCode), Converted=(If*->(ThenCode,ThenResult=RetResult); (ElseCode,ElseResult=RetResult)). :- discontiguous(f2q/6). %:- discontiguous(f2q/6). dif_functors(HeadIs,_):- var(HeadIs),!,fail. dif_functors(HeadIs,_):- \+ compound(HeadIs),!. dif_functors(HeadIs,Convert):- compound(HeadIs),compound(Convert), compound_name_arity(HeadIs,F,A),compound_name_arity(Convert,F,A). is_compiled_and(AND):- member(AND,[ /*(','), ('and'),*/ ('and2')]). flowc. no_lists(Args):- maplist(not_a_function_in_arg,Args). not_a_function_in_arg(Arg):- is_ftVar(Arg),!. not_a_function_in_arg(Arg):- \+ is_list(Arg),!. %is_data_functor(F,A),!. %f2q(_Depth,_HeadIs,_RetType,_RetResult, ie(N=V, Code)) :- !, into_equals(N,V,Code). % The catch-all If no specific case is matched, consider Convert as already converted. %f2q(_Depth,_HeadIs,_RetType,RetResult,Convert, Code):- into_u_assign(Convert,RetResult,Code). de_eval(u_assign(X),X):- compound(X),!. call1(G):- call(G). call2(G):- call(G). call3(G):- call(G). call4(G):- call(G). call5(G):- call(G). trace_break:- trace,break. %:- table(u_assign/2). %u_assign(FList,R):- is_list(FList),!,u_assign(FList,R). u_assign(FList,R):- var(FList),nonvar(R), !, u_assign(R,FList). u_assign(FList,R):- FList=@=R,!,FList=R. u_assign([F|List],[F|R]):- List=R, !. %u_assign(FList,R):- number(FList), var(R),!,R=FList. u_assign(FList,R):- \+ compound(FList), var(R),!,R=FList. u_assign(FList,R):- self_eval(FList), var(R),!,R=FList. u_assign(FList,RR):- (compound_non_cons(FList),u_assign_c(FList,RR))*->true;FList=~RR. u_assign(FList,R):- FList =~ R, !. u_assign(FList,R):- var(FList),!,/*trace,*/freeze(FList,u_assign(FList,R)). u_assign([F|List],R):- F == ':-',!, trace_break,as_tf(clause(F,List),R). %u_assign(FList,RR):- u_assign_list1(FList,RR)*->true;u_assign_list2(FList,RR). u_assign_list1([F|List],R):- fail,u_assign([F|List],R), nonvar(R), R\=@=[F|List]. u_assign_list2([F|List],R):- symbol(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/_),_), (fail, quietly(catch(u_assign([F|List],R),_, R=[F|List]))))). %u_assign([V|VI],[V|VO]):- nonvar(V),is_metta_data_functor(_Eq,V),!,maplist(u_assign,VI,VO). u_assign_c((F:-List),R):- !, R = (F:-List). u_assign_c(FList,RR):- as_functor_args(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(u_assign([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. quietlY(G):- call(G). call_fr(G,Result,FA):- current_predicate(FA),!,call(G,Result). call_fr(G,Result,_):- Result=G. % This predicate is responsible for converting functions to their equivalent predicates. % It takes a function 'AsFunction' and determines the predicate 'AsPred' which will be % equivalent to the given function, placing the result of the function at the 'Nth' position % of the predicate arguments. The 'Result' will be used to store the result of the 'AsFunction'. % % It handles cases where 'AsFunction' is a variable and when it's an symbol or a compound term. % For compound terms, it decomposes them to get the as_functor_args and arguments and then reconstructs % the equivalent predicate with the 'Result' at the 'Nth' position. % % Example: % funct_with_result_is_nth_of_pred(HeadIs,+(1, 2), Result, 3, +(1, 2, Result)). into_callable(Pred,AsPred):- is_ftVar(Pred),!,AsPred=holds(Pred). into_callable(Pred,AsPred):- Pred=AsPred,!. into_callable(Pred,AsPred):- iz_conz(Pred), !,AsPred=holds(Pred). into_callable(Pred,AsPred):- Pred=call_fr(_,_,_),!,AsPred=Pred. into_callable(Pred,AsPred):- Pred =~ Cons, !,AsPred=holds(Cons). %r2p(MeTTa,Result,IsPred):- r2p(_,MeTTa,Result,IsPred),!. %r2p(What,MeTTa,Result,IsPred):- h2p(What,MeTTa,Result,IsPred),!. %r2p(What,MeTTa,Result,IsPred):- ar2q(What,MeTTa,Result,IsPred),!. %h2p(MeTTa,Result,IsPred):- h2p(_,MeTTa,Result,IsPred). absorbed_default('Bool',_AsPred,'True'). absorbed_default(_,_AsPred,_). is_absorbed_return_value(F,A,Result):- is_absorbed_return_value(F,A,_,Result). is_absorbed_return_value(F,A,AsPred,Result):- is_absorbed_return(F,A,Bool), absorbed_default(Bool,AsPred,Result). h2p(boolean,AsPred,Result,IsPred):- as_functor_args(AsPred,F,Len,PArgs), is_absorbed_return_value(F,Len,Result),!, safe_univ(IsPred,F,PArgs),!. h2p(func,AsFunction,Result,IsPred):- as_functor_args(AsFunction,F,Len,Args), is_non_absorbed_return(F,Len,_Type), append(Args,[Result],PArgs), safe_univ(IsPred,F,PArgs),!. h2p(pred,AsPred,Result,IsPred):- as_functor_args(AsPred,F,Len,PArgs), is_absorbed_return(F,Len,_Type), Result = 'True', cname_var('AbsorbedRetTrue',Result), safe_univ(IsPred,F,PArgs),!. h2p(pred,AsPred,Result,IsPred):- as_functor_args(AsPred,F,A,PArgs), always_predicate_in_src(F,A),!, % once(functional_predicate_arg(F, A, Nth);Nth=A), %is_absorbed_return(F,A, _Bool), %nth1(Nth,Args,Result), Result = 'True', cname_var('PRetTrue',Result), safe_univ(IsPred,F,PArgs). h2p(func,AsPred,Result,IsPred):- as_functor_args(AsPred,F,A,Args), always_function_in_src(F,A), append(Args,[Result],PArgs), cname_var('FRet',Result), safe_univ(IsPred,F,PArgs),!. h2p(func,AsPred,Result,IsPred):- as_functor_args(AsPred,F,_A,Args), append(Args,[Result],PArgs), cname_var('Ret',Result), safe_univ(IsPred,F,PArgs),!. safe_univ(IsPred,F,PArgs):- is_list(PArgs),atom(F),!,IsPred=..[F|PArgs]. safe_univ(IsPred,F,PArgs):- compound(IsPred),var(F),!,IsPred=..[F|PArgs]. safe_univ(IsPred,F,PArgs):- IsPred=fL(F,PArgs). /* h2p(func,AsFunction,Result,IsPred):- as_functor_args(AsFunction,F,Len,Args), is_non_absorbed_return(F,Len, _Type), append(Args,[Result],PArgs), safe_univ(IsPred,F,PArgs),!. h2p(W,Data,Result,IsPred):- W\== boolean, as_functor_args(Data,F,A,_Args), is_data_functor(F,AA),!, (AA=A -> (IsPred = (Data =~ Result)) ; was_predicate(Data,Result,IsPred)). h2p(pred,AsPred,Result,IsPred):- as_functor_args(AsPred,F,A,Args), always_predicate_in_src(F,A),!, once(functional_predicate_arg(F, A, Nth);Nth=A), \+ is_absorbed_return(F,_, _Bool), nth1(Nth,Args,Result), IsPred=..[F|Args]. h2p(func,AsFunction,Result,IsPred):- as_functor_args(AsFunction,F,A0,FArgs), \+ is_absorbed_return(F,A0, _Bool), always_function_in_src(F,A0),!,A is A0 + 1, once(functional_predicate_arg(F, A, Nth);Nth=A), nth1(Nth,Args,Result,FArgs), IsPred=..[F|Args]. */ ar2q(MeTTa,Result,IsPred):- ar2q(_,MeTTa,Result,IsPred). ar2q(pred,AsPred,Result,IsPred):- as_functor_args(AsPred,F,A,Args), once(functional_predicate_arg(F, A, Nth);Nth=A), nth1(Nth,Args,Result), \+ is_absorbed_return(F,_, _Bool), IsPred=..[F|Args]. ar2q(funct,AsFunction,Result,IsPred):- as_functor_args(AsFunction,F,A0,FArgs),A is A0 + 1, \+ is_absorbed_return(F,_, _Bool), once(functional_predicate_arg(F, A, Nth);Nth=A), nth1(Nth,Args,Result,FArgs), IsPred=..[F|Args]. ar2q(pred,AsPred,Result,IsPred):- as_functor_args(AsPred,F,A,Args), is_absorbed_return_value(F,A,AsPred,Result), IsPred=..[F|Args],!. was_predicate(AsPred,Result,IsPred):- as_functor_args(AsPred,F,A,Args), is_absorbed_return_value(F,A,AsPred,Result), IsPred=..[F|Args],!. was_predicate(AsPred,Result,IsPred):- as_functor_args(AsPred,F,A,Args), once(functional_predicate_arg(F, A, Nth);Nth=A), \+ is_non_absorbed_return(F,A, _Bool), nth1(Nth,Args,Result), IsPred=..[F|Args]. was_function(AsFunction,Result,IsPred):- as_functor_args(AsFunction,F,A0,FArgs), ( ( \+ is_absorbed_return(F,A0,_)) ; is_non_absorbed_return(F,A0,_)), A is A0 + 1, once(functional_predicate_arg(F, A, Nth);Nth=A), nth1(Nth,Args,Result,FArgs), IsPred=..[F|Args]. funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, Nth, AsPred):- var(AsPred),!, funct_with_result_is_nth_of_pred0(HeadIs,AsFunction, Result, Nth, Pred), into_callable(Pred,AsPred). funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, Nth, AsPred):- var(AsFunction),!, funct_with_result_is_nth_of_pred0(HeadIs,Function, Result, Nth, AsPred), into_callable(Function,AsFunction). funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, Nth, AsPred):- funct_with_result_is_nth_of_pred0(HeadIs,AsFunction, Result, Nth, AsPred). % Handles the case where AsFunction is a variable. % It creates a compound term 'AsPred' and places the 'Result' at the 'Nth' position % of the predicate arguments, and the 'AsFunction' represents the functional form with % arguments excluding the result. funct_with_result_is_nth_of_pred0(_HeadIs,AsFunction, Result, Nth, AsPred) :- is_nsVar(AsFunction),!, compound(AsPred), compound_name_list(AsPred,FP,PredArgs), nth1(Nth,PredArgs,Result,FuncArgs), do_predicate_function_canonical(FP,F), AsFunction =~ [F,FuncArgs]. % Handles the case where 'AsFunction' is not a variable. % It decomposes 'AsFunction' to get the as_functor_args and arguments (FuncArgs) of the function % and then it constructs the equivalent predicate 'AsPred' with 'Result' at the 'Nth' % position of the predicate arguments. funct_with_result_is_nth_of_pred0(HeadIs,AsFunctionO, Result, Nth, (AsPred)) :- de_eval(AsFunctionO,AsFunction),!,funct_with_result_is_nth_of_pred0(HeadIs,AsFunction, Result, Nth, AsPred). funct_with_result_is_nth_of_pred0(HeadIs,AsFunction, Result, _Nth, AsPred) :- nonvar(AsFunction), compound(AsFunction), \+ is_arity_0(AsFunction,_), as_functor_args(AsFunction,F,A), HeadIs\=@=AsFunction, \+ (compound(HeadIs), (is_arity_0(HeadIs,HF);as_functor_args(HeadIs,HF,_))-> HF==F), (into_u_assign(AsFunction, Result,AsPred) -> true ; (AA is A+1, (FAA=(F/AA)), \+ current_predicate(FAA), !, AsPred = call_fr(AsFunction,Result,FAA))). funct_with_result_is_nth_of_pred0(_HeadIs,AsFunction, Result, Nth, (AsPred)) :- (symbol(AsFunction)->AsFunction =~ [F | FuncArgs]; compound_name_list(AsFunction,F,FuncArgs)), ignore(var(Nth) -> is_function(AsFunction,Nth); true), nth1(Nth, PredArgs, Result, FuncArgs), % It places 'Result' at the 'Nth' position AA is Nth+1, \+ current_predicate(F/AA), do_predicate_function_canonical(FP,F), AsPred =~ [FP | PredArgs]. % It forms the predicate 'AsPred' by joining the as_functor_args with the modified arguments list. funct_with_result_is_nth_of_pred0(_HeadIs,AsFunction, Result, Nth, (AsPred)) :- nonvar(AsFunction), AsFunction =~ [F | FuncArgs], do_predicate_function_canonical(FP,F), length(FuncArgs, Len), ignore(var(Nth) -> is_function(AsFunction,Nth); true), ((number(Nth),Nth > Len + 1) -> (trace,throw(error(index_out_of_bounds, _))); true), (var(Nth)->(between(1,Len,From1),Nth is Len-From1+1);true), nth1(Nth,PredArgs,Result,FuncArgs), AsPred =~ [FP | PredArgs]. % optionally remove next line funct_with_result_is_nth_of_pred0(_HeadIs,AsFunction, _, _, _) :- var(AsFunction), throw(error(instantiation_error, _)). % The remove_funct_arg/3 predicate is a utility predicate that removes % the Nth argument from a predicate term, effectively converting a % predicate to a function. The first argument is the input predicate term, % the second is the position of the argument to be removed, and the third % is the output function term. remove_funct_arg(AsPred, Nth, AsFunction) :- % Decompose AsPred into its as_functor_args and arguments. AsPred =~ [F | PredArgs], % Remove the Nth element from PredArgs, getting the list FuncArgs. nth1(Nth,PredArgs,_Result,FuncArgs), % Construct AsFunction using the as_functor_args and the list FuncArgs. do_predicate_function_canonical(F,FF), compound_name_list(AsFunction,FF,FuncArgs). % deep_lhs_sub_sterm/2 predicate traverses through a given Term % and finds a sub-term within it. The sub-term is unifiable with ST. % This is a helper predicate used in conjunction with others to inspect % and transform terms. deep_lhs_sub_sterm(ST, Term):- deep_lhs_sub_sterm0(ST, Term), ST\=@=Term. deep_lhs_sub_sterm0(_, Term):- never_subterm(Term),!,fail. deep_lhs_sub_sterm0(ST, Term):- Term =~ if(Cond,_Then,_Else),!,deep_lhs_sub_sterm0(ST, Cond). deep_lhs_sub_sterm0(ST, Term):- Term =~ 'if-error'(Cond,_Then,_Else),!,deep_lhs_sub_sterm0(ST, Cond). deep_lhs_sub_sterm0(ST, Term):- Term =~ 'if-decons'(Cond,_Then,_Else),!,deep_lhs_sub_sterm0(ST, Cond). deep_lhs_sub_sterm0(ST, Term):- Term =~ 'chain'(Expr,_Var,_Next),!,deep_lhs_sub_sterm0(ST, Expr). deep_lhs_sub_sterm0(ST, Term):- % If Term is a list, it reverses the list and searches for a member % in the reversed list that is unifiable with ST. is_list(Term),!,member(E,Term),deep_lhs_sub_sterm0(ST, E). deep_lhs_sub_sterm0(ST, Term):- % If Term is a compound term, it gets its arguments and then recursively % searches in those arguments for a sub-term unifiable with ST. compound(Term), compound_name_list(Term,_,Args),deep_lhs_sub_sterm0(ST, Args). deep_lhs_sub_sterm0(ST, ST):- % If ST is non-var, not an empty list, and callable, it unifies % ST with Term if it is unifiable. nonvar(ST), ST\==[], callable(ST). never_subterm(Term):- is_ftVar(Term). never_subterm([]). never_subterm('Nil'). %never_subterm(F):- symbol(F),not_function(F,0). % rev_member/2 predicate is a helper predicate used to find a member % of a list. It is primarily used within deep_lhs_sub_sterm/2 to % traverse through lists and find sub-terms. It traverses the list % from the end to the beginning, reversing the order of traversal. rev_member(E,[_|L]):- rev_member(E,L). rev_member(E,[E|_]). % Continuing from preds_to_functs/2 % Converts a given predicate representation to its equivalent function representation preds_to_functs(Convert, Converted):- % Verbose_unify/1 here may be used for debugging or to display detailed unification information verbose_unify(Convert), % Calls the auxiliary predicate preds_to_functs0/2 to perform the actual conversion preds_to_functs0(Convert, Converted). % if Convert is a variable, Converted will be the same variable preds_to_functs0(Convert, Converted) :- is_ftVar(Convert), !, Converted = Convert. % 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), cname_var('HEAD_RES',Result), 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,[u_assign(AsBodyFunction,Result)|Right],NewRevList), reverse(NewRevList,NewList), list_to_conjuncts(NewList,NewBody), preds_to_functs0(NewBody,ConvertedBody), % The final Converted term is constructed into_equals(AsFunction,ConvertedBody,Converted)). % Handles the case where Convert is a conjunction, and AsPred is not not_function. % It converts predicates to functions inside a conjunction preds_to_functs0((AsPred, Convert), Converted) :- \+ not_function(AsPred), pred_to_funct(AsPred, AsFunction, Result), sub_var(Result, Convert), !, % The function equivalent of AsPred replaces Result in Convert subst(Convert, Result, AsFunction, Converting), preds_to_functs0(Converting, Converted). % Handles the special case where u_assign/2 is used and returns the function represented by the first argument of u_assign/2 preds_to_functs0(u_assign(AsFunction, _Result), AsFunction) :- !. % Handles the general case where Convert is a conjunction. % It converts the predicates to functions inside a conjunction preds_to_functs0((AsPred, Converting), (AsPred, Converted)) :- !, 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, u_assign(AsFunction, Result)) :- pred_to_funct(AsPred, AsFunction, Result), !. % any other term remains unchanged preds_to_functs0(X, X). % Converts a given predicate AsPred to its equivalent function term AsFunction pred_to_funct(AsPred, AsFunction, Result) :- compound(AsPred), % Checks if AsPred is a compound term as_functor_args(AsPred, F, A), % Retrieves the as_functor_args F and arity A of AsPred functional_predicate_arg(F, A, Nth),!, % Finds the Nth argument where the result should be arg(Nth, AsPred, Result), % Retrieves the result from the Nth argument of AsPred remove_funct_arg(AsPred, Nth, AsFunction). % Constructs the function AsFunction by removing the Nth argument from AsPred % If not found in functional_predicate_arg/3, it tries to construct AsFunction by removing the last argument from AsPred pred_to_funct(AsPred, AsFunction, Result) :- compound(AsPred), !, as_functor_args(AsPred, _, Nth), arg(Nth, AsPred, Result), remove_funct_arg(AsPred, Nth, AsFunction). % body_member/4 is utility predicate to handle manipulation of body elements in the clause, but the exact implementation details and usage are not provided in the given code. body_member(Body,BE,NewBE,NewBody):- conjuncts_to_list(Body,List), reverse(List,RevList),append(Left,[BE|Right],RevList), append(Left,[NewBE|Right],NewRevList), reverse(NewRevList,NewList), list_to_conjuncts(NewList,NewBody). % combine_clauses/3 is the main predicate combining clauses with similar heads and bodies. % HeadBodiesList is a list of clauses (Head:-Body) % NewHead will be the generalized head representing all clauses in HeadBodiesList % NewCombinedBodies will be the combined bodies of all clauses in HeadBodiesList. combine_clauses(HeadBodiesList, NewHead, NewCombinedBodies) :- % If HeadBodiesList is empty, then NewCombinedBodies is 'false' and NewHead is an anonymous variable. (HeadBodiesList = [] -> NewCombinedBodies = false, NewHead = _ ; % Find all Heads in HeadBodiesList and collect them in the list Heads findall(Head, member((Head:-_), HeadBodiesList), Heads), % Find the least general head among the collected Heads least_general_head(Heads, LeastHead), as_functor_args(LeastHead,F,A),as_functor_args(NewHead,F,A), % Transform and combine bodies according to the new head found 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))))),!. % 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. least_general_head(Heads, LeastGeneralHead) :- lgu(Heads, LeastGeneralHead). % the LGU of a single head is the head itself. lgu([Head], Head) :- !. % find the LGU of the head and the rest of the list. lgu([H1|T], LGU) :- lgu(T, TempLGU), % Find generalization between head H1 and temporary LGU generalization(H1, TempLGU, LGU). % generalization/3 finds the generalization of two heads, Head1 and Head2, which is represented by GeneralizedHead. % This predicate is conceptual and will require more complex processing depending on the actual structures of the heads. generalization(Head1, Head2, GeneralizedHead) :- % Ensure the as_functor_args names and arities are the same between Head1 and Head2. as_functor_args(Head1, Name, Arity), as_functor_args(Head2, Name, Arity), as_functor_args(GeneralizedHead, Name, Arity), % Generalize the arguments of the heads. generalize_args(Arity, Head1, Head2, GeneralizedHead). % no more arguments to generalize. generalize_args(0, _, _, _) :- !. % generalize the corresponding arguments of the heads. generalize_args(N, Head1, Head2, GeneralizedHead) :- arg(N, Head1, Arg1), arg(N, Head2, Arg2), % If the corresponding arguments are equal, use them. Otherwise, create a new variable. (Arg1 = Arg2 -> arg(N, GeneralizedHead, Arg1); arg(N, GeneralizedHead, _)), % Continue with the next argument. N1 is N - 1, generalize_args(N1, Head1, Head2, GeneralizedHead). % transform_and_combine_bodies/3 takes a list of clause heads and bodies, a new head, and produces a combined body representing all the original bodies. % The new body is created according to the transformations required by the new head. transform_and_combine_bodies([(Head:-Body)|T], NewHead, CombinedBodies) :- % Transform the body according to the new head. transform(Head, NewHead, Body, TransformedBody), % Combine the transformed body with the rest. combine_bodies(T, NewHead, TransformedBody, CombinedBodies). /* OLD % Define predicate combine_clauses to merge multiple Prolog clauses with the same head. % It receives a list of clauses as input and returns a combined clause. combine_clauses([Clause], Clause) :- !. % If there's only one clause, return it as is. combine_clauses(Clauses, (Head :- Body)) :- % If there are multiple clauses, combine them. Clauses = [(Head :- FirstBody)|RestClauses], % Decompose the list into the first clause and the rest. combine_bodies(RestClauses, FirstBody, Body). % Combine the bodies of all the clauses. % Helper predicate to combine the bodies of a list of clauses. % The base case is when there are no more clauses to combine; the combined body is the current body. combine_bodies([], Body, Body). combine_bodies([(Head :- CurrentBody)|RestClauses], PrevBody, Body) :- % Combine the current body with the previous body using a conjunction (,). combine_two_bodies(PrevBody, CurrentBody, CombinedBody), % Recursively combine the rest of the bodies. combine_bodies(RestClauses, CombinedBody, Body). % Predicate to combine two bodies. % Handles the combination of different Prolog constructs like conjunctions, disjunctions, etc. combine_two_bodies((A, B), (C, D), (A, B, C, D)) :- !. % Combine conjunctions. combine_two_bodies((A; B), (C; D), (A; B; C; D)) :- !. % Combine disjunctions. combine_two_bodies(A, B, (A, B)). % Combine simple terms using conjunction. */ % if there are no more bodies, the accumulated Combined is the final CombinedBodies. combine_bodies([], _, Combined, Combined). % combine the transformed body with the accumulated bodies. combine_bodies([(Head:-Body)|T], NewHead, Acc, CombinedBodies) :- transform(Head, NewHead, Body, TransformedBody), % Create a disjunction between the accumulated bodies and the transformed body. NewAcc = (Acc;TransformedBody), combine_bodies(T, NewHead, NewAcc, CombinedBodies). % combine_code/3 combines Guard and Body to produce either Guard, Body, or a conjunction of both, depending on the values of Guard and Body. combine_code(Guard, Body, Guard) :- Body==true, !. combine_code(Guard, Body, Body) :- Guard==true, !. combine_code((A,B,C), Body, Out):- combine_code(C,Body,CBody),combine_code(B,CBody,BCBody),combine_code(A,BCBody,Out). combine_code((AB,C), Body, Out):- combine_code(C,Body,CBody),combine_code(AB,CBody,Out). combine_code(Guard, Body, (Guard, Body)). combine_code([A|Nil],O):- Nil==[],!,combine_code(A,O). combine_code([A|B],O):- \+ is_list(B),combine_code(A,AA),combine_code(B,BB),!, combine_code([AA,BB],O). combine_code([A,B|C],O):- \+ is_list(B), combine_code(A,AA),combine_code(B,BB),!, combine_code(AA,BB,AB), combine_code([AB|C],O),!. combine_code((A;O),(AA;OO)):- !, combine_code(A,AA),combine_code(O,OO). combine_code(AO,AO). % create_unifier/3 creates a unification code that unifies OneHead with NewHead. % If OneHead and NewHead are structurally equal, then they are unified and the unification Guard is 'true'. % Otherwise, the unification code is 'metta_unify(OneHead,NewHead)'. create_unifier(OneHead,NewHead,Guard):- OneHead=@=NewHead,OneHead=NewHead,!,Guard=true. create_unifier(OneHead,NewHead,Guard):- compound(OneHead), compound_name_list(OneHead,_,Args1), compound_name_list(NewHead,_,Args2), create_unifier_goals(Args1,Args2,Guard),!. create_unifier(OneHead,NewHead,u(OneHead,NewHead)). create_unifier_goals([V1],[V2],u(V1,V2)):-!. create_unifier_goals([V1|Args1],[V2|Args2],RightGuard):-!, create_unifier_goals(Args1,Args2,Guard), combine_code(u(V1,V2),Guard,RightGuard). create_unifier_goals([],[],true). % transform/4 combines unification code with Body to produce NewBody according to the transformations required by NewHead. % It uses create_unifier/3 to generate the unification code between OneHead and NewHead. transform(OneHead, NewHead, Body, NewBody):- create_unifier(OneHead,NewHead,Guard), combine_code(Guard,Body,NewBody). unnumbervars_clause(Cl,ClU):- copy_term_nat(Cl,AC),unnumbervars(AC,UA),copy_term_nat(UA,ClU). % =============================== % Compile in memory buffer % =============================== is_clause_asserted(AC):- unnumbervars_clause(AC,UAC), expand_to_hb(UAC,H,B),clause(H,B,Ref),clause(HH,BB,Ref), strip_m(HH,HHH),HHH=@=H, strip_m(BB,BBB),BBB=@=B,!. strip_m(M:BB,BB):- nonvar(BB),nonvar(M),!. strip_m(BB,BB). get_clause_pred(UAC,F,A):- expand_to_hb(UAC,H,_),strip_m(H,HH),functor(HH,F,A). :- dynamic(needs_tabled/2). add_assertion(Space,List):- is_list(List),!,maplist(add_assertion(Space),List). add_assertion(Space,AC):- unnumbervars_clause(AC,UAC), add_assertion1(Space,UAC). add_assertion1(_,AC):- /*'&self':*/is_clause_asserted(AC),!. add_assertion1(_,AC):- get_clause_pred(AC,F,A), \+ needs_tabled(F,A), !, pfcAdd(/*'&self':*/AC),!. add_assertion1(_KB,ACC) :- copy_term(ACC,AC,_), expand_to_hb(AC,H,_), as_functor_args(H,F,A), as_functor_args(HH,F,A), % assert(AC), % Get the current clauses of my_predicate/1 findall(HH:-B,clause(/*'&self':*/HH,B),Prev), copy_term(Prev,CPrev,_), % Create a temporary file and add the new assertion along with existing clauses append(CPrev,[AC],NewList), cl_list_to_set(NewList,Set), length(Set,N), if_t(N=2, (Set=[X,Y], numbervars(X), numbervars(Y), nl,display(X), nl,display(Y), nl)), %wdmsg(list_to_set(F/A,N)), abolish(/*'&self':*/F/A), create_and_consult_temp_file(F/A, Set). cl_list_to_set([A|List],Set):- member(B,List),same_clause(A,B),!, cl_list_to_set(List,Set). cl_list_to_set([New|List],[New|Set]):-!, cl_list_to_set(List,Set). cl_list_to_set([A,B],[A]):- same_clause(A,B),!. cl_list_to_set(List,Set):- list_to_set(List,Set). same_clause(A,B):- A==B,!. same_clause(A,B):- A=@=B,!. same_clause(A,B):- unnumbervars_clause(A,AA),unnumbervars_clause(B,BB),same_clause1(AA,BB). same_clause1(A,B):- A=@=B. same_clause1(A,B):- expand_to_hb(A,AH,AB),expand_to_hb(B,BH,BB),AB=@=BB, AH=@=BH,!. %clause('is-closed'(X),OO1,Ref),clause('is-closed'(X),OO2,Ref2),Ref2\==Ref, OO1=@=OO2. % Predicate to create a temporary file and write the tabled predicate create_and_consult_temp_file(F/A, PredClauses) :- % Generate a unique temporary memory buffer tmp_file_stream(text, TempFileName, TempFileStream), % Write the tabled predicate to the temporary file format(TempFileStream, ':- multifile((~q)/~w).~n', [F, A]), format(TempFileStream, ':- dynamic((~q)/~w).~n', [F, A]), %if_t( \+ option_value('tabling',false), if_t(option_value('tabling','True'),format(TempFileStream,':- ~q.~n',[table(F/A)])), maplist(write_clause(TempFileStream), PredClauses), % Close the temporary file close(TempFileStream), % Consult the temporary file % abolish(F/A), /*'&self':*/consult(TempFileName), % Delete the temporary file after consulting %delete_file(TempFileName), %assert(metta_compiled_predicate(F,A)). true. % Helper predicate to write a clause to the file write_clause(Stream, Clause) :- subst_vars(Clause,Can), write_canonical(Stream, Can), write(Stream, '.'), nl(Stream). same(X,Y):- X =~ Y. end_of_file. % If any sub-term of Convert is a control flow imperative, convert that sub-term and then proceed with the conversion. f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- fail, % Get the least deepest sub-term AsFunction of Convert get_first_p1(AsFunction,Convert,N1Cmpd), arg(2,N1Cmpd,Cmpd), Cmpd \= ( ==(_,_) ), (Cmpd = [EE,_,_] -> (EE \== '==') ; true ), AsFunction\=@= Convert, callable(AsFunction), % Check if AsFunction is callable Depth2 is Depth -0, % check that that is is a control flow imperative f2q(Depth2,HeadIs,RetType,Result,AsFunction, AsPred), HeadIs\=@=AsFunction,!, subst(Convert, AsFunction, Result, Converting), % Substitute AsFunction by Result in Convert f2p(Depth2,HeadIs,RetType,RetResult,(AsPred,Result==AsFunction,Converting), Converted). % Proceed with the conversion of the remaining terms % If any sub-term of Convert is a control flow imperative, convert that sub-term and then proceed with the conversion. f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- fail, deep_lhs_sub_sterm(AsFunction, Convert), AsFunction\=@= Convert, % Get the deepest sub-term AsFunction of Convert % sub_term(AsFunction, Convert), AsFunction\==Convert, callable(AsFunction), % Check if AsFunction is callable Depth2 is Depth -0, f2q(Depth2,HeadIs,RetType,Result,AsFunction, AsPred), HeadIs\=@=AsFunction,!, subst(Convert, AsFunction, Result, Converting), % Substitute AsFunction by Result in Convert f2p(Depth2,HeadIs,RetType,RetResult,(AsPred,Converting), Converted). % Proceed with the conversion of the remaining terms % If any sub-term of Convert is a function, convert that sub-term and then proceed with the conversion. f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- fail, deep_lhs_sub_sterm(AsFunction, Convert), % Get the deepest sub-term AsFunction of Convert AsFunction\=@= Convert, callable(AsFunction), % Check if AsFunction is callable %is_function(AsFunction, Nth), % Check if AsFunction is a function and get the position Nth where the result is stored/retrieved HeadIs\=@=AsFunction, funct_with_result_is_nth_of_pred(HeadIs,AsFunction, Result, _Nth, AsPred), % Convert AsFunction to a predicate AsPred subst(Convert, AsFunction, Result, Converting), % Substitute AsFunction by Result in Convert f2p(Depth,HeadIs,RetType,RetResult, (AsPred, Converting), Converted). % Proceed with the conversion of the remaining terms /* % If AsFunction is a recognized function, convert it to a predicate. f2q(Depth,HeadIs,RetType,RetResult,AsFunction,AsPred):- % HeadIs\=@=AsFunction, is_function(AsFunction, Nth), % Check if AsFunction is a recognized function and get the position Nth where the result is stored/retrieved 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 u_assign/2, convert that sub-term and then proceed with the conversion. f2q(Depth,HeadIs,RetType,RetResult,Convert, Converted) :- fail, deep_lhs_sub_sterm0(ConvertFunction, Convert), % Get the deepest sub-term AsFunction of Convert callable(ConvertFunction), % Check if AsFunction is callable ConvertFunction = u_assign(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 f2p(Depth,HeadIs,RetType,RetResult, (AsPred, Converting), Converted). % Proceed with the conversion of the remaining terms