[MLton-commit] r5976

Vesa Karvonen vesak at mlton.org
Fri Aug 31 05:41:47 PDT 2007


Optimized HashUniv.eq --- after profiling, of course!  The methods record
is now held in a ref cell, which acts as an identity.  This allows eq to
perform a quick identity equality test before a (usually) more costly
equality test.

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

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-08-30 18:27:26 UTC (rev 5975)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/pickle.sml	2007-08-31 12:41:46 UTC (rev 5976)
@@ -29,19 +29,18 @@
 
 structure HashUniv :> HASH_UNIV = struct
    datatype t = T of {value : Univ.t,
-                      methods : {eq : Univ.t BinPr.t, hash : Univ.t -> Word.t}}
+                      methods : {eq : Univ.t BinPr.t,
+                                 hash : Univ.t -> Word.t} Ref.t}
    fun new {eq, hash} = let
-      val (to, from) = Univ.Emb.new ()
-      val methods = {eq = fn (l, r) => case (from l, from r)
-                                        of (SOME l, SOME r) => eq (l, r)
-                                         | _                => false,
-                     hash = hash o valOf o from}
+      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 => valOf (from (#value r)))
+       fn T r => from (#value r))
    end
-   fun eq (T l, T r) = #eq (#methods l) (#value l, #value r)
-   fun hash (T r) = #hash (#methods r) (#value r)
+   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
 
 (************************************************************************)




More information about the MLton-commit mailing list