[MLton-commit] r4469

Matthew Fluet MLton@mlton.org
Sat, 6 May 2006 13:24:55 -0700


Elaborate constants to default types
----------------------------------------------------------------------

U   mlton/branches/on-20050822-x86_64-branch/mlton/ast/char-size.fun
U   mlton/branches/on-20050822-x86_64-branch/mlton/ast/char-size.sig
U   mlton/branches/on-20050822-x86_64-branch/mlton/ast/int-size.fun
U   mlton/branches/on-20050822-x86_64-branch/mlton/ast/int-size.sig
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/elaborate/elaborate-core.fun
U   mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/type-env.fun

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

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/ast/char-size.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/ast/char-size.fun	2006-05-06 18:44:35 UTC (rev 4468)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/ast/char-size.fun	2006-05-06 20:24:53 UTC (rev 4469)
@@ -21,8 +21,6 @@
      | C2 => 16
      | C4 => 32)
 
-val default = C1
-
 val equals = op =
 
 fun fromBits b =

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/ast/char-size.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/ast/char-size.sig	2006-05-06 18:44:35 UTC (rev 4468)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/ast/char-size.sig	2006-05-06 20:24:53 UTC (rev 4469)
@@ -17,7 +17,6 @@
 
       val all: t list
       val bits: t -> Bits.t
-      val default: t
       val equals: t * t -> bool
       val fromBits: Bits.t -> t
       val isInRange: t * IntInf.t -> bool

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/ast/int-size.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/ast/int-size.fun	2006-05-06 18:44:35 UTC (rev 4468)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/ast/int-size.fun	2006-05-06 20:24:53 UTC (rev 4469)
@@ -40,17 +40,15 @@
                                      then SOME (make (Bits.fromInt i))
                                   else NONE)
 
-fun I (b: Bits.t): t =
+fun fromBits (b: Bits.t): t =
    case Vector.sub (allVector, Bits.toInt b) handle Subscript => NONE of
-      NONE => Error.bug (concat ["IntSize.I: strange int size: ", Bits.toString b])
+      NONE => Error.bug (concat ["IntSize.fromBits: strange int size: ", Bits.toString b])
     | SOME s => s
 
-val all = List.map (sizes, I)
+val all = List.map (sizes, fromBits)
 
-val prims = List.map ([8, 16, 32, 64], I o Bits.fromInt)
+val prims = List.map ([8, 16, 32, 64], fromBits o Bits.fromInt)
 
-val default = I Bits.inWord
-
 val memoize: (t -> 'a) -> t -> 'a =
    fn f =>
    let
@@ -73,7 +71,7 @@
                            then 64
                         else Error.bug "IntSize.roundUpToPrim"
    in
-      I (Bits.fromInt bits)
+      fromBits (Bits.fromInt bits)
    end
 
 val bytes: t -> Bytes.t = Bits.toBytes o bits

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/ast/int-size.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/ast/int-size.sig	2006-05-06 18:44:35 UTC (rev 4468)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/ast/int-size.sig	2006-05-06 20:24:53 UTC (rev 4469)
@@ -22,9 +22,8 @@
       val bytes: t -> Bytes.t
       val cardinality: t -> IntInf.t
       val compare: t * t -> Relation.t
-      val default: t
       val equals: t * t -> bool
-      val I : Bits.t -> t
+      val fromBits : Bits.t -> t
       val layout: t -> Layout.t
       val memoize: (t -> 'a) -> t -> 'a
       datatype prim = I8 | I16 | I32 | I64

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	2006-05-06 18:44:35 UTC (rev 4468)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/ast/prim-tycons.fun	2006-05-06 20:24:53 UTC (rev 4469)
@@ -38,7 +38,6 @@
    fun 'a make (prefix: string,
                 all: 'a list,
                 bits: 'a -> Bits.t,
-                default: 'a,
                 equalsA: 'a * 'a -> bool,
                 memo: ('a -> t) -> ('a -> t),
                 admitsEquality: AdmitsEquality.t) =
@@ -58,35 +57,60 @@
             Vector.toListMap (all, fn (tycon, _) =>
                               (tycon, Arity 0, admitsEquality))
       in
-         (fromSize default, fromSize, all, is, prims)
+         (fromSize, all, is, prims)
       end
 in
-   val (defaultChar, char, _, isCharX, primChars) =
+   val (char, _, isCharX, primChars) =
       let
          open CharSize
       in
-         make ("char", all, bits, default, equals, memoize, Sometimes)
+         make ("char", all, bits, equals, memoize, Sometimes)
       end
-   val (defaultInt, int, ints, isIntX, primInts) =
+   val (int, ints, isIntX, primInts) =
       let
          open IntSize
       in
-         make ("int", all, bits, default, equals, memoize, Sometimes)
+         make ("int", all, bits, equals, memoize, Sometimes)
       end
-   val (defaultReal, real, reals, isRealX, primReals) =
+   val (real, reals, isRealX, primReals) =
       let
          open RealSize
       in
-         make ("real", all, bits, default, equals, memoize, Never)
+         make ("real", all, bits, equals, memoize, Never)
       end
-   val (defaultWord, word, words, isWordX, primWords) =
+   val (word, words, isWordX, primWords) =
       let
          open WordSize
       in
-         make ("word", all, bits, default, equals, memoize, Sometimes)
+         make ("word", all, bits, equals, memoize, Sometimes)
       end
 end
 
+val defaultChar = fn () => 
+   case !Control.defaultChar of
+      "char8" => char CharSize.C1
+    | _ => Error.bug "PrimTycons.defaultChar"
+val defaultInt = fn () => 
+   case !Control.defaultInt of
+      "int8" => int (IntSize.fromBits (Bits.fromInt 8))
+    | "int16" => int (IntSize.fromBits (Bits.fromInt 16))
+    | "int32" => int (IntSize.fromBits (Bits.fromInt 32))
+    | "int64" => int (IntSize.fromBits (Bits.fromInt 64))
+    | "intinf" => intInf
+    | _ => Error.bug "PrimTycons.defaultInt"
+val defaultReal = fn () => 
+   case !Control.defaultReal of
+      "real32" => real RealSize.R32
+    | "real64" => real RealSize.R64
+    | _ => Error.bug "PrimTycons.defaultReal"
+val defaultWord = fn () => 
+   case !Control.defaultWord of
+      "word8" => word (WordSize.fromBits (Bits.fromInt 8))
+    | "word16" => word (WordSize.fromBits (Bits.fromInt 16))
+    | "word32" => word (WordSize.fromBits (Bits.fromInt 32))
+    | "word64" => word (WordSize.fromBits (Bits.fromInt 64))
+    | _ => Error.bug "PrimTycons.defaultWord"
+
 val isIntX = fn c => equals (c, intInf) orelse isIntX c
 
 val prims =
@@ -122,7 +146,7 @@
          let
             val ({isChar}, lay) =
                case Vector.length args of
-                  0 => ({isChar = equals (c, defaultChar)}, layout c)
+                  0 => ({isChar = equals (c, defaultChar ())}, layout c)
                 | 1 => ({isChar = false},
                         seq [maybe (Vector.sub (args, 0)), str " ", layout c])
                 | _ => ({isChar = false},

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	2006-05-06 18:44:35 UTC (rev 4468)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/ast/prim-tycons.sig	2006-05-06 20:24:53 UTC (rev 4469)
@@ -37,10 +37,10 @@
       val arrow: tycon
       val bool: tycon
       val char: CharSize.t -> tycon
-      val defaultChar: tycon
-      val defaultInt: tycon
-      val defaultReal: tycon
-      val defaultWord: tycon
+      val defaultChar: unit -> tycon
+      val defaultInt: unit -> tycon
+      val defaultReal: unit -> tycon
+      val defaultWord: unit -> tycon
       val exn: tycon
       val int: IntSize.t -> tycon
       val ints: (tycon * IntSize.t) vector

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	2006-05-06 18:44:35 UTC (rev 4468)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/elaborate-core.fun	2006-05-06 20:24:53 UTC (rev 4469)
@@ -745,7 +745,7 @@
                      in
                         [Int8, Int16, Int32]
                      end)
-            @ sized (Tycon.int o IntSize.I,
+            @ sized (Tycon.int o IntSize.fromBits,
                      let
                         open CType
                      in

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	2006-05-06 18:44:35 UTC (rev 4468)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/type-env.fun	2006-05-06 20:24:53 UTC (rev 4469)
@@ -426,10 +426,10 @@
                 | Word => Tycon.isWordX c
 
             val defaultTycon: t -> Tycon.t =
-               fn Char => Tycon.defaultChar
-                | Int => Tycon.defaultInt
-                | Real => Tycon.defaultReal
-                | Word => Tycon.defaultWord
+               fn Char => Tycon.defaultChar ()
+                | Int => Tycon.defaultInt ()
+                | Real => Tycon.defaultReal ()
+                | Word => Tycon.defaultWord ()
          end
       
       (* Tuples of length <> 1 are always represented as records.
@@ -1284,18 +1284,15 @@
 
       val () = setSynonym (Tycon.pointer, Tycon.word (WordSize.pointer ()))
 
-      val defaultChar = con (Tycon.char CharSize.default, Vector.new0 ())
-      val defaultInt = con (Tycon.int IntSize.default, Vector.new0 ())
-
       structure Overload =
          struct
             open Overload
                
             val defaultType =
-               fn Char => defaultChar
-                | Int => defaultInt
-                | Real => defaultReal
-                | Word => defaultWord
+               fn Char => con (Tycon.defaultChar (), Vector.new0 ())
+                | Int => con (Tycon.defaultInt (), Vector.new0 ())
+                | Real => con (Tycon.defaultReal (), Vector.new0 ())
+                | Word => con (Tycon.defaultWord (), Vector.new0 ())
          end
          
       fun 'a simpleHom {con: t * Tycon.t * 'a vector -> 'a,