[MLton-commit] r5556
Matthew Fluet
fluet at mlton.org
Tue May 15 13:35:48 PDT 2007
Merge trunk revisions 5501:5555 into x86_64 branch
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library/build/sources.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/io.fun
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/io.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/mlton.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/platform/mingw.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/basis-ffi.sml
U mlton/branches/on-20050822-x86_64-branch/ide/emacs/def-use-mode.el
U mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/dir.sml
U mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/file.sml
U mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/list.sml
U mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/io.sig
U mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/mlton.sml
U mlton/branches/on-20050822-x86_64-branch/mlton/front-end/ml.lex
U mlton/branches/on-20050822-x86_64-branch/runtime/Makefile
U mlton/branches/on-20050822-x86_64-branch/runtime/basis-ffi.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def
U mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.sml
U mlton/branches/on-20050822-x86_64-branch/runtime/platform/mingw.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/build/sources.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/build/sources.mlb 2007-05-15 20:32:40 UTC (rev 5555)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/build/sources.mlb 2007-05-15 20:35:44 UTC (rev 5556)
@@ -250,6 +250,7 @@
../posix/posix.sml
../platform/cygwin.sml
+ ../platform/mingw.sml
../io/stream-io.sig
../io/stream-io.fun
@@ -318,6 +319,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 +339,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
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/io.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/io.fun 2007-05-15 20:32:40 UTC (rev 5555)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/io.fun 2007-05-15 20:35:44 UTC (rev 5556)
@@ -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
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/io.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/io.sig 2007-05-15 20:32:40 UTC (rev 5555)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/io.sig 2007-05-15 20:35:44 UTC (rev 5556)
@@ -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
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/mlton.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/mlton.sml 2007-05-15 20:32:40 UTC (rev 5555)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/mlton.sml 2007-05-15 20:35:44 UTC (rev 5556)
@@ -125,7 +125,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
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library/platform/mingw.sml (from rev 5555, mlton/trunk/basis-library/platform/mingw.sml)
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/basis-ffi.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/basis-ffi.sml 2007-05-15 20:32:40 UTC (rev 5555)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/basis-ffi.sml 2007-05-15 20:35:44 UTC (rev 5556)
@@ -63,6 +63,10 @@
end
val setRoundingMode = _import "IEEEReal_setRoundingMode" : C_Int.t -> unit;
end
+structure MinGW =
+struct
+val getTempPath = _import "MinGW_getTempPath" : C_Size.t * (Char8.t) array -> C_Size.t;
+end
structure MLton =
struct
val bug = _import "MLton_bug" : NullString8.t -> unit;
Modified: mlton/branches/on-20050822-x86_64-branch/ide/emacs/def-use-mode.el
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/ide/emacs/def-use-mode.el 2007-05-15 20:32:40 UTC (rev 5555)
+++ mlton/branches/on-20050822-x86_64-branch/ide/emacs/def-use-mode.el 2007-05-15 20:35:44 UTC (rev 5556)
@@ -112,10 +112,10 @@
current buffer."
(save-excursion
(goto-char point)
- (def-use-pos
- (+ (count-lines 1 (point))
- (if (= (current-column) 0) 1 0))
- (current-column))))
+ (beginning-of-line)
+ (let ((line (+ (count-lines 1 (point)) 1))
+ (col (- point (point))))
+ (def-use-pos line col))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; High-level symbol lookup
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/dir.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/dir.sml 2007-05-15 20:32:40 UTC (rev 5555)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/dir.sml 2007-05-15 20:35:44 UTC (rev 5556)
@@ -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 ()),
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/file.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/file.sml 2007-05-15 20:32:40 UTC (rev 5555)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/file.sml 2007-05-15 20:35:44 UTC (rev 5556)
@@ -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)
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/list.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/list.sml 2007-05-15 20:32:40 UTC (rev 5555)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/list.sml 2007-05-15 20:35:44 UTC (rev 5556)
@@ -390,8 +390,8 @@
in firstN (fold (s, [], insert),n)
end
- val smallest = choose (op <)
- val largest = choose (op >)
+ val smallest = choose (op < : int * int -> bool)
+ val largest = choose (op > : int * int -> bool)
fun getFirst (l, extreme, name) =
case extreme (l, 1) of
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/io.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/io.sig 2007-05-15 20:32:40 UTC (rev 5555)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/io.sig 2007-05-15 20:35:44 UTC (rev 5556)
@@ -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
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/mlton.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/mlton.sml 2007-05-15 20:32:40 UTC (rev 5555)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/mlton.sml 2007-05-15 20:35:44 UTC (rev 5556)
@@ -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 =
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/front-end/ml.lex
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/front-end/ml.lex 2007-05-15 20:32:40 UTC (rev 5555)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/front-end/ml.lex 2007-05-15 20:35:44 UTC (rev 5556)
@@ -335,7 +335,7 @@
<S>\\\" => (addString "\""; continue ());
<S>\\\\ => (addString "\\"; continue ());
<S>\\{nrws} => (YYBEGIN F; continue ());
-<S>\\{eol} => (Source.newline (source, yypos) ; YYBEGIN F ; continue ());
+<S>\\{eol} => (Source.newline (source, yypos + 1) ; YYBEGIN F ; continue ());
<S>\\ => (stringError (source, yypos, "illegal string escape")
; continue ());
<S>{eol} => (Source.newline (source, yypos)
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/Makefile 2007-05-15 20:32:40 UTC (rev 5555)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/Makefile 2007-05-15 20:35:44 UTC (rev 5556)
@@ -1,4 +1,4 @@
-## Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
+## Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
# Jagannathan, and Stephen Weeks.
# Copyright (C) 1997-2000 NEC Research Institute.
#
@@ -19,15 +19,15 @@
sed 's/.*gcc version \([0-9][0-9]*\)\.\([0-9][0-9]*\).*/\2/')
GCC_VERSION := $(GCC_MAJOR_VERSION).$(GCC_MINOR_VERSION)
-FLAGS :=
+FLAGS :=
EXE :=
OPTFLAGS := -O2 -fomit-frame-pointer
-GCOPTFLAGS :=
+GCOPTFLAGS :=
DEBUGFLAGS := -O1 -fno-inline -fkeep-inline-functions -g2
-GCDEBUGFLAGS :=
-WARNFLAGS :=
-OPTWARNFLAGS :=
-DEBUGWARNFLAGS :=
+GCDEBUGFLAGS :=
+WARNFLAGS :=
+OPTWARNFLAGS :=
+DEBUGWARNFLAGS :=
ifeq ($(TARGET_ARCH), amd64)
FLAGS += -m64
@@ -106,6 +106,7 @@
endif
CC := gcc -std=gnu99
+CPPFLAGS :=
CFLAGS := -I. -Iplatform $(FLAGS)
OPTCFLAGS := $(CFLAGS) $(OPTFLAGS)
DEBUGCFLAGS := $(CFLAGS) -DASSERT=1 $(DEBUGFLAGS)
@@ -240,11 +241,12 @@
$(CC) $(OPTCFLAGS) $(OPTWARNCFLAGS) \
-w -O1 -c -DINFNAN_CHECK \
*.c
+ $(RM) gdtoa/arithchk.o
$(AR) libgdtoa.a gdtoa/*.o
$(RANLIB) libgdtoa.a
gdtoa/arithchk.c:
- gzip -dc gdtoa.tgz | tar xf -
+ gzip -dc gdtoa.tgz | tar xf -
patch -s -p0 <gdtoa-patch
gdtoa/arithchk.out: gdtoa/arithchk.c
@@ -255,7 +257,7 @@
libmlton.a: $(OBJS)
$(AR) libmlton.a $(OBJS)
- $(RANLIB) libmlton.a
+ $(RANLIB) libmlton.a
libmlton-gdb.a: $(DEBUG_OBJS)
$(AR) libmlton-gdb.a $(DEBUG_OBJS)
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis-ffi.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis-ffi.h 2007-05-15 20:32:40 UTC (rev 5555)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis-ffi.h 2007-05-15 20:35:44 UTC (rev 5556)
@@ -44,6 +44,7 @@
extern const C_Int_t IEEEReal_RoundingMode_FE_TOWARDZERO;
extern const C_Int_t IEEEReal_RoundingMode_FE_UPWARD;
void IEEEReal_setRoundingMode(C_Int_t);
+C_Size_t MinGW_getTempPath(C_Size_t,Array(Char8_t));
__attribute__((noreturn)) void MLton_bug(NullString8_t);
extern const C_Int_t MLton_Itimer_PROF;
extern const C_Int_t MLton_Itimer_REAL;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def 2007-05-15 20:32:40 UTC (rev 5555)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def 2007-05-15 20:35:44 UTC (rev 5556)
@@ -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 : C_Size.t * Char8.t array -> C_Size.t
Net.htonl = _import : Word32.t -> Word32.t
Net.htons = _import : Word16.t -> Word16.t
Net.ntohl = _import : Word32.t -> Word32.t
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.h 2007-05-15 20:32:40 UTC (rev 5555)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.h 2007-05-15 20:35:44 UTC (rev 5556)
@@ -44,6 +44,7 @@
extern const C_Int_t IEEEReal_RoundingMode_FE_TOWARDZERO;
extern const C_Int_t IEEEReal_RoundingMode_FE_UPWARD;
void IEEEReal_setRoundingMode(C_Int_t);
+C_Size_t MinGW_getTempPath(C_Size_t,Array(Char8_t));
__attribute__((noreturn)) void MLton_bug(NullString8_t);
extern const C_Int_t MLton_Itimer_PROF;
extern const C_Int_t MLton_Itimer_REAL;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.sml 2007-05-15 20:32:40 UTC (rev 5555)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.sml 2007-05-15 20:35:44 UTC (rev 5556)
@@ -63,6 +63,10 @@
end
val setRoundingMode = _import "IEEEReal_setRoundingMode" : C_Int.t -> unit;
end
+structure MinGW =
+struct
+val getTempPath = _import "MinGW_getTempPath" : C_Size.t * (Char8.t) array -> C_Size.t;
+end
structure MLton =
struct
val bug = _import "MLton_bug" : NullString8.t -> unit;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/platform/mingw.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/platform/mingw.c 2007-05-15 20:32:40 UTC (rev 5555)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/platform/mingw.c 2007-05-15 20:35:44 UTC (rev 5556)
@@ -1024,3 +1024,11 @@
return result;
}
}
+
+/* ------------------------------------------------- */
+/* MinGW */
+/* ------------------------------------------------- */
+
+C_Size_t MinGW_getTempPath(C_Size_t buf_size, Array(Char8_t) buf) {
+ return GetTempPath(buf_size, buf);
+}
More information about the MLton-commit
mailing list