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
2005-10-19 01:47:43 +00:00 · 2005-10-19 01:47:43 +00:00 · 8b06ce9fe4
commit 8b06ce9fe4
parent e6a15addf5
8 changed files with 103 additions and 88 deletions
--- 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);
 }


--- 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@
--- 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,
--- 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).
+
+	
+
--- 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)).
--- 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).

--- 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) :-
--- 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).