diff --git a/prolog/metta_lang/metta_interp.pl b/prolog/metta_lang/metta_interp.pl index b156745dfd2..4f3817b26e4 100755 --- a/prolog/metta_lang/metta_interp.pl +++ b/prolog/metta_lang/metta_interp.pl @@ -1415,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). @@ -1424,7 +1429,10 @@ 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):- 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). @@ -1774,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), @@ -1831,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 58067038dbe..60b9d6ea3c1 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 46bc199afac..2dae77f8111 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 9cae0c5d96b..466b3702aef 100755 --- a/prolog/metta_lang/metta_printer.pl +++ b/prolog/metta_lang/metta_printer.pl @@ -739,9 +739,14 @@ 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. diff --git a/prolog/metta_lang/metta_repl.pl b/prolog/metta_lang/metta_repl.pl index 50ad62bb0fb..d91ebe034d3 100755 --- a/prolog/metta_lang/metta_repl.pl +++ b/prolog/metta_lang/metta_repl.pl @@ -425,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`. @@ -609,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))). @@ -786,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. % @@ -2045,6 +1982,8 @@ :- 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. diff --git a/prolog/metta_lang/metta_space.pl b/prolog/metta_lang/metta_space.pl index 22620f640d9..9d1a65eba2a 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,7 +699,7 @@ % ?- 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'). @@ -1338,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. @@ -1357,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. @@ -1408,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. @@ -1429,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. @@ -1462,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.