[MLton] Temporary directories on MinGW / mlnlffigen
Vesa Karvonen
vesa.a.j.k at gmail.com
Tue Apr 24 05:21:18 PDT 2007
On 4/24/07, Vesa Karvonen <vesa.a.j.k at gmail.com> wrote:
> Hmm... I just noticed the GetTempPath function:
>
> http://msdn2.microsoft.com/en-us/library/aa364992.aspx
[...]
Below is a patch (excluding generated files) using GetTempPath. It
introduces a new MinGW specific function MinGW_getTempPath that
returns the result of GetTempPath as a freshly malloced C string.
The C string is freed on the ML side after converting it to a ML
string. I wonder whether there is some other technique used in
MLton for such functions.
-Vesa Karvonen
Index: runtime/platform/mingw.c
===================================================================
--- runtime/platform/mingw.c (revision 5538)
+++ runtime/platform/mingw.c (working copy)
@@ -1024,3 +1024,26 @@
return result;
}
}
+
+/* ------------------------------------------------- */
+/* MinGW */
+/* ------------------------------------------------- */
+
+C_String_t MinGW_getTempPath() {
+ C_String_t buffer = NULL;
+
+ DWORD reqSize = GetTempPath(0, NULL);
+ if (!reqSize) goto failed;
+
+ buffer = malloc(reqSize);
+ if (!buffer) goto failed;
+
+ DWORD check = GetTempPath(reqSize, buffer);
+ if (0 == check || reqSize < check) goto failed;
+
+ return buffer;
+
+ failed:
+ free(buffer);
+ return NULL;
+}
Index: runtime/gen/basis-ffi.def
===================================================================
--- runtime/gen/basis-ffi.def (revision 5538)
+++ runtime/gen/basis-ffi.def (working copy)
@@ -103,6 +103,7 @@
MLton.Syslog.closelog = _import : unit -> unit
MLton.Syslog.openlog = _import : NullString8.t * C_Int.t * C_Int.t -> unit
MLton.Syslog.syslog = _import : C_Int.t * NullString8.t -> unit
+MinGW.getTempPath = _import : unit -> C_String.t
Net.htonl = _import : Word32.t -> Word32.t
Net.htons = _import : Word16.t -> Word16.t
Net.ntohl = _import : Word32.t -> Word32.t
Index: basis-library/platform/mingw.sml
===================================================================
--- basis-library/platform/mingw.sml (revision 0)
+++ basis-library/platform/mingw.sml (revision 0)
@@ -0,0 +1,20 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+structure MinGW =
+ struct
+ fun getTempPath () =
+ let
+ val path = PrimitiveFFI.MinGW.getTempPath ()
+ val free = _import "free" : CUtil.C_Pointer.t -> unit ;
+ in
+ if CUtil.C_Pointer.isNull path
+ then NONE
+ else
+ SOME (CUtil.C_String.toString path) before free path
+ end
+ end
Property changes on: basis-library/platform/mingw.sml
___________________________________________________________________
Name: svn:eol-style
+ native
Index: basis-library/mlton/io.sig
===================================================================
--- basis-library/mlton/io.sig (revision 5538)
+++ basis-library/mlton/io.sig (working copy)
@@ -26,4 +26,6 @@
val mkstemp: string -> string * outstream
(* mkstemps is like mkstemp, except it has both a prefix and suffix. *)
val mkstemps: {prefix: string, suffix: string} -> string * outstream
+ (* adds a suitable system or user specific prefix (dir) for temp files *)
+ val tempPrefix : string -> string
end
Index: basis-library/mlton/io.fun
===================================================================
--- basis-library/mlton/io.fun (revision 5538)
+++ basis-library/mlton/io.fun (working copy)
@@ -33,4 +33,12 @@
fun mkstemp s = mkstemps {prefix = s, suffix = ""}
+fun tempPrefix file =
+ case MLtonPlatform.OS.host of
+ MLtonPlatform.OS.MinGW =>
+ (case MinGW.getTempPath () of
+ SOME d => d
+ | NONE => "C:\\temp\\") ^ file
+ | _ => "/tmp/" ^ file
+
end
Index: basis-library/mlton/mlton.sml
===================================================================
--- basis-library/mlton/mlton.sml (revision 5538)
+++ basis-library/mlton/mlton.sml (working copy)
@@ -108,7 +108,8 @@
fun tmpName () =
let
- val (f, out) = MLton.TextIO.mkstemp "/tmp/file"
+ val (f, out) =
+ MLton.TextIO.mkstemp (MLton.TextIO.tempPrefix "file")
val _ = TextIO.closeOut out
in
f
Index: basis-library/build/sources.mlb
===================================================================
--- basis-library/build/sources.mlb (revision 5538)
+++ basis-library/build/sources.mlb (working copy)
@@ -250,6 +250,9 @@
../posix/posix.sml
../platform/cygwin.sml
+ ann "allowFFI true" in
+ ../platform/mingw.sml
+ end
../io/stream-io.sig
../io/stream-io.fun
@@ -318,6 +321,8 @@
../net/unix-sock.sig
../net/unix-sock.sml
+ ../mlton/platform.sig
+ ../mlton/platform.sml
../mlton/array.sig
../mlton/cont.sig
../mlton/cont.sml
@@ -336,8 +341,6 @@
../mlton/ffi.sml
end
../mlton/int-inf.sig
- ../mlton/platform.sig
- ../mlton/platform.sml
../mlton/proc-env.sig
../mlton/proc-env.sml
../mlton/profile.sig
Index: lib/mlton-stubs/io.sig
===================================================================
--- lib/mlton-stubs/io.sig (revision 5538)
+++ lib/mlton-stubs/io.sig (working copy)
@@ -26,4 +26,6 @@
val mkstemp: string -> string * outstream
(* mkstemps is like mkstemp, except it has both a prefix and suffix. *)
val mkstemps: {prefix: string, suffix: string} -> string * outstream
+ (* adds a suitable system or user specific prefix (dir) for temp files *)
+ val tempPrefix: string -> string
end
Index: lib/mlton-stubs/mlton.sml
===================================================================
--- lib/mlton-stubs/mlton.sml (revision 5538)
+++ lib/mlton-stubs/mlton.sml (working copy)
@@ -25,6 +25,7 @@
fun newOut _ = raise Fail "newOut"
fun outFd _ = raise Fail "outFd"
fun setIn _ = raise Fail "setIn"
+ fun tempPrefix _ = raise Fail "tempPrefix"
end
(* This file is just a dummy provided in place of the structure that MLton
@@ -84,6 +85,7 @@
fun newOut _ = raise Fail "newOut"
fun outFd _ = raise Fail "outFd"
fun setIn _ = raise Fail "setIn"
+ fun tempPrefix _ = raise Fail "tempPrefix"
end
structure CallStack =
Index: lib/mlton/basic/file.sml
===================================================================
--- lib/mlton/basic/file.sml (revision 5538)
+++ lib/mlton/basic/file.sml (working copy)
@@ -88,6 +88,7 @@
List.foreach (sources, fn f => outputContents (f, out)))
val temp = MLton.TextIO.mkstemps
+val tempPrefix = MLton.TextIO.tempPrefix
fun tempName z =
let
@@ -99,7 +100,7 @@
fun withTemp f =
let
- val name = tempName {prefix = "/tmp/file", suffix = ""}
+ val name = tempName {prefix = tempPrefix "file", suffix = ""}
in
Exn.finally (fn () => f name, fn () => remove name)
end
@@ -116,7 +117,7 @@
end
fun withTempOut (f, g) =
- withTempOut' ({prefix = "/tmp/file", suffix = ""}, f, g)
+ withTempOut' ({prefix = tempPrefix "file", suffix = ""}, f, g)
fun withString (s, f) =
withTempOut (fn out => Out.output (out, s), f)
Index: lib/mlton/basic/dir.sml
===================================================================
--- lib/mlton/basic/dir.sml (revision 5538)
+++ lib/mlton/basic/dir.sml (working copy)
@@ -85,7 +85,7 @@
fun inTemp thunk =
let
- val d = concat ["/tmp/dir", Random.alphaNumString 6]
+ val d = concat [MLton.TextIO.tempPrefix "dir", Random.alphaNumString 6]
val _ = make d
in
Exn.finally (fn () => inDir (d, fn _ => thunk ()),
More information about the MLton
mailing list