% File : ADVICE.PL % Author : R.A.O'Keefe % Updated: 20 August 1984 % Purpose: Interlisp-like advice package. % This module defines three commands and a predicate: % advise(Predicate, Port, Action) % unadvise(Predicate) % unadvise(Predicate, Port) % advised(Prediate) % which cause the Action to be performed at that Port (advise), % cause no action to be performed at that Port (unadvise), or % test whether a predicate is advised. % The Predicate argument must be a Prolog term. a/2 will be taken % as referring to the predicate (/)/2, which is probably not what % you want. Write a(_,_). This is the same convention as that % used by current_predicate. For advise/3 the arguments will be % retained and may be used as a further condition; the other two % predicates ignore the arguments except to note how many they are. % The Port argument may be call, exit, redo, or fail. % This corresponds exactly to the ports shown by the debugger. % Note that the "neck" port of some debuggers cannot be handled in % this indirect fashion. Advice should be integrated with the % debugger so that spy-points are handled this way, perhaps as % advise(Goal, call, spy) or some such. % Unlike the InterLISP facility on which this is based, it is % not possible to advise built-in predicates. %----------------------------------------------------------------------------% %...advised(Goal) % is true when Goal is a Prolog goal whose predicate is under advice. % The Goal may have some of its arguments filled in, that doesn't % matter. This predicate may be used to enumerate the predicates % being advised, in the spirit of current_predicate. advised(Goal) :- current_predicate(_, Goal), clause(Goal, 'a$call'(Goal,_)). %...advised(Goal, Skel, Call) % is a version of advised/1 which returns the general skeleton for % goal, and if the goal is ill-formed or not being advised, prints % an error message. It may NOT be used to enumerate goals, but as % you are not supposed to know about it, that is acceptable. As a % result of picking up the mapped call from the clause, only advise % needs to know how the new name is generated. advised(Goal, Skel, Call) :- functor(Goal, Functor, Arity), functor(Skel, Functor, Arity), clause(Skel, 'a$call'(Skel,Call)), !. advised(Goal, _, _) :- display('! You are not advising '), display(Goal), ttynl, fail. %----------------------------------------------------------------------------% %...advise(Goal, Port, Action) % makes sure that the Goal is being advised, and then adds an % entry to its advice table. On the Dec-10 and in C-Prolog, we % are able to put the advice "on the Goal's property list" by % using recorda/z. advise(Goal, Port, Action) :- 'a$fail'(Port), functor(Goal, Functor, Arity), functor(Skel, Functor, Arity), advise(Goal, Skel), recordz(Skel, advice(Port,Goal,Action), _). %...a$fail(Port) % checks that the Port is a valid port name. 'a$fail'(Var) :- var(Var), !, display('! Variable as port name in advise/unadvise'), ttynl, fail. 'a$fail'(call) :- !. 'a$fail'(exit) :- !. 'a$fail'(redo) :- !. 'a$fail'(fail) :- !. 'a$fail'(Port) :- display('! unknown port name '), display(Port), ttynl. %...advise(Goal) % takes a skeletal Goal, e.g. f(A,B,C), and makes sure that calls % to that goal will be routed to e.g. a$f(A,B,C) via a$call. If % the goal is advised already, nothing is done. If there are no % clauses for this goal, an error is announced (as this usually % indicates a typing mistake or a system predicate. Otherwise % all the current clauses are renamed, and a new clause % f(A, B, C) :- a$call(f(A,B,C), a$f(A,B,C)). % is added. BEWARE: this will not work if you change the predicate % using assert/retract. It would have to be built in to the system % at a much lower level for that to work. advise(_, Skel) :- % already advised? clause(Skel, 'a$call'(Skel,_)), !. advise(_, Skel) :- % has clauses? current_predicate(Functor, Skel), !, concat('a$', Functor, Afunctor), Skel =.. [Functor |Args], Call =.. [Afunctor|Args], ( clause(Skel, Body, Ref), assertz((Call :- Body)), erase(Ref), fail ; true ), !, assert((Skel :- 'a$call'(Skel,Call))). advise(Goal, _) :- display('! You have no clauses for '), display(Goal), ttynl, fail. advise(Pred_name) :- % An addition KJ 26-6-87 current_predicate(Pred_name, Skel), default_message(Pred_name, call, Message_for_call), advise(Skel, call, Message_for_call), default_message(Pred_name, redo, Message_for_redo), advise(Skel, redo, Message_for_redo), default_message(Pred_name, fail, Message_for_fail), advise(Skel, fail, Message_for_fail), default_message(Pred_name, exit, Message_for_exit), advise(Skel, exit, Message_for_exit). default_message(Pred_name, Port, Message) :- name(Pred_name,Pred_chars), name(Port, Port_chars), append(Pred_chars, [58,32|Port_chars],C1), % 58=';', 32=' ' append(C1, [10], C2), name(Message,C2). %----------------------------------------------------------------------------% %...unadvise(Goal) % wipes out all of the advice for the Goal. unadvise(Goal) :- advised(Goal, Skel, Call), retract((Skel :- 'a$call'(Skel,Call))), ( clause(Call, Body, Ref), assertz((Skel :- Body)), erase(Ref), fail ; true ), !, 'a$abolish'(Skel, _). %...unadvise(Goal, Port) % wipes out all the advice for Goal saying what to do at this Port. unadvise(Goal, Port) :- 'a$fail'(Port), % check that the Port is valid. advised(Goal, Skel, _), % validate the Goal. 'a$abolish'(Skel, Port). %...a$abolish(Goal, Port) % wipes out all the advice for this port of the goal, given % that the goal and port have been validated. 'a$abolish'(Goal, Port) :- recorded(Goal, advice(Port,_,_), Ref), erase(Ref), fail. 'a$abolish'(_, _). %...a$call(SourceGoal, MappedGoal) % routes a call on SourceGoal to call MappedGoal instead, but obeys % any advice that may be lying around. % 'a$call'(Goal, Call) :- % !, % call(Call). 'a$call'(Goal, Call) :- ( recorded(Goal, advice(call,Goal,Action), _), call(Action), fail ; call(Call) ; recorded(Goal, advice(fail,Goal,Action), _), call(Action), fail ), ( recorded(Goal, advice(exit,Goal,Action), _), call(Action), fail ; true ; recorded(Goal, advice(redo,Goal,Action), _), call(Action), fail ). /*----------------------------------------------------------------------+ | | | pa prints all advice | | pa help prints help about the advice package | | pa Preds prints the advice for Preds, where Preds | | is the same sort of specification pp takes. | | To use these commands you must have PP.PL loaded. | | | +----------------------------------------------------------------------*/ pa :- flag(advice, Old, Old), write('% The advice flag is '), write(Old), nl, advised(Pred), functor(Pred, F, N), pa_explicit(F/N), fail ; true. pa(help) :- !, give_help('advice.hlp'). pa(Pattern) :- setof(Predicate, isCurrent(Pattern, pp, Predicate), Predicates), pa_explicit(Predicates). pa_explicit([Head|Tail]) :- pa_explicit(Head), pa_explicit(Tail). pa_explicit([]). pa_explicit(Functor/Arity) :- functor(Head, Functor, Arity), write('% '), write(Functor/Arity), ( clause(Head, 'a$call'(Head,_)), !, nl, ( recorded(Head, advice(Port,Head,Action), _), write(:-(advise(Head,Port,Action))), put(46), nl, fail ; true ) ; write(' is not advised'), nl ). concat(Atom1,Atom2,Atom12) :- name(Atom1,Chars1), name(Atom2,Chars2), append(Chars1,Chars2,Chars12), name(Atom12,Chars12). append([],X,X). append([H|T],U,[H|V]) :- append(T,U,V).