diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
afa085de28
yap-6.3/pl/absf.yap
Vítor Santos Costa 78327cf885 rewrite
2016-02-13 03:07:04 +00:00

731 lines
21 KiB
Prolog
Executable File
Raw Blame History

/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-2014 *
* *
*************************************************************************/
/**
@file absf.yap
@author L.Damas, V.S.Costa
*/
:- system_module( absf, [absolute_file_name/2,
absolute_file_name/3,
add_to_path/1,
add_to_path/2,
path/1,
remove_from_path/1], ['$full_filename'/3,
'$system_library_directories'/2]).
/**
@defgroup AbsoluteFileName File Name Resolution
@ingroup builtins
Support for file name resolution through absolute_file_name/3 and
friends. These utility built-ins describe a list of directories that
are used by load_files/2 to search. They include pre-compiled paths
plus user-defined directories, directories based on environment
variables and registry information to search for files.
@{
*/
:- use_system_module( '$_boot', ['$system_catch'/4]).
:- use_system_module( '$_errors', ['$do_error'/2]).
:- use_system_module( '$_lists', [member/2]).
/**
@pred absolute_file_name( -File:atom, +Path:atom, +Options:list) is nondet
_Options_ is a list of options to guide the conversion:
- extensions(+ _ListOfExtensions_)
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_ )
Resolve the path relative to the given directory or directory the
holding the given file. Without this option, paths are resolved
relative to the working directory (see working_directory/2) or,
if _Spec_ is atomic and absolute_file_name/3 is executed
in a directive, it uses the current source-file as reference.
- access(+ _Mode_ )
Imposes the condition access_file( _File_ , _Mode_ ). _Mode_ is one of `read`, `write`, `append`, `exist` or
`none` (default).
See also access_file/2.
- file_type(+ _Type_ )
Defines suffixes matching one of several pre-specified type of files. Default mapping is as follows:
1. `txt` implies `[ '' ]`,
2. `prolog` implies `['.yap', '.pl', '.prolog', '']`,
3. `executable` implies `['.so', ',dylib', '.dll']` depending on the Operating system,
4. `qly` implies `['.qly', '']`,
5. `directory` implies `['']`,
6. The file-type `source` is an alias for `prolog` designed to support compatibility with SICStus Prolog. See also prolog_file_type/2.
Notice that this predicate only
returns non-directories, unless the option `file_type(directory)` is
specified, or unless `access(none)`.
- file_errors(`fail`/`error`)
If `error` (default), throw `existence_error` exception
if the file cannot be found. If `fail`, stay silent.
- solutions(`first`/`all`)
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, but
whereas SWI-Prolog implements its own conventions, YAP uses the
shell's `glob` primitive.
Notice that in `glob` mode YAP will fail if it cannot find a matching file, as `glob`
implicitely tests for existence when checking for patterns.
- 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`)
If `true` (default is `false`) output messages during
search. This is often helpful when debugging. Corresponds to the
SWI-Prolog flag `verbose_file_search` (also available in YAP).
Compatibility considerations to common argument-order in ISO as well
as SICStus absolute_file_name/3 forced us to be flexible here.
If the last argument is a list and the second not, the arguments are
swapped, thus the call
~~~~~~~~~~~~
?- absolute_file_name( 'pl/absf.yap', [], Path)
~~~~~~~~~~~~
is valid as well.
*/
absolute_file_name(File,TrueFileName,Opts) :-
( var(TrueFileName) ->
true ;
atom(TrueFileName), TrueFileName \= []
), !,
absolute_file_name(File,Opts,TrueFileName).
absolute_file_name(File,Opts,TrueFileName) :-
'$absolute_file_name'(File,Opts,TrueFileName,absolute_file_name(File,Opts,TrueFileName)).
/**
@pred absolute_file_name(+Name:atom,+Path:atom) is nondet
Converts the given file specification into an absolute path, using default options. See absolute_file_name/3 for details on the options.
*/
absolute_file_name(V,Out) :- var(V), !, % absolute_file_name needs commenting.
'$do_error'(instantiation_error, absolute_file_name(V, Out)).
absolute_file_name(user,user) :- !.
absolute_file_name(File0,File) :-
'$absolute_file_name'(File0,[access(none),file_type(txt),file_errors(fail),solutions(first)],File,absolute_file_name(File0,File)).
'$full_filename'(F0, F, G) :-
'$absolute_file_name'(F0,[access(read),
file_type(prolog),
file_errors(fail),
solutions(first),
expand(true)],F,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 ),
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'(File),
'$absf_trace_options'(LOpts),
'$find_in_path'(File, Opts,TrueFileName),
(
First == first
->
'$absf_trace'(' |------- got first ~a', [TrueFileName]),
set_prolog_flag( fileerrors, PreviousFileErrors ),
set_prolog_flag( open_expands_filename, 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,
'$absf_trace'(' !------- failed.', []),
set_prolog_flag( fileerrors, PreviousFileErrors ),
set_prolog_flag( verbose_file_search, PreviousVerbose ),
set_prolog_flag(file_name_variables, OldF),
get_abs_file_parameter( file_errors, Opts, error ),
'$do_error'(existence_error(file,File),G)
).
% This sequence must be followed:
% user and user_input are special;
% 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'(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]),
'$variable_expansion'(CorePath, Opts,ExpandedPath),
'$absf_trace'(' after environment variable expansion: ~s', [ExpandedPath]),
'$prefix'(ExpandedPath, Opts, Path , []),
'$absf_trace'(' after prefix expansion: ~s', [Path]),
atom_codes( APath, Path ),
(
Expand = true
->
expand_file_name( APath, EPaths),
'$absf_trace'(' after shell 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
'$core_file_name'(Name, Opts) -->
'$file_name'(Name, Opts, E),
'$suffix'(E, Opts),
'$glob'(Opts).
%
% 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).
'$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.
'$variable_expansion'( Path, Opts, APath ) :-
get_abs_file_parameter( expand, Opts, true ),
!,
'$expand_file_name'( Path, APath ).
'$variable_expansion'( Path, _, Path ).
'$var'(S) -->
"{", !, '$id'(S), "}".
'$var'(S) -->
'$id'(S).
'$drive' -->
'$id'(_),
":\\\\".
'$id'([C|S]) --> [C],
{ C >= "a", C =< "z" ; C >= "A", C =< "Z" ;
C >= "0", C =< "9" ; C =:= "_" },
!,
'$id'(S).
'$id'([]) --> [].
% always verify if a directory
'$check_file'(F, directory, _) :-
!,
exists_directory(F).
'$check_file'(_F, _Type, none) :- !.
'$check_file'(F, _Type, exist) :-
'$access_file'(F, exist). % if it has a type cannot be a directory..
'$check_file'(F, _Type, Access) :-
'$access_file'(F, Access),
\+ exists_directory(F). % if it has a type cannot be a directory..
'$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])
;
get_abs_file_parameter( file_type, Opts, Type ),
( Type == source -> NType = prolog ; NType = Type ),
user:prolog_file_type(Ext, NType)
),
'$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, ExpFiles, ExpFile) :-
lists:member(ExpFile, ExpFiles),
file_base_name( ExpFile, Base ),
Base \= '.',
Base \='..'.
'$prefix'( CorePath, _Opts) -->
{ is_absolute_file_name( CorePath ) },
!,
CorePath.
'$prefix'( CorePath, 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),
CorePath.
'$prefix'( CorePath, _) -->
{
recorded('$path',Prefix,_),
'$absf_trace'(' try YAP path database ~a', [Prefix]),
sub_atom(Prefix, _, _, 1, Last),
atom_codes(Prefix, S) },
S,
'$dir'(Last),
CorePath.
'$prefix'(CorePath, _ ) -->
'$absf_trace'(' empty prefix', []),
CorePath.
'$dir' --> { current_prolog_flag(windows, true) },
!,
"\\".
'$dir' --> "/".
'$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).
'$system_library_directories'(foreign, Dir) :-
foreign_directory( Dir ).
% compatibility with old versions
% search the current directory first.
'$system_library_directories'(commons, Dir) :-
commons_directory( Dir ).
% 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( File ) ).
'$absf_trace'( _File ).
'$absf_trace_options'(Args ) :-
current_prolog_flag( verbose_file_search, true ),
!,
print_message( informational, arguments( Args ) ).
'$absf_trace_options'( _Args ).
/** @pred prolog_file_name( +File, -PrologFileaNme)
Unify _PrologFileName_ with the Prolog file associated to _File_.
*/
prolog_file_name(File, PrologFileName) :-
var(File), !,
'$do_error'(instantiation_error, prolog_file_name(File, PrologFileName)).
prolog_file_name(user, Out) :- !, Out = user.
prolog_file_name(File, PrologFileName) :-
atom(File), !,
system:true_file_name(File, PrologFileName).
prolog_file_name(File, PrologFileName) :-
'$do_error'(type_error(atom,File), prolog_file_name(File, PrologFileName)).
/**
@pred path(-Directories:list) is det,deprecated
YAP specific procedure that returns a list of user-defined directories
in the library search-path.We suggest using user:file_search_path/2 for
compatibility with other Prologs.
*/
path(Path) :-
findall(X,'$in_path'(X),Path).
'$in_path'(X) :-
recorded('$path',Path,_),
atom_codes(Path,S),
( S = "" -> X = '.' ;
atom_codes(X,S) ).
/**
@pred add_to_path(+Directory:atom) is det,deprecated
YAP-specific predicate to include directory in library search path.
We suggest using user:file_search_path/2 for
compatibility with other Prologs.
*/
add_to_path(New) :-
add_to_path(New,last).
/**
@pred add_to_path(+Directory:atom, +Position:atom) is det,deprecated
YAP-specific predicate to include directory in front or back of
library search path. We suggest using user:file_search_path/2 for
compatibility with other Prologs and more extensive functionality.
*/
add_to_path(New,Pos) :-
atom(New), !,
'$check_path'(New,Str),
atom_codes(Path,Str),
'$add_to_path'(Path,Pos).
'$add_to_path'(New,_) :-
recorded('$path',New,R),
erase(R),
fail.
'$add_to_path'(New,last) :-
!,
recordz('$path',New,_).
'$add_to_path'(New,first) :-
recorda('$path',New,_).
/** @pred remove_from_path(+Directory:atom) is det,deprecated
@}
*/
remove_from_path(New) :- '$check_path'(New,Path),
recorded('$path',Path,R), erase(R).
'$check_path'(At,SAt) :- atom(At), !, atom_codes(At,S), '$check_path'(S,SAt).
'$check_path'([],[]).
'$check_path'([Ch],[Ch]) :- '$dir_separator'(Ch), !.
'$check_path'([Ch],[Ch,A]) :- !, integer(Ch), '$dir_separator'(A).
'$check_path'([N|S],[N|SN]) :- integer(N), '$check_path'(S,SN).
/**
@defgroup pathconf Configuration of the Prolog file search path
@ingroup AbsoluteFileName
Prolog systems search follow a complex search on order to track down files.
@{
**/
/**
@pred user:library_directory(?Directory:atom) is nondet, dynamic
Dynamic, multi-file predicate that succeeds when _Directory_ is a
current library directory name. Asserted in the user module.
Library directories are the places where files specified in the form
`library( _File_ )` are searched by the predicates consult/1,
reconsult/1, use_module/1, ensure_loaded/1, and load_files/2.
This directory is initialized by a rule that calls the system predicate
system_library/1.
*/
:- multifile user:library_directory/1.
:- dynamic user:library_directory/1.
%% Specifies the set of directories where
% one can find Prolog libraries.
%
% 1. honor YAPSHAREDIR
user:library_directory( Dir ) :-
getenv( 'YAPSHAREDIR', Dir).
%% 2. honor user-library
user:library_directory( '~/share/Yap' ).
%% 3. honor current directory
user:library_directory( '.' ).
%% 4. honor default location.
user:library_directory( Dir ) :-
system_library( Dir ).
/**
@pred user:commons_directory(? _Directory_:atom) is nondet, dynamic
State the location of the Commons Prolog Initiative.
This directory is initialized as a rule that calls the system predicate
library_directories/2.
*/
:- multifile user:commons_directory/1.
:- dynamic user:commons_directory/1.
user:commons_directory( Path ):-
system_commons( Path ).
/**
@pred user:foreign_directory(? _Directory_:atom) is nondet, dynamic
State the location of the Foreign Prolog Initiative.
This directory is initialized as a rule that calls the system predicate
library_directories/2.
*/
:- multifile user:foreign_directory/1.
:- dynamic user:foreign_directory/1.
user:foreign_directory( Path ):-
system_foreign( Path ).
/**
@pred user:prolog_file_type(?Suffix:atom, ?Handler:atom) is nondet, dynamic
This multifile/dynamic predicate relates a file extension _Suffix_
to a language or file type _Handler_. By
default, it supports the extensions yap, pl, and prolog for prolog files and
uses one of dll, so, or dylib for shared objects. Initial definition is:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~prolog
prolog_file_type(yap, prolog).
prolog_file_type(pl, prolog).
prolog_file_type(prolog, prolog).
prolog_file_type(qly, prolog).
prolog_file_type(qly, qly).
prolog_file_type(A, prolog) :-
current_prolog_flag(associate, A),
A \== prolog,
A \==pl,
A \== yap.
prolog_file_type(A, executable) :-
current_prolog_flag(shared_object_extension, A).
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
*/
:- multifile user:prolog_file_type/2.
:- dynamic user:prolog_file_type/2.
user:prolog_file_type(yap, prolog).
user:prolog_file_type(pl, prolog).
user:prolog_file_type(prolog, prolog).
user:prolog_file_type(A, prolog) :-
current_prolog_flag(associate, A),
A \== prolog,
A \== pl,
A \== yap.
user:prolog_file_type(qly, qly).
user:prolog_file_type(A, executable) :-
current_prolog_flag(shared_object_extension, A).
/**
@pred user:file_search_path(+Name:atom, -Directory:atom) is nondet
Allows writing file names as compound terms. The _Name_ and
_DIRECTORY_ must be atoms. The predicate may generate multiple
solutions. The predicate is originally defined as follows:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~prolog
file_search_path(library, Dir) :-
library_directory(Dir).
file_search_path(commons, Dir) :-
commons_directory(Dir).
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) :-
prolog_flag(host_type, Dir).
file_search_path(foreign, Dir) :-
foreign_directory(Dir).
file_search_path(path, C) :-
( getenv('PATH', A),
( current_prolog_flag(windows, true)
-> atomic_list_concat(B, ;, A)
; atomic_list_concat(B, :, A)
),
lists:member(C, B)
).
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Thus, `compile(library(A))` will search for a file using
library_directory/1 to obtain the prefix,
whereas 'compile(system(A))` would look at the `host_type` flag.
*/
:- multifile user:file_search_path/2.
:- dynamic user:file_search_path/2.
user:file_search_path(library, Dir) :-
user:library_directory(Dir).
user:file_search_path(commons, Dir) :-
user:commons_directory(Dir).
user:file_search_path(swi, Home) :-
current_prolog_flag(home, Home).
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, '.').
user:file_search_path(foreign, yap('lib/Yap')).
user:file_search_path(path, C) :-
( getenv('PATH', A),
( current_prolog_flag(windows, true)
-> atomic_list_concat(B, ;, A)
; atomic_list_concat(B, :, A)
),
lists:member(C, B)
).
%% @}
Reference in New Issue View Git Blame Copy Permalink