home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / MAGAZINE / MISC / AI_NOV88.ZIP / TBOXCDE < prev   
Encoding:
Text File  |  1988-05-04  |  10.1 KB  |  358 lines
  1. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2.  
  3.                  A Prolog Bug
  4.  
  5. % THE BUG:
  6.  
  7. t_write_list_cond_nl(Handle, Col)  :-
  8.        Col > 40,   !,
  9.        t_nl(Handle).
  10. t_write_list_cond_nl :- t_write(Handle, $ $).
  11.  
  12. % THE CALLING PREDICATE:
  13.  
  14. test :-
  15.           init_log_file, !,
  16.           nl, write($>>$),
  17.           read_string(100, X),
  18.           string_term(X, Foo),
  19.           nl, write($Term = $), write(Foo), nl,
  20.           trace_message(Foo    ),
  21.           close_log_file.
  22.  
  23.  
  24.         Listing 2
  25.  
  26.  
  27. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  28.  
  29.               A Tracing Predicate
  30.  
  31.         % print a trace message
  32. trace_message(X):-
  33.       get_trace_handle(Handle),
  34.       leadoff(Handle), trace_msg_hlpr(Handle,X).
  35.  
  36.         % print actual trace message after message header
  37.            % message is a list of printable items
  38.            % recurse on this list
  39. trace_msg_hlpr(Handle,[])  :- !,t_nl(Handle).
  40. trace_msg_hlpr(Handle,[H|T])  :- !,
  41.        write_message(Handle,H),!,
  42.        trace_msg_hlpr(Handle,T).
  43. trace_msg_hlpr(Handle,X) :- trace_msg_hlpr(Handle,[X]),!.
  44.  
  45.             % print a trace message header
  46. leadoff(Handle) :-     t_nl(Handle),
  47.                        t_write(Handle,$% **TRACE***: $).
  48.  
  49.             % print an individual trace message
  50.                   % special rule for lists
  51. write_message(Handle,X) :- is_nonempty_list(X),!,
  52.                            t_write_list(Handle,X).
  53.                   % rule for everything else
  54. write_message(Handle,X) :- write_message_hlpr(Handle,X).
  55.  
  56.  
  57.       % print an individual non_list trace message
  58.                % special debugging rule
  59. write_message_hlpr(Handle,X) :-
  60.                 % *********** INSERTED TRACE MESSAGE ***********
  61.              nl, write($ write_message_hlpr : $), write( X),fail.
  62.                % rule for strings
  63. write_message_hlpr(Handle,X) :- string(X),!, t_write(Handle,X).
  64.                % rule for non-strings
  65. write_message_hlpr(Handle,X) :- t_writeq(Handle,X).
  66.  
  67.         % do a new line both on screen and in trace log
  68.         % if there is one
  69. t_nl(Handle) :-
  70.      nl(1),
  71.      (Handle >=0,! /* , nl(Handle)   */ ;
  72.       true).
  73.  
  74.         % write in human format the argument both on screen and
  75.         % in trace log if there is one
  76. t_write(Handle,X) :-
  77.      write(1,X),
  78.      (Handle >=0,!  /*,  write(Handle,X) */  ;
  79.       true).
  80.  
  81.         % write in Prolog format the argument both on screen and
  82.         % in trace log if there is one
  83. t_writeq(Handle,X) :-
  84.      writeq(1,X),
  85.      (Handle >=0,! /* , writeq(Handle,X) */  ;
  86.       true).
  87.  
  88.         % write a list argument both on
  89.         % screen and in trace log if there is one
  90. t_write_list(Handle,[H|T]):-
  91.                 % *********** INSERTED TRACE MESSAGE ***********
  92.               nl, write($ t_write_list : $), write( [H|T]) ,
  93.           t_write(Handle,$[$) ,        !,
  94.                 % write list head
  95.           write_message_hlpr(Handle,H),     !,
  96.                 % write list tail
  97.           t_write_list_hlpr(Handle,T).
  98.  
  99.         % write a list tail both on
  100.         % screen and in trace log if there is one
  101.              % write right bracket when list is finished
  102. t_write_list_hlpr(Handle,[]) :-
  103.           t_write(Handle,$]$) ,        !.
  104.  
  105.              % recursive rule
  106. t_write_list_hlpr(Handle,[H|T]) :-
  107.                 % *********** INSERTED TRACE MESSAGE ***********
  108.               nl, write($ t_write_list_hlpr : $), write( [H|T]) ,
  109.                  % write separating comma
  110.           t_write(Handle,$,$) ,        !,
  111.                  % decide whether to start a new line
  112.           tget(_,Col),                 !,
  113.                 % *********** INSERTED TRACE MESSAGE ***********
  114.               nl, write($ a tget, Col = $), write( Col  ) ,
  115.           t_write_list_cond_nl(Handle, Col),!,
  116.                 % write list head
  117.           write_message_hlpr(Handle,H),  !,
  118.                 % recurse for tail
  119.           t_write_list_hlpr(Handle,T) .
  120.  
  121.          % decide whether to start a new line
  122. t_write_list_cond_nl(Handle, Col)  :-
  123.               % start a new line if you're past col. 40
  124.        Col > 40,   !,
  125.        t_nl(Handle).
  126.              % NOTE: This clause has a bug -- left in for
  127.              %       illustration.  Add the rule head arguments
  128.              %       from prev. clause before you run the program
  129.  
  130.               % otherwise just put in a space
  131. t_write_list_cond_nl :- t_write(Handle, $ $).
  132.  
  133. is_nonempty_list([_|_]).
  134.  
  135.  
  136. % reprinted by permission of Instant Recall
  137.  
  138.                     Listing 3
  139.  
  140. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  141.  
  142.           A Traced Main Predicate
  143.  
  144.     % main predicate
  145. main :- init_log_file, !,
  146.           main_trace($b init$),
  147.         init,  !,         % initial screen, etc.
  148.           main_trace($a init, b main_menu_loop$),
  149.              % you are now in a blank main  window
  150.              % main menu for user -- a loop
  151.         menu_loop(main_menu, $ MAIN  MENU$), !,
  152.           main_trace($ a main_menu_loop b closeout$),
  153.         closeout,     !,  % end  run
  154.           main_trace($ a closeout$),
  155.         close_log_file.
  156. main  :- error_msg($Error in main predicate.$).
  157.  
  158.  
  159.           Listing 5
  160.  
  161.  
  162. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  163.  
  164.              Getting Test Information
  165.  
  166.  
  167. dbox_exit(Box)   :-
  168.    dbox_proc_trace([$e dbox_exit, Box = $, Box]),   !,
  169.   write_message_for_user,
  170.   current_screen(Screen),  !,
  171.    dbox_proc_trace([$current_screen = $,Screen  ]),   !,
  172.   save_info( Box, Screen), !,
  173.    dbox_proc_trace([$b process_goto_question$]), !,
  174.   process_goto_question( Screen) ,
  175.   rem_global_value(current_screen), !,
  176.    dbox_proc_trace([$a rem current_screen, x dbox_exit$]),
  177.   !.
  178.  
  179.  
  180.              Listing 7
  181.  
  182. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  183.  
  184.             Trace Log Utilities
  185.  
  186.         % name of trace log file
  187. log_filename($log.log$).
  188.  
  189. init_log_file :-
  190.    log_filename( Log ),
  191.         % create trace log file
  192.    create(Handle, Log),
  193.    close(Handle),
  194.         % open it for appending
  195.    open( Handle2, Log, ra),
  196.         % save its file handle
  197.    setglobal(log_file_handle, Handle2),
  198.         % Message to user if user turns message flag on
  199.    (trace_trace, !,
  200.      trace_message([
  201.        $To save trace log do close_log_file if you get 'no'.$]),
  202.         % get acknowledgement keystroke
  203.      press_any;
  204.     true).
  205.  
  206. close_log_file :-
  207.         % get trace file handle
  208.    getglobal(log_file_handle, Handle),
  209.    close( Handle),
  210.         % clean up database
  211.    rem_global_value( log_file_handle).
  212.  
  213.        % get the handle for the trace log
  214. get_trace_handle(Handle) :-
  215.       getglobal(log_file_handle, Handle),!.
  216.        % default is -1, a recognizably illegal handle
  217. get_trace_handle(  -1  ) :- !.
  218.  
  219. % reprinted from Prolog Tools by permission of Instant Recall
  220.  
  221.              Listing 8
  222.  
  223.  
  224. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  225.  
  226.             A Test Predicate
  227.  
  228. test :-   test_hlpr,!.
  229. test :-   trace_message($Failure in tested predicate$),
  230.           close_log_file.
  231.  
  232. test_hlpr :-
  233.           init_log_file,    !,
  234.           call(what_to_test), !,
  235.           close_log_file.
  236.  
  237. what_to_test :-
  238.           report.
  239.  
  240.  
  241.              Listing 9
  242.  
  243. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  244.  
  245.       An Algorithmizing Control Predicate
  246.  
  247. do_or_die(L):-do_or_die(L,fail).
  248. do_or_die(List,Flag):-
  249.     call(Flag),!,
  250.     nl,write($*** entering do_or_die $),writeq(List),nl,
  251.     do_or_die0(List,true).
  252. do_or_die(List,_):-
  253.     do_or_die0(List,false).
  254.  
  255. do_or_die0([],true):-!,
  256.     nl,write($*** exit do_or_die$),nl.
  257. do_or_die0([],_):-!.
  258.  
  259. do_or_die0([H|T],Flag):-
  260.    (Flag,!,
  261.      nl,write($*** before $),writeq(H),nl
  262.    ;true),!,
  263.    do_or_die1(H,T,Flag).
  264. do_or_die0(X,Flag):-
  265.     do_or_die0([X],Flag).
  266.  
  267. do_or_die1(H,T,Flag):-
  268.      call(H),!,
  269.    (Flag,!,
  270.      nl,write($*** after $),writeq(H),nl
  271.    ;true),!,
  272.   do_or_die0(T,Flag).
  273. do_or_die1(H,_,Flag):-
  274.    (Flag,!,
  275.      nl,write($*** $),writeq(H),write($ failed.$),nl
  276.    ;true),
  277.    !,fail.
  278.  
  279. % reprinted from Prolog Tools by permisssion of Instant Recall
  280.  
  281.  
  282. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  283.  
  284.        Using do_or_die
  285.  
  286. test :-
  287.     %         do_or_die([
  288.           init_log_file, !,
  289.           nl, write($>>$),
  290.           read_string(100, X),
  291.           string_term(X, Foo),
  292.           nl, write($Term = $), write(Foo), nl,
  293.           trace_message(Foo    ),
  294.           close_log_file
  295.     %        ],true)
  296.               .
  297.  
  298.             Box 11
  299.  
  300. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  301.               Trace Switches
  302.  
  303.    % turn these traces on by commenting out the  'fail' line.
  304.    % turn these traces off by uncommenting the 'fail' line.
  305.  
  306. boxwrite_trace  :-!
  307. %              ,fail
  308.                .
  309.  
  310. color_trace :- !
  311. %               ,fail
  312.                .
  313.  
  314. detailed_dbox_proc_trace :- !
  315.                    ,fail
  316.                    .
  317.  
  318.               Listing 12
  319.  
  320. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  321.  
  322.               A Predicate that Can  Produce Garbage
  323.  
  324. summarize_category( Category) :-
  325.               tax_trace([$b get_value, Category = $,Category]),
  326.        get_value( Category, Value ), !,
  327.               tax_trace([$b report$]),
  328.        report( Category, Value),
  329.               tax_trace([$a report$]).
  330. summarize_category( Category) :-
  331.       write_message([$*** Unable to compute $, Category ]),!.
  332.  
  333.                    Box 13
  334.  
  335. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  336.  
  337.           A Predicate that Does It Right or Fails
  338.  
  339. summarize_category( Category) :-
  340.               tax_trace([$b get_value, Category = $,Category]),
  341.        get_value( Category, Value ),
  342.        float(Value),!,
  343.               tax_trace([$b report$]),
  344.        (report( Category, Value),
  345.               tax_trace([$a report$]),!;
  346.         report_errorCategory, Value),!,fail).
  347.  
  348. summarize_category( Category) :-
  349.       write_message([$*** Unable to compute $, Category ]),
  350.       !,fail.
  351.  
  352.                    Box 14
  353.  
  354. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  355. , Category ]),
  356.       !,fail.
  357.  
  358.