[net.sources] Prolog library: medic.pl

pereira@sri-unix.UUCP (08/15/83)

/*----------------------------------------------------------------------------
 
        Mode Error Diagnosis in Interpreted Code
        ----------------------------------------
 
                A Prolog Debugging Aid.
 
 
    This little package is supposed to help a Prolog programmer find mode
errors in his program.  It provides a new consulting routine called "medic"
which reads an unmodified file just like compile, consult, or reconsult.
The new evaluable predicate "expand_term" provided in version 3 Prolog permits
the use of MEDIC with DCGs and any future extensions to Prolog made in that
way.  A procedure whose mode is being checked may be spied and traced like
an ordinary Prolog procedure, because it IS an ordinary Prolog procedure.
 
    To use the package, type ".ru medic" instead of ".ru util".  MEDIC is
in the Mecho library area.  It may be used exactly as you would use UTIL.
Then just write "medic(File)" instead of "compile(File)".  The effect of
this is similar to the effect of "reconsult(File)", NOT "consult(File)".
 
    When a mode violation is detected, an error message will be printed and
you will be put in a break.  If you simply exit from the break with ^Z the
program will continue just as if nothing was wrong.  This will happen EACH
time the error is detected;  you can disable/enable it, however.  First, an
example.  Suppose you said   medic(tom)  where
tom:
        :- mode dick(+, -).
        dick(f(X, Y), Z) :-
                ... .
and then called  dick(U, 1+1).  The message will be
        ! Mode error: dick(+,-) called by
        dick(_1763,1+1)
        --- break ---
 
    If you have worked out why some mode is wrong, but would like to keep on
debugging, you can disable the checking by calling
        well(Functor, Arity).
There is still a certain amount of overhead associated with the procedure,
but at least you won't get the error messages any more.  If you change your
mind and want to see error messages again for that procedure, call
        sick(Functor, Arity).
 
    NB: medic doesn't understand about spy-points.  It will not preserve them,
and neither will "sick" and "well".  Nor is "medication" transparent to spying.
If you want a procedure to be checked and spied, you will have to spy on it
again every time medic does something to it.
 
----------------------------------------------------------------------------*/
 
:- public medic/1, well/2, sick/2, 'med$check'/2.
 
:- mode
    medic(?),   %  playing safe, should be +
        rest(+, +),
            handle(+, +, -),
                modes(+),
                    compare(+, +),
                    genname(+, -),
                        append(+, +, -),
                define(+, +, +, -),
                    change(+, +, -),
                    passed(+, +, +, -),
                        passed(+, +, +),
                others(+),
    sick(?, ?), well(?, ?),    %  playing safe again
        genterms(+, +, +, +, -, -),
    'med$check'(+, +),
        check_args(+, +).
 
 
medic(File) :-
        atom(File),
        seeing(OldFile),
        see(File), !,
        read(Term),
        rest(Term, none),
        seen,
        seeing(OldFile),
        write(File), write(' mediconsulted.'), nl.
 
%   rest is given two things: the next term to be processed, and a table
%   of the procedures seen so far in this file.  The table is
%       none                            - none read yet
%       read(Functor, Arity, Rest)      - Functor/Arity and the Rest
 
rest(end_of_file, Read) :- !.
rest(Other, Read) :-
        expand_term(Other, Term),
        handle(Term, Read, Seen),
        read(Next), !,
        rest(Next, Seen).
 
%   handle must cope with six cases:
%       :- public -,.. , - .                            {ignore}
%       :- mode   -,.. , - .                            {translate & store}
%       :- op     -,.. , - .                            {obey}
%       :- reconsult(File).                             {recur}
%       :- question.  or ?- question.                   {ignore? obey?}
%       assertion.                                      {translate & assert}
 
handle(':-'(public(_)),   Read, Read) :- !.
handle(':-'(mode(Modes)), Read, Read) :- !,
        modes(Modes).
handle(':-'(Others),      Read, Read) :- !,
        others(Others).
handle(':-'(Head, Body),  Read, Seen) :- !,
        define(Head, Tete,Read, Seen),
        assertz(( Tete :- Body )).
handle(Head,              Read, Seen) :- !,
        define(Head, Tete, Read, Seen),
        assertz(( Tete :- true )).
 
%   define(Head, Tete, Read, Seen)  checks whether the goal Head defines
%   some procedure whose mode is to be checked.  If it is, then a stub
%   has already been generated, and the functor is to be renamed, producing
%   a new goal Tete.  If the new goal is the first of its sort in this file
%   then any existing definitions of it should be abolished.
 
define(Head, Tete, Read, Seen) :-
        functor(Head, OldFunc, Arity),
        change(OldFunc, Arity, NewFunc),
        passed(Read, NewFunc, Arity, Seen),
        Head =.. [OldFunc|Args],
        Tete =.. [NewFunc|Args].
 
        change(OldFunc, Arity, NewFunc) :-
                'med$mode'(OldFunc, Arity, NewFunc, Template), !.
        change(OldFunc, Arity, OldFunc).
 
%   passed(Read, Functor, Arity, Seen) checks whether Functor/Arity is in
%   Read, in which case Seen=Read {nothing new}, or whether it is not, in
%   which case it is added to Read to form Seen, and any previous version
%   of the procedure is abolished.
 
passed(Read, Functor, Arity, Read) :-
        passed(Read, Functor, Arity), !.
passed(Read, Functor, Arity, read(Functor, Arity, Read)) :-
        abolish(Functor, Arity).
 
        passed(read(Functor, Arity, Read), Functor, Arity) :- !.
        passed(read(_,       _,     Read), Functor, Arity) :- !,
                passed(Read, Functor, Arity).
 
'med$check'(Template, Call) :-
        Template =.. [Functor|ArgModes],
        Call     =.. [NewFunc|Actuals],
    1514
From: sri-unix!pereira
Newsgroups: net.sources
Title: Prolog library: setrou.pl
Article-I.D.: sri-unix.119
Posted: Mon Aug  8 23:01:03 1983

/* SETROU.PL : Set manipulating routines

						UTILITY
						Lawrence
						Updated: 31 March 81
*/

	%%%  Compile this module
	%%%  SETROU requires no other modules



 /* EXPORT */

  :- public intersect/3,
	    member/2,
	    memberchk/2,
	    nmember/3,
	    seteq/2,
	    subset/2,
	    subtract/3,
	    union/3.



  /* MODES */

	:- mode intersect(?,?,?).
	:- mode member(?,?).
	:- mode memberchk(?,?).
	:- mode nmember(?,+,?).
	:- mode seteq(?,?).
	:- mode subset(?,?).
	:- mode subtract(?,?,?).
	:- mode union(?,?,?).




  intersect([],Set,[]).

  intersect([HD|TL],Set,[HD|Ans])
	:- member(HD,Set),
	   !,
	   intersect(TL,Set,Ans).

  intersect([HD|TL],Set,Ans) :- intersect(TL,Set,Ans).



  member(X,[X|TL]).

  member(X,[Y|TL]) :- member(X,TL).


  memberchk(X,[X|TL]) :- !.

  memberchk(X,[Y|TL]) :- memberchk(X,TL).



			% X is the N'th member of List

nmember(X,[X|_],1).

nmember(X,[_|L],N)
     :-	nmember(X,L,M),
	N is M+1.



  seteq(S1,S2) :- subset(S1,S2), subset(S2,S1).



  subset([],Ys).

  subset([X|Xs],Ys)
	:- memberchk(X,Ys),
	   subset(Xs,Ys).



  subtract([],Ys,[]).

  subtract([X|Xs],Ys,Zs)
	:- member(X,Ys),
	   !,
	   subtract(Xs,Ys,Zs).

  subtract([X|Xs],Ys,[X|Zs]) :- subtract(Xs,Ys,Zs).



  union([],Ys,Ys).

  union([X|Xs],Ys,Zs)
	:- member(X,Ys),
	   !,
	   union(Xs,Ys,Zs).

  union([X|Xs],Ys,[X|Zs]) :- union(Xs,Ys,Zs).



    'med$mode'(Functor, Arity, NewFunc, Template), !,
        abolish(Functor, Arity),  %  remove old stub
        genterms(Functor, NewFunc, Arity, [], Head, Call),
        assert((  Head :- Call  )),
        !.
well(Functor, Arity) :-
        write('! MEDIC hasn''t been consulted about '),
        write(Functor/Arity), nl,
        !.
 
%   genterms(F1, F2, N, [], T1, T2)
%   binds T1 to F1(A,...,Z) and T2 to F2(A,...,Z).
 
genterms(F1, F2, 0, Args, T1, T2) :- !,
        T1 =.. [F1|Args],
        T2 =.. [F2|Args].
genterms(F1, F2, N, Args, T1, T2) :-
        M is N-1, !,
        genterms(F1, F2, M, [Arg|Args], T1, T2).
 
%   modes(Modes) is given a comma-list of mode-declarations, which I call
%   "templates" here.  For each template, it checks that the new template
%   doesn't conflict with a previous template for the same procedure.  In
%   any case it creates an entry in the table med$mode and then says that
%   the procedure is "sick".  E.g. given :- mode dick(+,-) it stores
%       med$mode(dick, 2, med$dick, dick(+,-)).
%   and creates the stub
%       dick(A, B) :- med$check(dick(+,-), med$dick(A,B)).
%   MEDIC is free to create any new name in place of med$dick; only this
%   section of the package knows what that name is.  And only "sick/well"
%   know how the run-time checking is done.
 
modes(','(A,B)) :- !,
        modes(A),
        modes(B).
modes(Template) :-
        functor(Template, Functor, Arity),
        (   retract('med$mode'(Functor, Arity, NewFunc, OldTemp)),
                compare(OldTemp, Template)
        ;   genname(Functor, NewFunc)
        ),
        assert('med$mode'(Functor, Arity, NewFunc, Template)), !,
        sick(Functor, Arity).
 
%   compare(Old_template, New_template) checks that the new description
%   doesn't conflict with the old.  At the moment this is a simple = test,
%  but some more complex test might be justifiable.  Might.
 
compare(Same, Same).
compare(Old,  New ) :-
        write('! New mode declaration '), write(New),
        write(' conflicts with '), write(Old), nl,
        write('  New declaration accepted.'), nl.
 
genname(OldAtom, NewAtom) :-
        name(OldAtom, OldName),
        append("med$", OldName, NewName),
        name(NewAtom, NewName).
 
        append([Head|Tail], More, [Head|Rest]) :- !,
                append(Tail, More, Rest).
        append([], More, More).
 
%   others handles miscellaneous things like "op", "reconsult".
%   perhaps other commands should be obeyed too?
 
others(','(A,B)) :- !,
        others(A),  !,
        others(B).
others(op(A,B,C)) :- !,
        op(A,B,C).
others(reconsult(A)) :- !,
        medic(A).
others([-A]) :- !,
        medic(A).
others(X) :-
        true.   %   is this right?