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
   22clock_time(T):- statistics(walltime,[X,_]),T is X/1000.
   23
   24mk_complex(R, I, '@'(R, I)).
   25get_complex('@'(R, I), R, I).
   26
   27complex(C, R, I):- ground(C), get_complex(C, R0, I0), !, R=R0, I=I0.
   28complex(C, R, I):- ground((R, I)), mk_complex(R, I, C0), !, C=C0.
   29complex(C, R, I):- freeze(C, complex(C, R, I)), freeze(R, complex(C, R, I)), freeze(I, complex(C, R, I)).
   30
   31
   32
   33% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   34%  CODE FILE SECTION
   35:- nop(ensure_loaded('adv_util_subst')).   36% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   37
   38apply_all([], _Goal, S0, S0) :- !.
   39apply_all([Arg], Goal, S0, S2) :- !, apply_first_arg_state(Arg, Goal, S0, S2).
   40
   41apply_all(List, Goal, S0, S2) :- notrace((list_to_set(List,Set), 
   42   List\==Set)), !,
   43   apply_all(Set, Goal, S0, S2).
   44
   45apply_all([Arg|ArgTail], Goal, S0, S2) :-
   46   runnable_goal(Goal, Runnable),
   47   apply_first_arg_state(Arg, Runnable, S0, S1),
   48   !, % Don't allow future failure to redo successful agents.
   49   apply_all(ArgTail, Goal, S1, S2).
   50
   51runnable_goal(Goal, Goal) :- ground(Goal), !.
   52%runnable_goal(Goal, Goal_Copy):- copy_term(Goal, Goal_Copy).
   53runnable_goal(Goal, Goal).
   54
   55apply_state(Goal,S0,S0):- Goal==[],!.
   56apply_state(rtrace(Goal), S0, S2) :- !, rtrace(apply_state(Goal, S0, S2)). 
   57apply_state(dmust(Goal), S0, S2) :- !, dmust(apply_state(Goal, S0, S2)).
   58apply_state(must(Goal), S0, S2) :- !, dmust(apply_state(Goal, S0, S2)). 
   59apply_state(nop(_), S0, S2) :- !, S0=S2.
   60apply_state({Goal}, S0, S0) :- !, call(Goal).
   61apply_state([G1|G2], S0, S2) :- !,
   62  apply_state(G1, S0, S1),
   63  apply_state(G2, S1, S2).
   64apply_state((G1,G2), S0, S2) :- !,
   65  apply_state(G1, S0, S1),
   66  apply_state(G2, S1, S2).
   67apply_state((G1;G2), S0, S2) :- !,
   68  apply_state(G1, S0, S2);
   69  apply_state(G2, S0, S2).
   70
   71apply_state(s(Goal), S0, S2) :- !,
   72   notrace((compound_name_arguments(Goal, F, GoalL),
   73   append(GoalL, [S0], NewGoalL),
   74   must_input_state(S0),
   75   Call=..[F|NewGoalL])),
   76   dmust(Call),
   77   S0 = S2,
   78   must_output_state(S2).
   79
   80apply_state(Goal, S0, S2) :-
   81   notrace((compound_name_arguments(Goal, F, GoalL),
   82   append(GoalL, [S0, S2], NewGoalL),
   83   must_input_state(S0),
   84   Call=..[F|NewGoalL])),
   85   dmust(Call),
   86   must_output_state(S2).
   87
   88
   89
   90
   91apply_first_arg_state(Arg, Goal, S0, S2) :-
   92   notrace((compound_name_arguments(Goal, F, GoalL),
   93   append(GoalL, [S0, S2], NewGoalL),
   94   must_input_state(S0),
   95   Call=..[F, Arg|NewGoalL])),
   96   dmust(Call),
   97   must_output_state(S2).
   98
   99apply_first_arg(Arg, Goal, S0, S2):- 
  100   apply_first_arg_state(Arg, Goal, S0, S2).
  101
  102% --------
  103
  104% TODO: rewrite/debug findterm.
  105
  106findterm(Term, Term).
  107findterm(Term, [Head|_]) :- nonvar(Head),
  108  findterm(Term, Head).
  109findterm(Term, [_|Tail]) :- nonvar(Tail),
  110  findterm(Term, Tail).
  111findterm(Term, T) :-
  112  compound(T),
  113  \+ is_list(T),
  114  T =.. List,
  115  findterm(Term, List).
  116
  117% Substitute 'Replace' for 'Find' in T0, yielding T.
  118% TODO: add ^ handling like with bagof/setof.
  119%   bagof(Template, X^Goal, List) means to never instantiate X
  120% Current behavior:
  121%   subst(copy_term, macro(Code), expanded(Code, X), macro(foo), expanded(foo, Y))
  122%     leaving X unbound. Suppose I wanted X left bound?
  123%   subst(equivalent, macro(Code), expanded(Code, X), macro(foo), macro(foo))
  124%     This won't match Code.
  125%   subst(unify, macro(Code), expanded(Code, X), macro(foo), expanded(foo, X))
  126%     This only matches all occurrences of the same first Code!
  127subst(unify, Find1, Replace, Find2, Replace) :- Find1 = Find2,
  128  % The first unification of Find sticks!  Doesn't seem too useful to me.
  129  % TODO: consider somehow allowing a solution for each match.
  130  %   ground(Find) -> T0=Find, ! ; T0=Find.  sort of does it
  131  !.
  132subst(equivalent, Find, Replace, T0, Replace) :-
  133  % Don't unify any variables.  Safe and simple.
  134  T0 == Find,
  135  !.
  136subst(copy_term, Find, Replace, FindCopy, ReplaceCopy) :-
  137  % Unify with new instantiations at each replacement.
  138  % Allows sensible behavior like:
  139  %   subst(my_macro(Code),
  140  %         expanded(Code),
  141  %         (this, my_macro(that), other, my_macro(another)),
  142  %         (this, expanded(that), other, expanded(another)) )
  143  % ...but unfortunately will break any free-variable associations.
  144  % TODO: think about how bagof works; apply here.
  145  copy_term(Find-Replace, FindCopy-ReplaceCopy),
  146  !.
  147subst(BindType, Find, Replace, List, [T|Rest]) :-
  148  is_list(List),
  149  List = [T0|Rest0], % fails when List = []
  150  !,
  151  subst(BindType, Find, Replace, T0, T),
  152  subst(BindType, Find, Replace, Rest0, Rest).
  153subst(BindType, Find, Replace, T0, T) :-
  154  compound(T0),
  155  % \+ is_list(T0),
  156  !,
  157  T0 =.. [Functor0|Args0],
  158  subst(BindType, Find, Replace, Functor0, Functor1),
  159  subst(BindType, Find, Replace, Args0, Args1),
  160  % If Replacement would cause invalid functor, don't subst.
  161  ( atom(Functor1) -> T =.. [Functor1|Args1] ; T =.. [Functor0|Args1]).
  162subst(_BindType, _Find, _Replace, T, T).
  163
  164% Call subst on T for each Find-Replace pair in the given list.
  165% Order of substitution may matter to you!
  166subst_dict(_BindType, [], T, T).
  167subst_dict(BindType, [Find-Replace|Rest], T0, T) :-
  168  subst(BindType, Find, Replace, T0, T1),
  169  subst_dict(BindType, Rest, T1, T).
  170
  171
  172
  173writel([]).
  174writel([nl]) :- !, nl.  % special case if 'nl' is at end of list.
  175writel([H|T]) :- write(H), writel(T).
  176%writeln(L) :- writel(L), nl.
  177
  178% Is Term uninstantiated in any of its parts?
  179uninstantiated([]) :- !, fail.
  180uninstantiated(Term) :- var(Term).
  181uninstantiated([Head|_]) :- uninstantiated(Head).
  182uninstantiated([_|List]) :- !, uninstantiated(List).
  183uninstantiated(Term) :-
  184  compound(Term),
  185  Term =.. [Head | Tail],
  186  (uninstantiated(Head); uninstantiated(Tail)).
  187
  188% ground(Term) :- \+ uninstantiated(Term)
  189
  190% A safer "not" forbids uninstantiated arguments.
  191%:- op(900, fy, not).
  192%not(P) :- uninstantiated(P), throw(not(uninstantiated_var)).
  193%not(P) :- call(P), !, fail.    % standard prolog not(P) predicate
  194%not(_).
  195
  196%nth0(N0,List,Member) :-
  197%  N1 is N0 +1,
  198%  nth(N1,List,Member).  % gprolog only has 1-based indexing
  199
  200
  201/*
  202SWI
  203
  204random_adv(Base, Max, Number) :-
  205  Number is Base + random(Max - Base).
  206
  207my_random_member(List, Member) :-
  208  length(List, Count),
  209  random_adv(0, Count, R),  % fails if Count is 0
  210  nth0(R, List, Member).
  211*/
  212
  213%gensym(Base, NewSymbol) :- new_atom(Base, NewSymbol).
  214%gensym(NewSymbol) :- new_atom(gensym_, NewSymbol).
  215
  216%subset([Element|Tail], Set) :- member(Element, Set), subset(Tail, Set).
  217%subset([], _Set).
  218
  219%union([],Set,Set).
  220%union([Item|Tail],Set1,Set2) :-
  221%  member(Item,Set1),
  222%  !,
  223%  union(Tail, Set1, Set2).
  224%%union([Item|Tail],Set1,Set2) :-
  225%%  member(Item,Tail),
  226%%  !,
  227%%  union(Tail, Set1, Set2).
  228%union([Item|Tail],Set1,[Item|Tail2]) :-
  229%  union(Tail,Set1,Tail2).
  230
  231%intersection([],_Set,[]).
  232%intersection([Item|Tail],Set1,[Item|Tail2]) :-
  233%  member(Item, Set1),
  234%  !,
  235%  intersection(Tail,Set1,Tail2).
  236%intersection([_Item|Tail],Set1,Set2) :-
  237%  intersection(Tail,Set1,Set2).