absolute_filename ^#%@%
This commit is contained in:
parent
9a071d5823
commit
ee0335124f
106
os/iopreds.c
106
os/iopreds.c
@ -102,6 +102,31 @@ FILE *Yap_stdin;
|
||||
FILE *Yap_stdout;
|
||||
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) {
|
||||
if (t == TermFirst || t == TermAll)
|
||||
return true;
|
||||
@ -1355,10 +1380,11 @@ do_open(Term file_name, Term t2,
|
||||
/* get options */
|
||||
xarg *args = Yap_ArgListToVector(tlist, open_defs, OPEN_END);
|
||||
if (args == NULL) {
|
||||
if (LOCAL_Error_TYPE)
|
||||
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term,
|
||||
"option handling in open/3");
|
||||
return FALSE;
|
||||
if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
|
||||
if (LOCAL_Error_TYPE == DOMAIN_ERROR_PROLOG_FLAG)
|
||||
LOCAL_Error_TYPE = DOMAIN_ERROR_OPEN_OPTION;
|
||||
Yap_Error( LOCAL_Error_TYPE, LOCAL_Error_Term, "option handling in open/3" );
|
||||
}
|
||||
}
|
||||
/* done */
|
||||
sno = GetFreeStreamD();
|
||||
@ -1384,8 +1410,12 @@ do_open(Term file_name, Term t2,
|
||||
: false) ||
|
||||
trueGlobalPrologFlag(OPEN_EXPANDS_FILENAME_FLAG);
|
||||
// expand file name?
|
||||
fname = Yap_AbsoluteFile(fname, LOCAL_FileNameBuf, ok);
|
||||
fname = Yap_AbsoluteFile(fname, ok);
|
||||
if (fname) {
|
||||
st->name = Yap_LookupAtom(fname);
|
||||
} else {
|
||||
PlIOError(EXISTENCE_ERROR_SOURCE_SINK, ARG1, NULL);
|
||||
}
|
||||
|
||||
// Skip scripts that start with !#/.. or similar
|
||||
bool script = (args[OPEN_SCRIPT].used
|
||||
@ -1432,6 +1462,9 @@ do_open(Term file_name, Term t2,
|
||||
}
|
||||
if ((fd = fopen(fname, io_mode)) == NULL ||
|
||||
(!(flags & Binary_Stream_f) && binary_file(fname))) {
|
||||
strncpy( LOCAL_FileNameBuf, fname,MAXPATHLEN);
|
||||
free( (void *)fname );
|
||||
fname = LOCAL_FileNameBuf;
|
||||
UNLOCK(st->streamlock);
|
||||
if (errno == ENOENT)
|
||||
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 =
|
||||
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;
|
||||
}
|
||||
// if (args[CLOSE_FORCE].used) {
|
||||
// }
|
||||
Yap_CloseStream(sno);
|
||||
@ -1854,8 +1894,8 @@ Term read_line(int sno) {
|
||||
PAR("access", isatom, ABSOLUTE_FILE_NAME_ACCESS), \
|
||||
PAR("expand", booleanFlag, ABSOLUTE_FILE_NAME_EXPAND), \
|
||||
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_type", is_file_type, ABSOLUTE_FILE_NAME_FILE_TYPE), \
|
||||
PAR("glob", ok, ABSOLUTE_FILE_NAME_GLOB), \
|
||||
PAR("relative_to", isatom, ABSOLUTE_FILE_NAME_RELATIVE_TO), \
|
||||
PAR("solutions", issolutions, ABSOLUTE_FILE_NAME_SOLUTIONS), \
|
||||
@ -1884,19 +1924,28 @@ static Int abs_file_parameters(USES_REGS1) {
|
||||
/* get options */
|
||||
xarg *args = Yap_ArgListToVector(tlist, absolute_file_name_search_defs,
|
||||
ABSOLUTE_FILE_NAME_END);
|
||||
if (args == NULL)
|
||||
return FALSE;
|
||||
if (args == NULL) {
|
||||
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 */
|
||||
if (args[ABSOLUTE_FILE_NAME_EXTENSIONS].used)
|
||||
if (args[ABSOLUTE_FILE_NAME_EXTENSIONS].used) {
|
||||
t[ABSOLUTE_FILE_NAME_EXTENSIONS] =
|
||||
args[ABSOLUTE_FILE_NAME_EXTENSIONS].tvalue;
|
||||
else
|
||||
} else {
|
||||
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] =
|
||||
args[ABSOLUTE_FILE_NAME_RELATIVE_TO].tvalue;
|
||||
else
|
||||
t[ABSOLUTE_FILE_NAME_RELATIVE_TO] = TermEmptyAtom;
|
||||
gethdir( args[ABSOLUTE_FILE_NAME_RELATIVE_TO].tvalue );
|
||||
} else {
|
||||
t[ABSOLUTE_FILE_NAME_RELATIVE_TO] =
|
||||
gethdir( TermDot );
|
||||
}
|
||||
if (args[ABSOLUTE_FILE_NAME_FILE_TYPE].used)
|
||||
t[ABSOLUTE_FILE_NAME_FILE_TYPE] = args[ABSOLUTE_FILE_NAME_FILE_TYPE].tvalue;
|
||||
else
|
||||
@ -1937,28 +1986,11 @@ static Int get_abs_file_parameter(USES_REGS1) {
|
||||
Term t = Deref(ARG1), topts = ARG2;
|
||||
/* get options */
|
||||
/* done */
|
||||
if (t == TermExtensions)
|
||||
return Yap_unify(ARG3, ArgOfTerm(ABSOLUTE_FILE_NAME_EXTENSIONS + 1, topts));
|
||||
if (t == TermRelativeTo)
|
||||
return Yap_unify(ARG3,
|
||||
ArgOfTerm(ABSOLUTE_FILE_NAME_RELATIVE_TO + 1, topts));
|
||||
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);
|
||||
int i = Yap_ArgKey( AtomOfTerm( t ), absolute_file_name_search_defs,
|
||||
ABSOLUTE_FILE_NAME_END );
|
||||
if (i >= 0)
|
||||
return Yap_unify(ARG3, ArgOfTerm(i + 1, topts));
|
||||
Yap_Error(DOMAIN_ERROR_ABSOLUTE_FILE_NAME_OPTION, ARG1, NULL);
|
||||
return false;
|
||||
}
|
||||
|
||||
|
@ -205,7 +205,7 @@ bool Yap_InitReadline(Term enable) {
|
||||
#endif
|
||||
rl_outstream = stderr;
|
||||
using_history();
|
||||
const char *s = Yap_AbsoluteFile("~/.YAP.history", NULL, true);
|
||||
const char *s = Yap_AbsoluteFile("~/.YAP.history", true);
|
||||
if (!read_history(s)) {
|
||||
FILE *f = fopen(s, "w");
|
||||
if (f) {
|
||||
|
@ -639,23 +639,23 @@ static bool complete_processing(FEnv *fe, TokEntry *tokstart) {
|
||||
CurrentModule = fe->cmod;
|
||||
if (CurrentModule == TermProlog)
|
||||
CurrentModule = PROLOG_MODULE;
|
||||
if (fe->vp)
|
||||
if (fe->t && fe->vp)
|
||||
v1 = get_variables(fe, tokstart);
|
||||
else
|
||||
v1 = 0L;
|
||||
if (fe->np)
|
||||
if (fe->t && fe->np)
|
||||
v2 = get_varnames(fe, tokstart);
|
||||
else
|
||||
v2 = 0L;
|
||||
if (fe->sp)
|
||||
if (fe->t && fe->sp)
|
||||
v3 = get_singletons(fe, tokstart);
|
||||
else
|
||||
v3 = 0L;
|
||||
if (fe->tcomms)
|
||||
if (fe->t && fe->tcomms)
|
||||
vc = LOCAL_Comments;
|
||||
else
|
||||
vc = 0L;
|
||||
if (fe->tp)
|
||||
if (fe->t && fe->tp)
|
||||
tp = get_stream_position(fe, tokstart );
|
||||
else
|
||||
tp = 0L;
|
||||
@ -679,22 +679,22 @@ static bool complete_clause_processing(FEnv *fe, TokEntry
|
||||
CurrentModule = fe->cmod;
|
||||
if (CurrentModule == TermProlog)
|
||||
CurrentModule = PROLOG_MODULE;
|
||||
if (fe->vp)
|
||||
if (fe->t && fe->vp)
|
||||
v_vp = get_variables(fe, tokstart);
|
||||
else
|
||||
v_vp = 0L;
|
||||
if (fe->np)
|
||||
if (fe->t && fe->np)
|
||||
v_vnames = get_varnames(fe, tokstart);
|
||||
else
|
||||
v_vnames = 0L;
|
||||
if (trueLocalPrologFlag(SINGLE_VAR_WARNINGS_FLAG)) {
|
||||
if (fe->t && trueLocalPrologFlag(SINGLE_VAR_WARNINGS_FLAG)) {
|
||||
warn_singletons(fe, tokstart);
|
||||
}
|
||||
if (fe->tcomms)
|
||||
if (fe->t && fe->tcomms)
|
||||
v_comments = LOCAL_Comments;
|
||||
else
|
||||
v_comments = 0L;
|
||||
if (fe->tp)
|
||||
if (fe->t && fe->tp)
|
||||
v_pos = get_stream_position(fe, tokstart );
|
||||
else
|
||||
v_pos = 0L;
|
||||
@ -813,7 +813,9 @@ static parser_state_t scan(REnv *re, FEnv *fe, int inp_stream) {
|
||||
return YAP_PARSING;
|
||||
}
|
||||
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_Term = TermEof;
|
||||
return YAP_PARSING_ERROR;
|
||||
@ -878,7 +880,8 @@ static parser_state_t parseError(REnv *re, FEnv *fe, int inp_stream) {
|
||||
} else {
|
||||
Term terr = Yap_syntax_error(fe->toklast, inp_stream);
|
||||
if (ParserErrorStyle == TermError) {
|
||||
LOCAL_ErrorMessage = "SYNTAX ERROR";
|
||||
LOCAL_ErrorMessage = NULL;
|
||||
LOCAL_Error_TYPE = SYNTAX_ERROR;
|
||||
Yap_Error(SYNTAX_ERROR, terr, LOCAL_ErrorMessage);
|
||||
return YAP_PARSING_FINISHED;
|
||||
} else {
|
||||
@ -933,7 +936,7 @@ Term Yap_read_term(int inp_stream, Term opts, int nargs) {
|
||||
#endif
|
||||
|
||||
parser_state_t state = YAP_START_PARSING;
|
||||
while (state != YAP_PARSING_FINISHED) {
|
||||
while (true) {
|
||||
switch (state) {
|
||||
case YAP_START_PARSING:
|
||||
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);
|
||||
break;
|
||||
case YAP_PARSING_FINISHED:
|
||||
break;
|
||||
}
|
||||
}
|
||||
{
|
||||
CACHE_REGS
|
||||
if (fe.reading_clause &&
|
||||
!complete_clause_processing(&fe, LOCAL_tokptr))
|
||||
fe.t = 0;
|
||||
else if (!fe.reading_clause && !complete_processing(&fe, LOCAL_tokptr))
|
||||
bool done;
|
||||
if (fe.reading_clause)
|
||||
done = complete_clause_processing(&fe, LOCAL_tokptr);
|
||||
else
|
||||
done = complete_processing(&fe, LOCAL_tokptr);
|
||||
if (!done) {
|
||||
state = YAP_PARSING_ERROR;
|
||||
fe.t = 0;
|
||||
break;
|
||||
}
|
||||
#if EMACS
|
||||
first_char = tokstart->TokPos;
|
||||
#endif /* EMACS */
|
||||
return fe.t;
|
||||
}
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
static Int
|
||||
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
|
||||
*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
|
||||
*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(
|
||||
USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */
|
||||
|
15
os/streams.c
15
os/streams.c
@ -567,6 +567,11 @@ static Int cont_stream_property(USES_REGS1) { /* current_stream */
|
||||
args = Yap_ArgListToVector(Deref(ARG2), stream_property_defs,
|
||||
STREAM_PROPERTY_END);
|
||||
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();
|
||||
}
|
||||
LOCK(GLOBAL_StreamDescLock);
|
||||
@ -630,6 +635,11 @@ static Int stream_property(USES_REGS1) { /* Init current_stream */
|
||||
args = Yap_ArgListToVector(Deref(ARG2), stream_property_defs,
|
||||
STREAM_PROPERTY_END);
|
||||
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);
|
||||
cut_fail();
|
||||
}
|
||||
@ -682,6 +692,11 @@ static bool do_set_stream(int sno,
|
||||
|
||||
args = Yap_ArgListToVector(opts, set_stream_defs, SET_STREAM_END);
|
||||
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);
|
||||
return false;
|
||||
}
|
||||
|
558
os/sysbits.c
558
os/sysbits.c
@ -46,15 +46,26 @@ static Int p_mv( USES_REGS1 );
|
||||
static Int p_dir_sp( USES_REGS1 );
|
||||
static Int p_getenv( 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
|
||||
|
||||
static int chdir(char *);
|
||||
/* #define signal skel_signal */
|
||||
#endif /* MACYAP */
|
||||
|
||||
static char *
|
||||
expandVars(const char *spec);
|
||||
|
||||
void exit(int);
|
||||
|
||||
static void
|
||||
freeBuffer( const void *ptr )
|
||||
{
|
||||
if (ptr == NULL ||
|
||||
ptr == LOCAL_FileNameBuf || ptr == LOCAL_FileNameBuf2)
|
||||
return;
|
||||
free((void *)ptr);
|
||||
}
|
||||
|
||||
#ifdef _WIN32
|
||||
void
|
||||
Yap_WinError(char *yap_error)
|
||||
@ -267,13 +278,14 @@ bool
|
||||
Yap_IsAbsolutePath(const char *p0)
|
||||
{
|
||||
// verify first if expansion is needed: ~/ or $HOME/
|
||||
char c[MAXPATHLEN+1];
|
||||
char *p = expandVars( p0, c, MAXPATHLEN );
|
||||
char *p = expandVars( p0 );
|
||||
bool nrc;
|
||||
#if _WIN32 || __MINGW32__
|
||||
return !PathIsRelative(p);
|
||||
nrc = !PathIsRelative(p);
|
||||
#else
|
||||
return p[0] == '/';
|
||||
nrc = ( p[0] == '/' );
|
||||
#endif
|
||||
return nrc;
|
||||
}
|
||||
|
||||
#define isValidEnvChar(C) ( ((C) >= 'a' && (C) <= 'z') || ((C) >= 'A' && \
|
||||
@ -283,13 +295,10 @@ Yap_IsAbsolutePath(const char *p0)
|
||||
// support for ~expansion at the beginning
|
||||
// systems like Android do not do this.
|
||||
static char *
|
||||
yapExpandVars (const char *source, char *result)
|
||||
PlExpandVars (const char *source)
|
||||
{
|
||||
const char *src = source;
|
||||
char *res = result;
|
||||
|
||||
if(result == NULL)
|
||||
result = malloc( YAP_FILENAME_MAX+1);
|
||||
char *result = LOCAL_FileNameBuf;
|
||||
|
||||
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));
|
||||
@ -315,6 +324,7 @@ yapExpandVars (const char *source, char *result)
|
||||
} else {
|
||||
#if HAVE_GETPWNAM
|
||||
struct passwd *user_passwd;
|
||||
char *res = result;
|
||||
|
||||
src++;
|
||||
while (!dir_separator((*res = *src)) && *res != '\0')
|
||||
@ -338,7 +348,7 @@ yapExpandVars (const char *source, char *result)
|
||||
/* follow SICStus expansion rules */
|
||||
char v[YAP_FILENAME_MAX+1];
|
||||
int ch;
|
||||
char *s;
|
||||
char *s, *res;
|
||||
src = source+1;
|
||||
if (src[0] == '{') {
|
||||
res = v;
|
||||
@ -371,13 +381,6 @@ yapExpandVars (const char *source, char *result)
|
||||
return result;
|
||||
}
|
||||
|
||||
static char *
|
||||
expandVars(const char *pattern, char *expanded, int maxlent)
|
||||
{
|
||||
|
||||
return yapExpandVars(pattern, expanded);
|
||||
}
|
||||
|
||||
#if _WIN32 || defined(__MINGW32__)
|
||||
// straightforward conversion from Unix style to WIN style
|
||||
// check cygwin path.cc for possible improvements
|
||||
@ -452,11 +455,11 @@ PrologPath(const char *Y, char *X) {
|
||||
|
||||
static bool ChDir(const char *path) {
|
||||
bool rc = false;
|
||||
const char *qpath = Yap_AbsoluteFile(path, NULL, true);
|
||||
const char *qpath = Yap_AbsoluteFile(path, true);
|
||||
|
||||
#ifdef __ANDROID__
|
||||
if (GLOBAL_AssetsWD) {
|
||||
free( GLOBAL_AssetsWD );
|
||||
freeBuffer( GLOBAL_AssetsWD );
|
||||
GLOBAL_AssetsWD = NULL;
|
||||
}
|
||||
if (Yap_isAsset(qpath) ) {
|
||||
@ -487,7 +490,7 @@ static bool ChDir(const char *path) {
|
||||
#else
|
||||
rc = (chdir(qpath) == 0);
|
||||
#endif
|
||||
free( (void *)qpath );
|
||||
free((char *)qpath);
|
||||
return rc;
|
||||
}
|
||||
#if _WIN32 || defined(__MINGW32__)
|
||||
@ -521,7 +524,7 @@ DirName(const char *X) {
|
||||
}
|
||||
#endif
|
||||
|
||||
static const char *myrealpath( const char *path, char *out)
|
||||
static const char *myrealpath( const char *path)
|
||||
{
|
||||
#if _WIN32 || defined(__MINGW32__)
|
||||
DWORD retval=0;
|
||||
@ -540,246 +543,139 @@ static const char *myrealpath( const char *path, char *out)
|
||||
return out;
|
||||
#elif HAVE_REALPATH
|
||||
{
|
||||
const char *rc;
|
||||
rc = ( const char *)realpath(path,out);
|
||||
const char *s0, *s;
|
||||
char * rc = realpath(path,NULL);
|
||||
|
||||
if (rc == NULL && (errno == ENOENT|| errno == EACCES)) {
|
||||
|
||||
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);
|
||||
}
|
||||
if (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
|
||||
return NULL;
|
||||
if (rc[e-1] != '/' ) {
|
||||
rc[e]='/';
|
||||
rc[e+1]='\0';
|
||||
}
|
||||
#endif
|
||||
strcat(rc, b);
|
||||
return rc;
|
||||
}
|
||||
}
|
||||
}
|
||||
#endif
|
||||
char *out = malloc(strlen(path)+1);
|
||||
strcpy( out, path);
|
||||
return out;
|
||||
}
|
||||
|
||||
static char *
|
||||
PrologExpandVars(const char *spec, char *tmp0, bool ok_to)
|
||||
expandVars(const char *spec)
|
||||
{
|
||||
char *tmp;
|
||||
|
||||
#if _WIN32 || defined(__MINGW32__)
|
||||
char u[YAP_FILENAME_MAX+1];
|
||||
|
||||
// first pass, remove Unix style stuff
|
||||
if (unix2win(spec, u, YAP_FILENAME_MAX) == NULL)
|
||||
if ((ou=unix2win(spec, YAP_FILENAME_MAX)) == NULL)
|
||||
return NULL;
|
||||
spec = u;
|
||||
#endif
|
||||
if (tmp0 == NULL) {
|
||||
tmp = malloc(YAP_FILENAME_MAX+1);
|
||||
if (tmp == NULL) {
|
||||
bool ok_to = true;
|
||||
if (spec == NULL) {
|
||||
return NULL;
|
||||
}
|
||||
} else {
|
||||
tmp = tmp0;
|
||||
}
|
||||
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 {
|
||||
if (tmp != tmp0) {
|
||||
free(tmp);
|
||||
}
|
||||
tmp = (char *)spec;
|
||||
}
|
||||
return tmp;
|
||||
return (char *)spec;
|
||||
}
|
||||
|
||||
/**
|
||||
* generate absolute path, if ok first expand SICStus Prolog style
|
||||
*
|
||||
* @param[in] spec the file path, including `~` and `$`.
|
||||
* @param[out] tmp where to store the file.
|
||||
* @param[in] ok where to process `~` and `$`.
|
||||
*
|
||||
* @return tmp, or NULL
|
||||
* @return tmp, or NULL, in malloced memory
|
||||
*/
|
||||
const char *
|
||||
Yap_AbsoluteFile(const char *spec, char *tmp, bool ok)
|
||||
Yap_AbsoluteFile(const char *spec, bool ok)
|
||||
{
|
||||
char *t1 = NULL;
|
||||
t1 = PrologExpandVars(spec, t1, ok);
|
||||
if (!t1)
|
||||
const char*p;
|
||||
const char*rc;
|
||||
rc = expandVars(spec);
|
||||
if (!rc)
|
||||
return spec;
|
||||
if ((p = myrealpath(rc) ) ) {
|
||||
return p;
|
||||
} else {
|
||||
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
|
||||
* traditional SICStus-style variable expansion.
|
||||
* if ok first expand variable names and do globbing
|
||||
*
|
||||
* @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.
|
||||
* @param[in] spec the file path, including `~` and `$`.
|
||||
* @param[in] ok where to process `~` and `$`.
|
||||
*
|
||||
* @return
|
||||
* @return tmp, or NULL, in malloced memory
|
||||
*/
|
||||
static Int
|
||||
prolog_expanded_file_system_path( USES_REGS1 )
|
||||
const char *
|
||||
Yap_AbsoluteFileInBuffer(const char *spec, char *out, size_t sz, bool ok)
|
||||
{
|
||||
Term t1 = Deref(ARG1);
|
||||
Term t2 = Deref(ARG2);
|
||||
Term t3 = Deref(ARG3);
|
||||
char *o = LOCAL_FileNameBuf;
|
||||
bool flag;
|
||||
const char *cmd, *p0;
|
||||
|
||||
if (IsAtomTerm(t1)) {
|
||||
cmd = RepAtom(AtomOfTerm(t1))->StrOfAE;
|
||||
} else if (IsStringTerm(t1)) {
|
||||
cmd = StringOfTerm(t1);
|
||||
const char*p;
|
||||
const char*rc;
|
||||
if (ok) {
|
||||
rc = expandVars(spec);
|
||||
if (!rc)
|
||||
return spec;
|
||||
} else {
|
||||
return false;
|
||||
rc = spec;
|
||||
}
|
||||
if (t2 == TermTrue) {
|
||||
flag = true;
|
||||
} else if (t2 == TermFalse) {
|
||||
flag = false;
|
||||
|
||||
if ((p = myrealpath(rc) ) ) {
|
||||
if (!out) {
|
||||
out = LOCAL_FileNameBuf;
|
||||
sz = YAP_FILENAME_MAX-1;
|
||||
}
|
||||
if (p != out ) {
|
||||
strncpy(out, p, sz);
|
||||
freeBuffer(p);
|
||||
return out;
|
||||
} else {
|
||||
return false;
|
||||
}
|
||||
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
|
||||
return NULL;
|
||||
}
|
||||
|
||||
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__)
|
||||
{
|
||||
char u[YAP_FILENAME_MAX+1];
|
||||
@ -820,11 +716,18 @@ do_expand_file_name(Term t1, Term opts USES_REGS)
|
||||
return tf;
|
||||
}
|
||||
#elif HAVE_WORDEXP || HAVE_GLOB
|
||||
if (!use_system_expansion) {
|
||||
return MkPairTerm(MkAtomTerm(Yap_LookupAtom(spec)), TermNil);
|
||||
}
|
||||
/* Expand the string for the program to run. */
|
||||
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 HAVE_GLOB
|
||||
#ifdef GLOB_NOCHECK
|
||||
@ -875,8 +778,7 @@ do_expand_file_name(Term t1, Term opts USES_REGS)
|
||||
break;
|
||||
} else {
|
||||
Term t;
|
||||
char *out = LOCAL_FileNameBuf;
|
||||
t = MkAtomTerm( Yap_LookupAtom( expandVars(spec, out, YAP_FILENAME_MAX-1) ) );
|
||||
t = MkAtomTerm( Yap_LookupAtom( expandVars(spec) ) );
|
||||
wordfree (&wresult);
|
||||
return MkPairTerm( t, TermNil );
|
||||
}
|
||||
@ -893,11 +795,12 @@ do_expand_file_name(Term t1, Term opts USES_REGS)
|
||||
}
|
||||
#endif
|
||||
}
|
||||
tf = TermNil;
|
||||
const char * tmp;
|
||||
Term tf = TermNil;
|
||||
for (j = 0; j < pathcount; j++) {
|
||||
const char *s = ss[pathcount-(j+1)];
|
||||
#if HAVE_REALPATH
|
||||
tmp = myrealpath(s,(char *) tmp);
|
||||
tmp = myrealpath(s);
|
||||
#else
|
||||
tmp = s;
|
||||
#endif
|
||||
@ -907,21 +810,143 @@ do_expand_file_name(Term t1, Term opts USES_REGS)
|
||||
tf = MkPairTerm(MkAtomTerm( a ),tf);
|
||||
}
|
||||
#if HAVE_GLOB
|
||||
if (use_system_expansion && glob_vs_wordexp)
|
||||
if ( glob_vs_wordexp)
|
||||
globfree( &gresult );
|
||||
#endif
|
||||
#if HAVE_WORDEXP
|
||||
if (use_system_expansion && !glob_vs_wordexp)
|
||||
if ( !glob_vs_wordexp)
|
||||
wordfree( &wresult );
|
||||
#endif
|
||||
if (tmp)
|
||||
free( (void *)tmp );
|
||||
if (tmpe)
|
||||
free( tmpe );
|
||||
freeBuffer( (void *)tmp );
|
||||
return tf;
|
||||
#else
|
||||
// just use basic
|
||||
return MkPairTerm(MkAtomTerm(Yap_LookupAtom(spec)), TermNil);
|
||||
#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;
|
||||
}
|
||||
|
||||
@ -953,13 +978,11 @@ static char *canoniseFileName( char *path) {
|
||||
return NULL;
|
||||
path = o;
|
||||
#endif
|
||||
char *rc, *tmp = malloc(PATH_MAX);
|
||||
char *rc;
|
||||
if (tmp == NULL) return NULL;
|
||||
rc = myrealpath(path, tmp);
|
||||
if (rc != tmp)
|
||||
free(tmp);
|
||||
rc = myrealpath(path);
|
||||
#if _WIN32 || defined(__MINGW32__)
|
||||
free(o);
|
||||
freeBuffer(o);
|
||||
#endif
|
||||
return rc;
|
||||
#endif
|
||||
@ -982,11 +1005,11 @@ absolute_file_system_path( USES_REGS1 )
|
||||
Yap_Error(TYPE_ERROR_ATOM, t, "absolute_file_system_path");
|
||||
return false;
|
||||
}
|
||||
if (!(fp = Yap_AbsoluteFile( RepAtom(AtomOfTerm(t))->StrOfAE, s, true)))
|
||||
if (!(fp = Yap_AbsoluteFile( RepAtom(AtomOfTerm(t))->StrOfAE, true)))
|
||||
return false;
|
||||
rc = Yap_unify(MkAtomTerm(Yap_LookupAtom(fp)), ARG2);
|
||||
if (fp != s)
|
||||
free( (void *)fp );
|
||||
freeBuffer( (void *)fp );
|
||||
return rc;
|
||||
}
|
||||
|
||||
@ -1255,6 +1278,10 @@ Yap_InitPageSize(void)
|
||||
|
||||
/* 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__
|
||||
#include <ctype.h>
|
||||
#endif
|
||||
@ -1320,28 +1347,31 @@ Yap_InitPageSize(void)
|
||||
}
|
||||
|
||||
static const char *
|
||||
expandWithPrefix(const char *source, const char *root, char *result)
|
||||
expandWithPrefix(const char *source, const char *root)
|
||||
{
|
||||
char *work;
|
||||
char ares1[YAP_FILENAME_MAX+1];
|
||||
|
||||
|
||||
work = expandVars( source, ares1, YAP_FILENAME_MAX);
|
||||
work = expandVars( source );
|
||||
// expand names first
|
||||
if (root && !Yap_IsAbsolutePath( source ) ) {
|
||||
char ares2[YAP_FILENAME_MAX+1];
|
||||
strncpy( ares2, root, YAP_FILENAME_MAX );
|
||||
strncat( ares2, "/", YAP_FILENAME_MAX );
|
||||
strncat( ares2, work, YAP_FILENAME_MAX );
|
||||
return Yap_AbsoluteFile( ares2, result , false);
|
||||
} else {
|
||||
// expand path
|
||||
return myrealpath( work, result);
|
||||
char *s = expandVars( source);
|
||||
if (!s)
|
||||
return source;
|
||||
char *r0 = expandVars( root);
|
||||
size_t sl = strlen(s);
|
||||
size_t rl = strlen(r0);
|
||||
char *r = malloc( sl+rl+2);
|
||||
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
|
||||
*
|
||||
aaaaaaaaaaaaaaaaaaaaa*
|
||||
*
|
||||
* @param isource the proper file
|
||||
* @param idef the default name fo rthe file, ie, startup.yss
|
||||
@ -1452,11 +1482,9 @@ Yap_InitPageSize(void)
|
||||
|
||||
if (done)
|
||||
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) ; }
|
||||
const char *work = expandWithPrefix( source, root, (char *)result );
|
||||
const char *work = expandWithPrefix( source, root );
|
||||
|
||||
|
||||
// expand names in case you have
|
||||
// to add a prefix
|
||||
@ -1467,7 +1495,7 @@ Yap_InitPageSize(void)
|
||||
}
|
||||
|
||||
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);
|
||||
}
|
||||
@ -1491,7 +1519,7 @@ Yap_InitPageSize(void)
|
||||
Yap_Error(TYPE_ERROR_ATOM,t,"argument to true_file_name");
|
||||
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 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
|
||||
p_mv ( USES_REGS1 )
|
||||
{ /* rename(+OldName,+NewName) */
|
||||
#if HAVE_LINK
|
||||
int r;
|
||||
char oldname[YAP_FILENAME_MAX], newname[YAP_FILENAME_MAX];
|
||||
char *oldname, *newname;
|
||||
Term t1 = Deref (ARG1);
|
||||
Term t2 = Deref (ARG2);
|
||||
if (IsVarTerm(t1)) {
|
||||
@ -1767,11 +1790,9 @@ Yap_InitPageSize(void)
|
||||
Yap_Error(INSTANTIATION_ERROR, t2, "second argument to rename/2 unbound");
|
||||
} else if (!IsAtomTerm(t2)) {
|
||||
Yap_Error(TYPE_ERROR_ATOM, t2, "second argument to rename/2 not atom");
|
||||
}
|
||||
if (!Yap_trueFileName (RepAtom(AtomOfTerm(t1))->StrOfAE, NULL, NULL, oldname, true, YAP_STD, true, false))
|
||||
return FALSE;
|
||||
if (!Yap_trueFileName (RepAtom(AtomOfTerm(t2))->StrOfAE, NULL, NULL, oldname, true, YAP_STD, true, false))
|
||||
return FALSE;
|
||||
} else {
|
||||
oldname = (RepAtom(AtomOfTerm(t1)))->StrOfAE;
|
||||
newname = (RepAtom(AtomOfTerm(t2)))->StrOfAE;
|
||||
if ((r = link (oldname, newname)) == 0 && (r = unlink (oldname)) != 0)
|
||||
unlink (newname);
|
||||
if (r != 0) {
|
||||
@ -1780,13 +1801,14 @@ Yap_InitPageSize(void)
|
||||
#else
|
||||
Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM,t2,"in rename(%s,%s)",oldname,newname);
|
||||
#endif
|
||||
return FALSE;
|
||||
return false;
|
||||
}
|
||||
return true;
|
||||
}
|
||||
return TRUE;
|
||||
#else
|
||||
Yap_Error(SYSTEM_ERROR_INTERNAL,TermNil,"rename/2 not available in this machine");
|
||||
return (FALSE);
|
||||
#endif
|
||||
return false;
|
||||
}
|
||||
|
||||
|
||||
@ -2250,7 +2272,7 @@ Yap_InitPageSize(void)
|
||||
Yap_InitCPred ("sh", 0, p_sh, SafePredFlag|SyncPredFlag);
|
||||
Yap_InitCPred ("$shell", 1, p_shell, SafePredFlag|SyncPredFlag);
|
||||
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_paths", 3, p_yap_paths, 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);
|
||||
#endif
|
||||
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,
|
||||
true_file_name, SyncPredFlag);
|
||||
Yap_InitCPred ("true_file_name", 3, true_file_name3, SyncPredFlag);
|
||||
|
@ -114,7 +114,7 @@ int Yap_growtrail_in_parser(tr_fr_ptr *, TokEntry **, VarEntry **);
|
||||
|
||||
bool Yap_IsAbsolutePath(const char *p);
|
||||
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 {
|
||||
MEM_BUF_CODE = 1,
|
||||
|
410
pl/absf.yap
410
pl/absf.yap
@ -170,43 +170,43 @@ absolute_file_name(File0,File) :-
|
||||
solutions(first),
|
||||
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) :-
|
||||
% must_be_of_type( atom, File ),
|
||||
abs_file_parameters(LOpts,Opts),
|
||||
current_prolog_flag(open_expands_filename, OldF),
|
||||
current_prolog_flag( fileerrors, PreviousFileErrors ),
|
||||
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( expand, Opts, Expand ),
|
||||
set_prolog_flag( verbose_file_search, Verbose ),
|
||||
get_abs_file_parameter( file_errors, Opts, FErrors ),
|
||||
get_abs_file_parameter( solutions, Opts, First ),
|
||||
( FErrors == fail ->
|
||||
set_prolog_flag( fileerrors, false )
|
||||
;
|
||||
set_prolog_flag( fileerrors, true )
|
||||
),
|
||||
set_prolog_flag(file_name_variables, Expand),
|
||||
'$absf_trace'('search for ~w with options ~w', [File, LOpts] ),
|
||||
'$find_in_path'(File, Opts,TrueFileName,G),
|
||||
'$absf_trace'(File),
|
||||
'$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] ),
|
||||
% stop_lowxb( _level_trace,
|
||||
'$absf_trace'(' got first ~a', [TrueFileName]),
|
||||
% stop_low_level_trace,
|
||||
set_prolog_flag( fileerrors, PreviousFileErrors ),
|
||||
set_prolog_flag( open_expands_filename, OldF),
|
||||
set_prolog_flag( verbose_file_search, PreviousVerbose ),
|
||||
'$absf_trace'('first solution only', [] ),
|
||||
!
|
||||
;
|
||||
(
|
||||
'$absf_trace'('found solution ~a', [TrueFileName] ),
|
||||
% stop_low_level_trace,
|
||||
'$absf_trace'(' found match ~a.', [TrueFileName]),
|
||||
set_prolog_flag( fileerrors, PreviousFileErrors ),
|
||||
set_prolog_flag( file_name_variables, OldF),
|
||||
set_prolog_flag( verbose_file_search, PreviousVerbose )
|
||||
;
|
||||
'$absf_trace'(' no more solutions.', []),
|
||||
set_prolog_flag( verbose_file_search, Verbose ),
|
||||
get_abs_file_parameter( file_errors, Opts, FErrors ),
|
||||
set_prolog_flag(file_name_variables, Expand),
|
||||
@ -215,6 +215,7 @@ absolute_file_name(File0,File) :-
|
||||
;
|
||||
% no solution
|
||||
% stop_low_level_trace,
|
||||
'$absf_trace'(' failed.', []),
|
||||
set_prolog_flag( fileerrors, PreviousFileErrors ),
|
||||
set_prolog_flag( verbose_file_search, PreviousVerbose ),
|
||||
set_prolog_flag(file_name_variables, OldF),
|
||||
@ -227,95 +228,157 @@ absolute_file_name(File0,File) :-
|
||||
% 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'(S, Opts, NewFile, Call) :-
|
||||
S =.. [Name,File0],
|
||||
'$cat_file_name'(File0,File), !,
|
||||
'$absf_trace'('~w(~w) to ~w', [Name, File0, 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,File), !,
|
||||
'$add_path'(File, Opts, PFile),
|
||||
'$get_abs_file'(PFile,Opts,AbsFile),
|
||||
'$absf_trace'('~w to ~w', [PFile, NewFile] ),
|
||||
'$search_in_path'(AbsFile,Opts,NewFile).
|
||||
'$find_in_path'(File,_,_,Call) :-
|
||||
'$do_error'(domain_error(source_sink,File),Call).
|
||||
'$find_in_path'(user,_,user_input) :- !.
|
||||
'$find_in_path'(user_input,_,user_input) :- !.
|
||||
'$find_in_path'(user_output,_,user_ouput) :- !.
|
||||
'$find_in_path'(user_error,_,user_error) :- !.
|
||||
'$find_in_path'(Name, Opts, File) :-
|
||||
% ( atom(Name) -> true ; start_low_level_trace ),
|
||||
get_abs_file_parameter( file_type, Opts, Type ),
|
||||
get_abs_file_parameter( access, Opts, Access ),
|
||||
get_abs_file_parameter( expand, Opts, Expand ),
|
||||
'$absf_trace'('start with ~w', [Name]),
|
||||
'$core_file_name'(Name, Opts, CorePath, []),
|
||||
'$absf_trace'(' after name/library unfolding: ~w', [Name]),
|
||||
'$prefix'(CorePath, Opts, Path , CorePath),
|
||||
'$absf_trace'(' after prefix expansion: ~s', [Path]),
|
||||
atom_codes( APath, Path ),
|
||||
(
|
||||
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
|
||||
'$cat_file_name'(File0,File) :-
|
||||
atom(File0), !,
|
||||
File = File0.
|
||||
'$cat_file_name'(Atoms, File) :-
|
||||
'$to_list_of_atoms'(Atoms, List, []),
|
||||
atom_concat(List, File).
|
||||
'$core_file_name'(Name, Opts) -->
|
||||
'$file_name'(Name, Opts, E),
|
||||
'$suffix'(E, Opts),
|
||||
'$glob'(Opts).
|
||||
|
||||
'$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, ExpFile) :-
|
||||
'$control_for_expansion'(Opts, Expand),
|
||||
get_abs_file_parameter( relative_to, Opts, RelTo ),
|
||||
prolog_expanded_file_system_path( File, Expand, RelTo, ExpFile ),
|
||||
'$absf_trace'('Traditional expansion: ~w', [ExpFile] ).
|
||||
%
|
||||
% handle library(lists) or foreign(jpl)
|
||||
%
|
||||
'$file_name'(Name, Opts, E) -->
|
||||
{ Name =.. [Lib, P0] },
|
||||
!,
|
||||
{ user:file_search_path(Lib, IDirs) },
|
||||
{ '$paths'(IDirs, Dir ) },
|
||||
'$absf_trace'(' ~w first', [Dir]),
|
||||
'$file_name'(Dir, Opts, _),
|
||||
'$dir',
|
||||
{ '$absf_trace'(' ~w next', [P0]) },
|
||||
'$cat_file_name'(P0, E).
|
||||
'$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 ),
|
||||
!.
|
||||
'$control_for_expansion'(_Opts, Flag) :-
|
||||
current_prolog_flag( open_expands_filename, Flag ).
|
||||
'$absolute_path'( [0'$|L], Opts ) :-
|
||||
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) :-
|
||||
get_abs_file_parameter( extensions, Opts, Extensions ),
|
||||
'$absf_trace'('check extensions ~w?', [Extensions] ),
|
||||
'$add_extensions'(Extensions, File, F0),
|
||||
'$glob'( F0, Opts, FG),
|
||||
get_abs_file_parameter( file_type, Opts, Type ),
|
||||
get_abs_file_parameter( access, Opts, Access ),
|
||||
'$check_file'(FG,Type, Access, F),
|
||||
'$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]).
|
||||
% always verify if a directory
|
||||
'$check_file'(F, directory, _) :-
|
||||
!,
|
||||
exists_directory(F).
|
||||
'$check_file'(_F, _Type, none) :- !.
|
||||
'$check_file'(F, _Type, Access) :-
|
||||
'$access_file'(F, Access),
|
||||
\+ exists_directory(F). % if it has a type cannot be a directory..
|
||||
|
||||
'$glob'( File1, Opts, ExpFile) :-
|
||||
'$control_for_expansion'(Opts, Expand),
|
||||
get_abs_file_parameter( glob, Opts, Glob ),
|
||||
(Glob \== ''
|
||||
'$suffix'(Last, _Opts) -->
|
||||
{ lists:append(_, [0'.|Alphas], Last), '$id'(Alphas, _, [] ) },
|
||||
'$absf_trace'(' suffix in ~s', [Last]),
|
||||
!.
|
||||
'$suffix'(_, Opts) -->
|
||||
{
|
||||
(
|
||||
get_abs_file_parameter( extensions, Opts, Exts ),
|
||||
Exts \= []
|
||||
->
|
||||
'$dir_separator'(D),
|
||||
atom_codes(DA,[D]),
|
||||
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)
|
||||
lists:member(Ext, Exts),
|
||||
'$absf_trace'(' trying suffix ~a from ~w', [Ext,Exts])
|
||||
;
|
||||
Expand == true
|
||||
->
|
||||
expand_file_name(File1, ExpFiles),
|
||||
'$enumerate_glob'(File1, ExpFiles, ExpFile)
|
||||
;
|
||||
File1 = ExpFile
|
||||
get_abs_file_parameter( file_type, Opts, Type ),
|
||||
( Type == source -> NType = prolog ; NType = Type ),
|
||||
user:prolog_file_type(Ext, NType)
|
||||
),
|
||||
'$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) :-
|
||||
!.
|
||||
@ -325,55 +388,45 @@ absolute_file_name(File0,File) :-
|
||||
Base \= '.',
|
||||
Base \='..'.
|
||||
|
||||
|
||||
% always verify if a directory
|
||||
'$check_file'(F, directory, _, F) :-
|
||||
'$prefix'( CorePath, Opts) -->
|
||||
{ '$absolute_path'( CorePath, Opts ) },
|
||||
'$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).
|
||||
'$check_file'(F, _Type, none, F) :- !.
|
||||
'$check_file'(F0, _Type, Access, F0) :-
|
||||
access_file(F0, Access),
|
||||
\+ exists_directory(F0). % if it has a type cannot be a directory..
|
||||
S,
|
||||
'$dir'(Last).
|
||||
'$prefix'( _ , _) -->
|
||||
{
|
||||
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) :-
|
||||
atom_codes(Ext,[C|L]),
|
||||
C \= 0'.,
|
||||
'$dir' --> { current_prolog_flag(windows, true) },
|
||||
!,
|
||||
atom_codes(NExt,[0'.,C|L]).
|
||||
'$mk_sure_true_ext'(Ext,Ext).
|
||||
"\\".
|
||||
'$dir' --> "/".
|
||||
|
||||
'$add_type_extensions'(Type,File,F) :-
|
||||
( Type == source -> NType = prolog ; NType = Type ),
|
||||
user:prolog_file_type(Ext, NType),
|
||||
atom_concat([File,'.',Ext],F),
|
||||
'$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] ).
|
||||
'$dir'('/') --> !.
|
||||
'$dir'('\\') --> { current_prolog_flag(windows, true) },
|
||||
!.
|
||||
'$dir'(_) --> '$dir'.
|
||||
|
||||
%
|
||||
%
|
||||
%
|
||||
'$system_library_directories'(library, Dir) :-
|
||||
user:library_directory( Dir ).
|
||||
% '$split_by_sep'(0, 0, Dirs, Dir).
|
||||
@ -384,67 +437,26 @@ absolute_file_name(File0,File) :-
|
||||
'$system_library_directories'(commons, 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) :-
|
||||
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),
|
||||
'$absf_trace'('file_search_path ~a is ~w', [Name, IDirs] ),
|
||||
ground(IDirs),
|
||||
% enumerate all paths separated by a path_separator.
|
||||
'$paths'(Cs, C) :-
|
||||
atom(Cs),
|
||||
( current_prolog_flag(windows, true) -> Sep = ';' ; Sep = ':' ),
|
||||
sub_atom(Cs, N0, 1, N, Sep),
|
||||
!,
|
||||
(
|
||||
'$extend_path_directory'(IDirs, D, File, Opts, NewFile, Call)
|
||||
sub_atom(Cs,0,N0,_,C)
|
||||
;
|
||||
atom(IDirs) ->
|
||||
'$split_by_sep'(0, 0, IDirs, Dir)
|
||||
;
|
||||
Dir = IDirs
|
||||
),
|
||||
'$extend_pathd'(Dir, D, File, Opts, NewFile, Call).
|
||||
sub_atom(Cs,_,N,0,RC),
|
||||
'$paths'(RC, C)
|
||||
).
|
||||
'$paths'(S, S).
|
||||
|
||||
'$extend_pathd'(Dir, A, File, Opts, NewFile, Goal) :-
|
||||
atom(Dir), !,
|
||||
'$add_file_to_dir'(Dir,A,File,NFile),
|
||||
'$absf_trace'(' try ~a', [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],
|
||||
'$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 ) -->
|
||||
{ current_prolog_flag( verbose_file_search, true ) },
|
||||
!,
|
||||
{ print_message( informational, absolute_file_path( Msg, Args ) ) }.
|
||||
'$absf_trace'(_Msg, _Args ) --> [].
|
||||
|
||||
'$absf_trace'(Msg, Args ) :-
|
||||
current_prolog_flag( verbose_file_search, true ),
|
||||
@ -452,6 +464,18 @@ absolute_file_name(File0,File) :-
|
||||
print_message( informational, absolute_file_path( 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)
|
||||
|
||||
Unify _PrologFileName_ with the Prolog file associated to _File_.
|
||||
@ -560,14 +584,11 @@ system_library/1.
|
||||
%
|
||||
% 1. honor YAPSHAREDIR
|
||||
user:library_directory( Dir ) :-
|
||||
getenv( 'YAPSHAREDIR', Dir0),
|
||||
absolute_file_name( Dir0, [file_type(directory), expand(true),file_errors(fail)], Dir ).
|
||||
getenv( 'YAPSHAREDIR', Dir).
|
||||
%% 2. honor user-library
|
||||
user:library_directory( Dir ) :-
|
||||
absolute_file_name( '~/share/Yap', [file_type(directory), expand(true),file_errors(fail)], Dir ).
|
||||
user:library_directory( '~/share/Yap' ).
|
||||
%% 3. honor current directory
|
||||
user:library_directory( Dir ) :-
|
||||
absolute_file_name( '.', [file_type(directory), expand(true),file_errors(fail)], Dir ).
|
||||
user:library_directory( '.' ).
|
||||
%% 4. honor default location.
|
||||
user:library_directory( Dir ) :-
|
||||
system_library( Dir ).
|
||||
@ -663,7 +684,7 @@ file_search_path(swi, Home) :-
|
||||
current_prolog_flag(home, Home).
|
||||
file_search_path(yap, Home) :-
|
||||
current_prolog_flag(home, Home).
|
||||
file_search_path,(system, Dir) :-
|
||||
file_search_path(system, Dir) :-
|
||||
prolog_flag(host_type, Dir).
|
||||
file_search_path(foreign, Dir) :-
|
||||
foreign_directory(Dir).
|
||||
@ -698,8 +719,7 @@ user:file_search_path(yap, Home) :-
|
||||
current_prolog_flag(home, Home).
|
||||
user:file_search_path(system, Dir) :-
|
||||
prolog_flag(host_type, Dir).
|
||||
user:file_search_path(foreign, Dir) :-
|
||||
working_directory(Dir,Dir).
|
||||
user:file_search_path(foreign, '.').
|
||||
user:file_search_path(foreign, yap('lib/Yap')).
|
||||
user:file_search_path(path, C) :-
|
||||
( getenv('PATH', A),
|
||||
|
@ -129,7 +129,6 @@ do_c_built_in(Mod:G, _, H, OUT) :-
|
||||
'$yap_strip_module'(Mod:G, M1, G1),
|
||||
var(G1), !,
|
||||
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,
|
||||
(clause_location(Call, Caller),
|
||||
strip_module(M:Goal,M1,NGoal),
|
||||
|
@ -307,7 +307,6 @@ be lost.
|
||||
%'$do_spy'(V, M, CP, Flag) :-
|
||||
% writeln('$do_spy'(V, M, CP, Flag)), fail.
|
||||
'$do_spy'(V, M, CP, Flag) :-
|
||||
'$stop_low_level_trace',
|
||||
'$stop_creeping'(_),
|
||||
var(V), !,
|
||||
'$do_spy'(call(V), M, CP, Flag).
|
||||
@ -543,7 +542,7 @@ be lost.
|
||||
'$spycall'(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_expanded'(G, M, CalledFromDebugger, InRedo).
|
||||
|
||||
@ -568,13 +567,13 @@ be lost.
|
||||
*->
|
||||
'$stop_creeping'(_),
|
||||
(
|
||||
'$continue_debugging_goal'(no, '$execute_clause'(G, M, R, CP))
|
||||
'$continue_debugging_goal'(yes, '$execute_clause'(G, M, R, CP))
|
||||
;
|
||||
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
|
||||
|
||||
|
@ -105,6 +105,9 @@ must_be(Type, X, Comment) :-
|
||||
must_be_of_type(callable, X) :-
|
||||
!,
|
||||
is_callable(X, _).
|
||||
must_be_of_type(atom, X) :-
|
||||
!,
|
||||
is_atom(X, _).
|
||||
must_be_of_type(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, _) ).
|
||||
|
||||
must_be_of_type(predicate_indicator, X, Comment) :-
|
||||
!,
|
||||
|
@ -70,7 +70,7 @@ Grammar related built-in predicates:
|
||||
|
||||
*/
|
||||
|
||||
:- module( system('$_grammar'), [!/2,
|
||||
:- system_module( '$_grammar', [!/2,
|
||||
(',')/4,
|
||||
(->)/4,
|
||||
('.')/4,
|
||||
@ -82,9 +82,7 @@ Grammar related built-in predicates:
|
||||
phrase/2,
|
||||
phrase/3,
|
||||
{}/3,
|
||||
('|')/4]).
|
||||
|
||||
:- use_system_module( '$_errors', ['$do_error'/2]).
|
||||
('|')/4], ['$do_error'/2]).
|
||||
|
||||
:- use_module( library( expand_macros ) ).
|
||||
|
||||
@ -232,9 +230,24 @@ prolog:phrase(PhraseDef, WordList) :-
|
||||
This predicate succeeds when the difference list ` _L_- _R_`
|
||||
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) :-
|
||||
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).
|
||||
@ -306,19 +319,16 @@ prolog:'$goal_expansion_allowed'.
|
||||
NewGoal = '$execute_in_mod'(NewGoal3,M)
|
||||
).
|
||||
|
||||
allowed_module(phrase(_,_),_).
|
||||
allowed_module(phrase(_,_,_),_).
|
||||
do_c_built_in('C'(A,B,C), _, _, (A=[B|C])) :- !.
|
||||
|
||||
|
||||
system:goal_expansion(Mod:phrase(NT,Xs0, Xs),Mod:NewGoal) :-
|
||||
do_c_built_in(phrase(NT,Xs0, Xs),Mod, _, NewGoal) :-
|
||||
nonvar(NT), nonvar(Mod), !,
|
||||
'$goal_expansion_allowed',
|
||||
'$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),
|
||||
'$goal_expansion_allowed',
|
||||
'$c_built_in_phrase'(NT, [], Xs, Mod, NewGoal).
|
||||
'$c_built_in_phrase'(NT, Xs, [], Mod, NewGoal).
|
||||
|
||||
/**
|
||||
@}
|
||||
|
11
pl/init.yap
11
pl/init.yap
@ -120,7 +120,7 @@ otherwise.
|
||||
'$early_print_message'(Level, Msg) :-
|
||||
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) :-
|
||||
format(user_error, 'unprocessed ~a ~w ~n', [Level,Msg]).
|
||||
|
||||
@ -135,6 +135,9 @@ print_message(Level, Msg) :-
|
||||
|
||||
|
||||
:- bootstrap('arith.yap').
|
||||
|
||||
:- compile_expressions.
|
||||
|
||||
:- bootstrap('lists.yap').
|
||||
:- bootstrap('consult.yap').
|
||||
:- bootstrap('preddecls.yap').
|
||||
@ -145,14 +148,12 @@ print_message(Level, Msg) :-
|
||||
|
||||
:- bootstrap('atoms.yap').
|
||||
:- bootstrap('os.yap').
|
||||
:- bootstrap('grammar.yap').
|
||||
:- bootstrap('absf.yap').
|
||||
:- set_prolog_flag(verbose, normal).
|
||||
|
||||
%:-set_prolog_flag(gc_trace, verbose).
|
||||
%:- set_prolog_flag( verbose_file_search, true ).
|
||||
|
||||
:- compile_expressions.
|
||||
|
||||
:- dynamic prolog:'$parent_module'/2.
|
||||
|
||||
:- [
|
||||
@ -162,8 +163,6 @@ print_message(Level, Msg) :-
|
||||
].
|
||||
|
||||
:- use_module('error.yap').
|
||||
:- use_module('grammar.yap').
|
||||
|
||||
|
||||
:- [
|
||||
'errors.yap',
|
||||
|
@ -51,7 +51,7 @@ variable:
|
||||
|
||||
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) :-
|
||||
@ -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), !,
|
||||
'$do_error'(instantiation_error,G).
|
||||
'$check_objs_for_load_foreign_files'([],[],_) :- !.
|
||||
|
@ -105,10 +105,18 @@ compose_message( Term, _Level ) -->
|
||||
prolog:message(Term), !.
|
||||
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) -->
|
||||
[ ' absolute_file_path: ' - [],
|
||||
[ ' : ' - [],
|
||||
Msg - Args,
|
||||
nl ].
|
||||
compose_message( arguments([]), _Level) -->
|
||||
[].
|
||||
compose_message( arguments([A|As]), Level) -->
|
||||
[ ' ~w' - [A],
|
||||
nl ],
|
||||
compose_message( arguments(As), Level).
|
||||
compose_message( ancestors([]), _Level) -->
|
||||
[ 'There are no ancestors.' ].
|
||||
compose_message( breakp(bp(debugger,_,_,M:F/N,_),add,already), _Level) -->
|
||||
@ -195,7 +203,8 @@ compose_message(Term, Level) -->
|
||||
[nl,nl].
|
||||
compose_message(Term, Level) -->
|
||||
{ Level == error -> true ; Level == warning },
|
||||
main_message( Term, Level ),
|
||||
{ '$show_consult_level'(LC) },
|
||||
main_message( Term, Level, LC ),
|
||||
[nl,nl].
|
||||
|
||||
location(error(syntax_error(syntax_error(_,between(_,LN,_),FileName,_))), _ ) -->
|
||||
@ -209,75 +218,72 @@ location( error(_,Term), Level ) -->
|
||||
{ source_location(F0, L),
|
||||
stream_property(_Stream, alias(loop_stream)) }, !,
|
||||
{ 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].
|
||||
location( error(_,Term), Level ) -->
|
||||
{ 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].
|
||||
|
||||
%message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !,
|
||||
main_message(error(Msg,Info), _) --> {var(Info)}, !,
|
||||
[ nl, '~*|!!! uninstantiated message ~w~n.' - [8,Msg], nl ].
|
||||
main_message( error(syntax_error(syntax_error(Msg,between(L0,LM,LF),_Stream,Term)),_), _ ) -->
|
||||
main_message(error(Msg,Info), _, LC) --> {var(Info)}, !,
|
||||
[ nl, '~*|!!! uninstantiated message ~w~n.' - [LC,Msg], nl ].
|
||||
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],
|
||||
% [prefix(' ')],
|
||||
( syntax_error_term( between(L0,LM,LF), Term )
|
||||
->
|
||||
[]
|
||||
;
|
||||
['failed_processing syntax error term ~q' - [Term]],
|
||||
['~*|!!! failed_processing syntax error term ~q' - [LC,Term]],
|
||||
[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) },
|
||||
[ '~*|!!! 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 = [_] -> 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] ].
|
||||
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] ].
|
||||
main_message(error(consistency_error(Who)), _Source) -->
|
||||
[ '~*|!!! discontiguous definition for ~p.' - [LC,Mod:N/A] ].
|
||||
main_message(error(consistency_error(Who)), _Source, LC) -->
|
||||
!,
|
||||
{ '$show_consult_level'(LC) },
|
||||
[ '~*|!!! 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 ].
|
||||
main_message(error(evaluation_error(What, Who), _Where), _Source) -->
|
||||
[ '~*|!!! ~q does not belong to domain ~a,' - [LC,Type,Who], nl ].
|
||||
main_message(error(evaluation_error(What, Who), _Where), _Source, LC) -->
|
||||
!,
|
||||
[ '~*|!!! ~w caused ~a during evaluation of arithmetic expressions,' - [8,Who,What], nl ].
|
||||
main_message(error(existence_error(Type , Who), _Where), _Source) -->
|
||||
[ '~*|!!! ~w caused ~a during evaluation of arithmetic expressions,' - [LC,Who,What], nl ].
|
||||
main_message(error(existence_error(Type , Who), _Where), _Source, LC) -->
|
||||
!,
|
||||
[ '~*|!!! ~q ~q could not be found,' - [8,Type, Who], nl ].
|
||||
main_message(error(permission_error(Op, Type, Id), _Where), _Source) -->
|
||||
[ '~*|!!! ~q is not allowed in ~a ~q,' - [8, Op, Type,Id], nl ].
|
||||
main_message(error(instantiation_error, _Where), _Source) -->
|
||||
[ '~*|!!! unbound variable' - [8], nl ].
|
||||
main_message(error(representation_error), _Source) -->
|
||||
[ '~*|!!! unbound variable' - [8], nl ].
|
||||
main_message(error(type_error(Type,Who), _What), _Source) -->
|
||||
[ '~*|!!! ~q should be of type ~a' - [8,Who,Type]],
|
||||
[ '~*|!!! ~q ~q could not be found,' - [LC,Type, Who], nl ].
|
||||
main_message(error(permission_error(Op, Type, Id), _Where), _Source, LC) -->
|
||||
[ '~*|!!! ~q is not allowed in ~a ~q,' - [LC, Op, Type,Id], nl ].
|
||||
main_message(error(instantiation_error, _Where), _Source, LC) -->
|
||||
[ '~*|!!! unbound variable' - [LC], nl ].
|
||||
main_message(error(representation_error), _Source, LC) -->
|
||||
[ '~*|!!! unbound variable' - [LC], nl ].
|
||||
main_message(error(type_error(Type,Who), _What), _Source, LC) -->
|
||||
[ '~*|!!! ~q should be of type ~a' - [LC,Who,Type]],
|
||||
[ nl ].
|
||||
main_message(error(system_error(Who), _What), _Source) -->
|
||||
[ '~*|!!! ~q error' - [8,Who]],
|
||||
main_message(error(system_error(Who), _What), _Source, LC) -->
|
||||
[ '~*|!!! ~q error' - [LC,Who]],
|
||||
[ nl ].
|
||||
main_message(error(uninstantiation_error(T),_), _Source) -->
|
||||
[ '~*|!!! found ~q, expected unbound variable ' - [8,T], nl ].
|
||||
main_message(error(uninstantiation_error(T),_), _Source, LC) -->
|
||||
[ '~*|!!! found ~q, expected unbound variable ' - [LC,T], nl ].
|
||||
|
||||
display_consulting(_Level) -->
|
||||
{ source_location(F0, L),
|
||||
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(_) --> [].
|
||||
|
||||
caller( error(_,Term), _) -->
|
||||
@ -286,12 +292,12 @@ caller( error(_,Term), _) -->
|
||||
!,
|
||||
['~*|goal was ~q' - [10,Call]],
|
||||
[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].
|
||||
caller( error(_,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].
|
||||
caller( error(_,Term), _) -->
|
||||
{ lists:memberchk([g|g(Call)], Term) },
|
||||
@ -304,7 +310,7 @@ caller( _, _) -->
|
||||
c_goal( error(_,Term), Level ) -->
|
||||
{ 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].
|
||||
c_goal( _, _Level ) --> [].
|
||||
|
||||
|
31
pl/qly.yap
31
pl/qly.yap
@ -243,12 +243,19 @@ qend_program :-
|
||||
|
||||
'$init_state' :-
|
||||
once('$handle_throw'(_,_,_)),
|
||||
fail.
|
||||
'$init_state' :-
|
||||
recorded('$program_state', _P, _), !,
|
||||
'$do_init_state'.
|
||||
'$init_state'.
|
||||
(
|
||||
recorded('$program_state', _P, R)
|
||||
->
|
||||
erase(R),
|
||||
'$do_init_state'
|
||||
;
|
||||
true
|
||||
).
|
||||
|
||||
'$do_init_state' :-
|
||||
set_value('$user_module',user),
|
||||
'$protect',
|
||||
fail.
|
||||
'$do_init_state' :-
|
||||
compile_expressions,
|
||||
'$init_preds',
|
||||
@ -262,10 +269,6 @@ qend_program :-
|
||||
'$do_init_state' :-
|
||||
'$reinit_thread0',
|
||||
fail.
|
||||
'$do_init_state' :-
|
||||
set_value('$user_module',user),
|
||||
'$protect',
|
||||
fail.
|
||||
'$do_init_state' :-
|
||||
'$current_module'(prolog),
|
||||
module(user),
|
||||
@ -280,10 +283,13 @@ qend_program :-
|
||||
|
||||
%
|
||||
% first, recover what we need from the saved state...
|
||||
%
|
||||
%'
|
||||
'$init_from_saved_state_and_args' :-
|
||||
'$init_path_extensions',
|
||||
fail.
|
||||
'$init_from_saved_state_and_args' :-
|
||||
'$protect',
|
||||
fail.
|
||||
% use if we come from a save_program and we have SWI's shlib
|
||||
'$init_from_saved_state_and_args' :-
|
||||
current_prolog_flag(hwnd, _HWND),
|
||||
@ -320,15 +326,12 @@ qend_program :-
|
||||
'$init_from_saved_state_and_args' :-
|
||||
'$startup_goals',
|
||||
fail.
|
||||
'$init_from_saved_state_and_args' :-
|
||||
'$init_from_saved' :-
|
||||
recorded('$restore_goal',G,R),
|
||||
erase(R),
|
||||
prompt(_,'| '),
|
||||
catch(once(user:G),Error,user:'$Error'(Error)),
|
||||
fail.
|
||||
'$init_from_saved_state_and_args' :-
|
||||
'$protect',
|
||||
fail.
|
||||
'$init_from_saved_state_and_args'.
|
||||
|
||||
'$init_path_extensions' :-
|
||||
|
22
pl/yio.yap
22
pl/yio.yap
@ -46,6 +46,7 @@
|
||||
ttynl/0,
|
||||
ttyput/1,
|
||||
ttyskip/1,
|
||||
rename/2,
|
||||
write_depth/2], ['$default_expand'/1,
|
||||
'$extend_file_search_path'/1,
|
||||
'$set_default_expand'/1]).
|
||||
@ -438,8 +439,25 @@ The atom _File_ corresponds to an existing file or directory.
|
||||
|
||||
*/
|
||||
file_exists(IFile) :-
|
||||
true_file_name(IFile, File),
|
||||
'$file_exists'(File).
|
||||
absolute_file_name(IFile, _File, [expand(true), solutions(first), access(exist)]).
|
||||
|
||||
/** @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)]).
|
||||
|
||||
|
||||
/**
|
||||
@}
|
||||
|
Reference in New Issue
Block a user