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_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;
}

2
os/readline.c
View File

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

64
os/readterm.c
View File

@ -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,21 +954,26 @@ 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
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;
}
}
}
{
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;
return 0;
}
static Int
@ -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) */

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,
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);
@ -628,8 +633,13 @@ static Int stream_property(USES_REGS1) { /* Init current_stream */
cut_fail();
}
args = Yap_ArgListToVector(Deref(ARG2), stream_property_defs,
STREAM_PROPERTY_END);
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;
}

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

454
pl/absf.yap
View File

@ -170,51 +170,52 @@ 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,
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'(' 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'('found solution ~a', [TrueFileName] ),
% stop_low_level_trace,
set_prolog_flag( fileerrors, PreviousFileErrors ),
set_prolog_flag( file_name_variables, OldF),
set_prolog_flag( verbose_file_search, PreviousVerbose )
;
'$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),
fail
)
;
% no solution
% stop_low_level_trace,
;
% 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) :-
get_abs_file_parameter( expand, Opts, true ),
!.
'$control_for_expansion'(_Opts, Flag) :-
current_prolog_flag( open_expands_filename, Flag ).
'$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 ),
!.
'$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 \== ''
->
'$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)
;
Expand == true
->
expand_file_name(File1, ExpFiles),
'$enumerate_glob'(File1, ExpFiles, ExpFile)
'$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 \= []
->
lists:member(Ext, Exts),
'$absf_trace'(' trying suffix ~a from ~w', [Ext,Exts])
;
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 \='..'.
'$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) :-
'$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).
'$dir' --> { current_prolog_flag(windows, true) },
!,
"\\".
'$dir' --> "/".
'$mk_sure_true_ext'(Ext,NExt) :-
atom_codes(Ext,[C|L]),
C \= 0'.,
!,
atom_codes(NExt,[0'.,C|L]).
'$mk_sure_true_ext'(Ext,Ext).
'$add_type_extensions'(Type,File,F) :-
( Type == source -> NType = prolog ; NType = Type ),
user:prolog_file_type(Ext, NType),
atom_concat([File,'.',Ext],F),
'$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,73 +437,44 @@ 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),
(
'$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).
% 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),
!,
(
sub_atom(Cs,0,N0,_,C)
;
sub_atom(Cs,_,N,0,RC),
'$paths'(RC, C)
).
'$paths'(S, S).
'$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 ),
!,
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( Msg, Args ) ).
'$absf_trace'(_Msg, _Args ).
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)
@ -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),
@ -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),
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),

2
pl/boot.yap
View File

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

17
pl/debug.yap
View File

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

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

@ -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',

25
pl/load_foreign.yap
View File

@ -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) :-
@ -73,6 +73,29 @@ load_foreign_files(Objs,Libs,Entry) :-
;
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), !,

88
pl/messages.yap
View File

@ -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,' - [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 ].
main_message(error(existence_error(Type , Who), _Where), _Source) -->
!,
[ '~*|!!! ~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 ) --> [].

39
pl/qly.yap
View File

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

22
pl/yio.yap
View File

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