bts@unc.UUCP (07/19/83)
; Here is a copy of the latest version of the trace program. I hope it proves ; useful for you. Feel free to distribute it to other users on USENET. There ; have been commments that some prologs will not accept predicate names ; containing dollar signs. They are only there to ensure the uniqueness of ; the names. Please change the names to suit your needs if any problems ; occur. - - Alan Foonberg :-(op(1100, xfy, [or])). :-(op(1000, xfy, [and])). trace$_built_in(abolish, 2). trace$_built_in(abort, 0). trace$_built_in(acos, 1). trace$_built_in(arg, 3). trace$_built_in(asin, 1). trace$_built_in(assert, 1). trace$_built_in(assert, 2). trace$_built_in(asserta, 1). trace$_built_in(asserta, 2). trace$_built_in(assertz, 1). trace$_built_in(assertz, 2). trace$_built_in(atan, 1). trace$_built_in(atom, 1). trace$_built_in(atomic, 1). trace$_built_in(break, 0). trace$_built_in(clause, 2). trace$_built_in(clause, 3). trace$_built_in(close, 1). trace$_built_in(compare, 3). trace$_built_in(consult, 1). trace$_built_in(cos, 1). trace$_built_in(current_atom, 1). trace$_built_in(current_functor, 2). trace$_built_in(current_predicate, 2). trace$_built_in(debug, 0). trace$_built_in(debuging, 0). trace$_built_in(display, 1). trace$_built_in(erase, 1). trace$_built_in(erased, 1). trace$_built_in($excess_vars,4). trace$_built_in(exists, 1). trace$_built_in(exp, 1). trace$_built_in(expand_term, 2). trace$_built_in(fail, 0). trace$_built_in(fileerrors, 0). trace$_built_in(floor, 1). trace$_built_in(functor, 3). trace$_built_in(get, 1). trace$_built_in(get0, 1). trace$_built_in(halt, 0). trace$_built_in(instance, 2). trace$_built_in(integer, 1). trace$_built_in(is, 2). trace$_built_in(keysort, 2). trace$_built_in(leash, 1). trace$_built_in(listing, 0). trace$_built_in(listing, 1). trace$_built_in(log, 1). trace$_built_in(log10, 1). trace$_built_in(mod, 1). trace$_built_in(name, 2). trace$_built_in(nl, 0). trace$_built_in(nodebug, 0). trace$_built_in(nofileerrors, 0). trace$_built_in(nonvar, 1). trace$_built_in(nospy,1). trace$_built_in(number, 1). trace$_built_in(op, 3). trace$_built_in(print, 1). trace$_built_in(print, 2). trace$_built_in(process_terms, 0). trace$_built_in(prompt, 2). trace$_built_in(put, 1). trace$_built_in(read, 1). trace$_built_in($reap, 2). trace$_built_in(reconsult, 1). trace$_built_in(recorda, 3). trace$_built_in(recorded, 3). trace$_built_in(recordz, 3). trace$_built_in(rename, 2). trace$_built_in(repeat, 0). trace$_built_in(retract, 1). trace$_built_in(save, 1). trace$_built_in(see, 1). trace$_built_in(seeing, 1). trace$_built_in(seen, 1). trace$_built_in(sin, 1). trace$_built_in(skip, 1). trace$_built_in(sort, 2). trace$_built_in(spy, 1). trace$_built_in(sqrt, 1). trace$_built_in(tab, 1). trace$_built_in($tag,1). trace$_built_in(tan, 1). trace$_built_in(trace, 0). trace$_built_in(tell, 1). trace$_built_in(telling, 1). trace$_built_in(told, 1). trace$_built_in(trace, 1). trace$_built_in(true, 0). trace$_built_in(var, 1). trace$_built_in(write, 1). trace$_built_in(writeq, 1). trace$_built_in('!', 0). trace$_built_in('=..', 2). trace$_built_in('+', 2). trace$_built_in('-', 1). trace$_built_in('-', 2). trace$_built_in('*', 2). trace$_built_in('^', 2). trace$_built_in('//', 2). trace$_built_in('/', 2). trace$_built_in('<', 2). trace$_built_in('\+',1). trace$_built_in('=<', 2). trace$_built_in('>', 2). trace$_built_in('>=', 2). trace$_built_in('+.', 2). trace$_built_in('==', 2). trace$_built_in('\==', 2). trace$_built_in('=', 2). trace$_built_in('=:=', 2). trace$_built_in('\==', 2). trace$_built_in('@<', 2). trace$_built_in('@=<', 2). trace$_built_in('@>', 2). trace$_built_in('@>=', 2). and(A, B) :- A, B. append([], List, List). append([Old_First | Old_Rest], Other_List, [Old_First | Rest_of_New_List]) :- append(Old_Rest, Other_List, Rest_of_New_List). convert_conjuncts_to_list(Term, List) :- Term =.. [Functor, Term_1, Term_2], member(Functor, [',', and]), convert_conjuncts_to_list(Term_1, List_1), convert_conjuncts_to_list(Term_2, List_2), append(List_1, List_2, List). convert_conjuncts_to_list(Term, [Term]). copy_full_to_true :- repeat, full_trace([Count, Depth, Port, Term]), assert(true_trace([Count, Depth, Port, Term])), Port = 'starting', !. dec_count :- count(Count), retract(count(Count)), New_Count is Count - 1, assert(count(New_Count)), !. dec_depth :- depth(Depth), retract(depth(Depth)), New_Depth is Depth - 1, assert(depth(New_Depth)), !. do_a_call(Term) :- depth(Depth), Depth_Plus_1 is Depth + 1, inc_count, count(Count_Plus_1), inc_depth, asserta(stacked_count(Count_Plus_1, Depth_Plus_1)), message_print(Count_Plus_1, Depth, 'call ', Term), !. do_a_failed(Term) :- depth(Depth), stacked_count(New_Count, Depth), retract(stacked_count(New_Count, Depth)), dec_depth, New_Depth is Depth -1, message_print(New_Count, New_Depth, 'failed ', Term), !. do_a_no_more(Term) :- depth(Depth), stacked_count(New_Count, Depth), retract(stacked_count(New_Count, Depth)), dec_depth, New_Depth is Depth -1, message_print(New_Count, New_Depth, 'no more ', Term), !. do_a_stacked_count(Count, Depth) :- stacked_count(Count, Depth), !. do_an_exit(Term) :- depth(Depth), stacked_count(New_Count, Depth), dec_depth, depth(New_Depth), message_print(New_Count, New_Depth, 'exit ', Term), !. do_an_out_of(Term) :- depth(Depth), stacked_count(New_Count, Depth), Depth_Minus_1 is Depth - 1, message_print(New_Count, Depth_Minus_1, 'out of ', Term), !. trace$_edit_list(Old_List, New_List) :- my_write(user, [new_line, 'Current list: ', Old_List]), my_write(user, [new_line(2), tabulate,'Options: delete from list', tabulate, '- d', new_line]), my_write(user, [tabulate(2), ' add to list', tabulate(2), '- a', new_line]), my_write(user, [tabulate(2), ' replace list', tabulate(2), '- r', new_line]), my_write(user, [tabulate(2), ' exit', tabulate(3), '- e', new_line(2)]), repeat, my_write(user, ['Enter option: ']), get_a_char(Option_Letter), member(Option_Letter, [d, a, r, e]), !, ( (Option_Letter = e, New_List = Old_List); (my_write(user, ['Enter list: ']), seeing(Old_Input_Stream_3), see(user), read(List_Members), see(Old_Input_Stream_3), convert_conjuncts_to_list(List_Members, Real_List), ( (Option_Letter = d, set_difference(Old_List, Real_List, New_List)); (Option_Letter = a, union(Old_List, Real_List, New_List)); (Option_Letter = r, New_List = Real_List) ) ) ), !. eliminate_out_ofs :- repeat, true_trace([Count, Depth, Port, Term]), process_out_of(Count, Depth, Port, Term), Port = 'starting', !. eliminate_no_mores :- repeat, true_trace([Count, Depth, Port, Term]), process_no_more(Count, Depth, Port, Term), Port = 'starting', !. trace$_evaluate(Expression, Value) :- Value is Expression, !. get_a_char(Char) :- get_mode(_, Char), !. get_mode(Mode_1, Mode_2) :- seeing(Old_Input_Stream), see(user), get0(Char), see(Old_Input_Stream), get_mode(Mode_1, Char, Mode_2), !. get_mode(Mode, 10, c) :- % 10 is a return. var(Mode), !. get_mode(Mode, 10, Mode) :- % 10 is a return. nonvar(Mode), !. get_mode(Mode_1, Char, Mode_3) :- trace$_spell(Mode_2, [Char]), get_mode(Mode_2, Mode_3), !. inc_count :- count(Count), retract(count(Count)), New_Count is Count + 1, assert(count(New_Count)), !. inc_depth :- depth(Depth), retract(depth(Depth)), New_Depth is Depth + 1, assert(depth(New_Depth)), !. list_of_ASCII_codes([]). list_of_ASCII_codes([Element | List]) :- 0 @=< Element, Element @=< 255, list_of_ASCII_codes(List). make_true_trace :- my_write(user, [new_line, 'Computing true trace...', new_line]), eliminate_out_ofs, !, retract_all(marked_for_deletion(X,Y)), eliminate_no_mores, !. member(Element, [Element | Rest_of_List]). member(Element, [First_Element | Rest_of_List]) :- member(Element, Rest_of_List). member_without_instantiation(Variable, [Element | Rest_of_List]) :- Variable == Element. member_without_instantiation(Element, [First_Element | Rest_of_List]) :- member_without_instantiation(Element, Rest_of_List). message_print(Count, Depth, Port, Term) :- retract_all(real_count(Real_Count)), retract_all(real_depth(Real_Depth)), assert(real_count(Count)), assert(real_depth(Depth)), asserta(full_trace([Count, Depth, Port, Term])), asserta(true_trace([Count, Depth, Port, Term])), mode_check(Count, Depth, Port, Term), !. mode_check(Count, Depth, Port, Term) :- functor(Term, Functor, _), invisible(Invisible_Terms), member(Functor, Invisible_Terms), !. mode_check(Count, Depth, Port, Term) :- mode(c), my_write_it(Count, Depth, Port, Term), mode_enquire, !. mode_check(Count, Depth, Port, Term) :- mode(d), search_depth(Search_Depth), Depth >= Search_Depth, my_write_it(Count, Depth, Port, Term), mode_enquire, !. mode_check(Count, Depth, Port, Term) :- mode(d), !. mode_check(Count, Depth, Port, Term) :- mode(j), return_count(Count), member(Port, ['exit ', 'failed ', 'no more ', 'no match']), retract(return_count(Count)), my_write_it(Count, Depth, Port, Term), mode_enquire, !. mode_check(Count, Depth, Port, Term) :- mode(j), !. mode_check(Count, Depth, Port, Term) :- mode(l), functor(Term, Functor, _), terms(Terms), member(Functor, Terms), my_write_it(Count, Depth, Port, Term), mode_enquire, !. mode_check(Count, Depth, Port, Term) :- mode(l), !. mode_check(Count, Depth, Port, Term) :- mode(n), !. mode_check(Count, Depth, Port, Term) :- mode(r), my_write_it(Count, Depth, Port, Term), files(Files), (member(user, Files) -> my_write(user, [new_line]); true), !. mode_check(Count, Depth, Port, Term) :- mode(s), return_count(Count), retract(return_count(Count)), my_write_it(Count, Depth, Port, Term), mode_enquire, !. mode_check(Count, Depth, Port, Term) :- mode(s), !. mode_check(Count, Depth, Port, Term) :- mode(u), return_depth(Depth), retract(return_depth(Depth)), my_write_it(Count, Depth, Port, Term), mode_enquire, !. mode_check(Count, Depth, Port, Term) :- mode(u), !. mode_check(Count, Depth, Port, Term) :- mode(X), my_write(user, [X]), my_write(user, [' is not a valid mode. Type ''?'' for help or try again ']), mode_enquire, !. mode_enquire :- my_write(user, [' --> ']), get_mode(Mode_Char_In, Mode_Char_Out), ( (member(Mode_Char_Out, [h, '?']), my_write(user, [new_line, 'Available modes:', new_line]), my_write(user, [tabulate, 'a abort', tabulate, 'abort the whole thing', new_line]), my_write(user, [tabulate, 'c creep', tabulate, 'trace every step', new_line]), my_write(user, [tabulate, 'd depth', tabulate, 'resume tracing at specific depth', new_line]), my_write(user, [tabulate, 'e edit', tabulate, 'edit one of the following lists', new_line]), my_write(user, [tabulate(2), 'output files', new_line, tabulate(2), 'predicates to search for', new_line, tabulate(2), 'predicates not to print', new_line]), my_write(user, [tabulate, 'h help', tabulate, 'print this help message', new_line]), my_write(user, [tabulate, 'j jump', tabulate, 'resume tracing upon exiting or failing at same count', new_line]), my_write(user, [tabulate, 'l leap', tabulate, 'resume tracing upon seeing a term in the list of terms', new_line]), my_write(user, [tabulate, 'n notrace', tabulate, 'terminate tracing', new_line]), my_write(user, [tabulate, 'r run ', tabulate, 'trace without prompting for mode', new_line]), my_write(user, [tabulate, 's skip', tabulate, 'resume tracing at same count', new_line]), my_write(user, [tabulate, 'u up ', tabulate, 'resume tracing at the next higher depth', new_line]), my_write(user, [tabulate, '? help', tabulate, 'print this help message', new_line(2)]), my_write(user, ['Enter desired trace mode']), mode_enquire ); mode_set(Mode_Char_Out) ), !. mode_set(a) :- abort. mode_set(d) :- search_depth(Depth), my_write(user, ['At what depth do you want to resume tracing? ']), seeing(Old_Input_Stream), see(user), read(New_Depth), see(Old_Input_Stream), retract(search_depth(Depth)), asserta(search_depth(New_Depth)), mode(Old_Mode), retract(mode(Old_Mode)), assert(mode(d)), !. mode_set(e) :- my_write(user, [new_line, 'Which list would you like to edit? ', new_line, tabulate, 'f = files, p = predicates, i = invisible predicates: ']), seeing(Old_Input_Stream), see(user), get0(Option), trace$_spell(List, [Option]), get0(_), see(Old_Input_Stream), ((List = f) -> (files(Old_Files), trace$_edit_list(Old_Files, New_Files), retract(files(Old_Files)), assert(files(New_Files))); ((List = p) -> (terms(Old_Predicates), trace$_edit_list(Old_Predicates, New_Predicates), retract(terms(Old_Predicates)), assert(terms(New_Predicates))); ((List = i) -> (invisible(Old_List), trace$_edit_list(Old_List, New_List), retract(invisible(Old_List)), assert(invisible(New_List))); !))), my_write(user, ['Enter mode in which to conutinue tracing: ']), mode_enquire, !. mode_set(u) :- real_depth(Depth), Depth_Minus_1 is Depth-1, asserta(return_depth(Depth_Minus_1)), mode(Old_Mode), retract(mode(Old_Mode)), assert(mode(u)), !. mode_set(Mode) :- member(Mode, [j,s]), mode(Old_Mode), retract(mode(Old_Mode)), assert(mode(Mode)), real_count(Count), asserta(return_count(Count)), !. mode_set(Mode) :- mode(Old_Mode), retract(mode(Old_Mode)), assert(mode(Mode)), !. or(A, B) :- call(A); call(B). process_out_of(Count, Depth, Port, Term) :- ((Port = 'out of ', not marked_for_deletion(_, _), assert(marked_for_deletion(Count, Depth))); (Port = 'call ', marked_for_deletion(Count, Depth), retract(marked_for_deletion(Count, Depth))); (marked_for_deletion(X,Y), retract(true_trace([Count, Depth, Port, Term]))); true), !. process_no_more(Count, Depth, Port, Term) :- ((not marked_for_deletion(_, _), member(Port, ['no more ', 'failed ', 'no match']), assert(marked_for_deletion(Count, Depth)), retract(true_trace([Count, Depth, Port, Term]))); (Port = 'call ', marked_for_deletion(Count, Depth), retract(true_trace([Count, Depth, Port, Term])), retract(marked_for_deletion(Count, Depth))); (marked_for_deletion(X,Y), retract(true_trace([Count, Depth, Port, Term]))); true), !. put_together_full_trace([]) :- not full_trace(_), !. put_together_full_trace(Full_Trace) :- full_trace(Last_Line), retract(full_trace(Last_line)), put_together_full_trace(All_But_One), append(All_But_One, [Last_Line], Full_Trace), !. put_together_true_trace([]) :- not true_trace(_), !. put_together_true_trace(True_Trace) :- true_trace(Last_Line), retract(true_trace(Last_Line)), put_together_true_trace(All_But_One), append(All_But_One, [Last_Line], True_Trace), !. retract_all(Term) :- clause(Term, true, Reference), erase(Reference), fail. retract_all(Head) :- clause(Head, Body, Reference), erase(Reference), fail. retract_all(_). set_difference(Set_1, Set_2, Set_1_Minus_Set_2) :- set_of( X, (member(X, Set_1), not member_without_instantiation(X, Set_2) ), Set_1_Minus_Set_2), !. set_of(Variable, Predicate, Resulting_Set) :- setof(Variable, Predicate, Resulting_Set). set_of(Variable, Predicate, []). trace$_spell('', []) :- !. trace$_spell(Word, List) :- (atomic(Word); list_of_ASCII_codes(List)), name(Word, List), !. trace$_spell(Word, List) :- my_write(user, ['Error in call to trace$_spell: Word = ', Word, new_line, tabulate(2), 'List = ', List, new_line]), !. trace(Term, Full_Trace, True_Trace) :- trace(Term, Full_Trace), !, make_true_trace, put_together_true_trace(True_Trace), !. trace(Term, Full_Trace) :- trace(Term), !, put_together_full_trace(Full_Trace), !. trace(Term) :- retract_all(count(Count)), retract_all(depth(Depth)), retract_all(files(Files)), retract_all(terms(Terms)), retract_all(full_trace(Full_Trace)), retract_all(invisible(Terms)), retract_all(mode(Mode)), retract_all(return_count(Return_Count)), retract_all(return_depth(Return_Depth)), retract_all(real_count(Real_Count)), retract_all(real_depth(Real_Depth)), retract_all(search_depth(Search_Depth)), retract_all(stacked_count(Count, Depth)), retract_all(true_trace(True_Trace)), assert(count(0)), assert(depth(1)), assert(invisible([])), assert(mode(c)), assert(terms([])), assert(files([user])), assert(return_count(1)), assert(return_depth(1)), assert(search_depth(1)), message_print(0, 1, 'starting', Term), !, why(Term), !. union([], [], []). union([], [B_1 | B_Rest], C) :- union([], B_Rest, Rest), ((member(B_1, Rest), C = Rest); C = [B_1 | Rest]). union([A_1 | A_Rest], B, A_Union_B) :- union(A_Rest, B, A_Rest_Union_B), ((member(A_1, A_Rest_Union_B), A_Union_B = A_Rest_Union_B); A_Union_B = [A_1 | A_Rest_Union_B]). /************************************************************* c,d are inputs c',d' are outputs Message assert stacked_count retract count depth print -------------------------------------------------------------- call (c',d') -- -- c'=c+1 d'=d+1 c',d enter -- (cl,d) -- c'=c d'=d cl,d-1 outof -- (cl,d) -- c'=c d'=d cl,d-1 failed -- (cl,d) (cl,d) c'=c d'=d-1 cl,d' exit -- (cl,d) -- c'=c d'=d-1 cl,d' nomatch -- (cl,d) (cl,d) c'=c d'=d-1 cl,d' nomore -- (cl,d) (cl,d) c'=c d'=d-1 cl,d' *************************************************************/ why(Term) :- Term = (Term_1 -> Term_2; Term_3), !, (why(Term_1) -> why(Term_2); why(Term_3)). why(Term) :- Term = (Term_1 -> Term_2), !, (why(Term_1) -> why(Term_2)). why(Term) :- ( Term = (Term_1, Term_2) ; Term = (Term_1 and Term_2) ), !, why(Term_1), why(Term_2). why(Term) :- ( Term = (Term_1; Term_2) ; Term = (Term_1 or Term_2) ), !, ( why(Term_1) ; why(Term_2) ). why(Term) :- count(Count), functor(Term, Functor, _), trace$_built_in(Functor, _), !, do_a_call(Term), ( (Term, ( do_an_exit(Term) ; (inc_depth, do_an_out_of(Term), fail))) ; (do_a_failed(Term), !, fail)). why(Term) :- count(Count), (Term = call(Body); Term = $user_call(Body)), !, do_a_call(Term), ( (why(Body), ( do_an_exit(Term) ; (inc_depth, do_an_out_of(Term), fail))) ; (do_a_failed(Term), !, fail)). why(Term) :- not clause(Term, _), !, do_a_call(Term), depth(Depth), stacked_count(New_Count, Depth), retract(stacked_count(New_Count, Depth)), dec_depth, depth(New_Depth), message_print(New_Count, New_Depth, 'no match', Term), !, fail. why(Term) :- !, % assumes clause(Term, _) succeeds do_a_call(Term), ( (clause(Term, Body), depth(Depth), trace$_evaluate(Depth - 1, Depth_Minus_1), do_a_stacked_count(Count, Depth), message_print(Count, Depth_Minus_1, 'enter ', Term), ( (why(Body), ( do_an_exit(Term) ; (inc_depth, fail))) ; (do_an_out_of(Term), fail))) ; (do_a_no_more(Term), !, fail)). my_write([], Output_List) :- !. my_write([File | File_List], Output_List) :- my_write(File, Output_List), my_write(File_List, Output_List), !. my_write(user, Output_List) :- telling(Old_File), tell(user), my_write_list(Output_List), tell(Old_File), !. my_write(File, Output_List) :- atom(File), telling(Old_File), tell(File), my_write_list(Output_List), nl, tell(Old_File), !. my_write_it(Count, Depth, Port, Term) :- files(Files), my_write(Files, [trace_line([Count, Depth, Port, Term])]). my_write_list(Output_List) :- var(Output_List), write(Output_List), !. my_write_list([Term | Terms]) :- var(Term), write(Term), !, my_write_list(Terms), !. my_write_list([]) :- !. % Stop at the end of the list of terms. my_write_list([Term | Terms]) :- my_write_term(Term), !, my_write_list(Terms), !. my_write_term(trace_line([Count, Depth, Port, Term])) :- my_write_list([Count, '. (', Depth, ') ', Port, ' ', Term]). my_write_term(trace_list([Term | Terms])) :- my_write_term(new_line), my_write_term(trace_line(Term)), my_write_term(trace_list(Terms)), !. my_write_term(trace_list([])) :- my_write_term(new_line), !. my_write_list(Term) :- write(Term), !. my_write_term(new_line) :- my_write_term(new_line(1)). my_write_term(new_line(0)) :- !. my_write_term(new_line(N)) :- put(" "), M is N-1, my_write_term(new_line(M)). my_write_term(space) :- my_write_term(space(1)), !. my_write_term(space(0)) :- !. my_write_term(space(N)) :- put(" "), M is N-1, my_write_term(space(M)). my_write_term(tabulate) :- my_write_term(tabulate(1)). my_write_term(tabulate(0)) :- !. my_write_term(tabulate(N)) :- N > 0, put(" "), M is N-1, my_write_term(tabulate(M)). my_write_term(Term) :- % If don't recognize the term, just write it. write(Term), !.