diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

absolute_filename ^#%@%

Browse Source
This commit is contained in:
V'itor Santos Costa 2016-02-11 06:17:30 -08:00
parent 9a071d5823
commit ee0335124f
17 changed files with 1904 additions and 1746 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

106
os/iopreds.c
View File

@ -102,6 +102,31 @@ FILE *Yap_stdin;
FILE *Yap_stdout; FILE *Yap_stdout;
FILE *Yap_stderr; FILE *Yap_stderr;
static Term gethdir(Term t) {
Atom aref = AtomOfTerm( t );
char *s= RepAtom( aref )->StrOfAE;
size_t nsz;
s = strncpy(LOCAL_FileNameBuf, RepAtom( aref )->StrOfAE, MAXPATHLEN-1);
if (!s) {
return false;
}
if (TermDot == t) {
return TermEmptyAtom;
}
nsz = strlen(s);
if (!Yap_dir_separator(s[nsz-1])) {
#if _WIN32
s[nsz] = '\\';
#else
s[nsz] = '/';
#endif
s[nsz+1] = '\0';
}
return
MkAtomTerm(Yap_LookupAtom( s ) );
}
static bool issolutions(Term t) { static bool issolutions(Term t) {
if (t == TermFirst || t == TermAll) if (t == TermFirst || t == TermAll)
return true; return true;
@ -1355,10 +1380,11 @@ do_open(Term file_name, Term t2,
/* get options */ /* get options */
xarg *args = Yap_ArgListToVector(tlist, open_defs, OPEN_END); xarg *args = Yap_ArgListToVector(tlist, open_defs, OPEN_END);
if (args == NULL) { if (args == NULL) {
if (LOCAL_Error_TYPE) if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, if (LOCAL_Error_TYPE == DOMAIN_ERROR_PROLOG_FLAG)
"option handling in open/3"); LOCAL_Error_TYPE = DOMAIN_ERROR_OPEN_OPTION;
return FALSE; Yap_Error( LOCAL_Error_TYPE, LOCAL_Error_Term, "option handling in open/3" );
}
} }
/* done */ /* done */
sno = GetFreeStreamD(); sno = GetFreeStreamD();
@ -1384,8 +1410,12 @@ do_open(Term file_name, Term t2,
: false) || : false) ||
trueGlobalPrologFlag(OPEN_EXPANDS_FILENAME_FLAG); trueGlobalPrologFlag(OPEN_EXPANDS_FILENAME_FLAG);
// expand file name? // expand file name?
fname = Yap_AbsoluteFile(fname, LOCAL_FileNameBuf, ok); fname = Yap_AbsoluteFile(fname, ok);
if (fname) {
st->name = Yap_LookupAtom(fname); st->name = Yap_LookupAtom(fname);
} else {
PlIOError(EXISTENCE_ERROR_SOURCE_SINK, ARG1, NULL);
}
// Skip scripts that start with !#/.. or similar // Skip scripts that start with !#/.. or similar
bool script = (args[OPEN_SCRIPT].used bool script = (args[OPEN_SCRIPT].used
@ -1432,6 +1462,9 @@ do_open(Term file_name, Term t2,
} }
if ((fd = fopen(fname, io_mode)) == NULL || if ((fd = fopen(fname, io_mode)) == NULL ||
(!(flags & Binary_Stream_f) && binary_file(fname))) { (!(flags & Binary_Stream_f) && binary_file(fname))) {
strncpy( LOCAL_FileNameBuf, fname,MAXPATHLEN);
free( (void *)fname );
fname = LOCAL_FileNameBuf;
UNLOCK(st->streamlock); UNLOCK(st->streamlock);
if (errno == ENOENT) if (errno == ENOENT)
return (PlIOError(EXISTENCE_ERROR_SOURCE_SINK, file_name, "%s: %s", fname, return (PlIOError(EXISTENCE_ERROR_SOURCE_SINK, file_name, "%s: %s", fname,
@ -1829,8 +1862,15 @@ static Int close2(USES_REGS1) { /* '$close'(+GLOBAL_Stream) */
} }
xarg *args = xarg *args =
Yap_ArgListToVector((tlist = Deref(ARG2)), close_defs, CLOSE_END); Yap_ArgListToVector((tlist = Deref(ARG2)), close_defs, CLOSE_END);
if (args == NULL) if (args == NULL) {
if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_PROLOG_FLAG)
LOCAL_Error_TYPE = DOMAIN_ERROR_CLOSE_OPTION;
Yap_Error( LOCAL_Error_TYPE, LOCAL_Error_Term, NULL );
}
return false;
return FALSE; return FALSE;
}
// if (args[CLOSE_FORCE].used) { // if (args[CLOSE_FORCE].used) {
// } // }
Yap_CloseStream(sno); Yap_CloseStream(sno);
@ -1854,8 +1894,8 @@ Term read_line(int sno) {
PAR("access", isatom, ABSOLUTE_FILE_NAME_ACCESS), \ PAR("access", isatom, ABSOLUTE_FILE_NAME_ACCESS), \
PAR("expand", booleanFlag, ABSOLUTE_FILE_NAME_EXPAND), \ PAR("expand", booleanFlag, ABSOLUTE_FILE_NAME_EXPAND), \
PAR("extensions", ok, ABSOLUTE_FILE_NAME_EXTENSIONS), \ PAR("extensions", ok, ABSOLUTE_FILE_NAME_EXTENSIONS), \
PAR("file_type", is_file_type, ABSOLUTE_FILE_NAME_FILE_TYPE), \
PAR("file_errors", is_file_errors, ABSOLUTE_FILE_NAME_FILE_ERRORS), \ PAR("file_errors", is_file_errors, ABSOLUTE_FILE_NAME_FILE_ERRORS), \
PAR("file_type", is_file_type, ABSOLUTE_FILE_NAME_FILE_TYPE), \
PAR("glob", ok, ABSOLUTE_FILE_NAME_GLOB), \ PAR("glob", ok, ABSOLUTE_FILE_NAME_GLOB), \
PAR("relative_to", isatom, ABSOLUTE_FILE_NAME_RELATIVE_TO), \ PAR("relative_to", isatom, ABSOLUTE_FILE_NAME_RELATIVE_TO), \
PAR("solutions", issolutions, ABSOLUTE_FILE_NAME_SOLUTIONS), \ PAR("solutions", issolutions, ABSOLUTE_FILE_NAME_SOLUTIONS), \
@ -1884,19 +1924,28 @@ static Int abs_file_parameters(USES_REGS1) {
/* get options */ /* get options */
xarg *args = Yap_ArgListToVector(tlist, absolute_file_name_search_defs, xarg *args = Yap_ArgListToVector(tlist, absolute_file_name_search_defs,
ABSOLUTE_FILE_NAME_END); ABSOLUTE_FILE_NAME_END);
if (args == NULL) if (args == NULL) {
return FALSE; if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_PROLOG_FLAG)
LOCAL_Error_TYPE = DOMAIN_ERROR_ABSOLUTE_FILE_NAME_OPTION;
Yap_Error( LOCAL_Error_TYPE, LOCAL_Error_Term, NULL );
}
return false;
}
/* done */ /* done */
if (args[ABSOLUTE_FILE_NAME_EXTENSIONS].used) if (args[ABSOLUTE_FILE_NAME_EXTENSIONS].used) {
t[ABSOLUTE_FILE_NAME_EXTENSIONS] = t[ABSOLUTE_FILE_NAME_EXTENSIONS] =
args[ABSOLUTE_FILE_NAME_EXTENSIONS].tvalue; args[ABSOLUTE_FILE_NAME_EXTENSIONS].tvalue;
else } else {
t[ABSOLUTE_FILE_NAME_EXTENSIONS] = TermNil; t[ABSOLUTE_FILE_NAME_EXTENSIONS] = TermNil;
if (args[ABSOLUTE_FILE_NAME_RELATIVE_TO].used) }
if (args[ABSOLUTE_FILE_NAME_RELATIVE_TO].used) {
t[ABSOLUTE_FILE_NAME_RELATIVE_TO] = t[ABSOLUTE_FILE_NAME_RELATIVE_TO] =
args[ABSOLUTE_FILE_NAME_RELATIVE_TO].tvalue; gethdir( args[ABSOLUTE_FILE_NAME_RELATIVE_TO].tvalue );
else } else {
t[ABSOLUTE_FILE_NAME_RELATIVE_TO] = TermEmptyAtom; t[ABSOLUTE_FILE_NAME_RELATIVE_TO] =
gethdir( TermDot );
}
if (args[ABSOLUTE_FILE_NAME_FILE_TYPE].used) if (args[ABSOLUTE_FILE_NAME_FILE_TYPE].used)
t[ABSOLUTE_FILE_NAME_FILE_TYPE] = args[ABSOLUTE_FILE_NAME_FILE_TYPE].tvalue; t[ABSOLUTE_FILE_NAME_FILE_TYPE] = args[ABSOLUTE_FILE_NAME_FILE_TYPE].tvalue;
else else
@ -1937,28 +1986,11 @@ static Int get_abs_file_parameter(USES_REGS1) {
Term t = Deref(ARG1), topts = ARG2; Term t = Deref(ARG1), topts = ARG2;
/* get options */ /* get options */
/* done */ /* done */
if (t == TermExtensions) int i = Yap_ArgKey( AtomOfTerm( t ), absolute_file_name_search_defs,
return Yap_unify(ARG3, ArgOfTerm(ABSOLUTE_FILE_NAME_EXTENSIONS + 1, topts)); ABSOLUTE_FILE_NAME_END );
if (t == TermRelativeTo) if (i >= 0)
return Yap_unify(ARG3, return Yap_unify(ARG3, ArgOfTerm(i + 1, topts));
ArgOfTerm(ABSOLUTE_FILE_NAME_RELATIVE_TO + 1, topts)); Yap_Error(DOMAIN_ERROR_ABSOLUTE_FILE_NAME_OPTION, ARG1, NULL);
if (t == TermFileType)
return Yap_unify(ARG3, ArgOfTerm(ABSOLUTE_FILE_NAME_FILE_TYPE + 1, topts));
if (t == TermAccess)
return Yap_unify(ARG3, ArgOfTerm(ABSOLUTE_FILE_NAME_ACCESS + 1, topts));
if (t == TermFileErrors)
return Yap_unify(ARG3,
ArgOfTerm(ABSOLUTE_FILE_NAME_FILE_ERRORS + 1, topts));
if (t == TermSolutions)
return Yap_unify(ARG3, ArgOfTerm(ABSOLUTE_FILE_NAME_SOLUTIONS + 1, topts));
if (t == TermGlob)
return Yap_unify(ARG3, ArgOfTerm(ABSOLUTE_FILE_NAME_GLOB + 1, topts));
if (t == TermExpand)
return Yap_unify(ARG3, ArgOfTerm(ABSOLUTE_FILE_NAME_EXPAND + 1, topts));
if (t == TermVerboseFileSearch)
return Yap_unify(
ARG3, ArgOfTerm(ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH + 1, topts));
Yap_Error(DOMAIN_ERROR_ABSOLUTE_FILE_NAME_OPTION, ARG2, NULL);
return false; return false;
} }

2
os/readline.c
View File

@ -205,7 +205,7 @@ bool Yap_InitReadline(Term enable) {
#endif #endif
rl_outstream = stderr; rl_outstream = stderr;
using_history(); using_history();
const char *s = Yap_AbsoluteFile("~/.YAP.history", NULL, true); const char *s = Yap_AbsoluteFile("~/.YAP.history", true);
if (!read_history(s)) { if (!read_history(s)) {
FILE *f = fopen(s, "w"); FILE *f = fopen(s, "w");
if (f) { if (f) {

52
os/readterm.c
View File

@ -639,23 +639,23 @@ static bool complete_processing(FEnv *fe, TokEntry *tokstart) {
CurrentModule = fe->cmod; CurrentModule = fe->cmod;
if (CurrentModule == TermProlog) if (CurrentModule == TermProlog)
CurrentModule = PROLOG_MODULE; CurrentModule = PROLOG_MODULE;
if (fe->vp) if (fe->t && fe->vp)
v1 = get_variables(fe, tokstart); v1 = get_variables(fe, tokstart);
else else
v1 = 0L; v1 = 0L;
if (fe->np) if (fe->t && fe->np)
v2 = get_varnames(fe, tokstart); v2 = get_varnames(fe, tokstart);
else else
v2 = 0L; v2 = 0L;
if (fe->sp) if (fe->t && fe->sp)
v3 = get_singletons(fe, tokstart); v3 = get_singletons(fe, tokstart);
else else
v3 = 0L; v3 = 0L;
if (fe->tcomms) if (fe->t && fe->tcomms)
vc = LOCAL_Comments; vc = LOCAL_Comments;
else else
vc = 0L; vc = 0L;
if (fe->tp) if (fe->t && fe->tp)
tp = get_stream_position(fe, tokstart ); tp = get_stream_position(fe, tokstart );
else else
tp = 0L; tp = 0L;
@ -679,22 +679,22 @@ static bool complete_clause_processing(FEnv *fe, TokEntry
CurrentModule = fe->cmod; CurrentModule = fe->cmod;
if (CurrentModule == TermProlog) if (CurrentModule == TermProlog)
CurrentModule = PROLOG_MODULE; CurrentModule = PROLOG_MODULE;
if (fe->vp) if (fe->t && fe->vp)
v_vp = get_variables(fe, tokstart); v_vp = get_variables(fe, tokstart);
else else
v_vp = 0L; v_vp = 0L;
if (fe->np) if (fe->t && fe->np)
v_vnames = get_varnames(fe, tokstart); v_vnames = get_varnames(fe, tokstart);
else else
v_vnames = 0L; v_vnames = 0L;
if (trueLocalPrologFlag(SINGLE_VAR_WARNINGS_FLAG)) { if (fe->t && trueLocalPrologFlag(SINGLE_VAR_WARNINGS_FLAG)) {
warn_singletons(fe, tokstart); warn_singletons(fe, tokstart);
} }
if (fe->tcomms) if (fe->t && fe->tcomms)
v_comments = LOCAL_Comments; v_comments = LOCAL_Comments;
else else
v_comments = 0L; v_comments = 0L;
if (fe->tp) if (fe->t && fe->tp)
v_pos = get_stream_position(fe, tokstart ); v_pos = get_stream_position(fe, tokstart );
else else
v_pos = 0L; v_pos = 0L;
@ -813,7 +813,9 @@ static parser_state_t scan(REnv *re, FEnv *fe, int inp_stream) {
return YAP_PARSING; return YAP_PARSING;
} }
if (LOCAL_tokptr->Tok == eot_tok && LOCAL_tokptr->TokInfo == TermNl) { if (LOCAL_tokptr->Tok == eot_tok && LOCAL_tokptr->TokInfo == TermNl) {
LOCAL_ErrorMessage = "Empty clause"; char *out = malloc( strlen("Empty clause" + 1 ) );
strcpy( out, "Empty clause" );
LOCAL_ErrorMessage = out;
LOCAL_Error_TYPE = SYNTAX_ERROR; LOCAL_Error_TYPE = SYNTAX_ERROR;
LOCAL_Error_Term = TermEof; LOCAL_Error_Term = TermEof;
return YAP_PARSING_ERROR; return YAP_PARSING_ERROR;
@ -878,7 +880,8 @@ static parser_state_t parseError(REnv *re, FEnv *fe, int inp_stream) {
} else { } else {
Term terr = Yap_syntax_error(fe->toklast, inp_stream); Term terr = Yap_syntax_error(fe->toklast, inp_stream);
if (ParserErrorStyle == TermError) { if (ParserErrorStyle == TermError) {
LOCAL_ErrorMessage = "SYNTAX ERROR"; LOCAL_ErrorMessage = NULL;
LOCAL_Error_TYPE = SYNTAX_ERROR;
Yap_Error(SYNTAX_ERROR, terr, LOCAL_ErrorMessage); Yap_Error(SYNTAX_ERROR, terr, LOCAL_ErrorMessage);
return YAP_PARSING_FINISHED; return YAP_PARSING_FINISHED;
} else { } else {
@ -933,7 +936,7 @@ Term Yap_read_term(int inp_stream, Term opts, int nargs) {
#endif #endif
parser_state_t state = YAP_START_PARSING; parser_state_t state = YAP_START_PARSING;
while (state != YAP_PARSING_FINISHED) { while (true) {
switch (state) { switch (state) {
case YAP_START_PARSING: case YAP_START_PARSING:
state = initParser(opts, &fe, &re, inp_stream, nargs); state = initParser(opts, &fe, &re, inp_stream, nargs);
@ -951,22 +954,27 @@ Term Yap_read_term(int inp_stream, Term opts, int nargs) {
state = parseError(&re, &fe, inp_stream); state = parseError(&re, &fe, inp_stream);
break; break;
case YAP_PARSING_FINISHED: case YAP_PARSING_FINISHED:
break;
}
}
{ {
CACHE_REGS CACHE_REGS
if (fe.reading_clause && bool done;
!complete_clause_processing(&fe, LOCAL_tokptr)) if (fe.reading_clause)
fe.t = 0; done = complete_clause_processing(&fe, LOCAL_tokptr);
else if (!fe.reading_clause && !complete_processing(&fe, LOCAL_tokptr)) else
done = complete_processing(&fe, LOCAL_tokptr);
if (!done) {
state = YAP_PARSING_ERROR;
fe.t = 0; fe.t = 0;
break;
} }
#if EMACS #if EMACS
first_char = tokstart->TokPos; first_char = tokstart->TokPos;
#endif /* EMACS */ #endif /* EMACS */
return fe.t; return fe.t;
} }
}
}
return 0;
}
static Int static Int
read_term2(USES_REGS1) { /* '$read'(+Flag,?Term,?Module,?Vars,-Pos,-Err) */ read_term2(USES_REGS1) { /* '$read'(+Flag,?Term,?Module,?Vars,-Pos,-Err) */
@ -1113,11 +1121,11 @@ static Int read_clause2(USES_REGS1) {
* + The `syntax_errors` flag controls response to syntactic errors, the * + The `syntax_errors` flag controls response to syntactic errors, the
*default is `dec10`. *default is `dec10`.
* *
* The next two options are called implicitly:plwae * The next two options are called implicitly:
* *
* + The `module` option is initialized to the current source module, by * + The `module` option is initialized to the current source module, by
*default. *default.
* + The `tons` option is set from the single var flag * + The `singletons` option is set from the single var flag
*/ */
static Int read_clause( static Int read_clause(
USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */ USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */

15
os/streams.c
View File

@ -567,6 +567,11 @@ static Int cont_stream_property(USES_REGS1) { /* current_stream */
args = Yap_ArgListToVector(Deref(ARG2), stream_property_defs, args = Yap_ArgListToVector(Deref(ARG2), stream_property_defs,
STREAM_PROPERTY_END); STREAM_PROPERTY_END);
if (args == NULL) { if (args == NULL) {
if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_PROLOG_FLAG)
LOCAL_Error_TYPE = DOMAIN_ERROR_STREAM_PROPERTY_OPTION;
Yap_Error( LOCAL_Error_TYPE, LOCAL_Error_Term, NULL );
}
cut_fail(); cut_fail();
} }
LOCK(GLOBAL_StreamDescLock); LOCK(GLOBAL_StreamDescLock);
@ -630,6 +635,11 @@ static Int stream_property(USES_REGS1) { /* Init current_stream */
args = Yap_ArgListToVector(Deref(ARG2), stream_property_defs, args = Yap_ArgListToVector(Deref(ARG2), stream_property_defs,
STREAM_PROPERTY_END); STREAM_PROPERTY_END);
if (args == NULL) { if (args == NULL) {
if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_PROLOG_FLAG)
LOCAL_Error_TYPE = DOMAIN_ERROR_STREAM_PROPERTY_OPTION;
Yap_Error( LOCAL_Error_TYPE, LOCAL_Error_Term, NULL );
}
UNLOCK(GLOBAL_Stream[i].streamlock); UNLOCK(GLOBAL_Stream[i].streamlock);
cut_fail(); cut_fail();
} }
@ -682,6 +692,11 @@ static bool do_set_stream(int sno,
args = Yap_ArgListToVector(opts, set_stream_defs, SET_STREAM_END); args = Yap_ArgListToVector(opts, set_stream_defs, SET_STREAM_END);
if (args == NULL) { if (args == NULL) {
if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_PROLOG_FLAG)
LOCAL_Error_TYPE = DOMAIN_ERROR_SET_STREAM_OPTION;
Yap_Error( LOCAL_Error_TYPE, LOCAL_Error_Term, NULL );
}
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
return false; return false;
} }

558
os/sysbits.c
View File

@ -46,15 +46,26 @@ static Int p_mv( USES_REGS1 );
static Int p_dir_sp( USES_REGS1 ); static Int p_dir_sp( USES_REGS1 );
static Int p_getenv( USES_REGS1 ); static Int p_getenv( USES_REGS1 );
static Int p_putenv( USES_REGS1 ); static Int p_putenv( USES_REGS1 );
static char *expandVars(const char *pattern, char *expanded, int maxlen); static Term do_glob(const char *spec, bool ok_to);
#ifdef MACYAP #ifdef MACYAP
static int chdir(char *); static int chdir(char *);
/* #define signal skel_signal */ /* #define signal skel_signal */
#endif /* MACYAP */ #endif /* MACYAP */
static char *
expandVars(const char *spec);
void exit(int); void exit(int);
static void
freeBuffer( const void *ptr )
{
if (ptr == NULL ||
ptr == LOCAL_FileNameBuf || ptr == LOCAL_FileNameBuf2)
return;
free((void *)ptr);
}
#ifdef _WIN32 #ifdef _WIN32
void void
Yap_WinError(char *yap_error) Yap_WinError(char *yap_error)
@ -267,13 +278,14 @@ bool
Yap_IsAbsolutePath(const char *p0) Yap_IsAbsolutePath(const char *p0)
{ {
// verify first if expansion is needed: ~/ or $HOME/ // verify first if expansion is needed: ~/ or $HOME/
char c[MAXPATHLEN+1]; char *p = expandVars( p0 );
char *p = expandVars( p0, c, MAXPATHLEN ); bool nrc;
#if _WIN32 || __MINGW32__ #if _WIN32 || __MINGW32__
return !PathIsRelative(p); nrc = !PathIsRelative(p);
#else #else
return p[0] == '/'; nrc = ( p[0] == '/' );
#endif #endif
return nrc;
} }
#define isValidEnvChar(C) ( ((C) >= 'a' && (C) <= 'z') || ((C) >= 'A' && \ #define isValidEnvChar(C) ( ((C) >= 'a' && (C) <= 'z') || ((C) >= 'A' && \
@ -283,13 +295,10 @@ Yap_IsAbsolutePath(const char *p0)
// support for ~expansion at the beginning // support for ~expansion at the beginning
// systems like Android do not do this. // systems like Android do not do this.
static char * static char *
yapExpandVars (const char *source, char *result) PlExpandVars (const char *source)
{ {
const char *src = source; const char *src = source;
char *res = result; char *result = LOCAL_FileNameBuf;
if(result == NULL)
result = malloc( YAP_FILENAME_MAX+1);
if (strlen(source) >= YAP_FILENAME_MAX) { if (strlen(source) >= YAP_FILENAME_MAX) {
Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, "%s in true_file-name is larger than the buffer size (%d bytes)", source, strlen(source)); Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, "%s in true_file-name is larger than the buffer size (%d bytes)", source, strlen(source));
@ -315,6 +324,7 @@ yapExpandVars (const char *source, char *result)
} else { } else {
#if HAVE_GETPWNAM #if HAVE_GETPWNAM
struct passwd *user_passwd; struct passwd *user_passwd;
char *res = result;
src++; src++;
while (!dir_separator((*res = *src)) && *res != '\0') while (!dir_separator((*res = *src)) && *res != '\0')
@ -338,7 +348,7 @@ yapExpandVars (const char *source, char *result)
/* follow SICStus expansion rules */ /* follow SICStus expansion rules */
char v[YAP_FILENAME_MAX+1]; char v[YAP_FILENAME_MAX+1];
int ch; int ch;
char *s; char *s, *res;
src = source+1; src = source+1;
if (src[0] == '{') { if (src[0] == '{') {
res = v; res = v;
@ -371,13 +381,6 @@ yapExpandVars (const char *source, char *result)
return result; return result;
} }
static char *
expandVars(const char *pattern, char *expanded, int maxlent)
{
return yapExpandVars(pattern, expanded);
}
#if _WIN32 || defined(__MINGW32__) #if _WIN32 || defined(__MINGW32__)
// straightforward conversion from Unix style to WIN style // straightforward conversion from Unix style to WIN style
// check cygwin path.cc for possible improvements // check cygwin path.cc for possible improvements
@ -452,11 +455,11 @@ PrologPath(const char *Y, char *X) {
static bool ChDir(const char *path) { static bool ChDir(const char *path) {
bool rc = false; bool rc = false;
const char *qpath = Yap_AbsoluteFile(path, NULL, true); const char *qpath = Yap_AbsoluteFile(path, true);
#ifdef __ANDROID__ #ifdef __ANDROID__
if (GLOBAL_AssetsWD) { if (GLOBAL_AssetsWD) {
free( GLOBAL_AssetsWD ); freeBuffer( GLOBAL_AssetsWD );
GLOBAL_AssetsWD = NULL; GLOBAL_AssetsWD = NULL;
} }
if (Yap_isAsset(qpath) ) { if (Yap_isAsset(qpath) ) {
@ -487,7 +490,7 @@ static bool ChDir(const char *path) {
#else #else
rc = (chdir(qpath) == 0); rc = (chdir(qpath) == 0);
#endif #endif
free( (void *)qpath ); free((char *)qpath);
return rc; return rc;
} }
#if _WIN32 || defined(__MINGW32__) #if _WIN32 || defined(__MINGW32__)
@ -521,7 +524,7 @@ DirName(const char *X) {
} }
#endif #endif
static const char *myrealpath( const char *path, char *out) static const char *myrealpath( const char *path)
{ {
#if _WIN32 || defined(__MINGW32__) #if _WIN32 || defined(__MINGW32__)
DWORD retval=0; DWORD retval=0;
@ -540,246 +543,139 @@ static const char *myrealpath( const char *path, char *out)
return out; return out;
#elif HAVE_REALPATH #elif HAVE_REALPATH
{ {
const char *rc; char * rc = realpath(path,NULL);
rc = ( const char *)realpath(path,out);
const char *s0, *s;
if (rc == NULL && (errno == ENOENT|| errno == EACCES)) { if (rc) {
if ( is_directory(rc)) {
s = (const char *)path;
} else {
s = basename((char *)path);
path = dirname((char *)path);
}
s0 = malloc(strlen(s)+1);
strcpy((char *)s0, s);
if ((rc = myrealpath(path, out))==NULL) {
Yap_FileError(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, "could not find file %s: %s", path, strerror(errno));
return NULL;
}
if(rc[strlen(rc)-1] != '/' )
strcat((char *)rc, "/");
strcat((char *)rc, s0);
free((void *)s0);
}
return rc; return rc;
} }
// rc = NULL;
if (errno == ENOENT|| errno == EACCES) {
char base[YAP_FILENAME_MAX];
strncpy(base, path, YAP_FILENAME_MAX-1);
rc = realpath( dirname( (char *)path ), NULL);
if (rc) {
const char *b = basename(base);
size_t e = strlen(rc);
size_t bs = strlen( b );
rc = realloc( rc , e+bs+2);
#if _WIN32
if (rc[e-1] != '\\' && rc[e-1] != '/' ) {
rc[e]='\\';
rc[e+1]='\0';
}
#else #else
return NULL; if (rc[e-1] != '/' ) {
rc[e]='/';
rc[e+1]='\0';
}
#endif #endif
strcat(rc, b);
return rc;
}
}
}
#endif
char *out = malloc(strlen(path)+1);
strcpy( out, path);
return out;
} }
static char * static char *
PrologExpandVars(const char *spec, char *tmp0, bool ok_to) expandVars(const char *spec)
{ {
char *tmp;
#if _WIN32 || defined(__MINGW32__) #if _WIN32 || defined(__MINGW32__)
char u[YAP_FILENAME_MAX+1]; char u[YAP_FILENAME_MAX+1];
// first pass, remove Unix style stuff // first pass, remove Unix style stuff
if (unix2win(spec, u, YAP_FILENAME_MAX) == NULL) if ((ou=unix2win(spec, YAP_FILENAME_MAX)) == NULL)
return NULL; return NULL;
spec = u; spec = u;
#endif #endif
if (tmp0 == NULL) { bool ok_to = true;
tmp = malloc(YAP_FILENAME_MAX+1); if (spec == NULL) {
if (tmp == NULL) {
return NULL; return NULL;
} }
} else {
tmp = tmp0;
}
if ( ok_to ) if ( ok_to )
{ {
tmp=expandVars(spec,tmp,YAP_FILENAME_MAX); Term t = do_glob( spec, true );
if (IsPairTerm(t))
return RepAtom(AtomOfTerm(HeadOfTerm(t)))->StrOfAE;
return NULL;
} else {
return PlExpandVars( spec );
} }
else { return (char *)spec;
if (tmp != tmp0) {
free(tmp);
}
tmp = (char *)spec;
}
return tmp;
} }
/** /**
* generate absolute path, if ok first expand SICStus Prolog style * generate absolute path, if ok first expand SICStus Prolog style
* *
* @param[in] spec the file path, including `~` and `$`. * @param[in] spec the file path, including `~` and `$`.
* @param[out] tmp where to store the file.
* @param[in] ok where to process `~` and `$`. * @param[in] ok where to process `~` and `$`.
* *
* @return tmp, or NULL * @return tmp, or NULL, in malloced memory
*/ */
const char * const char *
Yap_AbsoluteFile(const char *spec, char *tmp, bool ok) Yap_AbsoluteFile(const char *spec, bool ok)
{ {
char *t1 = NULL; const char*p;
t1 = PrologExpandVars(spec, t1, ok); const char*rc;
if (!t1) rc = expandVars(spec);
if (!rc)
return spec;
if ((p = myrealpath(rc) ) ) {
return p;
} else {
return NULL; return NULL;
return myrealpath(t1, tmp); }
} }
/** /**
* @pred prolog_expanded_file_system_path( +PrologPath, +ExpandVars, -OSPath ) * generate absolute path and stores path in an user given buffer. If
* NULL, uses a temporary buffer that must be quickly released.
* *
* Apply basic transformations to paths, and conidtionally apply * if ok first expand variable names and do globbing
* traditional SICStus-style variable expansion.
* *
* @param PrologPath the source, may be atom or string * @param[in] spec the file path, including `~` and `$`.
* @param ExpandVars expand initial occurrence of ~ or $ * @param[in] ok where to process `~` and `$`.
* @param Prefix add this path before _PrologPath_
* @param OSPath pathname.
* *
* @return * @return tmp, or NULL, in malloced memory
*/ */
static Int const char *
prolog_expanded_file_system_path( USES_REGS1 ) Yap_AbsoluteFileInBuffer(const char *spec, char *out, size_t sz, bool ok)
{ {
Term t1 = Deref(ARG1); const char*p;
Term t2 = Deref(ARG2); const char*rc;
Term t3 = Deref(ARG3); if (ok) {
char *o = LOCAL_FileNameBuf; rc = expandVars(spec);
bool flag; if (!rc)
const char *cmd, *p0; return spec;
if (IsAtomTerm(t1)) {
cmd = RepAtom(AtomOfTerm(t1))->StrOfAE;
} else if (IsStringTerm(t1)) {
cmd = StringOfTerm(t1);
} else { } else {
return false; rc = spec;
} }
if (t2 == TermTrue) {
flag = true; if ((p = myrealpath(rc) ) ) {
} else if (t2 == TermFalse) { if (!out) {
flag = false; out = LOCAL_FileNameBuf;
sz = YAP_FILENAME_MAX-1;
}
if (p != out ) {
strncpy(out, p, sz);
freeBuffer(p);
return out;
} else { } else {
return false; return NULL;
}
if (IsAtomTerm(t3)) {
p0 = RepAtom(AtomOfTerm(t3))->StrOfAE;
} else if (IsStringTerm(t3)) {
p0 = StringOfTerm(t3);
} else {
return false;
}
const char *out = PrologExpandVars(cmd,o,flag);
if (Yap_IsAbsolutePath(out)) {
return Yap_unify(MkAtomTerm(Yap_LookupAtom(out)), ARG4);
} else if (p0[0] == '\0') {
const char *rc = myrealpath(out, LOCAL_FileNameBuf2 );
return Yap_unify(MkAtomTerm(Yap_LookupAtom(rc)), ARG4);
} else {
char *pt =strncpy( LOCAL_FileNameBuf2, p0, YAP_FILENAME_MAX );
if ( !dir_separator( pt[-1] )) {
#if ATARI || _MSC_VER || defined(__MINGW32__)
pt[0] = '\\';
#else
pt[0] = '/';
#endif
pt++;
pt[0] = '\n';
}
out = strncpy( pt, out, YAP_FILENAME_MAX -(pt -LOCAL_FileNameBuf2) );
const char *rc = myrealpath(LOCAL_FileNameBuf, LOCAL_FileNameBuf2 );
return Yap_unify(MkAtomTerm(Yap_LookupAtom(rc)), ARG4);
} }
} }
return NULL;
#define EXPAND_FILENAME_DEFS() \ }
PAR("parameter_expansion", isatom, EXPAND_FILENAME_PARAMETER_EXPANSION), \
PAR("commands", booleanFlag, EXPAND_FILENAME_COMMANDS), \
PAR(NULL, ok, EXPAND_FILENAME_END)
#define PAR(x, y, z) z
typedef enum expand_filename_enum_choices {
EXPAND_FILENAME_DEFS()
} expand_filename_enum_choices_t;
#undef PAR
#define PAR(x, y, z) \
{ x, y, z }
static const param_t expand_filename_defs[] = {EXPAND_FILENAME_DEFS()};
#undef PAR
static Term static Term
do_expand_file_name(Term t1, Term opts USES_REGS) /* Expand the string for the program to run. */
do_glob(const char *spec, bool glob_vs_wordexp)
{ {
xarg *args;
expand_filename_enum_choices_t i;
bool use_system_expansion = true, glob_vs_wordexp = true;
const char *tmp = NULL;
char *tmpe = NULL;
const char *spec;
#if HAVE_GLOB
glob_t gresult;
#endif
#if HAVE_GLOB || HAVE_WORDEXP
char **ss = NULL;
int flags = 0, j;
#endif
#if HAVE_WORDEXP
wordexp_t wresult;
#endif
Term tf;
if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR, t1, NULL);
return TermNil;
} else if (IsAtomTerm(t1)) {
spec = AtomTermName( t1 );
} else if (IsStringTerm(t1)) {
spec = StringOfTerm( t1 );
} else {
Yap_Error(TYPE_ERROR_ATOM, t1, NULL);
return TermNil;
}
args = Yap_ArgListToVector(opts, expand_filename_defs, EXPAND_FILENAME_END);
if (args == NULL) {
return TermNil;
}
tmpe = malloc(YAP_FILENAME_MAX+1);
for (i = 0; i < EXPAND_FILENAME_END; i++) {
if (args[i].used) {
Term t = args[i].tvalue;
switch (i) {
case EXPAND_FILENAME_PARAMETER_EXPANSION:
if (t == TermProlog) {
if (tmpe == NULL) {
return TermNil;
}
tmpe = expandVars( spec, tmpe, YAP_FILENAME_MAX);
spec = tmpe;
} else if (t == TermTrue) {
use_system_expansion = true;
} else if (t == TermFalse) {
use_system_expansion = false;
}
break;
case EXPAND_FILENAME_COMMANDS:
if (!use_system_expansion) {
use_system_expansion = true;
#ifdef WRDE_NOCMD
if (t == TermFalse) {
flags = WRDE_NOCMD;
}
#endif
}
case EXPAND_FILENAME_END:
break;
}
}
}
#if _WIN32 || defined(__MINGW32__) #if _WIN32 || defined(__MINGW32__)
{ {
char u[YAP_FILENAME_MAX+1]; char u[YAP_FILENAME_MAX+1];
@ -820,11 +716,18 @@ do_expand_file_name(Term t1, Term opts USES_REGS)
return tf; return tf;
} }
#elif HAVE_WORDEXP || HAVE_GLOB #elif HAVE_WORDEXP || HAVE_GLOB
if (!use_system_expansion) {
return MkPairTerm(MkAtomTerm(Yap_LookupAtom(spec)), TermNil);
}
/* Expand the string for the program to run. */ /* Expand the string for the program to run. */
size_t pathcount; size_t pathcount;
#if HAVE_GLOB
glob_t gresult;
#endif
#if HAVE_WORDEXP
wordexp_t wresult;
#endif
#if HAVE_GLOB || HAVE_WORDEXP
char **ss = NULL;
int flags = 0, j;
#endif
if ( glob_vs_wordexp ) { if ( glob_vs_wordexp ) {
#if HAVE_GLOB #if HAVE_GLOB
#ifdef GLOB_NOCHECK #ifdef GLOB_NOCHECK
@ -875,8 +778,7 @@ do_expand_file_name(Term t1, Term opts USES_REGS)
break; break;
} else { } else {
Term t; Term t;
char *out = LOCAL_FileNameBuf; t = MkAtomTerm( Yap_LookupAtom( expandVars(spec) ) );
t = MkAtomTerm( Yap_LookupAtom( expandVars(spec, out, YAP_FILENAME_MAX-1) ) );
wordfree (&wresult); wordfree (&wresult);
return MkPairTerm( t, TermNil ); return MkPairTerm( t, TermNil );
} }
@ -893,11 +795,12 @@ do_expand_file_name(Term t1, Term opts USES_REGS)
} }
#endif #endif
} }
tf = TermNil; const char * tmp;
Term tf = TermNil;
for (j = 0; j < pathcount; j++) { for (j = 0; j < pathcount; j++) {
const char *s = ss[pathcount-(j+1)]; const char *s = ss[pathcount-(j+1)];
#if HAVE_REALPATH #if HAVE_REALPATH
tmp = myrealpath(s,(char *) tmp); tmp = myrealpath(s);
#else #else
tmp = s; tmp = s;
#endif #endif
@ -907,21 +810,143 @@ do_expand_file_name(Term t1, Term opts USES_REGS)
tf = MkPairTerm(MkAtomTerm( a ),tf); tf = MkPairTerm(MkAtomTerm( a ),tf);
} }
#if HAVE_GLOB #if HAVE_GLOB
if (use_system_expansion && glob_vs_wordexp) if ( glob_vs_wordexp)
globfree( &gresult ); globfree( &gresult );
#endif #endif
#if HAVE_WORDEXP #if HAVE_WORDEXP
if (use_system_expansion && !glob_vs_wordexp) if ( !glob_vs_wordexp)
wordfree( &wresult ); wordfree( &wresult );
#endif #endif
if (tmp) if (tmp)
free( (void *)tmp ); freeBuffer( (void *)tmp );
if (tmpe) return tf;
free( tmpe );
#else #else
// just use basic // just use basic
return MkPairTerm(MkAtomTerm(Yap_LookupAtom(spec)), TermNil); return MkPairTerm(MkAtomTerm(Yap_LookupAtom(spec)), TermNil);
#endif #endif
}
/**
* @pred prolog_expanded_file_system_path( +PrologPath, +ExpandVars, -OSPath )
*
* Apply basic transformations to paths, and conidtionally apply
* traditional SICStus-style variable expansion.
*
* @param PrologPath the source, may be atom or string
* @param ExpandVars expand initial occurrence of ~ or $
* @param Prefix add this path before _PrologPath_
* @param OSPath pathname.
*
* @return
*/
static Int
prolog_realpath( USES_REGS1 )
{
Term t1 = Deref(ARG1);
const char *cmd;
if (IsAtomTerm(t1)) {
cmd = RepAtom(AtomOfTerm(t1))->StrOfAE;
} else if (IsStringTerm(t1)) {
cmd = StringOfTerm(t1);
} else {
return false;
}
const char *rc = myrealpath( cmd );
if (!rc) {
PlIOError( SYSTEM_ERROR_OPERATING_SYSTEM, ARG1, strerror(errno));
return false;
}
bool r = Yap_unify(MkAtomTerm(Yap_LookupAtom( rc )), ARG2);
freeBuffer( (char *) rc );
return r;
}
#define EXPAND_FILENAME_DEFS() \
PAR("parameter_expansion", isatom, EXPAND_FILENAME_PARAMETER_EXPANSION), \
PAR("commands", booleanFlag, EXPAND_FILENAME_COMMANDS), \
PAR(NULL, ok, EXPAND_FILENAME_END)
#define PAR(x, y, z) z
typedef enum expand_filename_enum_choices {
EXPAND_FILENAME_DEFS()
} expand_filename_enum_choices_t;
#undef PAR
#define PAR(x, y, z) \
{ x, y, z }
static const param_t expand_filename_defs[] = {EXPAND_FILENAME_DEFS()};
#undef PAR
static Term
do_expand_file_name(Term t1, Term opts USES_REGS)
{
xarg *args;
expand_filename_enum_choices_t i;
bool use_system_expansion = true;
char *tmpe = NULL;
const char *spec;
Term tf;
if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR, t1, NULL);
return TermNil;
} else if (IsAtomTerm(t1)) {
spec = AtomTermName( t1 );
} else if (IsStringTerm(t1)) {
spec = StringOfTerm( t1 );
} else {
Yap_Error(TYPE_ERROR_ATOM, t1, NULL);
return TermNil;
}
args = Yap_ArgListToVector(opts, expand_filename_defs, EXPAND_FILENAME_END);
if (args == NULL) {
return TermNil;
}
tmpe = malloc(YAP_FILENAME_MAX+1);
for (i = 0; i < EXPAND_FILENAME_END; i++) {
if (args[i].used) {
Term t = args[i].tvalue;
switch (i) {
case EXPAND_FILENAME_PARAMETER_EXPANSION:
if (t == TermProlog) {
char *s = expandVars( spec);
if (s == NULL) {
return TermNil;
}
strcpy(tmpe, s);
} else if (t == TermTrue) {
use_system_expansion = true;
} else if (t == TermFalse) {
use_system_expansion = false;
}
break;
case EXPAND_FILENAME_COMMANDS:
if (!use_system_expansion) {
use_system_expansion = true;
#ifdef WRDE_NOCMD
if (t == TermFalse) {
flags = WRDE_NOCMD;
}
#endif
}
case EXPAND_FILENAME_END:
break;
}
}
}
if (!use_system_expansion) {
return MkPairTerm(MkAtomTerm(Yap_LookupAtom(spec)), TermNil);
}
tf = do_glob(spec, true);
return tf; return tf;
} }
@ -953,13 +978,11 @@ static char *canoniseFileName( char *path) {
return NULL; return NULL;
path = o; path = o;
#endif #endif
char *rc, *tmp = malloc(PATH_MAX); char *rc;
if (tmp == NULL) return NULL; if (tmp == NULL) return NULL;
rc = myrealpath(path, tmp); rc = myrealpath(path);
if (rc != tmp)
free(tmp);
#if _WIN32 || defined(__MINGW32__) #if _WIN32 || defined(__MINGW32__)
free(o); freeBuffer(o);
#endif #endif
return rc; return rc;
#endif #endif
@ -982,11 +1005,11 @@ absolute_file_system_path( USES_REGS1 )
Yap_Error(TYPE_ERROR_ATOM, t, "absolute_file_system_path"); Yap_Error(TYPE_ERROR_ATOM, t, "absolute_file_system_path");
return false; return false;
} }
if (!(fp = Yap_AbsoluteFile( RepAtom(AtomOfTerm(t))->StrOfAE, s, true))) if (!(fp = Yap_AbsoluteFile( RepAtom(AtomOfTerm(t))->StrOfAE, true)))
return false; return false;
rc = Yap_unify(MkAtomTerm(Yap_LookupAtom(fp)), ARG2); rc = Yap_unify(MkAtomTerm(Yap_LookupAtom(fp)), ARG2);
if (fp != s) if (fp != s)
free( (void *)fp ); freeBuffer( (void *)fp );
return rc; return rc;
} }
@ -1255,6 +1278,10 @@ Yap_InitPageSize(void)
/* TrueFileName -> Finds the true name of a file */ /* TrueFileName -> Finds the true name of a file */
bool Yap_trueFileName(const char *isource, const char *idef, const char *root,
char *result, bool access, file_type_t ftype,
bool expand_root, bool in_lib);
#ifdef __MINGW32__ #ifdef __MINGW32__
#include <ctype.h> #include <ctype.h>
#endif #endif
@ -1320,28 +1347,31 @@ Yap_InitPageSize(void)
} }
static const char * static const char *
expandWithPrefix(const char *source, const char *root, char *result) expandWithPrefix(const char *source, const char *root)
{ {
char *work; char *work;
char ares1[YAP_FILENAME_MAX+1];
work = expandVars( source );
work = expandVars( source, ares1, YAP_FILENAME_MAX);
// expand names first // expand names first
if (root && !Yap_IsAbsolutePath( source ) ) { if (root && !Yap_IsAbsolutePath( source ) ) {
char ares2[YAP_FILENAME_MAX+1]; char *s = expandVars( source);
strncpy( ares2, root, YAP_FILENAME_MAX ); if (!s)
strncat( ares2, "/", YAP_FILENAME_MAX ); return source;
strncat( ares2, work, YAP_FILENAME_MAX ); char *r0 = expandVars( root);
return Yap_AbsoluteFile( ares2, result , false); size_t sl = strlen(s);
} else { size_t rl = strlen(r0);
// expand path char *r = malloc( sl+rl+2);
return myrealpath( work, result); strncat( r, r0, sl+rl+2 );
strncat( r, "/", sl+rl+2 );
strncat( r, s , sl+rl+2);
return r;
} }
strncpy( LOCAL_FileNameBuf, work, MAXPATHLEN-1);
return LOCAL_FileNameBuf;
} }
/** Yap_trueFileName: tries to generate the true name of file /** Yap_trueFileName: tries to generate the true name of file
* aaaaaaaaaaaaaaaaaaaaa*
* *
* @param isource the proper file * @param isource the proper file
* @param idef the default name fo rthe file, ie, startup.yss * @param idef the default name fo rthe file, ie, startup.yss
@ -1452,11 +1482,9 @@ Yap_InitPageSize(void)
if (done) if (done)
continue; continue;
if (expand_root && root) {
root = expandWithPrefix( root, NULL, save_buffer );
}
// { CACHE_REGS __android_log_print(ANDROID_LOG_ERROR, __FUNCTION__, "root= %s %s ", root, source) ; } // { CACHE_REGS __android_log_print(ANDROID_LOG_ERROR, __FUNCTION__, "root= %s %s ", root, source) ; }
const char *work = expandWithPrefix( source, root, (char *)result ); const char *work = expandWithPrefix( source, root );
// expand names in case you have // expand names in case you have
// to add a prefix // to add a prefix
@ -1467,7 +1495,7 @@ Yap_InitPageSize(void)
} }
int int
Yap_TrueFileName (const char *source, char *result, int in_lib) Yap_TrueFileName (const char *source, char *result, bool in_lib)
{ {
return Yap_trueFileName (source, NULL, NULL, result, true, YAP_PL, true, in_lib); return Yap_trueFileName (source, NULL, NULL, result, true, YAP_PL, true, in_lib);
} }
@ -1491,7 +1519,7 @@ Yap_InitPageSize(void)
Yap_Error(TYPE_ERROR_ATOM,t,"argument to true_file_name"); Yap_Error(TYPE_ERROR_ATOM,t,"argument to true_file_name");
return FALSE; return FALSE;
} }
if (!Yap_trueFileName (RepAtom(AtomOfTerm(t))->StrOfAE, NULL, NULL, LOCAL_FileNameBuf, false, YAP_PL, false, false)) if (!Yap_AbsoluteFileInBuffer( RepAtom(AtomOfTerm(t))->StrOfAE, LOCAL_FileNameBuf, YAP_FILENAME_MAX-1, true))
return FALSE; return FALSE;
return Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf))); return Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf)));
} }
@ -1745,17 +1773,12 @@ Yap_InitPageSize(void)
/* Rename a file */
/** @pred rename(+ _F_,+ _G_)
Renames file _F_ to _G_.
*/
static Int static Int
p_mv ( USES_REGS1 ) p_mv ( USES_REGS1 )
{ /* rename(+OldName,+NewName) */ { /* rename(+OldName,+NewName) */
#if HAVE_LINK #if HAVE_LINK
int r; int r;
char oldname[YAP_FILENAME_MAX], newname[YAP_FILENAME_MAX]; char *oldname, *newname;
Term t1 = Deref (ARG1); Term t1 = Deref (ARG1);
Term t2 = Deref (ARG2); Term t2 = Deref (ARG2);
if (IsVarTerm(t1)) { if (IsVarTerm(t1)) {
@ -1767,11 +1790,9 @@ Yap_InitPageSize(void)
Yap_Error(INSTANTIATION_ERROR, t2, "second argument to rename/2 unbound"); Yap_Error(INSTANTIATION_ERROR, t2, "second argument to rename/2 unbound");
} else if (!IsAtomTerm(t2)) { } else if (!IsAtomTerm(t2)) {
Yap_Error(TYPE_ERROR_ATOM, t2, "second argument to rename/2 not atom"); Yap_Error(TYPE_ERROR_ATOM, t2, "second argument to rename/2 not atom");
} } else {
if (!Yap_trueFileName (RepAtom(AtomOfTerm(t1))->StrOfAE, NULL, NULL, oldname, true, YAP_STD, true, false)) oldname = (RepAtom(AtomOfTerm(t1)))->StrOfAE;
return FALSE; newname = (RepAtom(AtomOfTerm(t2)))->StrOfAE;
if (!Yap_trueFileName (RepAtom(AtomOfTerm(t2))->StrOfAE, NULL, NULL, oldname, true, YAP_STD, true, false))
return FALSE;
if ((r = link (oldname, newname)) == 0 && (r = unlink (oldname)) != 0) if ((r = link (oldname, newname)) == 0 && (r = unlink (oldname)) != 0)
unlink (newname); unlink (newname);
if (r != 0) { if (r != 0) {
@ -1780,13 +1801,14 @@ Yap_InitPageSize(void)
#else #else
Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM,t2,"in rename(%s,%s)",oldname,newname); Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM,t2,"in rename(%s,%s)",oldname,newname);
#endif #endif
return FALSE; return false;
}
return true;
} }
return TRUE;
#else #else
Yap_Error(SYSTEM_ERROR_INTERNAL,TermNil,"rename/2 not available in this machine"); Yap_Error(SYSTEM_ERROR_INTERNAL,TermNil,"rename/2 not available in this machine");
return (FALSE);
#endif #endif
return false;
} }
@ -2250,7 +2272,7 @@ Yap_InitPageSize(void)
Yap_InitCPred ("sh", 0, p_sh, SafePredFlag|SyncPredFlag); Yap_InitCPred ("sh", 0, p_sh, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$shell", 1, p_shell, SafePredFlag|SyncPredFlag); Yap_InitCPred ("$shell", 1, p_shell, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("system", 1, p_system, SafePredFlag|SyncPredFlag|UserCPredFlag); Yap_InitCPred ("system", 1, p_system, SafePredFlag|SyncPredFlag|UserCPredFlag);
Yap_InitCPred ("rename", 2, p_mv, SafePredFlag|SyncPredFlag); Yap_InitCPred ("$rename", 2, p_mv, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$yap_home", 1, p_yap_home, SafePredFlag); Yap_InitCPred ("$yap_home", 1, p_yap_home, SafePredFlag);
Yap_InitCPred ("$yap_paths", 3, p_yap_paths, SafePredFlag); Yap_InitCPred ("$yap_paths", 3, p_yap_paths, SafePredFlag);
Yap_InitCPred ("$dir_separator", 1, p_dir_sp, SafePredFlag); Yap_InitCPred ("$dir_separator", 1, p_dir_sp, SafePredFlag);
@ -2275,7 +2297,7 @@ Yap_InitPageSize(void)
Yap_InitCPred ("win_registry_get_value", 3, p_win_registry_get_value,0); Yap_InitCPred ("win_registry_get_value", 3, p_win_registry_get_value,0);
#endif #endif
Yap_InitCPred ("absolute_file_system_path", 2, absolute_file_system_path, 0); Yap_InitCPred ("absolute_file_system_path", 2, absolute_file_system_path, 0);
Yap_InitCPred ("prolog_expanded_file_system_path", 4, prolog_expanded_file_system_path, 0); Yap_InitCPred ("real_path", 2, prolog_realpath, 0);
Yap_InitCPred ("true_file_name", 2, Yap_InitCPred ("true_file_name", 2,
true_file_name, SyncPredFlag); true_file_name, SyncPredFlag);
Yap_InitCPred ("true_file_name", 3, true_file_name3, SyncPredFlag); Yap_InitCPred ("true_file_name", 3, true_file_name3, SyncPredFlag);

2
os/yapio.h
View File

@ -114,7 +114,7 @@ int Yap_growtrail_in_parser(tr_fr_ptr *, TokEntry **, VarEntry **);
bool Yap_IsAbsolutePath(const char *p); bool Yap_IsAbsolutePath(const char *p);
Atom Yap_TemporaryFile(const char *prefix, int *fd); Atom Yap_TemporaryFile(const char *prefix, int *fd);
const char *Yap_AbsoluteFile(const char *spec, char *tmp, bool expand); const char *Yap_AbsoluteFile(const char *spec, bool expand);
typedef enum mem_buf_source { typedef enum mem_buf_source {
MEM_BUF_CODE = 1, MEM_BUF_CODE = 1,

410
pl/absf.yap
View File

@ -170,43 +170,43 @@ absolute_file_name(File0,File) :-
solutions(first), solutions(first),
expand(true)],F,G). expand(true)],F,G).
'$absolute_file_name'(File, _Opts, _TrueFileName, G) :- var(File), !,
'$do_error'(instantiation_error, G).
'$absolute_file_name'(File,LOpts,TrueFileName, G) :- '$absolute_file_name'(File,LOpts,TrueFileName, G) :-
% must_be_of_type( atom, File ),
abs_file_parameters(LOpts,Opts),
current_prolog_flag(open_expands_filename, OldF), current_prolog_flag(open_expands_filename, OldF),
current_prolog_flag( fileerrors, PreviousFileErrors ), current_prolog_flag( fileerrors, PreviousFileErrors ),
current_prolog_flag( verbose_file_search, PreviousVerbose ), current_prolog_flag( verbose_file_search, PreviousVerbose ),
abs_file_parameters(LOpts,Opts),
get_abs_file_parameter( verbose_file_search, Opts, Verbose ), get_abs_file_parameter( verbose_file_search, Opts, Verbose ),
get_abs_file_parameter( expand, Opts, Expand ), get_abs_file_parameter( expand, Opts, Expand ),
set_prolog_flag( verbose_file_search, Verbose ), set_prolog_flag( verbose_file_search, Verbose ),
get_abs_file_parameter( file_errors, Opts, FErrors ), get_abs_file_parameter( file_errors, Opts, FErrors ),
get_abs_file_parameter( solutions, Opts, First ),
( FErrors == fail -> ( FErrors == fail ->
set_prolog_flag( fileerrors, false ) set_prolog_flag( fileerrors, false )
; ;
set_prolog_flag( fileerrors, true ) set_prolog_flag( fileerrors, true )
), ),
set_prolog_flag(file_name_variables, Expand), set_prolog_flag(file_name_variables, Expand),
'$absf_trace'('search for ~w with options ~w', [File, LOpts] ), '$absf_trace'(File),
'$find_in_path'(File, Opts,TrueFileName,G), '$absf_trace_options'(LOpts),
'$find_in_path'(File, Opts,TrueFileName),
( (
get_abs_file_parameter( solutions, Opts, first ) First == first
-> ->
'$absf_trace'('found solution ~a', [TrueFileName] ), '$absf_trace'(' got first ~a', [TrueFileName]),
% stop_lowxb( _level_trace, % stop_low_level_trace,
set_prolog_flag( fileerrors, PreviousFileErrors ), set_prolog_flag( fileerrors, PreviousFileErrors ),
set_prolog_flag( open_expands_filename, OldF), set_prolog_flag( open_expands_filename, OldF),
set_prolog_flag( verbose_file_search, PreviousVerbose ), set_prolog_flag( verbose_file_search, PreviousVerbose ),
'$absf_trace'('first solution only', [] ),
! !
; ;
( (
'$absf_trace'('found solution ~a', [TrueFileName] ), '$absf_trace'(' found match ~a.', [TrueFileName]),
% stop_low_level_trace,
set_prolog_flag( fileerrors, PreviousFileErrors ), set_prolog_flag( fileerrors, PreviousFileErrors ),
set_prolog_flag( file_name_variables, OldF), set_prolog_flag( file_name_variables, OldF),
set_prolog_flag( verbose_file_search, PreviousVerbose ) set_prolog_flag( verbose_file_search, PreviousVerbose )
; ;
'$absf_trace'(' no more solutions.', []),
set_prolog_flag( verbose_file_search, Verbose ), set_prolog_flag( verbose_file_search, Verbose ),
get_abs_file_parameter( file_errors, Opts, FErrors ), get_abs_file_parameter( file_errors, Opts, FErrors ),
set_prolog_flag(file_name_variables, Expand), set_prolog_flag(file_name_variables, Expand),
@ -215,6 +215,7 @@ absolute_file_name(File0,File) :-
; ;
% no solution % no solution
% stop_low_level_trace, % stop_low_level_trace,
'$absf_trace'(' failed.', []),
set_prolog_flag( fileerrors, PreviousFileErrors ), set_prolog_flag( fileerrors, PreviousFileErrors ),
set_prolog_flag( verbose_file_search, PreviousVerbose ), set_prolog_flag( verbose_file_search, PreviousVerbose ),
set_prolog_flag(file_name_variables, OldF), set_prolog_flag(file_name_variables, OldF),
@ -227,95 +228,157 @@ absolute_file_name(File0,File) :-
% library(F) must check library_directories % library(F) must check library_directories
% T(F) must check file_search_path % T(F) must check file_search_path
% all must try search in path % all must try search in path
'$find_in_path'(user,_,user_input, _) :- !. '$find_in_path'(user,_,user_input) :- !.
'$find_in_path'(user_input,_,user_input, _) :- !. '$find_in_path'(user_input,_,user_input) :- !.
'$find_in_path'(S, Opts, NewFile, Call) :- '$find_in_path'(user_output,_,user_ouput) :- !.
S =.. [Name,File0], '$find_in_path'(user_error,_,user_error) :- !.
'$cat_file_name'(File0,File), !, '$find_in_path'(Name, Opts, File) :-
'$absf_trace'('~w(~w) to ~w', [Name, File0, File] ), % ( atom(Name) -> true ; start_low_level_trace ),
'$dir_separator'(D), get_abs_file_parameter( file_type, Opts, Type ),
atom_codes(A,[D]), get_abs_file_parameter( access, Opts, Access ),
'$extend_path_directory'(Name, A, File, Opts, NewFile, Call). get_abs_file_parameter( expand, Opts, Expand ),
'$find_in_path'(File0,Opts,NewFile,_) :- '$absf_trace'('start with ~w', [Name]),
'$cat_file_name'(File0,File), !, '$core_file_name'(Name, Opts, CorePath, []),
'$add_path'(File, Opts, PFile), '$absf_trace'(' after name/library unfolding: ~w', [Name]),
'$get_abs_file'(PFile,Opts,AbsFile), '$prefix'(CorePath, Opts, Path , CorePath),
'$absf_trace'('~w to ~w', [PFile, NewFile] ), '$absf_trace'(' after prefix expansion: ~s', [Path]),
'$search_in_path'(AbsFile,Opts,NewFile). atom_codes( APath, Path ),
'$find_in_path'(File,_,_,Call) :- (
'$do_error'(domain_error(source_sink,File),Call). Expand = true
->
expand_file_name( APath, EPaths),
'$absf_trace'(' after variable expansion/globbing: ~w', [EPaths]),
lists:member(EPath, EPaths)
;
EPath = APath
),
real_path( EPath, File),
'$absf_trace'(' after canonical path name: ~a', [File]),
'$check_file'( File, Type, Access ),
'$absf_trace'(' after testing ~a for ~a and ~a', [File,Type,Access]).
% allow paths in File Name % allow paths in File Name
'$cat_file_name'(File0,File) :- '$core_file_name'(Name, Opts) -->
atom(File0), !, '$file_name'(Name, Opts, E),
File = File0. '$suffix'(E, Opts),
'$cat_file_name'(Atoms, File) :- '$glob'(Opts).
'$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), !. % handle library(lists) or foreign(jpl)
'$to_list_of_atoms'(Atoms, L1, LF) :- %
Atoms =.. [A,As,Bs], '$file_name'(Name, Opts, E) -->
atom_codes(A,[D]), { Name =.. [Lib, P0] },
'$dir_separator'(D), !,
'$to_list_of_atoms'(As, L1, [A|L2]), { user:file_search_path(Lib, IDirs) },
'$to_list_of_atoms'(Bs, L2, LF). { '$paths'(IDirs, Dir ) },
'$absf_trace'(' ~w first', [Dir]),
'$get_abs_file'(File,Opts, ExpFile) :- '$file_name'(Dir, Opts, _),
'$control_for_expansion'(Opts, Expand), '$dir',
get_abs_file_parameter( relative_to, Opts, RelTo ), { '$absf_trace'(' ~w next', [P0]) },
prolog_expanded_file_system_path( File, Expand, RelTo, ExpFile ), '$cat_file_name'(P0, E).
'$absf_trace'('Traditional expansion: ~w', [ExpFile] ). '$file_name'(Name, _Opts, E) -->
'$cat_file_name'(Name, E).
'$control_for_expansion'(Opts, true) :- '$cat_file_name'(A/B, E ) -->
'$cat_file_name'(A, _),
'$dir',
'$cat_file_name'(B, E).
'$cat_file_name'(File, F) -->
{ atom(File), atom_codes(File, F) },
!,
F.
'$cat_file_name'(File, S) -->
{string(File), string_to_codes(File, S) },
!,
S.
% / separates both unix and windows path
'$absolute_path'( [0'/|_], _Opts ) :- !.
'$absolute_path'( [0'~|_], Opts ) :-
get_abs_file_parameter( expand, Opts, true ), get_abs_file_parameter( expand, Opts, true ),
!. !.
'$control_for_expansion'(_Opts, Flag) :- '$absolute_path'( [0'$|L], Opts ) :-
current_prolog_flag( open_expands_filename, Flag ). get_abs_file_parameter( expand, Opts, true ),
'$var'(L),
!.
% \ windows path
'$absolute_path'( [0'\\|_], _Opts ) :-
current_prolog_flag(windows, true),
!.
% windows drive
'$absolute_path'( Path, _Opts ) :-
current_prolog_flag(windows, true),
'$drive'( Path, _ ).
'$var'(S) -->
"{", !, '$id'(S), "}".
'$var'(S) -->
'$id'(S).
'$drive' -->
'$id'(_),
":\\\\".
'$id'([C|S]) --> [S],
{ C >= "a", C =< "z" ; C >= "A", C =< "Z" ;
C >= "0", C =< "9" ; C =:= "_" },
!,
'$id'(S).
'$id'([]) --> [].
'$search_in_path'(File,Opts,F) :- % always verify if a directory
get_abs_file_parameter( extensions, Opts, Extensions ), '$check_file'(F, directory, _) :-
'$absf_trace'('check extensions ~w?', [Extensions] ), !,
'$add_extensions'(Extensions, File, F0), exists_directory(F).
'$glob'( F0, Opts, FG), '$check_file'(_F, _Type, none) :- !.
get_abs_file_parameter( file_type, Opts, Type ), '$check_file'(F, _Type, Access) :-
get_abs_file_parameter( access, Opts, Access ), '$access_file'(F, Access),
'$check_file'(FG,Type, Access, F), \+ exists_directory(F). % if it has a type cannot be a directory..
'$absf_trace'(' ~a ok!', [Access]).
'$search_in_path'(File,Opts,F) :-
get_abs_file_parameter( file_type, Opts, Type ),
'$absf_trace'('check type ~w', [Type] ),
'$add_type_extensions'(Type,File, F0),
get_abs_file_parameter( access, Opts, Access ),
'$glob'( F0, Opts, FG),
'$check_file'(FG, Type, Access, F),
'$absf_trace'(' ~w ok!', [Access]).
'$glob'( File1, Opts, ExpFile) :- '$suffix'(Last, _Opts) -->
'$control_for_expansion'(Opts, Expand), { lists:append(_, [0'.|Alphas], Last), '$id'(Alphas, _, [] ) },
get_abs_file_parameter( glob, Opts, Glob ), '$absf_trace'(' suffix in ~s', [Last]),
(Glob \== '' !.
'$suffix'(_, Opts) -->
{
(
get_abs_file_parameter( extensions, Opts, Exts ),
Exts \= []
-> ->
'$dir_separator'(D), lists:member(Ext, Exts),
atom_codes(DA,[D]), '$absf_trace'(' trying suffix ~a from ~w', [Ext,Exts])
atom_concat( [File1, DA, Glob], File2 ),
expand_file_name(File2, ExpFiles),
% glob is not very much into failing
%[File2] \== ExpFiles,
'$enumerate_glob'(File2, ExpFiles, ExpFile)
; ;
Expand == true get_abs_file_parameter( file_type, Opts, Type ),
-> ( Type == source -> NType = prolog ; NType = Type ),
expand_file_name(File1, ExpFiles), user:prolog_file_type(Ext, NType)
'$enumerate_glob'(File1, ExpFiles, ExpFile)
;
File1 = ExpFile
), ),
'$absf_trace'(' With globbing (glob=~q;expand=~a): ~w', [Glob,Expand,ExpFile] ). '$absf_trace'(' trying suffix ~a from type ~a', [Ext, NType]),
atom_codes(Ext, Cs)
},
'$add_suffix'(Cs).
'$suffix'(_,_Opts) -->
'$absf_trace'(' try no suffix', []).
'$add_suffix'(Cs) -->
{ Cs = [0'. |_Codes] }
->
Cs
;
".", Cs.
'$glob'(Opts) -->
{
get_abs_file_parameter( glob, Opts, G ),
G \= '',
atom_codes( G, Gs )
},
'$dir',
Gs.
'$glob'(_Opts) -->
[].
'$enumerate_glob'(_File1, [ExpFile], ExpFile) :- '$enumerate_glob'(_File1, [ExpFile], ExpFile) :-
!. !.
@ -325,55 +388,45 @@ absolute_file_name(File0,File) :-
Base \= '.', Base \= '.',
Base \='..'. Base \='..'.
'$prefix'( CorePath, Opts) -->
% always verify if a directory { '$absolute_path'( CorePath, Opts ) },
'$check_file'(F, directory, _, F) :- '$absf_trace'(' rooted ~s', [CorePath]),
!.
'$prefix'( _, Opts) -->
{ get_abs_file_parameter( relative_to, Opts, Prefix ),
Prefix \= '',
'$absf_trace'(' relative_to ~a', [Prefix]),
sub_atom(Prefix, _, 1, 0, Last),
atom_codes(Prefix, S)
},
!, !,
exists_directory(F). S,
'$check_file'(F, _Type, none, F) :- !. '$dir'(Last).
'$check_file'(F0, _Type, Access, F0) :- '$prefix'( _ , _) -->
access_file(F0, Access), {
\+ exists_directory(F0). % if it has a type cannot be a directory.. recorded('$path',Prefix,_),
'$absf_trace'(' try YAP path database ~a', [Prefix]),
sub_atom(Prefix, _, _, 1, Last),
atom_codes(Prefix, S) },
S,
'$dir'(Last).
'$prefix'(_,_ ) -->
'$absf_trace'(' empty prefix', []).
'$add_extensions'([Ext|_], File,F) :-
'$absf_trace'(' extension ~w', [Ext] ),
'$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) :- '$dir' --> { current_prolog_flag(windows, true) },
atom_codes(Ext,[C|L]),
C \= 0'.,
!, !,
atom_codes(NExt,[0'.,C|L]). "\\".
'$mk_sure_true_ext'(Ext,Ext). '$dir' --> "/".
'$add_type_extensions'(Type,File,F) :- '$dir'('/') --> !.
( Type == source -> NType = prolog ; NType = Type ), '$dir'('\\') --> { current_prolog_flag(windows, true) },
user:prolog_file_type(Ext, NType), !.
atom_concat([File,'.',Ext],F), '$dir'(_) --> '$dir'.
'$absf_trace'(' extension ~w?', [F] ).
'$add_type_extensions'(_,File,File) :-
'$absf_trace'(' wo extension ~w?', [File] ).
'$add_path'(File, _, File) :-
is_absolute_file_name(File), !.
'$add_path'(File, Opts, File) :-
( get_abs_file_parameter( relative_to, Opts, Dir ) ->
true
;
working_directory(Dir, Dir)
),
'$dir_separator'( D ),
atom_codes( DSep, [D] ),
atomic_concat([Dir, DSep,File],PFile),
'$absf_trace'(' try . or ~a: ~a', [Dir,PFile] ).
'$add_path'(File, PFile) :-
recorded('$path',Path,_),
atom_concat([Path,File],PFile),
'$absf_trace'(' try ~a from path-data base: ~a', [Path, PFile] ).
%
%
%
'$system_library_directories'(library, Dir) :- '$system_library_directories'(library, Dir) :-
user:library_directory( Dir ). user:library_directory( Dir ).
% '$split_by_sep'(0, 0, Dirs, Dir). % '$split_by_sep'(0, 0, Dirs, Dir).
@ -384,67 +437,26 @@ absolute_file_name(File0,File) :-
'$system_library_directories'(commons, Dir) :- '$system_library_directories'(commons, Dir) :-
commons_directory( Dir ). commons_directory( Dir ).
'$split_by_sep'(Start, Next, Dirs, Dir) :-
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) :- % enumerate all paths separated by a path_separator.
sub_atom(Dirs, Next, 1, _, Let), !, '$paths'(Cs, C) :-
'$continue_split_by_sep'(Let, Start, Next, Dirs, Sep, Dir). atom(Cs),
'$split_by_sep'(Start, Next, Dirs, _Sep, Dir) :- ( current_prolog_flag(windows, true) -> Sep = ';' ; Sep = ':' ),
Next > Start, sub_atom(Cs, N0, 1, N, Sep),
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),
'$absf_trace'('file_search_path ~a is ~w', [Name, IDirs] ),
ground(IDirs),
( (
'$extend_path_directory'(IDirs, D, File, Opts, NewFile, Call) sub_atom(Cs,0,N0,_,C)
; ;
atom(IDirs) -> sub_atom(Cs,_,N,0,RC),
'$split_by_sep'(0, 0, IDirs, Dir) '$paths'(RC, C)
; ).
Dir = IDirs '$paths'(S, S).
),
'$extend_pathd'(Dir, D, File, Opts, NewFile, Call).
'$extend_pathd'(Dir, A, File, Opts, NewFile, Goal) :- '$absf_trace'(Msg, Args ) -->
atom(Dir), !, { current_prolog_flag( verbose_file_search, true ) },
'$add_file_to_dir'(Dir,A,File,NFile), !,
'$absf_trace'(' try ~a', [NFile] ), { print_message( informational, absolute_file_path( Msg, Args ) ) }.
'$find_in_path'(NFile, Opts, NewFile, Goal), !. '$absf_trace'(_Msg, _Args ) --> [].
'$extend_pathd'(Name, A, File, Opts, OFile, Goal) :-
nonvar(Name),
Name =.. [N,P0],
'$add_file_to_dir'(P0,A,File,NFile),
NewName =.. [N,NFile],
'$absf_trace'(' try ~q', [NewName] ),
'$find_in_path'(NewName, Opts, OFile, Goal).
'$add_file_to_dir'(P0,A,Atoms,NFile) :-
atom_concat([P0,A,Atoms],NFile).
'$absf_trace'(Msg, Args ) :- '$absf_trace'(Msg, Args ) :-
current_prolog_flag( verbose_file_search, true ), current_prolog_flag( verbose_file_search, true ),
@ -452,6 +464,18 @@ absolute_file_name(File0,File) :-
print_message( informational, absolute_file_path( Msg, Args ) ). print_message( informational, absolute_file_path( Msg, Args ) ).
'$absf_trace'(_Msg, _Args ). '$absf_trace'(_Msg, _Args ).
'$absf_trace'( File ) :-
current_prolog_flag( verbose_file_search, true ),
!,
print_message( informational, absolute_file_path( File ) ).
'$absf_trace'( _File ).
'$absf_trace_options'(Args ) :-
current_prolog_flag( verbose_file_search, true ),
!,
print_message( informational, arguments( Args ) ).
'$absf_trace_options'( _Args ).
/** @pred prolog_file_name( +File, -PrologFileaNme) /** @pred prolog_file_name( +File, -PrologFileaNme)
Unify _PrologFileName_ with the Prolog file associated to _File_. Unify _PrologFileName_ with the Prolog file associated to _File_.
@ -560,14 +584,11 @@ system_library/1.
% %
% 1. honor YAPSHAREDIR % 1. honor YAPSHAREDIR
user:library_directory( Dir ) :- user:library_directory( Dir ) :-
getenv( 'YAPSHAREDIR', Dir0), getenv( 'YAPSHAREDIR', Dir).
absolute_file_name( Dir0, [file_type(directory), expand(true),file_errors(fail)], Dir ).
%% 2. honor user-library %% 2. honor user-library
user:library_directory( Dir ) :- user:library_directory( '~/share/Yap' ).
absolute_file_name( '~/share/Yap', [file_type(directory), expand(true),file_errors(fail)], Dir ).
%% 3. honor current directory %% 3. honor current directory
user:library_directory( Dir ) :- user:library_directory( '.' ).
absolute_file_name( '.', [file_type(directory), expand(true),file_errors(fail)], Dir ).
%% 4. honor default location. %% 4. honor default location.
user:library_directory( Dir ) :- user:library_directory( Dir ) :-
system_library( Dir ). system_library( Dir ).
@ -663,7 +684,7 @@ file_search_path(swi, Home) :-
current_prolog_flag(home, Home). current_prolog_flag(home, Home).
file_search_path(yap, Home) :- file_search_path(yap, Home) :-
current_prolog_flag(home, Home). current_prolog_flag(home, Home).
file_search_path,(system, Dir) :- file_search_path(system, Dir) :-
prolog_flag(host_type, Dir). prolog_flag(host_type, Dir).
file_search_path(foreign, Dir) :- file_search_path(foreign, Dir) :-
foreign_directory(Dir). foreign_directory(Dir).
@ -698,8 +719,7 @@ user:file_search_path(yap, Home) :-
current_prolog_flag(home, Home). current_prolog_flag(home, Home).
user:file_search_path(system, Dir) :- user:file_search_path(system, Dir) :-
prolog_flag(host_type, Dir). prolog_flag(host_type, Dir).
user:file_search_path(foreign, Dir) :- user:file_search_path(foreign, '.').
working_directory(Dir,Dir).
user:file_search_path(foreign, yap('lib/Yap')). user:file_search_path(foreign, yap('lib/Yap')).
user:file_search_path(path, C) :- user:file_search_path(path, C) :-
( getenv('PATH', A), ( getenv('PATH', A),

1
pl/arith.yap
View File

@ -129,7 +129,6 @@ do_c_built_in(Mod:G, _, H, OUT) :-
'$yap_strip_module'(Mod:G, M1, G1), '$yap_strip_module'(Mod:G, M1, G1),
var(G1), !, var(G1), !,
do_c_built_metacall(G1, M1, H, OUT). do_c_built_metacall(G1, M1, H, OUT).
do_c_built_in('C'(A,B,C), _, _, (A=[B|C])) :- !.
do_c_built_in('$do_error'( Error, Goal), M, Head, do_c_built_in('$do_error'( Error, Goal), M, Head,
(clause_location(Call, Caller), (clause_location(Call, Caller),
strip_module(M:Goal,M1,NGoal), strip_module(M:Goal,M1,NGoal),

7
pl/debug.yap
View File

@ -307,7 +307,6 @@ be lost.
%'$do_spy'(V, M, CP, Flag) :- %'$do_spy'(V, M, CP, Flag) :-
% writeln('$do_spy'(V, M, CP, Flag)), fail. % writeln('$do_spy'(V, M, CP, Flag)), fail.
'$do_spy'(V, M, CP, Flag) :- '$do_spy'(V, M, CP, Flag) :-
'$stop_low_level_trace',
'$stop_creeping'(_), '$stop_creeping'(_),
var(V), !, var(V), !,
'$do_spy'(call(V), M, CP, Flag). '$do_spy'(call(V), M, CP, Flag).
@ -543,7 +542,7 @@ be lost.
'$spycall'(G, M, _, _) :- '$spycall'(G, M, _, _) :-
( '$is_system_predicate'(G,M) ; '$tabled_predicate'(G,M) ), ( '$is_system_predicate'(G,M) ; '$tabled_predicate'(G,M) ),
!, !,
'$continue_debugging_goal'(no, '$execute_nonstop'(G,M)). '$continue_debugging_goal'(yes, '$execute_nonstop'(G,M)).
'$spycall'(G, M, CalledFromDebugger, InRedo) :- '$spycall'(G, M, CalledFromDebugger, InRedo) :-
'$spycall_expanded'(G, M, CalledFromDebugger, InRedo). '$spycall_expanded'(G, M, CalledFromDebugger, InRedo).
@ -568,13 +567,13 @@ be lost.
*-> *->
'$stop_creeping'(_), '$stop_creeping'(_),
( (
'$continue_debugging_goal'(no, '$execute_clause'(G, M, R, CP)) '$continue_debugging_goal'(yes, '$execute_clause'(G, M, R, CP))
; ;
InRedo = true InRedo = true
) )
) )
; ;
( '$continue_debugging_goal'(no, '$execute_nonstop'(G,M) ) ; InRedo = true ) ( '$continue_debugging_goal'(yes, '$execute_nonstop'(G,M) ) ; InRedo = true )
). ).
% I may backtrack to here from far away % I may backtrack to here from far away

4
pl/error.yap
View File

@ -105,6 +105,9 @@ must_be(Type, X, Comment) :-
must_be_of_type(callable, X) :- must_be_of_type(callable, X) :-
!, !,
is_callable(X, _). is_callable(X, _).
must_be_of_type(atom, X) :-
!,
is_atom(X, _).
must_be_of_type(predicate_indicator, X) :- must_be_of_type(predicate_indicator, X) :-
!, !,
is_predicate_indicator(X, _). is_predicate_indicator(X, _).
@ -115,6 +118,7 @@ must_be_of_type(Type, X) :-
). ).
inline(must_be_of_type( callable, X ), error:is_callable(X, _) ). inline(must_be_of_type( callable, X ), error:is_callable(X, _) ).
inline(must_be_of_type( callable, X ), error:is_callable(X, _) ).
must_be_of_type(predicate_indicator, X, Comment) :- must_be_of_type(predicate_indicator, X, Comment) :-
!, !,

32
pl/grammar.yap
View File

@ -70,7 +70,7 @@ Grammar related built-in predicates:
*/ */
:- module( system('$_grammar'), [!/2, :- system_module( '$_grammar', [!/2,
(',')/4, (',')/4,
(->)/4, (->)/4,
('.')/4, ('.')/4,
@ -82,9 +82,7 @@ Grammar related built-in predicates:
phrase/2, phrase/2,
phrase/3, phrase/3,
{}/3, {}/3,
('|')/4]). ('|')/4], ['$do_error'/2]).
:- use_system_module( '$_errors', ['$do_error'/2]).
:- use_module( library( expand_macros ) ). :- use_module( library( expand_macros ) ).
@ -232,9 +230,24 @@ prolog:phrase(PhraseDef, WordList) :-
This predicate succeeds when the difference list ` _L_- _R_` This predicate succeeds when the difference list ` _L_- _R_`
is a phrase of type _P_. is a phrase of type _P_.
*/ */
prolog:phrase(V, S0, S) :-
var(V),
!,
'$do_error'(instantiation_error,phrase(V,S0,S)).
prolog:phrase([H|T], S0, S) :-
!,
S0 = [H|S1],
'$phrase_list'(T, S1, S).
prolog:phrase([], S0, S) :-
!,
S0 = S.
prolog:phrase(P, S0, S) :- prolog:phrase(P, S0, S) :-
call(P, S0, S). call(P, S0, S).
'$phrase_list'([], S, S).
'$phrase_list'([H|T], [H|S1], S0) :-
'$phrase_list'(T, S1, S0).
prolog:!(S, S). prolog:!(S, S).
prolog:[](S, S). prolog:[](S, S).
@ -306,19 +319,16 @@ prolog:'$goal_expansion_allowed'.
NewGoal = '$execute_in_mod'(NewGoal3,M) NewGoal = '$execute_in_mod'(NewGoal3,M)
). ).
allowed_module(phrase(_,_),_). do_c_built_in('C'(A,B,C), _, _, (A=[B|C])) :- !.
allowed_module(phrase(_,_,_),_).
do_c_built_in(phrase(NT,Xs0, Xs),Mod, _, NewGoal) :-
system:goal_expansion(Mod:phrase(NT,Xs0, Xs),Mod:NewGoal) :-
nonvar(NT), nonvar(Mod), !, nonvar(NT), nonvar(Mod), !,
'$goal_expansion_allowed', '$goal_expansion_allowed',
'$c_built_in_phrase'(NT, Xs0, Xs, Mod, NewGoal). '$c_built_in_phrase'(NT, Xs0, Xs, Mod, NewGoal).
system:goal_expansion(Mod:phrase(NT,Xs),Mod:NewGoal) :- do_c_built_in(phrase(NT,Xs),Mod,_,NewGoal) :-
nonvar(NT), nonvar(Mod), nonvar(NT), nonvar(Mod),
'$goal_expansion_allowed', '$c_built_in_phrase'(NT, Xs, [], Mod, NewGoal).
'$c_built_in_phrase'(NT, [], Xs, Mod, NewGoal).
/** /**
@} @}

11
pl/init.yap
View File

@ -120,7 +120,7 @@ otherwise.
'$early_print_message'(Level, Msg) :- '$early_print_message'(Level, Msg) :-
source_location(F0, L), source_location(F0, L),
!, !,
format(user_error, '~a:~d: unprocessed ~a ~w ~n', [F0, L,Level,Msg]). format(user_error, '~a:~d:0: unprocessed ~a ~w ~n', [F0, L,Level,Msg]).
'$early_print_message'(Level, Msg) :- '$early_print_message'(Level, Msg) :-
format(user_error, 'unprocessed ~a ~w ~n', [Level,Msg]). format(user_error, 'unprocessed ~a ~w ~n', [Level,Msg]).
@ -135,6 +135,9 @@ print_message(Level, Msg) :-
:- bootstrap('arith.yap'). :- bootstrap('arith.yap').
:- compile_expressions.
:- bootstrap('lists.yap'). :- bootstrap('lists.yap').
:- bootstrap('consult.yap'). :- bootstrap('consult.yap').
:- bootstrap('preddecls.yap'). :- bootstrap('preddecls.yap').
@ -145,14 +148,12 @@ print_message(Level, Msg) :-
:- bootstrap('atoms.yap'). :- bootstrap('atoms.yap').
:- bootstrap('os.yap'). :- bootstrap('os.yap').
:- bootstrap('grammar.yap').
:- bootstrap('absf.yap'). :- bootstrap('absf.yap').
:- set_prolog_flag(verbose, normal).
%:-set_prolog_flag(gc_trace, verbose). %:-set_prolog_flag(gc_trace, verbose).
%:- set_prolog_flag( verbose_file_search, true ). %:- set_prolog_flag( verbose_file_search, true ).
:- compile_expressions.
:- dynamic prolog:'$parent_module'/2. :- dynamic prolog:'$parent_module'/2.
:- [ :- [
@ -162,8 +163,6 @@ print_message(Level, Msg) :-
]. ].
:- use_module('error.yap'). :- use_module('error.yap').
:- use_module('grammar.yap').
:- [ :- [
'errors.yap', 'errors.yap',

25
pl/load_foreign.yap
View File

@ -51,7 +51,7 @@ variable:
if defined, or in the default library. if defined, or in the default library.
YAP also supports the SWI-Prolog interface to loading foreign code: YAP supports the SWI-Prolog interface to loading foreign code, the shlib package.
*/ */
load_foreign_files(Objs,Libs,Entry) :- load_foreign_files(Objs,Libs,Entry) :-
@ -75,6 +75,29 @@ load_foreign_files(Objs,Libs,Entry) :-
), ),
!. !.
/** @pred load_absolute_foreign_files( _Files_, _Libs_, _InitRoutine_)
Loads object files produced by the C compiler. It is useful when no search should be performed and instead one has the full paths to the _Files_ and _Libs_.
*/
load_absolute_foreign_files(Objs,Libs,Entry) :-
source_module(M),
(
recordzifnot( '$foreign', M:'$foreign'(Objs,Libs,Entry), _)
->
'$load_foreign_files'(Objs,Libs,Entry),
(
prolog_load_context(file, F)
->
ignore( recordzifnot( '$load_foreign_done', [F, M], _) )
;
true
)
;
true
),
!.
'$check_objs_for_load_foreign_files'(V,_,G) :- var(V), !, '$check_objs_for_load_foreign_files'(V,_,G) :- var(V), !,
'$do_error'(instantiation_error,G). '$do_error'(instantiation_error,G).
'$check_objs_for_load_foreign_files'([],[],_) :- !. '$check_objs_for_load_foreign_files'([],[],_) :- !.

86
pl/messages.yap
View File

@ -105,10 +105,18 @@ compose_message( Term, _Level ) -->
prolog:message(Term), !. prolog:message(Term), !.
compose_message( query(_QueryResult,_), _Level) --> compose_message( query(_QueryResult,_), _Level) -->
[]. [].
compose_message( absolute_file_path(File), _Level) -->
[ '~N~n absolute_file of ~w' - [File] ].
compose_message( absolute_file_path(Msg, Args), _Level) --> compose_message( absolute_file_path(Msg, Args), _Level) -->
[ ' absolute_file_path: ' - [], [ ' : ' - [],
Msg - Args, Msg - Args,
nl ]. nl ].
compose_message( arguments([]), _Level) -->
[].
compose_message( arguments([A|As]), Level) -->
[ ' ~w' - [A],
nl ],
compose_message( arguments(As), Level).
compose_message( ancestors([]), _Level) --> compose_message( ancestors([]), _Level) -->
[ 'There are no ancestors.' ]. [ 'There are no ancestors.' ].
compose_message( breakp(bp(debugger,_,_,M:F/N,_),add,already), _Level) --> compose_message( breakp(bp(debugger,_,_,M:F/N,_),add,already), _Level) -->
@ -195,7 +203,8 @@ compose_message(Term, Level) -->
[nl,nl]. [nl,nl].
compose_message(Term, Level) --> compose_message(Term, Level) -->
{ Level == error -> true ; Level == warning }, { Level == error -> true ; Level == warning },
main_message( Term, Level ), { '$show_consult_level'(LC) },
main_message( Term, Level, LC ),
[nl,nl]. [nl,nl].
location(error(syntax_error(syntax_error(_,between(_,LN,_),FileName,_))), _ ) --> location(error(syntax_error(syntax_error(_,between(_,LN,_),FileName,_))), _ ) -->
@ -209,75 +218,72 @@ location( error(_,Term), Level ) -->
{ source_location(F0, L), { source_location(F0, L),
stream_property(_Stream, alias(loop_stream)) }, !, stream_property(_Stream, alias(loop_stream)) }, !,
{ lists:memberchk([p|p(M,Na,Ar,_File,_FilePos)], Term ) }, { lists:memberchk([p|p(M,Na,Ar,_File,_FilePos)], Term ) },
[ '~a:~d:0 ~a in ~a:~q/~d:'-[F0, L,Level,M,Na,Ar] ], [ '~a:~d:0: ~a in ~a:~q/~d:'-[F0, L,Level,M,Na,Ar] ],
[nl]. [nl].
location( error(_,Term), Level ) --> location( error(_,Term), Level ) -->
{ lists:memberchk([p|p(M,Na,Ar,File,FilePos)], Term ) }, !, { lists:memberchk([p|p(M,Na,Ar,File,FilePos)], Term ) }, !,
[ '~a:~d:0 ~a in ~a:~q/~d:'-[File, FilePos,Level,M,Na,Ar] ], [ '~a:~d:0: ~a in ~a:~q/~d:'-[File, FilePos,Level,M,Na,Ar] ],
[nl]. [nl].
%message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !, %message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !,
main_message(error(Msg,Info), _) --> {var(Info)}, !, main_message(error(Msg,Info), _, LC) --> {var(Info)}, !,
[ nl, '~*|!!! uninstantiated message ~w~n.' - [8,Msg], nl ]. [ nl, '~*|!!! uninstantiated message ~w~n.' - [LC,Msg], nl ].
main_message( error(syntax_error(syntax_error(Msg,between(L0,LM,LF),_Stream,Term)),_), _ ) --> main_message( error(syntax_error(syntax_error(Msg,between(L0,LM,LF),_Stream,Term)),_), _, LC ) -->
!, !,
['~*|!!! syntax error: ~s' - [10,Msg]], ['~*|!!! syntax error: ~s' - [LC,Msg]],
[nl], [nl],
% [prefix(' ')], % [prefix(' ')],
( syntax_error_term( between(L0,LM,LF), Term ) ( syntax_error_term( between(L0,LM,LF), Term )
-> ->
[] []
; ;
['failed_processing syntax error term ~q' - [Term]], ['~*|!!! failed_processing syntax error term ~q' - [LC,Term]],
[nl] [nl]
). ).
main_message(error(style_check(style_check(singleton(SVs),_Pos,_File,P)),_), _) --> main_message(error(style_check(style_check(singleton(SVs),_Pos,_File,P)),_), _, LC) -->
!, !,
{ clause_to_indicator(P, I) }, { clause_to_indicator(P, I) },
[ '~*|!!! singleton variable~*c ~s in ~q.' - [ 10, NVs, 0's, SVsL, I] ], [ '~*|!!! singleton variable~*c ~s in ~q.' - [ LC, NVs, 0's, SVsL, I] ],
{ svs(SVs,SVs,SVsL), { svs(SVs,SVs,SVsL),
( SVs = [_] -> NVs = 0 ; NVs = 1 ) ( SVs = [_] -> NVs = 0 ; NVs = 1 )
}. }.
main_message(error(style_check(style_check(multiple(N,A,Mod,I0),_Pos,File,_P)),_),_) --> main_message(error(style_check(style_check(multiple(N,A,Mod,I0),_Pos,File,_P)),_),_, LC) -->
!, !,
{ '$show_consult_level'(LC) },
[ '~*|!!! ~a redefines ~q from ~a.' - [LC,File, Mod:N/A, I0] ]. [ '~*|!!! ~a redefines ~q from ~a.' - [LC,File, Mod:N/A, I0] ].
main_message(error(style_check(style_check(discontiguous(N,A,Mod),_S,_W,_P)),_) ,_)--> main_message(error(style_check(style_check(discontiguous(N,A,Mod),_S,_W,_P)),_,LC) ,_)-->
!, !,
{ '$show_consult_level'(LC) }, [ '~*|!!! discontiguous definition for ~p.' - [LC,Mod:N/A] ].
[ '~*|!!! !!! discontiguous definition for ~p.' - [LC,Mod:N/A] ]. main_message(error(consistency_error(Who)), _Source, LC) -->
main_message(error(consistency_error(Who)), _Source) -->
!, !,
{ '$show_consult_level'(LC) },
[ '~*|!!! has argument ~a not consistent with type.'-[LC,Who] ]. [ '~*|!!! has argument ~a not consistent with type.'-[LC,Who] ].
main_message(error(domain_error(Who , Type), _Where), _Source) --> main_message(error(domain_error(Who , Type), _Where), _Source, LC) -->
!, !,
[ '~*|!!! ~q does not belong to domain ~a,' - [8,Who,Type], nl ]. [ '~*|!!! ~q does not belong to domain ~a,' - [LC,Type,Who], nl ].
main_message(error(evaluation_error(What, Who), _Where), _Source) --> main_message(error(evaluation_error(What, Who), _Where), _Source, LC) -->
!, !,
[ '~*|!!! ~w caused ~a during evaluation of arithmetic expressions,' - [8,Who,What], nl ]. [ '~*|!!! ~w caused ~a during evaluation of arithmetic expressions,' - [LC,Who,What], nl ].
main_message(error(existence_error(Type , Who), _Where), _Source) --> main_message(error(existence_error(Type , Who), _Where), _Source, LC) -->
!, !,
[ '~*|!!! ~q ~q could not be found,' - [8,Type, Who], nl ]. [ '~*|!!! ~q ~q could not be found,' - [LC,Type, Who], nl ].
main_message(error(permission_error(Op, Type, Id), _Where), _Source) --> main_message(error(permission_error(Op, Type, Id), _Where), _Source, LC) -->
[ '~*|!!! ~q is not allowed in ~a ~q,' - [8, Op, Type,Id], nl ]. [ '~*|!!! ~q is not allowed in ~a ~q,' - [LC, Op, Type,Id], nl ].
main_message(error(instantiation_error, _Where), _Source) --> main_message(error(instantiation_error, _Where), _Source, LC) -->
[ '~*|!!! unbound variable' - [8], nl ]. [ '~*|!!! unbound variable' - [LC], nl ].
main_message(error(representation_error), _Source) --> main_message(error(representation_error), _Source, LC) -->
[ '~*|!!! unbound variable' - [8], nl ]. [ '~*|!!! unbound variable' - [LC], nl ].
main_message(error(type_error(Type,Who), _What), _Source) --> main_message(error(type_error(Type,Who), _What), _Source, LC) -->
[ '~*|!!! ~q should be of type ~a' - [8,Who,Type]], [ '~*|!!! ~q should be of type ~a' - [LC,Who,Type]],
[ nl ]. [ nl ].
main_message(error(system_error(Who), _What), _Source) --> main_message(error(system_error(Who), _What), _Source, LC) -->
[ '~*|!!! ~q error' - [8,Who]], [ '~*|!!! ~q error' - [LC,Who]],
[ nl ]. [ nl ].
main_message(error(uninstantiation_error(T),_), _Source) --> main_message(error(uninstantiation_error(T),_), _Source, LC) -->
[ '~*|!!! found ~q, expected unbound variable ' - [8,T], nl ]. [ '~*|!!! found ~q, expected unbound variable ' - [LC,T], nl ].
display_consulting(_Level) --> display_consulting(_Level) -->
{ source_location(F0, L), { source_location(F0, L),
stream_property(_Stream, alias(loop_stream)) }, !, stream_property(_Stream, alias(loop_stream)) }, !,
[ '~a:~d:0 found while compiling this file.'-[F0,L], nl ]. [ '~a:~d:0: found while compiling this file.'-[F0,L], nl ].
display_consulting(_) --> []. display_consulting(_) --> [].
caller( error(_,Term), _) --> caller( error(_,Term), _) -->
@ -286,12 +292,12 @@ caller( error(_,Term), _) -->
!, !,
['~*|goal was ~q' - [10,Call]], ['~*|goal was ~q' - [10,Call]],
[nl], [nl],
['~*|exception raised from ~a:~q:~d, ~a:~d:0. '-[10,M,Na,Ar,File, FilePos]], ['~*|exception raised from ~a:~q:~d, ~a:~d:0: '-[10,M,Na,Ar,File, FilePos]],
[nl]. [nl].
caller( error(_,Term), _) --> caller( error(_,Term), _) -->
{ lists:memberchk([e|p(M,Na,Ar,File,FilePos)], Term ) }, { lists:memberchk([e|p(M,Na,Ar,File,FilePos)], Term ) },
!, !,
['~*|exception raised from ~a:~q/~d, ~a:~d:0. '-[10,M,Na,Ar,File, FilePos]], ['~*|exception raised from ~a:~q/~d, ~a:~d:0: '-[10,M,Na,Ar,File, FilePos]],
[nl]. [nl].
caller( error(_,Term), _) --> caller( error(_,Term), _) -->
{ lists:memberchk([g|g(Call)], Term) }, { lists:memberchk([g|g(Call)], Term) },
@ -304,7 +310,7 @@ caller( _, _) -->
c_goal( error(_,Term), Level ) --> c_goal( error(_,Term), Level ) -->
{ lists:memberchk([c|c(File, Line, Func)], Term ) }, { lists:memberchk([c|c(File, Line, Func)], Term ) },
!, !,
['~*|~a raised at C-function ~a() in ~a/~d:0. '-[10, Level, Func, File, Line]], ['~*|~a raised at C-function ~a() in ~a:~d:0: '-[10, Level, Func, File, Line]],
[nl]. [nl].
c_goal( _, _Level ) --> []. c_goal( _, _Level ) --> [].

31
pl/qly.yap
View File

@ -243,12 +243,19 @@ qend_program :-
'$init_state' :- '$init_state' :-
once('$handle_throw'(_,_,_)), once('$handle_throw'(_,_,_)),
fail. (
'$init_state' :- recorded('$program_state', _P, R)
recorded('$program_state', _P, _), !, ->
'$do_init_state'. erase(R),
'$init_state'. '$do_init_state'
;
true
).
'$do_init_state' :-
set_value('$user_module',user),
'$protect',
fail.
'$do_init_state' :- '$do_init_state' :-
compile_expressions, compile_expressions,
'$init_preds', '$init_preds',
@ -262,10 +269,6 @@ qend_program :-
'$do_init_state' :- '$do_init_state' :-
'$reinit_thread0', '$reinit_thread0',
fail. fail.
'$do_init_state' :-
set_value('$user_module',user),
'$protect',
fail.
'$do_init_state' :- '$do_init_state' :-
'$current_module'(prolog), '$current_module'(prolog),
module(user), module(user),
@ -280,10 +283,13 @@ qend_program :-
% %
% first, recover what we need from the saved state... % first, recover what we need from the saved state...
% %'
'$init_from_saved_state_and_args' :- '$init_from_saved_state_and_args' :-
'$init_path_extensions', '$init_path_extensions',
fail. fail.
'$init_from_saved_state_and_args' :-
'$protect',
fail.
% use if we come from a save_program and we have SWI's shlib % use if we come from a save_program and we have SWI's shlib
'$init_from_saved_state_and_args' :- '$init_from_saved_state_and_args' :-
current_prolog_flag(hwnd, _HWND), current_prolog_flag(hwnd, _HWND),
@ -320,15 +326,12 @@ qend_program :-
'$init_from_saved_state_and_args' :- '$init_from_saved_state_and_args' :-
'$startup_goals', '$startup_goals',
fail. fail.
'$init_from_saved_state_and_args' :- '$init_from_saved' :-
recorded('$restore_goal',G,R), recorded('$restore_goal',G,R),
erase(R), erase(R),
prompt(_,'| '), prompt(_,'| '),
catch(once(user:G),Error,user:'$Error'(Error)), catch(once(user:G),Error,user:'$Error'(Error)),
fail. fail.
'$init_from_saved_state_and_args' :-
'$protect',
fail.
'$init_from_saved_state_and_args'. '$init_from_saved_state_and_args'.
'$init_path_extensions' :- '$init_path_extensions' :-

22
pl/yio.yap
View File

@ -46,6 +46,7 @@
ttynl/0, ttynl/0,
ttyput/1, ttyput/1,
ttyskip/1, ttyskip/1,
rename/2,
write_depth/2], ['$default_expand'/1, write_depth/2], ['$default_expand'/1,
'$extend_file_search_path'/1, '$extend_file_search_path'/1,
'$set_default_expand'/1]). '$set_default_expand'/1]).
@ -438,8 +439,25 @@ The atom _File_ corresponds to an existing file or directory.
*/ */
file_exists(IFile) :- file_exists(IFile) :-
true_file_name(IFile, File), absolute_file_name(IFile, _File, [expand(true), solutions(first), access(exist)]).
'$file_exists'(File).
/** @pred rename(+F , +G)
Renames the single file _F_ to _G_.
*/
rename(IFile, OFile) :-
absolute_file_name(IFile, IF, [access(read),expand(true)]),
absolute_file_name(OFile, OF, [expand(true)]),
'$rename'(IF, OF).
/** @pred access_file(+F , +G)
Verify whether file F respects property _G_. The file is processed
with absolute_file_name.
*/
access_file(IFile, Access) :-
absolute_file_name(IFile, _IF, [access(Access),expand(true)]).
/** /**
@} @}