[m-rev.] for review: library changes for `mmc --make' on Windows
Simon Taylor
stayl at cs.mu.OZ.AU
Sun Jun 15 00:05:42 AEST 2003
Estimated hours taken: 100
Branches: main
Library changes required to make the compiler work on Windows
without Cygwin. (Compiler changes to come separately).
library/dir.m:
Handle Windows-style paths.
Change the determinism of dir.basename and dir.split_name.
dir.basename now fails for root directories (a new function
dir.basename_det calls error/1 rather than failing).
dir.split_name fails for root directories or if the pathname
passed doesn't contain a directory separator.
Add predicates dir.make_directory and dir.path_name_is_absolute.
Add a function dir.parent_directory (returns "..").
Add dir.foldl2 and dir.recursive_foldl2, to iterate through
the entries in a directory (and maybe its subdirectories).
library/io.m:
Add io.file_type and io.check_file_accessibility.
Add predicates to deal with symlinks -- io.have_symlinks,
io.make_symlink and io.follow_symlink.
Add io.file_id for use by dir.foldl2 to detect
symlink loops. This is a bit low level, so it's
not included in the user documentation.
Add io.(binary_)input_stream_foldl2_io_maybe_stop, which
is like io.(binary_)input_stream_foldl2_io, but allows
stopping part of the way through. This is useful for
implementing `diff'-like functionality to replace
mercury_update_interface.
Use Windows-style paths when generating temporary file
names on Windows.
Add versions of the predicates to generate error messages
to handle Win32 errors.
Add versions of the predicates to generate error messages
which take a system error code, rather than looking up
errno. This simplifies things where the error we
are interested in was not from the last system call.
library/exception.m:
Add predicates try_det, try_io_det and try_store_det,
which only have one mode so they are more convenient
to pass to promise_only solution.
library/Mmakefile:
Add dependencies on runtime/mercury_conf.h for files which
use the MR_HAVE_* macros.
NEWS:
Document the new predicates and functions and the change
of determinism of dir.split_name and dir.basename.
configure.in:
runtime/mercury_conf.h.in:
Test for lstat, mkdir, symlink and readlink.
compiler/compile_target_code.m:
compiler/modules.m:
compiler/options_file.m:
compiler/prog_io.m:
compiler/source_file_map.m:
Changes required by the change of determinism of
dir.split_name and dir.basename.
tests/hard_coded/Mmakefile:
tests/hard_coded/dir_test.{m,exp,exp2,exp3}:
Test case.
Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.314
diff -u -u -r1.314 NEWS
--- NEWS 26 May 2003 10:05:13 -0000 1.314
+++ NEWS 13 Jun 2003 16:39:02 -0000
@@ -27,6 +27,24 @@
* Several new functions have been added to the string module, namely
elem/2, unsafe_elem/2, chomp/1, lstrip/1, lstrip/2, rstrip/1, rstrip/2,
strip/1, prefix_length/2, and suffix_length/2.
+* The dir module now handles Microsoft Windows pathnames correctly.
+* dir__split_name and dir__basename are now semidet, not det.
+* We've added some new predicates and functions to the dir module:
+ basename_det/1,
+ expand_braces/1,
+ make_directory/4,
+ foldl2/6,
+ parent_directory/0,
+ path_name_is_absolute/1,
+ recursive_foldl2/7.
+* We've added several new predicates to the io module:
+ have_symlinks/0,
+ make_symlink/4,
+ follow_symlink/4,
+ check_file_accessibility/5,
+ file_type/4,
+ input_stream_foldl2_io_maybe_stop/{6,7},
+ binary_input_stream_foldl2_io_maybe_stop/{6,7}.
Portability improvements:
* Nothing yet.
@@ -85,6 +103,35 @@
in the leaf nodes. Joining two cords together to construct a new cord
is therefore an O(1) operation.
+* The dir module now handles Microsoft Windows pathnames correctly.
+
+* dir__split_name and dir__basename are now semidet, not det.
+ dir__split_name fails for root directories or pathnames not
+ containing a directory separator.
+ dir__basename fails for root directories.
+
+* We've added some new predicates and functions to the dir module:
+ basename_det/1,
+ expand_braces/1,
+ make_directory/4,
+ foldl2/6,
+ parent_directory/0,
+ path_name_is_absolute/1,
+ recursive_foldl2/7.
+
+* We've added several new predicates to the io module:
+ have_symlinks/0,
+ make_symlink/4,
+ follow_symlink/4,
+ check_file_accessibility/5,
+ file_type/4,
+ input_stream_foldl2_io_maybe_stop/{6,7},
+ binary_input_stream_foldl2_io_maybe_stop/{6,7}.
+
+* We've added predicates try_det/2, try_io_det/4 and try_store_det/4
+ to exception.m. These predicates have only one mode, so it's more
+ convenient to pass them to promise_only_solution.
+
* Several new functions have been added to the string module, namely
elem/2, unsafe_elem/2, chomp/1, lstrip/1, lstrip/2, rstrip/1, rstrip/2,
strip/1, prefix_length/2, and suffix_length/2.
@@ -96,8 +143,6 @@
* We've added a new predicate, map__common_subset, to map.m.
* We've added a predicate, map_fold, to set.m.
-
-* We've added a predicate, expand_braces, to dir.m.
* We've added a function, pred_to_bool, to bool.m.
Index: configure.in
===================================================================
RCS file: /home/mercury1/repository/mercury/configure.in,v
retrieving revision 1.369
diff -u -u -r1.369 configure.in
--- configure.in 12 Jun 2003 12:08:30 -0000 1.369
+++ configure.in 12 Jun 2003 15:35:57 -0000
@@ -664,10 +664,10 @@
mprotect memalign memmove \
sigaction siginterrupt setitimer \
snprintf _snprintf vsnprintf _vsnprintf strerror \
- open close dup dup2 fdopen fileno fstat stat isatty \
+ open close dup dup2 fdopen fileno fstat stat lstat isatty \
getpid setpgid fork execlp wait kill \
grantpt unlockpt ptsname tcgetattr tcsetattr ioctl \
- access sleep opendir readdir closedir
+ access sleep opendir readdir closedir mkdir symlink readlink
#-----------------------------------------------------------------------------#
MERCURY_CHECK_FOR_HEADERS( \
Index: compiler/compile_target_code.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/compile_target_code.m,v
retrieving revision 1.44
diff -u -u -r1.44 compile_target_code.m
--- compiler/compile_target_code.m 26 May 2003 08:59:52 -0000 1.44
+++ compiler/compile_target_code.m 12 Jun 2003 15:58:08 -0000
@@ -839,7 +839,7 @@
( { TargetType = executable } ->
{ list__map(
(pred(ModuleStr::in, ModuleName::out) is det :-
- dir__basename(ModuleStr, ModuleStrBase),
+ ModuleStrBase = dir__basename_det(ModuleStr),
file_name_to_module_name(ModuleStrBase, ModuleName)
),
Modules, ModuleNames) },
@@ -1589,7 +1589,7 @@
join_module_list([], _Extension, Terminator, Terminator) --> [].
join_module_list([Module | Modules], Extension, Terminator,
[FileName, " " | Rest]) -->
- { dir__basename(Module, BaseName) },
+ { BaseName = dir__basename_det(Module) },
{ file_name_to_module_name(BaseName, ModuleName) },
module_name_to_file_name(ModuleName, Extension, no, FileName),
join_module_list(Modules, Extension, Terminator, Rest).
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.274
diff -u -u -r1.274 modules.m
--- compiler/modules.m 5 Jun 2003 04:16:20 -0000 1.274
+++ compiler/modules.m 12 Jun 2003 16:22:34 -0000
@@ -1095,7 +1095,7 @@
prog_out__sym_name_to_string(ModuleName, ".", MakeVarName).
make_directory(DirName) -->
- make_directory(DirName, _Result).
+ modules__make_directory(DirName, _Result).
make_directory(DirName, Result) -->
( { dir__this_directory(DirName) } ->
@@ -5431,7 +5431,11 @@
maybe_write_string(VeryVerbose, "'... "),
maybe_flush_output(VeryVerbose),
{ string__append(FileName, Extension, FullFileName) },
- { dir__basename(FileName, BaseFileName) },
+ { dir__basename(FileName, BaseFileName0) ->
+ BaseFileName = BaseFileName0
+ ;
+ BaseFileName = ""
+ },
{ file_name_to_module_name(BaseFileName, DefaultModuleName) },
( { Search = yes } ->
globals__io_lookup_accumulating_option(search_directories,
Index: compiler/options_file.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/options_file.m,v
retrieving revision 1.18
diff -u -u -r1.18 options_file.m
--- compiler/options_file.m 29 Apr 2003 05:25:08 -0000 1.18
+++ compiler/options_file.m 12 Jun 2003 16:17:08 -0000
@@ -185,22 +185,21 @@
{ ErrorIfNotExist = ErrorIfNotExist0 },
{ SearchDirs = [dir__this_directory] }
),
- { dir__split_name(OptionsFile0, OptionsDir, OptionsFile) },
- (
- % Is it an absolute pathname?
- % XXX This won't work on Windows
- % (but GNU Make does it this way too).
- { string__index(OptionsDir, 0,
- dir__directory_separator) }
- ->
- { FileToFind = OptionsFile },
- { Dirs = [OptionsDir] }
- ;
- { MaybeDirName = yes(DirName) }
- ->
- { FileToFind = OptionsFile },
- { Dirs = [dir__make_path_name(DirName, OptionsDir)
- | SearchDirs] }
+ ( { dir__split_name(OptionsFile0, OptionsDir, OptionsFile) } ->
+ (
+ { dir__path_name_is_absolute(OptionsDir) }
+ ->
+ { FileToFind = OptionsFile },
+ { Dirs = [OptionsDir] }
+ ;
+ { MaybeDirName = yes(DirName) }
+ ->
+ { FileToFind = OptionsFile },
+ { Dirs = [DirName/OptionsDir | SearchDirs] }
+ ;
+ { Dirs = SearchDirs },
+ { FileToFind = OptionsFile0 }
+ )
;
{ Dirs = SearchDirs },
{ FileToFind = OptionsFile0 }
@@ -212,7 +211,7 @@
debug_msg(
(pred(di, uo) is det -->
io__write_string("Reading options file "),
- io__write_string(FoundDir / OptionsFile),
+ io__write_string(FoundDir/FileToFind),
io__nl
)),
@@ -226,9 +225,9 @@
( { ErrorIfNotExist = error } ->
{ Dirs = [SingleDir] ->
ErrorFile = maybe_add_path_name(SingleDir,
- OptionsFile)
+ FileToFind)
;
- ErrorFile = OptionsFile
+ ErrorFile = FileToFind
},
io__write_string("Error reading options file `"),
io__write_string(ErrorFile),
Index: compiler/prog_io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io.m,v
retrieving revision 1.220
diff -u -u -r1.220 prog_io.m
--- compiler/prog_io.m 19 May 2003 14:24:26 -0000 1.220
+++ compiler/prog_io.m 12 Jun 2003 16:25:24 -0000
@@ -590,7 +590,7 @@
;
PartialFileName = FileName
},
- { file_name_to_module_name(dir__basename(PartialFileName),
+ { file_name_to_module_name(dir__basename_det(PartialFileName),
DefaultModuleName) },
read_first_item(DefaultModuleName, FileName,
ModuleName, RevMessages, _, _, _),
Index: compiler/source_file_map.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/source_file_map.m,v
retrieving revision 1.6
diff -u -u -r1.6 source_file_map.m
--- compiler/source_file_map.m 15 Mar 2003 03:09:10 -0000 1.6
+++ compiler/source_file_map.m 12 Jun 2003 16:26:32 -0000
@@ -189,7 +189,7 @@
;
PartialFileName = FileName
},
- { file_name_to_module_name(dir__basename(PartialFileName),
+ { file_name_to_module_name(dir__basename_det(PartialFileName),
DefaultModuleName) },
(
% Only include a module in the mapping if the
Index: library/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/library/Mmakefile,v
retrieving revision 1.116
diff -u -u -r1.116 Mmakefile
--- library/Mmakefile 26 May 2003 11:03:38 -0000 1.116
+++ library/Mmakefile 13 Jun 2003 16:27:01 -0000
@@ -340,9 +340,20 @@
endif # GRADE != il && GRADE != java
#-----------------------------------------------------------------------------#
-# Ensure we recompile library__version if VERSION is changed.
+# Ensure we recompile library__version if VERSION or the MR_HAVE_*
+# macros are changed.
+$(os_subdir)deconstruct.$O \
+$(os_subdir)deconstruct.pic_o \
$(os_subdir)library.$O \
$(os_subdir)library.pic_o \
+$(os_subdir)dir.$O \
+$(os_subdir)dir.pic_o \
+$(os_subdir)float.$O \
+$(os_subdir)float.pic_o \
+$(os_subdir)io.$O \
+$(os_subdir)io.pic_o \
+$(os_subdir)time.$O \
+$(os_subdir)time.pic_o \
: $(RUNTIME_DIR)/mercury_conf.h
# The object files in this directory depend on many of the header files
Index: library/dir.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/dir.m,v
retrieving revision 1.16
diff -u -u -r1.16 dir.m
--- library/dir.m 26 May 2003 09:00:29 -0000 1.16
+++ library/dir.m 14 Jun 2003 08:45:44 -0000
@@ -5,7 +5,7 @@
%---------------------------------------------------------------------------%
% File: dir.m.
-% Main author: fjh.
+% Main author: fjh, stayl.
% Filename and directory handling.
% Stability: high.
@@ -15,36 +15,92 @@
:- module dir.
:- interface.
-:- import_module list.
+:- import_module bool, io, list.
% predicates to isolate system dependencies
+ % Returns the separator between components of a pathname --
+ % '/' on Unix systems and '\' on Microsoft Windows systems.
:- func dir__directory_separator = character.
:- pred dir__directory_separator(character).
:- mode dir__directory_separator(out) is det.
:- mode dir__directory_separator(in) is semidet.
- % Returns '/'.
+ % Returns ".".
:- func dir__this_directory = string.
:- pred dir__this_directory(string).
:- mode dir__this_directory(out) is det.
-:- mode dir__this_directory(in) is semidet. % Implied
- % Returns ".".
-
- % predicates for splitting filenames into a directory part and
- % a filename part.
-:- pred dir__split_name(string::in, string::out, string::out) is det.
-:- pred dir__basename(string::in, string::out) is det.
-:- func dir__basename(string) = string.
+ % Returns "..".
+:- func dir__parent_directory = string.
+:- pred dir__parent_directory(string).
+:- mode dir__parent_directory(out) is det.
+
+ % dir__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 a directory separator.
+:- pred dir__split_name(string::in, string::out, string::out) is semidet.
+
+ % dir__basename(PathName) = BaseName.
+ % Returns the non-directory part of a filename.
+ % Fails when given a root directory.
+:- func dir__basename(string) = string is semidet.
+:- pred dir__basename(string::in, string::out) is semidet.
+
+ % As above, but throw an exception when given a root directory.
+:- func dir__basename_det(string) = string.
+
+ % dir__basename(PathName) = BaseName.
+ % Returns the directory part of a filename.
+:- func dir__dirname(string) = string is det.
:- pred dir__dirname(string::in, string::out) is det.
-:- func dir__dirname(string) = string.
+
+ % Is the path name syntactically an absolute path
+ % (doesn't check whether the path exists).
+:- pred dir__path_name_is_absolute(string::in) is semidet.
% Given a directory name and a filename, return the pathname of that
% file in that directory.
:- func dir__make_path_name(string, string) = string.
:- func string / string = string.
+%-----------------------------------------------------------------------------%
+
+ % 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 dir__make_directory(string, io__res, io__state, io__state).
+:- mode dir__make_directory(in, out, di, uo) is det.
+
+%-----------------------------------------------------------------------------%
+
+ % FoldlPred(DirName, BaseName, FileType, Continue, !Data, !IO).
+:- type dir__foldl_pred(T) == pred(string, string, io__file_type, bool,
+ T, T, io__state, io__state).
+:- inst dir__foldl_pred == (pred(in, in, in, out, in, out, di, uo) is det).
+
+ % dir__foldl2(P, DirName, InitialData, Result, !IO).
+ %
+ % Apply `P' to all direct subdirectories of the given directory.
+:- pred dir__foldl2(dir__foldl_pred(T), string,
+ T, io__maybe_partial_res(T), io__state, io__state).
+:- mode dir__foldl2(in(dir__foldl_pred), in, in, out, di, uo) is det.
+
+ % dir__recursive_foldl2(P, DirName, FollowSymLinks,
+ % InitialData, Result, !IO).
+ %
+ % Apply `P' to all direct and indirect subdirectories
+ % of the given directory.
+ % If `FollowSymLinks' is `yes', process the directories
+ % referenced by symbolic links in subdirectories of DirName.
+:- pred dir__recursive_foldl2(dir__foldl_pred(T), string, bool,
+ T, io__maybe_partial_res(T), io__state, io__state).
+:- mode dir__recursive_foldl2(in(dir__foldl_pred),
+ in, in, in, out, di, 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.
@@ -70,45 +126,252 @@
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module int, char, list, require, exception, string.
-dir__directory_separator('/').
+% Anything below here will not appear in the Mercury Library Reference Manual.
+:- interface.
+
+ % For use by io.m.
+:- pred dir__use_windows_paths is semidet.
+
+:- implementation.
+
+:- import_module char, enum, exception, int, list, require, string, std_util.
-dir__this_directory(".").
+dir__directory_separator = (if have_win32 then ('\\') else ('/')).
+:- pragma foreign_proc("C#", dir__directory_separator = (Sep::out),
+ [promise_pure, will_not_call_mercury, thread_safe],
+"
+ Sep = System.IO.Path.DirectorySeparatorChar;
+").
+
+use_windows_paths :- dir__directory_separator = ('\\').
+
+:- pragma export((dir__this_directory = out), "ML_this_directory").
+dir__this_directory = ".".
+
+dir__parent_directory = "..".
+
+%-----------------------------------------------------------------------------%
+
+dir__basename_det(FileName) =
+ ( if BaseName = dir__basename(FileName)
+ then BaseName
+ else func_error("dir.basename_det: given directory is root directory")
+ ).
+
+dir__basename(FileName) = BaseName :-
+ FileNameList = strip_repeated_dir_separators(
+ string__to_char_list(FileName)),
+ ( dir__is_root_directory(FileNameList) ->
+ fail
+ ; dir__split_name_2(FileNameList, _, BaseName0) ->
+ BaseName = BaseName0
+ ;
+ BaseName = FileName
+ ).
+
+dir__dirname(FileName) = DirName :-
+ FileNameList = strip_repeated_dir_separators(
+ string__to_char_list(FileName)),
+ ( dir__is_root_directory(FileNameList) ->
+ DirName = FileName
+ ; dir__split_name_2(FileNameList, DirName0, _) ->
+ DirName = DirName0
+ ;
+ DirName = dir__this_directory
+ ).
dir__split_name(FileName, DirName, BaseName) :-
- string__length(FileName, Length),
- dir__split_name_2(FileName, Length, DirName, BaseName).
+ FileNameList = strip_repeated_dir_separators(
+ string__to_char_list(FileName)),
+ \+ is_root_directory(FileNameList),
+ dir__split_name_2(FileNameList, DirName, BaseName).
+
+:- pred dir__split_name_2(list(char)::in, string::out, string::out) is semidet.
+
+dir__split_name_2(FileNameList0, DirName, BaseName) :-
+ ( io__have_dotnet ->
+ % Remove any trailing separator (System.IO.Path.GetFileName()
+ % returns the empty string if the path ends in a separator).
+ (
+ list__split_last(FileNameList0, FileNameList1,
+ dir__directory_separator)
+ ->
+ FileNameList = FileNameList1
+ ;
+ FileNameList = FileNameList0
+ ),
+ dir__split_name_dotnet(string__from_char_list(FileNameList),
+ DirName, BaseName)
+ ;
+ dir__split_name_3(FileNameList0, DirName, BaseName)
+ ).
-:- pred dir__split_name_2(string::in, int::in, string::out, string::out)
- is det.
+:- pred dir__split_name_3(list(char)::in, string::out, string::out) is semidet.
+
+dir__split_name_3(FileNameList, DirName, BaseName) :-
+ % Remove any trailing separator.
+ RevFileNameList0 = reverse(FileNameList),
+ ( RevFileNameList0 = [dir__directory_separator | RevFileNameList1] ->
+ RevFileNameList = RevFileNameList1
+ ;
+ RevFileNameList = RevFileNameList0
+ ),
+ list__takewhile(isnt(unify(dir__directory_separator)),
+ RevFileNameList, RevBaseName, RevDirName),
+ RevBaseName \= [],
+ RevDirName \= [],
+ BaseName = string__from_rev_char_list(RevBaseName),
+ DirName = string__from_rev_char_list(RevDirName).
+
+:- pred dir__split_name_dotnet(string::in,
+ string::out, string::out) is semidet.
+
+dir__split_name_dotnet(_, "", "") :- semidet_fail.
+
+% .NET provides functions to split directory names in a
+% system-dependent manner.
+:- pragma foreign_proc("C#",
+ dir__split_name_dotnet(FileName::in, DirName::out, BaseName::out),
+ [may_call_mercury, promise_pure, thread_safe],
+"
+ try {
+ DirName = System.IO.Path.GetDirectoryName(FileName);
+ if (DirName == null) {
+ SUCCESS_INDICATOR = false;
+ } else if (DirName == System.String.Empty) {
+ SUCCESS_INDICATOR = true;
+ DirName = mercury.dir.mercury_code.ML_this_directory();
+ BaseName = FileName;
+ } else {
+ BaseName = System.IO.Path.GetFileName(FileName);
+ SUCCESS_INDICATOR = (BaseName != null);
+ }
+ } catch (System.Exception e) {
+ SUCCESS_INDICATOR = false;
+ }
+").
-dir__split_name_2(FileName, N, DirName, BaseName) :-
- N1 = N - 1,
+:- func strip_repeated_dir_separators(list(char)) = list(char).
+
+strip_repeated_dir_separators(FileName0) =
(
- N1 < 0
+ % Windows allows paths of the form "\\server\share".
+ use_windows_paths,
+ FileName0 = [dir__directory_separator | FileName1]
->
- dir__this_directory(DirName),
- BaseName = FileName
+ [dir__directory_separator |
+ strip_repeated_dir_separators_2(FileName1, [])]
+ ;
+ strip_repeated_dir_separators_2(FileName0, [])
+ ).
+
+:- func strip_repeated_dir_separators_2(list(char), list(char)) = list(char).
+
+strip_repeated_dir_separators_2([], RevFileName) = reverse(RevFileName).
+strip_repeated_dir_separators_2([C | FileName0],
+ RevFileName) = FileName :-
+ ( C = dir__directory_separator ->
+ list__takewhile(unify(dir__directory_separator),
+ FileName0, _, FileName1),
+ FileName = strip_repeated_dir_separators_2(FileName1,
+ [C | RevFileName])
;
- string__index_det(FileName, N1, Separator),
- dir__directory_separator(Separator)
- ->
- string__split(FileName, N1, DirName, Rest),
- ( string__first_char(Rest, _Sep, BaseName0) ->
- BaseName = BaseName0
- ;
- error("dir__split_name_2")
- )
+ FileName = strip_repeated_dir_separators_2(FileName0,
+ [C | RevFileName])
+ ).
+
+:- pred is_root_directory(list(char)::in) is semidet.
+
+is_root_directory(FileName) :-
+ ( have_dotnet ->
+ is_dotnet_root_directory(string__from_char_list(FileName))
+ ; use_windows_paths ->
+ strip_leading_win32_root_directory(FileName, [])
+ ;
+ FileName = [dir__directory_separator]
+ ).
+
+ % Win32 should really provide a function to do this.
+ % 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) :-
+ ( strip_leading_win32_drive_spec(!FileName) ->
+ true
;
- dir__split_name_2(FileName, N1, DirName, BaseName)
+ strip_leading_win32_unc_root_directory(!FileName)
).
-dir__basename(FileName, BaseName) :-
- dir__split_name(FileName, _, BaseName).
+ % Check for `C:\'.
+:- pred strip_leading_win32_drive_spec(list(char)::in,
+ list(char)::out) is semidet.
+
+strip_leading_win32_drive_spec([Letter, ':' | !.FileName], !:FileName) :-
+ char__is_alpha(Letter),
+ ( !.FileName = [dir__directory_separator | !:FileName] ->
+ true
+ ;
+ true
+ ).
+
+ % Check for `\\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) :-
+ Sep = dir__directory_separator,
+ list__takewhile(isnt(unify(Sep)), !.FileName,
+ Server, [Sep | !:FileName]),
+ Server \= [],
+ list__takewhile(isnt(unify(Sep)), !.FileName,
+ Share, !:FileName),
+ Share \= [],
+ ( !.FileName = [Sep | !:FileName]
+ ; !.FileName = []
+ ).
+
+:- pred is_dotnet_root_directory(string::in) is semidet.
-dir__dirname(FileName, DirName) :-
- dir__split_name(FileName, DirName, _).
+is_dotnet_root_directory(_) :-
+ error("dir.is_dotnet_root_directory called for non-.NET backend").
+
+:- pragma foreign_proc("C#", is_dotnet_root_directory(FileName::in),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"{
+ try {
+ SUCCESS_INDICATOR =
+ (System.IO.Path.IsPathRooted(FileName) &&
+ (System.IO.Path.GetDirectoryName(FileName) == null));
+ } catch (System.Exception e) {
+ SUCCESS_INDICATOR = false;
+ }
+}").
+
+%-----------------------------------------------------------------------------%
+
+dir__path_name_is_absolute(FileName) :-
+ ( use_windows_paths ->
+ strip_leading_win32_root_directory(
+ strip_repeated_dir_separators(
+ string__to_char_list(FileName)),
+ _)
+ ;
+ string__index(FileName, 0, dir__directory_separator)
+ ).
+
+:- pragma foreign_proc("C#", dir__path_name_is_absolute(FileName::in),
+ [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
+"
+ try {
+ SUCCESS_INDICATOR = System.IO.Path.IsPathRooted(FileName);
+ } catch (System.Exception e) {
+ SUCCESS_INDICATOR = false;
+ }
+").
+
+%-----------------------------------------------------------------------------%
dir__make_path_name(DirName, FileName) = PathName :-
% Using string__append_list has a fixed overhead of six
@@ -122,6 +385,757 @@
DirName / FileName = dir__make_path_name(DirName, FileName).
+%-----------------------------------------------------------------------------%
+
+dir__make_directory(PathName, Result, !IO) :-
+ ( can_implement_make_directory ->
+ DirName = dir__dirname(PathName),
+ ( DirName = dir__this_directory ->
+ ParentAccessResult = ok
+ ;
+ io__check_file_accessibility(DirName, [],
+ ParentAccessResult, !IO)
+ ),
+ (
+ ParentAccessResult = ok,
+ dir__make_directory_2(PathName, Result, !IO)
+ ;
+ ParentAccessResult = error(_),
+ dir__make_directory(DirName, ParentResult, !IO),
+ (
+ ParentResult = ok,
+ dir__make_directory_2(PathName,
+ Result, !IO)
+ ;
+ ParentResult = error(_),
+ Result = ParentResult
+ )
+ )
+ ;
+ Result = error(make_io_error(
+ "dir.make_directory not implemented on this platform"))
+ ).
+
+% The .NET library function System.IO.Directory.CreateDirectory()
+% creates the entire path in one call.
+:- pragma foreign_proc("C#",
+ dir__make_directory(DirName::in, Res::out,
+ _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
+"{
+ try {
+ // CreateDirectory doesn't fail if a file with the same
+ // name as the directory being created already exists.
+ if (System.IO.File.Exists(DirName)) {
+ mercury.dir.mercury_code.ML_make_mkdir_res_error(
+ new System.Exception(""a file with that name already exists""),
+ ref Res);
+ } else if (System.IO.Directory.Exists(DirName)) {
+ mercury.dir.mercury_code. ML_check_dir_accessibility(DirName,
+ ref Res);
+ } else {
+ System.IO.Directory.CreateDirectory(DirName);
+ Res = mercury.dir.mercury_code.ML_make_mkdir_res_ok();
+ }
+ } catch (System.Exception e) {
+ mercury.dir.mercury_code.ML_make_mkdir_res_error(e, ref Res);
+ }
+}").
+
+:- pred can_implement_make_directory is semidet.
+
+can_implement_make_directory :- semidet_fail.
+:- pragma foreign_proc("C", can_implement_make_directory,
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+#if defined(MR_WIN32)
+ SUCCESS_INDICATOR = MR_TRUE;
+#elif defined(MR_HAVE_MKDIR)
+ SUCCESS_INDICATOR = MR_TRUE;
+#else
+ SUCCESS_INDICATOR = MR_FALSE;
+#endif
+").
+:- pragma foreign_proc("C#", can_implement_make_directory,
+ [will_not_call_mercury, promise_pure, thread_safe],
+ "SUCCESS_INDICATOR = true;"
+).
+
+:- pred dir__make_directory_2(string::in, io__res::out,
+ io__state::di, io__state::uo) is det.
+
+:- pragma foreign_proc("C",
+ dir__make_directory_2(DirName::in, Result::out, IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
+"{
+#if defined(MR_WIN32)
+ int error;
+
+ if (CreateDirectory(DirName, NULL)) {
+ Result = ML_make_mkdir_res_ok();
+ } else if ((error = GetLastError()) == ERROR_ALREADY_EXISTS) {
+ ML_make_mkdir_res_exists(error, DirName, &Result);
+ } else {
+ ML_make_mkdir_res_error(error, &Result);
+ }
+#elif defined(MR_HAVE_MKDIR)
+ if (mkdir(DirName, 0777) == 0) {
+ Result = ML_make_mkdir_res_ok();
+ # ifdef EEXIST
+ } else if (errno == EEXIST) {
+ ML_make_mkdir_res_exists(errno, DirName, &Result);
+ # endif /* EEXIST */
+ } else {
+ ML_make_mkdir_res_error(errno, &Result);
+ }
+#else
+ MR_fatal_error(""dir.make_directory_2 called but not supported"");
+#endif
+ IO = IO0;
+}").
+
+:- func dir__make_mkdir_res_ok = io__res.
+:- pragma export((dir__make_mkdir_res_ok = out), "ML_make_mkdir_res_ok").
+
+dir__make_mkdir_res_ok = ok.
+
+:- pred dir__make_mkdir_res_error(io__system_error::in,
+ io__res::out, io__state::di, io__state::uo) is det.
+:- pragma export(dir__make_mkdir_res_error(in, out, di, uo),
+ "ML_make_mkdir_res_error").
+
+dir__make_mkdir_res_error(Error, error(make_io_error(Msg)), !IO) :-
+ io__make_maybe_win32_err_msg(Error,
+ "dir.make_directory failed: ", Msg, !IO).
+
+:- pred dir__make_mkdir_res_exists(io__system_error::in,
+ string::in, io__res::out, io__state::di, io__state::uo) is det.
+:- pragma export(dir__make_mkdir_res_exists(in, in, out, di, uo),
+ "ML_make_mkdir_res_exists").
+
+dir__make_mkdir_res_exists(Error, DirName, Res, !IO) :-
+ io__file_type(yes, DirName, TypeResult, !IO),
+ ( TypeResult = ok(directory) ->
+ dir__check_dir_accessibility(DirName,
+ Res, !IO)
+ ;
+ dir__make_mkdir_res_error(Error, Res, !IO)
+ ).
+
+:- pred dir__check_dir_accessibility(string::in, io__res::out,
+ io__state::di, io__state::uo) is det.
+:- pragma export(dir__check_dir_accessibility(in, out, di, uo),
+ "ML_check_dir_accessibility").
+
+dir__check_dir_accessibility(DirName, Res, !IO) :-
+ % Check whether we can read and write the directory.
+ io__check_file_accessibility(DirName,
+ [read, write, execute], Res, !IO).
+
+%-----------------------------------------------------------------------------%
+
+dir__foldl2(P, DirName, T, Res, !IO) :-
+ dir__foldl2_process_dir(no, P, DirName, [],
+ no, no, _, T, Res, !IO).
+
+dir__recursive_foldl2(P, DirName, FollowLinks, T, Res, !IO) :-
+ dir__foldl2_process_dir(no, P, DirName, [],
+ yes, FollowLinks, _, T, Res, !IO).
+
+:- pred dir__foldl2_process_dir(bool, dir__foldl_pred(T), string,
+ list(file_id), bool, bool, bool, T, io__maybe_partial_res(T),
+ io__state, io__state).
+:- mode dir__foldl2_process_dir(in, in(dir__foldl_pred), in, in, in, in,
+ out, in, out, di, uo) is det.
+
+dir__foldl2_process_dir(SymLinkParent, P, DirName, ParentIds0, Recursive,
+ FollowLinks, Continue, T0, Result, !IO) :-
+ ( can_implement_dir_foldl ->
+ (
+ Recursive = yes,
+ FollowLinks = yes
+ ->
+ check_for_symlink_loop(SymLinkParent, DirName,
+ LoopRes, ParentIds0, ParentIds, !IO)
+ ;
+ ParentIds = ParentIds0,
+ LoopRes = ok(no)
+ ),
+ (
+ LoopRes = ok(no),
+ dir__open(DirName, OpenResult, !IO),
+ (
+ OpenResult = ok({Pos0, FirstEntry}),
+
+ % We need to close the directory if an exception is
+ % thrown to avoid resource leaks.
+ promise_only_solution_io(
+ try_io_det(
+ (pred({Res, Pos1, Cont}::out,
+ !.IO::di, !:IO::uo) is det :-
+ dir__foldl2_process_entries(SymLinkParent,
+ P, DirName, ok(FirstEntry), ParentIds,
+ Recursive, FollowLinks, Cont,
+ T0, Res, Pos0, Pos1, !IO)
+ )), ExcpResult, !IO),
+ (
+ ExcpResult = succeeded({Result1, Pos, Continue0}),
+ dir__close(Pos, CloseResult, !IO),
+ (
+ CloseResult = ok,
+ Continue = Continue0,
+ Result = Result1
+ ;
+ CloseResult = error(Error),
+ Continue = no,
+ ( Result1 = ok(_), Result = error(T0, Error)
+ ; Result1 = error(_, _), Result = Result1
+ )
+ )
+ ;
+ ExcpResult = failed,
+ error("dir.foldl2 cannot fail, but it has.")
+ ;
+ ExcpResult = exception(_),
+ % XXX This is a bit dodgy because Pos0 is dead here,
+ % but we know dir.read_entry() destructively updates
+ % the position, so it should be OK. The position
+ % isn't allocated on the Mercury heap, so accurate GC
+ % won't move it.
+ dir__close(Pos0, _, !IO),
+ rethrow(ExcpResult)
+ )
+ ;
+ OpenResult = eof,
+ Continue = yes,
+ Result = ok(T0)
+ ;
+ OpenResult = error(Error),
+ Continue = no,
+ Result = error(T0, Error)
+ )
+ ;
+ LoopRes = ok(yes),
+
+ Continue = yes,
+ Result = ok(T0)
+ ;
+ LoopRes = error(Error),
+
+ Continue = no,
+ Result = error(T0, Error)
+ )
+ ;
+ Continue = no,
+ Result = error(T0,
+ make_io_error("dir.foldl2 not implemented on this platform"))
+ ).
+
+:- pred dir__foldl2_process_entries(bool, dir__foldl_pred(T),
+ string, io__result(string), list(file_id), bool, bool,
+ bool, T, io__maybe_partial_res(T), dir__pos, dir__pos,
+ io__state, io__state).
+:- mode dir__foldl2_process_entries(in, in(dir__foldl_pred),
+ in, in, in, in, in, out, in, out, in, out, di, uo) is det.
+
+dir__foldl2_process_entries(_, _, _, error(Error), _, _, _, no,
+ T0, error(T0, Error), !Pos, !IO).
+dir__foldl2_process_entries(_, _, _, eof, _, _, _, yes, T0, ok(T0), !Pos, !IO).
+dir__foldl2_process_entries(SymLinkParent, P, DirName, ok(FileName), ParentIds,
+ Recursive, FollowLinks, Continue, T0, Res, !Pos, !IO) :-
+ PathName = DirName/FileName,
+ io__file_type(no, PathName, FileTypeRes, !IO),
+ (
+ FileTypeRes = ok(Type),
+ P(DirName, FileName, Type, Continue1, T0, T1, !IO),
+ (
+ Continue1 = yes,
+ ( Recursive = yes, Type = directory ->
+ dir__foldl2_process_dir(SymLinkParent, P, PathName, ParentIds,
+ Recursive, FollowLinks, Continue2, T1, Res1, !IO)
+ ; Recursive = yes, Type = symbolic_link, FollowLinks = yes ->
+ io__file_type(yes, PathName, TargetTypeRes, !IO),
+ (
+ TargetTypeRes = ok(TargetType),
+ ( TargetType = directory ->
+ dir__foldl2_process_dir(yes, P, PathName, ParentIds,
+ Recursive, FollowLinks, Continue2, T1, Res1, !IO)
+ ;
+ Continue2 = yes,
+ Res1 = ok(T1)
+ )
+ ;
+ TargetTypeRes = error(TargetTypeError),
+ Continue2 = no,
+ Res1 = error(T1, TargetTypeError)
+ )
+ ;
+ Continue2 = yes,
+ Res1 = ok(T1)
+ ),
+ ( Continue2 = yes, Res1 = ok(T) ->
+ dir__read_entry(EntryResult, !Pos, !IO),
+ dir__foldl2_process_entries(SymLinkParent, P, DirName,
+ EntryResult, ParentIds, Recursive, FollowLinks,
+ Continue, T, Res, !Pos, !IO)
+ ;
+ Continue = no,
+ Res = Res1
+ )
+ ;
+ Continue1 = no,
+ Res = ok(T1),
+ Continue = no
+ )
+ ;
+ FileTypeRes = error(Error),
+ Continue = no,
+ Res = error(T0, Error)
+ ).
+
+ % Check whether we've 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(bool::in, string::in, io__res(bool)::out,
+ list(file_id)::in, list(file_id)::out,
+ io__state::di, io__state::uo) is det.
+
+check_for_symlink_loop(SymLinkParent, DirName, LoopRes, !ParentIds, !IO) :-
+ ( io__have_symlinks ->
+ io__file_id(DirName, IdRes, !IO),
+ (
+ IdRes = ok(Id),
+ (
+ SymLinkParent = yes,
+ list__member(Id, !.ParentIds)
+ ->
+ Loop = yes
+ ;
+ !:ParentIds = [Id | !.ParentIds],
+ Loop = no
+ ),
+ LoopRes = ok(Loop)
+ ;
+ IdRes = error(Msg),
+ LoopRes = error(Msg)
+ )
+ ;
+ LoopRes = ok(no)
+ ).
+
+% MS-Windows doesn't provide the POSIX directory functions.
+:- pragma foreign_decl("C", "
+
+#include ""mercury_string.h""
+#include ""mercury_types.h""
+
+#ifdef MR_WIN32
+ #include <windows.h>
+#endif
+
+/* For realpath */
+#include <stdlib.h>
+#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
+
+/* For PATH_MAX */
+#include <limits.h>
+#ifdef MR_HAVE_SYS_PARAM_H
+ #include <sys/param.h>
+#endif
+
+#if defined(MR_WIN32)
+ typedef HANDLE ML_DIR_POS;
+#elif defined(MR_HAVE_READDIR)
+ typedef DIR * ML_DIR_POS;
+#else
+ typedef MR_Integer ML_DIR_POS;
+#endif
+").
+
+:- type dir__pos ---> dir__pos.
+:- pragma foreign_type("C", dir__pos, "ML_DIR_POS").
+:- pragma foreign_type("il", dir__pos,
+ "class [mscorlib]System.Collections.IEnumerator").
+
+:- pred can_implement_dir_foldl is semidet.
+
+can_implement_dir_foldl :- semidet_fail.
+:- pragma foreign_proc("C", can_implement_dir_foldl,
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+#if defined(MR_HAVE_OPENDIR) && defined(MR_HAVE_READDIR) && defined(MR_HAVE_CLOSEDIR)
+ SUCCESS_INDICATOR = MR_TRUE;
+#elif defined(MR_WIN32)
+ SUCCESS_INDICATOR = MR_TRUE;
+#else
+ SUCCESS_INDICATOR = MR_FALSE;
+#endif
+").
+:- pragma foreign_proc("C#",
+ can_implement_dir_foldl,
+ [will_not_call_mercury, promise_pure, thread_safe],
+ "SUCCESS_INDICATOR = true;"
+).
+
+ % Win32 doesn't allow us to open a directory without
+ % returning the first item.
+:- pred dir__open(string, io__result({dir__pos, string}),
+ io__state, io__state).
+:- mode dir__open(in, out, di, uo) is det.
+
+dir__open(DirName, Res, !IO) :-
+ ( can_implement_dir_foldl ->
+ dir__open_2(DirName, Res, !IO)
+ ;
+ Res = error(
+ io__make_io_error("dir.foldl2 not implemented on this platform"))
+ ).
+
+
+:- pred dir__open_2(string, io__result({dir__pos, string}),
+ io__state, io__state).
+:- mode dir__open_2(in, out, di, uo) is det.
+
+:- pragma foreign_proc("C",
+ dir__open_2(DirName::in, Result::out, IO0::di, IO::uo),
+ [may_call_mercury, promise_pure, tabled_for_io, thread_safe],
+"{
+#if defined(MR_WIN32)
+ WIN32_FIND_DATA file_data;
+ ML_DIR_POS Pos;
+ LPTSTR FirstFileName;
+ char *dir_pattern;
+ int dir_pattern_len;
+ int is_readable;
+
+ ML_check_dir_readable(DirName, &is_readable, &Result);
+ if (is_readable) {
+ dir_pattern_len = strlen(DirName);
+ MR_allocate_aligned_string_msg(dir_pattern,
+ dir_pattern_len + 2, MR_PROC_LABEL);
+ strcpy(dir_pattern, DirName);
+ dir_pattern[dir_pattern_len] = '\\\\';
+ dir_pattern[dir_pattern_len + 1] = '*';
+ dir_pattern[dir_pattern_len + 2] = '\\0';
+
+ Pos = FindFirstFile(dir_pattern, &file_data);
+ if (Pos == INVALID_HANDLE_VALUE) {
+ int error = GetLastError();
+ if (error = ERROR_NO_MORE_FILES) {
+ Result = ML_make_dir_open_result_eof();
+ } else {
+ ML_make_dir_open_result_error(error, &Result);
+ }
+ } else {
+ ML_make_win32_dir_open_result_ok(Pos,
+ (MR_Word) file_data.cFileName, &Result);
+ }
+ MR_free_heap(dir_pattern);
+ }
+
+#elif defined(MR_HAVE_OPENDIR) && defined(MR_HAVE_READDIR) && defined(MR_HAVE_CLOSEDIR)
+ ML_DIR_POS Pos;
+
+ Pos = opendir(DirName);
+ if (Pos == NULL) {
+ ML_make_dir_open_result_error(errno, &Result);
+ } else {
+ ML_dir_read_first_entry(Pos, &Result);
+ }
+
+#else /* !MR_WIN32 && !(MR_HAVE_OPENDIR etc.) */
+ MR_fatal_error(""dir.open called but not supported"");
+#endif
+ IO = IO0;
+}").
+
+:- pragma foreign_proc("C#",
+ dir__open_2(DirName::in, Result::out, _IO0::di, _IO::uo),
+ [may_call_mercury, promise_pure, tabled_for_io, thread_safe],
+"{
+ try {
+ System.Collections.IEnumerator Pos =
+ System.IO.Directory.GetFileSystemEntries(DirName).
+ GetEnumerator();
+ mercury.dir.mercury_code.ML_dir_read_first_entry(Pos,
+ ref Result);
+ } catch (System.Exception e) {
+ mercury.dir.mercury_code.ML_make_dir_open_result_error(e,
+ ref Result);
+ }
+}").
+
+:- pred dir__check_dir_readable(string, int, io__result({dir__pos, string}),
+ io__state, io__state).
+:- mode dir__check_dir_readable(in, out, out, di, uo) is det.
+:- pragma export(dir__check_dir_readable(in, out, out, di, uo),
+ "ML_check_dir_readable").
+
+dir__check_dir_readable(DirName, IsReadable, Result, !IO) :-
+ io__file_type(yes, DirName, FileTypeRes, !IO),
+ (
+ FileTypeRes = ok(FileType),
+ ( FileType = directory ->
+ io__check_file_accessibility(DirName,
+ [read, execute], AccessResult, !IO),
+ (
+ AccessResult = ok,
+ IsReadable = 1,
+ % This will not be used.
+ Result = error(make_io_error("no error"))
+ ;
+ AccessResult = error(Msg),
+ IsReadable = 0,
+ Result = error(Msg)
+ )
+ ;
+ IsReadable = 0,
+ Result = error(make_io_error(
+ "dir.foldl2: pathname is not a directory"))
+
+ )
+ ;
+ FileTypeRes = error(Msg),
+ IsReadable = 0,
+ Result = error(Msg)
+ ).
+
+:- pred dir__read_first_entry(dir__pos, io__result({dir__pos, string}),
+ io__state, io__state).
+:- mode dir__read_first_entry(in, out, di, uo) is det.
+:- pragma export(dir__read_first_entry(in, out, di, uo),
+ "ML_dir_read_first_entry").
+
+dir__read_first_entry(Pos0, Result, !IO) :-
+ dir__read_entry(EntryResult, Pos0, Pos, !IO),
+ (
+ EntryResult = ok(FirstEntry),
+ Result = ok({Pos, FirstEntry})
+ ;
+ EntryResult = eof,
+ dir__close(Pos, CloseResult, !IO),
+ ( CloseResult = ok, Result = eof
+ ; CloseResult = error(Msg), Result = error(Msg)
+ )
+ ;
+ EntryResult = error(Msg),
+ Result = error(Msg)
+ ).
+
+:- pred make_win32_dir_open_result_ok(dir__pos::in, c_pointer::in,
+ io__result({dir__pos, string})::out,
+ io__state::di, io__state::uo) is det.
+:- pragma export(make_win32_dir_open_result_ok(in, in, out, di, uo),
+ "ML_make_win32_dir_open_result_ok").
+
+make_win32_dir_open_result_ok(Pos0, FirstFilePtr, Result, !IO) :-
+ FirstFile0 = copy_c_string(FirstFilePtr),
+ (
+ ( FirstFile0 = dir__this_directory
+ ; FirstFile0 = dir__parent_directory
+ )
+ ->
+ dir__read_entry(ReadResult, Pos0, Pos, !IO),
+ (
+ ReadResult = ok(FirstFile),
+ Result = ok({Pos, FirstFile})
+ ;
+ ReadResult = eof,
+ dir__close(Pos, CloseRes, !IO),
+ ( CloseRes = ok, Result = eof
+ ; CloseRes = error(Error), Result = error(Error)
+ )
+ ;
+ ReadResult = error(Error),
+ dir__close(Pos, _, !IO),
+ Result = error(Error)
+ )
+ ;
+ Result = ok({Pos0, FirstFile0})
+ ).
+
+ % This is needed because the heap pointer is not valid in
+ % the may_call_mercury foreign proc for dir.open_2.
+:- func copy_c_string(c_pointer) = string.
+copy_c_string(_) = _ :-
+ error(
+"dir.copy_c_string should only be called by code generated by C backends").
+:- pragma foreign_proc("C",
+ copy_c_string(Ptr::in) = (Str::out),
+ [promise_pure, will_not_call_mercury, thread_safe],
+ "MR_make_aligned_string_copy(Str, (char *) Ptr);").
+
+
+:- func make_dir_open_result_eof = io__result({dir__pos, string}).
+:- pragma export((make_dir_open_result_eof = out),
+ "ML_make_dir_open_result_eof").
+
+make_dir_open_result_eof = eof.
+
+:- pred make_dir_open_result_error(io__system_error::in,
+ io__result({dir__pos, string})::out,
+ io__state::di, io__state::uo) is det.
+:- pragma export(make_dir_open_result_error(in, out, di, uo),
+ "ML_make_dir_open_result_error").
+
+make_dir_open_result_error(Error, error(io__make_io_error(Msg))) -->
+ io__make_err_msg(Error, "dir.foldl2: opening directory failed: ", Msg).
+
+:- pred dir__close(dir__pos, io__res, io__state, io__state).
+:- mode dir__close(in, out, di, uo) is det.
+
+dir__close(Pos, Res, !IO) :-
+ dir__close_2(Pos, Status, Error, !IO),
+ ( Status = 0 ->
+ io__make_maybe_win32_err_msg(Error,
+ "dir.foldl2: closing directory failed: ", Msg, !IO),
+ Res = error(io__make_io_error(Msg))
+ ;
+ Res = ok
+ ).
+
+:- pred dir__close_2(dir__pos, int, io__system_error, io__state, io__state).
+:- mode dir__close_2(in, out, out, di, uo) is det.
+
+:- pragma foreign_proc("C",
+ dir__close_2(Pos::in, Status::out, Error::out, IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
+"{
+ IO = IO0;
+#if defined(MR_WIN32)
+ Status = FindClose(Pos);
+ Error = GetLastError();
+#elif defined(MR_HAVE_CLOSEDIR)
+ Status = (closedir(Pos) == 0);
+ Error = errno;
+#else
+ MR_fatal_error(""dir.open called but not supported"");
+#endif
+}").
+
+:- pragma foreign_proc("C#",
+ dir__close_2(_Pos::in, Status::out, Error::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
+"{
+ /* Nothing to do. */
+ Error = null;
+ Status = 1;
+}").
+
+:- pred dir__read_entry(io__result(string),
+ dir__pos, dir__pos, io__state, io__state).
+:- mode dir__read_entry(out, in, out, di, uo) is det.
+
+dir__read_entry(Res, !Pos, !IO) :-
+ dir__read_entry_2(Status, Error, FileName, !Pos, !IO),
+ (
+ Status = 0
+ ->
+ io__make_maybe_win32_err_msg(Error,
+ "dir.foldl2: reading directory entry failed: ", Msg, !IO),
+ Res = error(io__make_io_error(Msg))
+ ;
+ Status = -1
+ ->
+ Res = eof
+ ;
+ ( FileName = dir__this_directory
+ ; FileName = dir__parent_directory
+ )
+ ->
+ dir__read_entry(Res, !Pos, !IO)
+ ;
+ Res = ok(FileName)
+ ).
+
+ % dir__read_entry(Status, Error, FileName, !Pos, !IO).
+ % Status is -1 for EOF, 0 for error, 1 for success.
+:- pred dir__read_entry_2(int, io__system_error, string, dir__pos, dir__pos,
+ io__state, io__state).
+:- mode dir__read_entry_2(out, out, out, in, out, di, uo) is det.
+
+:- pragma foreign_proc("C",
+ dir__read_entry_2(Status::out, Error::out, FileName::out,
+ Pos0::in, Pos::out, IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
+"{
+#if defined(MR_WIN32)
+ WIN32_FIND_DATA file_data;
+
+ Pos = Pos0;
+ IO = IO0;
+ if (FindNextFile(Pos, &file_data)) {
+ Status = 1;
+ MR_make_aligned_string_copy(FileName,
+ file_data.cFileName);
+ } else {
+ Error = GetLastError();
+ Status = (Error == ERROR_NO_MORE_FILES ? -1 : 0);
+ FileName = NULL;
+ }
+
+#elif defined(MR_HAVE_READDIR) && defined(MR_HAVE_CLOSEDIR)
+ struct dirent *dir_entry;
+
+ Pos = Pos0;
+ IO = IO0;
+ errno = 0;
+ dir_entry = readdir(Pos);
+ if (dir_entry == NULL) {
+ Error = errno;
+ FileName = NULL;
+ Status = (Error == 0 ? -1 : 0);
+ } else {
+ MR_make_aligned_string_copy(FileName,
+ dir_entry->d_name);
+ Error = 0;
+ Status = 1;
+ }
+
+#else /* !MR_WIN32 && !(MR_HAVE_READDIR etc.) */
+ MR_fatal_error(""dir.read_entry_2 called but not supported"");
+#endif
+}").
+
+:- pragma foreign_proc("C#",
+ dir__read_entry_2(Status::out, Error::out, FileName::out,
+ Pos0::in, Pos::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
+"{
+ Pos = Pos0;
+ try {
+ if (Pos.MoveNext()) {
+ // .NET returns path names qualified with
+ // the directory name passed to dir.open.
+ FileName = System.IO.Path.GetFileName(
+ (string) Pos.Current);
+ Status = 1;
+ } else {
+ FileName = null;
+ Status = -1;
+ }
+ Error = null;
+ } catch (System.Exception e) {
+ Error = e;
+ Pos = null;
+ FileName = null;
+ Status = 0;
+ }
+}").
+
+%-----------------------------------------------------------------------------%
+
expand_braces(ArgStr) = ExpandStrs :-
ArgChar = string__to_char_list(ArgStr),
ExpandChars = expand(ArgChar),
@@ -201,19 +1215,19 @@
list__append(CurAlternative, [Char]),
BraceLevel, Alternatives, Left)
).
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
% Ralph Becket <rwab1 at cl.cam.ac.uk> 27/04/99
% Functional forms added.
-dir__directory_separator = C :-
- dir__directory_separator(C).
+dir__directory_separator(dir__directory_separator).
+
+dir__this_directory(dir__this_directory).
+
+dir__parent_directory(dir__parent_directory).
-dir__this_directory = S :-
- dir__this_directory(S).
+dir__basename(S, dir__basename(S)).
-dir__basename(S1) = S2 :-
- dir__basename(S1, S2).
+dir__dirname(S, dir__dirname(S)).
-dir__dirname(S1) = S2 :-
- dir__dirname(S1, S2).
Index: library/exception.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/exception.m,v
retrieving revision 1.77
diff -u -u -r1.77 exception.m
--- library/exception.m 29 May 2003 12:08:25 -0000 1.77
+++ library/exception.m 12 Jun 2003 15:30:18 -0000
@@ -62,6 +62,11 @@
:- mode try(pred(out) is cc_multi, out(cannot_fail)) is cc_multi.
:- mode try(pred(out) is cc_nondet, out) is cc_multi.
+% As above. This version has only one mode, so it can be passed
+% as a closure (e.g. to builtin.promise_only_solution).
+:- pred try_det(pred(T), exception_result(T)).
+:- mode try_det(pred(out) is det, out(cannot_fail)) is cc_multi.
+
%
% try_io(Goal, Result, IO_0, IO):
% Operational semantics:
@@ -83,6 +88,13 @@
:- mode try_io(pred(out, di, uo) is cc_multi,
out(cannot_fail), di, uo) is cc_multi.
+% As above. This version has only one mode, so it can be passed
+% as a closure (e.g. to builtin.promise_only_solution_io).
+:- pred try_io_det(pred(T, io__state, io__state),
+ exception_result(T), io__state, io__state).
+:- mode try_io_det(pred(out, di, uo) is det,
+ out(cannot_fail), di, uo) is cc_multi.
+
%
% try_store(Goal, Result, Store_0, Store):
% Just like try_io, but for stores rather than io__states.
@@ -94,6 +106,13 @@
:- mode try_store(pred(out, di, uo) is cc_multi,
out(cannot_fail), di, uo) is cc_multi.
+% As above. This version has only one mode, so it can be passed
+% as a closure (e.g. to builtin.promise_only_solution_io).
+:- pred try_store_det(pred(T, store(S), store(S)),
+ exception_result(T), store(S), store(S)).
+:- mode try_store_det(pred(out, di, uo) is det,
+ out(cannot_fail), di, uo) is cc_multi.
+
%
% try_all(Goal, ResultList):
% Operational semantics:
@@ -318,6 +337,8 @@
builtin_catch(wrap_success_or_failure(Goal), wrap_exception, Result).
*********************/
+try_det(Goal, Result) :- try(Goal, Result).
+
try(Goal, Result) :-
get_determinism(Goal, Detism),
try(Detism, Goal, Result).
@@ -392,6 +413,8 @@
% We need to switch on the Detism argument
% for the same reason as above.
+try_store_det(StoreGoal, Result) --> try_store(StoreGoal, Result).
+
try_store(StoreGoal, Result) -->
{ get_determinism_2(StoreGoal, Detism) },
try_store(Detism, StoreGoal, Result).
@@ -436,6 +459,8 @@
% the store was from the goal which just threw an exception.
unsafe_promise_unique(Store0, Store)
).
+
+try_io_det(IO_Goal, Result) --> try_io(IO_Goal, Result).
try_io(IO_Goal, Result) -->
{ get_determinism_2(IO_Goal, Detism) },
Index: library/io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.298
diff -u -u -r1.298 io.m
--- library/io.m 29 May 2003 12:08:25 -0000 1.298
+++ library/io.m 12 Jun 2003 15:30:18 -0000
@@ -1,4 +1,4 @@
-%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------r
% Copyright (C) 1993-2003 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
@@ -24,7 +24,7 @@
:- module io.
:- interface.
-:- import_module char, string, std_util, list, time, deconstruct.
+:- import_module bool, char, string, std_util, list, time, deconstruct.
%-----------------------------------------------------------------------------%
@@ -173,6 +173,20 @@
% Applies the given closure to each character read from
% the input stream in turn, until eof or error.
+:- pred io__input_stream_foldl2_io_maybe_stop(
+ pred(char, bool, T, T, io__state, io__state),
+ T, io__maybe_partial_res(T), io__state, io__state).
+:- mode io__input_stream_foldl2_io_maybe_stop(
+ (pred(in, out, in, out, di, uo) is det),
+ in, out, di, uo) is det.
+:- mode io__input_stream_foldl2_io_maybe_stop(
+ (pred(in, out, in, out, di, uo) is cc_multi),
+ in, out, di, uo) is cc_multi.
+% Applies the given closure to each character read from
+% the input stream in turn, until eof or error, or the
+% closure returns `no' as its second argument.
+
+
:- pred io__putback_char(char, io__state, io__state).
:- mode io__putback_char(in, di, uo) is det.
% Un-reads a character from the current input stream.
@@ -247,6 +261,19 @@
% Applies the given closure to each character read from
% the input stream in turn, until eof or error.
+:- pred io__input_stream_foldl2_io_maybe_stop(io__input_stream,
+ pred(char, bool, T, T, io__state, io__state),
+ T, io__maybe_partial_res(T), io__state, io__state).
+:- mode io__input_stream_foldl2_io_maybe_stop(in,
+ (pred(in, out, in, out, di, uo) is det),
+ in, out, di, uo) is det.
+:- mode io__input_stream_foldl2_io_maybe_stop(in,
+ (pred(in, out, in, out, di, uo) is cc_multi),
+ in, out, di, uo) is cc_multi.
+% Applies the given closure to each character read from
+% the input stream in turn, until eof or error, or the
+% closure returns `no' as its second argument.
+
:- pred io__putback_char(io__input_stream, char, io__state, io__state).
:- mode io__putback_char(in, in, di, uo) is det.
% Un-reads a character from specified stream.
@@ -774,6 +801,19 @@
% Applies the given closure to each byte read from the
% current binary input stream in turn, until eof or error.
+:- pred io__binary_input_stream_foldl2_io_maybe_stop(
+ pred(int, bool, T, T, io__state, io__state),
+ T, io__maybe_partial_res(T), io__state, io__state).
+:- mode io__binary_input_stream_foldl2_io_maybe_stop(
+ (pred(in, out, in, out, di, uo) is det),
+ in, out, di, uo) is det.
+:- mode io__binary_input_stream_foldl2_io_maybe_stop(
+ (pred(in, out, in, out, di, uo) is cc_multi),
+ in, out, di, uo) is cc_multi.
+% Applies the given closure to each byte read from the
+% current binary input stream in turn, until eof or error,
+% or the closure returns `no' as its second argument.
+
:- pred io__binary_input_stream_foldl(io__binary_input_stream,
pred(int, T, T), T, io__maybe_partial_res(T),
io__state, io__state).
@@ -806,6 +846,20 @@
% Applies the given closure to each byte read from the
% given binary input stream in turn, until eof or error.
+:- pred io__binary_input_stream_foldl2_io_maybe_stop(
+ io__binary_input_stream,
+ pred(int, bool, T, T, io__state, io__state),
+ T, io__maybe_partial_res(T), io__state, io__state).
+:- mode io__binary_input_stream_foldl2_io_maybe_stop(in,
+ (pred(in, out, in, out, di, uo) is det),
+ in, out, di, uo) is det.
+:- mode io__binary_input_stream_foldl2_io_maybe_stop(in,
+ (pred(in, out, in, out, di, uo) is cc_multi),
+ in, out, di, uo) is cc_multi.
+% Applies the given closure to each byte read from the
+% given binary input stream in turn, until eof or error,
+% or the closure returns `no' as its second argument.
+
:- pred io__putback_byte(int, io__state, io__state).
:- mode io__putback_byte(in, di, uo) is det.
% Un-reads a byte from the current binary input stream.
@@ -1141,6 +1195,54 @@
% on some systems, the file previously named `NewFileName' will be
% deleted and replaced with the file previously named `OldFileName'.
+:- pred io__have_symlinks is semidet.
+ % Does the platform support symbolic links.
+
+:- pred io__make_symlink(string, string, io__res, io__state, io__state).
+:- mode io__make_symlink(in, in, out, di, uo) is det.
+ % io__make_symlink(FileName, LinkFileName, Result, IO0, IO)
+ % attempts to make `LinkFileName' be a symbolic link to `FileName'.
+
+:- pred io__follow_symlink(string, io__res(string), io__state, io__state).
+:- mode io__follow_symlink(in, out, di, uo) is det.
+ % io__follow_symlink(FileName, Result, IO0, IO) returns
+ % `ok(LinkTarget)' if FileName is a symbolic link pointing
+ % to LinkTarget, and `error(Error)' otherwise.
+
+:- type io__access_type
+ ---> read
+ ; write
+ ; execute
+ .
+
+:- pred io__check_file_accessibility(string, list(access_type),
+ io__res, io__state, io__state).
+:- mode io__check_file_accessibility(in, in, out, di, uo) is det.
+ % io__check_file_accessibility(FileName, AccessTypes, Result)
+ % Check whether the current user can access the given file.
+
+:- type io__file_type
+ ---> regular_file
+ ; directory
+ ; symbolic_link
+ ; named_pipe
+ ; socket
+ ; character_device
+ ; block_device
+ ; message_queue
+ ; semaphore
+ ; shared_memory
+ ; unknown
+ .
+
+:- pred io__file_type(bool, string, io__res(file_type), io__state, io__state).
+:- mode io__file_type(in, in, out, di, uo) is det.
+ % io__file_type(FollowSymLinks, FileName, TypeResult)
+ % finds the type of the given file.
+ % This predicate will only work on systems which provide
+ % the POSIX C library function stat(). On other systems the
+ % returned result will always be bound to error/1.
+
:- pred io__file_modification_time(string, io__res(time_t),
io__state, io__state).
:- mode io__file_modification_time(in, out, di, uo) is det.
@@ -1301,6 +1403,62 @@
%-----------------------------------------------------------------------------%
:- interface.
+% For use by dir.m:
+
+ % A system-dependent error indication.
+ % For C, this is the value of errno or the result of
+ % GetLastError() on Win32.
+:- type io__system_error.
+:- pragma foreign_type(c, io__system_error, "MR_Integer").
+:- pragma foreign_type(il, io__system_error,
+ "class [mscorlib]System.Exception").
+
+% io__make_err_msg(Error, MessagePrefix, Message):
+% `Message' is an error message obtained by looking up the
+% message for the given errno value and prepending
+% `MessagePrefix'.
+:- pred io__make_err_msg(io__system_error, string, string,
+ io__state, io__state).
+:- mode io__make_err_msg(in, in, out, di, uo) is det.
+
+% Succeeds iff the Win32 API is available.
+:- pred have_win32 is semidet.
+
+% Succeeds iff the .NET class library is available.
+:- pred have_dotnet is semidet.
+
+% io__make_win32_err_msg(Error, MessagePrefix, Message):
+% `Message' is an error message obtained by looking up the
+% error message for the given Win32 error number and prepending
+% `MessagePrefix'.
+% This will abort if called on a system which does not support
+% the Win32 API.
+:- pred io__make_win32_err_msg(io__system_error,
+ string, string, io__state, io__state).
+:- mode io__make_win32_err_msg(in, in, out, di, uo) is det.
+
+% io__make_maybe_win32_err_msg(Error, MessagePrefix, Message):
+% `Message' is an error message obtained by looking up the
+% last Win32 error message and prepending `MessagePrefix'.
+% On non-Win32 systems, the message corresponding to the
+% current value of errno will be used.
+:- pred io__make_maybe_win32_err_msg(io__system_error,
+ string, string, io__state, io__state).
+:- mode io__make_maybe_win32_err_msg(in, in, out, di, uo) is det.
+
+% io__file_id(FileName, FileId).
+%
+% Return a unique identifier for the given file.
+% XXX On Cygwin sometimes two files will have the same file_id.
+% This is because MS-Windows does not use inodes, so Cygwin
+% hashes the absolute file name.
+:- type file_id.
+:- pred io__file_id(string, io__res(file_id), io__state, io__state).
+:- mode io__file_id(in, out, di, uo) is det.
+
+% Succeeds if io__file_id is implemented on this platform.
+:- pred io__have_file_ids is semidet.
+
% For use by term_io.m:
:- import_module ops.
@@ -1885,6 +2043,31 @@
{ Res = error(T0, Error) }
).
+io__input_stream_foldl2_io_maybe_stop(Pred, T0, Res) -->
+ io__input_stream(Stream),
+ io__input_stream_foldl2_io_maybe_stop(Stream, Pred, T0, Res).
+
+io__input_stream_foldl2_io_maybe_stop(Stream, Pred, T0, Res) -->
+ io__read_char(Stream, CharResult),
+ (
+ { CharResult = ok(Char) },
+ Pred(Char, Continue, T0, T1),
+ (
+ { Continue = no },
+ { Res = ok(T1) }
+ ;
+ { Continue = yes },
+ io__input_stream_foldl2_io_maybe_stop(Stream,
+ Pred, T1, Res)
+ )
+ ;
+ { CharResult = eof },
+ { Res = ok(T0) }
+ ;
+ { CharResult = error(Error) },
+ { Res = error(T0, Error) }
+ ).
+
%-----------------------------------------------------------------------------%
:- pred io__clear_err(stream, io__state, io__state).
@@ -1943,7 +2126,7 @@
RetVal = -1;
}
- ML_maybe_make_err_msg(RetVal != 0, ""read failed: "",
+ ML_maybe_make_err_msg(RetVal != 0, errno, ""read failed: "",
MR_PROC_LABEL, RetStr);
MR_update_io(IO0, IO);
}").
@@ -1957,28 +2140,88 @@
MR_update_io(IO0, IO);
}").
-% io__make_err_msg(MessagePrefix, Message):
-% `Message' is an error message obtained by looking up the
-% message for the current value of errno and prepending
-% `MessagePrefix'.
:- pred io__make_err_msg(string, string, io__state, io__state).
:- mode io__make_err_msg(in, out, di, uo) is det.
+io__make_err_msg(Msg0, Msg) -->
+ io__get_system_error(Error),
+ io__make_err_msg(Error, Msg0, Msg).
+
+:- pred io__get_system_error(io__system_error, io__state, io__state).
+:- mode io__get_system_error(out, di, uo) is det.
+
+:- pragma foreign_proc("C",
+ io__get_system_error(Error::out, IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
+"{
+ Error = errno;
+ MR_update_io(IO0, IO);
+}").
+
+:- pragma foreign_proc("MC++",
+ io__get_system_error(Error::out, IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
+"{
+ Error = MR_io_exception;
+ MR_update_io(IO0, IO);
+}").
+
+:- pragma export(make_err_msg(in, in, out, di, uo), "ML_make_err_msg").
:- pragma foreign_proc("C",
- make_err_msg(Msg0::in, Msg::out, IO0::di, IO::uo),
+ make_err_msg(Error::in, Msg0::in, Msg::out, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io],
"{
- ML_maybe_make_err_msg(MR_TRUE, Msg0, MR_PROC_LABEL, Msg);
+ ML_maybe_make_err_msg(MR_TRUE, Error, Msg0, MR_PROC_LABEL, Msg);
MR_update_io(IO0, IO);
}").
:- pragma foreign_proc("MC++",
- make_err_msg(Msg0::in, Msg::out, _IO0::di, _IO::uo),
+ make_err_msg(Error::in, Msg0::in, Msg::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure],
"{
- Msg = System::String::Concat(Msg0, MR_io_exception->Message);
+ Msg = System::String::Concat(Msg0, Error->Message);
}").
+have_win32 :- semidet_fail.
+
+:- pragma foreign_proc("C",
+ have_win32,
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+#ifdef MR_WIN32
+ SUCCESS_INDICATOR = MR_TRUE;
+#else
+ SUCCESS_INDICATOR = MR_FALSE;
+#endif
+").
+
+have_dotnet :- semidet_fail.
+
+:- pragma foreign_proc("C#",
+ have_dotnet,
+ [will_not_call_mercury, promise_pure, thread_safe],
+ "SUCCESS_INDICATOR = true;").
+
+:- pragma export(make_win32_err_msg(in, in, out, di, uo),
+ "ML_make_win32_err_msg").
+
+make_win32_err_msg(_, _, _, _, _) :-
+ error("io__make_win32_err_msg called for non Win32 back-end").
+
+:- pragma foreign_proc("C",
+ make_win32_err_msg(Error::in, Msg0::in, Msg::out, IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
+"{
+ ML_maybe_make_win32_err_msg(MR_TRUE, Error, Msg0, MR_PROC_LABEL, Msg);
+ MR_update_io(IO0, IO);
+}").
+
+make_maybe_win32_err_msg(Error, Msg0, Msg, !IO) :-
+ ( have_win32 ->
+ make_win32_err_msg(Error, Msg0, Msg, !IO)
+ ;
+ make_err_msg(Error, Msg0, Msg, !IO)
+ ).
%-----------------------------------------------------------------------------%
@@ -1995,6 +2238,7 @@
#ifdef MR_HAVE_SYS_STAT_H
#include <sys/stat.h>
#endif
+#include ""mercury_types.h"" /* for MR_Integer */
").
:- pragma foreign_proc("C",
@@ -2062,7 +2306,7 @@
Msg = MR_string_const("""", 0);
Status = 1;
} else {
- ML_maybe_make_err_msg(MR_TRUE, ""stat() failed: "",
+ ML_maybe_make_err_msg(MR_TRUE, errno, ""stat() failed: "",
MR_PROC_LABEL, Msg);
Status = 0;
}
@@ -2074,15 +2318,451 @@
MR_update_io(IO0, IO);
}").
+
+%-----------------------------------------------------------------------------%
+
+io__file_type(FollowSymLinks, FileName, MaybeType) -->
+ ( { file_type_implemented } ->
+ { FollowSymLinksInt = ( FollowSymLinks = yes -> 1 ; 0 ) },
+ io__file_type_2(FollowSymLinksInt, FileName, MaybeType)
+ ;
+ { MaybeType = error(io__make_io_error(
+ "Sorry, io.file_type not implemented on this platform")) }
+ ).
-io__file_modification_time_2(_FileName, Status, Msg, Time) -->
- % This version is only used for back-ends for which there is no
- % matching foreign_proc version.
- { Status = 0 },
- { Msg = "io__file_modification_time not implemented for this target "
- ++ "(or compiler back-end)" },
- % This value will not be used
- { Time = rtti_implementation.unsafe_cast(0) }.
+:- pred file_type_implemented is semidet.
+
+file_type_implemented :- semidet_fail.
+:- pragma foreign_proc("C", file_type_implemented,
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+#ifdef MR_HAVE_STAT
+ SUCCESS_INDICATOR = MR_TRUE;
+#else
+ SUCCESS_INDICATOR = MR_FALSE;
+#endif
+").
+:- pragma foreign_proc("C#", file_type_implemented,
+ [will_not_call_mercury, promise_pure, thread_safe],
+ "SUCCESS_INDICATOR = true;"
+).
+
+:- pred io__file_type_2(int, string, io__res(io__file_type),
+ io__state, io__state).
+:- mode io__file_type_2(in, in, out, di, uo) is det.
+
+:- pragma foreign_proc("C",
+ io__file_type_2(FollowSymLinks::in, FileName::in,
+ Result::out, IO0::di, IO::uo),
+ [may_call_mercury, promise_pure, tabled_for_io, thread_safe],
+"{
+#ifdef MR_HAVE_STAT
+ struct stat s;
+ int stat_result;
+
+ if (FollowSymLinks == 1) {
+ stat_result = stat(FileName, &s);
+ } else {
+ #ifdef MR_HAVE_LSTAT
+ stat_result = lstat(FileName, &s);
+ #else
+ stat_result = stat(FileName, &s);
+ #endif
+ }
+
+ if (stat_result == 0) {
+ MR_Word type;
+
+ #if defined(S_ISREG)
+ if (S_ISREG(s.st_mode)) {
+ type = ML_file_type_regular();
+ } else
+ #elif defined(S_IFMT) && defined(S_IFREG)
+ if ((s.st_mode & S_IFMT) == S_IFREG) {
+ type = ML_file_type_regular();
+ } else
+ #endif
+
+ #if defined(S_ISDIR)
+ if (S_ISDIR(s.st_mode)) {
+ type = ML_file_type_directory();
+ } else
+ #elif defined(S_IFMT) && defined(S_IFDIR)
+ if ((s.st_mode & S_IFMT) == S_IFDIR) {
+ type = ML_file_type_directory();
+ } else
+ #endif
+
+ #if defined(S_ISBLK)
+ if (S_ISBLK(s.st_mode)) {
+ type = ML_file_type_block_device();
+ } else
+ #elif defined(S_IFMT) && defined(S_IFBLK)
+ if ((s.st_mode & S_IFMT) == S_IFBLK) {
+ type = ML_file_type_block_device();
+ } else
+ #endif
+
+ #if defined(S_ISCHR)
+ if (S_ISCHR(s.st_mode)) {
+ type = ML_file_type_character_device();
+ } else
+ #elif defined(S_IFMT) && defined(S_IFCHR)
+ if ((s.st_mode & S_IFMT) == S_IFCHR) {
+ type = ML_file_type_character_device();
+ } else
+ #endif
+
+ #if defined(S_ISFIFO)
+ if (S_ISFIFO(s.st_mode)) {
+ type = ML_file_type_fifo();
+ } else
+ #elif defined(S_IFMT) && defined(S_IFIFO)
+ if ((s.st_mode & S_IFMT) == S_IFIFO) {
+ type = ML_file_type_fifo();
+ } else
+ #endif
+
+ #if defined(S_ISLNK)
+ if (S_ISLNK(s.st_mode)) {
+ type = ML_file_type_symbolic_link();
+ } else
+ #elif defined(S_IFMT) && defined(S_IFLNK)
+ if ((s.st_mode & S_IFMT) == S_IFLNK) {
+ type = ML_file_type_symbolic_link();
+ } else
+ #endif
+
+ #if defined(S_ISSOCK)
+ if (S_ISSOCK(s.st_mode)) {
+ type = ML_file_type_socket();
+ } else
+ #elif defined(S_IFMT) && defined(S_IFSOCK)
+ if ((s.st_mode & S_IFMT) == S_IFSOCK) {
+ type = ML_file_type_socket();
+ } else
+ #endif
+
+ #ifdef S_TYPEISMQ
+ if (S_TYPEISMQ(&s)) {
+ type = ML_file_type_message_queue();
+ } else
+ #endif
+
+ #ifdef S_TYPEISSEM
+ if (S_TYPEISSEM(&s)) {
+ type = ML_file_type_semaphore();
+ } else
+ #endif
+
+ #ifdef S_TYPEISSHM
+ if (S_TYPEISSHM(&s)) {
+ type = ML_file_type_shared_memory();
+ } else
+ #endif
+
+ {
+ type = ML_file_type_unknown();
+ }
+
+ Result = ML_make_io_res_1_ok_file_type(type);
+ } else {
+ /*
+ ** We can't just call ML_make_err_msg here because
+ ** it uses `hp' and this procedure can call Mercury.
+ */
+ ML_make_io_res_1_error_file_type(errno,
+ MR_make_string_const(""io.file_type failed: ""),
+ &Result);
+ }
+#else
+ MR_fatal_error(
+ ""Sorry, io.file_type not implemented on this platform"") }
+#endif
+ MR_update_io(IO0, IO);
+}").
+
+:- pragma foreign_proc("C#",
+ io__file_type_2(_FollowSymLinks::in, FileName::in,
+ Result::out, _IO0::di, _IO::uo),
+ [may_call_mercury, promise_pure, tabled_for_io, thread_safe],
+"
+ try {
+ System.IO.FileAttributes attrs =
+ System.IO.File.GetAttributes(FileName);
+ if ((attrs & System.IO.FileAttributes.Directory) ==
+ System.IO.FileAttributes.Directory)
+ {
+ Result = mercury.io.mercury_code.ML_make_io_res_1_ok_file_type(
+ mercury.io.mercury_code.ML_file_type_directory());
+ }
+ else if ((attrs & System.IO.FileAttributes.Device) ==
+ System.IO.FileAttributes.Device)
+ {
+ // XXX It may be a block device, but .NET doesn't
+ // distinguish between character and block devices.
+ Result = mercury.io.mercury_code.ML_make_io_res_1_ok_file_type(
+ mercury.io.mercury_code.ML_file_type_character_device());
+ }
+ else
+ {
+ Result = mercury.io.mercury_code.ML_make_io_res_1_ok_file_type(
+ mercury.io.mercury_code.ML_file_type_regular());
+ }
+ } catch (System.Exception e) {
+ mercury.io.mercury_code.ML_make_io_res_1_error_file_type(e,
+ ""can't find file type: "", ref Result);
+ }
+").
+
+:- func file_type_character_device = file_type.
+:- func file_type_block_device = file_type.
+:- func file_type_fifo = file_type.
+:- func file_type_directory = file_type.
+:- func file_type_socket = file_type.
+:- func file_type_symbolic_link = file_type.
+:- func file_type_regular = file_type.
+:- func file_type_message_queue = file_type.
+:- func file_type_semaphore = file_type.
+:- func file_type_shared_memory = file_type.
+:- func file_type_unknown = file_type.
+
+file_type_character_device = character_device.
+file_type_block_device = block_device.
+file_type_fifo = named_pipe.
+file_type_directory = directory.
+file_type_socket = socket.
+file_type_symbolic_link = symbolic_link.
+file_type_regular = regular_file.
+file_type_message_queue = message_queue.
+file_type_semaphore = semaphore.
+file_type_shared_memory = shared_memory.
+file_type_unknown = unknown.
+
+:- pragma export(file_type_character_device = out,
+ "ML_file_type_character_device").
+:- pragma export(file_type_block_device = out, "ML_file_type_block_device").
+:- pragma export(file_type_fifo = out, "ML_file_type_fifo").
+:- pragma export(file_type_directory = out, "ML_file_type_directory").
+:- pragma export(file_type_socket = out, "ML_file_type_socket").
+:- pragma export(file_type_symbolic_link = out, "ML_file_type_symbolic_link").
+:- pragma export(file_type_regular = out, "ML_file_type_regular").
+:- pragma export(file_type_message_queue = out, "ML_file_type_message_queue").
+:- pragma export(file_type_semaphore = out, "ML_file_type_semaphore").
+:- pragma export(file_type_shared_memory = out, "ML_file_type_shared_memory").
+:- pragma export(file_type_unknown = out, "ML_file_type_unknown ").
+
+%-----------------------------------------------------------------------------%
+
+:- pragma foreign_proc("C",
+ io__check_file_accessibility(FileName::in, AccessTypes::in,
+ Result::out, IO0::di, IO::uo),
+ [may_call_mercury, promise_pure, tabled_for_io, thread_safe],
+"{
+#if defined(MR_HAVE_ACCESS)
+ #ifdef F_OK
+ int mode = F_OK;
+ #else
+ int mode = 0;
+ #endif
+ int access_result;
+
+ if (ML_access_types_includes_execute(AccessTypes)) {
+ #ifdef X_OK
+ mode |= X_OK;
+ #else
+ mode |= 1;
+ #endif
+ }
+ if (ML_access_types_includes_write(AccessTypes)) {
+ #ifdef W_OK
+ mode |= W_OK;
+ #else
+ mode |= 2;
+ #endif
+ }
+ if (ML_access_types_includes_read(AccessTypes)) {
+ #ifdef R_OK
+ mode |= R_OK;
+ #else
+ mode |= 4;
+ #endif
+ }
+
+ access_result = access(FileName, mode);
+ if (access_result == 0) {
+ Result = ML_make_io_res_0_ok();
+ } else {
+ ML_make_io_res_0_error(errno,
+ MR_make_string_const(
+ ""file not accessible: ""),
+ &Result);
+ }
+#else /* !MR_HAVE_ACCESS */
+ Result = ML_make_io_res_0_error_msg(
+ ""io.check_file_accessibility not supported on this platform"");
+#endif
+ IO = IO0;
+}").
+
+:- pragma foreign_decl("MC++",
+"
+#include <io.h> /* for access() */
+#include <errno.h>
+#include <string.h> /* for strerror() */
+
+").
+
+% The .NET class library doesn't provide any way to check the
+% accessibility of a file without opening it, so instead we
+% use the POSIX access() function, which is also supported by
+% Windows.
+% We use MC++ here rather than C# because it's easier to
+% access system functions (it would be difficult to access
+% `errno' from C#).
+:- pragma foreign_proc("MC++",
+ io__check_file_accessibility(FileName::in, AccessTypes::in,
+ Result::out, _IO0::di, _IO::uo),
+ [may_call_mercury, promise_pure, tabled_for_io, thread_safe],
+"{
+ int mode = 0;
+
+ if (mercury::io::mercury_code::ML_access_types_includes_execute(
+ AccessTypes))
+ {
+ mode |= 1;
+ }
+ if (mercury::io::mercury_code::ML_access_types_includes_write(
+ AccessTypes))
+ {
+ mode |= 2;
+ }
+ if (mercury::io::mercury_code::ML_access_types_includes_read(
+ AccessTypes))
+ {
+ mode |= 4;
+ }
+
+ char __nogc *c_filename = static_cast<char*>(
+ System::Runtime::InteropServices::Marshal::
+ StringToHGlobalAnsi(FileName).ToPointer());
+
+ int access_result = access(c_filename, mode);
+ System::Runtime::InteropServices::Marshal::FreeCoTaskMem(c_filename);
+ if (access_result == 0) {
+ Result = mercury::io::mercury_code::ML_make_io_res_0_ok();
+ } else {
+ char __nogc *error_string = strerror(errno);
+ System::String *error_msg =
+ System::Runtime::InteropServices::Marshal::PtrToStringAnsi(
+ static_cast<System::IntPtr>(error_string));
+ Result = mercury::io::mercury_code::ML_make_io_res_0_error_msg(
+ System::String::Concat(""file not accessible: "",
+ error_msg));
+ }
+}").
+
+:- pred access_types_includes_read(list(access_type)::in) is semidet.
+:- pragma export(access_types_includes_read(in),
+ "ML_access_types_includes_read").
+access_types_includes_read(Access) :- list__member(read, Access).
+
+:- pred access_types_includes_write(list(access_type)::in) is semidet.
+:- pragma export(access_types_includes_write(in),
+ "ML_access_types_includes_write").
+access_types_includes_write(Access) :- list__member(write, Access).
+
+:- pred access_types_includes_execute(list(access_type)::in) is semidet.
+:- pragma export(access_types_includes_execute(in),
+ "ML_access_types_includes_execute").
+access_types_includes_execute(Access) :- list__member(execute, Access).
+
+:- func make_io_res_0_ok = io__res.
+:- pragma export((make_io_res_0_ok = out), "ML_make_io_res_0_ok").
+make_io_res_0_ok = ok.
+
+:- pred make_io_res_0_error(io__system_error::in, string::in, io__res::out,
+ io__state::di, io__state::uo) is det.
+:- pragma export(make_io_res_0_error(in, in, out, di, uo),
+ "ML_make_io_res_0_error").
+make_io_res_0_error(Error, Msg0, error(make_io_error(Msg))) -->
+ io__make_err_msg(Error, Msg0, Msg).
+
+:- func make_io_res_0_error_msg(string) = io__res.
+:- pragma export((make_io_res_0_error_msg(in) = out),
+ "ML_make_io_res_0_error_msg").
+make_io_res_0_error_msg(Msg) = error(make_io_error(Msg)).
+
+:- func make_io_res_1_ok_file_type(file_type) = io__res(file_type).
+:- pragma export((make_io_res_1_ok_file_type(in) = out),
+ "ML_make_io_res_1_ok_file_type").
+make_io_res_1_ok_file_type(FileType) = ok(FileType).
+
+:- pred make_io_res_1_error_file_type(io__system_error::in,
+ string::in, io__res(file_type)::out,
+ io__state::di, io__state::uo) is det.
+:- pragma export(make_io_res_1_error_file_type(in, in, out, di, uo),
+ "ML_make_io_res_1_error_file_type").
+make_io_res_1_error_file_type(Error, Msg0, error(make_io_error(Msg))) -->
+ io__make_err_msg(Error, Msg0, Msg).
+
+%-----------------------------------------------------------------------------%
+
+% Can we retrieve inodes on this system.
+:- type file_id
+ ---> file_id(device :: int, inode :: int).
+
+io__file_id(FileName, Result) -->
+ ( { have_file_ids } ->
+ io__file_id_2(FileName, Status, Msg, Device, Inode),
+ ( { Status = 1 } ->
+ { Result = ok(file_id(Device, Inode)) }
+ ;
+ { Result = error(io_error(Msg)) }
+ )
+ ;
+ { Result = error(
+ make_io_error("io.file_id not implemented on this platform")) }
+ ).
+
+:- pred io__file_id_2(string, int, string, int, int,
+ io__state, io__state).
+:- mode io__file_id_2(in, out, out, out, out, di, uo) is det.
+
+:- pragma foreign_proc("C",
+ io__file_id_2(FileName::in, Status::out, Msg::out,
+ Device::out, Inode::out, IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
+"{
+#ifdef MR_HAVE_STAT
+ struct stat s;
+ if (stat(FileName, &s) == 0) {
+ Device = s.st_dev;
+ Inode = s.st_ino;
+ Msg = MR_string_const("""", 0);
+ Status = 1;
+ } else {
+ ML_maybe_make_err_msg(MR_TRUE, errno, ""stat() failed: "",
+ MR_PROC_LABEL, Msg);
+ Status = 0;
+ }
+ MR_update_io(IO0, IO);
+#else
+ MR_fatal_error(""io.file_id_2 called but not supported"");
+#endif
+}").
+
+have_file_ids :- semidet_fail.
+:- pragma foreign_proc("C", have_file_ids,
+ [promise_pure, will_not_call_mercury, thread_safe],
+"
+#if defined(MR_WIN32) || !defined(MR_HAVE_STAT)
+ /* Win32 returns junk in the st_ino field of `struct stat'. */
+ SUCCESS_INDICATOR = MR_FALSE;
+#else
+ SUCCESS_INDICATOR = MR_TRUE;
+#endif
+").
%-----------------------------------------------------------------------------%
@@ -2316,6 +2996,31 @@
{ Res = error(T0, Error) }
).
+io__binary_input_stream_foldl2_io_maybe_stop(Pred, T0, Res) -->
+ io__binary_input_stream(Stream),
+ io__binary_input_stream_foldl2_io_maybe_stop(Stream, Pred, T0, Res).
+
+io__binary_input_stream_foldl2_io_maybe_stop(Stream, Pred, T0, Res) -->
+ io__read_byte(Stream, ByteResult),
+ (
+ { ByteResult = ok(Byte) },
+ Pred(Byte, Continue, T0, T1),
+ (
+ { Continue = no },
+ { Res = ok(T1) }
+ ;
+ { Continue = yes },
+ io__binary_input_stream_foldl2_io_maybe_stop(Stream,
+ Pred, T1, Res)
+ )
+ ;
+ { ByteResult = eof },
+ { Res = ok(T0) }
+ ;
+ { ByteResult = error(Error) },
+ { Res = error(T0, Error) }
+ ).
+
%-----------------------------------------------------------------------------%
io__putback_char(Char) -->
@@ -3256,7 +3961,7 @@
io__progname_base(DefaultName, PrognameBase) -->
io__progname(DefaultName, Progname),
- { dir__basename(Progname, PrognameBase) }.
+ { PrognameBase = dir__basename_det(Progname) }.
% XXX we call a pred version of io__get_stream_id, which is a
@@ -3517,6 +4222,7 @@
#include <stdarg.h>
#include <string.h>
#include <errno.h>
+#include <limits.h>
#ifdef MR_HAVE_SYS_WAIT_H
#include <sys/wait.h> /* for WIFEXITED, WEXITSTATUS, etc. */
@@ -3701,7 +4407,7 @@
static MR_MercuryFile mercury_current_binary_output = mercury_stdout_binary;
// XXX not thread-safe! */
-static System::IO::IOException *MR_io_exception;
+static System::Exception *MR_io_exception;
").
@@ -5323,7 +6029,7 @@
** that the system call was killed by signal number 1.
*/
Status = 127;
- ML_maybe_make_err_msg(MR_TRUE,
+ ML_maybe_make_err_msg(MR_TRUE, errno,
""error invoking system command: "",
MR_PROC_LABEL, Msg);
} else {
@@ -5549,12 +6255,17 @@
{ Result = yes(Dir) }
;
{ Result = no },
- { Dir = "/tmp" }
+ { dir__use_windows_paths ->
+ Dir = "C:\\windows\\temp"
+ ;
+ Dir = "/tmp"
+ }
),
io__make_temp(Dir, "mtmp", Name).
io__make_temp(Dir, Prefix, Name) -->
- io__do_make_temp(Dir, Prefix, Name, Err, Message),
+ io__do_make_temp(Dir, Prefix, char_to_string(dir__directory_separator),
+ Name, Err, Message),
{ Err \= 0 ->
throw_io_error(Message)
;
@@ -5563,9 +6274,9 @@
/*---------------------------------------------------------------------------*/
-:- pred io__do_make_temp(string, string, string, int, string,
+:- pred io__do_make_temp(string, string, string, string, int, string,
io__state, io__state).
-:- mode io__do_make_temp(in, in, out, out, out, di, uo) is det.
+:- mode io__do_make_temp(in, in, in, out, out, out, di, uo) is det.
/*
** XXX The code for io__make_temp assumes POSIX.
@@ -5595,7 +6306,7 @@
").
:- pragma foreign_proc("C",
- io__do_make_temp(Dir::in, Prefix::in, FileName::out,
+ io__do_make_temp(Dir::in, Prefix::in, Sep::in, FileName::out,
Error::out, ErrorMessage::out, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"{
@@ -5622,7 +6333,7 @@
do {
sprintf(countstr, ""%06lX"", ML_io_tempnam_counter & 0xffffffL);
strcpy(FileName, Dir);
- strcat(FileName, ""/"");
+ strcat(FileName, Sep);
strncat(FileName, Prefix, 5);
strncat(FileName, countstr, 3);
strcat(FileName, ""."");
@@ -5633,12 +6344,14 @@
} while (fd == -1 && errno == EEXIST &&
num_tries < ML_MAX_TEMPNAME_TRIES);
if (fd == -1) {
- ML_maybe_make_err_msg(MR_TRUE, ""error opening temporary file: "",
+ ML_maybe_make_err_msg(MR_TRUE, errno,
+ ""error opening temporary file: "",
MR_PROC_LABEL, ErrorMessage);
Error = -1;
} else {
err = close(fd);
- ML_maybe_make_err_msg(err, ""error closing temporary file: "",
+ ML_maybe_make_err_msg(err, errno,
+ ""error closing temporary file: "",
MR_PROC_LABEL, ErrorMessage);
Error = err;
}
@@ -5653,7 +6366,7 @@
*/
:- pragma foreign_proc("MC++",
- io__do_make_temp(Dir::in, Prefix::in, FileName::out,
+ io__do_make_temp(Dir::in, Prefix::in, _Sep::in, FileName::out,
Error::out, ErrorMessage::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"{
@@ -5714,7 +6427,7 @@
#include <errno.h>
/*
-** ML_maybe_make_err_msg(was_error, msg, procname, error_msg):
+** ML_maybe_make_err_msg(was_error, errno, msg, procname, error_msg):
** if `was_error' is true, then append `msg' and `strerror(errno)'
** to give `error_msg'; otherwise, set `error_msg' to NULL.
**
@@ -5728,14 +6441,14 @@
** It also needs to be a macro because MR_incr_hp_atomic_msg()
** stringizes the procname argument.
*/
-#define ML_maybe_make_err_msg(was_error, msg, procname, error_msg) \\
+#define ML_maybe_make_err_msg(was_error, error, msg, procname, error_msg) \\
do { \\
char *errno_msg; \\
size_t total_len; \\
MR_Word tmp; \\
\\
if (was_error) { \\
- errno_msg = strerror(errno); \\
+ errno_msg = strerror(error); \\
total_len = strlen(msg) + strlen(errno_msg); \\
MR_incr_hp_atomic_msg(tmp, \\
(total_len + sizeof(MR_Word)) \\
@@ -5750,6 +6463,73 @@
} \\
} while(0)
+/*
+** ML_maybe_make_win32_err_msg(was_error, error, msg, procname, error_msg):
+** if `was_error' is true, then append `msg' and the string
+** returned by the Win32 API function FormatMessage() for the
+** last error to give `error_msg'; otherwise, set `error_msg' to NULL.
+** Aborts if MR_WIN32 is not defined.
+**
+** WARNING: this must only be called when the `hp' register is valid.
+** That means it must only be called from procedures declared
+** `[will_not_call_mercury, promise_pure]'.
+**
+** This is defined as a macro rather than a C function
+** to avoid worrying about the `hp' register being
+** invalidated by the function call.
+** It also needs to be a macro because MR_incr_hp_atomic_msg()
+** stringizes the procname argument.
+*/
+#ifdef MR_WIN32
+
+#include <windows.h>
+
+#define ML_maybe_make_win32_err_msg(was_error, error, msg, procname, error_msg) \\
+ do { \\
+ size_t total_len; \\
+ MR_Word tmp; \\
+ \\
+ if (was_error) { \\
+ LPVOID err_buf; \\
+ MR_bool free_err_buf = MR_TRUE; \\
+ if (!FormatMessage( \\
+ FORMAT_MESSAGE_ALLOCATE_BUFFER \\
+ | FORMAT_MESSAGE_FROM_SYSTEM \\
+ | FORMAT_MESSAGE_IGNORE_INSERTS, \\
+ NULL, \\
+ error, \\
+ MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), \\
+ (LPTSTR) &err_buf, \\
+ 0, \\
+ NULL)) \\
+ { \\
+ free_err_buf = MR_FALSE; \\
+ err_buf = ""could not retrieve error message""; \\
+ } \\
+ total_len = strlen(msg) + strlen((char *)err_buf); \\
+ MR_incr_hp_atomic_msg(tmp, \\
+ (total_len + sizeof(MR_Word)) \\
+ / sizeof(MR_Word), \\
+ procname, \\
+ ""string:string/0""); \\
+ (error_msg) = (char *)tmp; \\
+ strcpy((error_msg), msg); \\
+ strcat((error_msg), (char *)err_buf); \\
+ if (free_err_buf) { \\
+ LocalFree(err_buf); \\
+ } \\
+ } else { \\
+ (error_msg) = NULL; \\
+ } \\
+ } while(0)
+
+#else /* !MR_WIN32 */
+
+#define ML_maybe_make_win32_err_msg(was_error, error, msg, procname, error_msg) \\
+ MR_fatal_error(""ML_maybe_make_win32_err_msg called on non-Windows platform"")
+
+#endif /* !MR_WIN32 */
+
").
io__remove_file(FileName, Result, IO0, IO) :-
@@ -5769,7 +6549,7 @@
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"{
RetVal = remove(FileName);
- ML_maybe_make_err_msg(RetVal != 0, ""remove failed: "",
+ ML_maybe_make_err_msg(RetVal != 0, errno, ""remove failed: "",
MR_PROC_LABEL, RetStr);
MR_update_io(IO0, IO);
}").
@@ -5812,7 +6592,7 @@
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"{
RetVal = rename(OldFileName, NewFileName);
- ML_maybe_make_err_msg(RetVal != 0, ""rename failed: "",
+ ML_maybe_make_err_msg(RetVal != 0, errno, ""rename failed: "",
MR_PROC_LABEL, RetStr);
MR_update_io(IO0, IO);
}").
@@ -5837,6 +6617,129 @@
RetStr = e.Message;
}
}").
+
+io__have_symlinks :- semidet_fail.
+
+:- pragma foreign_proc("C", io__have_symlinks,
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+#if defined(MR_HAVE_SYMLINK) && defined(MR_HAVE_READLINK)
+ SUCCESS_INDICATOR = MR_TRUE;
+#else
+ SUCCESS_INDICATOR = MR_FALSE;
+#endif
+").
+
+io__make_symlink(FileName, LinkFileName, Result) -->
+ ( { io__have_symlinks } ->
+ io__make_symlink_2(FileName, LinkFileName, Status),
+ ( { Status = 0 } ->
+ io__make_err_msg("io.make_symlink failed: ", Msg),
+ { Result = error(make_io_error(Msg)) }
+ ;
+ { Result = ok }
+ )
+ ;
+ { Result = error(make_io_error(
+ "io.make_symlink not supported on this platform")) }
+ ).
+
+:- pred io__make_symlink_2(string::in, string::in, int::out,
+ io__state::di, io__state::uo) is det.
+
+:- pragma foreign_proc("C",
+ io__make_symlink_2(FileName::in, LinkFileName::in,
+ Status::out, IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
+"{
+#ifdef MR_HAVE_SYMLINK
+ Status = (symlink(FileName, LinkFileName) == 0);
+#else
+ Status = 0;
+#endif
+ MR_update_io(IO0, IO);
+}").
+
+io__follow_symlink(FileName, Result) -->
+ ( { io__have_symlinks } ->
+ io__follow_symlink_2(FileName, TargetFileName, Status, Error),
+ ( { Status = 0 } ->
+ io__make_err_msg(Error,
+ "io.follow_symlink failed: ", Msg),
+ { Result = error(make_io_error(Msg)) }
+ ;
+ { Result = ok(TargetFileName) }
+ )
+ ;
+ { Result = error(make_io_error(
+ "io.follow_symlink not supported on this platform")) }
+ ).
+
+:- pred io__follow_symlink_2(string::in, string::out, int::out,
+ io__system_error::out, io__state::di, io__state::uo) is det.
+
+:- pragma foreign_proc("C",
+ io__follow_symlink_2(FileName::in, TargetFileName::out,
+ Status::out, Error::out, IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
+"{
+#ifdef MR_HAVE_READLINK
+ #ifndef PATH_MAX
+ #define PATH_MAX 256
+ #endif
+ int num_chars;
+ char *buffer2 = NULL;
+ int buffer_size2 = PATH_MAX;
+ char buffer[PATH_MAX + 1];
+
+ /* readlink() does not null-terminate the buffer */
+ num_chars = readlink(FileName, buffer, PATH_MAX);
+
+ if (num_chars == PATH_MAX) {
+ while (1) {
+ buffer_size2 *= 2;
+ if (buffer2 != NULL) {
+ MR_free(buffer2);
+ }
+ buffer2 = MR_NEW_ARRAY(char, buffer_size2);
+ num_chars = readlink(FileName, buffer2, PATH_MAX);
+ if (num_chars == buffer_size2) {
+ MR_free(buffer2);
+ buffer2 = NULL;
+ continue;
+ } else if (num_chars == -1) {
+ Error = errno;
+ MR_free(buffer2);
+ buffer2 = NULL;
+ TargetFileName = MR_make_string_const("""");
+ Status = 0;
+ break;
+ } else {
+ buffer2[num_chars] = '\\0';
+ MR_make_aligned_string_copy(TargetFileName,
+ buffer2);
+ MR_free(buffer2);
+ buffer2 = NULL;
+ Status = 1;
+ }
+ }
+ } else if (num_chars == -1) {
+ TargetFileName = MR_make_string_const("""");
+ Error = errno;
+ Status = 0;
+ } else {
+ buffer[num_chars] = '\\0';
+ MR_make_aligned_string_copy(TargetFileName,
+ buffer);
+ Status = 1;
+ }
+#else /* !MR_HAVE_READLINK */
+ TargetFileName = NULL;
+ Status = 0;
+#endif
+ MR_update_io(IO0, IO);
+}").
+
/*---------------------------------------------------------------------------*/
Index: runtime/mercury_conf.h.in
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_conf.h.in,v
retrieving revision 1.48
diff -u -u -r1.48 mercury_conf.h.in
--- runtime/mercury_conf.h.in 2 Dec 2002 11:25:46 -0000 1.48
+++ runtime/mercury_conf.h.in 12 Jun 2003 15:34:33 -0000
@@ -200,6 +200,7 @@
** MR_HAVE_DLSYM we have the dlsym() function.
** MR_HAVE_DLERROR we have the dlerror() function.
** MR_HAVE_STAT we have the stat() function.
+** MR_HAVE_LSTAT we have the lstat() function.
** MR_HAVE_FSTAT we have the fstat() function.
** MR_HAVE_FDOPEN we have the fdopen() function.
** MR_HAVE_OPEN we have the open() function.
@@ -227,6 +228,9 @@
** MR_HAVE_OPENDIR we have the opendir() function.
** MR_HAVE_READDIR we have the readdir() function.
** MR_HAVE_CLOSEDIR we have the closedir() function.
+** MR_HAVE_MKDIR we have the mkdir function.
+** MR_HAVE_SYMLINK we have the symlink function.
+** MR_HAVE_READLINK we have the readlink function.
*/
#undef MR_HAVE_GETPID
#undef MR_HAVE_SETPGID
@@ -253,6 +257,7 @@
#undef MR_HAVE_DLSYM
#undef MR_HAVE_DLERROR
#undef MR_HAVE_STAT
+#undef MR_HAVE_LSTAT
#undef MR_HAVE_FSTAT
#undef MR_HAVE_FDOPEN
#undef MR_HAVE_OPEN
@@ -277,6 +282,9 @@
#undef MR_HAVE_OPENDIR
#undef MR_HAVE_READDIR
#undef MR_HAVE_CLOSEDIR
+#undef MR_HAVE_MKDIR
+#undef MR_HAVE_SYMLINK
+#undef MR_HAVE_READLINK
/*
** We use mprotect() and signals to catch stack and heap overflows.
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.199
diff -u -u -r1.199 Mmakefile
--- tests/hard_coded/Mmakefile 13 Jun 2003 05:39:47 -0000 1.199
+++ tests/hard_coded/Mmakefile 13 Jun 2003 10:56:40 -0000
@@ -36,6 +36,7 @@
deep_copy_exist \
deforest_cc_bug \
det_in_semidet_cntxt \
+ dir_test \
division_test \
dot_separator \
dupcall_types_bug \
@@ -365,6 +366,21 @@
< $@.tmp > $@; \
rm -f $@.tmp; \
fi
+
+#-----------------------------------------------------------------------------#
+
+dir_test.out: prepare_for_dir_test
+
+prepare_for_dir_test:
+ rm -rf test_dir unwritable
+ touch unwritable
+ chmod -w unwritable
+
+dir_test.clean: clean_dir_test
+
+.PHONY: clean_dir_test
+clean_dir_test:
+ rm -rf test_dir unwritable
#-----------------------------------------------------------------------------#
Index: tests/hard_coded/dir_test.exp
===================================================================
RCS file: tests/hard_coded/dir_test.exp
diff -N tests/hard_coded/dir_test.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/dir_test.exp 14 Jun 2003 08:42:00 -0000
@@ -0,0 +1,38 @@
+Directory separator is '\'.
+dir__split_name("\\server\share\foo", "\\server\share\", "foo").
+dir__split_name("\\server\share", _, _) failed.
+dir__split_name("\\server\share\\", _, _) failed.
+dir__split_name("C:\foo", "C:\", "foo").
+dir__split_name("C:\", _, _) failed.
+dir__split_name("", _, _) failed.
+dir__split_name("foo\\bar\", "foo\", "bar").
+dir__split_name("foo\bar\", "foo\", "bar").
+dir__split_name("foo", _, _) failed.
+dir__dirname("foo") = ".".
+dir__basename("C:\") = _ failed.
+dir__basename("C:\foo") = "foo".
+checking whether `unwritable' is readable...ok
+unwritable file found to be unwritable
+make_directory succeeded
+make_directory succeeded
+file_type succeeded
+type of test_dir\d1 is directory
+file_type 2 succeeded
+type of dir_test.m is regular_file
+path_name_is_absolute("test_dir\\d1") failed as expected
+touching file succeeded
+touching file succeeded
+touching file succeeded
+touching file succeeded
+creating directory with same name as ordinary file failed (as expected).
+symlinks not available on this platform
+dir__foldl2 succeeded
+Files in test_dir:
+test_dir\d1, test_dir\quark, test_dir\queeg
+dir__recursive_foldl2 (no symlinks) succeeded
+Files in test_dir (recursive, not following symlinks):
+test_dir\d1, test_dir\d1\foo, test_dir\d1\baz, test_dir\quark, test_dir\queeg
+dir__recursive_foldl2 (symlinks) succeeded
+Files in test_dir (recursive, following symlinks:
+test_dir\d1, test_dir\d1\foo, test_dir\d1\baz, test_dir\quark, test_dir\queeg
+dir.recursive_foldl2(list_files, "dir_test.m", ...) failed as expected.
Index: tests/hard_coded/dir_test.exp2
===================================================================
RCS file: tests/hard_coded/dir_test.exp2
diff -N tests/hard_coded/dir_test.exp2
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/dir_test.exp2 14 Jun 2003 08:42:01 -0000
@@ -0,0 +1,38 @@
+Directory separator is '\'.
+dir__split_name("\\server\share\foo", "\\server\share", "foo").
+dir__split_name("\\server\share", _, _) failed.
+dir__split_name("\\server\share\\", _, _) failed.
+dir__split_name("C:\foo", "C:\", "foo").
+dir__split_name("C:\", _, _) failed.
+dir__split_name("", _, _) failed.
+dir__split_name("foo\\bar\", "foo", "bar").
+dir__split_name("foo\bar\", "foo", "bar").
+dir__split_name("foo", ".", "foo").
+dir__dirname("foo") = ".".
+dir__basename("C:\") = _ failed.
+dir__basename("C:\foo") = "foo".
+checking whether `unwritable' is readable...ok
+unwritable file found to be unwritable
+make_directory succeeded
+make_directory succeeded
+file_type succeeded
+type of test_dir\d1 is directory
+file_type 2 succeeded
+type of dir_test.m is regular_file
+path_name_is_absolute("test_dir\\d1") failed as expected
+touching file succeeded
+touching file succeeded
+touching file succeeded
+touching file succeeded
+creating directory with same name as ordinary file failed (as expected).
+symlinks not available on this platform
+dir__foldl2 succeeded
+Files in test_dir:
+test_dir\d1, test_dir\quark, test_dir\queeg
+dir__recursive_foldl2 (no symlinks) succeeded
+Files in test_dir (recursive, not following symlinks):
+test_dir\d1, test_dir\d1\foo, test_dir\d1\baz, test_dir\quark, test_dir\queeg
+dir__recursive_foldl2 (symlinks) succeeded
+Files in test_dir (recursive, following symlinks:
+test_dir\d1, test_dir\d1\foo, test_dir\d1\baz, test_dir\quark, test_dir\queeg
+dir.recursive_foldl2(list_files, "dir_test.m", ...) failed as expected.
Index: tests/hard_coded/dir_test.exp3
===================================================================
RCS file: tests/hard_coded/dir_test.exp3
diff -N tests/hard_coded/dir_test.exp3
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/dir_test.exp3 14 Jun 2003 10:40:37 -0000
@@ -0,0 +1,43 @@
+Directory separator is '/'.
+dir__split_name("/foo", "/", "foo").
+dir__split_name("/foo//bar///", "/foo/", "bar").
+dir__split_name("//foo//bar/", "/foo/", "bar").
+dir__split_name("//foo//", "/", "foo").
+dir__split_name("/", _, _) failed.
+dir__split_name("", _, _) failed.
+dir__split_name("foo/bar", "foo/", "bar").
+dir__split_name("foo", _, _) failed.
+dir__dirname("foo") = ".".
+dir__basename("/") = _ failed.
+dir__basename("/foo") = "foo".
+checking whether `unwritable' is readable...ok
+unwritable file found to be unwritable
+make_directory succeeded
+make_directory succeeded
+file_type succeeded
+type of test_dir/d1 is directory
+file_type 2 succeeded
+type of dir_test.m is regular_file
+path_name_is_absolute("test_dir/d1") failed as expected
+touching file succeeded
+touching file succeeded
+touching file succeeded
+touching file succeeded
+creating directory with same name as ordinary file failed (as expected).
+making symlink 1 succeeded
+making symlink 2 succeeded
+making symlink 3 succeeded
+following symlink succeeded
+test_dir/d1/bar points to baz
+file_type 3 succeeded
+type of test_dir/d1/bar is symbolic_link
+dir__foldl2 succeeded
+Files in test_dir:
+test_dir/d1, test_dir/d2, test_dir/quark, test_dir/queeg
+dir__recursive_foldl2 (no symlinks) succeeded
+Files in test_dir (recursive, not following symlinks):
+test_dir/d1, test_dir/d1/bar, test_dir/d1/baz, test_dir/d1/foo, test_dir/d1/parent, test_dir/d2, test_dir/quark, test_dir/queeg
+dir__recursive_foldl2 (symlinks) succeeded
+Files in test_dir (recursive, following symlinks:
+test_dir/d1, test_dir/d1/bar, test_dir/d1/baz, test_dir/d1/foo, test_dir/d1/parent, test_dir/d2, test_dir/d2/bar, test_dir/d2/baz, test_dir/d2/foo, test_dir/d2/parent, test_dir/quark, test_dir/queeg
+dir.recursive_foldl2(list_files, "dir_test.m", ...) failed as expected.
Index: tests/hard_coded/dir_test.m
===================================================================
RCS file: tests/hard_coded/dir_test.m
diff -N tests/hard_coded/dir_test.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/dir_test.m 14 Jun 2003 08:41:56 -0000
@@ -0,0 +1,265 @@
+:- module dir_test.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module bool, dir, list, require, string.
+
+main -->
+ io__write_string("Directory separator is '"),
+ io__write_char(dir__directory_separator),
+ io__write_string("'.\n"),
+ ( { dir__use_windows_paths } ->
+ test_split_name("\\\\server\\share\\foo"),
+ test_split_name("\\\\server\\share"),
+ test_split_name("\\\\server\\share\\\\"),
+ test_split_name("C:\\foo"),
+ test_split_name("C:\\"),
+ test_split_name(""),
+ test_split_name("foo\\\\bar\\"),
+ test_split_name("foo\\bar\\"),
+ test_split_name("foo"),
+ test_dirname("foo"),
+ test_basename("C:\\"),
+ test_basename("C:\\foo")
+ ;
+ test_split_name("/foo"),
+ test_split_name("/foo//bar///"),
+ test_split_name("//foo//bar/"),
+ test_split_name("//foo//"),
+ test_split_name("/"),
+ test_split_name(""),
+ test_split_name("foo/bar"),
+ test_split_name("foo"),
+ test_dirname("foo"),
+ test_basename("/"),
+ test_basename("/foo")
+ ),
+
+ io__write_string("checking whether `unwritable' is readable..."),
+ io__check_file_accessibility("unwritable", [read], ReadResult),
+ io__write(ReadResult),
+ io__nl,
+
+ io__check_file_accessibility("unwritable",
+ [read, write], WriteResult),
+ ( { WriteResult = ok } ->
+ io__write_string(
+ "Error: unwritable file found to be writable\n")
+ ;
+ io__write_string(
+ "unwritable file found to be unwritable\n")
+ ),
+
+ { Dir1 = "test_dir"/"d1" },
+ test0("make_directory", dir__make_directory(Dir1)),
+ % Test making a directory that already exists.
+ test0("make_directory", dir__make_directory(Dir1)),
+
+ test1("file_type", io__file_type(yes, Dir1), Type),
+ io__write_string("type of "),
+ io__write_string(Dir1),
+ io__write_string(" is "),
+ io__write(Type),
+ io__nl,
+
+ test1("file_type 2", io__file_type(yes, "dir_test.m"), Type2),
+ io__write_string("type of "),
+ io__write_string("dir_test.m"),
+ io__write_string(" is "),
+ io__write(Type2),
+ io__nl,
+
+ ( { dir__path_name_is_absolute(Dir1) } ->
+ io__write_string("Error: path_name_is_absolute("),
+ io__write(Dir1),
+ io__write_string(") succeeded\n")
+ ;
+ io__write_string("path_name_is_absolute("),
+ io__write(Dir1),
+ io__write_string(") failed as expected\n")
+ ),
+
+ % Create some dummy files
+ touch_file(Dir1/"foo"),
+ touch_file(Dir1/"baz"),
+ touch_file("test_dir"/"quark"),
+ touch_file("test_dir"/"queeg"),
+
+ dir__make_directory(Dir1/"foo", MkdirRes),
+ (
+ { MkdirRes = ok },
+ io__write_string(
+"Error: creating directory with same name as ordinary file succeeded.\n")
+ ;
+ { MkdirRes = error(_) },
+ io__write_string(
+"creating directory with same name as ordinary file failed (as expected).\n")
+ ),
+
+ ( { io__have_symlinks } ->
+ test0("making symlink 1", io__make_symlink("baz", Dir1/"bar")),
+ test0("making symlink 2", io__make_symlink("d1",
+ "test_dir"/"d2")),
+
+ % Make a loop.
+ test0("making symlink 3",
+ io__make_symlink(dir__parent_directory, Dir1/"parent")),
+
+ test1("following symlink",
+ io__follow_symlink(Dir1/"bar"), LinkTarget),
+ io__write_string(Dir1/"bar"),
+ io__write_string(" points to "),
+ io__write_string(LinkTarget),
+ io__nl,
+
+ test1("file_type 3", io__file_type(no, Dir1/"bar"), Type3),
+ io__write_string("type of "),
+ io__write_string(Dir1/"bar"),
+ io__write_string(" is "),
+ io__write(Type3),
+ io__nl
+ ;
+ io__write_string("symlinks not available on this platform\n")
+ ),
+
+ testp("dir__foldl2",
+ dir__foldl2(list_files, "test_dir", []), TestDirFiles),
+ io__write_string("Files in test_dir:\n"),
+ io__write_list(reverse(TestDirFiles), ", ", io__write_string),
+ io__nl,
+
+ testp("dir__recursive_foldl2 (no symlinks)",
+ dir__recursive_foldl2(list_files, "test_dir", no, []),
+ NoFollowFiles),
+ io__write_string(
+ "Files in test_dir (recursive, not following symlinks):\n"),
+ io__write_list(reverse(NoFollowFiles), ", ", io__write_string),
+ io__nl,
+
+ testp("dir__recursive_foldl2 (symlinks)",
+ dir__recursive_foldl2(list_files, "test_dir", yes, []),
+ FollowFiles),
+ io__write_string(
+ "Files in test_dir (recursive, following symlinks:\n"),
+ io__write_list(reverse(FollowFiles), ", ", io__write_string),
+ io__nl,
+
+ dir__recursive_foldl2(list_files, "dir_test.m", yes, [], Res),
+ (
+ { Res = ok(_) },
+ io__write_string(
+"Error: dir.recursive_foldl2(list_files, ""dir_test.m"", ...) succeeded.\n")
+ ;
+ { Res = error(_, _) },
+ io__write_string(
+"dir.recursive_foldl2(list_files, ""dir_test.m"", ...) failed as expected.\n")
+ ).
+
+:- type test0 == pred(io__res, io__state, io__state).
+:- inst test0 == (pred(out, di, uo) is det).
+
+:- pred test0(string::in, test0::in(test0),
+ io__state::di, io__state::uo) is det.
+
+test0(Msg, P) -->
+ P(Res),
+ (
+ { Res = ok },
+ io__write_string(Msg),
+ io__write_string(" succeeded\n")
+ ;
+ { Res = error(Error) },
+ { error(Msg ++ " " ++ io__error_message(Error)) }
+ ).
+
+:- type test1(T) == pred(io__res(T), io__state, io__state).
+:- inst test1 == (pred(out, di, uo) is det).
+
+:- pred test1(string::in, test1(T)::in(test0), T::out,
+ io__state::di, io__state::uo) is det.
+
+test1(Msg, P, T) -->
+ P(Res),
+ (
+ { Res = ok(T) },
+ io__write_string(Msg),
+ io__write_string(" succeeded\n")
+ ;
+ { Res = error(Error) },
+ { error(Msg ++ " " ++ io__error_message(Error)) }
+ ).
+
+:- type testp(T) == pred(io__maybe_partial_res(T), io__state, io__state).
+:- inst testp == (pred(out, di, uo) is det).
+
+:- pred testp(string::in, testp(T)::in(testp), T::out,
+ io__state::di, io__state::uo) is det.
+
+testp(Msg, P, T) -->
+ P(Res),
+ (
+ { Res = ok(T) },
+ io__write_string(Msg),
+ io__write_string(" succeeded\n")
+ ;
+ { Res = error(_, Error) },
+ { error(Msg ++ " " ++ io__error_message(Error)) }
+ ).
+
+:- pred test_split_name(string::in, io__state::di, io__state::uo) is det.
+
+test_split_name(PathName) -->
+ io__write_string("dir__split_name("""),
+ io__write_string(PathName),
+ io__write_string(""", "),
+ ( { dir__split_name(PathName, DirName, FileName) } ->
+ io__write_string(""""),
+ io__write_string(DirName),
+ io__write_string(""", """),
+ io__write_string(FileName),
+ io__write_string(""").\n")
+ ;
+ io__write_string("_, _) failed.\n")
+ ).
+
+:- pred test_dirname(string::in, io__state::di, io__state::uo) is det.
+
+test_dirname(PathName) -->
+ io__write_string("dir__dirname("""),
+ io__write_string(PathName),
+ io__write_string(""") = """),
+ io__write_string(dir__dirname(PathName)),
+ io__write_string(""".\n").
+
+:- pred test_basename(string::in, io__state::di, io__state::uo) is det.
+
+test_basename(PathName) -->
+ io__write_string("dir__basename("""),
+ io__write_string(PathName),
+ io__write_string(""") = "),
+ ( { BaseName = dir__basename(PathName) } ->
+ io__write_string(""""),
+ io__write_string(BaseName),
+ io__write_string(""".\n")
+ ;
+ io__write_string("_ failed.\n")
+ ).
+
+:- pred touch_file(string::in, io__state::di, io__state::uo) is det.
+
+touch_file(FileName) -->
+ test1("touching file", io__open_output(FileName), FileStream),
+ io__close_output(FileStream).
+
+:- pred list_files `with_type` dir__foldl_pred(list(string))
+ `with_inst` dir__foldl_pred.
+
+list_files(DirName, BaseName, _FileType, yes,
+ Files, [DirName/BaseName | Files], !IO).
+
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list