diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fix dup code in directive handling

Browse Source
This commit is contained in:
Vitor Santos Costa 2016-08-19 21:34:24 -05:00
parent 03afaaf887
commit 56b2f14a32
5 changed files with 31 additions and 107 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
pl/boot.yap
View File

@ -277,8 +277,8 @@ private(_).
fail. fail.
'$bootstrap_predicate'('$imported_predicate'(_,_,_,_), _M, _) :- !, '$bootstrap_predicate'('$imported_predicate'(_,_,_,_), _M, _) :- !,
fail. fail.
'$bootstrap_predicate'('$all_directives'(_), _M, _) :- !, '$bootstrap_predicate'('$process_directive'(Gs, _Mode, M, _VL, _Pos) , _M, _) :- !,
fail. '$execute'( M:Gs ).
'$bootstrap_predicate'('$LoopError'( Error, _), _M, _) :- !, '$bootstrap_predicate'('$LoopError'( Error, _), _M, _) :- !,
source_location(F0, L), source_location(F0, L),
format('~a:~d:0: error in bootstrap:~n ~w~n', [F0,L,Error]), format('~a:~d:0: error in bootstrap:~n ~w~n', [F0,L,Error]),
@ -343,7 +343,7 @@ true :- true.
'$init_system' :- '$init_system' :-
get_value('$yap_inited', true), !. get_value('$yap_inited', true), !.
'$init_system' :- '$init_system' :-
set_value('$yap_inited', true), % start_low_level_trace,
% do catch as early as possible % do catch as early as possible
( (
% \+ '$uncaught_throw' % \+ '$uncaught_throw'
@ -390,7 +390,8 @@ true :- true.
set_input(user_input), set_input(user_input),
set_output(user_output), set_output(user_output),
'$init_or_threads', '$init_or_threads',
'$run_at_thread_start'. '$run_at_thread_start',
set_value('$yap_inited', true).
'$make_saved_state' :- '$make_saved_state' :-
current_prolog_flag(os_argv, Args), current_prolog_flag(os_argv, Args),
@ -642,9 +643,8 @@ number of steps.
( (
O = (:- G1) O = (:- G1)
-> ->
'$current_module'(M), '$yap_strip_module'(G1, M, G2),
'$process_directive'(G2, Option, M, VL, Pos)
'$process_directive'(G1, Option, M, VL, Pos)
; ;
'$execute_commands'(G1,VL,Pos,Option,O) '$execute_commands'(G1,VL,Pos,Option,O)
). ).
@ -655,56 +655,7 @@ number of steps.
'$execute_command'(G, VL, Pos, Option, Source) :- '$execute_command'(G, VL, Pos, Option, Source) :-
'$continue_with_command'(Option, VL, Pos, G, Source). '$continue_with_command'(Option, VL, Pos, G, Source).
%
% This command is very different depending on the language mode we are in.
%
% ISO only wants directives in files
% SICStus accepts everything in files
% YAP accepts everything everywhere
%
'$process_directive'(G, top, M, VL, Pos) :-
current_prolog_flag(language_mode, yap), !, /* strict_iso on */
'$process_directive'(G, consult, M, VL, Pos).
'$process_directive'(G, top, _, _, _) :-
!,
'$do_error'(context_error((:- G),clause),query).
%
% allow modules
%
'$process_directive'(M:G, Mode, _, VL, Pos) :- !,
'$process_directive'(G, Mode, M, VL, Pos).
%
% default case
%
'$process_directive'(Gs, _Mode, M, _VL, _Pos) :-
'$undefined'('$all_directives'(Gs),prolog),
!,
'$execute'(M:Gs).
'$process_directive'(Gs, Mode, M, VL, Pos) :-
'$all_directives'(Gs), !,
'$exec_directives'(Gs, Mode, M, VL, Pos).
%
% ISO does not allow goals (use initialization).
%
'$process_directive'(D, _, M, _VL, _Pos) :-
current_prolog_flag(language_mode, iso),
!, % ISO Prolog mode, go in and do it,
'$do_error'(context_error((:- M:D),query),directive).
%
% but YAP and SICStus does.
%
'$process_directive'(G, Mode, M, VL, Pos) :-
'$save_directive'(G, Mode, M, VL, Pos),
(
'$execute'(M:G)
->
true
;
format(user_error,':- ~w:~w failed.~n',[M,G])
).
'$continue_with_command'(Where,V,'$stream_position'(C,_P,A1,A2,A3),'$source_location'(_F,L):G,Source) :- '$continue_with_command'(Where,V,'$stream_position'(C,_P,A1,A2,A3),'$source_location'(_F,L):G,Source) :-
!, !,
'$continue_with_command'(Where,V,'$stream_position'(C,L,A1,A2,A3),G,Source). '$continue_with_command'(Where,V,'$stream_position'(C,L,A1,A2,A3),G,Source).
@ -1379,8 +1330,7 @@ bootstrap(F) :-
prolog_flag(agc_margin,_,Old), prolog_flag(agc_margin,_,Old),
!. !.
'$loop'(Stream,Status) :- '$loop'(Stream,Status) :-
% start_low_level_trace, repeat,
repeat,
'$current_module'( OldModule, OldModule ), '$current_module'( OldModule, OldModule ),
'$system_catch'( '$enter_command'(Stream,OldModule,Status), '$system_catch'( '$enter_command'(Stream,OldModule,Status),
OldModule, Error, OldModule, Error,

5
pl/consult.yap
View File

@ -735,7 +735,6 @@ db_files(Fs) :-
nb_setval('$qcompile', ContextQCompiling), nb_setval('$qcompile', ContextQCompiling),
( LC == 0 -> prompt(_,' |: ') ; true), ( LC == 0 -> prompt(_,' |: ') ; true),
'$exec_initialization_goals', '$exec_initialization_goals',
% format( 'O=~w~n', [Mod=UserFile] ),
!. !.
@ -1157,9 +1156,9 @@ unload_file( F0 ) :-
erase(R), erase(R),
fail. fail.
'$unload_file'( FileName, _F0 ) :- '$unload_file'( FileName, _F0 ) :-
recorded('$mf','$mf_clause'(FileName,_Name,_Arity,_Module,ClauseRef), R), recorded('$mf','$mf_clause'(FileName,_Name,_Arity, Module,ClauseRef), R),
erase(R), erase(R),
'$erase_clause'(ClauseRef), '$erase_clause'(ClauseRef, Module),
fail. fail.
'$unload_file'( FileName, _F0 ) :- '$unload_file'( FileName, _F0 ) :-
recorded('$multifile_dynamic'(_,_,_), '$mf'(_Na,_A,_M,FileName,R), R1), recorded('$multifile_dynamic'(_,_,_), '$mf'(_Na,_A,_M,FileName,R), R1),

40
pl/directives.yap
View File

@ -116,12 +116,8 @@
'$exec_directives'(G1, Mode, M, VL, Pos), '$exec_directives'(G1, Mode, M, VL, Pos),
'$exec_directives'(G2, Mode, M, VL, Pos). '$exec_directives'(G2, Mode, M, VL, Pos).
'$exec_directives'(G, Mode, M, VL, Pos) :- '$exec_directives'(G, Mode, M, VL, Pos) :-
'$save_directive'(G, Mode, M, VL, Pos),
'$exec_directive'(G, Mode, M, VL, Pos). '$exec_directive'(G, Mode, M, VL, Pos).
'$save_directive'(G, Mode, M, VL, Pos) :-
prolog_load_context(file, FileName), !,
recordz('$directive', directive(FileName,M:G, Mode, VL, Pos),_).
'$exec_directive'(multifile(D), _, M, _, _) :- '$exec_directive'(multifile(D), _, M, _, _) :-
'$system_catch'('$multifile'(D, M), M, '$system_catch'('$multifile'(D, M), M,
@ -129,7 +125,6 @@
user:'$LoopError'(Error, top)). user:'$LoopError'(Error, top)).
'$exec_directive'(discontiguous(D), _, M, _, _) :- '$exec_directive'(discontiguous(D), _, M, _, _) :-
'$discontiguous'(D,M). '$discontiguous'(D,M).
/** @pred initialization /** @pred initialization
Execute the goals defined by initialization/1. Only the first answer is Execute the goals defined by initialization/1. Only the first answer is
@ -253,15 +248,10 @@ user_defined_directive(Dir,Action) :-
'$process_directive'(G, top, M, VL, Pos) :- '$process_directive'(G, top, M, VL, Pos) :-
current_prolog_flag(language_mode, yap), !, /* strict_iso on */ current_prolog_flag(language_mode, yap), !, /* strict_iso on */
'$process_directive'(G, consult, M, VL, Pos). '$process_directive'(G, consult, M, VL, Pos).
'$process_directive'(G, top, _, _, _) :- '$process_directive'(G, top, M, _, _) :-
!, !,
'$do_error'(context_error((:- G),clause),query). '$do_error'(context_error((:-M:G),clause),query).
% %
% allow modules
%
'$process_directive'(M:G, Mode, _, VL, Pos) :- !,
'$process_directive'(G, Mode, M, VL, Pos).
%
% default case % default case
% %
'$process_directive'(Gs, Mode, M, VL, Pos) :- '$process_directive'(Gs, Mode, M, VL, Pos) :-
@ -276,22 +266,10 @@ user_defined_directive(Dir,Action) :-
!, % ISO Prolog mode, go in and do it, !, % ISO Prolog mode, go in and do it,
'$do_error'(context_error((:- M:D),query),directive). '$do_error'(context_error((:- M:D),query),directive).
% %
% but YAP and SICStus does. % but YAP and SICStus do.
% %
'$process_directive'(G, Mode, M, VL, Pos) :- '$process_directive'(G, _Mode, M, _VL, _Pos) :-
( '$undefined'('$save_directive'(G, Mode, M, VL, Pos),prolog) -> '$execute'(M:G),
true !.
; '$process_directive'(G, _Mode, M, _VL, _Pos) :-
'$save_directive'(G, Mode, M, VL, Pos) format(user_error,':- ~w:~w failed.~n',[M,G]).
->
true
;
true
),
(
'$execute'(M:G)
->
true
;
format(user_error,':- ~w:~w failed.~n',[M,G])
).

13
pl/hacks.yap
View File

@ -92,14 +92,14 @@ pc_code(-1,_PP,Name,Arity,Mod, '~a:~q/~d' - [Mod,Name,Arity]) --> !,
{ functor(S, Name,Arity), { functor(S, Name,Arity),
nth_clause(Mod:S,1,Ref), nth_clause(Mod:S,1,Ref),
clause_property(Ref, file(File)), clause_property(Ref, file(File)),
clause_property(Ref, line_count(Line)) }, clause_property(Ref, line_count(Line)) },
[ '~a:~d:0, ' - [File,Line] ]. [ '~a:~d:0, ' - [File,Line] ].
pc_code(Cl,Name,Arity,Mod, 'clause ~d for ~a:~q/~d'-[Cl,Mod,Name,Arity]) --> pc_code(Cl,Name,Arity,Mod, 'clause ~d for ~a:~q/~d'-[Cl,Mod,Name,Arity]) -->
{ Cl > 0 }, { Cl > 0 },
{ functor(S, Name,Arity), { functor(S, Name,Arity),
nth_clause(Mod:S,Cl,Ref), nth_clause(Mod:S,Cl,Ref),
clause_property(Ref, file(File)), clause_property(Ref, file(File)),
clause_property(Ref, line_count(Line)) }, clause_property(Ref, line_count(Line)) },
[ '~a:~d:0, ' - [File,Line] ]. [ '~a:~d:0, ' - [File,Line] ].
display_stack_info(_,_,0,_) --> !. display_stack_info(_,_,0,_) --> !.
@ -138,7 +138,7 @@ show_cp(CP, Continuation) -->
{ scratch_goal(Name,Arity,Mod,Caller) }, { scratch_goal(Name,Arity,Mod,Caller) },
[ '0x~16r~t*~16+ ~d~16+ ~q ~n'- [ '0x~16r~t*~16+ ~d~16+ ~q ~n'-
[Addr, ClNo, Caller] ] [Addr, ClNo, Caller] ]
; ;
[ '0x~16r~t *~16+~a ~d~16+ ~q:' - [ '0x~16r~t *~16+~a ~d~16+ ~q:' -
[Addr, Continuation, ClNo, Mod]] [Addr, Continuation, ClNo, Mod]]
@ -217,8 +217,8 @@ beautify_hidden_goal('$catch'(G,Exc,Handler),prolog) -->
[catch(G, Exc, Handler)]. [catch(G, Exc, Handler)].
beautify_hidden_goal('$execute_command'(Query,V,P,Option,Source),prolog) --> beautify_hidden_goal('$execute_command'(Query,V,P,Option,Source),prolog) -->
[toplevel_query(Query, V, P, Option, Source)]. [toplevel_query(Query, V, P, Option, Source)].
beautify_hidden_goal('$process_directive'(Gs,_,Mod),prolog) --> beautify_hidden_goal('$process_directive'(Gs,_Mode,_VL),prolog) -->
[(:- Mod:Gs)]. [(:- Gs)].
beautify_hidden_goal('$loop'(Stream,Option),prolog) --> beautify_hidden_goal('$loop'(Stream,Option),prolog) -->
[execute_load_file(Stream, consult=Option)]. [execute_load_file(Stream, consult=Option)].
beautify_hidden_goal('$load_files'(Files,Opts,?),prolog) --> beautify_hidden_goal('$load_files'(Files,Opts,?),prolog) -->
@ -253,6 +253,3 @@ beautify_hidden_goal('$current_predicate'(Na,M,S,_),prolog) -->
[current_predicate(Na,M:S)]. [current_predicate(Na,M:S)].
beautify_hidden_goal('$list_clauses'(Stream,M,Pred),prolog) --> beautify_hidden_goal('$list_clauses'(Stream,M,Pred),prolog) -->
[listing(Stream,M:Pred)]. [listing(Stream,M:Pred)].

12
pl/qly.yap
View File

@ -769,27 +769,27 @@ qload_file( F0 ) :-
fail. fail.
'$qload_file'(_S, _SourceModule, _File, FilePl, F0, _ImportList, _TOpts) :- '$qload_file'(_S, _SourceModule, _File, FilePl, F0, _ImportList, _TOpts) :-
b_setval('$user_source_file', F0 ), b_setval('$user_source_file', F0 ),
'$process_directives'( FilePl ), '$ql_process_directives'( FilePl ),
fail. fail.
'$qload_file'(_S, SourceModule, _File, FilePl, _F0, ImportList, TOpts) :- '$qload_file'(_S, SourceModule, _File, FilePl, _F0, ImportList, TOpts) :-
'$import_to_current_module'(FilePl, SourceModule, ImportList, _, TOpts). '$import_to_current_module'(FilePl, SourceModule, ImportList, _, TOpts).
'$process_directives'( FilePl ) :- '$ql_process_directives'( FilePl ) :-
user:'$file_property'( '$lf_loaded'( FilePl, M, Reconsult, UserFile, OldF, Line, Opts) ), user:'$file_property'( '$lf_loaded'( FilePl, M, Reconsult, UserFile, OldF, Line, Opts) ),
recorda('$lf_loaded','$lf_loaded'( FilePl, M, Reconsult, UserFile, OldF, Line, Opts), _), recorda('$lf_loaded','$lf_loaded'( FilePl, M, Reconsult, UserFile, OldF, Line, Opts), _),
fail. fail.
'$process_directives'( _FilePl ) :- '$ql_process_directives'( _FilePl ) :-
user:'$file_property'( multifile( List ) ), user:'$file_property'( multifile( List ) ),
lists:member( Clause, List ), lists:member( Clause, List ),
assert( Clause ), assert( Clause ),
fail. fail.
'$process_directives'( FilePl ) :- '$ql_process_directives'( FilePl ) :-
user:'$file_property'( directive( MG, _Mode, VL, Pos ) ), user:'$file_property'( directive( MG, _Mode, VL, Pos ) ),
'$set_source'( FilePl, Pos ), '$set_source'( FilePl, Pos ),
strip_module(MG, M, G), '$yap_strip_module'(MG, M, G),
'$process_directive'(G, reconsult, M, VL, Pos), '$process_directive'(G, reconsult, M, VL, Pos),
fail. fail.
'$process_directives'( _FilePl ) :- '$ql_process_directives'( _FilePl ) :-
abolish(user:'$file_property'/1). abolish(user:'$file_property'/1).
%% @} %% @}