From 4de58e0fe48f377b14629e18b512177e1e24ee78 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Thu, 12 Jul 2018 11:02:09 +0100 Subject: [PATCH] load_file --- os/charsio.c | 7 +--- os/streams.c | 13 ++++---- pl/consult.yap | 82 +++++++++++++++++++++++++++-------------------- pl/directives.yap | 1 - pl/hacks.yap | 6 ++-- pl/init.yap | 9 ++++-- pl/modules.yap | 6 ++-- 7 files changed, 68 insertions(+), 56 deletions(-) diff --git a/os/charsio.c b/os/charsio.c index f2205d8c5..f531d312e 100644 --- a/os/charsio.c +++ b/os/charsio.c @@ -990,16 +990,11 @@ leaving the current stream position unaltered. */ static Int peek_code(USES_REGS1) { /* at_end_of_stream */ /* the next character is a EOF */ - int sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "peek/2"); + int sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "peek_code/2"); Int ch; if (sno < 0) return FALSE; - if (GLOBAL_Stream[sno].status & Binary_Stream_f) { - UNLOCK(GLOBAL_Stream[sno].streamlock); - Yap_Error(PERMISSION_ERROR_INPUT_TEXT_STREAM, ARG1, "peek_code/2"); - return FALSE; - } if ((ch = Yap_peek(sno)) < 0) { #ifdef PEEK_EOF UNLOCK(GLOBAL_Stream[sno].streamlock); diff --git a/os/streams.c b/os/streams.c index 5ec3a1410..8e5baa2bc 100644 --- a/os/streams.c +++ b/os/streams.c @@ -683,7 +683,7 @@ static xarg *generate_property(int sno, Term t2, } static Int cont_stream_property(USES_REGS1) { /* current_stream */ - bool det; + bool det = false; xarg *args; int i = IntOfTerm(EXTRA_CBACK_ARG(2, 1)); stream_property_choices_t p = STREAM_PROPERTY_END; @@ -705,7 +705,7 @@ static Int cont_stream_property(USES_REGS1) { /* current_stream */ if (LOCAL_Error_TYPE != YAP_NO_ERROR) { if (LOCAL_Error_TYPE == DOMAIN_ERROR_GENERIC_ARGUMENT) LOCAL_Error_TYPE = DOMAIN_ERROR_STREAM_PROPERTY_OPTION; - Yap_Error(LOCAL_Error_TYPE, t2, NULL); + Yap_ThrowError(LOCAL_Error_TYPE, t2, NULL); return false; } cut_fail(); @@ -714,16 +714,17 @@ static Int cont_stream_property(USES_REGS1) { /* current_stream */ if (IsAtomTerm(args[STREAM_PROPERTY_ALIAS].tvalue)) { // one solution only i = Yap_CheckAlias(AtomOfTerm(args[STREAM_PROPERTY_ALIAS].tvalue)); - free(args) UNLOCK(GLOBAL_Stream[i].streamlock); + UNLOCK(GLOBAL_Stream[i].streamlock); if (i < 0 || !Yap_unify(ARG1, Yap_MkStream(i))) { + free(args); cut_fail(); } - cut_succeed(); + det = true; } LOCK(GLOBAL_Stream[i].streamlock); rc = do_stream_property(i, args PASS_REGS); UNLOCK(GLOBAL_Stream[i].streamlock); - if (IsVarTerm(t1)) { + if (!det && IsVarTerm(t1)) { if (rc) rc = Yap_unify(ARG1, Yap_MkStream(i)); if (p == STREAM_PROPERTY_END) { @@ -743,7 +744,7 @@ static Int cont_stream_property(USES_REGS1) { /* current_stream */ } } else { // done - det = (p == STREAM_PROPERTY_END); + det = det || (p == STREAM_PROPERTY_END); } free(args); if (rc) { diff --git a/pl/consult.yap b/pl/consult.yap index dc7c8ff6e..c00331f1d 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -220,10 +220,10 @@ SWI-compatible option where if _Autoload_ is `true` undefined % compilation_mode(compact,source,assert_all) => implemented % register(true, false) => implemented % -load_files(Files,Opts) :- - once( '$load_files'(Files,Opts,load_files(Files,Opts)) ), - fail. -load_files(_Files,_Opts). +load_files(Files0,Opts) :- + '$yap_strip_module'(Files0,M,Files), + '$load_files'(Files,M,Opts,M:load_files(Files,Opts)). + '$lf_option'(autoload, 1, false). '$lf_option'(derived_from, 2, false). @@ -234,7 +234,14 @@ load_files(_Files,_Opts). '$lf_option'(qcompile, 7, Current) :- '__NB_getval__'('$qcompile', Current, Current = never). '$lf_option'(silent, 8, _). -'$lf_option'(skip_unix_header, 9, true). +'$lf_option'(skip_unix_header, 9, Skip) :- + stream_property(Stream,[alias(loop_stream),tty(TTy),reposition(Rep)]), + ( Rep == true + -> + (TTy = true -> Skip = false ; Skip = true) + ; + Skip = false + ). '$lf_option'(compilation_mode, 10, Flag) :- current_prolog_flag(source, YFlag), ( YFlag == false -> Flag = compact ; Flag = source ). @@ -273,17 +280,43 @@ load_files(_Files,_Opts). '$lf_option'(Op, Id, _), setarg( Id, TOpts, Val ). -'$load_files'(Files, Opts, Call) :- +'$load_files'([user], M,Opts, Call) :- + current_input(S), + '$load_files__'(user, M, [stream(S)|Opts], Call). +'$load_files'(user, M,Opts, Call) :- + current_input(S), + '$load_files__'(user, M, [stream(S)|Opts], Call). +'$load_files'([-user], M,Opts, Call) :- + current_input(S), + '$load_files__'(user, M, [consult(reconsult),stream(S)|Opts], Call). +'$load_files'(-user, M,Opts, Call) :- + current_input(S), + '$load_files__'(user, M, [consult(reconsult),stream(S)|Opts], Call). +'$load_files'([user_input], M,Opts, Call) :- + current_input(S), + '$load_files__'(user_input, M, [stream(S)|Opts], Call). +'$load_files'(user_input, M,Opts, Call) :- + current_input(S), + '$load_files__'(user_input, M, [stream(S)|Opts], Call). +'$load_files'([-user_input], M,Opts, Call) :- + current_input(S), + '$load_files__'(user_input, M, [consult(reconsult),stream(S)|Opts], Call). +'$load_files'(-user_input, M,Opts, Call) :- + '$load_files__'(user_input, M, [consult(reconsult),stream(S)|Opts], Call). +'$load_files'(Files, M, Opts, Call) :- + '$load_files__'(Files, M, Opts, Call). +'$load_files__'(Files, M, Opts, Call) :- '$lf_option'(last_opt, LastOpt), ( '__NB_getval__'('$lf_status', OldTOpts, fail), nonvar(OldTOpts) -> - '$lf_opt'(autoload, OldTOpts, OldAutoload) + '$lf_opt'(autoload, OldTOpts, OldAutoload), + '$lf_opt'('$context_module', OldTOpts, OldContextModule) ; current_prolog_flag(autoload, OldAutoload), functor( OldTOpts, opt, LastOpt ), '$lf_opt'(autoload, OldTOpts, OldAutoload), - '$lf_opt'('$context_module', OldTOpts, user) + '$lf_opt'('$context_module', OldTOpts, OldContextModule) ), functor( TOpts, opt, LastOpt ), ( source_location(ParentF, Line) -> true ; ParentF = user_input, Line = -1 ), @@ -302,7 +335,6 @@ load_files(_Files,_Opts). ), '$check_use_module'(Call,UseModule), '$lf_opt'('$use_module', TOpts, UseModule), - '$current_module'(M0), ( '$lf_opt'(autoload, TOpts, Autoload), var(Autoload) -> Autoload = OldAutoload @@ -311,7 +343,7 @@ load_files(_Files,_Opts). ), % make sure we can run consult '$init_consult', - '$lf'(Files, M0, Call, TOpts). + '$lf'(Files, M, Call, TOpts). '$check_files'(Files, Call) :- var(Files), !, @@ -433,32 +465,12 @@ load_files(_Files,_Opts). '$lf'(V,_,Call, _ ) :- var(V), !, '$do_error'(instantiation_error,Call). '$lf'([], _, _, _) :- !. -'$lf'(M:X, _, Call, TOpts) :- !, - ( - atom(M) - -> - '$lf'(X, M, Call, TOpts) - ; - '$do_error'(type_error(atom,M),Call) - ). '$lf'([F|Fs], Mod, Call, TOpts) :- !, % clean up after each consult ( '$lf'(F,Mod,Call, TOpts), fail; '$lf'(Fs, Mod, Call, TOpts), fail; true ). -'$lf'(user, Mod, Call, TOpts) :- - !, - stream_property( S, alias( user_input )), - '$set_lf_opt'('$from_stream', TOpts, true), - '$set_lf_opt'( stream , TOpts, S), - '$lf'(S, Mod, Call, TOpts). -'$lf'(user_input, Mod, Call, TOpts ) :- - !, - stream_property( S, alias( user_input )), - '$set_lf_opt'('$from_stream', TOpts, true), - '$set_lf_opt'( stream , TOpts, S), - '$lf'(S, Mod, Call, TOpts). '$lf'(File, Mod, Call, TOpts) :- '$lf_opt'(stream, TOpts, Stream), b_setval('$user_source_file', File), @@ -1104,7 +1116,7 @@ just goes through every loaded file and verifies whether reloading is needed. make :- recorded('$lf_loaded','$lf_loaded'(F1,_M,reconsult,_,_,_,_),_), - '$load_files'(F1, [if(changed)],make), + load_files(F1, [if(changed)]), fail. make. @@ -1265,11 +1277,11 @@ use_module(M,F,Is) :- '$use_module'(M,M1,F,Is) :- nonvar(F), !, ( var(M) -> - '$load_files'(M1:F, [if(not_loaded),must_be_module(true),imports(Is)], use_module(M,F,Is)), + load_files(M1:F, [if(not_loaded),must_be_module(true),imports(Is)]), absolute_file_name( F, F1, [expand(true),file_type(prolog)] ), recorded('$module','$module'(F1,M,_,_,_),_) ; -'$load_files'(M1:F, [if(not_loaded),must_be_module(true),imports(Is)], use_module(M,F,Is)) +load_files(M1:F, [if(not_loaded),must_be_module(true),imports(Is)], use_module(M,F,Is)) ). '$use_module'(M,M1,F,Is) :- nonvar(M), !, @@ -1277,11 +1289,11 @@ use_module(M,F,Is) :- ( recorded('$module','$module'(F0,M,_,_,_),_) -> - '$load_files'(M1:F0, [if(not_loaded),must_be_module(true),imports(Is)], use_module(M,F,Is)) + load_files(M1:F0, [if(not_loaded),must_be_module(true),imports(Is)]) ; nonvar(F0) -> - '$load_files'(M1:F, [if(not_loaded),must_be_module(true),imports(Is)], use_module(M,F,Is)) + load_files(M1:F, [if(not_loaded),must_be_module(true),imports(Is)]) ; '$do_error'(instantiation_error,use_module(M,F,Is)) ). diff --git a/pl/directives.yap b/pl/directives.yap index 877d3542f..38540758b 100644 --- a/pl/directives.yap +++ b/pl/directives.yap @@ -45,7 +45,6 @@ '$include'/2, '$initialization'/1, '$initialization'/2, - '$load_files'/3, '$require'/2, '$set_encoding'/1, '$use_module'/3]). diff --git a/pl/hacks.yap b/pl/hacks.yap index 0b0c299cd..62692dbed 100644 --- a/pl/hacks.yap +++ b/pl/hacks.yap @@ -232,9 +232,9 @@ beautify_hidden_goal('$process_directive'(Gs,_Mode,_VL),prolog) --> [(:- Gs)]. beautify_hidden_goal('$loop'(Stream,Option),prolog) --> [execute_load_file(Stream, consult=Option)]. -beautify_hidden_goal('$load_files'(Files,Opts,?),prolog) --> - [load_files(Files,Opts)]. -beautify_hidden_goal('$load_files'(_,_,Name),prolog) --> +beautify_hidden_goal('$load_files'(Files,M,Opts,?),prolog) --> + [load_files(M:Files,Opts)]. +beautify_hidden_goal('$load_files'(_,_,_,Name),prolog) --> [Name]. beautify_hidden_goal('$reconsult'(Files,Mod),prolog) --> [reconsult(Mod:Files)]. diff --git a/pl/init.yap b/pl/init.yap index b110ba974..330bc76c4 100644 --- a/pl/init.yap +++ b/pl/init.yap @@ -40,8 +40,13 @@ nb_setval('$initialization_goals',off), nb_setval('$included_file',[]), nb_setval('$loop_streams',[]), - \+ '$undefined'('$init_preds',prolog), - '$init_preds'. + ( + '$undefined'('$init_preds',prolog) + -> + true + ; + '$init_preds' + ). '$init_win_graphics' :- '$undefined'(window_title(_,_), system), !. diff --git a/pl/modules.yap b/pl/modules.yap index 5747add74..6aba25b45 100644 --- a/pl/modules.yap +++ b/pl/modules.yap @@ -201,8 +201,8 @@ The state of the module system after this error is undefined. **/ -use_module(F) :- '$load_files'(F, - [if(not_loaded),must_be_module(true)], use_module(F)). +use_module(F) :- load_files(F, + [if(not_loaded),must_be_module(true)]). /** @@ -235,7 +235,7 @@ Unfortunately it is still not possible to change argument order. **/ use_module(F,Is) :- - '$load_files'(F, [if(not_loaded),must_be_module(true),imports(Is)], use_module(F,Is)). + load_files(F, [if(not_loaded),must_be_module(true),imports(Is)]). '$module'(O,N,P,Opts) :- !, '$module'(O,N,P),