From 93a41f0ef5979663f36524dd96dd4c03b1bd5f51 Mon Sep 17 00:00:00 2001 From: vsc Date: Tue, 22 Jan 2002 17:11:36 +0000 Subject: [PATCH] make consult messages more SICStus like. git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@318 b08c6af1-5177-4d33-ba66-4b1c6b8b522a --- pl/boot.yap | 37 +++++++++++++++++++++---------------- pl/consult.yap | 44 +++++++++++++++----------------------------- pl/errors.yap | 40 +++++++++++++++++++++++++--------------- pl/yio.yap | 2 -- 4 files changed, 61 insertions(+), 62 deletions(-) diff --git a/pl/boot.yap b/pl/boot.yap index a2e79feb3..962956018 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -74,6 +74,7 @@ read_sig. (nl,writeq('[ Received user signal 2 ]'),nl,halt)), _), '$set_yap_flags'(10,0), '$set_value'('$gc',on), + '$set_value'('$verbose',on), prompt(' ?- '), ( '$get_value'('$break',0) @@ -915,27 +916,34 @@ break :- '$get_value'('$break',BL), NBL is BL+1, '$getcwd'(OldD), '$get_value'('$consulting_file',OldF), '$set_consulting_file'(Stream), - H0 is heapused, T0 is cputime, + H0 is heapused, '$cputime'(T0,_), '$current_stream'(File,_,Stream), + '$current_module'(OldModule), '$start_consult'(consult,File,LC), '$get_value'('$consulting',Old), '$set_value'('$consulting',true), '$recorda'('$initialisation','$',_), - ( '$get_value'('$verbose',on) -> - '$tab'(user_error,LC), - '$format'(user_error, "[ consulting ~w... ]~n", [F]) - ; true ), + ( '$undefined'('$print_message'(_,_),prolog) -> + ( '$get_value'('$verbose',on) -> + '$format'(user_error, "~*|[ consulting ~w... ]~n", [LC,F]) + ; true ) + ; + '$print_message'(informational, loading(consulting, F)) + ), '$loop'(Stream,consult), + '$exec_initialisation_goals', + '$current_module'(Mod,OldModule), '$end_consult', ( LC == 0 -> prompt(_,' |: ') ; true), - ( '$get_value'('$verbose',on) -> - '$tab'(user_error,LC) ; - true ), - H is heapused-H0, T is cputime-T0, - ( '$get_value'('$verbose',off) -> - true + H is heapused-H0, '$cputime'(TF,_), T is TF-T0, + ( '$undefined'('$print_message'(_,_),prolog) -> + ( '$get_value'('$verbose',on) -> + '$format'(user_error, "~*|[ ~w consulted ~w bytes in ~d msecs ]~n", [LC,F,H,T]) + ; + true + ) ; - '$format'(user_error, "[ ~w consulted ~w bytes in ~g seconds ]~n", [F,H,T]) + '$print_message'(informational, loaded(consulted, F, Mod, T, H)) ), '$set_value'('$consulting',Old), '$set_value'('$consulting_file',OldF), @@ -982,7 +990,6 @@ break :- '$get_value'('$break',BL), NBL is BL+1, '$loop'(Stream,Status) :- - '$current_module'(OldModule), '$change_alias_to_stream'('$loop_stream',Stream), repeat, ( '$current_stream'(_,_,Stream) -> true @@ -991,9 +998,7 @@ break :- '$get_value'('$break',BL), NBL is BL+1, prompt('| '), prompt(_,'| '), '$system_catch'('$enter_command'(Stream,Status), OldModule, Error, user:'$LoopError'(Error)), - !, - '$exec_initialisation_goals', - '$current_module'(_,OldModule). + !. '$enter_command'(Stream,Status) :- '$read_vars'(Stream,Command,Vars), diff --git a/pl/consult.yap b/pl/consult.yap index e75724412..8598ace2f 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -128,30 +128,23 @@ reconsult(Fs) :- '$getcwd'(OldD), '$get_value'('$consulting_file',OldF), '$set_consulting_file'(Stream), - H0 is heapused, T0 is cputime, + H0 is heapused, '$cputime'(T0,_), current_stream(File,_,Stream), '$get_value'('$consulting',Old), '$set_value'('$consulting',false), + '$current_module'(OldModule), '$start_reconsulting'(F), '$start_consult'(reconsult,File,LC), '$recorda'('$initialisation','$',_), - ( '$get_value'('$verbose',on) -> - '$tab'(user_error,LC), - '$format'(user_error, "[ reconsulting ~w... ]~n", [F]) - ; true ), + '$print_message'(informational, loading(reconsulting, F)), '$loop'(Stream,reconsult), - '$end_consult', + '$exec_initialisation_goals', + '$current_module'(Mod,OldModule), + '$end_consult', '$clear_reconsulting', ( LC == 0 -> prompt(_,' |: ') ; true), - ( '$get_value'('$verbose',on) -> - '$tab'(user_error,LC) ; - true ), - H is heapused-H0, T is cputime-T0, - ( '$get_value'('$verbose',off) -> - true - ; - '$format'(user_error, "[ ~w reconsulted ~w bytes in ~g seconds ]~n", [F,H,T]) - ), + H is heapused-H0, '$cputime'(TF,_), T is TF-T0, + '$print_message'(informational, loaded(reconsulted, F, Mod, T, H)), '$set_value'('$consulting',Old), '$set_value'('$consulting_file',OldF), '$cd'(OldD), @@ -169,29 +162,22 @@ reconsult(Fs) :- '$open'(File,'$csult',Stream0,0), '$get_value'('$consulting_file',OldF), '$set_consulting_file'(Stream0), - H0 is heapused, T0 is cputime, + H0 is heapused, '$cputime'(T0,_), '$get_value'('$consulting',Old), '$set_value'('$consulting',false), '$start_reconsulting'(File), '$start_consult'(reconsult,File,LC), + '$current_module'(OldModule), '$recorda'('$initialisation','$',_), - ( '$get_value'('$verbose',on) -> - '$tab'(user_error,LC), - '$format'(user_error, "[ reconsulting ~w... ]~n", [F]) - ; true ), + '$print_message'(informational, loading(reconsulting, F)), '$loop'(Stream,reconsult), + '$exec_initialisation_goals', + '$current_module'(Mod,OldModule), '$end_consult', '$clear_reconsulting', ( LC == 0 -> prompt(_,' |: ') ; true), - ( '$get_value'('$verbose',on) -> - '$tab'(user_error,LC) ; - true ), - H is heapused-H0, T is cputime-T0, - ( '$get_value'('$verbose',off) -> - true - ; - '$format'(user_error, "[ ~w reconsulted ~w bytes in ~g seconds ]~n", [F,H,T]) - ), + H is heapused-H0, '$cputime'(TF,_), T is TF-T0, + '$print_message'(informational, loaded(reconsulted, F, Mod, T, H)), '$set_value'('$consulting',Old), '$set_value'('$consulting_file',OldF), '$cd'(OldD), diff --git a/pl/errors.yap b/pl/errors.yap index 0aca6ff18..f966c54cc 100644 --- a/pl/errors.yap +++ b/pl/errors.yap @@ -38,29 +38,39 @@ '$process_error'(Throw) :- print_message(error,Throw). -print_message(force(_Severity), Msg) :- !, +print_message(Level, Mss) :- + '$print_message'(Level, Mss). + +'$print_message'(force(_Severity), Msg) :- !, print(user_error,Msg). -print_message(Severity, Msg) :- +'$print_message'(Severity, Msg) :- \+ '$undefined'(portray_message(Severity, Msg), user), user:portray_message(Severity, Msg), !. -print_message(error,error(Msg,Where)) :- +'$print_message'(error,error(Msg,Where)) :- '$output_error_message'(Msg, Where), !. -print_message(error,Throw) :- +'$print_message'(error,Throw) :- '$format'(user_error,"[ No handler for ball ~w ]~n", [Throw]). -print_message(informational,debug(trace)) :- - '$format'(user_error,"[ The debugger will first creep -- showing everything (trace) ]~n",[]). -print_message(informational,M) :- - '$format'(user_error,"[ ", []), - '$do_print_message'(M), - '$format'(user_error," ]", []). -print_message(warning,M) :- - '$format'(user_error,"[ Warning: ", []), - '$do_print_message'(M), - '$format'(user_error," ]~n", []). -print_message(help,M) :- +'$print_message'(informational,M) :- + ( '$get_value'('$verbose',on) -> + '$do_print_message'(M) ; + true + ). +'$print_message'(warning,M) :- + '$do_print_message'(M). +'$print_message'(help,M) :- '$format'(user_error,"help on ~p",[M]). +'$do_print_message'(loading(_,user)) :- !. +'$do_print_message'(loading(What,AbsoluteFileName)) :- !, + '$show_consult_level'(LC), + '$format'(user_error, "~*|[ ~a ~a... ]~n", [LC, What, AbsoluteFileName]). +'$do_print_message'(loaded(_,user,_,_,_)) :- !. +'$do_print_message'(loaded(What,AbsoluteFileName,Mod,Time,Space)) :- !, + '$show_consult_level'(LC0), + LC is LC0+1, + '$format'(user_error, "~*|[ ~a ~a in module ~a, ~d msec ~d bytes ]~n", [LC, What, AbsoluteFileName,Mod,Time,Space]). +%message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !, '$do_print_message'(debug(trace)) :- !, '$format'(user_error,"[ The debugger will first creep -- showing everything (trace) ]~n",[]). '$do_print_message'('$format'(Msg, Args)) :- !, diff --git a/pl/yio.yap b/pl/yio.yap index 6dcc9792b..904ce7d5b 100644 --- a/pl/yio.yap +++ b/pl/yio.yap @@ -652,12 +652,10 @@ put_code(S,V) :- -get(Stream,_) :- \+ '$check_stream'(Stream,read), !, fail. get(Stream,N) :- '$get'(Stream,N). get0(N) :- current_input(S), '$get0'(S,N). -get0(Stream,_) :- \+ '$check_stream'(Stream,read), !, fail. get0(Stream,N) :- '$get0'(Stream,N). put(N) :- current_output(S), N1 is N, '$put'(S,N1).