[MLton-commit] r5113

Matthew Fluet fluet at mlton.org
Fri Feb 2 11:36:42 PST 2007


Merge trunk revisions 4991:5073 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/libs/basis-2002/top-level/basis.sig
U   mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/top-level/basis-sigs.sml
U   mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/top-level/basis.sig
U   mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/top-level/basis.sml
U   mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/mlton.sig
U   mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/mlton.sml
A   mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/mono-array.sig
A   mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/mono-vector.sig
U   mlton/branches/on-20050822-x86_64-branch/basis-library/mlton.mlb
U   mlton/branches/on-20050822-x86_64-branch/doc/changelog
U   mlton/branches/on-20050822-x86_64-branch/ide/emacs/esml-mlb-mode.el
U   mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/c.mlb
U   mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/internals/c-int.mlb
U   mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/internals/c-int.sml
U   mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/memory/linkage-libdl.sml
U   mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/memory/memory.32bit-unix.mlb
U   mlton/branches/on-20050822-x86_64-branch/mlton/ast/ast-mlbs.fun
U   mlton/branches/on-20050822-x86_64-branch/mlton/ast/prim-tycons.fun
U   mlton/branches/on-20050822-x86_64-branch/mlton/ast/prim-tycons.sig
U   mlton/branches/on-20050822-x86_64-branch/mlton/ast/sources.cm
U   mlton/branches/on-20050822-x86_64-branch/mlton/ast/sources.mlb
U   mlton/branches/on-20050822-x86_64-branch/mlton/atoms/hash-type.fun
U   mlton/branches/on-20050822-x86_64-branch/mlton/atoms/tycon.fun
U   mlton/branches/on-20050822-x86_64-branch/mlton/control/control-flags.sig
U   mlton/branches/on-20050822-x86_64-branch/mlton/control/control-flags.sml
U   mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/elaborate-core.fun
U   mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/elaborate-env.fun
U   mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/interface.fun
U   mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/interface.sig
U   mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/type-env.fun
U   mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/type-env.sig
U   mlton/branches/on-20050822-x86_64-branch/mlton/front-end/mlb-front-end.fun
U   mlton/branches/on-20050822-x86_64-branch/mlton/main/compile.fun
U   mlton/branches/on-20050822-x86_64-branch/mlton/main/main.fun
U   mlton/branches/on-20050822-x86_64-branch/mlton/ssa/ssa-tree2.fun
U   mlton/branches/on-20050822-x86_64-branch/mlton/xml/monomorphise.fun
U   mlton/branches/on-20050822-x86_64-branch/runtime/util/safe.h

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

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-02-02 16:45:13 UTC (rev 5112)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/build/sources.mlb	2007-02-02 19:35:19 UTC (rev 5113)
@@ -354,6 +354,8 @@
    ../mlton/word.sig
    ../mlton/world.sig
    ../mlton/world.sml
+   ../mlton/mono-array.sig
+   ../mlton/mono-vector.sig
    ../mlton/mlton.sig
    ../mlton/mlton.sml
 

Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-2002/top-level/basis.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-2002/top-level/basis.sig	2007-02-02 16:45:13 UTC (rev 5112)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-2002/top-level/basis.sig	2007-02-02 19:35:19 UTC (rev 5113)
@@ -218,8 +218,12 @@
       structure PackReal64Little : PACK_REAL
       structure PackRealBig : PACK_REAL
       structure PackRealLittle : PACK_REAL
+      structure PackWord16Big : PACK_WORD
+      structure PackWord16Little : PACK_WORD
       structure PackWord32Big : PACK_WORD
       structure PackWord32Little : PACK_WORD
+      structure PackWord64Big : PACK_WORD
+      structure PackWord64Little : PACK_WORD
       structure Posix : POSIX
       structure Real32 : REAL
       structure Real32Array : MONO_ARRAY

Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/top-level/basis-sigs.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/top-level/basis-sigs.sml	2007-02-02 16:45:13 UTC (rev 5112)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/top-level/basis-sigs.sml	2007-02-02 19:35:19 UTC (rev 5113)
@@ -92,6 +92,8 @@
 signature MLTON_INT_INF = MLTON_INT_INF
 signature MLTON_IO = MLTON_IO
 signature MLTON_ITIMER = MLTON_ITIMER
+signature MLTON_MONO_ARRAY = MLTON_MONO_ARRAY
+signature MLTON_MONO_VECTOR = MLTON_MONO_VECTOR
 signature MLTON_PLATFORM = MLTON_PLATFORM
 signature MLTON_POINTER = MLTON_POINTER
 signature MLTON_PROC_ENV = MLTON_PROC_ENV

Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/top-level/basis.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/top-level/basis.sig	2007-02-02 16:45:13 UTC (rev 5112)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/top-level/basis.sig	2007-02-02 19:35:19 UTC (rev 5113)
@@ -218,8 +218,12 @@
       structure PackReal64Little : PACK_REAL
       structure PackRealBig : PACK_REAL
       structure PackRealLittle : PACK_REAL
+      structure PackWord16Big : PACK_WORD
+      structure PackWord16Little : PACK_WORD
       structure PackWord32Big : PACK_WORD
       structure PackWord32Little : PACK_WORD
+      structure PackWord64Big : PACK_WORD
+      structure PackWord64Little : PACK_WORD
       structure Posix : POSIX
       structure Real32 : REAL
       structure Real32Array : MONO_ARRAY
@@ -622,6 +626,8 @@
       sharing type MLton.BinIO.outstream = BinIO.outstream
       sharing type MLton.TextIO.instream = TextIO.instream
       sharing type MLton.TextIO.outstream = TextIO.outstream
+      sharing type MLton.Word8Array.t = Word8Array.array
+      sharing type MLton.Word8Vector.t = Word8Vector.vector
    end
    (* bool is already defined as bool and so cannot be shared.
     * So, we where these to get the needed sharing.

Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/top-level/basis.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/top-level/basis.sml	2007-02-02 16:45:13 UTC (rev 5112)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/top-level/basis.sml	2007-02-02 19:35:19 UTC (rev 5113)
@@ -147,8 +147,12 @@
       structure PackReal64Little = PackReal64Little
       structure PackRealBig = PackRealBig
       structure PackRealLittle = PackRealLittle
+      structure PackWord16Big = PackWord16Big
+      structure PackWord16Little = PackWord16Little
       structure PackWord32Big = PackWord32Big
       structure PackWord32Little = PackWord32Little
+      structure PackWord64Big = PackWord64Big
+      structure PackWord64Little = PackWord64Little
       structure Posix = Posix
       structure Real32 = Real32
       structure Real32Array = Real32Array

Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/mlton.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/mlton.sig	2007-02-02 16:45:13 UTC (rev 5112)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/mlton.sig	2007-02-02 19:35:19 UTC (rev 5113)
@@ -50,5 +50,7 @@
       structure Weak: MLTON_WEAK
       structure Word: MLTON_WORD
       structure Word8: MLTON_WORD
+      structure Word8Array: MLTON_MONO_ARRAY
+      structure Word8Vector: MLTON_MONO_VECTOR
       structure World: MLTON_WORLD
    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-02-02 16:45:13 UTC (rev 5112)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/mlton.sml	2007-02-02 19:35:19 UTC (rev 5113)
@@ -81,6 +81,16 @@
       type t = word
    end
 
+structure Word8Array = struct
+   open Word8Array
+   type t = array
+end
+
+structure Word8Vector = struct
+   open Word8Vector
+   type t = vector
+end
+
 val _ = 
    (Primitive.TopLevel.setHandler MLtonExn.topLevelHandler
     ; Primitive.TopLevel.setSuffix 

Copied: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/mono-array.sig (from rev 5073, mlton/trunk/basis-library/mlton/mono-array.sig)

Copied: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/mono-vector.sig (from rev 5073, mlton/trunk/basis-library/mlton/mono-vector.sig)

Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton.mlb	2007-02-02 16:45:13 UTC (rev 5112)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton.mlb	2007-02-02 19:35:19 UTC (rev 5113)
@@ -24,6 +24,8 @@
       signature MLTON_INT_INF
       signature MLTON_IO
       signature MLTON_ITIMER
+      signature MLTON_MONO_ARRAY
+      signature MLTON_MONO_VECTOR
       signature MLTON_PLATFORM
       signature MLTON_POINTER
       signature MLTON_PROC_ENV

Modified: mlton/branches/on-20050822-x86_64-branch/doc/changelog
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/doc/changelog	2007-02-02 16:45:13 UTC (rev 5112)
+++ mlton/branches/on-20050822-x86_64-branch/doc/changelog	2007-02-02 19:35:19 UTC (rev 5113)
@@ -1,5 +1,15 @@
 Here are the changes since version 20051202.
 
+* 2006-12-29
+   - Added command line switch -show {anns|path-map} and deprecated command
+     line switch -show-anns {false|true}.  Use -show path-map to see the
+     complete MLB path map as seen by the compiler.
+
+* 2006-12-20
+   - Changed the output of command line switch -stop f to include mlb-files.
+     This is useful for generating Makefile dependencies.  The old output is
+     easy to recover if necessary (e.g. grep -v '\.mlb$').
+
 * 2006-12-8
    - Added command line switches -{,target}-{as,cc,link}-opt-quote, which
      pass their argument as a single argument to gcc (i.e., without

Modified: mlton/branches/on-20050822-x86_64-branch/ide/emacs/esml-mlb-mode.el
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/ide/emacs/esml-mlb-mode.el	2007-02-02 16:45:13 UTC (rev 5112)
+++ mlton/branches/on-20050822-x86_64-branch/ide/emacs/esml-mlb-mode.el	2007-02-02 19:35:19 UTC (rev 5113)
@@ -38,6 +38,10 @@
 ;; - find-binding-occurance (of a basid)
 ;; - support doc strings in mlb files
 
+;; TBD:
+;; - fix indentation bugs
+;; - use something more robust than `shell-command' to run shell commands
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Prelude
 
@@ -57,27 +61,18 @@
 Unrecognized
 - annotations (see `esml-mlb-show-annotations-command' and
                    `esml-mlb-additional-annotations'),
-- path variables (see `esml-mlb-mlb-path-map-files' and
+- path variables (see `esml-mlb-show-path-map-command',
+                      `esml-mlb-mlb-path-map-files', and
                       `esml-mlb-additional-path-variables'), and
 - path name suffices (see `esml-mlb-path-suffix-regexp') are
 highlighed as warnings."
   :group 'sml)
 
 (defcustom esml-mlb-additional-annotations
-  '(("allowConstant" "false" "true")
-    ("allowFFI" "false" "true")
-    ("allowOverload" "false" "true")
-    ("allowPrim" "false" "true")
-    ("allowRebindEquals" "false" "true")
-    ("deadCode" "false" "true")
-    ("ffiStr" "<longstrid>")
-    ("forceUsed")
-    ("nonexhaustiveExnMatch" "default" "ignore")
-    ("nonexhaustiveMatch" "warn" "ignore" "error")
-    ("redundantMatch" "warn" "ignore" "error")
-    ("sequenceNonUnit" "ignore" "error" "warn")
-    ("warnUnused" "false" "true"))
-  "Additional annotations accepted by your compiler(s)."
+  '()
+  "Additional annotations accepted by your compiler(s).  Note that ML
+Basis mode runs the `esml-mlb-show-annotations-command' to query available
+annotations automatically."
   :type '(repeat (cons :tag "Annotation"
                        (string :tag "Name")
                        (repeat :tag "Values starting with the default"
@@ -86,9 +81,10 @@
   :group 'esml-mlb)
 
 (defcustom esml-mlb-additional-path-variables
-  '(("LIB_MLTON_DIR" . "/usr/lib/mlton"))
+  '()
   "Additional path variables that can not be found in the path map files
-specified by `esml-mlb-mlb-path-map-files'."
+specified by `esml-mlb-mlb-path-map-files' or by running the command
+`esml-mlb-show-path-map-command'."
   :type '(repeat (cons (string :tag "Name") (string :tag "Value")))
   :set 'esml-mlb-set-custom-and-update
   :group 'esml-mlb)
@@ -135,8 +131,8 @@
   :group 'esml-mlb)
 
 (defcustom esml-mlb-show-annotations-command
-  "mlton -expert true -show-anns true"
-  "Shell command used to determine the annotations accepted by a compiler."
+  "mlton -expert true -show anns"
+  "Shell command used to query the available annotations."
   :type 'string
   :set 'esml-mlb-set-custom-and-update
   :group 'esml-mlb)
@@ -149,6 +145,13 @@
   :type 'string
   :group 'esml-mlb)
 
+(defcustom esml-mlb-show-path-map-command
+  "mlton -expert true -show path-map"
+  "Shell command used to query the available path variables."
+  :type 'string
+  :set 'esml-mlb-set-custom-and-update
+  :group 'esml-mlb)
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Faces
 
@@ -195,21 +198,28 @@
   "An association list of known path variables. This variable is updated
 by `esml-mlb-update'.")
 
+(defun esml-mlb-parse-path-variables-from-string (path-map-string)
+  (mapcar (function
+           (lambda (s) (apply 'cons (esml-split-string s "[ \t]+"))))
+          (esml-split-string path-map-string "[ \t]*\n+[ \t]*")))
+
 (defun esml-mlb-parse-path-variables ()
   (setq esml-mlb-path-variables
         (remove-duplicates
          (sort (append
                 esml-mlb-additional-path-variables
+                (esml-mlb-parse-path-variables-from-string
+                 (with-temp-buffer
+                   (save-window-excursion
+                     (shell-command
+                      esml-mlb-show-path-map-command
+                      (current-buffer))
+                     (buffer-string))))
                 (loop for file in esml-mlb-mlb-path-map-files
-                  append (mapcar (function
-                                  (lambda (s)
-                                    (apply 'cons
-                                           (esml-split-string s "[ \t]+"))))
-                                 (esml-split-string
-                                  (with-temp-buffer
-                                    (insert-file-contents file)
-                                    (buffer-string))
-                                  "[ \t]*\n+[ \t]*"))))
+                  append (esml-mlb-parse-path-variables-from-string
+                          (with-temp-buffer
+                            (insert-file-contents file)
+                            (buffer-string)))))
                (function
                 (lambda (a b)
                   (string-lessp (car a) (car b)))))

Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/c.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/c.mlb	2007-02-02 16:45:13 UTC (rev 5112)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/c.mlb	2007-02-02 19:35:19 UTC (rev 5113)
@@ -14,21 +14,27 @@
  *
  * author: Matthias Blume (blume at research.bell-labs.com)
  *)
-local
-   internals/c-int.mlb
+ann
+   "forceUsed"
+   "sequenceNonUnit warn"
+   "warnUnused true"
 in
-   structure Tag
+   local
+      internals/c-int.mlb
+   in
+      structure Tag
 
-   structure MLRep
+      structure MLRep
 
-   signature C
-   structure C
-   signature C_DEBUG
-   structure C_Debug
+      signature C
+      structure C
+      signature C_DEBUG
+      structure C_Debug
 
-   signature ZSTRING
-   structure ZString
+      signature ZSTRING
+      structure ZString
 
-   signature DYN_LINKAGE
-   structure DynLinkage
+      signature DYN_LINKAGE
+      structure DynLinkage
+   end
 end

Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/internals/c-int.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/internals/c-int.mlb	2007-02-02 16:45:13 UTC (rev 5112)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/internals/c-int.mlb	2007-02-02 19:35:19 UTC (rev 5113)
@@ -2,34 +2,42 @@
    $(SML_LIB)/basis/basis.mlb
 
    ../memory/memory.mlb
+in
+   ann
+      "forceUsed"
+      "sequenceNonUnit warn"
+      "warnUnused true"
+   in
+      local
+         ../c.sig
+         ../c-debug.sig
+         c-int.sig
+         c-int.sml
+         c.sml
+         c-debug.sml
 
-   ../c.sig
-   ../c-debug.sig
-   c-int.sig
-   c-int.sml
-   c.sml
-   c-debug.sml
+         ../zstring.sig
+         zstring.sml
+         tag.sml
+      in
+         structure Tag
 
-   ../zstring.sig
-   zstring.sml
-   tag.sml
-in
-   structure Tag
+         structure MLRep
+         signature C
+         structure C
+         signature C_INT
+         structure C_Int
+         signature C_DEBUG
+         structure C_Debug
 
-   structure MLRep
-   signature C
-   structure C
-   signature C_INT
-   structure C_Int
-   signature C_DEBUG
-   structure C_Debug
+         signature ZSTRING
+         structure ZString
 
-   signature ZSTRING
-   structure ZString
+         signature DYN_LINKAGE
+         structure DynLinkage
 
-   signature DYN_LINKAGE
-   structure DynLinkage
-
-   signature CMEMORY
-   structure CMemory
+         signature CMEMORY
+         structure CMemory
+      end
+   end
 end

Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/internals/c-int.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/internals/c-int.sml	2007-02-02 16:45:13 UTC (rev 5112)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/internals/c-int.sml	2007-02-02 19:35:19 UTC (rev 5113)
@@ -45,7 +45,9 @@
         type cword = MLRep.Int.Unsigned.word
         type bf = { a: addr, l: word, r: word, lr: word, m: cword, im: cword }
 
+(*
         fun pair_type_addr (t: 'f objt) (a: addr) = (a, t)
+*)
         fun strip_type (a: addr, _: 'f objt) = a
         fun p_strip_type (a: addr, _: 'f objt) = a
         fun strip_fun (a: addr, _: 'f) = a
@@ -62,7 +64,9 @@
         val op ~>> = MLRep.Int.Unsigned.~>>
         val op && = MLRep.Int.Unsigned.andb
         val op || = MLRep.Int.Unsigned.orb
+(*
         val op ^^ = MLRep.Int.Unsigned.xorb
+*)
         val ~~ = MLRep.Int.Unsigned.notb
     in
 
@@ -168,7 +172,7 @@
        fn w => fn x => w x
     val convert' : (('st, 'sc) obj, ('tt, 'tc) obj) W.witness -> 
                    ('st, 'sc) obj' -> ('tt, 'tc) obj' =
-       fn w => fn x => x
+       fn _ => fn x => x
 
     (*
      * A family of types and corresponding values representing natural numbers.
@@ -399,9 +403,9 @@
         local
             val u2s = MLRep.Int.Signed.fromLarge o MLRep.Int.Unsigned.toLargeIntX
         in
-            fun ubf ({ a, l, r, lr, m, im } : bf) =
+            fun ubf ({ a, l, r=_, lr, m=_, im=_ } : bf) =
                 (CMemory.load_uint a << l) >> lr
-            fun sbf ({ a, l, r, lr, m, im } : bf) =
+            fun sbf ({ a, l, r=_, lr, m=_, im=_ } : bf) =
                 u2s ((CMemory.load_uint a << l) ~>> lr)
         end
     end
@@ -455,7 +459,7 @@
                fn (x, p) => ptr_voidptr' (p_strip_type x, p)
         end
 
-        fun ubf ({ a, l, r, lr, m, im }, x) =
+        fun ubf ({ a, l=_, r, lr=_, m, im }, x) =
            CMemory.store_uint (a, (CMemory.load_uint a && im) ||
                                ((x << r) && m))
 
@@ -498,7 +502,7 @@
 
         val inject : 'o ptr -> voidptr = p_strip_type
         val cast : 'o ptr T.typ -> voidptr -> 'o ptr =
-           fn PTR (null, t) => (fn p => (p, t))
+           fn PTR (_, t) => (fn p => (p, t))
             | _ => bug "Ptr.cast (non-pointer-type)"
 
         val vnull : voidptr = CMemory.null
@@ -526,7 +530,7 @@
            fn ((p, t as PTR (_, t')), i) => (|+! (T.sizeof t') (p, i), t)
             | _ => bug "Ptr.|+| (non-pointer-type)"
         val |-| : ('t, 'c) obj ptr * ('t, 'c) obj ptr -> int =
-           fn ((p, t as PTR (_, t')), (p', _)) => |-! (T.sizeof t') (p, p')
+           fn ((p, PTR (_, t')), (p', _)) => |-! (T.sizeof t') (p, p')
             | _ => bug "Ptr.|-| (non-pointer-type"
 
         val sub : ('t, 'c) obj ptr * int -> ('t, 'c) obj =
@@ -539,7 +543,7 @@
            fn w => fn x => w x
         val convert' : (('st, 'sc) obj ptr, ('tt, 'tc) obj ptr) W.witness ->
                        ('st, 'sc) obj ptr' -> ('tt, 'tc) obj ptr' =
-           fn w => fn x => x
+           fn _ => fn x => x
 
         val ro : ('t, 'c) obj ptr   -> ('t, ro) obj ptr =
            fn x => convert (W.pointer (W.ro W.trivial)) x
@@ -577,7 +581,7 @@
            fn ((a, PTR (_, t)), d) => (a, T.arr (t, d))
             | _ => bug "Arr.reconstruct (non-pointer)"
 
-        fun reconstruct' (a: addr, d: 'n Dim.dim) = a
+        fun reconstruct' (a: addr, _: 'n Dim.dim) = a
 
         fun dim (_: addr, t) = T.dim t
     end

Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/memory/linkage-libdl.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/memory/linkage-libdl.sml	2007-02-02 16:45:13 UTC (rev 5112)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/memory/linkage-libdl.sml	2007-02-02 19:35:19 UTC (rev 5113)
@@ -99,8 +99,9 @@
         end
 
         (* label used for CleanUp *)
+(*
         val label = "DynLinkNewEra"
-
+*)
         (* generate a new "era" indicator *)
         fun newEra () = ref ()
 

Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/memory/memory.32bit-unix.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/memory/memory.32bit-unix.mlb	2007-02-02 16:45:13 UTC (rev 5112)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/memory/memory.32bit-unix.mlb	2007-02-02 19:35:19 UTC (rev 5113)
@@ -1,25 +1,33 @@
 local
    $(SML_LIB)/basis/basis.mlb
    $(SML_LIB)/basis/mlton.mlb
-
-   linkage.sig
-   ann "allowFFI true" in
-      linkage-libdl.sml
+in
+   ann
+      "forceUsed"
+      "sequenceNonUnit warn"
+      "warnUnused true"
+   in
+      local
+         linkage.sig
+         ann "allowFFI true" in
+            linkage-libdl.sml
+         end
+         bitop-fn.sml
+         mlrep-i8i16i32i32i64f32f64.sml
+         memaccess.sig
+         memaccess-a4c1s2i4l4ll8f4d8.sml
+         memalloc.sig
+         ann "allowFFI true" in
+            memalloc-a4-unix.sml
+         end
+         memory.sig
+         memory.sml
+      in
+         signature CMEMORY
+         structure CMemory
+         signature DYN_LINKAGE
+         structure DynLinkage
+         structure MLRep
+      end
    end
-   bitop-fn.sml
-   mlrep-i8i16i32i32i64f32f64.sml
-   memaccess.sig
-   memaccess-a4c1s2i4l4ll8f4d8.sml
-   memalloc.sig
-   ann "allowFFI true" in
-      memalloc-a4-unix.sml
-   end
-   memory.sig
-   memory.sml
-in
-   signature CMEMORY
-   structure CMemory
-   signature DYN_LINKAGE
-   structure DynLinkage
-   structure MLRep
 end

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/ast/ast-mlbs.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/ast/ast-mlbs.fun	2007-02-02 16:45:13 UTC (rev 5112)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/ast/ast-mlbs.fun	2007-02-02 19:35:19 UTC (rev 5113)
@@ -128,7 +128,8 @@
                      else let
                              val () = b := true
                           in
-                             sourceFilesBasdec (Promise.force dec)
+                             Buffer.add (sourceFiles, fileAbs)
+                             ; sourceFilesBasdec (Promise.force dec)
                           end
                end
           | Open _ => ()

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/ast/prim-tycons.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/ast/prim-tycons.fun	2007-02-02 16:45:13 UTC (rev 5112)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/ast/prim-tycons.fun	2007-02-02 19:35:19 UTC (rev 5113)
@@ -11,30 +11,42 @@
 
 open S
 
+structure BindingStrength =
+   struct
+      datatype t =
+         Arrow
+       | Tuple
+       | Unit
+
+      val arrow = Arrow
+      val tuple = Tuple
+      val unit = Unit
+   end
+
 datatype z = datatype RealSize.t
 
 type tycon = t
 
-val array = fromString "array"
-val arrow = fromString "->"
-val bool = fromString "bool"
-val exn = fromString "exn"
-val intInf = fromString "intInf"
-val list = fromString "list"
-val pointer = fromString "pointer"
-val reff = fromString "ref"
-val thread = fromString "thread"
-val tuple = fromString "*"
-val vector = fromString "vector"
-val weak = fromString "weak"
+local
+   fun make s = (s, fromString s)
+in
+   val array = make "array"
+   val arrow = make "->"
+   val bool = make "bool"
+   val exn = make "exn"
+   val intInf = make "intInf"
+   val list = make "list"
+   val pointer = make "pointer"
+   val reff = make "ref"
+   val thread = make "thread"
+   val tuple = make "*"
+   val vector = make "vector"
+   val weak = make "weak"
+end
 
 datatype z = datatype Kind.t
 datatype z = datatype AdmitsEquality.t
 
-val isBool = fn c => equals (c, bool)
-val isExn = fn c => equals (c, exn)
-val isPointer = fn c => equals (c, pointer)
-
 local
    fun 'a make (prefix: string,
                 all: 'a list,
@@ -45,22 +57,31 @@
       let
          val all =
             Vector.fromListMap
-            (all, fn s =>
-             (fromString (concat [prefix, Bits.toString (bits s)]), s))
+            (all, fn s => let
+               val name = concat [prefix, Bits.toString (bits s)]
+            in
+               {name = name,
+                size = s,
+                tycon = fromString name}
+            end)
          val fromSize =
             memo
             (fn s =>
-             case Vector.peek (all, fn (_, s') => equalsA (s, s')) of
+             case Vector.peek (all, fn {size = s', ...} => equalsA (s, s')) of
                 NONE => Error.bug "PrimTycons.make.fromSize"
-              | SOME (tycon, _) => tycon)
-         fun is t = Vector.exists (all, fn (t', _) => equals (t, t'))
+              | SOME {tycon, ...} => tycon)
+         fun is t = Vector.exists (all, fn {tycon = t', ...} => equals (t, t'))
          fun de t = 
-            case Vector.peek (all, fn (t', _) => equals (t, t')) of
+            case Vector.peek (all, fn {tycon = t', ...} => equals (t, t')) of
                NONE => Error.bug "PrimTycons.make.de"
-             | SOME (_, s') => s'
+             | SOME {size, ...} => size
          val prims =
-            Vector.toListMap (all, fn (tycon, _) =>
-                              (tycon, Arity 0, admitsEquality))
+            Vector.toListMap (all, fn {name, tycon, ...} =>
+                              {admitsEquality = admitsEquality,
+                               kind = Arity 0,
+                               name = name,
+                               tycon = tycon})
+         val all = Vector.map (all, fn {tycon, size, ...} => (tycon, size))
       in
          (fromSize, all, is, de, prims)
       end
@@ -91,6 +112,39 @@
       end
 end
 
+val prims =
+   List.map ([(array, Arity 1, Always),
+              (arrow, Arity 2, Never),
+              (bool, Arity 0, Sometimes),
+              (exn, Arity 0, Never),
+              (intInf, Arity 0, Sometimes),
+              (list, Arity 1, Sometimes),
+              (pointer, Arity 0, Always),
+              (reff, Arity 1, Always),
+              (thread, Arity 0, Never),
+              (tuple, Nary, Sometimes),
+              (vector, Arity 1, Sometimes),
+              (weak, Arity 1, Never)],
+             fn ((name, tycon), kind, admitsEquality) =>
+             {admitsEquality = admitsEquality,
+              kind = kind,
+              name = name,
+              tycon = tycon})
+   @ primChars @ primInts @ primReals @ primWords
+
+val array = #2 array
+val arrow = #2 arrow
+val bool = #2 bool
+val exn = #2 exn
+val intInf = #2 intInf
+val list = #2 list
+val pointer = #2 pointer
+val reff = #2 reff
+val thread = #2 thread
+val tuple = #2 tuple
+val vector = #2 vector
+val weak = #2 weak
+
 val defaultChar = fn () => 
    case !Control.defaultChar of
       "char8" => char CharSize.C8
@@ -116,26 +170,15 @@
     | "word64" => word (WordSize.fromBits (Bits.fromInt 64))
     | _ => Error.bug "PrimTycons.defaultWord"
 
+val isBool = fn c => equals (c, bool)
+val isExn = fn c => equals (c, exn)
+val isPointer = fn c => equals (c, pointer)
 val isIntX = fn c => equals (c, intInf) orelse isIntX c
 val deIntX = fn c => if equals (c, intInf) then NONE else SOME (deIntX c)
 
-val prims =
-   [(array, Arity 1, Always),
-    (arrow, Arity 2, Never),
-    (bool, Arity 0, Sometimes),
-    (exn, Arity 0, Never),
-    (intInf, Arity 0, Sometimes),
-    (list, Arity 1, Sometimes),
-    (pointer, Arity 0, Always),
-    (reff, Arity 1, Always),
-    (thread, Arity 0, Never),
-    (tuple, Nary, Sometimes),
-    (vector, Arity 1, Sometimes),
-    (weak, Arity 1, Never)]
-   @ primChars @ primInts @ primReals @ primWords
-
 fun layoutApp (c: t,
-               args: (Layout.t * {isChar: bool, needsParen: bool}) vector) =
+               args: (Layout.t * ({isChar: bool}
+                                  * BindingStrength.t)) vector) =
    let
       local
          open Layout
@@ -144,37 +187,52 @@
          val seq = seq
          val str = str
       end
-      fun maybe (l, {isChar = _, needsParen}) =
-         if needsParen
-            then Layout.paren l
-         else l
+      datatype z = datatype BindingStrength.t
+      datatype binding_context =
+         ArrowLhs
+       | ArrowRhs
+       | TupleElem
+       | Tyseq1
+       | TyseqN
+      fun maybe bindingContext (l, ({isChar = _}, bindingStrength)) =
+         case (bindingStrength, bindingContext) of
+            (Unit, _) => l
+          | (Tuple, ArrowLhs) => l
+          | (Tuple, ArrowRhs) => l
+          | (Tuple, TyseqN) => l
+          | (Arrow, ArrowRhs) => l
+          | (Arrow, TyseqN) =>  l
+          | _ => Layout.paren l
       fun normal () =
          let
             val ({isChar}, lay) =
                case Vector.length args of
                   0 => ({isChar = equals (c, defaultChar ())}, layout c)
                 | 1 => ({isChar = false},
-                        seq [maybe (Vector.sub (args, 0)), str " ", layout c])
+                        seq [maybe Tyseq1 (Vector.sub (args, 0)),
+                             str " ", layout c])
                 | _ => ({isChar = false},
-                        seq [Layout.tuple (Vector.toListMap (args, maybe)),
+                        seq [Layout.tuple
+                             (Vector.toListMap (args, maybe TyseqN)),
                              str " ", layout c])
          in
-            (lay, {isChar = isChar, needsParen = false})
+            (lay, ({isChar = isChar}, Unit))
          end
    in
       if equals (c, arrow)
-         then (mayAlign [maybe (Vector.sub (args, 0)),
-                         seq [str "-> ", maybe (Vector.sub (args, 1))]],
-               {isChar = false, needsParen = true})
+         then (mayAlign [maybe ArrowLhs (Vector.sub (args, 0)),
+                         seq [str "-> ",
+                              maybe ArrowRhs (Vector.sub (args, 1))]],
+               ({isChar = false}, Arrow))
       else if equals (c, tuple)
          then if 0 = Vector.length args
-                 then (str "unit", {isChar = false, needsParen = false})
+                 then (str "unit", ({isChar = false}, Unit))
               else (mayAlign (Layout.separateLeft
-                              (Vector.toListMap (args, maybe), "* ")),
-                    {isChar = false, needsParen = true})
+                              (Vector.toListMap (args, maybe TupleElem), "* ")),
+                    ({isChar = false}, Tuple))
       else if equals (c, vector)
-         then if #isChar (#2 (Vector.sub (args, 0)))
-                 then (str "string", {isChar = false, needsParen = false})
+         then if #isChar (#1 (#2 (Vector.sub (args, 0))))
+                 then (str "string", ({isChar = false}, Unit))
               else normal ()
       else normal ()
    end

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/ast/prim-tycons.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/ast/prim-tycons.sig	2007-02-02 16:45:13 UTC (rev 5112)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/ast/prim-tycons.sig	2007-02-02 19:35:19 UTC (rev 5113)
@@ -27,10 +27,21 @@
       val layout: t -> Layout.t
    end
 
+signature BINDING_STRENGTH =
+   sig
+      type t
+
+      val arrow: t
+      val tuple: t
+      val unit: t
+   end
+
 signature PRIM_TYCONS =
    sig
       include PRIM_TYCONS_SUBSTRUCTS
 
+      structure BindingStrength: BINDING_STRENGTH
+
       type tycon
 
       val array: tycon
@@ -57,11 +68,14 @@
       val isRealX: tycon -> bool
       val isWordX: tycon -> bool
       val layoutApp:
-         tycon * (Layout.t * {isChar: bool, needsParen: bool}) vector
-         -> Layout.t * {isChar: bool, needsParen: bool}
+         tycon * (Layout.t * ({isChar: bool} * BindingStrength.t)) vector
+         -> Layout.t * ({isChar: bool} * BindingStrength.t)
       val list: tycon
       val pointer: tycon
-      val prims: (tycon * Kind.t * AdmitsEquality.t) list
+      val prims: {admitsEquality: AdmitsEquality.t,
+                  kind: Kind.t,
+                  name: string,
+                  tycon: tycon} list
       val real: RealSize.t -> tycon
       val reals: (tycon * RealSize.t) vector
       val reff: tycon

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/ast/sources.cm
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/ast/sources.cm	2007-02-02 16:45:13 UTC (rev 5112)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/ast/sources.cm	2007-02-02 19:35:19 UTC (rev 5113)
@@ -10,6 +10,7 @@
 
 signature ADMITS_EQUALITY
 signature AST
+signature BINDING_STRENGTH
 signature CHAR_SIZE
 signature FIELD
 signature INT_SIZE

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/ast/sources.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/ast/sources.mlb	2007-02-02 16:45:13 UTC (rev 5112)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/ast/sources.mlb	2007-02-02 19:35:19 UTC (rev 5113)
@@ -56,6 +56,7 @@
 in
    signature ADMITS_EQUALITY
    signature AST
+   signature BINDING_STRENGTH
    signature CHAR_SIZE
    signature FIELD
    signature INT_SIZE

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/atoms/hash-type.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/atoms/hash-type.fun	2007-02-02 16:45:13 UTC (rev 5112)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/atoms/hash-type.fun	2007-02-02 19:35:19 UTC (rev 5113)
@@ -84,8 +84,9 @@
       fun layout (ty: t): Layout.t =
          #1 (hom {con = Tycon.layoutApp,
                   ty = ty,
-                  var = fn a => (Tyvar.layout a, {isChar = false,
-                                                  needsParen = false})})
+                  var = fn a => (Tyvar.layout a,
+                                 ({isChar = false},
+                                  Tycon.BindingStrength.unit))})
 
       val toString = Layout.toString o layout
 

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/atoms/tycon.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/atoms/tycon.fun	2007-02-02 16:45:13 UTC (rev 5112)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/atoms/tycon.fun	2007-02-02 19:35:19 UTC (rev 5113)
@@ -35,7 +35,7 @@
       open Layout
    in
       align
-      (List.map (prims, fn (c, _, _) =>
+      (List.map (prims, fn {tycon = c, ...} =>
                  seq [layout c, str " size is ",
                       Int.layout (MLton.size c),
                       str " plist length is ",

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/control/control-flags.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/control/control-flags.sig	2007-02-02 16:45:13 UTC (rev 5112)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/control/control-flags.sig	2007-02-02 19:35:19 UTC (rev 5113)
@@ -152,9 +152,12 @@
 
       val inlineIntoMain: bool ref
 
-      (* The input file on the command line, minus path and extension *)
+      (* The input file on the command line, minus path and extension. *)
       val inputFile: File.t ref
 
+      (* Whether or not the elaborator keeps def-use information. *)
+      val keepDefUse: bool ref
+         
       (* Keep dot files for whatever SSA files are produced. *)
       val keepDot: bool ref
 
@@ -192,6 +195,8 @@
       val maxFunctionSize: int ref
 
       val mlbPathMaps: string list ref
+      val mlbPathMap: unit -> {var: string,
+                               path: string} list
 
       structure Native:
          sig

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/control/control-flags.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/control/control-flags.sml	2007-02-02 16:45:13 UTC (rev 5112)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/control/control-flags.sml	2007-02-02 19:35:19 UTC (rev 5113)
@@ -706,6 +706,10 @@
                         default = false,
                         toString = Bool.toString}
 
+val keepDefUse = control {name = "keep def use",
+                          default = true,
+                          toString = Bool.toString}
+
 val keepDot = control {name = "keep dot",
                        default = false,
                        toString = Bool.toString}
@@ -987,6 +991,49 @@
                         default = Linux,
                         toString = MLton.Platform.OS.toString}
 
+local
+   fun make (file: File.t) =
+      if not (File.canRead file) then
+         Error.bug (concat ["can't read MLB path map file: ", file])
+      else
+         List.keepAllMap
+         (File.lines file, fn line =>
+          if String.forall (line, Char.isSpace)
+             then NONE
+          else
+             case String.tokens (line, Char.isSpace) of
+                [var, path] => SOME {var = var, path = path}
+              | _ => Error.bug (concat ["strange mlb path mapping: ",
+                                        file, ":: ", line]))
+in
+   fun mlbPathMap () =
+      List.rev
+         (List.concat
+             [[{var = "LIB_MLTON_DIR",
+                path = !libDir},
+               {var = "TARGET_ARCH",
+                path = String.toLower (MLton.Platform.Arch.toString
+                                       (!targetArch))},
+               {var = "TARGET_OS",
+                path = String.toLower (MLton.Platform.OS.toString
+                                       (!targetOS))},
+               {var = "OBJPTR_REP",
+                path = "objptr-rep32.sml"},
+               {var = "HEADER_WORD",
+                path = "header-word32.sml"},
+               {var = "SEQINDEX_INT",
+                path = "seqindex-int32.sml"},
+               {var = "DEFAULT_CHAR",
+                path = concat ["default-", !defaultChar, ".sml"]},
+               {var = "DEFAULT_INT",
+                path = concat ["default-", !defaultInt, ".sml"]},
+               {var = "DEFAULT_REAL",
+                path = concat ["default-", !defaultReal, ".sml"]},
+               {var = "DEFAULT_WORD",
+                path = concat ["default-", !defaultWord, ".sml"]}],
+              List.concat (List.map (!mlbPathMaps, make))])
+end
+
 val typeCheck = control {name = "type check",
                          default = false,
                          toString = Bool.toString}

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/elaborate-core.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/elaborate-core.fun	2007-02-02 16:45:13 UTC (rev 5112)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/elaborate-core.fun	2007-02-02 19:35:19 UTC (rev 5113)
@@ -658,10 +658,7 @@
                                            val {args, instance} =
                                               Scheme.instantiate s
                                         in
-                                           if Type.canUnify
-                                              (instance,
-                                               Type.arrow (Type.new (),
-                                                           Type.new ()))
+                                           if Type.isArrow instance
                                               then
                                                  (Control.error
                                                   (region,

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/elaborate-env.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/elaborate-env.fun	2007-02-02 16:45:13 UTC (rev 5112)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/elaborate-env.fun	2007-02-02 19:35:19 UTC (rev 5113)
@@ -84,7 +84,7 @@
       fun explainDoesNotAdmitEquality (t: t): Layout.t =
          let
             open Layout
-            val wild = (str "_", {isChar = false, needsParen = false})
+            val wild = (str "_", ({isChar = false}, Tycon.BindingStrength.unit))
             fun con (c, ts) =
                let
                   fun keep {showInside: bool} =
@@ -101,7 +101,8 @@
                   case ! (Tycon.admitsEquality c) of
                      Always => NONE
                    | Never => SOME (bracket (#1 (keep {showInside = false})),
-                                    {isChar = false, needsParen = false})
+                                    ({isChar = false},
+                                     Tycon.BindingStrength.unit))
                    | Sometimes =>
                         if Vector.exists (ts, Option.isSome)
                            then SOME (keep {showInside = true})
@@ -134,7 +135,7 @@
                                        seq [Field.layout f, str ": ", z] :: ac),
                                 ",")),
                               str ending],
-                             {isChar = false, needsParen = false})
+                             ({isChar = false}, Tycon.BindingStrength.unit))
                          end
                     | SOME v =>
                          Tycon.layoutApp
@@ -688,7 +689,7 @@
               uses = uses}))
    end
 
-val allTycons: Tycon.t list ref = ref (List.map (Tycon.prims, #1))
+val allTycons: Tycon.t list ref = ref (List.map (Tycon.prims, #tycon))
 val newTycons: (Tycon.t * Kind.t * Region.t) list ref = ref []
 
 val newTycon: string * Kind.t * AdmitsEquality.t * Region.t -> Tycon.t =
@@ -1154,9 +1155,13 @@
       fun newUses (T {defUses, ...}, class, def) =
          let
             val u = Uses.new ()
-            val _ = List.push (defUses, {class = class,
-                                         def = def,
-                                         uses = u})
+            val _ =
+               if !Control.keepDefUse then
+                  List.push (defUses, {class = class,
+                                       def = def,
+                                       uses = u})
+               else
+                  ()
          in
             u
          end

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/interface.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/interface.fun	2007-02-02 16:45:13 UTC (rev 5112)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/interface.fun	2007-02-02 19:35:19 UTC (rev 5113)
@@ -144,7 +144,8 @@
                     ("id", TyconId.layout id)]
          end
 
-      fun layoutApp (t, _) = (layout t, {isChar = false, needsParen = false})
+      fun layoutApp (t, _) =
+          (layout t, ({isChar = false}, Etycon.BindingStrength.unit))
 
       val copies: copy list ref = ref []
 
@@ -247,7 +248,7 @@
 
       local
          open Layout
-         fun simple l = (l, {isChar = false, needsParen = false})
+         fun simple l = (l, ({isChar = false}, Etycon.BindingStrength.unit))
          fun loop t =
             case t of
                Con (c, ts) => Tycon.layoutApp (c, Vector.map (ts, loop))

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/interface.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/interface.sig	2007-02-02 16:45:13 UTC (rev 5112)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/interface.sig	2007-02-02 19:35:19 UTC (rev 5113)
@@ -15,6 +15,8 @@
             structure Kind: TYCON_KIND
             structure Tycon:
                sig
+                  structure BindingStrength: BINDING_STRENGTH
+
                   type t
 
                   val admitsEquality: t -> AdmitsEquality.t ref
@@ -23,8 +25,9 @@
                   val exn: t
                   val layout: t -> Layout.t
                   val layoutApp:
-                     t * (Layout.t * {isChar: bool, needsParen: bool}) vector
-                     -> Layout.t * {isChar: bool, needsParen: bool}
+                     t * (Layout.t
+                          * ({isChar: bool} * BindingStrength.t)) vector
+                     -> Layout.t * ({isChar: bool} * BindingStrength.t)
                   val tuple: t
                end
 

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/type-env.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/type-env.fun	2007-02-02 16:45:13 UTC (rev 5112)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/type-env.fun	2007-02-02 19:35:19 UTC (rev 5113)
@@ -84,10 +84,10 @@
 
 structure Lay =
    struct
-      type t = Layout.t * {isChar: bool, needsParen: bool}
+      type t = Layout.t * ({isChar: bool} * Tycon.BindingStrength.t)
 
       fun simple (l: Layout.t): t =
-         (l, {isChar = false, needsParen = false})
+         (l, ({isChar = false}, Tycon.BindingStrength.unit))
    end
 
 structure UnifyResult =
@@ -124,7 +124,8 @@
                      region = ref NONE,
                      time = ref (Time.now ())})
 
-val _ = List.foreach (Tycon.prims, fn (c, _, a) => initAdmitsEquality (c, a))
+val _ = List.foreach (Tycon.prims, fn {tycon = c, admitsEquality = a, ...} =>
+                      initAdmitsEquality (c, a))
 
 structure Equality:>
    sig
@@ -369,11 +370,11 @@
    Trace.trace ("TypeEnv.tyvarTime", Tyvar.layout, Ref.layout Time.layout) tyvarTime
 
 local
-   type z = Layout.t * {isChar: bool, needsParen: bool}
+   type z = Layout.t * ({isChar: bool} * Tycon.BindingStrength.t)
    open Layout
 in
    fun simple (l: Layout.t): z =
-      (l, {isChar = false, needsParen = false})
+      (l, ({isChar = false}, Tycon.BindingStrength.unit))
    val dontCare: z = simple (str "_")
    fun bracket l = seq [str "[", l, str "]"]
    fun layoutRecord (ds: (Field.t * bool * z) list, flexible: bool) =
@@ -599,8 +600,9 @@
          end
 
       fun makeLayoutPretty (): {destroy: unit -> unit,
-                                lay: t -> Layout.t * {isChar: bool,
-                                                      needsParen: bool}} =
+                                lay: t -> Layout.t
+                                          * ({isChar: bool}
+                                          * Tycon.BindingStrength.t)} =
          let
             val str = Layout.str
             fun con (_, c, ts) = Tycon.layoutApp (c, ts)
@@ -719,6 +721,8 @@
       fun new () = unknown {canGeneralize = true,
                             equality = Equality.unknown ()}
 
+      val new = Trace.trace ("TypeEnv.Type.new", Unit.layout, layout) new
+
       fun newFlex {fields, spine} =
          newTy (FlexRecord {fields = fields,
                             spine = spine},
@@ -775,6 +779,11 @@
 
       val unit = tuple (Vector.new0 ())
 
+      fun isArrow t =
+         case toType t of
+            Con (c, _) => Tycon.equals (c, Tycon.arrow)
+          | _ => false
+
       fun isBool t =
          case toType t of
             Con (c, _) => Tycon.isBool c
@@ -938,10 +947,9 @@
                          (NotUnifiable (l, l'),
                           Unknown (Unknown.new {canGeneralize = true}))
                       val bracket =
-                         fn (l, {isChar, needsParen = _}) =>
+                         fn (l, ({isChar}, _)) =>
                          (bracket l,
-                          {isChar = isChar,
-                           needsParen = false})
+                          ({isChar = isChar}, Tycon.BindingStrength.unit))
                       fun notUnifiableBracket (l, l') =
                          notUnifiable (bracket l, bracket l')
                       fun flexToRecord (fields, spine) =
@@ -1653,7 +1661,7 @@
                                        Time.layout (!time),
                                        str " where getTime is ",
                                        Time.layout genTime],
-                                  Out.standard)
+                                  Out.error)
                       end
              in
                 if not (Time.<= (genTime, !time))

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/type-env.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/type-env.sig	2007-02-02 16:45:13 UTC (rev 5112)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/type-env.sig	2007-02-02 19:35:19 UTC (rev 5113)
@@ -38,6 +38,7 @@
                           record: 'a SortedRecord.t -> 'a,
                           replaceSynonyms: bool,
                           var: Tyvar.t -> 'a} -> 'a
+            val isArrow: t -> bool
             val isBool: t -> bool
             val isCharX: t -> bool
             val isExn: t -> bool
@@ -52,8 +53,8 @@
                                                   hom: t -> 'a}
             val makeLayoutPretty:
                unit -> {destroy: unit -> unit,
-                        lay: t -> Layout.t * {isChar: bool,
-                                              needsParen: bool}}
+                        lay: t -> Layout.t * ({isChar: bool}
+                                              * Tycon.BindingStrength.t)}
             (* minTime (t, time) makes every component of t occur no later than
              * time.  This will display a type error message if time is before
              * the definition time of some component of t.

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/front-end/mlb-front-end.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/front-end/mlb-front-end.fun	2007-02-02 16:45:13 UTC (rev 5112)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/front-end/mlb-front-end.fun	2007-02-02 19:35:19 UTC (rev 5113)
@@ -84,46 +84,8 @@
       val psi : (File.t * Ast.Basdec.t Promise.t) HashSet.t =
          HashSet.new {hash = String.hash o #1}
       local
-         fun make (file: File.t) =
-            if not (File.canRead file) then
-               Error.bug (concat ["can't read MLB path map file: ", file])
-            else
-               List.keepAllMap
-               (File.lines file, fn line =>
-                if String.forall (line, Char.isSpace)
-                   then NONE
-                else 
-                   case String.tokens (line, Char.isSpace) of
-                      [var, path] => SOME {var = var, path = path}
-                    | _ => Error.bug (concat ["strange mlb path mapping: ", 
-                                              file, ":: ", line]))
          val pathMap =
-            List.rev
-            (List.concat
-             [[{var = "LIB_MLTON_DIR", 
-                path = !Control.libDir},
-               {var = "TARGET_ARCH",
-                path = String.toLower (MLton.Platform.Arch.toString
-                                       (!Control.targetArch))},
-               {var = "TARGET_OS",
-                path = String.toLower (MLton.Platform.OS.toString
-                                       (!Control.targetOS))},
-               {var = "OBJPTR_REP",
-                path = "objptr-rep32.sml"},
-               {var = "HEADER_WORD",
-                path = "header-word32.sml"},
-               {var = "SEQINDEX_INT",
-                path = "seqindex-int32.sml"},
-               {var = "DEFAULT_CHAR",
-                path = concat ["default-", !Control.defaultChar, ".sml"]},
-               {var = "DEFAULT_INT",
-                path = concat ["default-", !Control.defaultInt, ".sml"]},
-               {var = "DEFAULT_REAL",
-                path = concat ["default-", !Control.defaultReal, ".sml"]},
-               {var = "DEFAULT_WORD",
-                path = concat ["default-", !Control.defaultWord, ".sml"]}],
-              List.concat (List.map (!Control.mlbPathMaps, make))])
-
+             Control.mlbPathMap ()
          fun peekPathMap var' =
             case List.peek (pathMap, fn {var,...} =>
                             var = var') of

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/main/compile.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/main/compile.fun	2007-02-02 16:45:13 UTC (rev 5112)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/main/compile.fun	2007-02-02 19:35:19 UTC (rev 5113)
@@ -242,10 +242,9 @@
             let
                val _ =
                   List.foreach
-                  (Tycon.prims, fn (tycon, kind, _) =>
+                  (Tycon.prims, fn {kind, name, tycon, ...} =>
                    extendTycon
-                   (E, Ast.Tycon.fromSymbol (Symbol.fromString
-                                             (Tycon.originalName tycon),
+                   (E, Ast.Tycon.fromSymbol (Symbol.fromString name,
                                              Region.bogus),
                     TypeStr.tycon (tycon, kind),
                     {forceUsed = false, isRebind = false}))

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/main/main.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/main/main.fun	2007-02-02 16:45:13 UTC (rev 5112)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/main/main.fun	2007-02-02 19:35:19 UTC (rev 5113)
@@ -47,6 +47,11 @@
        | Yes 
    end
 
+structure Show =
+   struct
+      datatype t = Anns | PathMap
+   end
+
 val gcc: string ref = ref "<unset>"
 val asOpts: {opt: string, pred: OptPred.t} list ref = ref []
 val ccOpts: {opt: string, pred: OptPred.t} list ref = ref []
@@ -65,7 +70,7 @@
 val profileSet: bool ref = ref false
 val profileTimeSet: bool ref = ref false
 val runtimeArgs: string list ref = ref ["@MLton"]
-val showAnns: bool ref = ref false
+val show: Show.t option ref = ref NONE
 val stop = ref Place.OUT
 
 val targetMap: unit -> {arch: MLton.Platform.Arch.t,
@@ -451,8 +456,20 @@
         boolRef profileStack),
        (Normal, "runtime", " <arg>", "pass arg to runtime via @MLton",
         SpaceString (fn s => List.push (runtimeArgs, s))),
-       (Expert, "show-anns", " {false|true}", "show annotations",
-        boolRef showAnns),
+       (Expert, "show", " {anns|path-map}", "print specified data and stop",
+        SpaceString
+        (fn s =>
+         show := SOME (case s of
+                          "anns" => Show.Anns
+                        | "path-map" => Show.PathMap
+                        | _ => usage (concat ["invalid -show arg: ", s])))),
+       (Expert, "show-anns", " {false|true}", "deprecated (use -show anns)",
+        Bool
+        (fn b =>
+         (if b then show := SOME Show.Anns else ()
+          ; Out.output
+            (Out.error,
+             "Warning: deprecated option: -show-anns.  Use -show anns.\n")))),
        (Normal, "show-basis", " <file>", "write out the final basis environment",
         SpaceString (fn s => showBasis := SOME s)),
        (Normal, "show-def-use", " <file>", "write def-use information",
@@ -583,11 +600,24 @@
                       | SOME c => c)
       val () = MLton.Rusage.measureGC (!verbosity <> Silent)
       val () =
-         if !showAnns then
-            (Layout.outputl (Control.Elaborate.document {expert = !expert}, 
-                             Out.standard)
+         case !show of
+            NONE => ()
+          | SOME info =>
+            (case info of
+                Show.Anns =>
+                Layout.outputl (Control.Elaborate.document {expert = !expert},
+                                Out.standard)
+              | Show.PathMap =>
+                let
+                   open Layout
+                in
+                   outputl (align
+                            (List.map (Control.mlbPathMap (),
+                                       fn {var, path, ...} =>
+                                       str (concat [var, " ", path]))),
+                            Out.standard)
+                end
              ; let open OS.Process in exit success end)
-         else ()
       val () = if !profileTimeSet
                   then (case !codegen of
                            Native => profile := ProfileTimeLabel
@@ -675,10 +705,11 @@
          if !keepDot andalso List.isEmpty (!keepPasses)
             then keepSSA := true
          else ()
-      val keepDefUse = 
-         isSome (!showDefUse)
-         orelse (Control.Elaborate.enabled Control.Elaborate.warnUnused)
-         orelse (Control.Elaborate.default Control.Elaborate.warnUnused)
+      val () =
+         keepDefUse
+         := (isSome (!showDefUse)
+             orelse (Control.Elaborate.enabled Control.Elaborate.warnUnused)
+             orelse (Control.Elaborate.default Control.Elaborate.warnUnused))
       val warnMatch =
           (Control.Elaborate.enabled Control.Elaborate.nonexhaustiveMatch)
           orelse (Control.Elaborate.enabled Control.Elaborate.redundantMatch)
@@ -688,7 +719,7 @@
                   Control.Elaborate.DiagEIW.Ignore)
       val _ = elaborateOnly := (stop = Place.TypeCheck
                                 andalso not (warnMatch)
-                                andalso not (keepDefUse))
+                                andalso not (!keepDefUse))
       val _ =
          if !codegen = Bytecode andalso !profile <> ProfileNone
             then usage (concat ["bytecode doesn't support profiling\n"])

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/ssa/ssa-tree2.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/ssa/ssa-tree2.fun	2007-02-02 16:45:13 UTC (rev 5112)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/ssa/ssa-tree2.fun	2007-02-02 19:35:19 UTC (rev 5113)
@@ -59,7 +59,8 @@
                                        then seq [layout elt, str " ref"]
                                     else layout elt
                               in
-                                 (lay, {isChar = false, needsParen = false})
+                                 (lay, ({isChar = false},
+                                        Tycon.BindingStrength.unit))
                               end))))
       end
 

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/xml/monomorphise.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/xml/monomorphise.fun	2007-02-02 16:45:13 UTC (rev 5112)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/xml/monomorphise.fun	2007-02-02 19:35:19 UTC (rev 5113)
@@ -94,7 +94,7 @@
          Property.destGetSet (Tycon.plist,
                               Property.initRaise ("mono", Tycon.layout))
       val _ =
-         List.foreach (Tycon.prims, fn (t, _, _) =>
+         List.foreach (Tycon.prims, fn {tycon = t, ...} =>
                        setTycon (t, fn ts => Stype.con (t, ts)))
       val {set = setTyvar, get = getTyvar: Tyvar.t -> Stype.t, ...} =
          Property.getSet (Tyvar.plist,

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/util/safe.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/util/safe.h	2007-02-02 16:45:13 UTC (rev 5112)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/util/safe.h	2007-02-02 19:35:19 UTC (rev 5113)
@@ -47,9 +47,14 @@
   size_t res;
 
   res = fread (buf, size, count, f);
-  if (res != count)
-    diee ("fread (_, %zu, %zu, _) failed (only read %zu).\n",
-          size, count, res);
+  if (res != count) {
+    if (feof (f))
+       fprintf (stderr, "eof\n");
+    else
+       fprintf (stderr, "errno = %d\n", ferror (f));  
+    diee ("fread ("FMTPTR", %zu, %zu, _) failed (only read %zu).\n",
+          (uintptr_t)buf, size, count, res);
+  }
 }
 
 static inline void fwrite_safe (const void *buf, size_t size, size_t count, FILE *f) {




More information about the MLton-commit mailing list