mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-15 17:33:38 +00:00
Code Issues Projects Releases Wiki Activity
Files
52317df5bb73d43fbcb2df199767cbeea24535aa
mercury/library/dir.m
Julien Fischer f65cf12e94 Add some missing semicolons. 
library/dir.m:
    Add some missing semicolons to some statements in foreign_proc body.
    (The code in question compiled because we wrap foreign proc bodies
    int { ;}.)
2026-03-14 01:59:56 +11:00

2198 lines
74 KiB
Mathematica
Raw Blame History

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 1994-1995,1997,1999-2000,2002-2012 The University of Melbourne.
% Copyright (C) 2016-2026 The Mercury team.
% This file is distributed under the terms specified in COPYING.LIB.
%---------------------------------------------------------------------------%
%
% File: dir.m.
% Main authors: fjh, stayl.
% Stability: high.
%
% Filename and directory handling.
%
% Note that the predicates and functions in this module change directory
% separators in paths passed to them to the normal separator for the platform,
% if that does not change the meaning of the path name.
%
% Duplicate directory separators and trailing separators are also removed
% where that does not change the meaning of the path name.
%
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- module dir.
:- interface.
:- import_module bool.
:- import_module io.
:- import_module list.
%---------------------------------------------------------------------------%
%
% Predicates to isolate system dependencies.
%
% Return the default separator between components of a pathname,
% which is '/' on Unix systems and '\\' on Microsoft Windows systems.
%
:- func directory_separator = character.
:- pred directory_separator(character::out) is det.
% Is the character a directory separator?
% On Microsoft Windows systems, this will succeed for both '/' and '\\'.
%
:- pred is_directory_separator(character).
:- mode is_directory_separator(in) is semidet.
:- mode is_directory_separator(out) is multi.
% Returns ".".
%
:- func this_directory = string.
:- pred this_directory(string::out) is det.
% Returns "..".
%
:- func parent_directory = string.
:- pred parent_directory(string::out) is det.
% split_name(PathName, DirName, BaseName).
%
% Split a filename into a directory part and a filename part.
%
% Fails for root directories or relative filenames not containing
% directory information.
%
% Trailing slashes are removed from PathName before splitting,
% if that does not change the meaning of PathName.
%
% Trailing slashes are removed from DirName after splitting,
% if that does not change the meaning of DirName.
%
% On Windows, drive current directories are handled correctly,
% for example `split_name("C:foo", "C:", "foo")'.
% (`X:' is the current directory on drive `X').
% Note that Cygwin does not support drive current directories,
% so `split_name("C:foo", _, _)' will fail when running under Cygwin.
%
:- pred split_name(string::in, string::out, string::out) is semidet.
% basename(PathName) = BaseName.
%
% Returns the non-directory part of a filename.
%
% Fails when given a root directory, ".", ".." or a Windows path
% such as "X:".
%
% Trailing slashes are removed from PathName before splitting,
% if that does not change the meaning of PathName.
%
:- func basename(string) = string is semidet.
% NOTE_TO_IMPLEMENTORS CFF :- pragma obsolete(func(basename/1), [basename/2]).
:- pred basename(string::in, string::out) is semidet.
% As above, but throws an exception instead of failing.
%
:- func det_basename(string) = string.
% dirname(PathName) = DirName.
%
% Returns the directory part of a filename.
%
% Returns PathName if it specifies a root directory.
%
% Returns PathName for Windows paths such as "X:".
%
% Returns `this_directory' when given a filename
% without any directory information (e.g. "foo").
%
% Trailing slashes in PathName are removed first, if that does not change
% the meaning of PathName.
%
% Trailing slashes are removed from DirName after splitting,
% if that does not change the meaning of DirName.
%
:- func dirname(string) = string.
:- pred dirname(string::in, string::out) is det.
% path_name_is_root_directory(PathName)
%
% On Unix, '/' is the only root directory.
% On Windows, a root directory is one of the following:
% 'X:\', which specifies the root directory of drive X,
% where X is any letter.
% '\', which specifies the root directory of the current drive.
% '\\server\share\', which specifies a UNC (Universal Naming Convention)
% root directory for a network drive.
%
% Note that 'X:' is not a Windows root directory -- it specifies the
% current directory on drive X, where X is any letter.
%
:- pred path_name_is_root_directory(string::in) is semidet.
% path_name_is_absolute(PathName)
%
% Is the path name syntactically an absolute path
% (this does not check whether the path exists)?
%
% A path is absolute if-and-only-if it begins with a root directory
% (see path_name_is_root_directory).
%
:- pred path_name_is_absolute(string::in) is semidet.
% PathName = DirName / FileName
%
% Given a directory name and a filename, return the pathname of
% that file in that directory.
%
% If DirName ends with a directory separator, this function
% will not add a second one.
%
% On Windows, a call such as `"C:" / "foo"' will return "C:foo".
%
% Throws an exception if FileName is an absolute path name.
% Throws an exception on Windows if FileName is a drive relative path
% such as "C:".
%
:- func string / string = string.
:- func make_path_name(string, string) = string.
% relative_path_name_from_components(List) = PathName.
%
% Return the relative pathname from the components in the list.
% The components of the list must not contain directory separators.
%
:- func relative_path_name_from_components(list(string)) = string.
%---------------------------------------------------------------------------%
% current_directory(Result)
% Return the current working directory.
%
:- pred current_directory(io.res(string)::out, io::di, io::uo) is det.
%---------------------------------------------------------------------------%
% Make the given directory, and all parent directories.
% This will also succeed if the directory already exists
% and is readable and writable by the current user.
%
:- pred make_directory(string::in, io.res::out, io::di, io::uo) is det.
% Make only the given directory.
% Returns an error if the directory already exists, or the parent directory
% does not exist.
%
:- pred make_single_directory(string::in, io.res::out, io::di, io::uo)
is det.
%---------------------------------------------------------------------------%
% FoldlPred(DirName, BaseName, FileType, Continue, !Data, !IO).
%
% A predicate passed to foldl2 to process each entry in a directory.
% Processing will stop if Continue is bound to `no'.
%
:- type foldl_pred(T) ==
pred(string, string, io.file_type, bool, T, T, io, io).
:- inst foldl_pred == (pred(in, in, in, out, in, out, di, uo) is det).
% foldl2(Pred, DirName, InitialData, Result, !IO):
%
% Apply Pred to all files and directories in the given directory.
% Directories are not processed recursively.
% Processing will stop if the boolean (Continue) output of Pred is bound
% to `no'.
% The order in which the entries are processed is unspecified.
%
:- pred foldl2(foldl_pred(T)::in(foldl_pred), string::in,
T::in, io.maybe_partial_res(T)::out, io::di, io::uo) is det.
% recursive_foldl2(Pred, DirName, FollowSymLinks, InitialData, Result,
% !IO):
%
% As above, but recursively process subdirectories.
% Subdirectories are processed depth-first, processing the directory itself
% before its contents. If FollowSymLinks is `yes', recursively process
% the directories referenced by symbolic links.
%
:- pred recursive_foldl2(foldl_pred(T)::in(foldl_pred),
string::in, bool::in, T::in, io.maybe_partial_res(T)::out,
io::di, io::uo) is det.
:- type fold_params
---> fold_params(
fp_subdirs :: maybe_subdirs,
fp_on_error :: on_error
).
:- type maybe_subdirs
---> do_not_enter_subdirs
; enter_subdirs(maybe_follow_symlinks).
:- type maybe_follow_symlinks
---> do_not_follow_symlinks
; follow_symlinks.
:- type on_error
---> on_error_stop
; on_error_keep_going.
:- type file_error
---> file_error(string, file_operation, io.error).
% file_error(PathName, Operation, Error) means that
% when we tried to perform Operation on PathName, the result
% was Error. PathName specifies the file name relative to
% the directory name given to general_foldl2.
:- type file_operation
---> file_open
; file_close
; file_get_id
; file_get_type
; file_check_accessibility
; file_read_dir_entry.
% general_foldl2(Params, Pred, DirName, Data0, Data, Errors, !IO).
%
% A generalised version of the above, whose behavior is controlled
% by setting up Params.
%
% Whether we recursively process subdirectories depends on whether
% the fp_subdirs field of Params is do_not_enter_subdirs or enter_subdirs.
% If it is do_not_enter_subdirs, then we do not process subdirectories
% at all. If it is enter_subdirs, then we process subdirectories depth
% first. The traversal is preorder, meaning that we call Pred on the
% pathname of a subdirectory *before* we process the contents of that
% subdirectory.
%
% Whether we recursively process subdirectories referenced by symlinks
% depends on the first argument of enter_subdirs.
%
% When we encounter an error, such as a failure to open a directory
% for reading, we record that error, but what happens after that
% depends on the fp_on_error field of Params. If this field is
% on_error_stop, then we stop the traversal, which means that
% with on_error_stop, we will return at most one error.
% If it is on_error_keep_going, we continue with the traversal after
% errors, which means that with on_error_keep_going, we can return
% more than one error.
%
% Regardless of the setting of fp_on_error, we stop the traversal
% if Pred returns Continue = `no'.
%
% In all cases, the value of Data will reflect the results of all
% the invocations of Pred during the traversal up to the time
% the traversal was stopped either by an error, by Continue = `no',
% or by running out of files to traverse.
%
:- pred general_foldl2(fold_params::in, foldl_pred(T)::in(foldl_pred),
string::in, T::in, T::out, list(file_error)::out,
io::di, io::uo) is det.
%---------------------------------------------------------------------------%
% Implement brace expansion, as in sh: return the sequence of strings
% generated from the given input string. Throw an exception if the
% input string contains mismatched braces.
%
% The following is the documentation of brace expansion from the sh manual:
%
% Brace expansion is a mechanism by which arbitrary strings may be
% generated. This mechanism is similar to pathname expansion, but the
% filenames generated need not exist. Patterns to be brace expanded
% take the form of an optional preamble, followed by a series of
% comma-separated strings between a pair of braces, followed by an
% optional postscript. The preamble is prefixed to each string contained
% within the braces, and the postscript is then appended to each
% resulting string, expanding left to right.
%
% Brace expansions may be nested. The results of each expanded string
% are not sorted; left to right order is preserved. For example,
% a{d,c,b}e expands into `ade ace abe'.
%
:- func expand_braces(string) = list(string).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
% Anything below here will not appear in the Mercury Library Reference Manual.
:- interface.
% For use by io.m.
%
:- pred use_windows_paths is semidet.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module char.
:- import_module exception.
:- import_module int.
:- import_module io.error_util.
:- import_module io.file.
:- import_module maybe.
:- import_module require.
:- import_module string.
:- import_module unit.
%---------------------------------------------------------------------------%
directory_separator = (if have_win32 then ('\\') else ('/')).
:- pragma foreign_proc("C#",
directory_separator = (Sep::out),
[promise_pure, will_not_call_mercury, thread_safe],
"
Sep = System.IO.Path.DirectorySeparatorChar;
").
:- pragma foreign_proc("Java",
directory_separator = (Sep::out),
[promise_pure, will_not_call_mercury, thread_safe],
"
Sep = java.io.File.separatorChar;
").
directory_separator(dir.directory_separator).
:- func alt_directory_separator = char.
alt_directory_separator = (if io.have_cygwin then ('\\') else ('/')).
:- pragma foreign_proc("C#",
alt_directory_separator = (Sep::out),
[promise_pure, will_not_call_mercury, thread_safe],
"
Sep = System.IO.Path.AltDirectorySeparatorChar;
").
is_directory_separator(Char) :-
(
Char = dir.directory_separator,
Char \= dir.alt_directory_separator
;
Char = dir.alt_directory_separator
).
% Single-moded version of is_directory_separator
% for passing as a closure.
%
:- pred is_directory_separator_semidet(char::in) is semidet.
is_directory_separator_semidet(Char) :-
dir.is_directory_separator(Char).
% Is the input character either the standard or alternate directory
% separator for the current platform? If yes, then
% - on non-cygwin systems, it will return the standard separator;
% - on cygwin systems, where in some circumstances such replacements
% would change the meaning of a pathname, it will return
% the input character.
% If the input character is not a directory separator, then fail.
%
:- pred is_directory_separator_return_canon(character::in, character::out)
is semidet.
is_directory_separator_return_canon(Char, StdChar) :-
( if Char = dir.directory_separator then
StdChar = Char
else if Char = dir.alt_directory_separator then
% On Cygwin, "//" is different to "\\" in that
%
% - "//" is the Cygwin root directory, while
% - "\\" is the root directory of the current drive.
%
% On Cygwin, "\foo\bar" (relative to root of current drive)
% is different to "/foo/bar" (relative to Cygwin root directory),
% so we cannot convert separators.
( if io.have_cygwin then
StdChar = Char
else
StdChar = dir.directory_separator
)
else
fail
).
:- pred ends_with_directory_separator(string::in, int::in, int::out)
is semidet.
ends_with_directory_separator(String, End, PrevIndex) :-
string.unsafe_prev_index(String, End, PrevIndex, Char),
dir.is_directory_separator(Char).
this_directory = ".".
this_directory(dir.this_directory).
parent_directory = "..".
parent_directory(dir.parent_directory).
%---------------------------------------------------------------------------%
split_name(FileName, DirName, BaseName) :-
FileNameChars = canonicalize_path_chars(string.to_char_list(FileName)),
not is_root_directory(FileNameChars),
dir.split_name_2(FileNameChars, DirName, BaseName).
% Check that the filename is not empty or dir.this_directory,
% pass the directory off to any backend-specific implementations,
% or if none exist, invoke split_name_3 to split the filename using
% Mercury code.
% This assumes that the caller has already checked whether the
% directory is a root directory.
%
:- pred split_name_2(list(char)::in, string::out, string::out) is semidet.
split_name_2(FileNameChars0, DirName, BaseName) :-
FileNameChars0 = [_ | _],
FileNameWithoutSlash = remove_trailing_dir_separator(FileNameChars0),
FileNameWithoutSlash \= string.to_char_list(dir.this_directory),
FileNameWithoutSlash \= string.to_char_list(dir.parent_directory),
( if io.have_dotnet then
% System.IO.Path.GetFileName() returns the empty string
% if the path ends in a separator.
dir.split_name_dotnet(string.from_char_list(FileNameWithoutSlash),
DirName, BaseName)
else
dir.split_name_3(FileNameChars0, DirName, BaseName)
).
:- pred split_name_3(list(char)::in, string::out, string::out) is semidet.
split_name_3(FileNameChars, DirName, BaseName) :-
% Remove any trailing separator.
RevFileNameChars0 = reverse(FileNameChars),
( if
RevFileNameChars0 = [LastChar | RevFileNameChars1],
dir.is_directory_separator(LastChar)
then
RevFileNameChars = RevFileNameChars1
else
RevFileNameChars = RevFileNameChars0
),
( if
list.take_while_not(dir.is_directory_separator_semidet,
RevFileNameChars, RevBaseName, RevDirName0),
RevBaseName = [_ | _],
RevDirName0 = [_ | _]
then
% Strip the trailing separator off the directory name
% if doing so does not change the meaning.
( if
RevDirName0 = [Sep | RevDirName1],
not (
dir.is_directory_separator(Sep),
(
( use_windows_paths
; io.have_cygwin
),
RevDirName1 = [(':'), Drive],
char.is_alpha(Drive)
;
RevDirName1 = []
)
)
then
RevDirName = RevDirName1
else
RevDirName = RevDirName0
),
BaseName = string.from_rev_char_list(RevBaseName),
DirName = string.from_rev_char_list(RevDirName)
else if
% Check for relative paths of the form `C:foo'.
use_windows_paths,
FileNameChars = [Drive, (':') | BaseNameChars],
char.is_alpha(Drive),
BaseNameChars = [BaseNameFirst | _],
not dir.is_directory_separator(BaseNameFirst)
then
BaseName = string.from_char_list(BaseNameChars),
DirName = string.from_char_list([Drive, (':')])
else
fail
).
:- pred split_name_dotnet(string::in, string::out, string::out) is semidet.
split_name_dotnet(_, "", "") :-
semidet_fail.
% The .NET CLI provides functions to split directory names in a
% system-dependent manner.
:- pragma foreign_proc("C#",
split_name_dotnet(FileName::in, DirName::out, BaseName::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
try {
DirName = System.IO.Path.GetDirectoryName(FileName);
if (DirName == null || DirName == System.String.Empty) {
BaseName = null;
SUCCESS_INDICATOR = false;
} else {
BaseName = System.IO.Path.GetFileName(FileName);
SUCCESS_INDICATOR = (BaseName != null);
}
} catch (System.Exception) {
BaseName = null;
DirName = null;
SUCCESS_INDICATOR = false;
}
").
%---------------------------------------------------------------------------%
basename(FileName) = BaseName :-
basename(FileName, BaseName).
basename(FileName, BaseName) :-
FileNameChars = canonicalize_path_chars(string.to_char_list(FileName)),
not dir.is_root_directory(FileNameChars),
not (
% Current directory on the given drive.
use_windows_paths,
FileNameChars = [Drive, (':')],
char.is_alpha(Drive)
),
FileNameWithoutSlash = remove_trailing_dir_separator(FileNameChars),
FileNameWithoutSlash \= string.to_char_list(dir.this_directory),
FileNameWithoutSlash \= string.to_char_list(dir.parent_directory),
( if dir.split_name_2(FileNameChars, _, BaseName0) then
BaseName = BaseName0
else
BaseName = FileName
).
det_basename(FileName) =
( if dir.basename(FileName, BaseName) then
BaseName
else
unexpected($pred, "given directory is root directory")
).
%---------------------------------------------------------------------------%
dirname(FileName) = DirName :-
FileNameChars = canonicalize_path_chars(string.to_char_list(FileName)),
( if
dir.is_root_directory(FileNameChars)
then
DirName = string.from_char_list(FileNameChars)
else if
% Current directory on the given drive.
use_windows_paths,
FileNameChars = [Drive, (':')],
char.is_alpha(Drive)
then
DirName = string.from_char_list(FileNameChars)
else if
dir.split_name_2(FileNameChars, DirName0, _)
then
DirName = DirName0
else if
remove_trailing_dir_separator(FileNameChars) =
string.to_char_list(dir.parent_directory)
then
DirName = dir.parent_directory
else
DirName = dir.this_directory
).
dirname(S, dir.dirname(S)).
%---------------------------------------------------------------------------%
% Remove repeated path separators.
% XXX That is not ALL that this function does.
%
:- func canonicalize_path_chars(list(char)) = list(char).
canonicalize_path_chars(FileNameChars0) = FileNameChars :-
( if
% Windows allows path names of the form "\\server\share".
% These path names are referred to as UNC path names.
( use_windows_paths ; io.have_cygwin ),
FileNameChars0 = [HeadChar | TailChars],
is_directory_separator_return_canon(HeadChar, CanonHeadChar)
then
canonicalize_later_path_chars(TailChars, CanonTailChars),
% "\\" is not a UNC path name, so it is equivalent to "\".
( if
CanonTailChars = [OnlyCanonTailChar],
is_directory_separator(OnlyCanonTailChar)
then
FileNameChars = [CanonHeadChar]
else
FileNameChars = [CanonHeadChar | CanonTailChars]
)
else
canonicalize_later_path_chars(FileNameChars0, FileNameChars)
).
:- pred canonicalize_later_path_chars(list(char)::in, list(char)::out) is det.
canonicalize_later_path_chars(FileNameChars0, FileNameChars) :-
RevFileNameChars0 = [],
canonicalize_later_path_chars_acc(FileNameChars0,
RevFileNameChars0, RevFileNameChars),
list.reverse(RevFileNameChars, FileNameChars).
:- pred canonicalize_later_path_chars_acc(list(char)::in,
list(char)::in, list(char)::out) is det.
canonicalize_later_path_chars_acc([], !RevFileNameChars).
canonicalize_later_path_chars_acc([HeadChar | TailChars], !RevFileNameChars) :-
% Convert all directory separators to the standard separator
% for the platform, if that does not change the meaning.
( if is_directory_separator_return_canon(HeadChar, CanonHeadChar) then
% Remove repeated directory separators.
% (Actually, we delete the first separator, and keep the second
% separator, at least for now, since the next iteration may remove
% that as well, if the input contains three or more in a row.)
( if
TailChars = [FirstTailChar | _],
dir.is_directory_separator(FirstTailChar)
then
% Repeated separators; don't add CanonHeadChar
% to !RevFileNameChars.
true
else
% HeadChar is not followed by a duplicated separator.
!:RevFileNameChars = [CanonHeadChar | !.RevFileNameChars]
)
else
!:RevFileNameChars = [HeadChar | !.RevFileNameChars]
),
canonicalize_later_path_chars_acc(TailChars, !RevFileNameChars).
:- pred is_path_string_canonical(string::in) is semidet.
is_path_string_canonical(Path) :-
is_path_string_canonical_loop(Path, 0, prev_char_is_not_separator).
:- type canon_prev_char
---> prev_char_is_not_separator
; prev_char_is_separator.
:- pred is_path_string_canonical_loop(string::in, int::in, canon_prev_char::in)
is semidet.
is_path_string_canonical_loop(Path, CurIndex, PrevChar) :-
( if string.unsafe_index_next(Path, CurIndex, NextIndex, Char) then
( if dir.is_directory_separator_return_canon(Char, CanonChar) then
% Two consecutive directory separators may not occur
% in a canonical path.
PrevChar = prev_char_is_not_separator,
% A directory separator may not occur in a canonical path
% without itself being a canonical separator.
Char = CanonChar,
is_path_string_canonical_loop(Path, NextIndex,
prev_char_is_separator)
else
is_path_string_canonical_loop(Path, NextIndex,
prev_char_is_not_separator)
)
else
% We have come to the end of Path.
true
).
:- func remove_trailing_dir_separator(list(char)) = list(char).
remove_trailing_dir_separator(Chars) =
( if
list.split_last(Chars, Chars1, Sep),
dir.is_directory_separator(Sep)
then
Chars1
else
Chars
).
%---------------------------------------------------------------------------%
path_name_is_root_directory(PathName) :-
is_root_directory(canonicalize_path_chars(string.to_char_list(PathName))).
% Assumes repeated directory separators have been removed.
%
:- pred is_root_directory(list(char)::in) is semidet.
is_root_directory(FileName) :-
( if
have_dotnet
then
is_dotnet_root_directory(string.from_char_list(FileName))
else if
( use_windows_paths
; io.have_cygwin
)
then
strip_leading_win32_root_directory(FileName, [])
else
FileName = [Char],
dir.is_directory_separator(Char)
).
% strip_leading_win32_root_directory(FileName, FileNameMinusRoot)
%
% XXX Handle Unicode file names.
%
:- pred strip_leading_win32_root_directory(list(char)::in,
list(char)::out) is semidet.
strip_leading_win32_root_directory(!FileName) :-
( if strip_leading_win32_drive_root_directory(!FileName) then
true
else if strip_leading_win32_unc_root_directory(!FileName) then
true
else
strip_leading_win32_current_drive_root_directory(!FileName)
).
% Check for `X:\'.
% XXX On Cygwin `C:' is treated as being identical to `C:\'.
% The comments in the Cygwin source imply that this behaviour may change,
% and it is pretty awful anyway (`C:foo' is not the same as `C:\foo'),
% so we don't support it here.
%
:- pred strip_leading_win32_drive_root_directory(list(char)::in,
list(char)::out) is semidet.
strip_leading_win32_drive_root_directory([Letter, ':', Sep | !.FileName],
!:FileName) :-
char.is_alpha(Letter),
dir.is_directory_separator(Sep).
% Check for `\foo...'.
%
:- pred strip_leading_win32_current_drive_root_directory(list(char)::in,
list(char)::out) is semidet.
strip_leading_win32_current_drive_root_directory([Char1 | !.FileName],
!:FileName) :-
dir.is_directory_separator(Char1),
(
!.FileName = []
;
!.FileName = [Char2 | !:FileName],
not dir.is_directory_separator(Char2)
).
% Check for `\\server\' or `\\server\share\'.
%
:- pred strip_leading_win32_unc_root_directory(list(char)::in, list(char)::out)
is semidet.
strip_leading_win32_unc_root_directory([Sep, Sep | !.FileName], !:FileName) :-
dir.is_directory_separator(Sep),
list.take_while_not(dir.is_directory_separator_semidet, !.FileName,
Server, !:FileName),
Server = [_ | _],
(
!.FileName = []
;
!.FileName = [Sep | !:FileName],
(
!.FileName = []
;
!.FileName = [_ | _],
list.take_while_not(dir.is_directory_separator_semidet,
!.FileName, Share, !:FileName),
Share = [_ | _],
( !.FileName = [Sep | !:FileName]
; !.FileName = []
)
)
).
:- pred is_dotnet_root_directory(string::in) is semidet.
is_dotnet_root_directory(FileName) :-
dir.path_name_is_absolute(FileName),
(
is_dotnet_root_directory_2(FileName)
;
% For reasons known only to Microsoft,
% trailing slashes are significant.
FileNameLen = length(FileName),
( if FileNameLen > 0 then
ends_with_directory_separator(FileName, FileNameLen, PrevIndex),
string.unsafe_between(FileName, 0, PrevIndex, Prefix),
is_dotnet_root_directory_2(Prefix)
else
fail
)
).
:- pred is_dotnet_root_directory_2(string::in) is semidet.
:- pragma no_determinism_warning(pred(is_dotnet_root_directory_2/1)).
:- pragma foreign_proc("C#",
is_dotnet_root_directory_2(FileName::in),
[will_not_call_mercury, promise_pure, thread_safe],
"{
try {
SUCCESS_INDICATOR =
(System.IO.Path.GetDirectoryName(FileName) == null);
} catch (System.Exception) {
SUCCESS_INDICATOR = false;
}
}").
is_dotnet_root_directory_2(_) :-
unexpected($pred, "called for non-.NET CLI backend").
%---------------------------------------------------------------------------%
path_name_is_absolute(FileName) :-
( if
have_dotnet
then
dotnet_path_name_is_absolute(FileName)
else if
( use_windows_paths
; io.have_cygwin
)
then
strip_leading_win32_root_directory(
canonicalize_path_chars(string.to_char_list(FileName)), _)
else
string.index(FileName, 0, FirstChar),
dir.is_directory_separator(FirstChar)
).
:- pred dotnet_path_name_is_absolute(string::in) is semidet.
dotnet_path_name_is_absolute(FileName) :-
dir.dotnet_path_name_is_absolute_2(FileName),
% The .NET CLI function System.IO.Path.IsPathRooted succeeds for
% paths such as `C:', which specifies a directory relative to the
% current directory on drive C.
not (
use_windows_paths,
FileNameLen = length(FileName),
( if FileNameLen >= 2 then
char.is_alpha(string.unsafe_index(FileName, 0)),
string.unsafe_index(FileName, 1) = (':'),
( if FileNameLen > 2 then
not dir.is_directory_separator(
string.unsafe_index(FileName, 2))
else
true
)
else
fail
)
).
:- pred dotnet_path_name_is_absolute_2(string::in) is semidet.
:- pragma no_determinism_warning(pred(dotnet_path_name_is_absolute_2/1)).
:- pragma foreign_proc("C#",
dotnet_path_name_is_absolute_2(FileName::in),
[will_not_call_mercury, promise_pure, thread_safe],
"
try {
SUCCESS_INDICATOR = System.IO.Path.IsPathRooted(FileName);
} catch (System.Exception) {
SUCCESS_INDICATOR = false;
}
").
dotnet_path_name_is_absolute_2(_) :-
unexpected($pred, "called on non-.NET CLI backend").
%---------------------------------------------------------------------------%
DirName0 / FileName0 = PathName :-
( if is_path_string_canonical(DirName0) then
DirName = DirName0
else
DirName = string.from_char_list(canonicalize_path_chars(
string.to_char_list(DirName0)))
),
( if is_path_string_canonical(FileName0) then
FileName = FileName0
else
FileName = string.from_char_list(canonicalize_path_chars(
string.to_char_list(FileName0)))
),
( if dir.path_name_is_absolute(FileName) then
unexpected($pred, "second argument is absolute")
else if dir.path_name_is_drive_letter_relative_path(FileName) then
unexpected($pred, "second argument is a drive-letter relative path")
else if
(
% If DirName has the form "C:", then we don't need or want
% to add a directory separator after it; the colon is enough.
path_name_starts_with_drive_letter_colon(DirName, ThirdCharIndex),
not string.unsafe_index_next(DirName, ThirdCharIndex, _, _)
;
% Do not introduce duplicate directory separators.
% On Windows, \\foo (a UNC server specification) is not equivalent
% to \foo (the directory X:\foo, where X is the current drive).
string.length(DirName, DirNameLength),
DirNameLength > 0,
ends_with_directory_separator(DirName, DirNameLength, _)
)
then
PathName = DirName ++ FileName
else
% Using string.append_list has a fixed overhead of six words, whereas
% using two string.appends back to back would have a memory overhead
% proportional to the size of the string copied twice. We prefer the
% former because it is bounded.
PathName = string.append_list([DirName,
string.char_to_string(dir.directory_separator),
FileName])
).
% Is FileName a drive letter relative path of the form "C:foo"?
%
:- pred path_name_is_drive_letter_relative_path(string::in) is semidet.
path_name_is_drive_letter_relative_path(FileName) :-
% In the following, C stands for any drive letter, and xyz for
% non-special characters that can occur in filenames.
path_name_starts_with_drive_letter_colon(FileName, ThirdCharIndex),
( if string.unsafe_index_next(FileName, ThirdCharIndex, _, ThirdChar) then
( if is_directory_separator(ThirdChar) then
% FileName is "C:\xyz", which is a drive letter path,
% but an absolute one.
fail
else
% FileName is "C:xyz", which is a drive letter relative path.
true
)
else
% FileName is "C:", which is a drive letter relative path.
true
).
:- pred path_name_starts_with_drive_letter_colon(string::in, int::out)
is semidet.
path_name_starts_with_drive_letter_colon(FileName, ThirdCharIndex) :-
use_windows_paths,
string.unsafe_index_next(FileName, 0, SecondCharIndex, FirstChar),
string.unsafe_index_next(FileName, SecondCharIndex, ThirdCharIndex,
SecondChar),
% SecondChar is *much* more unlikely to be ':'
% than FirstChar is to pass is_alpha.
SecondChar = (':'),
char.is_alpha(FirstChar).
make_path_name(DirName, FileName) = DirName / FileName.
relative_path_name_from_components(Components) = PathName :-
Sep = string.from_char(dir.directory_separator),
PathName = string.join_list(Sep, Components).
%---------------------------------------------------------------------------%
current_directory(Result, !IO) :-
current_directory_2(CurDir, Error, !IO),
is_error(Error, "dir.current_directory failed: ", MaybeIOError, !IO),
(
MaybeIOError = yes(IOError),
Result = error(IOError)
;
MaybeIOError = no,
Result = ok(CurDir)
).
:- pred current_directory_2(string::out, io.system_error::out, io::di, io::uo)
is det.
:- pragma foreign_proc("C",
current_directory_2(CurDir::out, Error::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
may_not_duplicate],
"
#ifdef MR_WIN32
wchar_t *wbuf;
MR_String str;
wbuf = _wgetcwd(NULL, 1);
if (wbuf != NULL) {
CurDir = MR_wide_to_utf8(wbuf, MR_ALLOC_ID);
Error = 0;
free(wbuf);
} else {
CurDir = MR_make_string_const("""");
Error = errno;
}
#else
size_t size = 256;
while (1) {
// `size' includes the NUL terminator.
MR_allocate_aligned_string_msg(CurDir, size - 1, MR_ALLOC_ID);
if (getcwd(CurDir, size)) {
Error = 0;
break;
}
if (errno != ERANGE) {
CurDir = MR_make_string_const("""");
Error = errno;
break;
}
// Buffer too small. Resize and try again.
size *= 1.5;
}
#endif
").
:- pragma foreign_proc("C#",
current_directory_2(CurDir::out, Error::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, thread_safe, may_not_duplicate],
"
try {
CurDir = System.IO.Directory.GetCurrentDirectory();
Error = null;
} catch (System.Exception e) {
CurDir = """";
Error = e;
}
").
:- pragma foreign_proc("Java",
current_directory_2(CurDir::out, Error::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, thread_safe, may_not_duplicate],
"
try {
java.io.File dir = new java.io.File(""."");
CurDir = dir.getCanonicalPath();
Error = null;
} catch (java.lang.Exception e) {
CurDir = """";
Error = e;
}
").
%---------------------------------------------------------------------------%
make_directory(PathName, Result, !IO) :-
( if have_make_directory_including_parents then
make_directory_including_parents(PathName, Result, !IO)
else
DirName = dir.dirname(PathName),
( if PathName = DirName then
% We have been asked to make a root directory
% -- the mkdir will fail.
make_directory_or_check_exists(PathName, Result, !IO)
else if DirName = dir.this_directory then
% Just go ahead and attempt to make the directory -- if the
% current directory is not accessible, the mkdir will fail.
make_directory_or_check_exists(PathName, Result, !IO)
else
io.file.check_file_accessibility(DirName, [],
ParentAccessResult, !IO),
(
ParentAccessResult = ok,
make_directory_or_check_exists(PathName, Result, !IO)
;
ParentAccessResult = error(_),
make_directory(DirName, ParentResult, !IO),
(
ParentResult = ok,
make_directory_or_check_exists(PathName, Result, !IO)
;
ParentResult = error(_),
Result = ParentResult
)
)
)
).
:- pred make_directory_or_check_exists(string::in, io.res::out,
io::di, io::uo) is det.
make_directory_or_check_exists(DirName, Result, !IO) :-
make_single_directory_2(DirName, MakeDirStatus, Error, IsWin32Error, !IO),
(
MakeDirStatus = ok,
Result = ok
;
MakeDirStatus = name_exists,
io.file.file_type(yes, DirName, TypeResult, !IO),
( if TypeResult = ok(directory) then
check_dir_accessibility(DirName, Result, !IO)
else
make_io_error_from_maybe_win32_error(Error, IsWin32Error,
"cannot create directory: ", IOError, !IO),
Result = error(IOError)
)
;
MakeDirStatus = dir_exists,
check_dir_accessibility(DirName, Result, !IO)
;
MakeDirStatus = error,
make_io_error_from_maybe_win32_error(Error, IsWin32Error,
"cannot create directory: ", IOError, !IO),
Result = error(IOError)
).
:- pred check_dir_accessibility(string::in, io.res::out, io::di, io::uo)
is det.
check_dir_accessibility(DirName, Result, !IO) :-
% Check whether we can read, write and search the directory.
io.file.check_file_accessibility(DirName, [read, write, execute],
Result, !IO).
%---------------------------------------------------------------------------%
:- pred have_make_directory_including_parents is semidet.
have_make_directory_including_parents :-
semidet_fail.
:- pragma foreign_proc("C#",
have_make_directory_including_parents,
[will_not_call_mercury, promise_pure, thread_safe],
"
SUCCESS_INDICATOR = true;
").
:- pragma foreign_proc("Java",
have_make_directory_including_parents,
[will_not_call_mercury, promise_pure, thread_safe],
"
SUCCESS_INDICATOR = true;
").
:- pred make_directory_including_parents(string::in, io.res::out,
io::di, io::uo) is det.
make_directory_including_parents(DirName, Result, !IO) :-
make_directory_including_parents_2(DirName, SystemError, CheckAccess, !IO),
is_error(SystemError, "cannot make directory: ", MaybeIOError, !IO),
(
MaybeIOError = yes(IOError),
Result = error(IOError)
;
MaybeIOError = no,
(
CheckAccess = yes,
check_dir_accessibility(DirName, Result, !IO)
;
CheckAccess = no,
Result = ok
)
).
:- pred make_directory_including_parents_2(string::in, io.system_error::out,
bool::out, io::di, io::uo) is det.
:- pragma foreign_proc("C",
make_directory_including_parents_2(_DirName::in, Error::out,
CheckAccess::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
"
Error = ENOSYS;
CheckAccess = MR_NO;
").
:- pragma foreign_proc("C#",
make_directory_including_parents_2(DirName::in, Error::out,
CheckAccess::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, thread_safe],
"
try {
System.IO.DirectoryInfo di = new System.IO.DirectoryInfo(DirName);
// DirectoryInfo.Create() does nothing if the directory already exists,
// so we check explicitly. There is a race here.
if (di.Exists) {
Error = null;
CheckAccess = mr_bool.YES;
} else {
di.Create();
Error = null;
CheckAccess = mr_bool.NO;
}
} catch (System.Exception e) {
Error = e;
CheckAccess = mr_bool.NO;
}
").
:- pragma foreign_proc("Java",
make_directory_including_parents_2(DirName::in, Error::out,
CheckAccess::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, thread_safe],
"
try {
java.io.File dir = new java.io.File(DirName);
// We should switch to java.nio.file.Files.createDirectories()
// to remove these additional checks.
if (dir.isFile()) {
Error = new java.io.IOException(
""A file with that name already exists"");
CheckAccess = bool.NO;
} else if (dir.isDirectory()) {
Error = null;
CheckAccess = bool.YES;
} else if (dir.mkdirs()) {
Error = null;
CheckAccess = bool.NO;
} else {
Error = new java.io.IOException(""Failed to create directory"");
CheckAccess = bool.NO;
}
} catch (java.lang.Exception e) {
Error = e;
CheckAccess = bool.NO;
}
").
%---------------------------------------------------------------------------%
make_single_directory(DirName, Result, !IO) :-
make_single_directory_2(DirName, Status, Error, IsWin32Error, !IO),
(
Status = ok,
Result = ok
;
( Status = name_exists
; Status = dir_exists
; Status = error
),
make_io_error_from_maybe_win32_error(Error, IsWin32Error,
"cannot create directory: ", IOError, !IO),
Result = error(IOError)
).
:- type make_single_directory_status
---> ok
; name_exists % may or may not be directory
; dir_exists
; error.
:- pragma foreign_export_enum("C", make_single_directory_status/0,
[prefix("ML_MAKE_SINGLE_DIRECTORY_"), uppercase]).
:- pragma foreign_export_enum("C#", make_single_directory_status/0,
[prefix("ML_MAKE_SINGLE_DIRECTORY_"), uppercase]).
:- pragma foreign_export_enum("Java", make_single_directory_status/0,
[prefix("ML_MAKE_SINGLE_DIRECTORY_"), uppercase]).
:- pred make_single_directory_2(string::in, make_single_directory_status::out,
io.system_error::out, bool::out, io::di, io::uo) is det.
:- pragma foreign_proc("C",
make_single_directory_2(DirName::in, Status::out, Error::out,
IsWin32Error::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
will_not_modify_trail, does_not_affect_liveness, may_not_duplicate],
"
#if defined(MR_WIN32)
if (CreateDirectoryW(MR_utf8_to_wide(DirName), NULL)) {
Status = ML_MAKE_SINGLE_DIRECTORY_OK;
Error = 0;
} else {
Error = GetLastError();
if (Error == ERROR_ALREADY_EXISTS) {
Status = ML_MAKE_SINGLE_DIRECTORY_NAME_EXISTS;
} else {
Status = ML_MAKE_SINGLE_DIRECTORY_ERROR;
}
}
IsWin32Error = MR_YES;
#elif defined(MR_HAVE_MKDIR)
if (mkdir(DirName, 0777) == 0) {
Status = ML_MAKE_SINGLE_DIRECTORY_OK;
Error = 0;
} else {
Status = ML_MAKE_SINGLE_DIRECTORY_ERROR;
Error = errno;
#ifdef EEXIST
if (Error == EEXIST) {
Status = ML_MAKE_SINGLE_DIRECTORY_NAME_EXISTS;
}
#endif // EEXIST
}
IsWin32Error = MR_NO;
#else // !MR_WIN32 && !MR_HAVE_MKDIR
Status = ML_MAKE_SINGLE_DIRECTORY_ERROR;
Error = ENOSYS;
IsWin32Error = MR_NO;
#endif
").
:- pragma foreign_proc("C#",
make_single_directory_2(DirName::in, Status::out, Error::out,
IsWin32Error::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, thread_safe],
"
try {
System.IO.DirectoryInfo di = new System.IO.DirectoryInfo(DirName);
// DirectoryInfo.Create() does nothing if the directory already exists,
// so we check explicitly. There is a race here.
if (di.Exists) {
Status = dir.ML_MAKE_SINGLE_DIRECTORY_DIR_EXISTS;
Error =
new System.IO.IOException(""Directory already exists."");
} else {
System.IO.DirectoryInfo parent = di.Parent;
// This check just improves the error message.
if (parent != null && !parent.Exists) {
Status = dir.ML_MAKE_SINGLE_DIRECTORY_ERROR;
Error = new System.IO.IOException(
""Parent directory does not exist."");
} else {
di.Create();
Status = dir.ML_MAKE_SINGLE_DIRECTORY_OK;
Error = null;
}
}
} catch (System.Exception e) {
Status = dir.ML_MAKE_SINGLE_DIRECTORY_ERROR;
Error = e;
}
IsWin32Error = mr_bool.NO;
").
:- pragma foreign_proc("Java",
make_single_directory_2(DirName::in, Status::out, Error::out,
IsWin32Error::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, thread_safe, may_not_duplicate],
"
try {
java.io.File newDir = new java.io.File(DirName);
// We should switch to java.nio.file.Files.createDirectory().
if (newDir.exists()) {
Status = dir.ML_MAKE_SINGLE_DIRECTORY_NAME_EXISTS;
Error = new java.io.IOException(""File already exists"");
} else {
java.io.File parent = newDir.getParentFile();
if (parent != null && !parent.exists()) {
Status = dir.ML_MAKE_SINGLE_DIRECTORY_ERROR;
Error = new java.io.IOException(
""Parent directory does not exist"");
} else if (newDir.mkdir()) {
Status = dir.ML_MAKE_SINGLE_DIRECTORY_OK;
Error = null;
} else {
Status = dir.ML_MAKE_SINGLE_DIRECTORY_ERROR;
Error = new java.io.IOException(
""Failed to create directory"");
}
}
} catch (java.lang.Exception e) {
Status = dir.ML_MAKE_SINGLE_DIRECTORY_ERROR;
Error = e;
}
IsWin32Error = bool.NO;
").
%---------------------------------------------------------------------------%
foldl2(Pred, DirName, Data0, Result, !IO) :-
SubDirs = do_not_enter_subdirs,
Params = fold_params(SubDirs, on_error_stop),
dir.foldl2_process_dir(Params, Pred, make_dirname_ok_for_windows(DirName),
parent_is_not_symlink, [], user_continue, _MaybeUserStop,
[], RevErrors, Data0, Data, !IO),
list.reverse(RevErrors, Errors),
(
Errors = [],
Result = ok(Data)
;
Errors = [HeadError | _],
HeadError = file_error(_, _, Error),
Result = error(Data, Error)
).
recursive_foldl2(Pred, DirName, FollowLinks0, Data0, Result, !IO) :-
( FollowLinks0 = no, FollowLinks = do_not_follow_symlinks
; FollowLinks0 = yes, FollowLinks = follow_symlinks
),
SubDirs = enter_subdirs(FollowLinks),
Params = fold_params(SubDirs, on_error_stop),
dir.foldl2_process_dir(Params, Pred, make_dirname_ok_for_windows(DirName),
parent_is_not_symlink, [], user_continue, _MaybeUserStop,
[], RevErrors, Data0, Data, !IO),
list.reverse(RevErrors, Errors),
(
Errors = [],
Result = ok(Data)
;
Errors = [HeadError | _],
HeadError = file_error(_, _, Error),
Result = error(Data, Error)
).
general_foldl2(Params, Pred, DirName, Data0, Data, Errors, !IO) :-
dir.foldl2_process_dir(Params, Pred, make_dirname_ok_for_windows(DirName),
parent_is_not_symlink, [], user_continue, _MaybeUserStop,
[], RevErrors, Data0, Data, !IO),
list.reverse(RevErrors, Errors).
%---------------------%
% Under Windows, you cannot list the files of a directory if the directory
% name contains a trailing slash, except when the trailing slash indicates
% the root directory.
%
% This function removes the trailing slash, except when we are in the
% root directory.
%
:- func make_dirname_ok_for_windows(string) = string.
make_dirname_ok_for_windows(Dir0) = Dir :-
DirChars = canonicalize_path_chars(string.to_char_list(Dir0)),
( if is_root_directory(DirChars) then
Dir = Dir0
else
Dir = string.from_char_list(remove_trailing_dir_separator(DirChars))
).
%---------------------%
:- type is_parent_symlink
---> parent_is_not_symlink
; parent_is_symlink.
:- type maybe_user_stop
---> user_continue
; user_stop.
:- type maybe_file_error(T)
---> mfe_ok(T)
; mfe_error(file_error).
:- type maybe_file_error == maybe_file_error(unit).
:- pred foldl2_process_dir(fold_params::in,
dir.foldl_pred(T)::in(dir.foldl_pred),
string::in, is_parent_symlink::in, list(file_id)::in,
maybe_user_stop::in, maybe_user_stop::out,
list(file_error)::in, list(file_error)::out, T::in, T::out,
io::di, io::uo) is det.
foldl2_process_dir(Params, Pred, DirName, SymLinkParent, ParentIds0,
!MaybeUserStop, !RevErrors, !Data, !IO) :-
( if Params ^ fp_subdirs = enter_subdirs(follow_symlinks) then
check_for_symlink_loop(DirName, SymLinkParent, ParentIds0,
MaybeLoop, !IO)
else
MaybeLoop = scr_ok(ParentIds0)
),
(
MaybeLoop = scr_ok(ParentIds),
dir.open(DirName, OpenResult, !IO),
(
OpenResult = mfe_ok(DirStream),
% To avoid resource leaks, we need to close DirStream
% even if an exception is thrown.
% XXX It would be nice to know what code could throw exceptions.
% The Mercury code in this module does not throw exceptions,
% except for the *re*throw just below.
promise_equivalent_solutions [!:IO, TryResult] (
try_io(
foldl2_process_dir_entries_for_try(Params, Pred,
DirName, DirStream, SymLinkParent, ParentIds,
!.MaybeUserStop, !.RevErrors, !.Data),
TryResult, !IO)
),
dir.close(DirName, DirStream, CloseResult, !IO),
(
TryResult = succeeded({!:MaybeUserStop, !:RevErrors, !:Data}),
(
CloseResult = mfe_ok(unit)
;
CloseResult = mfe_error(Error),
!:RevErrors = [Error | !.RevErrors]
)
;
TryResult = exception(_),
rethrow(TryResult)
)
;
OpenResult = mfe_error(Error),
!:RevErrors = [Error | !.RevErrors]
)
;
MaybeLoop = scr_loop
;
MaybeLoop = scr_error(Error),
!:RevErrors = [Error | !.RevErrors]
).
:- pred foldl2_process_dir_entries_for_try(fold_params::in,
dir.foldl_pred(T)::in(dir.foldl_pred),
string::in, dir.stream::in, is_parent_symlink::in, list(file_id)::in,
maybe_user_stop::in, list(file_error)::in, T::in,
{maybe_user_stop, list(file_error), T}::out,
io::di, io::uo) is det.
foldl2_process_dir_entries_for_try(Params, Pred, DirName, DirStream,
SymLinkParent, ParentIds, !.MaybeUserStop, !.RevErrors, !.Data,
{!:MaybeUserStop, !:RevErrors, !:Data}, !IO) :-
foldl2_process_dir_entries(Params, Pred, DirName, DirStream, SymLinkParent,
ParentIds, !MaybeUserStop, !RevErrors, !Data, !IO).
:- pred foldl2_process_dir_entries(fold_params::in,
dir.foldl_pred(T)::in(dir.foldl_pred),
string::in, dir.stream::in, is_parent_symlink::in, list(file_id)::in,
maybe_user_stop::in, maybe_user_stop::out,
list(file_error)::in, list(file_error)::out, T::in, T::out,
io::di, io::uo) is det.
foldl2_process_dir_entries(Params, Pred, DirName, DirStream, SymLinkParent,
ParentIds, !MaybeUserStop, !RevErrors, !Data, !IO) :-
( if
(
!.MaybeUserStop = user_stop
;
!.RevErrors = [_ | _],
Params ^ fp_on_error = on_error_stop
)
then
true
else
dir.read_entry(DirStream, ReadResult, !IO),
(
ReadResult = ok(FileName),
PathName = make_path_name(DirName, FileName),
io.file.file_type(no, PathName, FileTypeResult, !IO),
(
FileTypeResult = ok(FileType),
Pred(DirName, FileName, FileType, PredSaysContinue,
!Data, !IO),
(
PredSaysContinue = yes,
( if
FileType = directory,
Params ^ fp_subdirs = enter_subdirs(_)
then
% XXX SymLinkParent?
foldl2_process_dir(Params, Pred, PathName,
SymLinkParent, ParentIds,
!MaybeUserStop, !RevErrors, !Data, !IO)
else if
FileType = symbolic_link,
Params ^ fp_subdirs = enter_subdirs(follow_symlinks)
then
io.file.file_type(yes, PathName,
TargetTypeResult, !IO),
(
TargetTypeResult = ok(TargetType),
(
TargetType = directory,
foldl2_process_dir(Params, Pred, PathName,
parent_is_symlink, ParentIds,
!MaybeUserStop, !RevErrors, !Data, !IO)
;
( TargetType = regular_file
; TargetType = symbolic_link
; TargetType = named_pipe
; TargetType = socket
; TargetType = character_device
; TargetType = block_device
; TargetType = message_queue
; TargetType = semaphore
; TargetType = shared_memory
; TargetType = unknown
)
)
;
TargetTypeResult = error(TargetTypeError),
Error = file_error(PathName, file_get_type,
TargetTypeError),
!:RevErrors = [Error | !.RevErrors]
)
else
true
),
foldl2_process_dir_entries(Params, Pred,
DirName, DirStream, SymLinkParent, ParentIds,
!MaybeUserStop, !RevErrors, !Data, !IO)
;
PredSaysContinue = no,
% We do not call foldl2_process_dir_entries recursively.
!:MaybeUserStop = user_stop
)
;
FileTypeResult = error(IOError),
Error = file_error(PathName, file_get_type, IOError),
!:RevErrors = [Error | !.RevErrors]
)
;
ReadResult = eof
;
ReadResult = error(IOError),
Error = file_error(DirName, file_read_dir_entry, IOError),
!:RevErrors = [Error | !.RevErrors]
)
).
:- type symlink_check_result
---> scr_ok(list(file_id))
; scr_loop
; scr_error(file_error).
% Check whether we have seen this directory before in this branch of the
% directory tree. This only works if the system can provide a unique
% identifier for each file. Returns `ok(DetectedLoop : bool)' on success.
%
:- pred check_for_symlink_loop(string::in, is_parent_symlink::in,
list(file_id)::in, symlink_check_result::out, io::di, io::uo) is det.
check_for_symlink_loop(DirName, SymLinkParent, ParentIds0, MaybeLoop, !IO) :-
( if io.file.have_symlinks then
io.file_id(DirName, IdResult, !IO),
(
IdResult = ok(Id),
( if
SymLinkParent = parent_is_symlink,
list.member(Id, ParentIds0)
then
MaybeLoop = scr_loop
else
ParentIds = [Id | ParentIds0],
MaybeLoop = scr_ok(ParentIds)
)
;
IdResult = error(Error),
MaybeLoop = scr_error(file_error(DirName, file_get_id, Error))
)
else
% There is no point in updating the list of parent ids,
% since we will never need them.
MaybeLoop = scr_ok(ParentIds0)
).
:- pragma foreign_decl("C", local,
"
#include ""mercury_string.h""
#include ""mercury_types.h""
#if defined(MR_WIN32) && defined(MR_HAVE_WINDOWS_H)
#include ""mercury_windows.h""
#include <direct.h> // for _wgetcwd
#endif
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#ifdef MR_HAVE_SYS_TYPES_H
#include <sys/types.h>
#endif
#ifdef MR_HAVE_DIRENT_H
#include <dirent.h>
#endif
#if defined(MR_WIN32)
struct ML_DIR_STREAM {
HANDLE handle; // may be INVALID_HANDLE_VALUE
MR_String pending_entry; // initially populated, then NULL
};
typedef struct ML_DIR_STREAM *ML_DIR_STREAM;
#elif defined(MR_HAVE_READDIR)
typedef DIR *ML_DIR_STREAM;
#else
typedef MR_Integer ML_DIR_STREAM;
#endif
").
% A dir.stream should be treated like an io.text_input_stream,
% except using dir.read_entry, rather than io.read_char.
% dir.streams must be closed to avoid resource leaks.
:- type dir.stream
---> dir.stream.
:- pragma foreign_type("C", dir.stream, "ML_DIR_STREAM").
:- pragma foreign_type("C#", dir.stream, "System.Collections.IEnumerator").
:- pragma foreign_type("Java", dir.stream, "java.util.Iterator").
:- pred open(string::in, maybe_file_error(dir.stream)::out,
io::di, io::uo) is det.
open(DirName, Result, !IO) :-
( if have_win32 then
% XXX This call to check_dir_readable seems to be redundant.
check_dir_readable(DirName, ReadabilityResult, !IO),
(
ReadabilityResult = mfe_ok(_),
DirPattern = make_path_name(DirName, "*"),
dir.open_2(DirName, DirPattern, Result, !IO)
;
ReadabilityResult = mfe_error(Error),
Result = mfe_error(Error)
)
else
DirPattern = "", % unused
dir.open_2(DirName, DirPattern, Result, !IO)
).
:- pred open_2(string::in, string::in, maybe_file_error(dir.stream)::out,
io::di, io::uo) is det.
open_2(DirName, DirPattern, Result, !IO) :-
open_3(DirName, DirPattern, DirStream, Error, IsWin32Error, !IO),
is_error_maybe_win32(Error, IsWin32Error, "cannot open directory: ",
MaybeIOError, !IO),
(
MaybeIOError = yes(IOError),
Result = mfe_error(file_error(DirName, file_open, IOError))
;
MaybeIOError = no,
Result = mfe_ok(DirStream)
).
:- pred open_3(string::in, string::in, dir.stream::out, io.system_error::out,
bool::out, io::di, io::uo) is det.
:- pragma foreign_proc("C",
open_3(DirName::in, DirPattern::in, DirStream::out, Error::out,
IsWin32Error::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
will_not_modify_trail, does_not_affect_liveness, may_not_duplicate],
"
#if defined(MR_WIN32)
WIN32_FIND_DATAW file_data;
DirStream = MR_GC_NEW_ATTRIB(struct ML_DIR_STREAM, MR_ALLOC_ID);
DirStream->handle = FindFirstFileW(MR_utf8_to_wide(DirPattern), &file_data);
if (DirStream->handle == INVALID_HANDLE_VALUE) {
Error = GetLastError();
if (Error == ERROR_NO_MORE_FILES) {
Error = 0;
}
DirStream->pending_entry = NULL;
} else {
Error = 0;
DirStream->pending_entry = MR_wide_to_utf8(file_data.cFileName, MR_ALLOC_ID);
}
IsWin32Error = MR_YES;
#elif defined(MR_HAVE_OPENDIR) && defined(MR_HAVE_READDIR) && \\
defined(MR_HAVE_CLOSEDIR)
DirStream = opendir(DirName);
if (DirStream == NULL) {
Error = errno;
} else {
Error = 0;
}
IsWin32Error = MR_NO;
#else // !MR_WIN32 && !(MR_HAVE_OPENDIR etc.)
DirStream = NULL;
Error = ENOSYS;
IsWin32Error = MR_NO;
#endif
").
:- pragma foreign_proc("C#",
open_3(DirName::in, _DirPattern::in, DirStream::out, Error::out,
IsWin32Error::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, thread_safe],
"
try {
DirStream =
System.IO.Directory.GetFileSystemEntries(DirName).GetEnumerator();
Error = null;
} catch (System.Exception e) {
DirStream = null;
Error = e;
}
IsWin32Error = mr_bool.NO;
").
:- pragma foreign_proc("Java",
open_3(DirName::in, _DirPattern::in, DirStream::out, Error::out,
IsWin32Error::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, thread_safe],
"
try {
java.io.File file = new java.io.File(DirName);
if (file.isDirectory()) {
String[] list = file.list();
if (list != null) {
DirStream = java.util.Arrays.asList(list).iterator();
Error = null;
} else {
DirStream = null;
// Probably permission problem.
Error = new java.io.IOException(""Error getting file list"");
}
} else if (!file.exists()) {
DirStream = null;
Error = new java.io.FileNotFoundException(
""No such file or directory"");
} else {
DirStream = null;
Error = new java.io.IOException(""Not a directory"");
}
} catch (java.lang.Exception e) {
DirStream = null;
Error = e;
}
IsWin32Error = bool.NO;
").
:- pred check_dir_readable(string::in, maybe_file_error::out,
io::di, io::uo) is det.
check_dir_readable(DirName, Result, !IO) :-
io.file.file_type(yes, DirName, FileTypeResult, !IO),
(
FileTypeResult = ok(FileType),
(
FileType = directory,
io.file.check_file_accessibility(DirName, [read, execute],
CheckResult, !IO),
(
CheckResult = ok,
Result = mfe_ok(unit)
;
CheckResult = error(IOError),
Error = file_error(DirName, file_check_accessibility, IOError),
Result = mfe_error(Error)
)
;
( FileType = regular_file
; FileType = symbolic_link
; FileType = named_pipe
; FileType = socket
; FileType = character_device
; FileType = block_device
; FileType = message_queue
; FileType = semaphore
; FileType = shared_memory
; FileType = unknown
),
% XXX The top level caller may not be dir.foldl2.
% XXX The message is too verbose for use in a full file_error.
% XXX ERROR: can we use a system error?
IOError = make_io_error("pathname is not a directory"),
% XXX Should file_check_accessibility be something else?
Error = file_error(DirName, file_check_accessibility, IOError),
Result = mfe_error(Error)
)
;
FileTypeResult = error(IOError),
Result = mfe_error(file_error(DirName, file_get_type, IOError))
).
:- pred close(string::in, dir.stream::in, maybe_file_error::out,
io::di, io::uo) is det.
close(DirName, DirStream, Result, !IO) :-
close_2(DirStream, Error, IsWin32Error, !IO),
% XXX The top level caller may not be dir.foldl2.
% XXX The message is too verbose for use in a full file_error.
is_error_maybe_win32(Error, IsWin32Error, "closing directory failed: ",
MaybeIOError, !IO),
(
MaybeIOError = yes(IOError),
Result = mfe_error(file_error(DirName, file_close, IOError))
;
MaybeIOError = no,
Result = mfe_ok(unit)
).
:- pred close_2(dir.stream::in, io.system_error::out, bool::out,
io::di, io::uo) is det.
:- pragma foreign_proc("C",
close_2(DirStream::in, Error::out, IsWin32Error::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
will_not_modify_trail, does_not_affect_liveness, may_not_duplicate],
"
#if defined(MR_WIN32)
if (DirStream->handle == INVALID_HANDLE_VALUE) {
Error = 0;
} else if (FindClose(DirStream->handle)) {
DirStream->handle = INVALID_HANDLE_VALUE;
Error = 0;
} else {
Error = GetLastError();
}
IsWin32Error = MR_YES;
#elif defined(MR_HAVE_CLOSEDIR)
if (closedir(DirStream) == 0) {
Error = 0;
} else {
Error = errno;
}
IsWin32Error = MR_NO;
#else
Error = ENOSYS;
IsWin32Error = MR_NO;
#endif
").
:- pragma foreign_proc("C#",
close_2(_DirStream::in, Error::out, IsWin32Error::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, thread_safe],
"
// Nothing to do.
Error = null;
IsWin32Error = mr_bool.NO;
").
:- pragma foreign_proc("Java",
close_2(_DirStream::in, Error::out, IsWin32Error::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, thread_safe],
"
// Nothing to do.
Error = null;
IsWin32Error = bool.NO;
").
:- pred read_entry(dir.stream::in, io.result(string)::out, io::di, io::uo)
is det.
read_entry(DirStream, Result, !IO) :-
read_entry_2(DirStream, Error, IsWin32Error, HaveFileName, FileName, !IO),
% XXX The top level caller may not be dir.foldl2.
% XXX The message is too verbose for use in a full file_error.
is_error_maybe_win32(Error, IsWin32Error,
"reading directory entry failed: ", MaybeIOError, !IO),
(
MaybeIOError = yes(IOError),
Result = error(IOError)
;
MaybeIOError = no,
(
HaveFileName = no,
Result = eof
;
HaveFileName = yes,
( if
( FileName = dir.this_directory
; FileName = dir.parent_directory
)
then
dir.read_entry(DirStream, Result, !IO)
else
Result = ok(FileName)
)
)
).
% read_entry_2(DirStream, Error, IsWin32Error, HaveFileName, FileName,
% !IO):
% If there is no error and HaveFileName = no, then we have reached the
% end-of-stream.
%
:- pred read_entry_2(dir.stream::in, io.system_error::out, bool::out,
bool::out, string::out, io::di, io::uo) is det.
:- pragma foreign_proc("C",
read_entry_2(DirStream::in, Error::out, IsWin32Error::out,
HaveFileName::out, FileName::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
will_not_modify_trail, does_not_affect_liveness, may_not_duplicate],
"
#if defined(MR_WIN32)
WIN32_FIND_DATAW file_data;
if (DirStream->handle == INVALID_HANDLE_VALUE) {
// Directory was empty when opened.
Error = 0;
IsWin32Error = MR_YES;
HaveFileName = MR_NO;
FileName = MR_make_string_const("""");
} else if (DirStream->pending_entry != NULL) {
// FindFirstFileW already returned the first entry.
Error = 0;
IsWin32Error = MR_YES;
HaveFileName = MR_YES;
FileName = DirStream->pending_entry;
DirStream->pending_entry = NULL;
} else if (FindNextFileW(DirStream->handle, &file_data)) {
Error = 0;
IsWin32Error = MR_YES;
HaveFileName = MR_YES;
FileName = MR_wide_to_utf8(file_data.cFileName, MR_ALLOC_ID);
} else {
Error = GetLastError();
IsWin32Error = MR_YES;
if (Error == ERROR_NO_MORE_FILES) {
Error = 0;
}
HaveFileName = MR_NO;
FileName = MR_make_string_const("""");
}
#elif defined(MR_HAVE_READDIR) && defined(MR_HAVE_CLOSEDIR)
struct dirent *dir_entry;
errno = 0; // to detect end-of-stream
dir_entry = readdir(DirStream);
if (dir_entry == NULL) {
Error = errno; // remains zero at end-of-stream
IsWin32Error = MR_NO;
HaveFileName = MR_NO;
FileName = MR_make_string_const("""");
} else {
Error = 0;
IsWin32Error = MR_NO;
HaveFileName = MR_YES;
MR_make_aligned_string_copy_msg(FileName, dir_entry->d_name,
MR_ALLOC_ID);
}
#else // !MR_WIN32 && !(MR_HAVE_READDIR etc.)
Error = ENOSYS;
IsWin32Error = MR_NO;
HaveFileName = MR_NO;
FileName = MR_make_string_const("""");
#endif
").
:- pragma foreign_proc("C#",
read_entry_2(DirStream::in, Error::out, IsWin32Error::out,
HaveFileName::out, FileName::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, thread_safe],
"
try {
if (DirStream.MoveNext()) {
// The .NET CLI returns path names qualified with
// the directory name passed to dir.open.
HaveFileName = mr_bool.YES;
FileName = System.IO.Path.GetFileName((string) DirStream.Current);
} else {
HaveFileName = mr_bool.NO;
FileName = """";
}
Error = null;
IsWin32Error = mr_bool.NO;
} catch (System.Exception e) {
Error = e;
IsWin32Error = mr_bool.NO;
HaveFileName = mr_bool.NO;
FileName = """";
}
").
:- pragma foreign_proc("Java",
read_entry_2(DirStream::in, Error::out, IsWin32Error::out,
HaveFileName::out, FileName::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, thread_safe],
"
try {
if (DirStream.hasNext()) {
HaveFileName = bool.YES;
FileName = (java.lang.String) DirStream.next();
} else {
HaveFileName = bool.NO;
FileName = """";
}
Error = null;
IsWin32Error = bool.NO;
} catch (java.lang.Exception e) {
Error = e;
IsWin32Error = bool.NO;
HaveFileName = bool.NO;
FileName = """";
}
").
%---------------------------------------------------------------------------%
expand_braces(ArgStr) = ExpandStrs :-
ArgChar = string.to_char_list(ArgStr),
ExpandChars = expand(ArgChar),
ExpandStrs = list.map(string.from_char_list, ExpandChars).
:- func expand(list(char)) = list(list(char)).
expand(Chars) = expand_acc(Chars, [[]]).
:- func expand_acc(list(char), list(list(char))) = list(list(char)).
expand_acc([], Prefixes) = Prefixes.
expand_acc([Char | Chars], Prefixes0) = Strings :-
( if Char = '{' then
find_matching_brace(Chars, Alternatives0, Left),
AlternativeLists = list.map(expand, Alternatives0),
Alternatives = list.condense(AlternativeLists),
PrefixLists = list.map(add_alternatives(Alternatives), Prefixes0),
Prefixes1 = list.condense(PrefixLists),
expand_acc(Left, Prefixes1) = Strings
else
Prefixes1 = list.map(add_char_at_end(Char), Prefixes0),
Strings = expand_acc(Chars, Prefixes1)
).
:- func add_alternatives(list(list(char)), list(char)) = list(list(char)).
add_alternatives(Alternatives, Prefix) =
list.map(list.append(Prefix), Alternatives).
:- func add_char_at_end(char, list(char)) = list(char).
add_char_at_end(Char, Prefix) = list.append(Prefix, [Char]).
:- pred find_matching_brace(list(char)::in, list(list(char))::out,
list(char)::out) is det.
find_matching_brace(Chars, Alternatives, Left) :-
find_matching_brace_or_comma(Chars, [], [], 0, Alternatives, Left).
:- pred find_matching_brace_or_comma(list(char)::in, list(list(char))::in,
list(char)::in, int::in, list(list(char))::out, list(char)::out) is det.
find_matching_brace_or_comma([], _, _, _, _, _) :-
error("dir.expand_braces: mismatched braces").
find_matching_brace_or_comma([Char | Chars], Alternatives0, CurAlternative,
BraceLevel, Alternatives, Left) :-
( if Char = '}' then
( if BraceLevel = 0 then
list.append(Alternatives0, [CurAlternative], Alternatives),
Left = Chars
else
find_matching_brace_or_comma(Chars, Alternatives0,
list.append(CurAlternative, [Char]),
BraceLevel - 1, Alternatives, Left)
)
else if Char = '{' then
find_matching_brace_or_comma(Chars, Alternatives0,
list.append(CurAlternative, [Char]),
BraceLevel + 1, Alternatives, Left)
else if Char = (',') then
( if BraceLevel = 0 then
list.append(Alternatives0, [CurAlternative], Alternatives1),
find_matching_brace_or_comma(Chars, Alternatives1,
[], BraceLevel, Alternatives, Left)
else
find_matching_brace_or_comma(Chars, Alternatives0,
list.append(CurAlternative, [Char]),
BraceLevel, Alternatives, Left)
)
else
find_matching_brace_or_comma(Chars, Alternatives0,
list.append(CurAlternative, [Char]),
BraceLevel, Alternatives, Left)
).
%---------------------------------------------------------------------------%
use_windows_paths :-
dir.directory_separator = ('\\').
%---------------------------------------------------------------------------%
:- end_module dir.
%---------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink