diff --git a/prolog/metta_lang/metta_eval.pl b/prolog/metta_lang/metta_eval.pl index 21504867b8..7eaebd955f 100755 --- a/prolog/metta_lang/metta_eval.pl +++ b/prolog/metta_lang/metta_eval.pl @@ -269,6 +269,7 @@ subst_args_here(_Eq,_RetType,_Depth2,_Self,Y,YO):- wont_need_subst(Y),!, Y=YO. subst_args_here(Eq,RetType,Depth2,Self,Y,YO):- subst_args(Eq,RetType,Depth2,Self,Y,YO), + %Y =YO, notrace(if_t_else((wont_need_subst(Y),Y\=@=YO), (write_src_uo(needed_subst_args(Y,YO)),bt,sleep(1.0)), nop(write_src_uo(unneeded_subst_args(Y))))). @@ -1537,9 +1538,12 @@ % Placeholder to deal with formatting {:} later format_args_get_format(FormatRest, FormatRest, _). -format_args_write(Arg,_) :- string(Arg), !, write(Arg). -format_args_write('#\\'(Arg),_) :- !, write(Arg). -format_args_write(Arg,_) :- write_src_woi(Arg). +format_args_write(Arg,_) :- \+ compound(Arg), !, format_arg(Arg). +format_args_write('#\\'(Char),_) :- !, format_arg(Char). +format_args_write(Arg,_) :- format_arg(Arg). + +format_arg(Arg) :- string(Arg), !, write(Arg). +format_arg(Arg):- \+ \+ write_src_woi(Arg). format_nth_args([], _, _). format_nth_args(['{','{'|FormatRest], Iterator, Args) :- !, put('{'), format_nth_args(FormatRest, Iterator, Args). % escaped diff --git a/prolog/metta_lang/metta_interp.pl b/prolog/metta_lang/metta_interp.pl index b2fe793540..f4e32c2348 100755 --- a/prolog/metta_lang/metta_interp.pl +++ b/prolog/metta_lang/metta_interp.pl @@ -368,8 +368,12 @@ :- use_module(library(shell)). %:- use_module(library(tabling)). -:- nb_setval(self_space, '&self'). -current_self(Self):- ((nb_current(self_space,Self),Self\==[])->true;Self='&self'). +use_top_self :- \+ fast_option_value('top-self', false). +top_self('&top'):- use_top_self,!. +top_self('&self'). + +%:- top_self(Self), nb_setval(self_space, '&self'), +current_self(Self):- ((nb_current(self_space,Self),Self\==[])->true;top_self(Self)). :- nb_setval(repl_mode, '+'). @@ -411,6 +415,7 @@ option_value_name_default_type_help('repeats', true, [true, false], "false to avoid repeated results", 'Miscellaneous'). option_value_name_default_type_help('time', true, [false, true], "Enable or disable timing for operations (in Rust compatibility mode, this is false)", 'Miscellaneous'). option_value_name_default_type_help('vn', auto, [auto, true, false], "Enable or disable, (auto = enable but not if it breaks stuff) EXPERIMENTAL BUG-FIX where variable names are preserved (see https://github.com/trueagi-io/metta-wam/issues/221)", 'Miscellaneous'). +option_value_name_default_type_help('top-self', false, [true, false, auto], "When set, stop pretending &self==&top", 'Miscellaneous'). % Testing and Validation option_value_name_default_type_help('synth-unit-tests', false, [false, true], "Synthesize unit tests", 'Testing and Validation'). @@ -1410,6 +1415,11 @@ %get_metta_atom(Eq,KB, [F|List]):- KB='&flybase',fb_pred(F, Len), length(List,Len),apply(F,List). +maybe_into_top_self(WSelf, Self):- use_top_self,WSelf=='&self',current_self(Self),Self\==WSelf,!. +into_top_self(WSelf, Self):- maybe_into_top_self(WSelf, Self),!. +into_top_self(Self, Self). + + get_metta_atom_from(KB,Atom):- metta_atom(KB,Atom). get_metta_atom(Eq,Space, Atom):- metta_atom(Space, Atom), \+ (Atom =[EQ,_,_], EQ==Eq). @@ -1419,22 +1429,26 @@ metta_atom(Space, Atom):- typed_list(Space,_,L),!, member(Atom,L). metta_atom(KB, [F, A| List]):- KB=='&flybase',fb_pred_nr(F, Len),current_predicate(F/Len), length([A|List],Len),apply(F,[A|List]). %metta_atom(KB,Atom):- KB=='&corelib',!, metta_atom_corelib(Atom). +%metta_atom(X,Y):- use_top_self,maybe_resolve_space_dag(X,XX),!,in_dag(XX,XXX),XXX\==X,metta_atom(XXX,Y). + +metta_atom(X,Y):- maybe_into_top_self(X, TopSelf),!,metta_atom(TopSelf,Y). +%metta_atom(X,Y):- var(X),use_top_self,current_self(TopSelf),metta_atom(TopSelf,Y),X='&self'. metta_atom(KB,Atom):- metta_atom_in_file( KB,Atom). metta_atom(KB,Atom):- metta_atom_asserted( KB,Atom). %metta_atom(KB,Atom):- KB == '&corelib', !, metta_atom_asserted('&self',Atom). -metta_atom(KB,Atom):- KB \== '&corelib', using_all_spaces,!, metta_atom('&corelib',Atom). +%metta_atom(KB,Atom):- KB \== '&corelib', using_all_spaces,!, metta_atom('&corelib',Atom). %metta_atom(KB,Atom):- KB \== '&corelib', !, metta_atom('&corelib',Atom). -metta_atom(KB,Atom):- KB \== '&corelib', !, +metta_atom(KB,Atom):- KB \== '&corelib', !, % is_code_inheritor(KB), \+ \+ (metta_atom_asserted(KB,'&corelib'), should_inherit_from_corelib(Atom)), !, metta_atom('&corelib',Atom). should_inherit_from_corelib(_):- using_all_spaces,!. -should_inherit_from_corelib([H,A|_]):- H == ':',!,nonvar(A). -should_inherit_from_corelib([H|_]):- H == '@doc', !. +should_inherit_from_corelib([H,A|_]):- nonvar(A), should_inherit_op_from_corelib(H),!,nonvar(A). +%should_inherit_from_corelib([H|_]):- H == '@doc', !. should_inherit_from_corelib([H,A|T]):- fail, - H == '=',write_src_uo(try([H,A|T])),!,is_list(A), - A=[F|_],nonvar(F), F \==':', + H == '=',write_src_uo(try([H,A|T])),!, + A=[F|_],nonvar(F), F \==':',is_list(A), \+ metta_atom_asserted('&self',[:,F|_]), % \+ \+ metta_atom_asserted('&corelib',[=,[F|_]|_]), write_src_uo([H,A|T]). @@ -1446,12 +1460,13 @@ should_inherit_op_from_corelib('@doc'). %should_inherit_op_from_corelib(_). -metta_atom_asserted('&self','&corelib'). -metta_atom_asserted('&self','&stdlib'). -metta_atom_asserted('top','&corelib'). -metta_atom_asserted('top','&stdlib'). +%metta_atom_asserted('&self','&corelib'). +%metta_atom_asserted('&self','&stdlib'). +metta_atom_asserted(Top,'&corelib'):- top_self(Top). +metta_atom_asserted(Top,'&stdlib'):- top_self(Top). metta_atom_asserted('&stdlib','&corelib'). metta_atom_asserted('&flybase','&corelib'). +metta_atom_asserted('&flybase','&stdlib'). metta_atom_asserted('&catalog','&corelib'). metta_atom_asserted('&catalog','&stdlib'). @@ -1461,13 +1476,14 @@ in_dag(X,X). space_to_ctx(Top,Var):- nonvar(Top),current_self(Top),!,Var='&self'. -space_to_ctx(Top,Var):- 'mod-space'(Top,Var). +space_to_ctx(Top,Var):- 'mod-space'(Top,Var),!. +space_to_ctx(Var,Var). -'mod-space'(top,'&self'). +'mod-space'(top,'&top'). 'mod-space'(catalog,'&catalog'). 'mod-space'(corelib,'&corelib'). 'mod-space'(stdlib,'&stdlib'). -'mod-space'(Top,'&self'):- Top == self. +'mod-space'(Top,'&self'):- current_self(Top). not_metta_atom_corelib(A,N):- A \== '&corelib' , metta_atom('&corelib',N). @@ -1766,24 +1782,29 @@ ignore(( symbolic(Cmt),symbolic_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),!, + must_det_ll((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). + + +% Prolog CALL do_metta(From,_,Self, call(Expr),Out):- !, do_metta(From,call,Self,Expr,Out). do_metta(From,_,Self, ':-'(Expr),Out):- !, do_metta(From,call,Self,Expr,Out). do_metta(From,call,Self,TermV,FOut):- !, if_t(into_simple_op(call,TermV,OP),pfcAdd_Now('next-operation'(OP))), call_for_term_variables(TermV,Term,NamedVarsList,X), must_be(nonvar,Term), copy_term(NamedVarsList,Was), - Output = NamedVarsList, - user:u_do_metta_exec(From,Self,TermV,Term,X,NamedVarsList,Was,Output,FOut). + Output = X, + user:u_do_metta_exec(From,Self,call(TermV),Term,X,NamedVarsList,Was,Output,FOut). +% Non Exec do_metta(_File,Load,Self,Src,Out):- Load\==exec, !, if_t(into_simple_op(Load,Src,OP),pfcAdd_Now('next-operation'(OP))), dont_give_up(as_tf(asserted_do_metta(Self,Load,Src),Out)). +% Doing Exec do_metta(file(Filename),exec,Self,TermV,Out):- must_det_ll((inc_exec_num(Filename), get_exec_num(Filename,Nth), @@ -1823,13 +1844,79 @@ o_s(S,S). into_simple_op(Load,[Op|O],op(Load,Op,S)):- o_s(O,S),!. -call_for_term_variables(TermV,catch_red(show_failure(Term)),NamedVarsList,X):- - term_variables(TermV, AllVars), call_for_term_variables4v(TermV,AllVars,Term,NamedVarsList,X),!, - must_be(callable,Term). -call_for_term_variables(TermV,catch_red(show_failure(Term)),NamedVarsList,X):- - get_term_variables(TermV, DCAllVars, Singletons, NonSingletons), - call_for_term_variables5(TermV, DCAllVars, Singletons, NonSingletons, Term,NamedVarsList,X),!, - must_be(callable,Term). + +%! call_for_term_variables(+Term, +X, -Result, -NamedVarsList, +TF) is det. +% Handles the term `Term` and determines the term variable list and final result. +% This version handles the case when the term has no variables and converts it to a truth-functional form. +% +% @arg Term The input term to be analyzed. +% @arg X The list of variables found within the term. It can be empty or contain one variable. +% @arg Result The final result, either as the original term or transformed into a truth-functional form. +% @arg NamedVarsList The list of named variables associated with the term. +% @arg TF The truth-functional form when the term has no variables. +% +% @example +% % Example with no variables: +% ?- call_for_term_variables(foo, Result, Vars, TF). +% Result = as_tf(foo, TF), +% Vars = []. +% +call_for_term_variables(TermV,catch_red(show_failure(TermR)),NewNamedVarsList,X):- + subst_vars(TermV,Term,NamedVarsList), + wwdmsg(subst_vars(TermV,Term,NamedVarsList)), + term_variables(Term, AllVars), + %get_global_varnames(VNs), append(NamedVarsList,VNs,All), nb_setval('$variable_names',All), wdmsg(term_variables(Term, AllVars)=All), + term_singletons(Term, Singletons),term_dont_cares(Term, DontCares), + + wwdmsg((term_singletons(Term, Singletons),term_dont_cares(Term, DontCares))), + include(not_in_eq(Singletons), AllVars, NonSingletons), + wwdmsg([dc=DontCares, sv=Singletons, ns=NonSingletons]), !, + include(not_in_eq(DontCares), NonSingletons, CNonSingletons), + include(not_in_eq(DontCares), Singletons, CSingletons), + wwdmsg([dc=DontCares, csv=CSingletons, cns=CNonSingletons]),!, + maplist(maplist(into_named_vars), + [DontCares, CSingletons, CNonSingletons], + [DontCaresN, CSingletonsN, CNonSingletonsN]), + wwdmsg([dc_nv=DontCaresN, sv_nv=CSingletonsN, ns_nv=CNonSingletonsN]), + call_for_term_variables5(Term, DontCaresN, CNonSingletonsN, CSingletonsN, TermR, NamedVarsList, NewNamedVarsList, X),!, + wwdmsg(call_for_term_variables5(orig=Term, all=DontCaresN, singles=CSingletonsN, shared=CNonSingletonsN, call=TermR, nvl=NamedVarsList, nvlo=NewNamedVarsList, output=X)). + +wwdmsg(_). +% If the term is ground, return the as_tf form. +%call_for_term_variables5(Term,_,_,_,as_tf(Term,Ret),VL,['$RetVal'=Ret|VL],[==,['call!',Term],Ret]) :- ground(Term), !. +% If the term is ground, create a call_nth with the term. +call_for_term_variables5(Term,_,_,_,call_nth(Term,Count),VL,['Count'=Count|VL],Ret) :- Ret=Term. + + +into_metta_callable(_Self,CALL,Term,X,NamedVarsList,Was):- fail, + % wdmsg(mc(CALL)), + CALL= call(TermV), + \+ never_compile(TermV), + must_det_ll(((( + term_variables(TermV,Res), + % ignore(Res = '$VAR'('ExecRes')), + RealRes = Res, + TermV=ExecGoal, + %format("~w ~w\n",[Res,ExecGoal]), + subst_vars(Res+ExecGoal,Res+Term,NamedVarsList), + copy_term_g(NamedVarsList,Was), + term_variables(Term,Vars), + + + Call = do_metta_runtime(Res, ExecGoal), + output_language(prolog, notrace((color_g_mesg('#114411', print_pl_source(:- Call ))))), + %nl,writeq(Term),nl, + ((\+ \+ + (( + %numbervars(v(TermV,Term,NamedVarsList,Vars),999,_,[attvar(skip)]), + %nb_current(variable_names,NamedVarsList), + %nl,print(subst_vars(Term,NamedVarsList,Vars)), + nop(nl))))), + nop(maplist(verbose_unify,Vars)), + %NamedVarsList=[_=RealRealRes|_], + %var(RealRes), + X = RealRes)))),!. + into_metta_callable(_Self,TermV,Term,X,NamedVarsList,Was):- \+ never_compile(TermV), diff --git a/prolog/metta_lang/metta_loader.pl b/prolog/metta_lang/metta_loader.pl index 58067038db..60b9d6ea3c 100755 --- a/prolog/metta_lang/metta_loader.pl +++ b/prolog/metta_lang/metta_loader.pl @@ -883,9 +883,11 @@ % If Filename is not a valid symbol or file does not exist, handle wildcards for includes. (\+ symbol(Filename); \+ exists_file(Filename)),!, must_det_ll(with_wild_path(include_metta(Self), Filename)),!. -include_metta1(Self, RelFilename):- + +include_metta1(WSelf, RelFilename):- % Ensure RelFilename is a valid symbol and exists as a file. must_det_ll(( + into_top_self(WSelf, Self), symbol(RelFilename), exists_file(RelFilename),!, % Convert the relative filename to an absolute path. diff --git a/prolog/metta_lang/metta_parser.pl b/prolog/metta_lang/metta_parser.pl index 46bc199afa..2dae77f811 100644 --- a/prolog/metta_lang/metta_parser.pl +++ b/prolog/metta_lang/metta_parser.pl @@ -921,9 +921,9 @@ at_end_of_stream(Stream), !, Clause = end_of_file. read_prolog_syntax(Stream, Clause) :- % Handle errors while reading a clause. - catch(read_prolog_syntax_0(Stream, Clause), E, + catch(read_prolog_syntax_unsafe(Stream, Clause), E, throw_stream_error(Stream,E)), !. -read_prolog_syntax_0(Stream, Term) :- +read_prolog_syntax_unsafe(Stream, Term) :- % Set options for reading the clause with metadata. Options = [ variable_names(Bindings), term_position(Pos), @@ -937,12 +937,12 @@ -> true ; % Store term position and variable names. b_setval('$term_position', Pos), - b_setval('$variable_names', Bindings), + nb_setval('$variable_names', Bindings), % Display information about the term. maplist(star_vars,Bindings), nop(display_term_info(Stream, Term, Bindings, Pos, RawLayout, Comments))). -star_vars(N=V):- ignore('$'(N) = V). +star_vars(N=V):- ignore('$VAR'(N) = V). %! maybe_name_vars(+List) is det. % diff --git a/prolog/metta_lang/metta_printer.pl b/prolog/metta_lang/metta_printer.pl index 55ec7e8201..466b3702ae 100755 --- a/prolog/metta_lang/metta_printer.pl +++ b/prolog/metta_lang/metta_printer.pl @@ -148,7 +148,7 @@ % If Term is a list, apply list-specific formatting. is_list(Term), !, writeln('---------------------'), - numbervars(Term, 666, _, [attvar(bind)]), % Bind variables for display. + numbervars(Term, 666, _, [attvar(skip)]), % Bind variables for display. write((Msg)), write(':'), nl, write_src(Term), nl. ppct(Msg, Term) :- @@ -162,14 +162,14 @@ Term = (_ = _), !, writeln('---------------------'), write((Msg)), write(':'), nl, - numbervars(Term, 444, _, [attvar(bind)]), + numbervars(Term, 444, _, [attvar(skip)]), write_src(Term), nl. ppct(Msg, Term) :- % For clauses with specific formatting needs, include variable numbering and tree display. Term = (_ :- _), !, writeln('---------------------'), write((Msg)), write(':'), nl, - numbervars(Term, 222, _, [attvar(bind)]), + numbervars(Term, 222, _, [attvar(skip)]), print_tree(Term), nl. %! pp_metta(+P) is det. @@ -190,7 +190,8 @@ % pp_metta(P) :- % Standardize variable names in P for readability. - pretty_numbervars(P, PP), + %pretty_numbervars(P, PP), + P=PP, % Pretty-print PP with the `concepts=false` option. with_option(concepts=false, pp_fb(PP)). @@ -238,6 +239,8 @@ % Run the primary source-printing predicate within `run_pl_source/1`. run_pl_source(print_pl_source0(P)). +pnotrace(G):- quietly(G). + %! run_pl_source(+G) is det. % % Executes a goal `G` safely, catching any errors and attempting a retry with tracing if needed. @@ -273,13 +276,13 @@ % print_pl_source0(_) :- % Do not print if compatibility mode is enabled. - notrace(is_compatio), !. + pnotrace(is_compatio), !. print_pl_source0(_) :- % Do not print if silent loading mode is enabled. - notrace(silent_loading), !. + pnotrace(silent_loading), !. print_pl_source0(P) :- % Check if P was just printed (avoid redundant printing). - notrace((just_printed(PP), PP =@= P)), !. + pnotrace((just_printed(PP), PP =@= P)), !. print_pl_source0((A :- B)) :- % For rules (A :- B), display using portray_clause for readability. !,portray_clause((A :- B)). @@ -517,7 +520,7 @@ var(V), !, write_dvar(V), !. is_final_write('$VAR'(S)) :- % For '$VAR' structures, write the variable name S. - !, write_dvar(S), !. + !, write_dvar(S), !. is_final_write('#\\'(S)) :- % For special character format `#\S`, write S in single quotes. !, format("'~w'", [S]). @@ -710,47 +713,53 @@ % Writes the source of a term `V` with indentation enabled. % % This predicate sets indentation mode on by calling `with_indents/2` with `true`, -% and then writes the source of `V` using `write_src/1`. The use of `notrace/1` +% and then writes the source of `V` using `write_src/1`. The use of `pnotrace/1` % ensures that tracing is disabled during this operation. % % @arg V The term whose source is to be written with indentation. % write_src_wi(V) :- % Enable indentation and write the source of V. - notrace((with_indents(true, write_src(V)))). + pnotrace((with_indents(true, write_src(V)))). %! write_src(+V) is det. % % Writes the source of a term `V` after guessing Metta variables. % % This predicate first tries to identify variables in `V` using `guess_metta_vars/1` -% and then formats `V` for output using `pp_sex/1`. The `notrace/1` wrapper +% and then formats `V` for output using `pp_sex/1`. The `pnotrace/1` wrapper % ensures tracing is turned off. % % @arg V The term to be written as source. % write_src(V) :- % Guess variables in V and pretty-print using `pp_sex/1`. - \+ \+ notrace((src_vars(V, I), pp_sex(I))), !. + \+ \+ pnotrace((src_vars(V, I), pp_sex(I))), !. print_compounds_special:- true. +src_vars(V,I):- var(V),!,I=V. src_vars(V,I):- %ignore(guess_metta_vars(V)), - ignore(guess_varnames(V,I)), - ignore(numbervars(V,10000,_,[singleton(true),attvar(skip)])). - + pre_guess_varnames(V,II),ignore(II=V), + guess_varnames(II,I), + nop(ignore(numbervars(I,10000,_,[singleton(true),attvar(skip)]))). +pre_guess_varnames(V,I):- \+ compound(V),!,I=V. +pre_guess_varnames(V,I):- functor(V,F,A),functor(II,F,A), metta_file_buffer(_, _, _, II, Vs, _,_), Vs\==[], I=@=II, I=II, V=I,maybe_name_vars(Vs),!. +pre_guess_varnames(V,I):- is_list(V),!,maplist(pre_guess_varnames,V,I). +pre_guess_varnames(C,I):- compound_name_arguments(C,F,V),!,maplist(pre_guess_varnames,V,VV),compound_name_arguments(I,F,VV),!. +pre_guess_varnames(V,V). %! write_src_woi(+Term) is det. % % Writes the source of a term `Term` with indentation disabled. % % This predicate calls `with_indents/2` with `false` to disable indentation, -% and then writes `Term` using `write_src/1`. The `notrace/1` wrapper ensures +% and then writes `Term` using `write_src/1`. The `pnotrace/1` wrapper ensures % that tracing is disabled. % % @arg Term The term to be written without indentation. % write_src_woi(Term) :- % Disable indentation and write the source of Term. - notrace((with_indents(false, write_src(Term)))). + pnotrace((with_indents(false, write_src(Term)))). %! write_src_woi_nl(+X) is det. % @@ -764,7 +773,7 @@ % write_src_woi_nl(X) :- % Guess variables in X, add newlines, and write without indentation. - \+ \+ notrace(( + \+ \+ pnotrace(( format('~N'), write_src_woi(X), format('~N') )). diff --git a/prolog/metta_lang/metta_repl.pl b/prolog/metta_lang/metta_repl.pl index 454f574787..d91ebe034d 100755 --- a/prolog/metta_lang/metta_repl.pl +++ b/prolog/metta_lang/metta_repl.pl @@ -152,6 +152,10 @@ % ?- save_history. % true. % +:- if(is_win64). +% Dummy to avoid errors on windows. +save_history. +:- else. save_history :- % Get the current input stream. current_input(Input), @@ -163,6 +167,7 @@ ; % Otherwise, do nothing. true). +:- endif. %! load_and_trim_history is det. % Loads and trims the REPL history if needed, and installs readline support. @@ -420,31 +425,6 @@ % If the input stream is not provided, do nothing. read_pending_white_codes(_). -%! call_for_term_variables4v(+Term, +X, -Result, -NamedVarsList, +TF) is det. -% Handles the term `Term` and determines the term variable list and final result. -% This version handles the case when the term has no variables and converts it to a truth-functional form. -% -% @arg Term The input term to be analyzed. -% @arg X The list of variables found within the term. It can be empty or contain one variable. -% @arg Result The final result, either as the original term or transformed into a truth-functional form. -% @arg NamedVarsList The list of named variables associated with the term. -% @arg TF The truth-functional form when the term has no variables. -% -% @example -% % Example with no variables: -% ?- call_for_term_variables4v(foo, [], Result, Vars, true). -% Result = as_tf(foo, true), -% Vars = []. -% -call_for_term_variables4v(Term, [], as_tf(Term, TF), NamedVarsList, TF) :- - % Get global variable names for the term. - get_global_varnames(NamedVarsList), - % Succeed if no variables are present. - !. -% Handles the case when the term has one variable and passes the term as-is. -call_for_term_variables4v(Term, [X], Term, NamedVarsList, X) :- - % Get global variable names for the term. - get_global_varnames(NamedVarsList). %! balanced_parentheses(+Str) is semidet. % Checks if parentheses are balanced in a string or list of characters `Str`. @@ -604,9 +584,10 @@ % repl_read_next(NewAccumulated, Expr) :- % Concatenate the input with '.' and try to interpret it as an atom. - symbol_concat(Atom,'.',NewAccumulated), + symbol_concat(_Atom,'.',NewAccumulated), % Attempt to read the term from the atom, handle errors and retry if necessary. - catch_err((read_term_from_atom(Atom, Term, []), Expr = call(Term)), E, + open_string(NewAccumulated,Stream), + catch_err((read_prolog_syntax_unsafe(Stream, Term), Expr = call(Term)), E, (((fail, write('Syntax error: '), writeq(E), nl, repl_read_next(Expr))))), !. % Previously commented: repl_read_next(Str, Expr):- ((clause(t_l:s_reader_info(Expr),_,Ref),erase(Ref))). @@ -781,45 +762,6 @@ % Directive to set a global variable for variable names. :- nb_setval(variable_names, []). -%! call_for_term_variables5(+Term, +DC, +Vars1, +Vars2, -CallTerm, -DCVars, -TF) is det. -% -% Processes term variables and generates a call structure based on the provided term, -% handling cases with ground terms, single variables, and multiple variables. -% -% @arg Term The input term to process. -% @arg DC The direct constraints or variables list (can be empty). -% @arg Vars1 The first set of variables (e.g., `[Var=Value]` format). -% @arg Vars2 The second set of variables. -% @arg CallTerm The generated term call (e.g., `call_nth/2` or `as_tf/2`). -% @arg DCVars The combined list of variables or constraints. -% @arg TF The variable or value associated with the call. -% -% @example Handling a ground term: -% ?- call_for_term_variables5(hello, [], [], [], CallTerm, DCVars, TF). -% CallTerm = as_tf(hello, TF), -% DCVars = [], -% TF = _. -% -% @example Single variable case: -% ?- call_for_term_variables5(hello, [], [], [X=_], CallTerm, DCVars, TF). -% CallTerm = call_nth(hello, Count), -% DCVars = ['Count' = Count], -% TF = X. -% - % If the term is ground, return the as_tf form. -call_for_term_variables5(Term,[],[],[],as_tf(Term,TF),[],TF) :- ground(Term), !. - % If the term is ground, create a call_nth with the term. -call_for_term_variables5(Term,DC,[],[],call_nth(Term,TF),DC,TF) :- ground(Term), !. -% If there is one variable, set the term to call_nth. -call_for_term_variables5(Term,_,[],[_=Var],call_nth(Term,Count),['Count'=Count],Var). -% Similar case when the variable is reversed in arguments. -call_for_term_variables5(Term,_,[_=Var],[],call_nth(Term,Count),['Count'=Count],Var). -% If both term variables and equal variable are present, pass them along. -call_for_term_variables5(Term,_,Vars,[_=Var],Term,Vars,Var). -% Same case but with the variables reversed. -call_for_term_variables5(Term,_,[_=Var],Vars,Term,Vars,Var). -% Handle case with more than one variable, generating a call_nth. -call_for_term_variables5(Term,_,SVars,Vars,call_nth(Term,Count),[Vars,SVars],Count). %! is_interactive(+From) is nondet. % @@ -2038,12 +1980,18 @@ % This installs readline/editline support, allowing for line editing and history during input. :- dynamic(is_installed_readline_editline/1). :- volatile(is_installed_readline_editline/1). + +:- if(is_win64). +% dummy for on windows +install_readline_editline. +:-else. install_readline_editline :- % Get the current input stream. current_input(Input), % Install readline support for the current input. install_readline(Input), !. +:- endif. %! el_wrap_metta(+Input) is det. % diff --git a/prolog/metta_lang/metta_space.pl b/prolog/metta_lang/metta_space.pl index a3cc1efe46..9d1a65eba2 100755 --- a/prolog/metta_lang/metta_space.pl +++ b/prolog/metta_lang/metta_space.pl @@ -377,7 +377,8 @@ % @example Clear all atoms from a space: % ?- 'clear-atoms'('my_space'). % -'clear-atoms'(SpaceNameOrInstance) :- +'clear-atoms'(DynSpace) :- + into_top_self(DynSpace, SpaceNameOrInstance), % Log the operation of clearing atoms from the specified space. dout(space, ['clear-atoms', SpaceNameOrInstance]), % Retrieve the appropriate method for clearing the space based on its type. @@ -404,7 +405,8 @@ % @example Add an atom to a space: % ?- 'add-atom'('my_space', my_atom). % -'add-atom'(SpaceNameOrInstance, Atom) :- +'add-atom'(DynSpace, Atom) :- + into_top_self(DynSpace, SpaceNameOrInstance), % Retrieve the method for adding an atom based on the space type. ((space_type_method(Type, add_atom, Method), % Ensure the space type matches by calling the type predicate. @@ -447,7 +449,8 @@ % @example Remove an atom from a space: % ?- 'remove-atom'('my_space', my_atom). % -'remove-atom'(SpaceNameOrInstance, Atom) :- +'remove-atom'(DynSpace, Atom) :- + into_top_self(DynSpace, SpaceNameOrInstance), % Log the operation of removing an atom from the specified space. dout(space, ['remove-atom', SpaceNameOrInstance, Atom]), % Retrieve the method for removing an atom based on the space type. @@ -494,7 +497,8 @@ % @example Replace an atom in a space: % ?- 'replace-atom'('my_space', old_atom, new_atom). % -'replace-atom'(SpaceNameOrInstance, Atom, New) :- +'replace-atom'(DynSpace, Atom, New) :- + into_top_self(DynSpace, SpaceNameOrInstance), dout(space, ['replace-atom', SpaceNameOrInstance, Atom, New]), space_type_method(Type, replace_atom, Method), call(Type, SpaceNameOrInstance), @@ -536,7 +540,8 @@ % ?- 'atom-count'(env, Count). % Count = 10. % -'atom-count'(SpaceNameOrInstance, Count) :- +'atom-count'(DynSpace, Count) :- + into_top_self(DynSpace, SpaceNameOrInstance), dout(space, ['atom-count', SpaceNameOrInstance]), space_type_method(Type, atom_count, Method), call(Type, SpaceNameOrInstance), !, @@ -568,7 +573,8 @@ % ?- get-atoms('env1', Atoms). % Atoms = [atomA, atomB, atomC]. % -'get-atoms'(SpaceNameOrInstance, AtomsL) :- +'get-atoms'(DynSpace, AtomsL) :- + into_top_self(DynSpace, SpaceNameOrInstance), % Output a debug message indicating the 'get-atoms' request to the space. dout(space, ['get-atoms', SpaceNameOrInstance]), % Determine the method for retrieving atoms based on the space type. @@ -598,7 +604,8 @@ % @example Iterate over atoms in a space: % ?- 'atoms_iter'('my_space', Iter). % -'atoms_iter'(SpaceNameOrInstance, Iter) :- +'atoms_iter'(DynSpace, Iter) :- + into_top_self(DynSpace, SpaceNameOrInstance), dout(space, ['atoms_iter', SpaceNameOrInstance]), space_type_method(Type, atoms_iter, Method), call(Type, SpaceNameOrInstance), @@ -621,7 +628,8 @@ % @example Match atoms in a space: % ?- 'atoms_match'('my_space', Atoms, my_template, else_clause). % -'atoms_match'(SpaceNameOrInstance, Atoms, Template, Else) :- +'atoms_match'(DynSpace, Atoms, Template, Else) :- + into_top_self(DynSpace, SpaceNameOrInstance), space_type_method(Type, atoms_match, Method), call(Type, SpaceNameOrInstance), !, @@ -642,7 +650,8 @@ % @example Query a space for an atom: % ?- 'space_query'('my_space', query_atom, Result). % -'space_query'(SpaceNameOrInstance, QueryAtom, Result) :- +'space_query'(DynSpace, QueryAtom, Result) :- + into_top_self(DynSpace, SpaceNameOrInstance), space_type_method(Type, query, Method), call(Type, SpaceNameOrInstance), !, @@ -663,7 +672,8 @@ % ?- subst_pattern_template('example_space', some_pattern, Template). % Template = [substituted_atom1, substituted_atom2]. % -subst_pattern_template(SpaceNameOrInstance, Pattern, Template) :- +subst_pattern_template(DynSpace, Pattern, Template) :- + into_top_self(DynSpace, SpaceNameOrInstance), % Log the operation for traceability. dout(space, [subst_pattern_template, SpaceNameOrInstance, Pattern, Template]), % Match and substitute atoms in the given space according to the pattern. @@ -689,10 +699,12 @@ % ?- was_asserted_space('&self'). % true. % -was_asserted_space('&self'). +was_asserted_space('&self'):- current_self(X), (X=='&self'->true;was_asserted_space(X)). was_asserted_space('&stdlib'). was_asserted_space('&corelib'). was_asserted_space('&flybase'). +was_asserted_space('&top'). +was_asserted_space('&catalog'). /* was_asserted_space('&attentional_focus'). was_asserted_space('&belief_events'). @@ -1336,9 +1348,12 @@ % % Get the atom count for a loaded context. % ?- atom_count_provider(some_context, Count). % -atom_count_provider(Self, Count) :- + + +atom_count_provider(SpaceNameOrInstance, Count) :- + into_top_self(SpaceNameOrInstance, DynSpace), % Check if the context has been loaded into a knowledge base (KB). - user:loaded_into_kb(Self, Filename), + user:loaded_into_kb(DynSpace, Filename), % Retrieve the associated predicate for the given filename. once(user:asserted_metta_pred(Mangle, Filename)), % Derive a related predicate from the original. @@ -1355,8 +1370,9 @@ predicate_property(Data, number_of_rules(RC)), % Calculate the atom count as the difference between clauses and rules. Count is CC - RC. -atom_count_provider(KB, Count) :- +atom_count_provider(SpaceNameOrInstance, Count) :- must_det_ll(( + into_top_self(SpaceNameOrInstance, KB), % Predicate for asserted atoms. AMA = metta_atom_asserted, % Declare the predicate with arity 2. @@ -1406,7 +1422,8 @@ % % Iterate over atoms in 'example_kb' and retrieve them. % ?- metta_assertdb_iter('example_kb', Atom). % -metta_assertdb_iter(KB, Atoms) :- +metta_assertdb_iter(SpaceNameOrInstance, Atoms) :- + into_top_self(SpaceNameOrInstance, KB), % Dynamically construct the predicate for the given KB. MP =.. [metta_atom, KB, Atoms], % Call the constructed predicate to retrieve atoms. @@ -1427,7 +1444,8 @@ % % Execute a query against the KB and bind variables. % ?- metta_iter_bind('example_kb', my_query(X), Vars, ['X']). % -metta_iter_bind(KB, Query, Vars, VarNames) :- +metta_iter_bind(SpaceNameOrInstance, Query, Vars, VarNames) :- + into_top_self(SpaceNameOrInstance, KB), % Extract all variables from the query. term_variables(Query, QVars), % Align the provided variable names with the query variables. @@ -1460,7 +1478,8 @@ % % Query the KB and retrieve bound variables. % ?- space_query_vars('example_kb', my_query(X), Vars). % -space_query_vars(KB, Query, Vars) :- +space_query_vars(SpaceNameOrInstance, Query, Vars) :- + into_top_self(SpaceNameOrInstance, KB), % Check if the knowledge base is an asserted space. is_asserted_space(KB), !, % Declare the predicate for asserted atoms with arity 2. diff --git a/prolog/metta_lang/metta_subst.pl b/prolog/metta_lang/metta_subst.pl index 59b13682fd..7e9f137ac6 100755 --- a/prolog/metta_lang/metta_subst.pl +++ b/prolog/metta_lang/metta_subst.pl @@ -65,7 +65,7 @@ self_subst('True'). self_subst('False'). self_subst('F'). %' -:- nb_setval(self_space, '&self'). % ' +%:- nb_setval(self_space, '&self'). % ' substs_to(XX,Y):- Y==XX,!. substs_to(XX,Y):- Y=='True',!, is_True(XX),!. %' @@ -256,7 +256,7 @@ set_last_error(_). */ -subst_args1(Eq,RetType,Depth, Self, [OP|ARGS], Template):- +subst_args1(Eq,RetType,Depth, Self, [OP|ARGS], Template):- fail, is_space_op(OP), !, subst_args_as(Depth, Self, [OP|ARGS], Template). @@ -714,11 +714,11 @@ % user defined function -subst_args2(Eq,Depth,Self,[H|PredDecl],Res):- mnotrace(is_user_defined_head(Eq,Self,H)),!, +subst_args2(Eq,Depth,Self,[H|PredDecl],Res):- fail,mnotrace(is_user_defined_head(Eq,Self,H)),!, subst_args30(Eq,Depth,Self,[H|PredDecl],Res). % function inherited by system -subst_args2(Eq,Depth,Self,PredDecl,Res):- subst_args40(Eq,Depth,Self,PredDecl,Res). +subst_args2(Eq,Depth,Self,PredDecl,Res):- fail, subst_args40(Eq,Depth,Self,PredDecl,Res). /* last_element(T,E):- \+ compound(T),!,E=T. @@ -843,7 +843,7 @@ */ -subst_args30(Eq,Depth,Self,H,B):- (subst_args34(Depth,Self,H,B)*->true;subst_args37(Eq,Depth,Self,H,B)). +subst_args30(Eq,Depth,Self,H,B):- fail, (subst_args34(Depth,Self,H,B)*->true;subst_args37(Eq,Depth,Self,H,B)). subst_args34(_Dpth,Self,H,B):- (metta_eq_def(Eq,Self,H,B);(get_metta_atom(Eq,Self,H),B=H)). diff --git a/prolog/metta_lang/stdlib_mettalog.metta b/prolog/metta_lang/stdlib_mettalog.metta index 3bfb94a1a9..45bb95eb2b 100644 --- a/prolog/metta_lang/stdlib_mettalog.metta +++ b/prolog/metta_lang/stdlib_mettalog.metta @@ -97,8 +97,11 @@ (= (If False $then) (let $n 0 (let $n 1 $n))) (= (If $cond $then $else) (if $cond $then $else)) -(iz predicate-arity MeTTaLog) +(@doc type-check + (@desc "The value of type-check determines MeTTa's type-checking behavior. Set via pragma!. When set to auto (i.e. !(pragma! type-check auto)), types are checked immediately on adding an expression to the space. By default, when unset (or set to anything other than auto), types are checked only on evaluation. For example !(+ 1 \"2\") would trigger a type violation, but (= (foo $x) (+ $x \"2\")) would not, unless type-check is set to auto, in which case both would trigger type violations.")) +(: type-check Symbol) +(iz predicate-arity MeTTaLog) (@doc predicate-arity (@desc "Specifies the arity (number of arguments) for a given predicate, allowing it to be queriable in the system's match framework. This is particularly useful for enabling built-in functions, such as `size-atom`, to be used as predicates in declarative contexts and run in reverse to compute inputs based on outputs.