make consult messages more SICStus like.
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@318 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
74e1561dfa
commit
93a41f0ef5
33
pl/boot.yap
33
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','$',_),
|
||||
( '$undefined'('$print_message'(_,_),prolog) ->
|
||||
( '$get_value'('$verbose',on) ->
|
||||
'$tab'(user_error,LC),
|
||||
'$format'(user_error, "[ consulting ~w... ]~n", [F])
|
||||
; true ),
|
||||
'$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),
|
||||
H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
|
||||
( '$undefined'('$print_message'(_,_),prolog) ->
|
||||
( '$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 consulted ~w bytes in ~d msecs ]~n", [LC,F,H,T])
|
||||
;
|
||||
'$format'(user_error, "[ ~w consulted ~w bytes in ~g seconds ]~n", [F,H,T])
|
||||
true
|
||||
)
|
||||
;
|
||||
'$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),
|
||||
|
||||
@ -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),
|
||||
'$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),
|
||||
|
||||
@ -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)) :- !,
|
||||
|
||||
@ -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).
|
||||
|
||||
Reference in New Issue
Block a user