more fixes to absolute_file_names and a new option, glob/1.
This commit is contained in:
Vítor Santos Costa
parent
a8b51a1ada
commit
1d66c45fc2
@ -155,6 +155,7 @@
|
||||
AtomGeneratePredInfo = Yap_FullLookupAtom("$generate_pred_info");
|
||||
AtomGetwork = Yap_FullLookupAtom("$getwork");
|
||||
AtomGetworkSeq = Yap_FullLookupAtom("$getwork_seq");
|
||||
AtomGlob = Yap_LookupAtom("glob");
|
||||
AtomGlobal = Yap_LookupAtom("global");
|
||||
AtomGlobalSp = Yap_LookupAtom("global_sp");
|
||||
AtomGlobalTrie = Yap_LookupAtom("global_trie");
|
||||
|
||||
@ -155,6 +155,7 @@
|
||||
AtomGeneratePredInfo = AtomAdjust(AtomGeneratePredInfo);
|
||||
AtomGetwork = AtomAdjust(AtomGetwork);
|
||||
AtomGetworkSeq = AtomAdjust(AtomGetworkSeq);
|
||||
AtomGlob = AtomAdjust(AtomGlob);
|
||||
AtomGlobal = AtomAdjust(AtomGlobal);
|
||||
AtomGlobalSp = AtomAdjust(AtomGlobalSp);
|
||||
AtomGlobalTrie = AtomAdjust(AtomGlobalTrie);
|
||||
|
||||
@ -461,6 +461,9 @@
|
||||
Atom AtomGetworkSeq_;
|
||||
#define AtomGetworkSeq Yap_heap_regs->AtomGetworkSeq_
|
||||
#define TermGetworkSeq MkAtomTerm( Yap_heap_regs->AtomGetworkSeq_ )
|
||||
Atom AtomGlob_;
|
||||
#define AtomGlob Yap_heap_regs->AtomGlob_
|
||||
#define TermGlob MkAtomTerm( Yap_heap_regs->AtomGlob_ )
|
||||
Atom AtomGlobal_;
|
||||
#define AtomGlobal Yap_heap_regs->AtomGlobal_
|
||||
#define TermGlobal MkAtomTerm( Yap_heap_regs->AtomGlobal_ )
|
||||
|
||||
60
os/iopreds.c
60
os/iopreds.c
@ -1447,7 +1447,6 @@ do_open ( Term file_name, Term t2, Term tlist USES_REGS )
|
||||
return PlIOError (RESOURCE_ERROR_MAX_STREAMS,TermNil, "open/3");
|
||||
st = &GLOBAL_Stream[sno];
|
||||
st->user_name = file_name;
|
||||
st->name = Yap_LookupAtom(Yap_AbsoluteFile(fname, NULL));
|
||||
flags = s;
|
||||
// user requested encoding?
|
||||
if (args[OPEN_ALIAS].used) {
|
||||
@ -1463,24 +1462,21 @@ do_open ( Term file_name, Term t2, Term tlist USES_REGS )
|
||||
} else {
|
||||
encoding = LOCAL_encoding;
|
||||
}
|
||||
bool ok =
|
||||
(
|
||||
args[OPEN_EXPAND_FILENAME].used
|
||||
?
|
||||
args[OPEN_EXPAND_FILENAME].tvalue == TermTrue
|
||||
:
|
||||
false
|
||||
)
|
||||
|| trueGlobalPrologFlag(OPEN_EXPANDS_FILENAME_FLAG);
|
||||
// expand file name?
|
||||
if (args[OPEN_EXPAND_FILENAME].used) {
|
||||
Term t = args[OPEN_TYPE].tvalue;
|
||||
if (t == TermTrue) {
|
||||
fname = Yap_AbsoluteFile( fname, LOCAL_FileNameBuf);
|
||||
} else {
|
||||
if (!strncpy(LOCAL_FileNameBuf, fname, YAP_FILENAME_MAX))
|
||||
return PlIOError (SYSTEM_ERROR_INTERNAL,file_name,"file name is too long in open/3");
|
||||
}
|
||||
} else if (trueGlobalPrologFlag(OPEN_EXPANDS_FILENAME_FLAG)) {
|
||||
fname = Yap_AbsoluteFile( fname, LOCAL_FileNameBuf);
|
||||
} else {
|
||||
if (!strncpy(LOCAL_FileNameBuf, fname, YAP_FILENAME_MAX)) {
|
||||
return PlIOError (SYSTEM_ERROR_INTERNAL,file_name,"file name is too long in open/3");
|
||||
}
|
||||
}
|
||||
fname = Yap_AbsoluteFile( fname, LOCAL_FileNameBuf, ok );
|
||||
st->name = Yap_LookupAtom(fname);
|
||||
|
||||
// binary type
|
||||
if ((args[OPEN_TYPE].used)) {
|
||||
if (args[OPEN_TYPE].used) {
|
||||
Term t = args[OPEN_TYPE].tvalue;
|
||||
bool bin = ( t == TermBinary );
|
||||
if (bin) {
|
||||
@ -1851,15 +1847,16 @@ read_line(int sno)
|
||||
|
||||
|
||||
#define ABSOLUTE_FILE_NAME_DEFS() \
|
||||
PAR( "extensions", ok, ABSOLUTE_FILE_NAME_EXTENSIONS), \
|
||||
PAR( "relative_to", isatom, ABSOLUTE_FILE_NAME_RELATIVE_TO ), \
|
||||
PAR( "access", isatom, ABSOLUTE_FILE_NAME_ACCESS ), \
|
||||
PAR( "file_type", is_file_type, ABSOLUTE_FILE_NAME_FILE_TYPE ), \
|
||||
PAR( "file_errors", is_file_errors, ABSOLUTE_FILE_NAME_FILE_ERRORS ), \
|
||||
PAR( "solutions", issolutions, ABSOLUTE_FILE_NAME_SOLUTIONS ), \
|
||||
PAR( "expand", boolean, ABSOLUTE_FILE_NAME_EXPAND ), \
|
||||
PAR( "verbose_file_search", boolean, ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH), \
|
||||
PAR( NULL, ok, ABSOLUTE_FILE_NAME_END )
|
||||
PAR( "access", isatom, ABSOLUTE_FILE_NAME_ACCESS ), \
|
||||
PAR( "expand", boolean, 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( "glob", ok, ABSOLUTE_FILE_NAME_GLOB), \
|
||||
PAR( "relative_to", isatom, ABSOLUTE_FILE_NAME_RELATIVE_TO ), \
|
||||
PAR( "solutions", issolutions, ABSOLUTE_FILE_NAME_SOLUTIONS ), \
|
||||
PAR( "verbose_file_search", boolean, ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH), \
|
||||
PAR( NULL, ok, ABSOLUTE_FILE_NAME_END )
|
||||
|
||||
#define PAR(x,y,z) z
|
||||
|
||||
@ -1895,7 +1892,7 @@ static Int abs_file_parameters ( USES_REGS1 )
|
||||
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] = TermDot;
|
||||
t[ABSOLUTE_FILE_NAME_RELATIVE_TO] = TermEmptyAtom;
|
||||
if (args[ABSOLUTE_FILE_NAME_FILE_TYPE].used)
|
||||
t[ABSOLUTE_FILE_NAME_FILE_TYPE] = args[ABSOLUTE_FILE_NAME_FILE_TYPE].tvalue;
|
||||
else
|
||||
@ -1916,10 +1913,14 @@ static Int abs_file_parameters ( USES_REGS1 )
|
||||
t[ABSOLUTE_FILE_NAME_EXPAND] = args[ABSOLUTE_FILE_NAME_EXPAND].tvalue;
|
||||
else
|
||||
t[ABSOLUTE_FILE_NAME_EXPAND] = TermFalse;
|
||||
if (args[ABSOLUTE_FILE_NAME_GLOB].used)
|
||||
t[ABSOLUTE_FILE_NAME_GLOB] = args[ABSOLUTE_FILE_NAME_GLOB].tvalue;
|
||||
else
|
||||
t[ABSOLUTE_FILE_NAME_GLOB] = TermEmptyAtom;
|
||||
if (args[ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH].used)
|
||||
t[ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH] = args[ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH].tvalue;
|
||||
else
|
||||
t[ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH] = getYapFlag( TermVerboseFileSearch );
|
||||
t[ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH] = TermFalse;
|
||||
tf = Yap_MkApplTerm(Yap_MkFunctor(AtomOpt,ABSOLUTE_FILE_NAME_END), ABSOLUTE_FILE_NAME_END, t);
|
||||
return (Yap_unify (ARG2, tf));
|
||||
|
||||
@ -1942,10 +1943,13 @@ static Int get_abs_file_parameter ( USES_REGS1 )
|
||||
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;
|
||||
|
||||
}
|
||||
|
||||
109
pl/absf.yap
109
pl/absf.yap
@ -50,7 +50,6 @@
|
||||
*/
|
||||
:- multifile user:library_directory/1.
|
||||
:- dynamic user:library_directory/1.
|
||||
|
||||
%% user:library_directory( ?Dir )
|
||||
% Specifies the set of directories where
|
||||
% one can find Prolog libraries.
|
||||
@ -219,11 +218,13 @@ user:file_search_path(path, C) :-
|
||||
|
||||
- extensions(+ _ListOfExtensions_)
|
||||
|
||||
List of file-extensions to try. Default is `''`. For each
|
||||
extension, absolute_file_name/3 will first add the extension and then
|
||||
verify the conditions imposed by the other options. If the condition
|
||||
fails, the next extension of the list is tried. Extensions may be
|
||||
specified both with dot, as `.ext`, or without, as plain `ext`.
|
||||
List of file-name suffixes to add to try adding to the file. The
|
||||
Default is the empty suffix, `''`. For each extension,
|
||||
absolute_file_name/3 will first add the extension and then verify
|
||||
the conditions imposed by the other options. If the condition
|
||||
fails, the next extension of the list is tried. Extensions may
|
||||
be specified both with dot, as `.ext`, or without, as plain
|
||||
`ext`.
|
||||
|
||||
- relative_to(+ _FileOrDir_ )
|
||||
|
||||
@ -262,20 +263,29 @@ user:file_search_path(path, C) :-
|
||||
|
||||
- file_errors(`fail`/`error`)
|
||||
|
||||
If `error` (default), throw and `existence_error` exception
|
||||
If `error` (default), throw `existence_error` exception
|
||||
if the file cannot be found. If `fail`, stay silent.
|
||||
|
||||
- solutions(`first`/`all`)
|
||||
|
||||
If `first` (default), the search cannot backtrack. leaves no choice-point.
|
||||
Otherwise a choice-point will be left and backtracking may yield
|
||||
more solutions.
|
||||
If `first` (default), commit to the first solution. Otherwise
|
||||
absolute_file_name will enumerate all solutions via backtracking.
|
||||
|
||||
- expand(`true`/`false`)
|
||||
|
||||
If `true` (default is `false`) and _Spec_ is atomic,
|
||||
call expand_file_name/2 followed by member/2 on _Spec_ before
|
||||
proceeding. This is originally a SWI-Prolog extension.
|
||||
If `true` (default is `false`) and _Spec_ is atomic, call
|
||||
expand_file_name/2 followed by member/2 on _Spec_ before
|
||||
proceeding. This is originally a SWI-Prolog extension, but
|
||||
whereas SWI-Prolog implements its own conventions, YAP uses the
|
||||
shell's `glob` primitive.
|
||||
|
||||
- glob(`Pattern`)
|
||||
|
||||
If _Pattern_ is atomic, add the pattern as a suffix to the current expansion, and call
|
||||
expand_file_name/2 followed by member/2 on the result. This is originally a SICStus Prolog exception.
|
||||
|
||||
Both `glob` and `expand` rely on the same underlying
|
||||
mechanism. YAP gives preference to `glob`.
|
||||
|
||||
- verbose_file_search(`true`/`false`)
|
||||
|
||||
@ -320,7 +330,7 @@ absolute_file_name(File0,File) :-
|
||||
'$absolute_file_name'(File, _Opts, _TrueFileName, G) :- var(File), !,
|
||||
'$do_error'(instantiation_error, G).
|
||||
'$absolute_file_name'(File,LOpts,TrueFileName, G) :-
|
||||
current_prolog_flag(file_name_variables, OldF),
|
||||
current_prolog_flag(open_expands_filename, OldF),
|
||||
current_prolog_flag( fileerrors, PreviousFileErrors ),
|
||||
current_prolog_flag( verbose_file_search, PreviousVerbose ),
|
||||
abs_file_parameters(LOpts,Opts),
|
||||
@ -328,7 +338,7 @@ absolute_file_name(File0,File) :-
|
||||
get_abs_file_parameter( expand, Opts, Expand ),
|
||||
set_prolog_flag( verbose_file_search, Verbose ),
|
||||
get_abs_file_parameter( file_errors, Opts, FErrors ),
|
||||
( FErrors = fail ->
|
||||
( FErrors == fail ->
|
||||
set_prolog_flag( fileerrors, false )
|
||||
;
|
||||
set_prolog_flag( fileerrors, true )
|
||||
@ -342,7 +352,7 @@ absolute_file_name(File0,File) :-
|
||||
'$absf_trace'('found solution ~a', [TrueFileName] ),
|
||||
% stop_lowxb( _level_trace,
|
||||
set_prolog_flag( fileerrors, PreviousFileErrors ),
|
||||
set_prolog_flag( file_name_variables, OldF),
|
||||
set_prolog_flag( open_expands_filename, OldF),
|
||||
set_prolog_flag( verbose_file_search, PreviousVerbose ),
|
||||
'$absf_trace'('first solution only', [] ),
|
||||
!
|
||||
@ -408,44 +418,61 @@ absolute_file_name(File0,File) :-
|
||||
'$to_list_of_atoms'(As, L1, [A|L2]),
|
||||
'$to_list_of_atoms'(Bs, L2, LF).
|
||||
|
||||
'$get_abs_file'(File,Opts,AbsFile) :-
|
||||
get_abs_file_parameter( expand, Opts, Expand ),
|
||||
'$absf_trace'('variable expansion allowed? ~w', [Expand] ),
|
||||
absolute_file_name(File,ExpFile),
|
||||
'$absf_trace'(' variable expansion ~w', [ExpFile] ),
|
||||
'$get_abs_file'(File,Opts, ExpFile) :-
|
||||
'$control_for_expansion'(Opts, Expand),
|
||||
get_abs_file_parameter( relative_to, Opts, RelTo ),
|
||||
(
|
||||
RelTo \= '.'
|
||||
->
|
||||
( is_absolute_file_name(ExpFile) ->
|
||||
AbsFile = ExpFile
|
||||
;
|
||||
'$dir_separator'(D),
|
||||
atom_codes(DA,[D]),
|
||||
atom_concat([RelTo, DA, ExpFile], AbsFile),
|
||||
'$absf_trace'('add relative path ~a', [RelTo] )
|
||||
)
|
||||
;
|
||||
AbsFile = ExpFile
|
||||
),
|
||||
'$absf_trace'('after relative to absolute path, ~a ', [AbsFile] ).
|
||||
prolog_expanded_file_system_path( File, Expand, RelTo, ExpFile ),
|
||||
'$absf_trace'('Traditional expansion: ~w', [ExpFile] ).
|
||||
|
||||
|
||||
'$control_for_expansion'(Opts, true) :-
|
||||
get_abs_file_parameter( expand, Opts, true ),
|
||||
!.
|
||||
'$control_for_expansion'(_Opts, Flag) :-
|
||||
current_prolog_flag( open_expands_filename, Flag ).
|
||||
|
||||
|
||||
'$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 ),
|
||||
'$absf_trace'('check access permission ~a...', [Access] ),
|
||||
'$check_file'(F0,Type, Access, F).
|
||||
'$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 ),
|
||||
'$absf_trace'('check access permission ~w?', [Access] ),
|
||||
'$check_file'(F0, Type, Access, F).
|
||||
'$glob'( F0, Opts, FG),
|
||||
'$check_file'(FG, Type, Access, F),
|
||||
'$absf_trace'(' ~w ok!', [Access]).
|
||||
|
||||
'$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),
|
||||
lists:member(ExpFile, ExpFiles),
|
||||
\+ sub_atom( ExpFile, _, _, 1, '.'),
|
||||
\+ sub_atom( ExpFile, _, _, 2, '..')
|
||||
;
|
||||
Expand == true
|
||||
->
|
||||
expand_file_name(File1, ExpFiles),
|
||||
lists:member(ExpFile, ExpFiles),
|
||||
\+ sub_atom( ExpFile, _, _, 1, '.'),
|
||||
\+ sub_atom( ExpFile, _, _, 2, '..')
|
||||
;
|
||||
File1 = ExpFile
|
||||
),
|
||||
'$absf_trace'(' With globbing (glob=~q;expand=~a): ~w', [Glob,Expand,ExpFile] ).
|
||||
|
||||
% always verify if a directory
|
||||
'$check_file'(F, directory, _, F) :-
|
||||
@ -569,7 +596,7 @@ absolute_file_name(File0,File) :-
|
||||
print_message( informational, absolute_file_path( Msg, Args ) ).
|
||||
'$absf_trace'(_Msg, _Args ).
|
||||
|
||||
/** @pred prolog_file_name( +File, -PrologFileName)
|
||||
/** @pred prolog_file_name( +File, -PrologFileaNme)
|
||||
|
||||
Unify _PrologFileName_ with the Prolog file associated to _File_.
|
||||
|
||||
|
||||
@ -429,11 +429,11 @@ load_files(Files,Opts) :-
|
||||
b_setval('$source_file', user_input),
|
||||
'$do_lf'(Mod, user_input, user_input, user_input, TOpts).
|
||||
'$lf'(File, Mod, Call, TOpts) :-
|
||||
'$lf_opt'(stream, TOpts, Stream),
|
||||
'$lf_opt'(stream, TOpts, Stream),
|
||||
b_setval('$source_file', File),
|
||||
( var(Stream) ->
|
||||
/* need_to_open_file */
|
||||
( '$full_filename'(File, Y, Call) -> true ; '$do_error'(existence_error(source_sink,File),Call) ),
|
||||
( '$full_filename'(File, Y, Call) -> true ; '$do_error'(existence_error(source_sink,File),Call) ),
|
||||
( open(Y, read, Stream) -> true ; '$do_error'(permission_error(input,stream,Y),Call) )
|
||||
;
|
||||
stream_property(Stream, file_name(Y))
|
||||
@ -872,7 +872,7 @@ nb_setval('$if_le1vel',0).
|
||||
%
|
||||
'$do_startup_reconsult'(_X) :-
|
||||
'$init_win_graphics',
|
||||
fail.
|
||||
fail.
|
||||
'$do_startup_reconsult'(X) :-
|
||||
catch(load_files(user:X, [silent(true)]), Error, '$Error'(Error)),
|
||||
!,
|
||||
|
||||
@ -226,12 +226,15 @@ main_message(error(style_check(style_check(singleton(SVs),_Pos,_File,P)),_), _)
|
||||
{ svs(SVs,SVs,SVsL),
|
||||
( SVs = [_] -> NVs = 0 ; NVs = 1 )
|
||||
}.
|
||||
main_message(error(style_check(style_check(multiple(N,A,Mod,I0),File,_W,_P)),_),_) -->
|
||||
[ '~*|!!! ~a redefines ~q from ~a.' - [8,File, Mod:N/A, I0] ].
|
||||
main_message(error(style_check(style_check(discontiguous(N,A,Mod),_S,_W,_P)),_) ,_)-->
|
||||
[ '~*|!!! !!! discontiguous definition for ~p.' - [8,Mod:N/A] ].
|
||||
main_message(error(style_check(style_check(multiple(N,A,Mod,I0),_Pos,File,_P)),_),_) -->
|
||||
{ '$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,a_P)),_) ,_)-->
|
||||
{ '$show_consult_level'(LC) },
|
||||
[ '~*|!!! !!! discontiguous definition for ~p.' - [LC,Mod:N/A] ].
|
||||
main_message(error(consistency_error(Who)), _Source) -->
|
||||
[ '~*|!!! has argument ~a not consistent with type.'-[8,Who] ].
|
||||
{ '$show_consult_level'(LC) },
|
||||
[ '~*|!!! has argument ~a not consistent with type.'-[LC,Who] ].
|
||||
main_message(error(domain_error(Who , Type), _Where), _Source) -->
|
||||
[ '~*|!!! ~q does not belong to domain ~a,' - [8,Who,Type], nl ].
|
||||
main_message(error(evaluation_error(What, Who), _Where), _Source) -->
|
||||
|
||||
Reference in New Issue
Block a user