[MLton-commit] r6018
Vesa Karvonen
vesak at mlton.org
Thu Sep 13 01:53:38 PDT 2007
Optimized to use a simple resizable array, instead of a more complex and
slower hash map, while unpickling.
----------------------------------------------------------------------
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/pickle.sml
----------------------------------------------------------------------
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/pickle.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/pickle.sml 2007-09-13 08:12:00 UTC (rev 6017)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/pickle.sml 2007-09-13 08:53:37 UTC (rev 6018)
@@ -114,18 +114,20 @@
structure I = let
structure SMC = MkStateMonad
(open Istream
- type t = Int.t * (Int.t, Dyn.t) HashMap.t)
+ type t = Dyn.t ResizableArray.t)
structure M = MkMonad (SMC)
in
struct
open M
- structure Map = struct
- val get = map #2 SMC.get
- end
+ structure Map = SMC
structure Key = struct
- val alloc = SMC.get >>= (fn (n, m) =>
- SMC.set (n+1, m) >>
- return (n+1))
+ local
+ val dummy = #1 (Dyn.new {eq = undefined, hash = undefined}) ()
+ in
+ val alloc = SMC.get >>= (fn arr =>
+ (ResizableArray.push arr dummy
+ ; return (ResizableArray.length arr)))
+ end
end
fun run s = Istream.run o SMC.run s
val read = SMC.lift Istream.read
@@ -306,14 +308,12 @@
val (toDyn, fromDyn) = Dyn.new {eq = Arg.eq self, hash = Arg.hash self}
open I
in
- P {rd = rd size >>& Map.get >>= (fn key & mp =>
+ P {rd = rd size >>& Map.get >>= (fn key & arr =>
if 0 = key
then Key.alloc >>& readProxy >>= (fn key & proxy =>
- (HashMap.insert mp (key, toDyn proxy)
+ (ResizableArray.update (arr, key-1, toDyn proxy)
; readBody proxy >> return proxy))
- else case HashMap.find mp key
- of NONE => fail "Corrupted pickle"
- | SOME d => return (fromDyn d)),
+ else return (fromDyn (ResizableArray.sub (arr, key-1)))),
wr = fn v => let
val d = toDyn v
open O
@@ -332,14 +332,12 @@
val (toDyn, fromDyn) = Dyn.new {eq = Arg.eq aT, hash = Arg.hash aT}
open I
in
- P {rd = rd size >>& Map.get >>= (fn key & mp =>
+ P {rd = rd size >>& Map.get >>= (fn key & arr =>
if 0 = key
then Key.alloc >>& aR >>= (fn key & v =>
- (HashMap.insert mp (key, toDyn v)
+ (ResizableArray.update (arr, key-1, toDyn v)
; return v))
- else case HashMap.find mp key
- of NONE => fail "Corrupted pickle"
- | SOME d => return (fromDyn d)),
+ else return (fromDyn (ResizableArray.sub (arr, key-1)))),
wr = fn v => let
val d = toDyn v
open O
@@ -495,7 +493,7 @@
open I
in
IOSMonad.map #1 o
- run (0, HashMap.new {eq = op =, hash = Word.fromInt})
+ run (ResizableArray.new ())
(rd word32 >>= (fn key' =>
if key' <> key
then raise Pickling.TypeMismatch
More information about the MLton-commit
mailing list