home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / lifeos2.zip / LIFE-1.02 / TOOLS / DEBUG.LF < prev    next >
Text File  |  1996-06-04  |  9KB  |  564 lines
  1. % Debugger for predicates by source code transformation.
  2. %
  3. % Author: Richard Meyer
  4. %
  5. % Date: June 16th 1993
  6. %
  7. % USE: 'debug(Name,Level,Verbose)'
  8. % AFTER all the clauses for 'Name' have been defined.
  9. % WARNING: Will corrupt dynamic predicates and functions.
  10. %
  11. %    $Id: debug.lf,v 1.2 1994/12/08 23:50:39 duchier Exp $    
  12.  
  13.  
  14. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  15. %
  16. %        Code common to both predicates and functions.
  17. %
  18. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  19.  
  20.  
  21.  
  22. module("debug")?
  23. public(debug,undebug,goal)?
  24.  
  25.  
  26. %%%write("
  27. %%%DEBUG: source transformation to provide spy-points.
  28.  
  29. %%%Use:
  30. %%%    > import(""debug"")?
  31.  
  32. %%%    > debug(Name,Level,Verbose)?
  33.  
  34. %%%        Name     = name of function or predicate to debug
  35. %%%        Level         := {fail;clause;goal}
  36. %%%        Verbose     := {true;false}
  37.  
  38. %%%    > undebug(Name)?
  39.  
  40.  
  41. %%%Read: 'Tools/Debug.doc' for more information.
  42.  
  43. %%%")?
  44.  
  45.  
  46.  
  47. %
  48. % Debug - top-level entry point
  49. %
  50.  
  51. debug(What,Level,Verbose) :-
  52.     Level={clause;fail;goal},!,
  53.     Verbose={true;false},!,
  54.  
  55.     (
  56.         is_function(What),
  57.         !,
  58.         Type=(->),
  59.         S=function,
  60.         RW=rewrite_func
  61.     ;
  62.         is_predicate(What),
  63.         !,
  64.         Type=(:-),
  65.         S=predicate,
  66.         RW=rewrite_pred
  67.     ;
  68.         write_err("Debug: ",What," is not a predicate or a function"),
  69.         nl,
  70.         fail
  71.     ),
  72.  
  73.     dynamic(What),
  74.  
  75.     (
  76.         get_old_clauses(What,Clauses),
  77.         !
  78.     ;
  79.         read_and_retract(What,Clauses,Type),
  80.         assert(old_clauses(What,Clauses,Type,S))
  81.     ),
  82.  
  83.     (
  84.         Clauses:==[],
  85.         !,
  86.         write_err("*** No clauses for '",What,"'"),
  87.         nl_err
  88.     ;
  89.         write("Added debugging code to ",S," '",What,
  90.               "': level=",Level,
  91.               ", verbose=",Verbose,
  92.               ", clauses=",length(Clauses)),
  93.         nl,
  94.         RW=@(Clauses,What,Level,Verbose),
  95.         RW
  96.     ).
  97.  
  98.  
  99.  
  100. %
  101. % Undebug
  102. %
  103.  
  104. undebug(What) :-
  105.     get_old_clauses(What,Clauses),
  106.     !,
  107.     assert_list(Clauses),
  108.     retract(old_clauses(What) :- succeed).
  109.  
  110. undebug(What) :- write("Debug: no stored clauses for ",What),nl.
  111.  
  112. assert_list([H|T]) :- !,assert(H),assert_list(T).
  113. assert_list([]).
  114.  
  115.  
  116.  
  117. %
  118. % Restore the old clauses for a predicate or function
  119. %
  120.  
  121. dynamic(old_clauses)?
  122.  
  123. get_old_clauses(What,Clauses) :-
  124.     clause(old_clauses(What,Clauses,Type,Sort):-succeed),
  125.     !,
  126.     write("Debug: restored original clauses for ",Sort," '",What,"'"),
  127.     nl,
  128.     read_and_retract(What,ModifiedClauses,Type).
  129.  
  130.  
  131.  
  132. %
  133. % Output a trace message
  134. % Note: this could be improved with indenting.
  135. %
  136.  
  137. prefix(X) :- write("<",X,"> ").
  138.  
  139. debug_indent(0) :- !.
  140. debug_indent(N) :- write("  "),debug_indent(N-1).
  141.  
  142.  
  143.  
  144. %
  145. % Take verbose flag into account
  146. %
  147.  
  148. write_term(T,V) -> cond(V,T,root_sort(T)).
  149.  
  150.  
  151.  
  152. %
  153. % Read and retract the original clauses
  154. %
  155.  
  156. read_and_retract(P,[H|T],Type) :-
  157.     R=root_sort(P),
  158.     H=root_sort(Type),
  159.     H.1=R,
  160.     H.2=@,
  161. %    write("H=",H),nl,
  162.     clause(H),
  163.     !,
  164.     retract(H),
  165.     read_and_retract(P,T,Type).
  166.  
  167. read_and_retract(P,[],T).
  168.  
  169.  
  170.  
  171.  
  172. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  173. %
  174. %        P R E D I C A T E S
  175. %
  176. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  177.  
  178.  
  179.  
  180. %
  181. % Rewrite a predicate
  182. %
  183.  
  184.  
  185. rewrite_pred(Clauses,Pred,Level,Verbose) :-
  186.     cond(Level :\== fail,call_pred(Pred,Verbose)),
  187.     rewrite_clauses(Clauses,Pred,Level,Verbose,1),
  188.     fail_pred(Pred,Verbose),
  189.     ! .
  190.  
  191. rewrite_pred(C,Pred,L,V) :-
  192.     write_err("*** Debug failed for '",Pred,"': program corrupted."),
  193.     nl_err.
  194.  
  195.  
  196.  
  197. %
  198. % Call predicate
  199. %
  200.  
  201. call_pred(P,V) :-
  202.     R=root_sort(P),
  203.     M=write_term(R,V),
  204.     assert(R :- (prefix("CALL"),write(M,": entry call"),nl,fail)).
  205.  
  206.  
  207.  
  208. %
  209. % Fail predicate
  210. %
  211.  
  212. fail_pred(P,V) :-
  213.     R=root_sort(P),
  214.     M=write_term(R,V),
  215.     assert(R :- (prefix("FAIL"),write(M,": fails"),nl,fail)).
  216.  
  217. %
  218. % Rewrite clauses
  219. %
  220.  
  221. rewrite_clauses([H|T],Pred,Level,Verbose,N) :-
  222.     !,
  223.     H=(Head:-Body),
  224.     cond(Level :\== fail,try_clause(Pred,N)),
  225.  
  226.     rewrite_body(Body,Body2,Pred,Level,Verbose,N,1),
  227.  
  228.     cond(Level :== fail,
  229.          NewBody=Body2,
  230.          NewBody=(Body2,prefix("SUCC"),write(Pred,"#",N,": succeeds"),nl)
  231.     ),
  232.  
  233.     assert(Head :- NewBody),
  234.     rewrite_clauses(T,Pred,Level,Verbose,N+1).
  235.  
  236. rewrite_clauses([],Pred,Level,Verbose,N).
  237.  
  238.  
  239.  
  240. %
  241. % Try clause
  242. %
  243.  
  244. try_clause(Pred,N) :-
  245.     R=root_sort(Pred),
  246.     cond(N>1,
  247.          assert(Pred :- (    prefix("REDO"),
  248.                 write(R,": try clause #",N),
  249.                 nl,
  250.                 fail))).
  251.  
  252.  
  253.  
  254. %
  255. % Rewrite the body of a clause
  256. %
  257.  
  258. non_strict(rewrite_body)?
  259.  
  260. rewrite_body(Top,Top,Pred,Level,Verb,N,M) :-
  261.     Top :== @,
  262.     !.
  263.  
  264. rewrite_body((A,B),(A2,B2),Pred,Level,Verb,N,M) :-
  265.     !,
  266.     rewrite_body(A,A2,Pred,Level,Verb,N,M),
  267.     NM=M+1,
  268.     rewrite_body(B,B2,Pred,Level,Verb,N,NM).
  269.  
  270. rewrite_body((A;B),(A2;B3),Pred,Level,Verb,N,M) :-
  271.     !,
  272.     rewrite_body(A,A2,Pred,Level,Verb,N,M),
  273.     rewrite_body(B,B2,Pred,Level,Verb,N,M),
  274.     cond(Level :== goal,
  275.          B3=(prefix("REDO"),
  276.          write(Pred,"#",N,": retry disjunction"),
  277.          nl,
  278.          B2),
  279.          B3=B2).
  280.  
  281. rewrite_body(!,C,Pred,Level,Verb,N,M) :-
  282.     !,
  283.     C=(!,(
  284.         cond(Level:==fail,
  285.              succeed,
  286.              (    prefix("CUT!"),
  287.             cond(Level:==goal,
  288.                  write(Pred,"#",N,".",M,": cut!"),
  289.                  write(Pred,"#",N,": cut!")),
  290.             nl)
  291.         )
  292.          ;
  293.         prefix("FAIL"),
  294.         write(Pred,"#",N,": fails and alternatives cut"),
  295.         nl,
  296.         fail
  297.          )
  298.     ).
  299.  
  300.  
  301. rewrite_body(C:cond(A),D:cond(A),Pred,Level,Verb,N,M) :-
  302.     !,
  303.     cond(has_feature(2,C,T),
  304.          (    rewrite_body(T,T2,Pred,Level,Verb,N,M),
  305.         D.2=T)),
  306.  
  307.     cond(has_feature(3,C,F),
  308.          (    rewrite_body(F,F2,Pred,Level,Verb,N,M),
  309.         D.3=F)).
  310.     
  311.  
  312. % Default:
  313. rewrite_body(A,A2,Pred,Level,Verb,N,M) :-
  314.     cond(Level:==goal,
  315.          A2=(    prefix("GOAL"),
  316.             write(Pred,"#",N,".",M,": ",write_term(A,Verb)),
  317.             nl,
  318.             A),
  319.          A2=A).
  320.  
  321.  
  322.  
  323. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  324. %
  325. %        F U N C T I O N S
  326. %
  327. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  328.  
  329.  
  330. %
  331. % Rewrite a function
  332. %
  333.  
  334. rewrite_func(Rules,Func,Level,Verbose) :-
  335. %    cond(Level :\== fail,call_func(Func,Verbose)),
  336.     rewrite_rules(Rules,Func,Level,Verbose,1),
  337.     fail_func(Func,Verbose),
  338.     ! .
  339.  
  340. rewrite_func(C,Func,L,V) :-
  341.     write_err("*** Debug failed for '",Func,"': program corrupted."),
  342.     nl_err.
  343.  
  344.  
  345. %
  346. % Call function
  347. % Can't implement this without renaming - so won't
  348.  
  349. %call_func(P,V) :-
  350. %    R=root_sort(P),
  351. %    M=write_term(R,V),
  352. %    assert(R :- (prefix("CALL"),write(M,": entry call"),nl,fail)).
  353.  
  354. %
  355. % Fail function:
  356. %
  357.  
  358. fail_func(P,V) :-
  359.     R=root_sort(P),
  360.     M=write_term(R,V),
  361.     assert((R -> @ | prefix("FAIL"),write(M,": fails"),nl,fail)).
  362.  
  363.  
  364.  
  365. %
  366. % Rewrite rules
  367. %
  368.  
  369. rewrite_rules([H|T],Func,Level,Verbose,N) :-
  370.     !,
  371.     rewrite_rule(H,Func,Level,Verbose,N),
  372.     rewrite_rules(T,Func,Level,Verbose,N+1).
  373.  
  374. rewrite_rules([],Func,Level,Verbose,N).
  375.  
  376.  
  377. %
  378. % Debug messages for functions:
  379. %
  380.  
  381. func_fail(M,N) :-
  382.     prefix("FAIL"),
  383.     write(M,": fails at clause #",N),
  384.     nl,
  385.     fail.
  386.  
  387. eval_fail(M,N) :-
  388.     prefix("FAIL"),
  389.     write(M,": evaluation at clause #",N),
  390.     nl,
  391.     fail.
  392.  
  393. body_fail(M,N) :-
  394.     prefix("FAIL"),
  395.     write(M,": such-that goals at clause #",N),
  396.     nl,
  397.     fail.
  398.  
  399.  
  400.  
  401. %
  402. % Rewrite a function rule
  403. %
  404.  
  405. non_strict(rewrite_rule)?
  406.  
  407.  
  408.  
  409. % Goal level
  410.  
  411. rewrite_rule((Pattern -> W),Func,goal,Verbose,N) :-
  412.     W :== `(|) ,
  413.     !,
  414.     W= `(Value | Body),
  415.     M=write_term(Pattern,Verbose),
  416.     rewrite_body(Body,Body2,Func,goal,Verbose,N,1),
  417.     Check=( Succ<<-@,
  418.     (
  419.         prefix("PATT"),
  420.         write(M,": pattern matches clause #",N),
  421.         nl,
  422.         Succ<<-patt,
  423.  
  424.         Result=Value,
  425.         prefix("EVAL"),
  426.         write(M,": clause #",N,", result=",
  427.             `write_term(Result,Verbose)),
  428.         nl,
  429.         Succ<<-evall,
  430.  
  431.         Body2,
  432.         prefix("SUCC"),
  433.         write(M,": clause #",N),
  434.         nl,
  435.         Succ<<-succ
  436.     ;
  437.         `(Succ:==succ),
  438.         !,
  439.         fail
  440.     ;
  441.         `(Succ:==evall),
  442.         !,
  443.         body_fail(M,N)
  444.     ;
  445.         `(Succ:==patt),
  446.         !,
  447.         eval_fail(M,N)
  448.     ;
  449.         func_fail(M,N)
  450.     )),
  451.     assert((Pattern-> Result | Check)).
  452.  
  453.  
  454.  
  455. rewrite_rule(Pattern -> Value,Func,goal,Verbose,N) :-
  456.     !,
  457.     M=write_term(Pattern,Verbose),
  458.     Check=(    Succ<<-@,
  459.     (
  460.         prefix("PATT"),
  461.         write(M,": pattern matches clause #",N),
  462.         nl,
  463.         Succ<<-patt,
  464.  
  465.         Result=Value,
  466.         prefix("EVAL"),
  467.         write(M,": clause #",N,", result=",
  468.             `write_term(Result,Verbose)),
  469.         nl,
  470.         Succ<<-evall
  471.     ;
  472.         `(Succ:==evall),
  473.         !,
  474.         fail
  475.     ;
  476.         `(Succ:==patt),
  477.         !,
  478.         eval_fail(M,N)
  479.     ;
  480.         func_fail(M,N)
  481.     )),
  482.     assert((Pattern-> Result | Check)).
  483.  
  484.  
  485.  
  486.  
  487.  
  488.  
  489. % Clause level
  490.  
  491. rewrite_rule((Pattern -> W),Func,clause,Verbose,N) :-
  492.     W :== ` | ,
  493.     !,
  494.     W= `(Value | Body),
  495.     M=write_term(Pattern,Verbose),
  496.     Result=Value,
  497.     Check=( Succ<<-@,
  498.     (    Body,
  499.         prefix("SUCC"),
  500.         write(M,": clause #",N,", result=",
  501.             `write_term(Result,Verbose)),
  502.         nl,
  503.         Succ<<-succ
  504.     ;
  505.         `(Succ:==succ),
  506.         !,
  507.         fail
  508.     ;
  509.         func_fail(M,N)
  510.     )),
  511.     assert((Pattern-> Result | Check)).
  512.  
  513.  
  514.  
  515. rewrite_rule(Pattern -> Value,Func,clause,Verbose,N) :-
  516.     !,
  517.     M=write_term(Pattern,Verbose),
  518.     Result=Value,
  519.     Check=(    Succ<<-@,
  520.     (    prefix("EVAL"),
  521.         write(M,": clause #",N,", result=",
  522.             `write_term(Result,Verbose)),
  523.         nl,
  524.         Succ<<-evall
  525.     ;
  526.         `(Succ:==evall),
  527.         !,
  528.         fail
  529.     ;
  530.         func_fail(M,N)
  531.     )),
  532.     assert((Pattern-> Result | Check)).
  533.  
  534.  
  535.  
  536. % Fail level
  537.  
  538. rewrite_rule((Pattern -> W),Func,fail,Verbose,N) :-
  539.     W :== ` | ,
  540.     !,
  541.     W= `(Value | Body),
  542.     M=write_term(Pattern,Verbose),
  543.     Check=(    Succ<<-@,
  544.     (    Body,
  545.         Succ<<-succ
  546.     ;
  547.         `(Succ:==@),
  548.         func_fail(M,N)
  549.     )),
  550.     assert((Pattern-> Value | Check)).
  551.  
  552.  
  553.  
  554. rewrite_rule((Pattern -> Value),Func,fail,Verbose,N) :-
  555.     !,
  556.     M=write_term(Pattern,Verbose),
  557.     Check=(    Succ<<-@,
  558.     (    Succ<<-succ
  559.     ;
  560.         `(Succ:==@),
  561.         func_fail(M,N)
  562.     )),
  563.     assert((Pattern-> Value | Check)).
  564.