diff --git a/C/init.c b/C/init.c index b59b31bf2..493b58d9c 100755 --- a/C/init.c +++ b/C/init.c @@ -919,7 +919,6 @@ InitFlags(void) yap_flags[WRITE_QUOTED_STRING_FLAG] = FALSE; /* we do not garantee safe assert in parallel mode */ yap_flags[ALLOW_ASSERTING_STATIC_FLAG] = TRUE; - yap_flags[GENERATE_DEBUG_INFO_FLAG] = TRUE; /* current default */ yap_flags[INDEXING_MODE_FLAG] = INDEX_MODE_MULTI; yap_flags[TABLING_MODE_FLAG] = 0; diff --git a/C/iopreds.c b/C/iopreds.c index 0bd63a23a..d807c0600 100755 --- a/C/iopreds.c +++ b/C/iopreds.c @@ -334,11 +334,7 @@ syntax_error (TokEntry * tokptr, IOSTREAM *st, Term *outp) { char s[2]; s[1] = '\0'; - if (Ord (info) == 'l') { - s[0] = '('; - } else { - s[0] = (char)info; - } + s[0] = (char)info; ts[0] = MkAtomTerm(Yap_LookupAtom(s)); } } @@ -561,7 +557,6 @@ static Int Term tcomms = Deref(ARG7); int store_comments = IsVarTerm(tcomms); - Yap_setCurrentSourceLocation(&inp_stream); if (IsVarTerm(tmod)) { tmod = CurrentModule; } else if (!IsAtomTerm(tmod)) { diff --git a/C/signals.c b/C/signals.c index c3f5ed92c..59dc7eba4 100644 --- a/C/signals.c +++ b/C/signals.c @@ -116,24 +116,6 @@ p_creep_allowed( USES_REGS1 ) return FALSE; } -static Int -p_debug_on( USES_REGS1 ) -{ - Term t = Deref(ARG1); - if (IsVarTerm(t)) { - if (LOCAL_DebugOn) - return Yap_unify(MkAtomTerm(AtomTrue),ARG1); - else - return Yap_unify(MkAtomTerm(AtomFalse),ARG1); - } - if (t == MkAtomTerm(AtomTrue)) - LOCAL_DebugOn = TRUE; - else - LOCAL_DebugOn = FALSE; - return TRUE; -} - - void Yap_signal(yap_signals sig) { @@ -370,7 +352,6 @@ Yap_InitSignalCPreds(void) Yap_InitCPred("$stop_creeping", 0, p_stop_creeping, SafePredFlag); Yap_InitCPred ("$first_signal", 1, p_first_signal, SafePredFlag|SyncPredFlag); Yap_InitCPred ("$continue_signals", 0, p_continue_signals, SafePredFlag|SyncPredFlag); - Yap_InitCPred("$debug_on", 1, p_debug_on, 0); Yap_InitCPred("$creep_allowed", 0, p_creep_allowed, 0); #ifdef DEBUG Yap_InitCPred("$debug", 1, p_debug, SafePredFlag|SyncPredFlag); diff --git a/C/stdpreds.c b/C/stdpreds.c index d57b9ade7..487ff4a56 100644 --- a/C/stdpreds.c +++ b/C/stdpreds.c @@ -1706,11 +1706,6 @@ p_set_yap_flags( USES_REGS1 ) return(FALSE); yap_flags[STACK_DUMP_ON_ERROR_FLAG] = value; break; - case GENERATE_DEBUG_INFO_FLAG: - if (value != 0 && value != 1) - return(FALSE); - yap_flags[GENERATE_DEBUG_INFO_FLAG] = value; - break; case INDEXING_MODE_FLAG: if (value < INDEX_MODE_OFF || value > INDEX_MODE_MAX) return(FALSE); diff --git a/pl/boot.yap b/pl/boot.yap index 0af841705..5fe46cce4 100755 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -18,13 +18,6 @@ % % % -c(G, C, A) :- - '$$save_by'(CP0), - '$execute'(G), - '$$save_by'(CP1), - (CP0 == CP1 -> !; true ). - - true :- true. '$live' :- @@ -61,9 +54,9 @@ true :- true. ), ( '$access_yap_flags'(22, 0) -> - set_value('$verbose',on) + '$swi_set_prolog_flag'(verbose, normal) ; - set_value('$verbose',off) + '$swi_set_prolog_flag'(verbose, silent) ), % '$init_preds', % needs to be done before library_directory % ( @@ -80,7 +73,7 @@ true :- true. set_value('$gc',on), ('$exit_undefp' -> true ; true), prompt1(' ?- '), - '$debug_on'(false), + '$swi_set_prolog_flag'(debug, false), % simple trick to find out if this is we are booting from Prolog. % boot from a saved state ( @@ -107,13 +100,10 @@ true :- true. '$init_consult' :- set_value('$open_expands_filename',true), - set_value('$lf_verbose',informational), nb_setval('$assert_all',off), nb_setval('$if_level',0), nb_setval('$endif',off), - nb_setval('$consulting_file',[]), - nb_setval('$initialization_goals',off), - nb_setval('$consulting',false), + nb_setval('$initialization_goals',off), nb_setval('$included_file',[]), \+ '$undefined'('$init_preds',prolog), '$init_preds', @@ -200,7 +190,7 @@ true :- true. fail. '$enter_top_level' :- '$nb_getval'('$break',BreakLevel,fail), - '$debug_on'(DBON), + '$swi_current_prolog_flag'(debug, DBON), ( '$nb_getval'('$trace', on, fail) -> @@ -995,11 +985,11 @@ not(G) :- \+ '$execute'(G). '$silent_bootstrap'(F) :- '$init_globals', nb_setval('$if_level',0), - get_value('$lf_verbose',OldSilent), - set_value('$lf_verbose',silent), + '$swi_current_prolog_flag'(verbose_load, OldSilent), + '$swi_set_prolog_flag'(verbose_load, silent), bootstrap(F), % -p option must be processed after initializing the system - set_value('$lf_verbose', OldSilent). + '$swi_set_prolog_flag'(verbose_load, OldSilent). bootstrap(F) :- % '$open'(F, '$csult', Stream, 0, 0, F), @@ -1010,7 +1000,7 @@ bootstrap(F) :- file_directory_name(File, Dir), working_directory(OldD, Dir), ( - get_value('$lf_verbose',silent) + '$swi_current_prolog_flag'(verbose_load, silent) -> true ; @@ -1021,7 +1011,7 @@ bootstrap(F) :- working_directory(_, OldD), '$end_consult', ( - get_value('$lf_verbose',silent) + '$swi_current_prolog_flag'(verbose_load, silent) -> true ; diff --git a/pl/checker.yap b/pl/checker.yap index cccb97f85..0ac0eeab1 100644 --- a/pl/checker.yap +++ b/pl/checker.yap @@ -166,7 +166,7 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T). ; get_value('$syntaxcheckmultiple',on) ), - nb_getval('$consulting_file',File), + source_location( File, _ ), '$xtract_head'(T,M,NM,_,F,A), \+ ( % allow duplicates if we are not the last predicate to have @@ -233,7 +233,7 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T). '$handle_discontiguous'((:-),1,_) :- !, fail. '$handle_discontiguous'(F,A,M) :- - nb_getval('$consulting_file', FileName), + source_location( FileName, _ ), % we have been there before once(recorded('$predicate_defs','$predicate_defs'(F, A, M, FileName),_)), % and we are not @@ -247,11 +247,11 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T). % never complain the second time '$handle_multiple'(F,A,M) :- - nb_getval('$consulting_file', FileName), + source_location(FileName, _), recorded('$predicate_defs','$predicate_defs'(F,A,M,FileName),_), !. % first time we have a definition '$handle_multiple'(F,A,M) :- - nb_getval('$consulting_file', FileName0), + source_location(FileName0, _), recorded('$predicate_defs','$predicate_defs'(F,A,M,FileName),_), FileName \= FileName0, '$multiple_has_been_defined'(FileName, F/A, M), !. @@ -259,7 +259,7 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T). % be careful about these cases. % consult does not count '$multiple_has_been_defined'(_, _, _) :- - nb_getval('$consulting',true), !. + '$nb_getval'('$consulting_file', _, fail), !. % multifile does not count '$multiple_has_been_defined'(_, F/A, M) :- functor(S, F, A), @@ -334,7 +334,7 @@ discontiguous(F) :- % '$check_multifile_pred'(Hd, M, _) :- functor(Hd,Na,Ar), - nb_getval('$consulting_file',F), + source_location(F, _), recorded('$multifile_defs','$defined'(F,Na,Ar,M),_), !. % oops, we did not. '$check_multifile_pred'(Hd, M, Fl) :- diff --git a/pl/consult.yap b/pl/consult.yap index fd7101f45..402bd5910 100755 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -20,7 +20,7 @@ % autoload(true,false) % derived_from(File) -> make % encoding(Encoding) => implemented -% expand({true,false) + % expand(true,false) % if(changed,true,not_loaded) => implemented % imports(all,List) => implemented % qcompile(true,false) @@ -28,157 +28,205 @@ % stream(Stream) => implemented % consult(consult,reconsult,exo,db) => implemented % compilation_mode(compact,source,assert_all) => implemented +% register(true, false) => implemented % load_files(Files,Opts) :- '$load_files'(Files,Opts,load_files(Files,Opts)). -'$load_files'(Files,Opts,Call) :- +'$lf_opt'(autoload, 1). +'$lf_opt'(derived_from). +'$lf_opt'(encoding, 3). +'$lf_opt'(expand, 4). +'$lf_opt'(if, 5). +'$lf_opt'(imports, 6). +'$lf_opt'(qcompile, 7). +'$lf_opt'(silent, 8). +'$lf_opt'(skip_unix_header, 9). +'$lf_opt'(compilation_mode, 10). +'$lf_opt'(consult, 11). +'$lf_opt'(stream, 12). +'$lf_opt'(register, 13). +'$lf_opt'('$files', 14). +'$lf_opt'('$call', 15). +'$lf_opt'('$use_module', 16). +'$lf_opt'('$consulted_at', 17). +'$lf_opt'('$options', 18). +'$lf_opt'('$location', 19). +'$lf_opt'(last_opt, 19). + +'$lf_opt'( Op, TOpts, Val) :- + '$lf_opt'(Op, Id), + arg( Id, TOpts, Val ). + +'$load_files'(Files, Opts, Call) :- + ( '$nb_getval'('$lf_status', OldTOpts, fail), nonvar(OldTOpts) -> '$lf_opt'(silent, OldTOpts, OldVerbosity) ; true ), '$check_files'(Files,load_files(Files,Opts)), - '$process_lf_opts'(Opts,Silent,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,SkipUnixComments,CompMode,Reconsult,Files,Call), + '$lf_opt'(last_opt, LastOpt), + functor( TOpts, opt, LastOpt ), + ( source_location(ParentF, Line) -> true ; ParentF = user_input, Line = -1 ), + '$lf_opt'('$location', TOpts, ParentF:Line), + '$lf_opt'('$files', TOpts, Files), + '$lf_opt'('$call', TOpts, Call), + '$lf_opt'('$options', TOpts, Opts), + '$process_lf_opts'(Opts,TOpts,Files,Call), '$check_use_module'(Call,UseModule), + '$lf_opt'('$use_module', TOpts, UseModule), '$current_module'(M0), + '$lf_opt'(silent, TOpts, Verbosity), + ( var(Verbosity) -> Verbosity = OldVerbosity ; true ), % make sure we can run consult '$init_system', - '$lf'(Files,M0,Call,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,SkipUnixComments,CompMode,Reconsult,UseModule), - '$close_lf'(Silent). + '$lf'(Files, M0, Call, TOpts). -'$check_files'(Files,Call) :- +'$check_files'(Files, Call) :- var(Files), !, - '$do_error'(instantiation_error,Call). -'$check_files'(M:Files,Call) :- !, + '$do_error'(instantiation_error, Call). +'$check_files'(M:Files, Call) :- !, (var(M) -> - '$do_error'(instantiation_error,Call) + '$do_error'(instantiation_error, Call) ; atom(M) -> '$check_files'(Files,Call) ; - '$do_error'(type_error(atom,M),Call) + '$do_error'(type_error(atom,M), Call) ). -'$check_files'(Files,Call) :- - (ground(Files) +'$check_files'(Files, Call) :- + ( ground(Files) -> true ; - '$do_error'(instantiation_error,Call) + '$do_error'(instantiation_error, Call) ). - -'$process_lf_opts'(V,_,_,_,_,_,_,_,_,_,_,_,_,Call) :- +'$process_lf_opts'(V, _, _, Call) :- var(V), !, '$do_error'(instantiation_error,Call). -'$process_lf_opts'([],_,InfLevel,_,_,_,_,_,_,_,_,_,_,_). -'$process_lf_opts'([Opt|Opts],Silent,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,SkipUnixComments,CompMode,Reconsult,Files,Call) :- - '$process_lf_opt'(Opt,Silent,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,SkipUnixComments,CompMode,Reconsult,Files,Call), !, - '$process_lf_opts'(Opts,Silent,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,SkipUnixComments,CompMode,Reconsult,Files,Call). -'$process_lf_opts'([Opt|_],_,_,_,_,_,_,_,_,_,_,_,_,Call) :- +'$process_lf_opts'([], _, _, _). +'$process_lf_opts'([Opt|Opts],TOpt,Files,Call) :- + Opt =.. [Op, Val], + ground(Val), + '$lf_opt'(Op, TOpt, Val), + '$process_lf_opt'(Op, Val,Call), !, + '$process_lf_opts'(Opts, TOpt, Files, Call). +'$process_lf_opts'([Opt|_],_,_,Call) :- '$do_error'(domain_error(unimplemented_option,Opt),Call). -'$process_lf_opt'(autoload(true),Silent,InfLevel,_,_,_,_,_,_,_,_,_,_,_) :- - get_value('$verbose_auto_load',VAL), - (VAL = true -> - InfLevel = informational, - (get_value('$lf_verbose',informational) -> true ; Silent = silent), - set_value('$lf_verbose',informational) - ; - InfLevel = silent, - (get_value('$lf_verbose',silent) -> true ; Silent = informational), - set_value('$lf_verbose',silent) - ). -'$process_lf_opt'(autoload(false),_,_,_,_,_,_,_,_,_,_,_,_,_). -'$process_lf_opt'(derived_from(File),_,_,_,_,_,_,_,_,_,_,_,Files,Call) :- - ( atom(File) -> true ; '$do_error'(type_error(atom,File),Call) ), - ( atom(Files) -> true ; '$do_error'(type_error(atom,Files),Call) ), - /* call make */ - '$do_error'(domain_error(unimplemented_option,derived_from),Call). -'$process_lf_opt'(encoding(Encoding),_,_,_,_,_,_,_,_,Encoding,_,_,_,Call) :- +'$process_lf_opt'(autoload, Val, Call) :- + ( Val == false -> true ; + Val == true -> true ; + '$do_error'(domain_error(unimplemented_option,autoload(Val)),Call) ). +'$process_lf_opt'(derived_from, File, Call) :- + ( atom(File) -> true ; '$do_error'(type_error(atom,File),Call) ). +'$process_lf_opt'(encoding, Encoding, Call) :- atom(Encoding). -'$process_lf_opt'(expand(true),_,_,true,_,_,_,_,_,_,_,_,_,Call) :- - '$do_error'(domain_error(unimplemented_option,expand),Call). -'$process_lf_opt'(expand(false),_,_,false,_,_,_,_,_,_,_,_,_,_). -'$process_lf_opt'(if(changed),_,_,_,changed,_,_,_,_,_,_,_,_,_). -'$process_lf_opt'(if(true),_,_,_,true,_,_,_,_,_,_,_,_,_). -'$process_lf_opt'(if(not_loaded),_,_,_,not_loaded,_,_,_,_,_,_,_,_,_). -'$process_lf_opt'(imports(all),_,_,_,_,_,_,_,_,_,_,_,_,_). -'$process_lf_opt'(imports(Imports),_,_,_,_,_,Imports,_,_,_,_,_,_,_). -'$process_lf_opt'(qcompile(true),_,_,_,_,true,_,_,_,_,_,_,_,Call) :- - '$do_error'(domain_error(unimplemented_option,qcompile),Call). -'$process_lf_opt'(qcompile(false),_,_,_,_,false,_,_,_,_,_,_,_,_). -'$process_lf_opt'(silent(true),Silent,silent,_,_,_,_,_,_,_,_,_,_,_) :- - ( get_value('$lf_verbose',silent) -> true ; Silent = informational), - set_value('$lf_verbose',silent). -'$process_lf_opt'(silent(false),Silent,informational,_,_,_,_,_,_,_,_,_,_,_) :- - ( get_value('$lf_verbose',informational) -> true ; Silent = silent), - set_value('$lf_verbose',informational). -'$process_lf_opt'(skip_unix_comments,_,_,_,_,_,_,_,_,skip_unix_comments,_,_,_,_). -'$process_lf_opt'(compilation_mode(source),_,_,_,_,_,_,_,_,_,source,_,_,_). -'$process_lf_opt'(compilation_mode(compact),_,_,_,_,_,_,_,_,_,compact,_,_,_). -'$process_lf_opt'(compilation_mode(assert_all),_,_,_,_,_,_,_,_,_,assert_all,_,_,_). -'$process_lf_opt'(consult(reconsult),_,_,_,_,_,_,_,_,_,_,reconsult,_,_). -'$process_lf_opt'(consult(exo),_,_,_,_,_,_,_,_,_,_,exo,_,_). -'$process_lf_opt'(consult(db),_,_,_,_,_,_,_,_,_,_,db,_,_). -'$process_lf_opt'(consult(consult),_,_,_,_,_,_,_,_,_,_,consult,_,_). -'$process_lf_opt'(stream(Stream),_,_,_,_,_,_,Stream,_,_,_,_,Files,Call) :- -/* ( is_stream(Stream) -> true ; '$do_error'(domain_error(stream,Stream),Call) ), */ - ( atom(Files) -> true ; '$do_error'(type_error(atom,Files),Call) ). +'$process_lf_opt'(expand, Val, Call) :- + ( Val == true -> '$do_error'(domain_error(unimplemented_option,expand),Call) ; + Val == false -> true ; + '$do_error'(domain_error(unimplemented_option,expand(Val)),Call) ). +'$process_lf_opt'(if, If, Call) :- + ( If == changed -> true ; + If == true -> true ; + If == not_loaded -> true ; + '$do_error'(domain_error(unimplemented_option,if),Call) ). +'$process_lf_opt'(imports, Val, Call). + ( Val == all -> true ; + is_list(Val) -> true ; + '$do_error'(domain_error(unimplemented_option,imports(Val)),Call) ). +'$process_lf_opt'(qcompile, Val,Call) :- + ( Val == true -> '$do_error'(domain_error(unimplemented_option,expand),Call) ; + Val == false -> true ; + '$do_error'(domain_error(unimplemented_option,expand(Val)),Call) ). +'$process_lf_opt'(silent, Val, Call) :- + ( Val == false -> true ; + Val == true -> true ; + '$do_error'(domain_error(unimplemented_option,silent(Val)),Call) ). +'$process_lf_opt'(skip_unix_header, Val, Call) :- + ( Val == false -> true ; + Val == true -> true ; + '$do_error'(domain_error(unimplemented_option,skip_unix_header(Val)),Call) ). +'$process_lf_opt'(compilation_mode, Val, Call) :- + ( Val == source -> true ; + Val == compact -> true ; + Val == assert_all -> true ; + '$do_error'(domain_error(unimplemented_option,compilation_mode(Val)),Call) ). +'$process_lf_opt'(consult, Val , Call) :- + ( Val == reconsult -> true ; + Val == consult -> true ; + Val == exo -> true ; + Val == db -> true ; + '$do_error'(domain_error(unimplemented_option,comnsult(Val)),Call) ). +'$process_lf_opt'(stream, Val, Call) :- + ( current_stream(Val) -> true ; + '$do_error'(domain_error(unimplemented_option,stream(Val)),Call) ), + '$lf_opt'('$files', TOpts, Files), + ( atom(File) -> true ; '$do_error'(type_error(atom,Files),Call) ). +'$process_lf_opt'(register, Val, Call) :- + ( Val == false -> true ; + Val == true -> true ; + '$do_error'(domain_error(unimplemented_option,register(Val)),Call) ). -'$check_use_module'(use_module(_),use_module(_)) :- !. -'$check_use_module'(use_module(_,_),use_module(_)) :- !. -'$check_use_module'(use_module(M,_,_),use_module(M)) :- !. -'$check_use_module'(_,load_files) :- !. +'$check_use_module'(use_module(_), use_module(_)) :- !. +'$check_use_module'(use_module(_,_), use_module(_)) :- !. +'$check_use_module'(use_module(M,_,_), use_module(M)) :- !. +'$check_use_module'(_, load_files) :- !. -'$lf'(V,_,Call,_,_,_,_,_,_,_,_,_,_) :- var(V), !, +'$lf'(V,_,Call, _ ) :- var(V), !, '$do_error'(instantiation_error,Call). -'$lf'([],_,_,_,_,_,_,_,_,_,_,_,_,_) :- !. -'$lf'(M:X, _, Call,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,SkipUnixComments,CompMode,Reconsult,UseModule) :- !, +'$lf'([], _, _, _) :- !. +'$lf'(M:X, _, Call, TOpts) :- !, ( atom(M) -> - '$lf'(X, M, Call,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,SkipUnixComments,CompMode,Reconsult,UseModule) + '$lf'(X, M, Call, TOpts) ; '$do_error'(type_error(atom,M),Call) ). -'$lf'([F|Fs], Mod,Call,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,SkipUnixComments,CompMode,Reconsult,UseModule) :- !, - '$lf'(F,Mod,Call,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,SkipUnixComments,CompMode,Reconsult,_), - '$lf'(Fs, Mod,Call,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,SkipUnixComments,CompMode,Reconsult,UseModule). -'$lf'(_, Mod, _,InfLevel,_,_,CompilationMode,Imports,Stream,_,Reconsult,SkipUnixComments,CompMode,UseModule) :- - nonvar(Stream), !, - '$do_lf'(Mod, Stream, InfLevel,CompilationMode,Imports,SkipUnixComments,CompMode,Reconsult,UseModule). -'$lf'(user, Mod, _,InfLevel,_,_,CompilationMode,Imports,_,_,SkipUnixComments,CompMode,Reconsult,UseModule) :- !, - '$do_lf'(Mod, user_input, InfLevel, CompilationMode,Imports,SkipUnixComments,CompMode,Reconsult,UseModule). -'$lf'(user_input, Mod, _,InfLevel,_,_,CompilationMode,Imports,_,_,SkipUnixComments,CompMode,Reconsult,UseModule) :- !, - '$do_lf'(Mod, user_input, InfLevel, CompilationMode,Imports,SkipUnixComments,CompMode,Reconsult,UseModule). -'$lf'(X, Mod, Call, InfLevel,_,Changed,CompilationMode,Imports,_,Encoding,SkipUnixComments,CompMode,Reconsult,UseModule) :- - '$full_filename'(X, Y, Call), - ( - var(Encoding) - -> - Opts = [] +'$lf'([F|Fs], Mod, Call, TOpts) :- !, + % clean up after each consult + ( '$lf'(F,Mod,Call, TOpts), fail ; + '$lf'(Fs, Mod, Call, TOpts) ). +'$lf'(user, Mod, _, TOpts) :- !, + '$do_lf'(Mod, user_input, user_input, TOpts). +'$lf'(user_input, Mod, _, TOpts) :- !, + '$do_lf'(Mod, user_input, user_input, TOpts). +'$lf'(File, Mod, Call, TOpts) :- + '$lf_opt'(stream, TOpts, Stream), + ( var(Stream) -> + /* need_to_open_file */ + '$lf_opt'(encoding, TOpts, Encoding), + '$full_filename'(File, Y, Call), + ( + var(Encoding) + -> + Opts = [] + ; + Opts = [encoding(Encoding)] + ), + open(Y, read, Stream, Opts) ; - Opts = [encoding(Encoding)] - ), - open(Y, read, Stream, Opts), !, - '$set_changed_lfmode'(Changed), - '$start_lf'(X, Mod, Stream, InfLevel, CompilationMode, Imports, Changed,SkipUnixComments,CompMode,Reconsult,UseModule), + true + ), !, + '$lf_opt'(if, TOpts, If), + '$lf_opt'(imports, TOpts, Imports), + '$start_lf'(If, Mod, Stream, TOpts, File, Imports), close(Stream). -'$lf'(X, _, Call, _, _, _, _, _, _, _, _, _, _, _) :- +'$lf'(X, _, Call, _) :- '$do_error'(permission_error(input,stream,X),Call). -'$set_changed_lfmode'(true) :- !. -'$set_changed_lfmode'(_). - -'$start_lf'(_, Mod, Stream,_ ,_, Imports, not_loaded, _, _, _, _) :- - '$file_loaded'(Stream, Mod, Imports), !. -'$start_lf'(_, Mod, Stream, _, _, Imports, changed, _, _, _, _) :- - '$file_unchanged'(Stream, Mod, Imports), !. -'$start_lf'(_, Mod, Stream, InfLevel, CompilationMode, Imports, _, SkipUnixComments, CompMode, Reconsult, UseModule) :- - '$do_lf'(Mod, Stream, InfLevel, CompilationMode, Imports, SkipUnixComments, CompMode, Reconsult, UseModule). - -'$close_lf'(Silent) :- - nonvar(Silent), !, - set_value('$lf_verbose',Silent). -'$close_lf'(_). +'$start_lf'(not_loaded, Mod, Stream, TOpts, UserFile, Imports) :- + '$file_loaded'(Stream, Mod, Imports), !, + '$lf_opt'('$options', TOpts, Opts), + '$lf_opt'('$location', TOpts, ParentF:Line), + '$loaded'(Stream, UserFile, Mod, ParentF, Line, not_loaded, _File, _Dir, Opts). +'$start_lf'(changed, Mod, Stream, TOpts, UserFile, Imports) :- + '$file_unchanged'(Stream, Mod, Imports), !, + '$lf_opt'('$options', TOpts, Opts), + '$lf_opt'('$location', TOpts, ParentF:Line), + '$loaded'(Stream, UserFile, Mod, ParentF, Line, changed, _File, _Dir, Opts). +'$start_lf'(_, Mod, Stream, TOpts, File, _) :- + '$do_lf'(Mod, Stream, File, TOpts). ensure_loaded(Fs) :- '$load_files'(Fs, [if(changed)],ensure_loaded(Fs)). @@ -232,25 +280,34 @@ use_module(M,F,Is) :- '$use_module'(M,F,Is) :- nonvar(F), '$load_files'(F, [if(not_loaded),imports(Is)], use_module(M,F,Is)). -'$csult'(V, _) :- var(V), !, - '$do_error'(instantiation_error,consult(V)). -'$csult'([], _). -'$csult'([-F|L], M) :- !, '$load_files'(M:F, [],[-M:F]), '$csult'(L, M). -'$csult'([F|L], M) :- '$consult'(F, M), '$csult'(L, M). +'$csult'(Fs, M) :- + '$extract_minus'(Fs, MFs), !, + '$load_files'(M:MFs,[],[M:Fs]). +'$csult'(Fs, M) :- + '$load_files'(M:Fs,[consult(consult)],[M:Fs]). -'$do_lf'(ContextModule, Stream, InfLevel, _, Imports, SkipUnixComments, CompMode, Reconsult, UseModule) :- +'$extract_minus'([], []). +'$extract_minus'([-F|Fs], [F|MFs]) :- + '$extract_minus'(Fs, MFs). + + +'$do_lf'(ContextModule, Stream, UserFile, TOpts) :- %MsgLevel, _, Imports, SkipUnixHeader, CompMode, Reconsult, UseModule) :- + '$msg_level'( TOpts, Verbosity), + % export to process + b_setval('$lf_status', TOpts), '$reset_if'(OldIfLevel), '$into_system_mode'(OldMode), - '$record_loaded'(Stream, ContextModule, Reconsult), - '$current_module'(OldModule,ContextModule), - working_directory(OldD,OldD), - '$ensure_consulting_file'(OldF, Stream), + % take care with [a:f], a is the ContextModule + '$current_module'(SourceModule, ContextModule), + '$lf_opt'(consult, TOpts, Reconsult), + '$lf_opt'('$options', TOpts, Opts), + '$lf_opt'('$location', TOpts, ParentF:Line), + '$loaded'(Stream, UserFile, SourceModule, ParentF, Line, Reconsult, File, Dir, Opts), + working_directory(OldD, Dir), H0 is heapused, '$cputime'(T0,_), - '$file_name'(Stream,File), '$set_current_loop_stream'(OldStream, Stream), - '$ensure_consulting'(Old, false), - '$access_yap_flags'(18,GenerateDebug), - '$consult_infolevel'(InfLevel), + '$swi_current_prolog_flag'(generate_debug_info, GenerateDebug), + '$lf_opt'(compilation_mode, TOpts, CompMode), '$comp_mode'(OldCompMode, CompMode), ( get_value('$syntaxcheckflag',on) -> '$init_style_check'(File) ; true ), recorda('$initialisation','$',_), @@ -265,16 +322,17 @@ use_module(M,F,Is) :- StartMsg = consulting, EndMsg = consulted ), - print_message(InfLevel, loading(StartMsg, File)), - ( SkipUnixComments == skip_unix_comments -> - '$skip_unix_comments'(Stream) + print_message(Verbosity, loading(StartMsg, File)), + '$lf_opt'(skip_unix_header , TOpts, SkipUnixHeader), + ( SkipUnixHeader == true-> + '$skip_unix_header'(Stream) ; true ), '$loop'(Stream,Reconsult), H is heapused-H0, '$cputime'(TF,_), T is TF-T0, - '$current_module'(Mod,OldModule), - print_message(InfLevel, loaded(EndMsg, File, Mod, T, H)), + '$current_module'(Mod, SourceModule), + print_message(Verbosity, loaded(EndMsg, File, Mod, T, H)), '$end_consult', ( Reconsult = reconsult -> @@ -283,22 +341,38 @@ use_module(M,F,Is) :- true ), '$set_current_loop_stream'(_, OldStream), - '$set_yap_flags'(18,GenerateDebug), + '$swi_set_prolog_flag'(generate_debug_info, GenerateDebug), '$comp_mode'(CompMode, OldCompMode), - nb_setval('$consulting',Old), - nb_setval('$consulting_file',OldF), working_directory(_,OldD), % surely, we were in run mode or we would not have included the file! nb_setval('$if_skip_mode',run), % back to include mode! nb_setval('$if_level',OldIfLevel), + '$lf_opt'('$use_module', TOpts, UseModule), '$bind_module'(Mod, UseModule), + '$lf_opt'(imports, TOpts, Imports0), + (Imports0 == all -> true ; Imports = Imports0 ), '$import_to_current_module'(File, ContextModule, Imports), ( LC == 0 -> prompt(_,' |: ') ; true), ( OldMode == off -> '$exit_system_mode' ; true ), '$exec_initialisation_goals', !. +% are we in autoload and autoload_flag is false? +'$msg_level'( TOpts, Verbosity) :- + '$lf_opt'(autoload, TOpts, AutoLoad), + AutoLoad == true, + '$swi_current_prolog_flag'(verbose_autoload, false), !, + Verbosity = silent. +'$msg_level'( _TOpts, Verbosity) :- + '$swi_current_prolog_flag'(verbose, silent), !, + Verbosity = silent. +'$msg_level'( TOpts, Verbosity) :- + '$lf_opt'(silent, TOpts, Silent), + Silent == true, !, + Verbosity = silent. +'$msg_level'( _TOpts, informational). + '$reset_if'(OldIfLevel) :- '$nb_getval'('$if_level', OldIfLevel, fail), !, nb_setval('$if_level',0). @@ -314,14 +388,6 @@ use_module(M,F,Is) :- ( '$nb_getval'('$system_mode', OldMode, fail) -> true ; OldMode = off), ( OldMode == off -> '$enter_system_mode' ; true ). -'$ensure_consulting_file'(OldF, Stream) :- - ( '$nb_getval'('$consulting_file',OldF, fail) -> true ; OldF = []), - '$set_consulting_file'(Stream). - -'$ensure_consulting'(Old, New) :- - ( '$nb_getval'('$consulting',Old, fail) -> true ; Old = false ), - nb_setval('$consulting', New). - '$bind_module'(_, load_files). '$bind_module'(Mod, use_module(Mod)). @@ -330,11 +396,6 @@ use_module(M,F,Is) :- '$use_preds'(Imports, Ps, NM, M). '$import_to_current_module'(_, _, _). -'$consult_infolevel'(InfoLevel) :- nonvar(InfoLevel), !. -'$consult_infolevel'(InfoLevel) :- - get_value('$lf_verbose',InfoLevel), InfoLevel \= [], !. -'$consult_infolevel'(informational). - '$start_reconsulting'(F) :- recorda('$reconsulted','$',_), recorda('$reconsulting',F,_). @@ -451,28 +512,33 @@ initialization(G,OPT) :- '$include'(F, Status), '$include'(Fs, Status). '$include'(X, Status) :- - get_value('$lf_verbose',Verbosity), - '$full_filename'(X,Y,include(X)), - ( '$nb_getval'('$included_file', OY, fail ) -> true ; OY = [] ), - nb_setval('$included_file', Y), + b_getval('$lf_status', TOpts), + '$msg_level'( TOpts, Verbosity), + '$full_filename'(X, Y , ( :- include(X)) ), + '$lf_opt'(stream, TOpts, OldStream), + source_location(F, L), '$current_module'(Mod), - H0 is heapused, '$cputime'(T0,_), - ( open(Y, read, Stream), !, - print_message(Verbosity, loading(including, Y)), - '$loop'(Stream,Status), close(Stream) - ; + ( open(Y, read, Stream) -> + true ; '$do_error'(permission_error(input,stream,Y),include(X)) ), + H0 is heapused, '$cputime'(T0,_), + '$loaded'(Stream, X, Mod, F, L, include, Y, Dir, []), + ( '$nb_getval'('$included_file', OY, fail ) -> true ; OY = [] ), + nb_setval('$included_file', Y), + print_message(Verbosity, loading(including, Y)), + '$loop'(Stream,Status), + close(Stream), H is heapused-H0, '$cputime'(TF,_), T is TF-T0, print_message(Verbosity, loaded(included, Y, Mod, T, H)), nb_setval('$included_file',OY). '$do_startup_reconsult'(X) :- ( '$access_yap_flags'(15, 0) -> - '$system_catch'(load_files(X, [silent(true)]),Module, Error, '$Error'(Error)) + '$system_catch'(load_files(X, [silent(true)]), Module, Error, '$Error'(Error)) ; - set_value('$verbose',off), - '$system_catch'(load_files(X, [silent(true),skip_unix_comments]),Module,_,fail) + '$swi_set_prolog_flag'(verbose, silent), + '$system_catch'(load_files(X, [silent(true),skip_unix_header(true)]),Module,_,fail) ; true ), @@ -480,15 +546,15 @@ initialization(G,OPT) :- ( '$access_yap_flags'(15, 0) -> true ; halt). '$do_startup_reconsult'(_). -'$skip_unix_comments'(Stream) :- +'$skip_unix_header'(Stream) :- peek_code(Stream, 0'#), !, % 35 is ASCII for '# skip(Stream, 10), - '$skip_unix_comments'(Stream). -'$skip_unix_comments'(_). + '$skip_unix_header'(Stream). +'$skip_unix_header'(_). source_file(FileName) :- - recorded('$lf_loaded','$lf_loaded'(FileName,Mod,_,_),_), Mod \= prolog. + recorded('$lf_loaded','$lf_loaded'(FileName, _),_). source_file(Mod:Pred, FileName) :- current_module(Mod), @@ -504,29 +570,24 @@ source_file(Mod:Pred, FileName) :- '$owned_by'(T, Mod, FileName) :- '$owner_file'(T, Mod, FileName). -prolog_load_context(_, _) :- - '$nb_getval'('$consulting_file', [], fail), !, fail. prolog_load_context(directory, DirName) :- - getcwd(DirName). + source_location(F, _), + file_directory_name(F, DirName). prolog_load_context(file, FileName) :- - ( '$nb_getval'('$included_file', IncFileName, fail ) -> true ; IncFileName = [] ), - ( IncFileName = [] -> - '$nb_getval'('$consulting_file', FileName, fail), - FileName \= [] - ; - FileName = IncFileName - ). + source_location(FileName, _). prolog_load_context(module, X) :- + '$nb_getval'('$consulting_file', _, fail), '$current_module'(X). -prolog_load_context(source, FileName) :- - nb_getval('$consulting_file',FileName). +prolog_load_context(source, F0) :- + source_location(F0, _) /*, + '$input_context'(Context), + '$top_file'(Context, F0, F) */. prolog_load_context(stream, Stream) :- + '$nb_setval'('$consulting_file', _, fail), '$current_loop_stream'(Stream). % return this term for SWI compatibility. prolog_load_context(term_position, '$stream_position'(0,Line,0,0,0)) :- - '$current_loop_stream'(Stream), - stream_property(Stream, position(Position)), - stream_position_data(line_count, Position, Line). + source_location(_, Line). % if the file exports a module, then we can @@ -537,11 +598,11 @@ prolog_load_context(term_position, '$stream_position'(0,Line,0,0,0)) :- '$ensure_file_loaded'(F, M, Imports) :- recorded('$module','$module'(F1,NM,P),_), - recorded('$lf_loaded','$lf_loaded'(F1,_,_,_),_), + recorded('$lf_loaded','$lf_loaded'(F1,_),_), same_file(F1,F), !, '$use_preds'(Imports,P, NM, M). -'$ensure_file_loaded'(F, M, _) :- - recorded('$lf_loaded','$lf_loaded'(F1,M,_,_),_), +'$ensure_file_loaded'(F, _M, _) :- + recorded('$lf_loaded','$lf_loaded'(F1,_),_), same_file(F1,F), !. @@ -553,12 +614,12 @@ prolog_load_context(term_position, '$stream_position'(0,Line,0,0,0)) :- '$ensure_file_unchanged'(F, M, Imports) :- recorded('$module','$module'(F1,NM,P),_), - recorded('$lf_loaded','$lf_loaded'(F1,_,Age,_),R), + recorded('$lf_loaded','$lf_loaded'(F1,Age),R), same_file(F1,F), !, '$file_is_unchanged'(F, R, Age), '$use_preds'(Imports, P, NM, M). '$ensure_file_unchanged'(F, M, _) :- - recorded('$lf_loaded','$lf_loaded'(F1,M,Age,_),R), + recorded('$lf_loaded','$lf_loaded'(F1,Age),R), same_file(F1,F), !, '$file_is_unchanged'(F, R, Age). @@ -598,7 +659,7 @@ remove_from_path(New) :- '$check_path'(New,Path), % add_multifile_predicate when we start consult '$add_multifile'(Name,Arity,Module) :- - nb_getval('$consulting_file',File), + source_location(File,_), '$add_multifile'(File,Name,Arity,Module). '$add_multifile'(File,Name,Arity,Module) :- @@ -626,31 +687,17 @@ remove_from_path(New) :- '$check_path'(New,Path), fail. '$remove_multifile_clauses'(_). -'$set_consulting_file'(user) :- !, - nb_setval('$consulting_file',user_input). -'$set_consulting_file'(user_input) :- !, - nb_setval('$consulting_file',user_input). -'$set_consulting_file'(Stream) :- - '$file_name'(Stream,F), - nb_setval('$consulting_file',F), - '$set_consulting_dir'(F). -% -% Use directory where file exists -% -'$set_consulting_dir'(F) :- - file_directory_name(F, Dir), - working_directory(_, Dir). - -'$record_loaded'(Stream, M, Reconsult) :- - Stream \= user, - Stream \= user_input, - '$file_name'(Stream,F), - ( recorded('$lf_loaded','$lf_loaded'(F,M,_,_),R), erase(R), fail ; true ), - time_file64(F,Age), - recorda('$lf_loaded','$lf_loaded'(F,M,Age,Reconsult),_), - fail. -'$record_loaded'(_, _, _). +'$loaded'(Stream, UserFile, M, OldF, Line, Reconsult, F, Dir, Opts) :- + '$file_name'(Stream, F0), + ( F0 == user_input, nonvar(File) -> UserFile = F ; F = F0 ), + ( F == user_input -> working_directory(Dir,Dir) ; file_directory_name(F, Dir) ), + nb_setval('$consulting_file', F ), + ( Reconsult \== consult, Reconsult \== not_loaded, Reconsult \== changed, recorded('$lf_loaded','$lf_loaded'(F, _),R), erase(R), fail ; var(Reconsult) -> Reconsult = consult ; true ), + ( Reconsult \== consult, recorded('$lf_loaded','$lf_loaded'(F, _, _, _, _, _, _),R), erase(R), fail ; var(Reconsult) -> Reconsult = consult ; true ), + ( F == user_input -> Age = 0 ; time_file64(F, Age) ), + recorda('$lf_loaded','$lf_loaded'( F, Age), _), + recorda('$lf_loaded','$lf_loaded'( F, M, Reconsult, UserFile, OldF, Line, Opts), _). '$set_encoding'(Encoding) :- '$current_loop_stream'(Stream), @@ -1031,7 +1078,7 @@ absolute_file_name(File,Opts,TrueFileName) :- '$fetch_comp_status'(compact). make :- - recorded('$lf_loaded','$lf_loaded'(F1,M,_,reconsult),_), + recorded('$lf_loaded','$lf_loaded'(F1,M,reconsult,_,_,_,_),_), '$load_files'(F1, [if(changed)],make), fail. make. @@ -1040,7 +1087,7 @@ make_library_index(_Directory). '$file_name'(Stream,F) :- stream_property(Stream, file_name(F)), !. -'$file_name'(user_input,user_output). +'$file_name'(user_input,user_input). '$file_name'(user_output,user_ouput). '$file_name'(user_error,user_error). @@ -1073,3 +1120,44 @@ make_library_index(_Directory). exists_source(File) :- '$full_filename'(File, AbsFile, exists_source(File)). +% reload_file(File) :- +% ' $source_base_name'(File, Compile), +% findall(M-Opts, +% source_file_property(File, load_context(M, _, Opts)), +% Modules), +% ( Modules = [First-OptsFirst|Rest] +% -> Extra = [ silent(false), +% register(false) +% ], +% merge_options([if(true)|Extra], OptsFirst, OFirst), +% % debug(make, 'Make: First load ~q', [load_files(First:Compile, OFirst)]), +% load_files(First:Compile, OFirst), +% forall(member(Context-Opts, Rest), +% ( merge_options([if(not_loaded)|Extra], Opts, O), +% % debug(make, 'Make: re-import: ~q', +% % [load_files(Context:Compile, O)]), +% load_files(Context:Compile, O) +% )) +% ; load_files(user:Compile) +% ). + +% ' $source_base_name'(File, Compile) :- +% file_name_extension(Compile, Ext, File), +% user:prolog_file_type(Ext, prolog), !. +% ' $source_base_name'(File, File). + +source_file_property( File0, Prop) :- + ( nonvar(File0) -> absolute_file_name(File0,File) ; File = File0 ), + '$source_file_property'( File, Prop). + +'$source_file_property'( OldF, includes(F, Age)) :- + recorded('$lf_loaded','$lf_loaded'( F, _M, include, _File, OldF, _Line, _), _), + recorded('$lf_loaded','$lf_loaded'( F, Age), _). +'$source_file_property'( F, included_in(OldF, Line)) :- + recorded('$lf_loaded','$lf_loaded'( F, _M, include, _File, OldF, Line, _), _). +'$source_file_property'( F, load_context(OldF, Line, Options)) :- + recorded('$lf_loaded','$lf_loaded'( F, _M, V, _File, OldF, Line, Options), _), V \== include. +'$source_file_property'( F, modified(Age)) :- + recorded('$lf_loaded','$lf_loaded'( F, Age), _). +'$source_file_property'( F, module(M)) :- + recorded('$module','$module'(F,M,_),_). diff --git a/pl/control.yap b/pl/control.yap index 07fd95982..448150653 100644 --- a/pl/control.yap +++ b/pl/control.yap @@ -326,8 +326,8 @@ break :- nb_setval('$trace',off), nb_getval('$debug_jump',Jump), nb_getval('$debug_run',Run), - '$debug_on'(Debug), - '$debug_on'(false), + '$swi_current_prolog_flag'(debug, Debug), + '$swi_set_prolog_flag'(debug, false), nb_getval('$break',BL), NBL is BL+1, nb_getval('$spy_gn',SPY_GN), b_getval('$spy_glist',GList), @@ -342,7 +342,7 @@ break :- nb_setval('$spy_gn',SPY_GN), set_input(InpStream), set_output(OutStream), - '$debug_on'(Debug), + '$swi_set_prolog_flag'(debug, Debug), nb_setval('$debug_jump',Jump), nb_setval('$debug_run',Run), nb_setval('$trace',Trace), diff --git a/pl/debug.yap b/pl/debug.yap index 0f49296ce..b7df0f4f5 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -165,16 +165,16 @@ debug :- '$start_debugging'(Mode) :- (Mode == on -> - '$debug_on'(true) + '$swi_set_prolog_flag'(debug, true) ; - '$debug_on'(false) + '$swi_set_prolog_flag'(debug, false) ), nb_setval('$debug_run',off), nb_setval('$debug_jump',false). nodebug :- '$init_debugger', - '$debug_on'(false), + '$swi_set_prolog_flag'(debug, false), nb_setval('$trace',off), print_message(informational,debug(off)). @@ -264,7 +264,7 @@ debugging :- '$init_debugger', prolog:debug_action_hook(nospyall), !. debugging :- - ( '$debug_on'(true) -> + ( '$swi_current_prolog_flag'(debug, true) -> print_message(help,debug(debug)) ; print_message(help,debug(off)) @@ -307,7 +307,7 @@ debugging :- % % $spy may be called from user code, so be careful. '$spy'([Mod|G]) :- - '$debug_on'(F), F = false, !, + '$swi_current_prolog_flag'(debug, false), !, '$execute_nonstop'(G,Mod). '$spy'([Mod|G]) :- '$in_system_mode', !, @@ -587,7 +587,7 @@ debugging :- % at this point we are done with leap or skip nb_setval('$debug_run',off), % make sure we run this code outside debugging mode. - '$debug_on'(false), + '$swi_set_prolog_flag'(debug, false), repeat, '$trace_msg'(P,G,Module,L,Deterministic), ( @@ -600,13 +600,13 @@ debugging :- ), (Debug = on -> - '$debug_on'(true) + '$swi_set_prolog_flag'(debug, true) ; Debug = zip -> - '$debug_on'(true) + '$swi_set_prolog_flag'(debug, true) ; - '$debug_on'(false) + '$swi_set_prolog_flag'(debug, false) ), !. @@ -650,10 +650,10 @@ debugging :- '$action'(0'!,_,_,_,_,_) :- !, % ! 'g execute read(user,G), % don't allow yourself to be caught by creep. - '$debug_on'(OldDeb), - '$debug_on'(false), + '$swi_current_prolog_flag'(debug, OldDeb), + '$swi_set_prolog_flag'(debug, false), ( '$execute'(G) -> true ; true), - '$debug_on'(OldDeb), + '$swi_set_prolog_flag'(debug, OldDeb), % '$skipeol'(0'!), % ' fail. '$action'(0'<,_,_,_,_,_) :- !, % <'Depth @@ -732,7 +732,7 @@ debugging :- nodebug. '$action'(0'r,_,CallId,_,_,_) :- !, % 'r retry '$scan_number'(0'r,CallId,ScanNumber), % ' - '$debug_on'(true), + '$swi_set_prolog_flag'(debug, true), throw(error('$retry_spy'(ScanNumber),[])). '$action'(0's,P,CallNumber,_,_,on) :- !, % 's skip '$skipeol'(0's), % ' diff --git a/pl/dialect.yap b/pl/dialect.yap index bb1304c8a..89f9736dc 100644 --- a/pl/dialect.yap +++ b/pl/dialect.yap @@ -20,14 +20,14 @@ prolog:'$expects_dialect'(Dialect) :- check_dialect(Dialect) :- var(Dialect),!, - '$do_error'(instantiation_error,(:- dialect(Dialect))). + '$do_error'(instantiation_error,(:- expects_dialect(Dialect))). check_dialect(Dialect) :- \+ atom(Dialect),!, - '$do_error'(type_error(Dialect),(:- dialect(Dialect))). + '$do_error'(type_error(Dialect),(:- expects_dialect(Dialect))). check_dialect(Dialect) :- exists_source(library(dialect/Dialect)), !. check_dialect(Dialect) :- - '$do_error'(domain_error(dialect,Dialect),(:- dialect(Dialect))). + '$do_error'(domain_error(dialect,Dialect),(:- expects_dialect(Dialect))). %% exists_source(+Source) is semidet. % diff --git a/pl/flags.yap b/pl/flags.yap index 45baed920..6d3554f06 100755 --- a/pl/flags.yap +++ b/pl/flags.yap @@ -117,34 +117,6 @@ yap_flag(debug_on_error,X) :- -yap_flag(generate_debug_info,X) :- - var(X), !, - '$access_yap_flags'(18,Options), - (Options =:= 0 -> X = false ; X = true ). -yap_flag(generate_debug_info,true) :- !, - '$enable_restore_flag_info'(generate_debug_info), - '$set_yap_flags'(18,1), - source. -yap_flag(generate_debug_info,false) :- !, - '$enable_restore_flag_info'(generate_debug_info), - '$set_yap_flags'(18,0), - no_source. -yap_flag(generate_debug_info,X) :- - '$do_error'(domain_error(flag_value,generate_debug_info+X),yap_flag(generate_debug_info,X)). - -'$enable_restore_flag_info'(_) :- - nb_getval('$consulting_file',[]), !. -'$enable_restore_flag_info'(_) :- - nb_getval('$initialization_goals',on), !. -'$enable_restore_flag_info'(Flag) :- - '$show_consult_level'(Level1), - yap_flag(Flag, Info), - % it will be done after we leave the current consult level. - Level is Level1-1, - recorda('$initialisation',do(Level,yap_flag(Flag,Info)),_), - fail. -'$enable_restore_flag_info'(_). - % % show state of $ % @@ -254,37 +226,7 @@ yap_flag(tabling_mode,Options) :- '$transl_to_yap_flag_tabling_mode'(6,global_trie). yap_flag(informational_messages,X) :- var(X), !, - get_value('$verbose',X). -yap_flag(informational_messages,on) :- !, - set_value('$verbose',on), - '$set_yap_flags'(22,0). -yap_flag(informational_messages,off) :- !, - set_value('$verbose',off), - '$set_yap_flags'(22,1). -yap_flag(informational_messages,X) :- - '$do_error'(domain_error(flag_value,informational_messages+X),yap_flag(informational_messages,X)). - -yap_flag(verbose,X) :- var(X), !, - get_value('$verbose',X0), - (X0 == on -> X = normal ; X = silent). -yap_flag(verbose,normal) :- !, - set_value('$verbose',on), - '$set_yap_flags'(22,0). -yap_flag(verbose,silent) :- !, - set_value('$verbose',off), - '$set_yap_flags'(22,1). -yap_flag(verbose,X) :- - '$do_error'(domain_error(flag_value,verbose+X),yap_flag(verbose,X)). - -yap_flag(integer_rounding_function,X) :- - var(X), !, - '$access_yap_flags'(2, X1), - '$transl_to_rounding_function'(X1,X). -yap_flag(integer_rounding_function,X) :- - (X = down; X = toward_zero), !, - '$do_error'(permission_error(modify,flag,integer_rounding_function),yap_flag(integer_rounding_function,X)). -yap_flag(integer_rounding_function,X) :- - '$do_error'(domain_error(flag_value,integer_rounding_function+X),yap_flag(integer_rounding_function,X)). + yap_flag(verbose, X). yap_flag(version,X) :- var(X), !, @@ -404,21 +346,6 @@ yap_flag(language,X) :- yap_flag(language,X) :- '$do_error'(domain_error(flag_value,language+X),yap_flag(language,X)). -yap_flag(debug,X) :- - var(X), !, - '$debug_on'(Val), - (Val == true - -> - X = on - ; - X = true - ). -yap_flag(debug,X) :- - '$transl_to_on_off'(_,X), !, - (X = on -> debug ; nodebug). -yap_flag(debug,X) :- - '$do_error'(domain_error(flag_value,debug+X),yap_flag(debug,X)). - yap_flag(discontiguous_warnings,X) :- var(X), !, '$syntax_check_discontiguous'(on,_). @@ -492,6 +419,8 @@ yap_flag(system_options,X) :- '$swi_current_prolog_flag'(readline, true). '$system_options'(tabling) :- \+ '$undefined'('$c_table'(_,_,_), prolog). +'$system_options'(threads) :- + \+ '$undefined'('$thread_join'(_), prolog). '$system_options'(wam_profiler) :- \+ '$undefined'(reset_op_counters, prolog). @@ -640,28 +569,6 @@ yap_flag(toplevel_print_options,Opts) :- yap_flag(host_type,X) :- '$host_type'(X). -yap_flag(verbose_load,X) :- - var(X), !, - ( get_value('$lf_verbose',silent) -> X = false ; X = true ). -yap_flag(verbose_load,true) :- !, - set_value('$lf_verbose',informational). -yap_flag(verbose_load,false) :- !, - set_value('$lf_verbose',silent), - '$set_yap_flags'(7,1). -yap_flag(verbose_load,X) :- - '$do_error'(domain_error(flag_value,verbose_load+X),yap_flag(verbose_load,X)). - -yap_flag(verbose_auto_load,X) :- - var(X), !, - ( get_value('$verbose_auto_load',true) -> X = true ; X = false ). -yap_flag(verbose_auto_load,true) :- !, - set_value('$verbose_auto_load',true). -yap_flag(verbose_auto_load,false) :- !, - set_value('$verbose_auto_load',false), - '$set_yap_flags'(7,1). -yap_flag(verbose_auto_load,X) :- - '$do_error'(domain_error(flag_value,verbose_auto_load+X),yap_flag(verbose_auto_load,X)). - yap_flag(float_format,X) :- var(X), !, '$float_format'(X). @@ -695,7 +602,6 @@ yap_flag(max_threads,X) :- '$yap_system_flag'(char_conversion). '$yap_system_flag'(character_escapes). '$yap_system_flag'(chr_toplevel_show_store). -'$yap_system_flag'(debug). '$yap_system_flag'(debug_on_error ). '$yap_system_flag'(debugger_print_options). '$yap_system_flag'(discontiguous_warnings). @@ -712,14 +618,12 @@ yap_flag(max_threads,X) :- '$yap_system_flag'(gc ). '$yap_system_flag'(gc_margin ). '$yap_system_flag'(gc_trace ). -'$yap_system_flag'(generate_debug_info ). % V = hide ; '$yap_system_flag'(host_type ). '$yap_system_flag'(index). '$yap_system_flag'(index_sub_term_search_depth). '$yap_system_flag'(tabling_mode). '$yap_system_flag'(informational_messages). -'$yap_system_flag'(integer_rounding_function). '$yap_system_flag'(language). '$yap_system_flag'(max_workers). '$yap_system_flag'(max_threads). @@ -750,9 +654,6 @@ yap_flag(max_threads,X) :- '$yap_system_flag'(user_input). '$yap_system_flag'(user_output). '$yap_system_flag'(variable_names_may_end_with_quotes). -'$yap_system_flag'(verbose). -'$yap_system_flag'(verbose_load). -'$yap_system_flag'(verbose_auto_load). '$yap_system_flag'(version). '$yap_system_flag'(write_strings). @@ -861,7 +762,7 @@ set_prolog_flag(F,V) :- \+ atom(F), !, '$do_error'(type_error(atom,F),set_prolog_flag(F,V)). set_prolog_flag(F, Val) :- - '$swi_current_prolog_flag'(F, _), + '$swi_current_prolog_flag'(F, _), !, '$swi_set_prolog_flag'(F, Val). set_prolog_flag(F,V) :- '$yap_system_flag'(F), !, diff --git a/pl/init.yap b/pl/init.yap index bd1db782c..a8b30bcfe 100755 --- a/pl/init.yap +++ b/pl/init.yap @@ -123,9 +123,6 @@ otherwise. version(yap,[6,3]). -system_mode(verbose,on) :- set_value('$verbose',on). -system_mode(verbose,off) :- set_value('$verbose',off). - :- op(1150,fx,(mode)). :- dynamic 'extensions_to_present_answer'/1. @@ -171,7 +168,8 @@ yap_hacks:cut_by(CP) :- '$$cut_by'(CP). % % cleanup ensure loaded and recover some data-base space. % -:- ( recorded('$loaded','$loaded'(_,_,_),R), erase(R), fail ; true ). +:- ( recorded('$lf_loaded',_,R), erase(R), fail ; true ). +:- ( recorded('$module',_,R), erase(R), fail ; true ). :- set_value('$user_module',user), '$protect'. @@ -184,8 +182,6 @@ yap_hacks:cut_by(CP) :- '$$cut_by'(CP). % :- yap_flag(gc_trace,verbose). -:- system_mode(verbose,on). - :- multifile prolog:message/3. :- dynamic prolog:message/3. diff --git a/pl/modules.yap b/pl/modules.yap index 4e785dec0..4afb7069a 100644 --- a/pl/modules.yap +++ b/pl/modules.yap @@ -16,10 +16,6 @@ *************************************************************************/ % module handling -'$consulting_file_name'(Stream,F) :- - '$file_name'(Stream, F). - - '$module'(_,N,P) :- '$module_dec'(N,P). @@ -77,7 +73,7 @@ module(N) :- '$module_dec'(N,P) :- '$current_module'(_,N), - nb_getval('$consulting_file',F), + source_location(F, _), '$add_module_on_file'(N, F, P). '$add_module_on_file'(Mod, F, Exports) :- @@ -744,7 +740,7 @@ export_list(Module, List) :- '$reexport'(ModuleSource, Spec, Module) :- - nb_getval('$consulting_file',TopFile), + source_location(CurrentFile, _), ( Spec == all -> @@ -753,12 +749,11 @@ export_list(Module, List) :- Goal = reexport(ModuleSource,Spec) ), absolute_file_name(ModuleSource, File, [access(read),file_type(prolog),file_errors(fail),solutions(first),expand(true)]), - '$load_files'(File, [if(not_loaded),imports([])], Goal), + '$load_files'(File, [if(not_loaded),silent(true), imports(Spec)], Goal), recorded('$module', '$module'(FullFile, Mod, Exports),_), atom_concat(File, _, FullFile), !, '$convert_for_reexport'(Spec, Exports, Tab, MyExports, Goal), '$add_to_imports'(Tab, Module, Mod), - recorded('$lf_loaded','$lf_loaded'(TopFile,TopModule,_,_),_), recorded('$module', '$module'(CurrentFile, Module, ModExports), Ref), erase(Ref), lists:append(ModExports, MyExports, AllExports), diff --git a/pl/preds.yap b/pl/preds.yap index d4642a1b4..92f8794ae 100644 --- a/pl/preds.yap +++ b/pl/preds.yap @@ -179,7 +179,7 @@ assertz_static(C) :- '$head_and_body'(C0, H0, B0), '$recordap'(Mod:Head,(H0 :- B0),R,CR), ( '$is_multifile'(Head, Mod) -> - nb_getval('$consulting_file',F), + sourcee_location(F, _), functor(H0, Na, Ar), recorda('$multifile_dynamic'(_,_,_), '$mf'(Na,Ar,Mod,F,R), _) ; @@ -198,7 +198,7 @@ assertz_static(C) :- '$head_and_body'(C0, H0, B0), '$recordzp'(Mod:Head,(H0 :- B0),R,CR), ( '$is_multifile'(H0, Mod) -> - get_value('$consulting_file',F), + source_location(F, _), functor(H0, Na, Ar), recordz('$multifile_dynamic'(_,_,_), '$mf'(Na,Ar,Mod,F,R), _) ; @@ -234,7 +234,7 @@ assertz_static(C) :- '$remove_all_d_clauses'(_,_). '$erase_all_mf_dynamic'(Na,A,M) :- - get_value('$consulting_file',F), + source_location( F , _), recorded('$multifile_dynamic'(_,_,_), '$mf'(Na,A,M,F,R), R1), erase(R1), erase(R),