Category : Files from Magazines
Archive   : AI-NOV88.ZIP
Filename : TBOXCDE

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

A Prolog Bug

% THE BUG:

t_write_list_cond_nl(Handle, Col) :-
Col > 40, !,
t_nl(Handle).
t_write_list_cond_nl :- t_write(Handle, $ $).

% THE CALLING PREDICATE:

test :-
init_log_file, !,
nl, write($>>$),
read_string(100, X),
string_term(X, Foo),
nl, write($Term = $), write(Foo), nl,
trace_message(Foo ),
close_log_file.


Listing 2


~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

A Tracing Predicate

% print a trace message
trace_message(X):-
get_trace_handle(Handle),
leadoff(Handle), trace_msg_hlpr(Handle,X).

% print actual trace message after message header
% message is a list of printable items
% recurse on this list
trace_msg_hlpr(Handle,[]) :- !,t_nl(Handle).
trace_msg_hlpr(Handle,[H|T]) :- !,
write_message(Handle,H),!,
trace_msg_hlpr(Handle,T).
trace_msg_hlpr(Handle,X) :- trace_msg_hlpr(Handle,[X]),!.

% print a trace message header
leadoff(Handle) :- t_nl(Handle),
t_write(Handle,$% **TRACE***: $).

% print an individual trace message
% special rule for lists
write_message(Handle,X) :- is_nonempty_list(X),!,
t_write_list(Handle,X).
% rule for everything else
write_message(Handle,X) :- write_message_hlpr(Handle,X).


% print an individual non_list trace message
% special debugging rule
write_message_hlpr(Handle,X) :-
% *********** INSERTED TRACE MESSAGE ***********
nl, write($ write_message_hlpr : $), write( X),fail.
% rule for strings
write_message_hlpr(Handle,X) :- string(X),!, t_write(Handle,X).
% rule for non-strings
write_message_hlpr(Handle,X) :- t_writeq(Handle,X).

% do a new line both on screen and in trace log
% if there is one
t_nl(Handle) :-
nl(1),
(Handle >=0,! /* , nl(Handle) */ ;
true).

% write in human format the argument both on screen and
% in trace log if there is one
t_write(Handle,X) :-
write(1,X),
(Handle >=0,! /*, write(Handle,X) */ ;
true).

% write in Prolog format the argument both on screen and
% in trace log if there is one
t_writeq(Handle,X) :-
writeq(1,X),
(Handle >=0,! /* , writeq(Handle,X) */ ;
true).

% write a list argument both on
% screen and in trace log if there is one
t_write_list(Handle,[H|T]):-
% *********** INSERTED TRACE MESSAGE ***********
nl, write($ t_write_list : $), write( [H|T]) ,
t_write(Handle,$[$) , !,
% write list head
write_message_hlpr(Handle,H), !,
% write list tail
t_write_list_hlpr(Handle,T).

% write a list tail both on
% screen and in trace log if there is one
% write right bracket when list is finished
t_write_list_hlpr(Handle,[]) :-
t_write(Handle,$]$) , !.

% recursive rule
t_write_list_hlpr(Handle,[H|T]) :-
% *********** INSERTED TRACE MESSAGE ***********
nl, write($ t_write_list_hlpr : $), write( [H|T]) ,
% write separating comma
t_write(Handle,$,$) , !,
% decide whether to start a new line
tget(_,Col), !,
% *********** INSERTED TRACE MESSAGE ***********
nl, write($ a tget, Col = $), write( Col ) ,
t_write_list_cond_nl(Handle, Col),!,
% write list head
write_message_hlpr(Handle,H), !,
% recurse for tail
t_write_list_hlpr(Handle,T) .

% decide whether to start a new line
t_write_list_cond_nl(Handle, Col) :-
% start a new line if you're past col. 40
Col > 40, !,
t_nl(Handle).
% NOTE: This clause has a bug -- left in for
% illustration. Add the rule head arguments
% from prev. clause before you run the program

% otherwise just put in a space
t_write_list_cond_nl :- t_write(Handle, $ $).

is_nonempty_list([_|_]).


% reprinted by permission of Instant Recall

Listing 3

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

A Traced Main Predicate

% main predicate
main :- init_log_file, !,
main_trace($b init$),
init, !, % initial screen, etc.
main_trace($a init, b main_menu_loop$),
% you are now in a blank main window
% main menu for user -- a loop
menu_loop(main_menu, $ MAIN MENU$), !,
main_trace($ a main_menu_loop b closeout$),
closeout, !, % end run
main_trace($ a closeout$),
close_log_file.
main :- error_msg($Error in main predicate.$).


Listing 5


~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Getting Test Information


dbox_exit(Box) :-
dbox_proc_trace([$e dbox_exit, Box = $, Box]), !,
write_message_for_user,
current_screen(Screen), !,
dbox_proc_trace([$current_screen = $,Screen ]), !,
save_info( Box, Screen), !,
dbox_proc_trace([$b process_goto_question$]), !,
process_goto_question( Screen) ,
rem_global_value(current_screen), !,
dbox_proc_trace([$a rem current_screen, x dbox_exit$]),
!.


Listing 7

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Trace Log Utilities

% name of trace log file
log_filename($log.log$).

init_log_file :-
log_filename( Log ),
% create trace log file
create(Handle, Log),
close(Handle),
% open it for appending
open( Handle2, Log, ra),
% save its file handle
setglobal(log_file_handle, Handle2),
% Message to user if user turns message flag on
(trace_trace, !,
trace_message([
$To save trace log do close_log_file if you get 'no'.$]),
% get acknowledgement keystroke
press_any;
true).

close_log_file :-
% get trace file handle
getglobal(log_file_handle, Handle),
close( Handle),
% clean up database
rem_global_value( log_file_handle).

% get the handle for the trace log
get_trace_handle(Handle) :-
getglobal(log_file_handle, Handle),!.
% default is -1, a recognizably illegal handle
get_trace_handle( -1 ) :- !.

% reprinted from Prolog Tools by permission of Instant Recall

Listing 8


~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

A Test Predicate

test :- test_hlpr,!.
test :- trace_message($Failure in tested predicate$),
close_log_file.

test_hlpr :-
init_log_file, !,
call(what_to_test), !,
close_log_file.

what_to_test :-
report.


Listing 9

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

An Algorithmizing Control Predicate

do_or_die(L):-do_or_die(L,fail).
do_or_die(List,Flag):-
call(Flag),!,
nl,write($*** entering do_or_die $),writeq(List),nl,
do_or_die0(List,true).
do_or_die(List,_):-
do_or_die0(List,false).

do_or_die0([],true):-!,
nl,write($*** exit do_or_die$),nl.
do_or_die0([],_):-!.

do_or_die0([H|T],Flag):-
(Flag,!,
nl,write($*** before $),writeq(H),nl
;true),!,
do_or_die1(H,T,Flag).
do_or_die0(X,Flag):-
do_or_die0([X],Flag).

do_or_die1(H,T,Flag):-
call(H),!,
(Flag,!,
nl,write($*** after $),writeq(H),nl
;true),!,
do_or_die0(T,Flag).
do_or_die1(H,_,Flag):-
(Flag,!,
nl,write($*** $),writeq(H),write($ failed.$),nl
;true),
!,fail.

% reprinted from Prolog Tools by permisssion of Instant Recall


~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Using do_or_die

test :-
% do_or_die([
init_log_file, !,
nl, write($>>$),
read_string(100, X),
string_term(X, Foo),
nl, write($Term = $), write(Foo), nl,
trace_message(Foo ),
close_log_file
% ],true)
.

Box 11

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Trace Switches

% turn these traces on by commenting out the 'fail' line.
% turn these traces off by uncommenting the 'fail' line.

boxwrite_trace :-!
% ,fail
.

color_trace :- !
% ,fail
.

detailed_dbox_proc_trace :- !
,fail
.

Listing 12

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

A Predicate that Can Produce Garbage

summarize_category( Category) :-
tax_trace([$b get_value, Category = $,Category]),
get_value( Category, Value ), !,
tax_trace([$b report$]),
report( Category, Value),
tax_trace([$a report$]).
summarize_category( Category) :-
write_message([$*** Unable to compute $, Category ]),!.

Box 13

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

A Predicate that Does It Right or Fails

summarize_category( Category) :-
tax_trace([$b get_value, Category = $,Category]),
get_value( Category, Value ),
float(Value),!,
tax_trace([$b report$]),
(report( Category, Value),
tax_trace([$a report$]),!;
report_errorCategory, Value),!,fail).

summarize_category( Category) :-
write_message([$*** Unable to compute $, Category ]),
!,fail.

Box 14

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
, Category ]),
!,fail.