last patch had broken include.

fix multiple initializations.
get rid of debugging messages.
This commit is contained in:
Vítor Santos Costa 2015-04-22 14:21:20 -06:00
parent 18fee4eee1
commit d5ce9a1376
2 changed files with 31 additions and 36 deletions

View File

@ -839,7 +839,7 @@ db_files(Fs) :-
'$msg_level'( TOpts, Verbosity), '$msg_level'( TOpts, Verbosity),
'$full_filename'(X, Y , ( :- include(X)) ), '$full_filename'(X, Y , ( :- include(X)) ),
'$lf_opt'(stream, TOpts, OldStream), '$lf_opt'(stream, TOpts, OldStream),
source_location(Y, L), source_location(OldY, L),
'$current_module'(Mod), '$current_module'(Mod),
( open(Y, read, Stream) -> ( open(Y, read, Stream) ->
true ; true ;
@ -847,8 +847,8 @@ db_files(Fs) :-
), ),
'$set_current_loop_stream'(OldStream, Stream), '$set_current_loop_stream'(OldStream, Stream),
H0 is heapused, '$cputime'(T0,_), H0 is heapused, '$cputime'(T0,_),
'$full_filename'(X, Y,include(X) ), working_directory(Dir, Dir),
'$loaded'(Y, X, Mod, L, include, _, Y, _Dir, []), '$loaded'(Y, X, Mod, OldY, L, include, _, Dir, []),
( '$nb_getval'('$included_file', OY, fail ) -> true ; OY = [] ), ( '$nb_getval'('$included_file', OY, fail ) -> true ; OY = [] ),
'$lf_opt'(encoding, TOpts, Encoding), '$lf_opt'(encoding, TOpts, Encoding),
'$set_encoding'(Stream, Encoding), '$set_encoding'(Stream, Encoding),
@ -1011,11 +1011,6 @@ prolog_load_context(term_position, Position) :-
!, !,
'$import_to_current_module'(F, M, Imports, _, TOpts). '$import_to_current_module'(F, M, Imports, _, TOpts).
'$ensure_file_loaded'(F, _M, F1) :-
recorded('$source_file','$source_file'(F1, _, _),_),
recorded('$module','$module'(F1,_NM,_Source,_P,_),_),
same_file(F1, F), !.
'$ensure_file_loaded'(F, M) :- '$ensure_file_loaded'(F, M) :-
% loaded from the same module, but does not define a module. % loaded from the same module, but does not define a module.
recorded('$source_file','$source_file'(F, _Age, NM), _R), recorded('$source_file','$source_file'(F, _Age, NM), _R),
@ -1032,7 +1027,7 @@ prolog_load_context(term_position, Position) :-
% module can be reexported. % module can be reexported.
'$ensure_file_unchanged'(F, M) :- '$ensure_file_unchanged'(F, M) :-
% loaded from the same module, but does not define a module. % loaded from the same module, but does not define a module.
recorded('$source_file','$source_file'(F, Age, NM), R), writeln(M:NM), recorded('$source_file','$source_file'(F, Age, NM), R),
% make sure: it either defines a new module or it was loaded in the same context % make sure: it either defines a new module or it was loaded in the same context
'$file_is_unchanged'(F, R, Age), '$file_is_unchanged'(F, R, Age),
( M == NM -> true ; recorded('$module','$module'(F,NM,_Source,_P,_),_) ), !. ( M == NM -> true ; recorded('$module','$module'(F,NM,_Source,_P,_),_) ), !.
@ -1074,6 +1069,7 @@ prolog_load_context(term_position, Position) :-
), ),
( F == user_input -> Age = 0 ; time_file64(F, Age) ), ( F == user_input -> Age = 0 ; time_file64(F, Age) ),
% modules are logically loaded only once % modules are logically loaded only once
( recorded('$module','$module'(F,_DonorM,_SourceF, _AllExports, _Line),_) -> true ; ( recorded('$module','$module'(F,_DonorM,_SourceF, _AllExports, _Line),_) -> true ;
recordaifnot('$source_file','$source_file'( F, Age, M), _) -> true ; recordaifnot('$source_file','$source_file'( F, Age, M), _) -> true ;
true ), true ),
@ -1442,7 +1438,8 @@ Similar to initialization/1, but allows for specifying when
*/ */
initialization(G,OPT) :- initialization(G,OPT) :-
'$initialization'(G,OPT). ( '$initialization'(G,OPT) -> fail ).
initialization(_G,_OPT).
'$initialization'(G,OPT) :- '$initialization'(G,OPT) :-
( (
@ -1458,13 +1455,6 @@ initialization(G,OPT) :-
-> ->
'$do_error'(type_error(callable,G),initialization(G,OPT)) '$do_error'(type_error(callable,G),initialization(G,OPT))
; ;
var(OPT)
->
'$do_error'(instantiation_error,initialization(G,OPT))
;
atom(OPT)
->
(
OPT == now OPT == now
-> ->
fail fail
@ -1477,10 +1467,15 @@ initialization(G,OPT) :-
-> ->
fail fail
; ;
'$do_error'(domain_error(initialization,OPT),initialization(OPT)) var(OPT)
) ->
'$do_error'(instantiation_error,initialization(G,OPT))
; ;
'$do_error'(type_error(OPT),initialization(G,OPT)) atom(OPT)
->
'$do_error'(domain_error(initialization,OPT),initialization(OPT))
;
'$do_error'(type_error(atom,OPT),initialization(OPT))
). ).
'$initialization'(G,now) :- '$initialization'(G,now) :-
( call(G) -> true ; ( call(G) -> true ;