From 8b06ce9fe4010df7e911071c85ea28b972ddc635 Mon Sep 17 00:00:00 2001 From: vsc Date: Wed, 19 Oct 2005 01:47:43 +0000 Subject: [PATCH] make consult even load_files/2 define bootstrap/1 for initial consult git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1403 b08c6af1-5177-4d33-ba66-4b1c6b8b522a --- C/sysbits.c | 73 +++++++++++++++++++++++++++++++---------------- Makefile.in | 2 +- pl/boot.yap | 55 +++++------------------------------ pl/consult.yap | 44 +++++++++++++++++++++++----- pl/directives.yap | 2 +- pl/init.yap | 9 +++--- pl/protect.yap | 3 ++ pl/utils.yap | 3 -- 8 files changed, 103 insertions(+), 88 deletions(-) diff --git a/C/sysbits.c b/C/sysbits.c index 926b47a3e..55e9bec95 100644 --- a/C/sysbits.c +++ b/C/sysbits.c @@ -1614,10 +1614,10 @@ TrueFileName (char *source, char *result, int in_lib) strncpy(ares1,yap_pwd,YAP_FILENAME_MAX); #elif HAVE_GETCWD if (getcwd (ares1, YAP_FILENAME_MAX) == NULL) - return (FALSE); + return FALSE; #else if (getwd (ares1) == NULL) - return (FALSE); + return FALSE; #endif #if _MSC_VER || defined(__MINGW32__) strncat (ares1, "\\", YAP_FILENAME_MAX); @@ -1709,15 +1709,13 @@ p_getcwd(void) strncpy(Yap_FileNameBuf,yap_pwd,YAP_FILENAME_MAX); #elif HAVE_GETCWD if (getcwd (Yap_FileNameBuf, YAP_FILENAME_MAX) == NULL) - return (FALSE); + return FALSE; #else if (getwd (Yap_FileNameBuf) == NULL) - return (FALSE); + return FALSE; #endif - t = Yap_StringToList(Yap_FileNameBuf); - return(Yap_unify(ARG1,t)); - + return Yap_unify(ARG1,t); } /* Executes $SHELL under Prolog */ @@ -1885,19 +1883,51 @@ p_mv (void) } +/* find the directory info from a file name */ +static Int +p_file_directory_name (void) +{ + Term t1 = Deref(ARG1); + char *chp; + + if (IsVarTerm(t1)) { + Yap_Error(INSTANTIATION_ERROR, t1, "first arg of file_directory_name/2"); + return FALSE; + } + if (!IsAtomTerm(t1)) { + Yap_Error(TYPE_ERROR_ATOM, t1, "first arg of file_directory_name/2"); + return FALSE; + } + TrueFileName (RepAtom(AtomOfTerm(t1))->StrOfAE, Yap_FileNameBuf, FALSE); + chp = Yap_FileNameBuf+strlen(Yap_FileNameBuf); + while (!dir_separator(*--chp) && chp != Yap_FileNameBuf); + if (chp == Yap_FileNameBuf) { + return Yap_unify(MkAtomTerm(Yap_LookupAtom(".")),ARG2); + } + *chp = '\0'; + return Yap_unify(MkAtomTerm(Yap_LookupAtom(Yap_FileNameBuf)),ARG2); +} + /* Change the working directory */ static Int p_cd (void) { /* cd(+NewD) */ -#if HAVE_CHDIR Term t1 = Deref (ARG1); - if (t1 == TermNil) - return(TRUE); - if (!Yap_GetName (Yap_FileNameBuf, YAP_FILENAME_MAX, t1)) { - Yap_Error(SYSTEM_ERROR,t1,"argument to cd/1 is not valid"); - return(FALSE); + + if (IsVarTerm(t1)) { + return FALSE; + } else if (IsAtomTerm(t1)) { + TrueFileName (RepAtom(AtomOfTerm(t1))->StrOfAE, Yap_FileNameBuf2, FALSE); + } else { + if (t1 == TermNil) + return TRUE; + if (!Yap_GetName (Yap_FileNameBuf, YAP_FILENAME_MAX, t1)) { + Yap_Error(SYSTEM_ERROR,t1,"argument to cd/1 is not valid"); + return FALSE; + } + TrueFileName (Yap_FileNameBuf, Yap_FileNameBuf2, FALSE); } - TrueFileName (Yap_FileNameBuf, Yap_FileNameBuf2, FALSE); +#if HAVE_CHDIR #if __simplescalar__ strncpy(yap_pwd,Yap_FileNameBuf2,YAP_FILENAME_MAX); #endif @@ -1908,21 +1938,15 @@ p_cd (void) #else Yap_Error(SYSTEM_ERROR,t1,"cd(%s)", Yap_FileNameBuf2); #endif - return(FALSE); + return FALSE; } - return(TRUE); + return TRUE; #else #ifdef MACYAP - Term t1 = Deref (ARG1); - if (!Yap_GetName (Yap_FileNameBuf, YAP_FILENAME_MAX, t1)) { - Yap_Error(SYSTEM_ERROR,t1,"argument to cd/1 is not valid"); - return(FALSE); - } - TrueFileName (Yap_FileNameBuf, Yap_FileNameBuf2, FALSE); return (!chdir (Yap_FileNameBuf2)); #else Yap_Error(SYSTEM_ERROR,TermNil,"cd/1 not available in this machine"); - return(FALSE); + return FALSE; #endif #endif } @@ -2398,7 +2422,7 @@ Yap_InitSysPreds(void) Yap_InitCPred ("$shell", 1, p_shell, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$system", 1, p_system, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$rename", 2, p_mv, SafePredFlag|SyncPredFlag|HiddenPredFlag); - Yap_InitCPred ("$cd", 1, p_cd, SafePredFlag|SyncPredFlag|HiddenPredFlag); + Yap_InitCPred ("cd", 1, p_cd, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$yap_home", 1, p_yap_home, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$getcwd", 1, p_getcwd, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$dir_separator", 1, p_dir_sp, SafePredFlag|HiddenPredFlag); @@ -2410,6 +2434,7 @@ Yap_InitSysPreds(void) Yap_InitCPred ("$first_signal", 1, p_first_signal, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$host_type", 1, p_host_type, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$continue_signals", 0, p_continue_signals, SafePredFlag|SyncPredFlag|HiddenPredFlag); + Yap_InitCPred ("file_directory_name", 2, p_file_directory_name, SafePredFlag); } diff --git a/Makefile.in b/Makefile.in index e8471d340..59f6debac 100644 --- a/Makefile.in +++ b/Makefile.in @@ -473,7 +473,7 @@ all: startup startup: yap@EXEC_SUFFIX@ $(PL_SOURCES) -rm -f startup - echo "['$(srcdir)/pl/init.yap']. module(user). save_program(startup)." | @CROSS_SIMULATOR@ ./yap -b $(srcdir)/pl/boot.yap + echo "bootstrap('$(srcdir)/pl/init.yap'). module(user). save_program(startup)." | @CROSS_SIMULATOR@ ./yap -b $(srcdir)/pl/boot.yap yap@EXEC_SUFFIX@: $(HEADERS) yap.o @YAPLIB@ $(MPI_CC) $(STANDARD_CFLAGS) $(LDFLAGS) -o yap yap.o @YAPLIB@ $(LIBS) @MPI_LIBS@ diff --git a/pl/boot.yap b/pl/boot.yap index c2a81ae68..e8db88373 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -791,30 +791,18 @@ break :- set_value('$break',BL). -'$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). - -'$bconsult'(F,Mod,Stream) :- - '$current_module'(OldModule, Mod), - '$getcwd'(OldD), - get_value('$consulting_file',OldF), - '$set_consulting_file'(Stream), +bootstrap(F) :- + '$open'(F,'$csult',Stream,0), H0 is heapused, '$cputime'(T0,_), '$current_stream'(File,_,Stream), - '$start_consult'(consult,File,LC), - get_value('$consulting',Old), - set_value('$consulting',true), + '$start_consult'(consult, File, LC), + file_directory_name(File, Dir), + '$getcwd'(OldD), + cd(Dir), format(user_error, '~*|% consulting ~w...~n', [LC,F]), '$loop'(Stream,consult), + cd(OldD), '$end_consult', - set_value('$consulting',Old), - set_value('$consulting_file',OldF), - '$current_module'(NewMod,OldModule), - '$cd'(OldD), - ( LC == 0 -> prompt(_,' |: ') ; true), H is heapused-H0, '$cputime'(TF,_), T is TF-T0, format(user_error, '~*|% ~w consulted ~w bytes in ~d msecs~n', [LC,F,H,T]), !. @@ -831,35 +819,6 @@ break :- fail. '$record_loaded'(_, _). -'$set_consulting_file'(user) :- !, - set_value('$consulting_file',user_input). -'$set_consulting_file'(user_input) :- !, - set_value('$consulting_file',user_input). -'$set_consulting_file'(Stream) :- - '$file_name'(Stream,F), - set_value('$consulting_file',F), - '$set_consulting_dir'(F). - -% -% Use directory where file exists -% -'$set_consulting_dir'(F) :- - atom_codes(F,S), - '$strip_file_for_scd'(S,Dir,Unsure,Unsure), - '$cd'(Dir). - -% -% The algorithm: I have two states, one for what I am sure will be an answer, -% the other for what I have found so far. -% -'$strip_file_for_scd'([], [], _, _). -'$strip_file_for_scd'([D|L], Out, Out, Cont) :- - '$dir_separator'(D), !, - '$strip_file_for_scd'(L, Cont, [D|C2], C2). -'$strip_file_for_scd'([F|L], Out, Cont, [F|C2]) :- - '$strip_file_for_scd'(L, Out, Cont, C2). - - '$loop'(Stream,Status) :- '$change_alias_to_stream'('$loop_stream',Stream), repeat, diff --git a/pl/consult.yap b/pl/consult.yap index b83006657..4657a0693 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -121,8 +121,9 @@ load_files(Files,Opts) :- '$do_lf'(X, Mod, Stream, InfLevel, CompilationMode, Imports, Reconsult). '$close_lf'(Silent) :- - nonvar(Silent), + nonvar(Silent), !, set_value('$lf_verbose',Silent). +'$close_lf'(_). ensure_looaded(Fs) :- '$load_files'(Fs, [if(changed)],ensure_loaded(Fs)). @@ -147,7 +148,7 @@ consult(Fs) :- !, '$load_files'(Module:Fs,[],Fs). '$consult'(Fs, Module) :- var(V), !, - '$load_files'(Module:Fs,[reconsult(consult)],Fs). + '$load_files'(Module:Fs,[consult(consult)],Fs). reconsult(Fs) :- '$load_files'(Fs, [], reconsult(Fs)). @@ -161,6 +162,12 @@ use_module(F,Is) :- use_module(M,F,Is) :- '$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). + '$do_lf'(F, ContextModule, Stream, InfLevel, _, Imports, Reconsult) :- '$record_loaded'(Stream, M), '$current_module'(OldModule,ContextModule), @@ -168,13 +175,13 @@ use_module(M,F,Is) :- get_value('$consulting_file',OldF), '$set_consulting_file'(Stream), H0 is heapused, '$cputime'(T0,_), - current_stream(File,_,Stream), + '$current_stream'(File,_,Stream), get_value('$consulting',Old), set_value('$consulting',false), '$consult_infolevel'(InfLevel), recorda('$initialisation','$',_), ( Reconsult = reconsult -> - '$start_reconsulting'(F) + '$start_reconsulting'(F), '$start_consult'(Reconsult,File,LC), '$remove_multifile_clauses'(File), StartMsg = reconsulting, @@ -186,13 +193,18 @@ use_module(M,F,Is) :- ), '$print_message'(InfLevel, loading(StartMsg, File)), ( recorded('$trace', on, TraceR) -> erase(TraceR) ; true), - '$loop'(Stream,reconsult), + '$loop'(Stream,Reconsult), '$end_consult', ( nonvar(TraceR) -> recorda('$trace', on, _) ; true), - '$clear_reconsulting', + ( + Reconsult = reconsult -> + '$clear_reconsulting' + ; + true + ), set_value('$consulting',Old), set_value('$consulting_file',OldF), - '$cd'(OldD), + cd(OldD), '$current_module'(Mod,OldModule), '$import_to_current_module'(File, ContextModule, Imports), ( LC == 0 -> prompt(_,' |: ') ; true), @@ -398,3 +410,21 @@ remove_from_path(New) :- '$check_path'(New,Path), fail. '$remove_multifile_clauses'(_). +'$set_consulting_file'(user) :- !, + set_value('$consulting_file',user_input). +'$set_consulting_file'(user_input) :- !, + set_value('$consulting_file',user_input). +'$set_consulting_file'(Stream) :- + '$file_name'(Stream,F), + set_value('$consulting_file',F), + '$set_consulting_dir'(F). + +% +% Use directory where file exists +% +'$set_consulting_dir'(F) :- + file_directory_name(F, Dir), + cd(Dir). + + + diff --git a/pl/directives.yap b/pl/directives.yap index 171f4d140..7ec5b4662 100644 --- a/pl/directives.yap +++ b/pl/directives.yap @@ -94,7 +94,7 @@ char_conversion(IN,OUT). '$exec_directive'(public(P), _, M) :- '$public'(P, M). -'$exec_directive'(compile(F), _, M) :- +'$exec_directive'(compile(Fs), _, M) :- '$load_files'(M:Fs, [], compile(Fs)). '$exec_directive'(reconsult(Fs), _, M) :- '$load_files'(M:Fs, [], reconsult(Fs)). diff --git a/pl/init.yap b/pl/init.yap index 73b115d0a..110dc6a88 100644 --- a/pl/init.yap +++ b/pl/init.yap @@ -40,8 +40,10 @@ otherwise. % force having indexing code for throw. :- '$handle_throw'(_,_,_), !. -:- ['errors.yap', - 'utils.yap', +:- bootstrap('errors.yap'). +:- bootstrap('consult.yap'). + +:- [ 'utils.yap', 'arith.yap', 'directives.yap']. @@ -49,7 +51,6 @@ otherwise. :- [ 'yio.yap', 'debug.yap', - 'consult.yap', 'checker.yap', 'depth_bound.yap', 'grammar.yap', @@ -108,7 +109,7 @@ system_mode(verbose,off) :- set_value('$verbose',off). % :- yap_flag(gc_trace,verbose). -:- initialization((system_mode(verbose,on),module(user))). +:- system_mode(verbose,on). :- module(user). diff --git a/pl/protect.yap b/pl/protect.yap index d3a35b186..df6806a35 100644 --- a/pl/protect.yap +++ b/pl/protect.yap @@ -22,6 +22,9 @@ atom_codes(Name,[0'$|_]), '$hide_predicates'(Name), '$hide'(Name). +'$protect' :- + '$hide_predicates'(bootstrap), + '$hide'(bootstrap). '$protect'. '$hide_predicates'(Name) :- diff --git a/pl/utils.yap b/pl/utils.yap index d211f7879..714c6dac7 100644 --- a/pl/utils.yap +++ b/pl/utils.yap @@ -180,9 +180,6 @@ op(P,T,V) :- '$op2'(P,T,V). %%% Operating System utilities -cd(A) :- atom(A), !, atom_codes(A,S), '$cd'(S). -cd(S) :- '$cd'(S). - getcwd(D) :- '$getcwd'(SD), atom_codes(D, SD). system(A) :- atom(A), !, atom_codes(A,S), '$system'(S).