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

avoid state in db

Browse Source
This commit is contained in:
Vítor Santos Costa 2015-10-22 00:40:13 +01:00
parent f1be0f94d0
commit 3f2dbba042
1 changed files with 20 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
pl/consult.yap
View File

@ -236,8 +236,10 @@ load_files(Files,Opts) :-
'$lf_option'('$parent_topts', 28, _). '$lf_option'('$parent_topts', 28, _).
'$lf_option'(must_be_module, 29, false). '$lf_option'(must_be_module, 29, false).
'$lf_option'('$source_pos', 30, _). '$lf_option'('$source_pos', 30, _).
'$lf_option'(initialization, 31, Ref) :-
nb:nb_queue(Ref).
'$lf_option'(last_opt, 30). '$lf_option'(last_opt, 31).
'$lf_opt'( Op, TOpts, Val) :- '$lf_opt'( Op, TOpts, Val) :-
'$lf_option'(Op, Id, _), '$lf_option'(Op, Id, _),
@ -755,7 +757,7 @@ db_files(Fs) :-
'$nb_getval'('$if_level', OldIfLevel, fail), !, '$nb_getval'('$if_level', OldIfLevel, fail), !,
nb_setval('$if_level',0). nb_setval('$if_level',0).
'$reset_if'(0) :- '$reset_if'(0) :-
nb_setval('$if_level',0). nb_setval('$if_le1vel',0).
'$get_if'(Level0) :- '$get_if'(Level0) :-
'$nb_getval'('$if_level', Level, fail), !, '$nb_getval'('$if_level', Level, fail), !,
@ -783,9 +785,6 @@ db_files(Fs) :-
recorda('$reconsulted','$',_), recorda('$reconsulted','$',_),
recorda('$reconsulting',F,_). recorda('$reconsulting',F,_).
'$exec_initialisation_goals' :-
nb_setval('$initialization_goals',on),
fail.
'$exec_initialisation_goals' :- '$exec_initialisation_goals' :-
recorded('$blocking_code',_,R), recorded('$blocking_code',_,R),
erase(R), erase(R),
@ -795,29 +794,21 @@ db_files(Fs) :-
recorded('$system_initialisation',G,R), recorded('$system_initialisation',G,R),
erase(R), erase(R),
G \= '$', G \= '$',
once( call(G) ), '$system_catch'(ignore(M:G), M, Error, user:'$LoopError'(Error, top)),
fail. fail.
'$exec_initialisation_goals' :- '$exec_initialisation_goals' :-
'$show_consult_level'(Level), b_getval('$lf_status', TOpts),
writeln(ok),
'$lf_opt'( initialization, TOpts, Ref),
writeln(Ref),
nb:nb_queue_close(Ref, Answers, []),
writeln( Answers ),
'$current_module'(M), '$current_module'(M),
recorded('$initialisation',do(Level,_),_), lists:member(G, Answers),
findall(G, writeln(G),
'$fetch_init_goal'(Level, G), '$system_catch'(ignore(M:G), M, Error, user:'$LoopError'(Error, top)),
LGs), fail.
lists:member(G,LGs), '$exec_initialisation_goals'.
% run initialization under user control (so allow debugging this stuff).
(
'$system_catch'('$user_call'(G,M), M, Error, user:'$LoopError'(Error, top)) ->
fail
).
'$exec_initialisation_goals' :-
nb_setval('$initialization_goals',off).
'$fetch_init_goal'(Level, G) :-
recorded('$initialisation',do(Level,G),R),
erase(R),
G\='$'.
/** /**
@pred include(+ _F_) is directive @pred include(+ _F_) is directive
@ -1385,10 +1376,9 @@ environment. Use initialization/2 for more flexible behavior.
'$initialization'(C) :- db_reference(C), !, '$initialization'(C) :- db_reference(C), !,
'$do_error'(type_error(callable,C),initialization(C)). '$do_error'(type_error(callable,C),initialization(C)).
'$initialization'(G) :- '$initialization'(G) :-
'$show_consult_level'(Level1), b_getval('$lf_status', TOpts),
% it will be done after we leave the current consult level. '$lf_opt'( initialization, TOpts, Ref),
Level is Level1-1, nb:nb_queue_enqueue(Ref, G),
recordz('$initialisation',do(Level,G),_),
fail. fail.
'$initialization'(_). '$initialization'(_).