[MLton-commit] r6166

[Vesa Karvonen]

Ported to Alice ML using workarounds for OS.FileSys.access and
OS.FileSys.fullPath.

----------------------------------------------------------------------

U   mltonlib/trunk/org/mlton/vesak/use-lib/unstable/Make.sh
A   mltonlib/trunk/org/mlton/vesak/use-lib/unstable/detail/ml/
A   mltonlib/trunk/org/mlton/vesak/use-lib/unstable/detail/ml/alice/
A   mltonlib/trunk/org/mlton/vesak/use-lib/unstable/detail/ml/alice/workarounds.sml

----------------------------------------------------------------------

Modified: mltonlib/trunk/org/mlton/vesak/use-lib/unstable/Make.sh
===================================================================
--- mltonlib/trunk/org/mlton/vesak/use-lib/unstable/Make.sh	2007-11-13 12:23:57 UTC (rev 6165)
+++ mltonlib/trunk/org/mlton/vesak/use-lib/unstable/Make.sh	2007-11-13 14:35:34 UTC (rev 6166)
@@ -18,6 +18,12 @@
 
 (* WARNING: This file was generated by the $(basename $0) script. *)" > .tmp
 
+    workarounds=detail/ml/$1/workarounds.sml
+
+    if test -f $workarounds ; then
+        grep -v '^ *(\?\*' $workarounds >> .tmp
+    fi
+
     cat $sources                                \
   | grep -v '^ *(\?\*'                          \
   | sed -e "s/\\\${SML_COMPILER}/\"$1\"/g"      \
@@ -37,6 +43,8 @@
     fi
 }
 
+gen alice '()' 'ignore' ''
+
 gen polyml                                      \
     '(PolyML.get_print_depth ()                 \
       before PolyML.print_depth 0)'             \

Added: mltonlib/trunk/org/mlton/vesak/use-lib/unstable/detail/ml/alice/workarounds.sml
===================================================================
--- mltonlib/trunk/org/mlton/vesak/use-lib/unstable/detail/ml/alice/workarounds.sml	2007-11-13 12:23:57 UTC (rev 6165)
+++ mltonlib/trunk/org/mlton/vesak/use-lib/unstable/detail/ml/alice/workarounds.sml	2007-11-13 14:35:34 UTC (rev 6166)
@@ -0,0 +1,40 @@
+(* Copyright (C) 2007 Vesa Karvonen
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+structure OS = struct
+   open OS
+
+   structure FileSys = struct
+      open FileSys
+
+      local
+         fun try (th, fv, fe) =
+             ((case th () of v => fn () => fv v) handle e => fn () => fe e) ()
+
+         fun after (th, ef) =
+             try (th, fn x => (ef () ; x), fn e => (ef () ; raise e))
+      in
+         (* WARNING: Totally ignores links. *)
+         fun access (p, _) =
+             try (fn () => TextIO.openIn p,
+                  fn s => (TextIO.closeIn s ; true),
+                  fn _ => false)
+
+         (* WARNING: Tests always for only read access only. *)
+         fun fullPath p =
+             case getDir ()
+              of cwd =>
+                 after (fn () =>
+                           if isDir p
+                           then (chDir p ; getDir ())
+                           else case Path.splitDirFile p
+                                 of {dir, file} =>
+                                    (if "" <> dir then chDir dir else ()
+                                   ; Path.joinDirFile {dir = dir, file = file}),
+                        fn () => chDir cwd)
+      end
+   end
+end


Property changes on: mltonlib/trunk/org/mlton/vesak/use-lib/unstable/detail/ml/alice/workarounds.sml
___________________________________________________________________
Name: svn:eol-style
   + native