diff --git a/H/iatoms.h b/H/iatoms.h index 4d0bf0224..47a3b8bbd 100644 --- a/H/iatoms.h +++ b/H/iatoms.h @@ -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"); diff --git a/H/ratoms.h b/H/ratoms.h index cc3875fcd..866574440 100644 --- a/H/ratoms.h +++ b/H/ratoms.h @@ -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); diff --git a/H/tatoms.h b/H/tatoms.h index 3c27ade3f..56456e7ac 100644 --- a/H/tatoms.h +++ b/H/tatoms.h @@ -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_ ) diff --git a/os/iopreds.c b/os/iopreds.c index f902d56ea..e85066ed0 100644 --- a/os/iopreds.c +++ b/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; } diff --git a/pl/absf.yap b/pl/absf.yap index 644a6140a..99f1ba264 100755 --- a/pl/absf.yap +++ b/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_. diff --git a/pl/consult.yap b/pl/consult.yap index ac6c4d627..8900bda4c 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -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)), !, diff --git a/pl/messages.yap b/pl/messages.yap index f8de9c05e..15d92eaa9 100644 --- a/pl/messages.yap +++ b/pl/messages.yap @@ -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) -->