[MLton-commit] r5981
Vesa Karvonen
vesak at mlton.org
Fri Aug 31 09:49:23 PDT 2007
Moved HashMap and HashUniv to their own files, because they are going to
be used outside of pickling.
----------------------------------------------------------------------
A mltonlib/trunk/com/ssh/generic/unstable/detail/hash-map.sml
A mltonlib/trunk/com/ssh/generic/unstable/detail/hash-univ.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/ml/smlnj/unsealed.cm
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/pickle.sml
U mltonlib/trunk/com/ssh/generic/unstable/lib.mlb
----------------------------------------------------------------------
Copied: mltonlib/trunk/com/ssh/generic/unstable/detail/hash-map.sml (from rev 5976, mltonlib/trunk/com/ssh/generic/unstable/detail/value/pickle.sml)
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/pickle.sml 2007-08-31 12:41:46 UTC (rev 5976)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/hash-map.sml 2007-08-31 16:49:21 UTC (rev 5981)
@@ -0,0 +1,17 @@
+(* 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 HashMap :> sig
+ type ('a, 'b) t
+ val new : {eq : 'a BinPr.t, hash : 'a -> Word.t} -> ('a, 'b) 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)
+end
Copied: mltonlib/trunk/com/ssh/generic/unstable/detail/hash-univ.sml (from rev 5976, mltonlib/trunk/com/ssh/generic/unstable/detail/value/pickle.sml)
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/pickle.sml 2007-08-31 12:41:46 UTC (rev 5976)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/hash-univ.sml 2007-08-31 16:49:21 UTC (rev 5981)
@@ -0,0 +1,28 @@
+(* 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.
+ *)
+
+signature HASH_UNIV = sig
+ type t
+ val new : {eq : 'a BinPr.t, hash : 'a -> Word.t} -> ('a, t) Iso.t
+ val eq : t BinPr.t
+ val hash : t -> Word.t
+end
+
+structure HashUniv :> HASH_UNIV = struct
+ datatype t = T of {value : Univ.t,
+ methods : {eq : Univ.t BinPr.t,
+ hash : Univ.t -> Word.t} Ref.t}
+ fun new {eq, hash} = let
+ val (to, from) = Univ.Iso.new ()
+ val methods = ref {eq = BinPr.map from eq, hash = hash o from}
+ in
+ (fn value => T {value = to value, methods = methods},
+ fn T r => from (#value r))
+ end
+ fun eq (T l, T r) = #methods l = #methods r
+ andalso #eq (! (#methods l)) (#value l, #value r)
+ fun hash (T r) = #hash (! (#methods r)) (#value r)
+end
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/ml/smlnj/unsealed.cm
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/ml/smlnj/unsealed.cm 2007-08-31 16:35:48 UTC (rev 5980)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/ml/smlnj/unsealed.cm 2007-08-31 16:49:21 UTC (rev 5981)
@@ -37,6 +37,8 @@
../../close-generic.fun
../../generics-util.sml
../../generics.sml
+ ../../hash-map.sml
+ ../../hash-univ.sml
../../layer-generic.fun
../../mk-closed-rep.fun
../../reg-basis-exns.fun
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/pickle.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/pickle.sml 2007-08-31 16:35:48 UTC (rev 5980)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/pickle.sml 2007-08-31 16:49:21 UTC (rev 5981)
@@ -6,45 +6,6 @@
(************************************************************************)
-structure HashMap :> sig
- type ('a, 'b) t
- val new : {eq : 'a BinPr.t, hash : 'a -> Word.t} -> ('a, 'b) 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)
-end
-
-(************************************************************************)
-
-signature HASH_UNIV = sig
- type t
- val new : {eq : 'a BinPr.t, hash : 'a -> Word.t} -> ('a, t) Iso.t
- val eq : t BinPr.t
- val hash : t -> Word.t
-end
-
-structure HashUniv :> HASH_UNIV = struct
- datatype t = T of {value : Univ.t,
- methods : {eq : Univ.t BinPr.t,
- hash : Univ.t -> Word.t} Ref.t}
- fun new {eq, hash} = let
- val (to, from) = Univ.Iso.new ()
- val methods = ref {eq = BinPr.map from eq, hash = hash o from}
- in
- (fn value => T {value = to value, methods = methods},
- fn T r => from (#value r))
- end
- fun eq (T l, T r) = #methods l = #methods r
- andalso #eq (! (#methods l)) (#value l, #value r)
- fun hash (T r) = #hash (! (#methods r)) (#value r)
-end
-
-(************************************************************************)
-
functor MkStateMonad (Arg : sig include MONAD_CORE T end) :> sig
include MONAD_CORE
val Y : 'a monad Tie.t
Modified: mltonlib/trunk/com/ssh/generic/unstable/lib.mlb
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/lib.mlb 2007-08-31 16:35:48 UTC (rev 5980)
+++ mltonlib/trunk/com/ssh/generic/unstable/lib.mlb 2007-08-31 16:49:21 UTC (rev 5981)
@@ -45,6 +45,17 @@
detail/mk-closed-rep.fun
+ 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 *)
detail/with-extra.fun
@@ -94,15 +105,7 @@
detail/value/ord.sml
public/value/pickle.sig
- local
- local
- $(SML_LIB)/smlnj-lib/Util/smlnj-lib.mlb
- in
- structure HashTable
- end
- in
- detail/value/pickle.sml
- end
+ detail/value/pickle.sml
public/value/pretty.sig
detail/value/pretty.sml
More information about the MLton-commit
mailing list