more fixes

C/iopreds.c

@@ -118,7 +118,7 @@ Yap_InitPlIO (void)
  */
 static int newline = TRUE;
 
-#if DEBUG
+#if DEBUG_YAP
 
 static       int   eolflg = 1;
 
@@ -1088,7 +1088,7 @@ Yap_InitBackIO (void)
 {
 }
 
-#if DEBUG
+#if DEBUG_YAP
 static Int
 p_write_string( USES_REGS1 )
 {
@@ -1116,7 +1116,7 @@ Yap_InitIOPreds(void)
   Yap_InitCPred ("$get_read_error_handler", 1, p_get_read_error_handler, SafePredFlag|SyncPredFlag);
   Yap_InitCPred ("$read", 7, p_read, SyncPredFlag|UserCPredFlag);
   Yap_InitCPred ("$read", 8, p_read2, SyncPredFlag|UserCPredFlag);
-#if DEBUG
+#if DEBUG_YAP
   Yap_InitCPred ("write_string", 2, p_write_string, SyncPredFlag|UserCPredFlag);
 #endif
   Yap_InitCPred ("$start_line", 1, p_startline, SafePredFlag|SyncPredFlag);

C/pl-yap.c

@@ -1333,6 +1333,85 @@ accessLevel(void)
   return NULL_ATOM;
 }
 
+#define SKIP_VERY_DEEP	  1000000000L
+#define SKIP_REDO_IN_SKIP (SKIP_VERY_DEEP-1)
+
+#define WFG_TRACE       0x01000
+#define WFG_TRACING     0x02000
+#define WFG_BACKTRACE   0x04000
+#define WFG_CHOICE      0x08000
+
+#define TRACE_FIND_NONE 0
+#define TRACE_FIND_ANY  1
+#define TRACE_FIND_NAME 2
+#define TRACE_FIND_TERM 3
+
+typedef struct find_data_tag
+{ int    port;                          /* Port to find */
+  bool   searching;                     /* Currently searching? */
+  int    type;                          /* TRACE_FIND_* */
+  union
+  { atom_t      name;                   /* Name of goal to find */
+    struct
+    { functor_t functor;                /* functor of the goal */
+      Record    term;                   /* Goal to find */
+    } term;
+  } goal;
+} find_data;
+
+
+int
+tracemode(debug_type doit, debug_type *old)
+{ GET_LD
+
+  if ( doit )
+  { debugmode(DBG_ON, NULL);
+    doit = TRUE;
+  }
+
+  if ( old )
+    *old = debugstatus.tracing;
+
+  if ( debugstatus.tracing != doit )
+  { debugstatus.tracing = doit;
+    printMessage(ATOM_silent,
+                 PL_FUNCTOR_CHARS, "trace_mode", 1,
+                   PL_ATOM, doit ? ATOM_on : ATOM_off);
+  }
+  if ( doit )                           /* make sure trace works inside skip */
+  { debugstatus.skiplevel = SKIP_VERY_DEEP;
+    if ( LD->trace.find )
+      LD->trace.find->searching = FALSE;
+  }
+
+  succeed;
+}
+
+
+int
+debugmode(debug_type doit, debug_type *old)
+{ GET_LD
+
+  if ( old )
+    *old = debugstatus.debugging;
+
+  if ( debugstatus.debugging != doit )
+  { if ( doit )
+    { debugstatus.skiplevel = SKIP_VERY_DEEP;
+      if ( doit == DBG_ALL )
+      { doit = DBG_ON;
+      }
+    }
+    debugstatus.debugging = doit;
+    printMessage(ATOM_silent,
+                 PL_FUNCTOR_CHARS, "debug_mode", 1,
+                   PL_ATOM, doit ? ATOM_on : ATOM_off);
+  }
+
+  succeed;
+}
+
+
 int
 getAccessLevelMask(atom_t a, access_level_t *val)
 { if ( a == ATOM_user )

H/Yap.h

@@ -365,33 +365,6 @@ typedef enum
 #define QUINTUS_TO_CHARS	0
 #define ISO_TO_CHARS		1
 
-#define CPROLOG_CHARACTER_ESCAPES		0
-#define ISO_CHARACTER_ESCAPES			1
-#define SICSTUS_CHARACTER_ESCAPES		2
-
-// SWI Stuff
-typedef enum
-  { DBG_OFF = 0,                          /* no debugging */
-    DBG_ON,                               /* switch on in current environment */
-    DBG_ALL                               /* switch on globally */
-  } debug_type;
-
-typedef int bool;
-
-typedef struct debuginfo
-{ size_t        skiplevel;              /* current skip level */
-  bool          tracing;                /* are we tracing? */
-  debug_type    debugging;              /* are we debugging? */
-  int           leashing;               /* ports we are leashing */
-  int           visible;                /* ports that are visible */
-  bool          showContext;            /* tracer shows context module */
-  int           styleCheck;             /* source style checking */
-  int           suspendTrace;           /* tracing is suspended now */
-  //LocalFrame    retryFrame;             /* Frame to retry */
-} pl_debugstatus_t;
-// over SWI
-
-
 typedef enum
 {
   INDEX_MODE_OFF = 0,

H/dlocals.h

@@ -412,8 +412,6 @@
 
 #define LOCAL_search_atoms LOCAL->search_atoms_
 #define REMOTE_search_atoms(wid) REMOTE(wid)->search_atoms_
-#define LOCAL_debugstatus LOCAL->debugstatus_
-#define REMOTE_debugstatus(wid) REMOTE(wid)->debugstatus_
 #define LOCAL_SourceModule LOCAL->SourceModule_
 #define REMOTE_SourceModule(wid) REMOTE(wid)->SourceModule_
 

H/hlocals.h

@@ -232,6 +232,5 @@ typedef struct worker_local {
   UInt  exo_arg_;
 
   struct scan_atoms*  search_atoms_;
-  pl_debugstatus_t  debugstatus_;
   Term  SourceModule_;
 } w_local;

H/ilocals.h

@@ -232,6 +232,5 @@ static void InitWorker(int wid) {
   REMOTE_exo_arg(wid) = 0;
 
 
-
   REMOTE_SourceModule(wid) = 0;
 }

H/pl-global.h

@@ -1,3 +1,25 @@
+
+typedef enum
+  { DBG_OFF = 0,                          /* no debugging */
+    DBG_ON,                               /* switch on in current environment */
+    DBG_ALL                               /* switch on globally */
+  } debug_type;
+
+typedef struct debuginfo
+{ size_t        skiplevel;              /* current skip level */
+  bool          tracing;                /* are we tracing? */
+  debug_type    debugging;              /* are we debugging? */
+  int           leashing;               /* ports we are leashing */
+  int           visible;                /* ports that are visible */
+  bool          showContext;            /* tracer shows context module */
+  int           styleCheck;             /* source style checking */
+  int           suspendTrace;           /* tracing is suspended now */
+  //LocalFrame    retryFrame;             /* Frame to retry */
+} pl_debugstatus_t;
+
+
+typedef struct find_data_tag *  FindData;       /* pl-trace.c */
+
 typedef enum
 { LDATA_IDLE = 0,
   LDATA_SIGNALLED,
@@ -319,6 +341,12 @@ typedef struct PL_local_data {
   } exception;
   const char   *float_format;		/* floating point format */
 
+  struct
+  { FindData    find;                   /* /<ports> <goal> in tracer */
+  } trace;
+
+  pl_debugstatus_t _debugstatus;        /* status of the debugger */
+
 #ifdef O_PLMT
   struct
   { //intptr_t   magic;			/* PL_THREAD_MAGIC (checking) */
@@ -375,3 +403,4 @@ extern PL_local_data_t lds;
 #define source_line_pos		(LD->read_source.linepos)
 #define source_char_no		(LD->read_source.character)
 
+#define debugstatus		(LD->_debugstatus)

H/pl-incl.h

@@ -1,4 +1,8 @@
 
+#ifndef PL_INCL_H
+
+#define PL_INCL_H 1
+
 #include "config.h"
 
 #if USE_GMP
@@ -47,8 +51,6 @@
 
 #define SWIP "swi_"
 
-#include "pl-shared.h"
-
 /* try not to pollute the SWI space */
 #ifdef P
 #undef P
@@ -89,6 +91,8 @@ typedef int bool;
 typedef int			Char;		/* char that can pass EOF */
 typedef uintptr_t		word;		/* Anonymous 4 byte object */
 
+#include "pl-shared.h"
+
 #if SIZE_DOUBLE==SIZEOF_INT_P
 #define WORDS_PER_DOUBLE 1
 #else
@@ -186,6 +190,8 @@ typedef enum
 #endif
 typedef uintptr_t	PL_atomic_t;	/* same size as a word */
 
+typedef struct record *		Record;	
+
 #define MAXSIGNAL	64
 
 #define SIG_PROLOG_OFFSET	32	/* Start of Prolog signals */
@@ -839,3 +845,6 @@ extern const PL_extension PL_predicates_from_write[];
 extern const PL_extension PL_predicates_from_prologflag[];
 extern const PL_extension PL_predicates_from_win[];
 
+#define enableThreads(val) FALSE
+
+#endif

H/pl-shared.h

@@ -16,14 +16,17 @@
 typedef	uintptr_t    term_t;
 #endif
 
-#ifndef _FLI_H_INCLUDED
+#if  !defined(_FLI_H_INCLUDED) && !defined(PL_INCL_H)
 
 #ifdef __WINDOWS__
 #include <windows.h>
 #include <windows/uxnt.h>
 #endif
 
-typedef	void *record_t;
+typedef int	bool;
+
+
+typedef	DBTerm *record_t;
 typedef struct mod_entry *module_t;
 typedef uintptr_t	atom_t;
 
@@ -156,6 +159,7 @@ typedef struct initialise_handle * InitialiseHandle;
 #define clear(s, a)		((s)->flags &= ~(a))
 #ifdef  DEBUG
 /* should have messages here */
+#define DEBUG_YAP 1
 #undef DEBUG
 #define DEBUG(LEVEL, COMMAND)
 #else
@@ -203,10 +207,11 @@ typedef struct initialise_handle * InitialiseHandle;
 extern unsigned int
 getUnknownModule(module_t m);
 
-#define debugstatus LOCAL_debugstatus        /* status of the debugger */
-
 #define truePrologFlag(flag)      true(&LD->prolog_flag.mask, flag)
 #define setPrologFlagMask(flag)   set(&LD->prolog_flag.mask, flag)
 #define clearPrologFlagMask(flag) clear(&LD->prolog_flag.mask, flag)
 
+COMMON(int)		debugmode(debug_type new, debug_type *old);
+COMMON(int)		tracemode(debug_type new, debug_type *old);
+
 #endif /* PL_SHARED_INCLUDE */

H/rlocals.h

@@ -231,7 +231,6 @@ static void RestoreWorker(int wid USES_REGS) {
 
 
 
-
 
 
 }

misc/LOCALS

@@ -265,8 +265,6 @@ UInt				exo_arg					=0
 // atom completion
 struct scan_atoms*		search_atoms				void
 
-pl_debugstatus_t		debugstatus				void
-
 Term				SourceModule				=0
 
 END_WORKER_LOCAL

os/pl-prologflag.c

@@ -568,7 +568,6 @@ set_prolog_flag_unlocked(term_t key, term_t value, int flags)
 	else
 	  clearPrologFlagMask(mask);
       }
-#ifndef __YAP_PROLOG__
       if ( k == ATOM_character_escapes )
       { if ( val )
 	  set(m, M_CHARESCAPE);
@@ -589,7 +588,6 @@ set_prolog_flag_unlocked(term_t key, term_t value, int flags)
 	  break;			/* don't change value */
 #endif
       }
-#endif /* __YAP_PROLOG__ */
 
 					/* set the flag value */
       f->value.a = (val ? ATOM_true : ATOM_false);

pl/absf.yap

@@ -0,0 +1,326 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 							 *
+*									 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		consult.yap						 *
+* Last rev:	8/2/88							 *
+* mods:									 *
+* comments:	Consulting Files in YAP					 *
+*									 *
+*************************************************************************/
+
+absolute_file_name(V,Out) :- var(V), !,
+	'$do_error'(instantiation_error, absolute_file_name(V, Out)).
+absolute_file_name(user,user) :- !.
+absolute_file_name(File0,File) :-
+	'$absolute_file_name'(File0,[access(none),file_type(txt),file_errors(fail),solutions(first)],File,absolute_file_name(File0,File)).
+
+'$full_filename'(F0,F,G) :-
+	'$absolute_file_name'(F0,[access(read),file_type(source),file_errors(fail),solutions(first),expand(true)],F,G).
+
+% fix wrong argument order, TrueFileName should be last.
+absolute_file_name(File,TrueFileName,Opts) :-
+	( var(TrueFileName) -> true ; atom(TrueFileName), TrueFileName \= [] ),
+	!,
+	absolute_file_name(File,Opts,TrueFileName).
+absolute_file_name(File,Opts,TrueFileName) :-
+	'$absolute_file_name'(File,Opts,TrueFileName,absolute_file_name(File,Opts,TrueFileName)).
+	
+'$absolute_file_name'(File, _Opts, _TrueFileName, G) :- var(File), !,
+	'$do_error'(instantiation_error, G).
+'$absolute_file_name'(File,Opts,TrueFileName, G) :-
+	'$process_fn_opts'(Opts,Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,G),
+	/* our own local findall */
+	nb:nb_queue(Ref),
+	(
+	    '$find_in_path'(File,opts(Extensions,RelTo,Type,Access,FErrors,Expand,Debug),TrueFileName,G),
+	    nb:nb_queue_enqueue(Ref, TrueFileName),
+	    fail
+	; 
+	    nb:nb_queue_close(Ref, FileNames, [])
+	 ),
+	'$absolute_file_names'(Solutions, FileNames, FErrors, TrueFileName, File, G).
+
+'$absolute_file_names'(_Solutions, [], error, _, File, G) :- !,
+	'$do_error'(existence_error(file,File),G).
+'$absolute_file_names'(Solutions, FileNames, _, TrueFileName, _, _) :-
+        lists:member(TrueFileName, FileNames),
+	(Solutions == first -> ! ; true).
+	 
+
+'$process_fn_opts'(V,_,_,_,_,_,_,_,_,G) :- var(V), !,
+	'$do_error'(instantiation_error, G).
+'$process_fn_opts'([],[],_,txt,none,error,first,false,false,_) :- !.
+'$process_fn_opts'([Opt|Opts],Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,G) :- !,
+	'$process_fn_opt'(Opt,Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions0,RelTo0,Type0,Access0,FErrors0,Solutions0,Expand0,Debug0,G),
+	'$process_fn_opts'(Opts,Extensions0,RelTo0,Type0,Access0,FErrors0,Solutions0,Expand0,Debug0,G).
+'$process_fn_opts'(Opts,_Extensions,_RelTo,_Type,_Access,_FErrors,_Solutions,_Expand,_Debug,G) :- !,
+	'$do_error'(type_error(list,Opts),G).
+
+'$process_fn_opt'(Opt,Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,G) :- var(Opt), !,
+	'$do_error'(instantiation_error, G).
+'$process_fn_opt'(extensions(Extensions),Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,_,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,G) :- !,
+	'$check_fn_extensions'(Extensions,G).
+'$process_fn_opt'(relative_to(RelTo),Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,_,Type,Access,FErrors,Solutions,Expand,Debug,G) :- !,
+	'$check_atom'(RelTo,G).
+'$process_fn_opt'(access(Access),Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,RelTo,Type,_,FErrors,Solutions,Expand,Debug,G) :- !,
+	'$check_atom'(Access,G).
+'$process_fn_opt'(file_type(Type),Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,RelTo,_,Access,FErrors,Solutions,Expand,Debug,G) :- !,
+	'$check_fn_type'(Type,G).
+'$process_fn_opt'(file_errors(FErrors),Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,RelTo,Type,Access,_,Solutions,Expand,Debug,G) :- !,
+	'$check_fn_errors'(FErrors,G).
+'$process_fn_opt'(solutions(Solutions),Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,RelTo,Type,Access,FErrors,_,Expand,Debug,G) :- !,
+	'$check_fn_solutions'(Solutions,G).
+'$process_fn_opt'(expand(Expand),Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,RelTo,Type,Access,FErrors,Solutions,_,Debug,G) :- !,
+	'$check_true_false'(Expand,G).
+'$process_fn_opt'(verbose_file_search(Debug),Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,_,G) :- !,
+	'$check_true_false'(Debug,G).
+'$process_fn_opt'(Opt,Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,G) :- !,
+	'$do_error'(domain_error(file_name_option,Opt),G).	
+
+'$check_fn_extensions'(V,G) :- var(V), !,
+	'$do_error'(instantiation_error, G).
+'$check_fn_extensions'([],_) :- !.
+'$check_fn_extensions'([A|L],G) :- !,
+	'$check_atom'(A,G),
+	'$check_fn_extensions'(L,G).
+'$check_fn_extensions'(T,G) :- !,
+	'$do_error'(type_error(list,T),G).
+
+'$check_atom'(V,G) :- var(V), !,
+	'$do_error'(instantiation_error, G).
+'$check_atom'(A,_G) :- atom(A), !.
+'$check_atom'(T,G) :- !,
+	'$do_error'(type_error(atom,T),G).
+	
+'$check_fn_type'(V,G) :- var(V), !,
+	'$do_error'(instantiation_error, G).
+'$check_fn_type'(txt,_) :- !.
+'$check_fn_type'(prolog,_) :- !.
+'$check_fn_type'(source,_) :- !.
+'$check_fn_type'(executable,_) :- !.
+'$check_fn_type'(qlf,_) :- !.
+'$check_fn_type'(directory,_) :- !.
+'$check_fn_type'(T,G) :- atom(T), !,
+	'$do_error'(domain_error(file_type,T),G).
+'$check_fn_type'(T,G) :- !,
+	'$do_error'(type_error(atom,T),G).
+	
+'$check_fn_errors'(V,G) :- var(V), !,
+	'$do_error'(instantiation_error, G).
+'$check_fn_errors'(fail,_) :- !.
+'$check_fn_errors'(error,_) :- !.
+'$check_fn_errors'(T,G) :- atom(T), !,
+	'$do_error'(domain_error(file_errors,T),G).
+'$check_fn_errors'(T,G) :- !,
+	'$do_error'(type_error(atom,T),G).
+	
+'$check_fn_solutions'(V,G) :- var(V), !,
+	'$do_error'(instantiation_error, G).
+'$check_fn_solutions'(first,_) :- !.
+'$check_fn_solutions'(all,_) :- !.
+'$check_fn_solutions'(T,G) :- atom(T), !,
+	'$do_error'(domain_error(solutions,T),G).
+'$check_fn_solutions'(T,G) :- !,
+	'$do_error'(type_error(atom,T),G).
+	
+'$check_true_false'(V,G) :- var(V), !,
+	'$do_error'(instantiation_error, G).
+'$check_true_false'(true,_) :- !.
+'$check_true_false'(false,_) :- !.
+'$check_true_false'(T,G) :- atom(T), !,
+	'$do_error'(domain_error(boolean,T),G).
+'$check_true_false'(T,G) :- !,
+	'$do_error'(type_error(atom,T),G).
+	
+% This sequence must be followed:
+% user and user_input are special;
+% library(F) must check library_directories
+% T(F) must check file_search_path
+% all must try search in path
+'$find_in_path'(user,_,user_input, _) :- !.
+'$find_in_path'(user_input,_,user_input, _) :- !.
+'$find_in_path'(commons(D),_,_, _) :-
+	% make sure library_directory is open.
+	\+ clause(user:commons_directory(_),_),
+	'$system_commons_directories'(D),
+	assert(user:commons_directory(D)),
+	fail.
+'$find_in_path'(S, Opts, NewFile, Call) :-
+	S =.. [Name,File0],
+	'$cat_file_name'(File0,File1), !,
+	'$expand_file_name'(File1, File),
+	'$dir_separator'(D),
+	atom_codes(A,[D]),
+	'$extend_path_directory'(Name, A, File, Opts, NewFile, Call).
+'$find_in_path'(File0,Opts,NewFile,_) :-
+	'$cat_file_name'(File0,File1), !,
+	'$expand_file_name'(File1, File),
+	'$add_path'(File,PFile),
+	'$get_abs_file'(PFile,Opts,AbsFile),
+	'$search_in_path'(AbsFile,Opts,NewFile).
+'$find_in_path'(File,_,_,Call) :-
+	'$do_error'(domain_error(source_sink,File),Call).
+
+% allow paths in File Name
+'$cat_file_name'(File0,File) :-
+	atom(File0), !,
+	File = File0.
+'$cat_file_name'(Atoms, File) :-
+	'$to_list_of_atoms'(Atoms, List, []),
+	atom_concat(List, File).
+
+'$to_list_of_atoms'(V, _, _) :- var(V), !, fail.
+'$to_list_of_atoms'(Atom, [Atom|L], L) :- atom(Atom), !.
+'$to_list_of_atoms'(Atoms, L1, LF) :-
+	Atoms =.. [A,As,Bs],
+	atom_codes(A,[D]),
+	'$dir_separator'(D),
+	'$to_list_of_atoms'(As, L1, [A|L2]),
+	'$to_list_of_atoms'(Bs, L2, LF).
+
+'$get_abs_file'(File,opts(_,RelTo,_,_,_,Expand,_),AbsFile) :-
+	(
+	 nonvar(RelTo)
+	->
+	 ( is_absolute_file_name(File) ->
+	   ActualFile = File
+	  ;
+	   '$dir_separator'(D),
+	   atom_codes(DA,[D]),
+	   atom_concat([RelTo, DA, File], ActualFile)
+	  )
+	;
+	  ActualFile = File
+	),
+	'$swi_current_prolog_flag'(file_name_variables, OldF),
+	'$swi_set_prolog_flag'(file_name_variables, Expand),
+	(
+	 '$absolute_file_name'(ActualFile,AbsFile)
+	-> 
+	'$swi_set_prolog_flag'(file_name_variables, OldF)
+	;
+	'$swi_set_prolog_flag'(file_name_variables, OldF),
+	 fail
+	).
+	 
+
+'$search_in_path'(File,opts(Extensions,_,Type,Access,_,_,_),F) :-
+	'$add_extensions'(Extensions, File, F0),
+	'$check_file'(F0, Type, Access, F).
+'$search_in_path'(File,opts(_,_,Type,Access,_,_,_),F) :-
+	'$add_type_extensions'(Type, File, F0),
+	'$check_file'(F0, Type, Access, F).
+
+'$check_file'(F, _Type, none, F) :- !.
+'$check_file'(F0, Type, Access, F0) :-
+	access_file(F0, Access),
+	(Type == directory
+	->
+	 exists_directory(F0)
+	;
+	 true
+	).
+
+'$add_extensions'([Ext|_],File,F) :-
+	'$mk_sure_true_ext'(Ext,NExt),
+	atom_concat([File,NExt],F).
+'$add_extensions'([_|Extensions],File,F) :-
+	'$add_extensions'(Extensions,File,F).
+
+'$mk_sure_true_ext'(Ext,NExt) :-
+	atom_codes(Ext,[C|L]),
+	C \= 0'.,
+	!,
+	atom_codes(NExt,[0'.,C|L]).
+'$mk_sure_true_ext'(Ext,Ext).
+
+'$add_type_extensions'(Type,File,F) :-
+	( Type == source -> NType = prolog ; NType = Type ),
+	user:prolog_file_type(Ext, NType),
+	atom_concat([File,'.',Ext],F).
+'$add_type_extensions'(_,File,File).
+
+'$add_path'(File,File) :-
+	'$dir_separator'(D),
+	atom_codes(DA,[D]),
+	sub_atom(File, 0, 1, _, DA), !.
+'$add_path'(File,File).
+'$add_path'(File,PFile) :-
+	recorded('$path',Path,_),
+	atom_concat([Path,File],PFile).
+
+'$system_library_directories'(Dir) :-
+	getenv('YAPSHAREDIR', Dirs),
+	'$split_by_sep'(0, 0, Dirs, Dir).
+'$system_library_directories'(Dir) :-
+	getenv('YAPCOMMONSDIR', Dirs),
+	'$split_by_sep'(0, 0, Dirs, Dir).
+'$system_library_directories'(Dir) :-
+	get_value(system_library_directory,Dir).
+'$system_library_directories'(Dir) :-
+    get_value(prolog_commons_directory,Dir).
+
+
+'$split_by_sep'(Start, Next, Dirs, Dir) :-
+    '$swi_current_prolog_flag'(windows, true), !,
+    '$split_by_sep'(Start, Next, Dirs, ';', Dir).
+'$split_by_sep'(Start, Next, Dirs, Dir) :-
+    '$split_by_sep'(Start, Next, Dirs, ':', Dir).
+
+'$split_by_sep'(Start, Next, Dirs, Sep, Dir) :-
+    sub_atom(Dirs, Next, 1, _, Let), !,
+    '$continue_split_by_sep'(Let, Start, Next, Dirs, Sep, Dir).
+'$split_by_sep'(Start, Next, Dirs, _Sep, Dir) :-
+    Next > Start,
+    Len is Next-Start,
+    sub_atom(Dirs, Start, Len, _, Dir).
+
+
+% closed a directory
+'$continue_split_by_sep'(Sep, Start, Next, Dirs, Sep, Dir) :-
+    Sz is Next-Start,
+    Sz > 0,
+    sub_atom(Dirs, Start, Sz, _, Dir).
+% next dir
+'$continue_split_by_sep'(Sep , _Start, Next, Dirs, Sep, Dir) :- !,
+    N1 is Next+1,
+    '$split_by_sep'(N1, N1, Dirs, Dir).
+% same dir
+'$continue_split_by_sep'(_Let, Start, Next, Dirs, Sep, Dir) :-
+    N1 is Next+1,
+    '$split_by_sep'(Start, N1, Dirs, Sep, Dir).
+
+
+'$extend_path_directory'(_Name, D, File, _Opts, File, Call) :-
+	is_absolute_file_name(File), !.
+'$extend_path_directory'(Name, D, File, Opts, NewFile, Call) :-
+	user:file_search_path(Name, IDirs),
+        ( atom(IDirs) -> 
+	  '$split_by_sep'(0, 0, IDirs, Dir)
+	;
+	   Dir = IDirs
+	),
+	'$extend_pathd'(Dir, D, File, Opts, NewFile, Call).
+
+'$extend_pathd'(Dir, A, File, Opts, NewFile, Goal) :-
+	atom(Dir), !,
+	'$add_file_to_dir'(Dir,A,File,NFile),
+	'$find_in_path'(NFile, Opts, NewFile, Goal), !.
+'$extend_pathd'(Name, A, File, Opts, OFile, Goal) :-
+	nonvar(Name),
+	Name =.. [N,P0],
+	'$add_file_to_dir'(P0,A,File,NFile),
+	NewName =.. [N,NFile],
+	'$find_in_path'(NewName, Opts, OFile, Goal).
+
+'$add_file_to_dir'(P0,A,Atoms,NFile) :-
+	atom_concat([P0,A,Atoms],NFile).
+
+

pl/consult.yap

@@ -771,315 +771,6 @@ remove_from_path(New) :- '$check_path'(New,Path),
 '$set_encoding'(Stream, Encoding) :-
 	( Encoding == default -> true ; set_stream(Stream, encoding(Encoding)) ).
 
-absolute_file_name(V,Out) :- var(V), !,
-	'$do_error'(instantiation_error, absolute_file_name(V, Out)).
-absolute_file_name(user,user) :- !.
-absolute_file_name(File0,File) :-
-	'$absolute_file_name'(File0,[access(none),file_type(txt),file_errors(fail),solutions(first)],File,absolute_file_name(File0,File)).
-
-'$full_filename'(F0,F,G) :-
-	'$absolute_file_name'(F0,[access(read),file_type(source),file_errors(fail),solutions(first),expand(true)],F,G).
-
-% fix wrong argument order, TrueFileName should be last.
-absolute_file_name(File,TrueFileName,Opts) :-
-	( var(TrueFileName) -> true ; atom(TrueFileName), TrueFileName \= [] ),
-	!,
-	absolute_file_name(File,Opts,TrueFileName).
-absolute_file_name(File,Opts,TrueFileName) :-
-	'$absolute_file_name'(File,Opts,TrueFileName,absolute_file_name(File,Opts,TrueFileName)).
-	
-'$absolute_file_name'(File, _Opts, _TrueFileName, G) :- var(File), !,
-	'$do_error'(instantiation_error, G).
-'$absolute_file_name'(File,Opts,TrueFileName, G) :-
-	'$process_fn_opts'(Opts,Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,G),
-	/* our own local findall */
-	nb:nb_queue(Ref),
-	(
-	    '$find_in_path'(File,opts(Extensions,RelTo,Type,Access,FErrors,Expand,Debug),TrueFileName,G),
-	    nb:nb_queue_enqueue(Ref, TrueFileName),
-	    fail
-	; 
-	    nb:nb_queue_close(Ref, FileNames, [])
-	 ),
-	'$absolute_file_names'(Solutions, FileNames, FErrors, TrueFileName, File, G).
-
-'$absolute_file_names'(_Solutions, [], error, _, File, G) :- !,
-	'$do_error'(existence_error(file,File),G).
-'$absolute_file_names'(Solutions, FileNames, _, TrueFileName, _, _) :-
-        lists:member(TrueFileName, FileNames),
-	(Solutions == first -> ! ; true).
-	 
-
-'$process_fn_opts'(V,_,_,_,_,_,_,_,_,G) :- var(V), !,
-	'$do_error'(instantiation_error, G).
-'$process_fn_opts'([],[],_,txt,none,error,first,false,false,_) :- !.
-'$process_fn_opts'([Opt|Opts],Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,G) :- !,
-	'$process_fn_opt'(Opt,Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions0,RelTo0,Type0,Access0,FErrors0,Solutions0,Expand0,Debug0,G),
-	'$process_fn_opts'(Opts,Extensions0,RelTo0,Type0,Access0,FErrors0,Solutions0,Expand0,Debug0,G).
-'$process_fn_opts'(Opts,_Extensions,_RelTo,_Type,_Access,_FErrors,_Solutions,_Expand,_Debug,G) :- !,
-	'$do_error'(type_error(list,Opts),G).
-
-'$process_fn_opt'(Opt,Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,G) :- var(Opt), !,
-	'$do_error'(instantiation_error, G).
-'$process_fn_opt'(extensions(Extensions),Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,_,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,G) :- !,
-	'$check_fn_extensions'(Extensions,G).
-'$process_fn_opt'(relative_to(RelTo),Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,_,Type,Access,FErrors,Solutions,Expand,Debug,G) :- !,
-	'$check_atom'(RelTo,G).
-'$process_fn_opt'(access(Access),Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,RelTo,Type,_,FErrors,Solutions,Expand,Debug,G) :- !,
-	'$check_atom'(Access,G).
-'$process_fn_opt'(file_type(Type),Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,RelTo,_,Access,FErrors,Solutions,Expand,Debug,G) :- !,
-	'$check_fn_type'(Type,G).
-'$process_fn_opt'(file_errors(FErrors),Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,RelTo,Type,Access,_,Solutions,Expand,Debug,G) :- !,
-	'$check_fn_errors'(FErrors,G).
-'$process_fn_opt'(solutions(Solutions),Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,RelTo,Type,Access,FErrors,_,Expand,Debug,G) :- !,
-	'$check_fn_solutions'(Solutions,G).
-'$process_fn_opt'(expand(Expand),Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,RelTo,Type,Access,FErrors,Solutions,_,Debug,G) :- !,
-	'$check_true_false'(Expand,G).
-'$process_fn_opt'(verbose_file_search(Debug),Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,_,G) :- !,
-	'$check_true_false'(Debug,G).
-'$process_fn_opt'(Opt,Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,G) :- !,
-	'$do_error'(domain_error(file_name_option,Opt),G).	
-
-'$check_fn_extensions'(V,G) :- var(V), !,
-	'$do_error'(instantiation_error, G).
-'$check_fn_extensions'([],_) :- !.
-'$check_fn_extensions'([A|L],G) :- !,
-	'$check_atom'(A,G),
-	'$check_fn_extensions'(L,G).
-'$check_fn_extensions'(T,G) :- !,
-	'$do_error'(type_error(list,T),G).
-
-'$check_atom'(V,G) :- var(V), !,
-	'$do_error'(instantiation_error, G).
-'$check_atom'(A,_G) :- atom(A), !.
-'$check_atom'(T,G) :- !,
-	'$do_error'(type_error(atom,T),G).
-	
-'$check_fn_type'(V,G) :- var(V), !,
-	'$do_error'(instantiation_error, G).
-'$check_fn_type'(txt,_) :- !.
-'$check_fn_type'(prolog,_) :- !.
-'$check_fn_type'(source,_) :- !.
-'$check_fn_type'(executable,_) :- !.
-'$check_fn_type'(qlf,_) :- !.
-'$check_fn_type'(directory,_) :- !.
-'$check_fn_type'(T,G) :- atom(T), !,
-	'$do_error'(domain_error(file_type,T),G).
-'$check_fn_type'(T,G) :- !,
-	'$do_error'(type_error(atom,T),G).
-	
-'$check_fn_errors'(V,G) :- var(V), !,
-	'$do_error'(instantiation_error, G).
-'$check_fn_errors'(fail,_) :- !.
-'$check_fn_errors'(error,_) :- !.
-'$check_fn_errors'(T,G) :- atom(T), !,
-	'$do_error'(domain_error(file_errors,T),G).
-'$check_fn_errors'(T,G) :- !,
-	'$do_error'(type_error(atom,T),G).
-	
-'$check_fn_solutions'(V,G) :- var(V), !,
-	'$do_error'(instantiation_error, G).
-'$check_fn_solutions'(first,_) :- !.
-'$check_fn_solutions'(all,_) :- !.
-'$check_fn_solutions'(T,G) :- atom(T), !,
-	'$do_error'(domain_error(solutions,T),G).
-'$check_fn_solutions'(T,G) :- !,
-	'$do_error'(type_error(atom,T),G).
-	
-'$check_true_false'(V,G) :- var(V), !,
-	'$do_error'(instantiation_error, G).
-'$check_true_false'(true,_) :- !.
-'$check_true_false'(false,_) :- !.
-'$check_true_false'(T,G) :- atom(T), !,
-	'$do_error'(domain_error(boolean,T),G).
-'$check_true_false'(T,G) :- !,
-	'$do_error'(type_error(atom,T),G).
-	
-% This sequence must be followed:
-% user and user_input are special;
-% library(F) must check library_directories
-% T(F) must check file_search_path
-% all must try search in path
-'$find_in_path'(user,_,user_input, _) :- !.
-'$find_in_path'(user_input,_,user_input, _) :- !.
-'$find_in_path'(commons(D),_,_, _) :-
-	% make sure library_directory is open.
-	\+ clause(user:commons_directory(_),_),
-	'$system_commons_directories'(D),
-	assert(user:commons_directory(D)),
-	fail.
-'$find_in_path'(S, Opts, NewFile, Call) :-
-	S =.. [Name,File0],
-	'$cat_file_name'(File0,File1), !,
-	'$expand_file_name'(File1, File),
-	'$dir_separator'(D),
-	atom_codes(A,[D]),
-	'$extend_path_directory'(Name, A, File, Opts, NewFile, Call).
-'$find_in_path'(File0,Opts,NewFile,_) :-
-	'$cat_file_name'(File0,File1), !,
-	'$expand_file_name'(File1, File),
-	'$add_path'(File,PFile),
-	'$get_abs_file'(PFile,Opts,AbsFile),
-	'$search_in_path'(AbsFile,Opts,NewFile).
-'$find_in_path'(File,_,_,Call) :-
-	'$do_error'(domain_error(source_sink,File),Call).
-
-% allow paths in File Name
-'$cat_file_name'(File0,File) :-
-	atom(File0), !,
-	File = File0.
-'$cat_file_name'(Atoms, File) :-
-	'$to_list_of_atoms'(Atoms, List, []),
-	atom_concat(List, File).
-
-'$to_list_of_atoms'(V, _, _) :- var(V), !, fail.
-'$to_list_of_atoms'(Atom, [Atom|L], L) :- atom(Atom), !.
-'$to_list_of_atoms'(Atoms, L1, LF) :-
-	Atoms =.. [A,As,Bs],
-	atom_codes(A,[D]),
-	'$dir_separator'(D),
-	'$to_list_of_atoms'(As, L1, [A|L2]),
-	'$to_list_of_atoms'(Bs, L2, LF).
-
-'$get_abs_file'(File,opts(_,RelTo,_,_,_,Expand,_),AbsFile) :-
-	(
-	 nonvar(RelTo)
-	->
-	 ( is_absolute_file_name(File) ->
-	   ActualFile = File
-	  ;
-	   '$dir_separator'(D),
-	   atom_codes(DA,[D]),
-	   atom_concat([RelTo, DA, File], ActualFile)
-	  )
-	;
-	  ActualFile = File
-	),
-	'$swi_current_prolog_flag'(file_name_variables, OldF),
-	'$swi_set_prolog_flag'(file_name_variables, Expand),
-	(
-	 '$absolute_file_name'(ActualFile,AbsFile)
-	-> 
-	'$swi_set_prolog_flag'(file_name_variables, OldF)
-	;
-	'$swi_set_prolog_flag'(file_name_variables, OldF),
-	 fail
-	).
-	 
-
-'$search_in_path'(File,opts(Extensions,_,Type,Access,_,_,_),F) :-
-	'$add_extensions'(Extensions, File, F0),
-	'$check_file'(F0, Type, Access, F).
-'$search_in_path'(File,opts(_,_,Type,Access,_,_,_),F) :-
-	'$add_type_extensions'(Type, File, F0),
-	'$check_file'(F0, Type, Access, F).
-
-'$check_file'(F, _Type, none, F) :- !.
-'$check_file'(F0, Type, Access, F0) :-
-	access_file(F0, Access),
-	(Type == directory
-	->
-	 exists_directory(F0)
-	;
-	 true
-	).
-
-'$add_extensions'([Ext|_],File,F) :-
-	'$mk_sure_true_ext'(Ext,NExt),
-	atom_concat([File,NExt],F).
-'$add_extensions'([_|Extensions],File,F) :-
-	'$add_extensions'(Extensions,File,F).
-
-'$mk_sure_true_ext'(Ext,NExt) :-
-	atom_codes(Ext,[C|L]),
-	C \= 0'.,
-	!,
-	atom_codes(NExt,[0'.,C|L]).
-'$mk_sure_true_ext'(Ext,Ext).
-
-'$add_type_extensions'(Type,File,F) :-
-	( Type == source -> NType = prolog ; NType = Type ),
-	user:prolog_file_type(Ext, NType),
-	atom_concat([File,'.',Ext],F).
-'$add_type_extensions'(_,File,File).
-
-'$add_path'(File,File) :-
-	'$dir_separator'(D),
-	atom_codes(DA,[D]),
-	sub_atom(File, 0, 1, _, DA), !.
-'$add_path'(File,File).
-'$add_path'(File,PFile) :-
-	recorded('$path',Path,_),
-	atom_concat([Path,File],PFile).
-
-'$system_library_directories'(Dir) :-
-	getenv('YAPSHAREDIR', Dirs),
-	'$split_by_sep'(0, 0, Dirs, Dir).
-'$system_library_directories'(Dir) :-
-	getenv('YAPCOMMONSDIR', Dirs),
-	'$split_by_sep'(0, 0, Dirs, Dir).
-'$system_library_directories'(Dir) :-
-	get_value(system_library_directory,Dir).
-'$system_library_directories'(Dir) :-
-    get_value(prolog_commons_directory,Dir).
-
-
-'$split_by_sep'(Start, Next, Dirs, Dir) :-
-    '$swi_current_prolog_flag'(windows, true), !,
-    '$split_by_sep'(Start, Next, Dirs, ';', Dir).
-'$split_by_sep'(Start, Next, Dirs, Dir) :-
-    '$split_by_sep'(Start, Next, Dirs, ':', Dir).
-
-'$split_by_sep'(Start, Next, Dirs, Sep, Dir) :-
-    sub_atom(Dirs, Next, 1, _, Let), !,
-    '$continue_split_by_sep'(Let, Start, Next, Dirs, Sep, Dir).
-'$split_by_sep'(Start, Next, Dirs, _Sep, Dir) :-
-    Next > Start,
-    Len is Next-Start,
-    sub_atom(Dirs, Start, Len, _, Dir).
-
-
-% closed a directory
-'$continue_split_by_sep'(Sep, Start, Next, Dirs, Sep, Dir) :-
-    Sz is Next-Start,
-    Sz > 0,
-    sub_atom(Dirs, Start, Sz, _, Dir).
-% next dir
-'$continue_split_by_sep'(Sep , _Start, Next, Dirs, Sep, Dir) :- !,
-    N1 is Next+1,
-    '$split_by_sep'(N1, N1, Dirs, Dir).
-% same dir
-'$continue_split_by_sep'(_Let, Start, Next, Dirs, Sep, Dir) :-
-    N1 is Next+1,
-    '$split_by_sep'(Start, N1, Dirs, Sep, Dir).
-
-
-'$extend_path_directory'(_Name, D, File, _Opts, File, Call) :-
-	is_absolute_file_name(File), !.
-'$extend_path_directory'(Name, D, File, Opts, NewFile, Call) :-
-	user:file_search_path(Name, IDirs),
-        ( atom(IDirs) -> 
-	  '$split_by_sep'(0, 0, IDirs, Dir)
-	;
-	   Dir = IDirs
-	),
-	'$extend_pathd'(Dir, D, File, Opts, NewFile, Call).
-
-'$extend_pathd'(Dir, A, File, Opts, NewFile, Goal) :-
-	atom(Dir), !,
-	'$add_file_to_dir'(Dir,A,File,NFile),
-	'$find_in_path'(NFile, Opts, NewFile, Goal), !.
-'$extend_pathd'(Name, A, File, Opts, OFile, Goal) :-
-	nonvar(Name),
-	Name =.. [N,P0],
-	'$add_file_to_dir'(P0,A,File,NFile),
-	NewName =.. [N,NFile],
-	'$find_in_path'(NewName, Opts, OFile, Goal).
-
-'$add_file_to_dir'(P0,A,Atoms,NFile) :-
-	atom_concat([P0,A,Atoms],NFile).
-
-
 %
 % This is complicated because of embedded ifs.
 %

pl/init.yap

@@ -67,6 +67,7 @@ otherwise.
 :- bootstrap('errors.yap').
 :- bootstrap('lists.yap').
 :- bootstrap('consult.yap').
+:- bootstrap('absf.yap').
 
 :- [	 'utils.yap',
 	 'control.yap',