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) {

64
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,21 +954,26 @@ 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
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;
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))
fe.t = 0;
}
#if EMACS
first_char = tokstart->TokPos;
#endif /* EMACS */
return fe.t;
} }
static Int static Int
@ -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) */

17
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);
@ -628,8 +633,13 @@ static Int stream_property(USES_REGS1) { /* Init current_stream */
cut_fail(); cut_fail();
} }
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;
} }

2740
os/sysbits.c
View File

File diff suppressed because it is too large Load Diff

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,

454
pl/absf.yap
View File

@ -170,51 +170,52 @@ 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),
fail fail
) )
; ;
% 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 ) -->
get_abs_file_parameter( expand, Opts, true ), '$cat_file_name'(A, _),
!. '$dir',
'$control_for_expansion'(_Opts, Flag) :- '$cat_file_name'(B, E).
current_prolog_flag( open_expands_filename, Flag ). '$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 ),
!.
'$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) :- % 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) -->
'$dir_separator'(D), {
atom_codes(DA,[D]), (
atom_concat( [File1, DA, Glob], File2 ), get_abs_file_parameter( extensions, Opts, Exts ),
expand_file_name(File2, ExpFiles), Exts \= []
% glob is not very much into failing ->
%[File2] \== ExpFiles, lists:member(Ext, Exts),
'$enumerate_glob'(File2, ExpFiles, ExpFile) '$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) :- '$enumerate_glob'(_File1, [ExpFile], ExpFile) :-
!. !.
@ -325,55 +388,45 @@ absolute_file_name(File0,File) :-
Base \= '.', Base \= '.',
Base \='..'. Base \='..'.
'$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)
},
!,
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', []).
% always verify if a directory
'$check_file'(F, directory, _, F) :-
!,
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..
'$add_extensions'([Ext|_], File,F) :- '$dir' --> { current_prolog_flag(windows, true) },
'$absf_trace'(' extension ~w', [Ext] ), !,
'$mk_sure_true_ext'(Ext,NExt), "\\".
atom_concat([File,NExt],F). '$dir' --> "/".
'$add_extensions'([_|Extensions],File,F) :-
'$add_extensions'(Extensions,File,F).
'$mk_sure_true_ext'(Ext,NExt) :- '$dir'('/') --> !.
atom_codes(Ext,[C|L]), '$dir'('\\') --> { current_prolog_flag(windows, true) },
C \= 0'., !.
!, '$dir'(_) --> '$dir'.
atom_codes(NExt,[0'.,C|L]).
'$mk_sure_true_ext'(Ext,Ext).
'$add_type_extensions'(Type,File,F) :-
( Type == source -> NType = prolog ; NType = Type ),
user:prolog_file_type(Ext, NType),
atom_concat([File,'.',Ext],F),
'$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,73 +437,44 @@ 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). (
sub_atom(Cs,0,N0,_,C)
;
% closed a directory sub_atom(Cs,_,N,0,RC),
'$continue_split_by_sep'(Sep, Start, Next, Dirs, Sep, Dir) :- '$paths'(RC, C)
Sz is Next-Start, ).
Sz > 0, '$paths'(S, S).
sub_atom(Dirs, Start, Sz, _, Dir).
% next dir '$absf_trace'(Msg, Args ) -->
'$continue_split_by_sep'(Sep , _Start, Next, Dirs, Sep, Dir) :- !, { current_prolog_flag( verbose_file_search, true ) },
N1 is Next+1, !,
'$split_by_sep'(N1, N1, Dirs, Dir). { print_message( informational, absolute_file_path( Msg, Args ) ) }.
% same dir '$absf_trace'(_Msg, _Args ) --> [].
'$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)
;
atom(IDirs) ->
'$split_by_sep'(0, 0, IDirs, Dir)
;
Dir = IDirs
),
'$extend_pathd'(Dir, D, File, Opts, NewFile, Call).
'$extend_pathd'(Dir, A, File, Opts, NewFile, Goal) :-
atom(Dir), !,
'$add_file_to_dir'(Dir,A,File,NFile),
'$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 ) :- '$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'( File ) :-
current_prolog_flag( verbose_file_search, true ), current_prolog_flag( verbose_file_search, true ),
!, !,
print_message( informational, absolute_file_path( Msg, Args ) ). print_message( informational, absolute_file_path( File ) ).
'$absf_trace'(_Msg, _Args ). '$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)
@ -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),
@ -711,4 +731,4 @@ user:file_search_path(path, C) :-
). ).
%% @} %% @}

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),

2
pl/boot.yap
View File

@ -373,7 +373,7 @@ true :- true.
get_value('$consult_on_boot',X), get_value('$consult_on_boot',X),
( (
X \= [] X \= []
-> ->
bootstrap(X), bootstrap(X),
module( user ), module( user ),
qsave_program( 'startup.yss') qsave_program( 'startup.yss')

17
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).
@ -521,15 +520,15 @@ be lost.
'$spycall'(G, M, _, _) :- '$spycall'(G, M, _, _) :-
current_prolog_flag( debug, false), current_prolog_flag( debug, false),
!, !,
'$execute_nonstop'(G,M). '$execute_nonstop'(G,M).
'$spycall'(G, M, _, _) :- '$spycall'(G, M, _, _) :-
'__NB_getval__'('$debug_jump',true, fail), '__NB_getval__'('$debug_jump',true, fail),
!, !,
( '$is_metapredicate'(G, M) ( '$is_metapredicate'(G, M)
-> ->
'$expand_meta_call'(M:G, [], G1) '$expand_meta_call'(M:G, [], G1)
; ;
G = G1 G = G1
), ),
'$execute_nonstop'(G1,M). '$execute_nonstop'(G1,M).
'$spycall'(G, M, _, _) :- '$spycall'(G, M, _, _) :-
@ -542,8 +541,8 @@ be lost.
'$do_spy'(NG, NM, CP, spy). '$do_spy'(NG, NM, CP, spy).
'$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
@ -786,7 +785,7 @@ be lost.
'$action'(0'n,_,_,_,_,off) :- !, % 'n nodebug '$action'(0'n,_,_,_,_,off) :- !, % 'n nodebug
'$skipeol'(0'n), % ' '$skipeol'(0'n), % '
% tell debugger never to stop. % tell debugger never to stop.
'__NB_setval__'('$debug_run', -1), '__NB_setval__'('$debug_run', -1),
'__NB_setval__'('$debug_jump',true), '__NB_setval__'('$debug_jump',true),
nodebug. nodebug.
'$action'(0'r,_,CallId,_,_,_) :- !, % 'r retry '$action'(0'r,_,CallId,_,_,_) :- !, % 'r retry

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) :-
!, !,

56
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,14 +82,12 @@ 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 ) ).
% :- meta_predicate ^(?,0,?). % :- meta_predicate ^(?,0,?).
% ^(Xs, Goal, Xs) :- call(Goal). % ^(Xs, Goal, Xs) :- call(Goal).
% :- meta_predicate ^(?,1,?,?). % :- meta_predicate ^(?,1,?,?).
% ^(Xs0, Goal, Xs0, Xs) :- call(Goal, Xs). % ^(Xs0, Goal, Xs0, Xs) :- call(Goal, Xs).
@ -101,17 +99,17 @@ Grammar related built-in predicates:
*/ */
prolog:'$translate_rule'(Rule, (NH :- B) ) :- prolog:'$translate_rule'(Rule, (NH :- B) ) :-
source_module( SM ), source_module( SM ),
'$yap_strip_module'( SM:Rule, M0, (LP-->RP) ), '$yap_strip_module'( SM:Rule, M0, (LP-->RP) ),
t_head(LP, NH0, NGs, S, SR, (LP-->SM:RP)), t_head(LP, NH0, NGs, S, SR, (LP-->SM:RP)),
'$yap_strip_module'( M0:NH0, M, NH1 ), '$yap_strip_module'( M0:NH0, M, NH1 ),
( M == SM -> NH = NH1 ; NH = M:NH1 ), ( M == SM -> NH = NH1 ; NH = M:NH1 ),
(var(NGs) -> (var(NGs) ->
t_body(RP, _, last, S, SR, B1) t_body(RP, _, last, S, SR, B1)
; ;
t_body((RP,{NGs}), _, last, S, SR, B1) t_body((RP,{NGs}), _, last, S, SR, B1)
), ),
t_tidy(B1, B). t_tidy(B1, B).
t_head(V, _, _, _, _, G0) :- var(V), !, t_head(V, _, _, _, _, G0) :- var(V), !,
@ -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) :-
@ -73,6 +73,29 @@ load_foreign_files(Objs,Libs,Entry) :-
; ;
true true
), ),
!.
/** @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), !,

88
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,' - [LC,Who,What], nl ].
main_message(error(existence_error(Type , Who), _Where), _Source, LC) -->
!, !,
[ '~*|!!! ~w caused ~a during evaluation of arithmetic expressions,' - [8,Who,What], nl ]. [ '~*|!!! ~q ~q could not be found,' - [LC,Type, Who], nl ].
main_message(error(existence_error(Type , Who), _Where), _Source) --> main_message(error(permission_error(Op, Type, Id), _Where), _Source, LC) -->
!, [ '~*|!!! ~q is not allowed in ~a ~q,' - [LC, Op, Type,Id], nl ].
[ '~*|!!! ~q ~q could not be found,' - [8,Type, Who], nl ]. main_message(error(instantiation_error, _Where), _Source, LC) -->
main_message(error(permission_error(Op, Type, Id), _Where), _Source) --> [ '~*|!!! unbound variable' - [LC], nl ].
[ '~*|!!! ~q is not allowed in ~a ~q,' - [8, Op, Type,Id], nl ]. main_message(error(representation_error), _Source, LC) -->
main_message(error(instantiation_error, _Where), _Source) --> [ '~*|!!! unbound variable' - [LC], nl ].
[ '~*|!!! unbound variable' - [8], nl ]. main_message(error(type_error(Type,Who), _What), _Source, LC) -->
main_message(error(representation_error), _Source) --> [ '~*|!!! ~q should be of type ~a' - [LC,Who,Type]],
[ '~*|!!! unbound variable' - [8], nl ].
main_message(error(type_error(Type,Who), _What), _Source) -->
[ '~*|!!! ~q should be of type ~a' - [8,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 ) --> [].

39
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' :-
@ -343,9 +346,9 @@ qend_program :-
module(user), module(user),
fail. fail.
'$startup_goals' :- '$startup_goals' :-
recorded('$startup_goal',G,_), recorded('$startup_goal',G,_),
catch(once(user:G),Error,user:'$Error'(Error)), catch(once(user:G),Error,user:'$Error'(Error)),
fail. fail.
'$startup_goals' :- '$startup_goals' :-
get_value('$init_goal',GA), get_value('$init_goal',GA),
GA \= [], GA \= [],
@ -793,4 +796,4 @@ qload_file( F0 ) :-
'$process_directives'( _FilePl ) :- '$process_directives'( _FilePl ) :-
abolish(user:'$file_property'/1). abolish(user:'$file_property'/1).
%% @} %% @}

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)]).
/** /**
@} @}