1/*
    2% NomicMUD: A MUD server written in Prolog
    3% Maintainer: Douglas Miles
    4% Dec 13, 2035
    5%
    6% Bits and pieces:
    7%
    8% LogicMOO, Inform7, FROLOG, Guncho, PrologMUD and Marty's Prolog Adventure Prototype
    9% 
   10% Copyright (C) 2004 Marty White under the GNU GPL 
   11% Sept 20,1999 - Douglas Miles
   12% July 10,1996 - John Eikenberry 
   13%
   14% Logicmoo Project changes:
   15%
   16% Main file.
   17%
   18*/
   19
   20% Miscellaneous generic utility predicates.
   21
   22:- meta_predicate findall_set(?,0,*).   23findall_set(E,G,S):- findall(E,G,L),list_to_set(L,S).
   24
   25% was_dcg(M,Kept,S0,S2):- !, M:apply_state(Kept,S0,S2).
   26was_dcg(M,Kept,S0,S2):- call(M:phrase(Kept,S0,S2)).
   27%:- trace.
   28term_expansion_was_dcg('-->'(DCG , Keeper), '-->'(DCG , was_dcg(M,Keeper))):- Keeper \= was_dcg(_,_), prolog_load_context(module,M).
   29
   30:- meta_predicate(sg(1,?,?)).   31sg(G,S0,S9) :- call(G,S0),S0=S9.
   32
   33%mu:term_expansion(I,P,O,PO):- notrace((compound(I),nonvar(P))),term_expansion_was_dcg(I,O),P=PO.
   34%foo --> bar ,!.
   35%foo --> bar,baz.
   36%:- break.
   37
   38clock_time(T):- statistics(walltime,[X,_]),T is ('//'(X , 100))/10.
   39
   40
   41:- dynamic(is_state_pred/2).   42is_state_pred(F,N):- atom(F),!,is_state_pred(P,N),functor(P,F,_).
   43
   44defn_state_pred(P,N):- is_state_pred(P,N),!.
   45defn_state_pred(P,N):- asserta(is_state_pred(P,N)),
   46  strip_module(P,M,PP),
   47  assertion(compound(PP)),functor(PP,F,A),            
   48  ignore(defn_state_pred_wrapper(M,F,A,PP,N)).
   49
   50defn_state_pred_wrapper(M,F,A,_,0):- 
   51  assertion(F\==('/')),assertion(F\==('//')),
   52  functor(PP,F,A),PP=..[F|Args],
   53  append(Args,[S0,S9],NewArgs),
   54  PPS09=..[F|NewArgs],
   55  asserta_if_undef(M, PPS09, (M:PP, S0 = S9)).
   56
   57defn_state_pred_wrapper(M,F,A,_,1):- 
   58  assertion(F\==('/')),assertion(F\==('//')),
   59  functor(PP,F,A),PP=..[F|Args],
   60  append(Args,[S0],NewArgs0),
   61  PPS0 =..[F|NewArgs0],
   62  append(Args,[S0,S9],NewArgs09),
   63  PPS09 =..[F|NewArgs09],  
   64  asserta_if_undef(M, PPS09,( M:PPS0, S0 = S9)),
   65  asserta_if_undef(M, PP, (get_advstate(S0),M:PPS0)).
   66 
   67asserta_if_undef(Mod,Head,_Body):- predicate_property(Mod:Head, defined),!.
   68asserta_if_undef(Mod,Head, Body):- Mod:asserta((Head:-Body)).
   69
   70defn_state_none(P):- defn_state_pred(P,0).
   71defn_state_getter(P):- defn_state_pred(P,1).
   72defn_state_setter(P):- defn_state_pred(P,2).
   73
   74:- defn_state_none(adv_io:bugout1(term)).   75:- defn_state_none(adv_io:bugout3(string,list(term),term)).   76:- defn_state_none(adv_io:bugout3(string,term)).   77:- defn_state_none(==(term,term)).   78:- defn_state_none(\==(term,term)).   79:- defn_state_none(=(term,term)).   80:- defn_state_none(\=(term,term)).   81:- defn_state_none(dif(term,term)).   82:- defn_state_none(nop(term)).   83
   84
   85mk_complex(R, I, '@'(R, I)).
   86get_complex('@'(R, I), R, I).
   87
   88complex(C, R, I):- ground(C), get_complex(C, R0, I0), !, R=R0, I=I0.
   89complex(C, R, I):- ground((R, I)), mk_complex(R, I, C0), !, C=C0.
   90complex(C, R, I):- freeze(C, complex(C, R, I)), freeze(R, complex(C, R, I)), freeze(I, complex(C, R, I)).
   91
   92
   93nonvar_subterm(Var, Data):- var(Var), !, sub_term(Var, Data),nonvar(Var).
   94nonvar_subterm(Bound, Data):- sub_term(E, Data),nonvar(E),'=@='(E,Bound).
   95
   96
   97% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   98% CODE FILE SECTION
   99% :- nop(ensure_loaded('adv_util_subst')).
  100% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  101apply_mapl_state(Goal, List, S0, S2):- apply_all(List, Goal, S0, S2).
  102
  103apply_all([], _Goal, S0, S0) :- !.
  104apply_all([Arg], Goal, S0, S2) :- !, apply_first_arg_state(Arg, Goal, S0, S2).
  105
  106apply_all(List, Goal, S0, S2) :- notrace((list_to_set(List,Set), 
  107 List\==Set)), !,
  108 apply_all(Set, Goal, S0, S2).
  109
  110apply_all([Arg|ArgTail], Goal, S0, S2) :-
  111 runnable_goal(Goal, Runnable),
  112 apply_first_arg_state(Arg, Runnable, S0, S1),
  113 !, % Don't allow future failure to redo successful agents.
  114 apply_all(ArgTail, Goal, S1, S2).
  115
  116
  117apply_mapl_rest_state(_Front, [], _Rest, S, S).
  118apply_mapl_rest_state(Front, [E|List], Rest, S0, S2) :-
  119 copy_term(Front+Rest,FrontC+RestC),
  120 apply_state_rest(Front, E, Rest, S0, S1),
  121 apply_mapl_rest_state(FrontC, List, RestC, S1, S2).
  122
  123as_rest_list(Rest,RestL):- is_list(Rest)->Rest=RestL;Rest=..[_|RestL].
  124
  125apply_state_rest(Front, E, Rest, S0, S1):- as_rest_list(Rest,RestL),
  126   append(E,RestL,ERestL),append(ERestL,[S0,S1],APPLYARGS),
  127   apply(Front,APPLYARGS).
  128   
  129 
  130
  131
  132runnable_goal(Goal, Goal) :- ground(Goal), !.
  133%runnable_goal(Goal, Goal_Copy):- copy_term(Goal, Goal_Copy).
  134runnable_goal(Goal, Goal).
  135
  136
  137:- module_transparent(apply_forall_frames//3).  138:- meta_predicate(apply_forall_frames(+,+,2,+,-)).  139apply_forall_frames([],_Forall,_Apply,S0,S0).
  140apply_forall_frames([Frame|Frames],Forall,Apply,S0,S2):-
  141 Frame=Forall,apply_state(Apply,S0,S1),
  142 apply_forall_frames(Frames,Forall,Apply,S1,S2).
  143
  144:- module_transparent(apply_forall//2).  145:- meta_predicate(apply_forall(0,2,+,-)).  146apply_forall(Forall,Apply,S0,S1):-
  147 findall(Forall,Forall,Frames),
  148  apply_forall_frames(Frames,Forall,Apply,S0,S1).
  149
  150findall(E,Goal,L, S0, S2):- apply_state(findall(E,Goal,L), S0, S2).
  151
  152%unless(G,Else,S0,S2):- apply_state(unless(G,Else), S0, S2).
  153must_det(Goal,S0,S2):- apply_state(must_det(Goal), S0, S2).
  154ignore(Goal,S0,S2):- apply_state(ignore(Goal), S0, S2).
  155
  156:- meta_predicate with_state(*,0,*,*).  157with_state(S,Goal,S0,S2):- S0=S,call(Goal),S0=S2.
  158
  159is_state_getter(P):- compound(P),functor(P,F,Am1),A is Am1+1, current_predicate(F/A),!.
  160is_state_getter(P):- \+ atom(P),!,compound(P),functor(P,F,_),!,is_state_getter(F).
  161is_state_getter(F):- is_state_pred(F,1).
  162
  163is_state_setter(P):- \+ atom(P),!,compound(P),functor(P,F,_),!,is_state_setter(F).
  164is_state_setter(F):- is_state_pred(F,2).
  165
  166is_state_meta(P,N):- \+ atom(P),!,compound(P),functor(P,F,_),!,is_state_meta(F,N).
  167is_state_meta(rtrace,0).
  168is_state_meta(findall,1).
  169
  170is_state_ignorer(P):- \+ atom(P),!,compound(P),functor(P,F,_),!,is_state_ignorer(F).
  171is_state_ignorer(F):- is_state_pred(F,1).
  172%is_state_ignorer('{}'(term)).
  173
  174must_input_state(S0):- quietly(check4bugs(input,S0)).
  175must_output_state(S0):- quietly(check4bugs(output,S0)).
  176%must_state(S0):- quietly(check4bugs(anon, S0)).
  177
  178:- module_transparent(apply_state//3).  179:- meta_predicate(apply_state(*,+,-)).  180:- meta_predicate(apply_state(*,+,-,+,-)).  181
  182apply_state(Goal,S0,S2,DCG0,DCG2):-
  183  DCG0=S0,
  184  apply_state(Goal, S0, S2),
  185  DCG2=S2.
  186
  187
  188rapply_state(S0,S2,Goal):- apply_state(Goal, S0, S2).
  189
  190:- module_transparent(apply_state//1).  191%:- meta_predicate(apply_state(//,+,-)).
  192
  193apply_state(NonGoal, S0, S2) :- \+ callable(NonGoal),!,trace, S0=S2.
  194apply_state(M:Goal, S0, S2) :- !, assertion(atom(M)),
  195 M:apply_state(Goal, S0, S2).
  196apply_state({Goal}, S0, S0) :- !, call(Goal).
  197apply_state(M:{Goal}, S0, S0) :- !, call(M:Goal).
  198apply_state(Goal,S0,S0):- Goal==[],!.
  199
  200apply_state(List, S0, S2) :- is_list(List),!,append(S0,List,S2),!.
  201apply_state(G12, S0, S2) :- G12 = [_|_],!, 
  202 append(GL,G2,G12), (((is_list(GL),append(S0,GL,S1))-> apply_state(G2, S1, S2))).
  203
  204%apply_state((unless(Unless,Error),More), S0, S2) :- !, (apply_state(Unless, S0, S1)->apply_state(More, S1, S2);apply_state(Error, S0, S2)).
  205%apply_state(unless(Unless,Error), S0, S2) :- !, (apply_state(Unless, S0, S2)->true;apply_state(Error, S0, S2)).
  206apply_state(ignore(Goal), S0, S2) :- !, apply_state(Goal, S0, S2)->true;S0=S2.
  207apply_state(findall(E,Goal,L), S0, S2) :- !, findall(E,apply_state(Goal, S0, _),L),S0=S2.
  208apply_state(i_o(S0,S2), S0, S2) :- !.
  209
  210apply_state(Goal, S0, S2) :- is_state_getter(Goal),call(Goal,S0),!, S0=S2.
  211apply_state(rtrace(Goal), S0, S2) :- !, rtrace(apply_state(Goal, S0, S2)). 
  212apply_state(current_state(S0), S0, S2) :- !, S0=S2.
  213apply_state(must_det((G1,G2)), S0, S2) :- !, apply_state(must_det(G1), S0, S1),apply_state(must_det(G2), S1, S2).
  214apply_state(must(Goal), S0, S2) :- !, must(apply_state(Goal, S0, S2)). 
  215apply_state(nop(_), S0, S2) :- !, S0=S2.
  216apply_state(must_det(Goal), S0, S2) :- !, must_det(apply_state(Goal, S0, S2)).
  217apply_state(Meta, S0, S2) :- is_state_meta(Meta,N), length(Left,N),Meta=..[F|MetaL],
  218   append(Left,[Goal|MetaR],MetaL),
  219   append(Left,[apply_state(Goal, S0, S2)|MetaR],MetaC),
  220   apply(call(F),MetaC).
  221apply_state(Goal, S0, S2) :- is_state_ignorer(Goal),call(Goal),!, S0=S2.
  222apply_state((('->'(G1,G2));G3), S0, S2) :- !,
  223 apply_state(G1, S0, If) -> 
  224 apply_state(G2, If, S2);
  225 apply_state(G3, S0, S2). 
  226apply_state((G1*->G2;G3), S0, S2) :- !,
  227 apply_state(G1, S0, If) *-> 
  228 apply_state(G2, If, S2);
  229 apply_state(G3, S0, S2). 
  230apply_state((G1,G2), S0, S2) :- !,
  231 apply_state(G1, S0, S1),
  232 apply_state(G2, S1, S2).
  233apply_state((G1;G2), S0, S2) :- !,
  234 apply_state(G1, S0, S2);
  235 apply_state(G2, S0, S2).
  236
  237
  238apply_state(sg(Goal), S0, S2) :- !,
  239 notrace((compound_name_arguments(Goal, F, GoalL),
  240 append(GoalL, [S0], NewGoalL),
  241 must_input_state(S0),
  242 Call=..[F|NewGoalL])),
  243 must_det(Call),
  244 S0 = S2,
  245 must_output_state(S2).
  246
  247apply_state(Goal, S0, S2) :- 
  248 notrace(is_state_setter(Goal)), !,
  249 notrace((compound_name_arguments(Goal, F, GoalL),
  250 append(GoalL, [S0, S2], NewGoalL),
  251 must_input_state(S0),
  252 Call=..[F|NewGoalL])),
  253 must_det(Call),
  254 must_output_state(S2).
  255
  256apply_state(Goal, S0, S2) :-
  257 notrace((compound_name_arguments(Goal, F, GoalL),
  258 append(GoalL, [S0, S2], NewGoalL),
  259 must_input_state(S0),
  260 Call=..[F|NewGoalL])), !,
  261 must_det(Call),
  262 notrace(must_output_state(S2)).
  263
  264 %apply_state(Goal, S0, S2):- phrase(Goal,S0,S2).
  265
  266
  267
  268%:- meta_predicate(apply_first_arg_state(+,3,+,-)).
  269apply_first_arg_state(Arg, Goal, S0, S2) :-
  270 notrace((compound_name_arguments(Goal, F, GoalL),
  271 append(GoalL, [S0, S2], NewGoalL),
  272 must_input_state(S0),
  273 Call=..[F, Arg|NewGoalL])),
  274 must_det(Call),
  275 notrace(must_output_state(S2)).
  276
  277%:- meta_predicate(apply_first(+,3,+,-)).
  278apply_first_arg(Arg, Goal, S0, S2):- 
  279 apply_first_arg_state(Arg, Goal, S0, S2).
  280
  281% --------
  282
  283% TODO: rewrite/debug findterm.
  284
  285findterm(Term, Term).
  286findterm(Term, [Head|_]) :- nonvar(Head),
  287 findterm(Term, Head).
  288findterm(Term, [_|Tail]) :- nonvar(Tail),
  289 findterm(Term, Tail).
  290findterm(Term, T) :-
  291 compound(T),
  292 \+ is_list(T),
  293 T =.. List,
  294 findterm(Term, List).
  295
  296user:adv_subst(Prop,Find,Replace,NewProp):- adv_subst(equivalent,Find,Replace,Prop,NewProp).
  297
  298% Substitute 'Replace' for 'Find' in T0, yielding T.
  299% TODO: add ^ handling like with bagof/setof.
  300% bagof(Template, X^Goal, List) means to never instantiate X
  301% Current behavior:
  302% adv_subst(copy_term, macro(Code), expanded(Code, X), macro(foo), expanded(foo, Y))
  303%  departing X unbound. Suppose I wanted X left bound?
  304% adv_subst(equivalent, macro(Code), expanded(Code, X), macro(foo), macro(foo))
  305%  This won't match Code.
  306% adv_subst(unify, macro(Code), expanded(Code, X), macro(foo), expanded(foo, X))
  307%  This only matches all occurrences of the same first Code!
  308adv_subst(unify, Find1, Replace, Find2, Replace) :- Find1 = Find2,
  309 % The first unification of Find sticks! Doesn't seem too useful to me.
  310 % TODO: consider somehow allowing a solution for each match.
  311 % ground(Find) -> T0=Find, ! ; T0=Find. sort of does it
  312 !.
  313adv_subst(equivalent, Find, Replace, T0, Replace) :-
  314 % Don't unify any variables. Safe and simple.
  315 T0 == Find,
  316 !.
  317adv_subst(copy_term, Find, Replace, FindCopy, ReplaceCopy) :-
  318 % Unify with new instantiations at each replacement.
  319 % Allows sensible behavior like:
  320 % adv_subst(my_macro(Code),
  321 %   expanded(Code),
  322 %   (this, my_macro(that), other, my_macro(another)),
  323 %   (this, expanded(that), other, expanded(another)) )
  324 % ...but unfortunately will break any free-variable associations.
  325 % TODO: think about how bagof works; apply here.
  326 copy_term(Find-Replace, FindCopy-ReplaceCopy),
  327 !.
  328adv_subst(BindType, Find, Replace, List, [T|Rest]) :-
  329 is_list(List),
  330 List = [T0|Rest0], % fails when List = []
  331 !,
  332 adv_subst(BindType, Find, Replace, T0, T),
  333 adv_subst(BindType, Find, Replace, Rest0, Rest).
  334adv_subst(BindType, Find, Replace, T0, T) :-
  335 compound(T0),
  336 % \+ is_list(T0),
  337 !,
  338 T0 =.. [Functor0|Args0],
  339 adv_subst(BindType, Find, Replace, Functor0, Functor1),
  340 adv_subst(BindType, Find, Replace, Args0, Args1),
  341 % If Replacement would cause invalid functor, don't adv_subst.
  342 ( atom(Functor1) -> T =.. [Functor1|Args1] ; T =.. [Functor0|Args1]).
  343adv_subst(_BindType, _Find, _Replace, T, T).
  344
  345% Call adv_subst on T for each Find-Replace pair in the given list.
  346% Order of substitution may matter to you!
  347subst_dict(_BindType, [], T, T).
  348subst_dict(BindType, [Find-Replace|Rest], T0, T) :-
  349 adv_subst(BindType, Find, Replace, T0, T1),
  350 subst_dict(BindType, Rest, T1, T).
  351
  352
  353
  354writel([]).
  355writel([nl]) :- !, nl. % special case if 'nl' is at end of list.
  356writel([H|T]) :- write(H), writel(T).
  357%writeln(L) :- writel(L), nl.
  358
  359% Is Term uninstantiated in any of its parts?
  360uninstantiated([]) :- !, fail.
  361uninstantiated(Term) :- var(Term).
  362uninstantiated([Head|_]) :- uninstantiated(Head).
  363uninstantiated([_|List]) :- !, uninstantiated(List).
  364uninstantiated(Term) :-
  365 compound(Term),
  366 Term =.. [Head | Tail],
  367 (uninstantiated(Head); uninstantiated(Tail)).
  368
  369% ground(Term) :- \+ uninstantiated(Term)
  370
  371% A safer "not" forbids uninstantiated arguments.
  372%:- op(900, fy, not).
  373%not(P) :- uninstantiated(P), throw(not(uninstantiated_var)).
  374%not(P) :- call(P), !, fail. % standard prolog not(P) predicate
  375%not(_).
  376
  377%nth0(N0,List,Member) :-
  378% N1 is N0 +1,
  379% nth(N1,List,Member). % gprolog only has 1-based indexing
  380
  381
  382/*
  383SWI
  384
  385random_adv(Base, Max, Number) :-
  386 Number is Base + random(Max - Base).
  387
  388my_random_member(List, Member) :-
  389 length(List, Count),
  390 random_adv(0, Count, R), % fails if Count is 0
  391 nth0(R, List, Member).
  392*/
  393
  394%gensym(Base, NewSymbol) :- new_atom(Base, NewSymbol).
  395%gensym(NewSymbol) :- new_atom(gensym_, NewSymbol).
  396
  397%subset([Element|Tail], Set) :- member(Element, Set), subset(Tail, Set).
  398%subset([], _Set).
  399
  400%union([],Set,Set).
  401%union([Item|Tail],Set1,Set2) :-
  402% member(Item,Set1),
  403% !,
  404% union(Tail, Set1, Set2).
  405%%union([Item|Tail],Set1,Set2) :-
  406%% member(Item,Tail),
  407%% !,
  408%% union(Tail, Set1, Set2).
  409%union([Item|Tail],Set1,[Item|Tail2]) :-
  410% union(Tail,Set1,Tail2).
  411
  412%intersection([],_Set,[]).
  413%intersection([Item|Tail],Set1,[Item|Tail2]) :-
  414% member(Item, Set1),
  415% !,
  416% intersection(Tail,Set1,Tail2).
  417%intersection([_Item|Tail],Set1,Set2) :-
  418% intersection(Tail,Set1,Set2).