[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,