[MLton-commit] r6092
Vesa Karvonen
vesak at mlton.org
Fri Oct 26 02:05:46 PDT 2007
Towards compiling the generics library with MLKit. CastReal (for MLKit)
is just a fake and will not work. Word64 support has been dropped for
now, because MLKit doesn't support it. (Just noticed that Poly/ML doesn't
provide FixedInt, etc... at all. It would seem that some sort of
configuration is going to be needed.) Also switched to a home grown
HashMap implementation (not sure if MLKit provides a port of SML/NJ lib).
----------------------------------------------------------------------
U mltonlib/trunk/com/ssh/generic/unstable/detail/close-generic.fun
U mltonlib/trunk/com/ssh/generic/unstable/detail/hash-map.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/layer-generic.fun
A mltonlib/trunk/com/ssh/generic/unstable/detail/ml/mlkit/
A mltonlib/trunk/com/ssh/generic/unstable/detail/ml/mlkit/cast-real.sml
A mltonlib/trunk/com/ssh/generic/unstable/detail/ml/mlkit/extensions.mlb
D mltonlib/trunk/com/ssh/generic/unstable/detail/ml/smlnj/hash-table.cm
U mltonlib/trunk/com/ssh/generic/unstable/detail/ml/smlnj/unsealed.cm
U mltonlib/trunk/com/ssh/generic/unstable/detail/ops.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/reg-basis-exns.fun
U mltonlib/trunk/com/ssh/generic/unstable/detail/root-generic.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/arbitrary.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/data-rec-info.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/debug.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/dynamic.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/eq.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/fmap.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/hash.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/ord.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/pickle.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/pretty.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/reduce.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/seq.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/shrink.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/size.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/some.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/transform.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/type-exp.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/type-hash.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/type-info.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/with-extra.fun
U mltonlib/trunk/com/ssh/generic/unstable/lib.mlb
U mltonlib/trunk/com/ssh/generic/unstable/public/closed-cases.sig
U mltonlib/trunk/com/ssh/generic/unstable/public/generic-extra.sig
U mltonlib/trunk/com/ssh/generic/unstable/public/generic.sig
U mltonlib/trunk/com/ssh/generic/unstable/public/layer-dep-cases-fun.sig
U mltonlib/trunk/com/ssh/generic/unstable/public/open-cases.sig
U mltonlib/trunk/com/ssh/generic/unstable/test/pickle.sml
----------------------------------------------------------------------
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/close-generic.fun
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/close-generic.fun 2007-10-26 09:00:08 UTC (rev 6091)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/close-generic.fun 2007-10-26 09:05:40 UTC (rev 6092)
@@ -57,7 +57,9 @@
val largeWord = Open.largeWord ()
val word8 = Open.word8 ()
val word32 = Open.word32 ()
+(*
val word64 = Open.word64 ()
+*)
fun list ? = Open.list ignore ?
val bool = Open.bool ()
val char = Open.char ()
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/hash-map.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/hash-map.sml 2007-10-26 09:00:08 UTC (rev 6091)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/hash-map.sml 2007-10-26 09:05:40 UTC (rev 6092)
@@ -4,14 +4,198 @@
* See the LICENSE file or http://mlton.org/License for details.
*)
+structure Node :> sig
+ type 'a t
+ type 'a p = 'a t Option.t Ref.t
+
+ val new : 'a -> 'a t
+ val ptr : 'a p Thunk.t
+
+ val next : 'a t -> 'a p
+ val value : 'a t -> 'a
+
+ val isEmpty : 'a p UnPr.t
+
+ val length : 'a p -> Int.t
+
+ val hd : 'a p -> 'a
+ val tl : 'a p UnOp.t
+
+ val push : 'a p -> 'a Effect.t
+ val pop : 'a p -> 'a Option.t
+
+ val peek : 'a p -> 'a Option.t
+
+ val drop : 'a p Effect.t
+
+ val find : 'a UnPr.t -> 'a p -> ('a p, 'a p) Sum.t
+ val fold : ('a * 's -> 's) -> 's -> 'a p -> 's
+
+ val toList : 'a p -> 'a List.t
+
+ val filter : 'a UnPr.t -> 'a p UnOp.t
+
+ val appClear : 'a Effect.t -> 'a p UnOp.t
+
+ val insert : 'a BinPr.t -> 'a p -> 'a Effect.t
+end = struct
+ (* <-- SML/NJ workaround *)
+ open TopLevel
+ infix 4 <\
+ infixr 4 />
+ (* SML/NJ workaround --> *)
+
+ datatype 'a t = T of 'a * 'a p
+ withtype 'a p = 'a t Option.t Ref.t
+
+ fun ptr () = ref NONE
+ fun new v = T (v, ptr ())
+
+ fun next (T (_, p)) = p
+ fun value (T (v, _)) = v
+
+ fun isEmpty p = isNone (!p)
+
+ fun nonEmpty f p = case !p of NONE => raise Empty | SOME n => f n
+ fun hd p = nonEmpty value p
+ fun tl p = nonEmpty next p
+
+ fun drop p = p := !(tl p)
+
+ fun push p v = let
+ val n = new v
+ in
+ next n := !p ; p := SOME n
+ end
+
+ fun pop p =
+ case !p of
+ NONE => NONE
+ | SOME (T (v, p')) => (p := !p' ; SOME v)
+
+ fun peek p =
+ case !p of
+ NONE => NONE
+ | SOME (T (v, _)) => SOME v
+
+ fun find c p =
+ case !p of
+ NONE => INL p
+ | SOME (T (v, p')) => if c v then INR p else find c p'
+
+ fun fold f s p =
+ case !p of
+ NONE => s
+ | SOME (T (v, p)) => fold f (f (v, s)) p
+
+ fun toList p = rev (fold op :: [] p)
+
+ fun length p = fold (1 <\ op + o #2) 0 p
+
+ fun filter c p =
+ case !p of
+ NONE => p
+ | SOME (T (v, n)) =>
+ if c v then filter c n else (p := !n ; filter c p)
+
+ fun appClear ef p =
+ case !p of
+ NONE => p
+ | SOME (T (v, n)) => (ef v : unit ; p := !n ; appClear ef p)
+
+ fun insert lt p v =
+ case !p of
+ NONE => push p v
+ | SOME (T (x, p')) =>
+ if lt (x, v) then insert lt p' v else push p v
+end
+
structure HashMap :> sig
type ('a, 'b) t
val new : {eq : 'a BinPr.t, hash : 'a -> Word.t} -> ('a, 'b) t
+ val size : ('a, 'b) t -> Int.t
val insert : ('a, 'b) t -> ('a * 'b) Effect.t
val find : ('a, 'b) t -> 'a -> 'b Option.t
- val numItems : ('a, 'b) t -> Int.t
end = struct
- open HashTable
- type ('a, 'b) t = ('a, 'b) hash_table
- fun new {eq, hash} = mkTable (hash, eq) (127, Subscript)
+ (* <-- SML/NJ workaround *)
+ open TopLevel
+ (* SML/NJ workaround --> *)
+
+ datatype ('a, 'b) t =
+ IN of {table : {hash : Word.t,
+ key : 'a,
+ value : 'b Ref.t} Node.p Vector.t Ref.t,
+ size : Int.t Ref.t,
+ eq : 'a BinPr.t,
+ hash : 'a -> Word.t}
+
+ fun table (IN r) = !(#table r)
+ fun size (IN r) = !(#size r)
+ fun eq (IN r) = #eq r
+ fun hash (IN r) = #hash r
+
+ val caps = Vector.fromList
+ [3, 7, 13, 31, 61, 127, 251, 509, 1021, 2039, 4093, 8191,
+ 16381, 32749, 65521, 131071, 262139, 524287, 1048573,
+ 2097143, 4194301, 8388593, 16777213, 33554393, 67108859,
+ 134217689, 268435399, 536870909, 1073741789]
+ val minCap = Vector.sub (caps, 0)
+ val maxCap = Vector.sub (caps, Vector.length caps - 1)
+
+ fun hashToIdx t hash =
+ Word.toIntX (hash mod Word.fromInt (Vector.length (table t)))
+
+ fun newTable cap = Vector.tabulate (cap, Node.ptr o ignore)
+
+ fun locate t key' = let
+ val hash' = hash t key'
+ val idx = hashToIdx t hash'
+ in
+ (hash', Node.find (fn {hash, key, ...} =>
+ hash = hash' andalso eq t (key, key'))
+ (Vector.sub (table t, idx)))
+ end
+
+ fun maybeGrow (t as IN {size, table, ...}) = let
+ val cap = Vector.length (!table)
+ in
+ if cap <= !size andalso cap < maxCap
+ then let
+ val newCap =
+ recur 0 (fn lp =>
+ fn i => if Vector.sub (caps, i) = cap
+ then Vector.sub (caps, i+1)
+ else lp (i+1))
+ val oldTable = !table
+ in
+ table := newTable newCap
+ ; Vector.app (ignore o
+ Node.appClear
+ (fn c =>
+ Node.push
+ (Vector.sub (!table, hashToIdx t (#hash c)))
+ c))
+ oldTable
+ end
+ else ()
+ end
+
+ fun new {eq, hash} =
+ IN {table = ref (newTable minCap),
+ size = ref 0,
+ eq = eq,
+ hash = hash}
+
+ fun find t key' =
+ case locate t key'
+ of (_, INR p) => SOME (! (#value (Node.hd p)))
+ | (_, INL _) => NONE
+
+ fun insert (t as IN {size, ...}) (key, value) =
+ case locate t key
+ of (_, INR p) => #value (Node.hd p) := value
+ | (hash, INL p) =>
+ (Node.push p {hash = hash, key = key, value = ref value}
+ ; size := !size+1
+ ; maybeGrow t)
end
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/layer-generic.fun
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/layer-generic.fun 2007-10-26 09:00:08 UTC (rev 6091)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/layer-generic.fun 2007-10-26 09:05:40 UTC (rev 6092)
@@ -110,7 +110,9 @@
fun largeWord ? = op0t Open.largeWord Arg.largeWord ?
fun word8 ? = op0t Open.word8 Arg.word8 ?
fun word32 ? = op0t Open.word32 Arg.word32 ?
+(*
fun word64 ? = op0t Open.word64 Arg.word64 ?
+*)
fun list ? = op1t Open.list Arg.list ?
fun bool ? = op0t Open.bool Arg.bool ?
fun char ? = op0t Open.char Arg.char ?
Copied: mltonlib/trunk/com/ssh/generic/unstable/detail/ml/mlkit/cast-real.sml (from rev 6080, mltonlib/trunk/com/ssh/generic/unstable/detail/ml/mlton/cast-real.sml)
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/ml/mlton/cast-real.sml 2007-10-24 12:29:43 UTC (rev 6080)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/ml/mlkit/cast-real.sml 2007-10-26 09:05:40 UTC (rev 6092)
@@ -0,0 +1,13 @@
+(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+structure CastReal : CAST_REAL where type t = Real.t = struct
+ open Real
+ structure Bits = Word
+ val isoBits = (undefined, undefined)
+end
+
+structure CastLargeReal : CAST_REAL where type t = LargeReal.t = CastReal
Copied: mltonlib/trunk/com/ssh/generic/unstable/detail/ml/mlkit/extensions.mlb (from rev 6080, mltonlib/trunk/com/ssh/generic/unstable/detail/ml/mlton/extensions.mlb)
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/ml/mlton/extensions.mlb 2007-10-24 12:29:43 UTC (rev 6080)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/ml/mlkit/extensions.mlb 2007-10-26 09:05:40 UTC (rev 6092)
@@ -0,0 +1,12 @@
+(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+local
+ $(MLTON_LIB)/com/ssh/extended-basis/unstable/basis.mlb
+in
+ ../common/cast-real.sig
+ cast-real.sml
+end
Deleted: mltonlib/trunk/com/ssh/generic/unstable/detail/ml/smlnj/hash-table.cm
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/ml/smlnj/hash-table.cm 2007-10-26 09:00:08 UTC (rev 6091)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/ml/smlnj/hash-table.cm 2007-10-26 09:05:40 UTC (rev 6092)
@@ -1,10 +0,0 @@
-(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
- *
- * This code is released under the MLton license, a BSD-style license.
- * See the LICENSE file or http://mlton.org/License for details.
- *)
-
-group
- structure HashTable
-is
- $/smlnj-lib.cm
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/ml/smlnj/unsealed.cm
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/ml/smlnj/unsealed.cm 2007-10-26 09:00:08 UTC (rev 6091)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/ml/smlnj/unsealed.cm 2007-10-26 09:05:40 UTC (rev 6092)
@@ -43,5 +43,4 @@
../../value/type-info.sml
../../with-extra.fun
extensions.cm
- hash-table.cm
sigs.cm
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/ops.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/ops.sml 2007-10-26 09:00:08 UTC (rev 6091)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/ops.sml 2007-10-26 09:05:40 UTC (rev 6092)
@@ -40,7 +40,9 @@
structure RealWordOps = MkWordOps (CastReal.Bits)
structure WordOps = MkWordOps (Word)
structure Word32Ops = MkWordOps (Word32)
+(*
structure Word64Ops = MkWordOps (Word64)
+*)
structure Word8Ops = MkWordOps (Word8)
functor MkIntOps (Arg : INTEGER) = struct
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/reg-basis-exns.fun
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/reg-basis-exns.fun 2007-10-26 09:00:08 UTC (rev 6091)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/reg-basis-exns.fun 2007-10-26 09:05:40 UTC (rev 6092)
@@ -6,7 +6,7 @@
functor RegBasisExns (include CLOSED_CASES) = struct
val () = let
- open Generics IEEEReal OS OS.IO OS.Path Time
+ open Generics (*IEEEReal*) OS OS.IO OS.Path Time
local
fun lift f a = SOME (f a) handle Match => NONE
@@ -27,12 +27,16 @@
; regExn0' "Option" Option (fn Option => ())
; regExn0' "Overflow" Overflow (fn Overflow => ())
; regExn0' "OS.Path.Path" Path (fn Path => ())
+(*
; regExn0' "OS.IO.Poll" Poll (fn Poll => ())
+*)
; regExn0' "Size" Size (fn Size => ())
; regExn0' "Span" Span (fn Span => ())
; regExn0' "Subscript" Subscript (fn Subscript => ())
; regExn0' "Time.Time" Time (fn Time => ())
+(*
; regExn0' "IEEEReal.Unordered" Unordered (fn Unordered => ())
+*)
; regExn1' "Fail" string Fail (fn Fail ? => ?)
(* Handlers for some extended-basis exceptions: *)
; regExn0' "IOSMonad.EOS" IOSMonad.EOS (fn IOSMonad.EOS => ())
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/root-generic.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/root-generic.sml 2007-10-26 09:00:08 UTC (rev 6091)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/root-generic.sml 2007-10-26 09:05:40 UTC (rev 6092)
@@ -50,7 +50,9 @@
val largeWord = id
val word8 = id
val word32 = id
+(*
val word64 = id
+*)
val list = id
val bool = id
val char = id
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/arbitrary.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/arbitrary.sml 2007-10-26 09:00:08 UTC (rev 6091)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/arbitrary.sml 2007-10-26 09:05:40 UTC (rev 6092)
@@ -154,7 +154,9 @@
val word8 = IN {gen = G.word8, cog = G.variant o Word8.toWord}
val word32 = mkWord Word32.wordSize Word32.fromLargeInt Arg.Open.word32
+(*
val word64 = mkWord Word64.wordSize Word64.fromLargeInt Arg.Open.word64
+*)
fun hole () = IN {gen = G.lift undefined, cog = undefined}
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/data-rec-info.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/data-rec-info.sml 2007-10-26 09:00:08 UTC (rev 6091)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/data-rec-info.sml 2007-10-26 09:05:40 UTC (rev 6092)
@@ -109,7 +109,9 @@
val word8 = base
val word32 = base
+(*
val word64 = base
+*)
fun hole () = base
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/debug.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/debug.sml 2007-10-26 09:00:08 UTC (rev 6091)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/debug.sml 2007-10-26 09:05:40 UTC (rev 6092)
@@ -76,7 +76,9 @@
val word8 = ()
val word32 = ()
+(*
val word64 = ()
+*)
fun hole () = ()
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/dynamic.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/dynamic.sml 2007-10-26 09:00:08 UTC (rev 6091)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/dynamic.sml 2007-10-26 09:05:40 UTC (rev 6092)
@@ -32,7 +32,9 @@
| WORD of Word.t
| WORD8 of Word8.t
| WORD32 of Word32.t
+(*
| WORD64 of Word64.t
+*)
exception Dynamic
end
@@ -104,7 +106,9 @@
val word8 = (WORD8, fn WORD8 ? => ? | _ => raise Dynamic)
val word32 = (WORD32, fn WORD32 ? => ? | _ => raise Dynamic)
+(*
val word64 = (WORD64, fn WORD64 ? => ? | _ => raise Dynamic)
+*)
fun hole () = (undefined, undefined)
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/eq.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/eq.sml 2007-10-26 09:00:08 UTC (rev 6091)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/eq.sml 2007-10-26 09:05:40 UTC (rev 6092)
@@ -87,7 +87,9 @@
val word8 = op = : Word8.t t
val word32 = op = : Word32.t t
+(*
val word64 = op = : Word64.t t
+*)
fun hole () = undefined
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/fmap.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/fmap.sml 2007-10-26 09:00:08 UTC (rev 6091)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/fmap.sml 2007-10-26 09:05:40 UTC (rev 6092)
@@ -25,7 +25,9 @@
| WORD of Word.t
| WORD8 of Word8.t
| WORD32 of Word32.t
+(*
| WORD64 of Word64.t
+*)
| ARGUMENT of Univ.t
datatype 'a i = ISO of ('a, u) Iso.t
datatype 'a t = IN of 'a
@@ -115,7 +117,9 @@
val word8 = ISO (WORD8, fn WORD8 ? => ? | _ => raise Empty)
val word32 = ISO (WORD32, fn WORD32 ? => ? | _ => raise Empty)
+(*
val word64 = ISO (WORD64, fn WORD64 ? => ? | _ => raise Empty)
+*)
fun hole () = ISO (undefined, undefined)
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/hash.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/hash.sml 2007-10-26 09:00:08 UTC (rev 6091)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/hash.sml 2007-10-26 09:05:40 UTC (rev 6092)
@@ -175,7 +175,9 @@
val word8 = prim Word8.toWord
val word32 = prim Word32.toWord
+(*
val word64 = viaWord id op mod Word64.isoWord
+*)
fun hole () = undefined
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/ord.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/ord.sml 2007-10-26 09:00:08 UTC (rev 6091)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/ord.sml 2007-10-26 09:05:40 UTC (rev 6092)
@@ -141,7 +141,9 @@
val word8 = lift Word8.compare
val word32 = lift Word32.compare
+(*
val word64 = lift Word64.compare
+*)
fun hole () = undefined
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/pickle.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/pickle.sml 2007-10-26 09:00:08 UTC (rev 6091)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/pickle.sml 2007-10-26 09:05:40 UTC (rev 6092)
@@ -681,7 +681,9 @@
val word8 = word8
val word32 = word32
+(*
val word64 = bits false Word64Ops.ops Iso.id
+*)
fun hole () = P {rd = let open I in return () >>= undefined end,
wr = undefined, sz = NONE}
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/pretty.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/pretty.sml 2007-10-26 09:00:08 UTC (rev 6091)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/pretty.sml 2007-10-26 09:05:40 UTC (rev 6092)
@@ -421,7 +421,9 @@
val word8 = mkWord Word8.fmt
val word32 = mkWord Word32.fmt
+(*
val word64 = mkWord Word64.fmt
+*)
fun hole () = undefined
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/reduce.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/reduce.sml 2007-10-26 09:00:08 UTC (rev 6091)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/reduce.sml 2007-10-26 09:05:40 UTC (rev 6092)
@@ -89,7 +89,9 @@
val word8 = default
val word32 = default
+(*
val word64 = default
+*)
fun hole () = undefined
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/seq.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/seq.sml 2007-10-26 09:00:08 UTC (rev 6091)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/seq.sml 2007-10-26 09:05:40 UTC (rev 6092)
@@ -133,7 +133,9 @@
val word8 = lift op = : Word8.t t
val word32 = lift op = : Word32.t t
+(*
val word64 = lift op = : Word64.t t
+*)
fun hole () = undefined
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/shrink.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/shrink.sml 2007-10-26 09:00:08 UTC (rev 6091)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/shrink.sml 2007-10-26 09:05:40 UTC (rev 6092)
@@ -195,7 +195,9 @@
val word8 = mkWord Word8Ops.ops
val word32 = mkWord Word32Ops.ops
+(*
val word64 = mkWord Word64Ops.ops
+*)
fun hole () = IN {kids = undefined, shrink = undefined}
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/size.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/size.sml 2007-10-26 09:00:08 UTC (rev 6091)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/size.sml 2007-10-26 09:05:40 UTC (rev 6092)
@@ -164,7 +164,9 @@
val word8 = mkWord Word8.wordSize : Word8.t t
val word32 = mkWord Word32.wordSize : Word32.t t
+(*
val word64 = mkWord Word64.wordSize : Word64.t t
+*)
fun hole () = DYNAMIC undefined
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/some.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/some.sml 2007-10-26 09:00:08 UTC (rev 6091)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/some.sml 2007-10-26 09:05:40 UTC (rev 6092)
@@ -86,7 +86,9 @@
val word8 = fn () => 0w0 : Word8.t
val word32 = fn () => 0w0 : Word32.t
+(*
val word64 = fn () => 0w0 : Word64.t
+*)
fun hole () = undefined
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/transform.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/transform.sml 2007-10-26 09:00:08 UTC (rev 6091)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/transform.sml 2007-10-26 09:05:40 UTC (rev 6092)
@@ -113,7 +113,9 @@
val word8 = default
val word32 = default
+(*
val word64 = default
+*)
fun hole () = (CUSTOM, undefined)
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/type-exp.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/type-exp.sml 2007-10-26 09:00:08 UTC (rev 6091)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/type-exp.sml 2007-10-26 09:05:40 UTC (rev 6092)
@@ -81,7 +81,9 @@
val word8 = CON0 WORD8
val word32 = CON0 WORD32
+(*
val word64 = CON0 WORD64
+*)
fun hole () = CON0 UNIT
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/type-hash.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/type-hash.sml 2007-10-26 09:00:08 UTC (rev 6091)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/type-hash.sml 2007-10-26 09:05:40 UTC (rev 6092)
@@ -74,7 +74,9 @@
val word8 = 0wxB6DB6809 : Word32.t
val word32 = 0wxCDB6D501 : Word32.t
+(*
val word64 = 0wxDB6DB101 : Word32.t
+*)
fun hole () = 0w0 : Word32.t
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/type-info.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/type-info.sml 2007-10-26 09:00:08 UTC (rev 6091)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/type-info.sml 2007-10-26 09:05:40 UTC (rev 6092)
@@ -82,7 +82,9 @@
val word8 = base
val word32 = base
+(*
val word64 = base
+*)
fun hole () = base
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/with-extra.fun
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/with-extra.fun 2007-10-26 09:00:08 UTC (rev 6091)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/with-extra.fun 2007-10-26 09:05:40 UTC (rev 6092)
@@ -43,7 +43,9 @@
else iso largeInt large'
in
val int32 = let open Int32 in mk precision isoInt isoFixedInt isoLarge end
+(*
val int64 = let open Int64 in mk precision isoInt isoFixedInt isoLarge end
+*)
val position =
let open Position in mk precision isoInt isoFixedInt isoLarge end
end
Modified: mltonlib/trunk/com/ssh/generic/unstable/lib.mlb
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/lib.mlb 2007-10-26 09:00:08 UTC (rev 6091)
+++ mltonlib/trunk/com/ssh/generic/unstable/lib.mlb 2007-10-26 09:05:40 UTC (rev 6092)
@@ -8,6 +8,8 @@
$(MLTON_LIB)/com/ssh/extended-basis/unstable/basis.mlb
$(MLTON_LIB)/com/ssh/prettier/unstable/lib.mlb
$(MLTON_LIB)/com/ssh/random/unstable/lib.mlb
+
+ detail/hash-map.sml
in
ann
"forceUsed"
@@ -54,15 +56,6 @@
detail/opt-int.sml (* XXX Should really go to Extended Basis? *)
- local
- local
- $(SML_LIB)/smlnj-lib/Util/smlnj-lib.mlb
- in
- structure HashTable
- end
- in
- detail/hash-map.sml
- end
detail/hash-univ.sml
(* Framework *)
Modified: mltonlib/trunk/com/ssh/generic/unstable/public/closed-cases.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/closed-cases.sig 2007-10-26 09:00:08 UTC (rev 6091)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/closed-cases.sig 2007-10-26 09:05:40 UTC (rev 6092)
@@ -114,7 +114,9 @@
val word8 : Word8.t Rep.t
val word32 : Word32.t Rep.t
+(*
val word64 : Word64.t Rep.t
+*)
(** == Support for Some Built-In Type Constructors == *)
Modified: mltonlib/trunk/com/ssh/generic/unstable/public/generic-extra.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/generic-extra.sig 2007-10-26 09:00:08 UTC (rev 6091)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/generic-extra.sig 2007-10-26 09:05:40 UTC (rev 6092)
@@ -54,7 +54,9 @@
(** == Integer Types == *)
val int32 : Int32.t Rep.t
+(*
val int64 : Int64.t Rep.t
+*)
val position : Position.t Rep.t
Modified: mltonlib/trunk/com/ssh/generic/unstable/public/generic.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/generic.sig 2007-10-26 09:00:08 UTC (rev 6091)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/generic.sig 2007-10-26 09:05:40 UTC (rev 6092)
@@ -40,7 +40,9 @@
val largeWord : LargeWord.t Rep.t
val word8 : Word8.t Rep.t
val word32 : Word32.t Rep.t
+(*
val word64 : Word64.t Rep.t
+*)
val list : ('a, 'x) Open.Rep.t -> 'a List.t Rep.t
val bool : Bool.t Rep.t
val char : Char.t Rep.t
Modified: mltonlib/trunk/com/ssh/generic/unstable/public/layer-dep-cases-fun.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/layer-dep-cases-fun.sig 2007-10-26 09:00:08 UTC (rev 6091)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/layer-dep-cases-fun.sig 2007-10-26 09:05:40 UTC (rev 6092)
@@ -37,7 +37,9 @@
val largeWord : LargeWord.t This.t
val word8 : Word8.t This.t
val word32 : Word32.t This.t
+(*
val word64 : Word64.t This.t
+*)
val list : ('a, 'x) t -> 'a List.t This.t
val bool : Bool.t This.t
val char : Char.t This.t
Modified: mltonlib/trunk/com/ssh/generic/unstable/public/open-cases.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/open-cases.sig 2007-10-26 09:00:08 UTC (rev 6091)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/open-cases.sig 2007-10-26 09:05:40 UTC (rev 6092)
@@ -38,7 +38,9 @@
val largeWord : 'x -> (LargeWord.t, 'x) Rep.t
val word8 : 'x -> (Word8.t, 'x) Rep.t
val word32 : 'x -> (Word32.t, 'x) Rep.t
+(*
val word64 : 'x -> (Word64.t, 'x) Rep.t
+*)
val list : ('x -> 'y) -> ('a, 'x) Rep.t -> ('a List.t, 'y) Rep.t
val bool : 'x -> (Bool.t, 'x) Rep.t
val char : 'x -> (Char.t, 'x) Rep.t
Modified: mltonlib/trunk/com/ssh/generic/unstable/test/pickle.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/test/pickle.sml 2007-10-26 09:00:08 UTC (rev 6091)
+++ mltonlib/trunk/com/ssh/generic/unstable/test/pickle.sml 2007-10-26 09:05:40 UTC (rev 6092)
@@ -43,7 +43,7 @@
(testAllSeq (vector (option (list real))))
(testAllSeq (tuple2 (fixedInt, largeInt)))
(testAllSeq (largeReal &` largeWord))
- (testAllSeq (tuple3 (word8, word32, word64)))
+ (testAllSeq (tuple3 (word8, word32, int32)))
(testAllSeq (bool &` char &` int &` real &` string &` word))
(title "Generic.Pickle.Cyclic")
More information about the MLton-commit
mailing list