[MLton-commit] r6390

[Vesa Karvonen]

Replaced the list based set implementation with a non-recursive closure
based implementation that can likely be constant folded by MLton.

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

U   mltonlib/trunk/com/ssh/generic/unstable/detail/value/data-rec-info.sml

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

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	2008-02-08 03:04:14 UTC (rev 6389)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/data-rec-info.sml	2008-02-09 14:42:26 UTC (rev 6390)
@@ -1,4 +1,4 @@
-(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+(* Copyright (C) 2007-2008 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.
@@ -11,25 +11,29 @@
    infix  1 orElse
    (* SML/NJ workaround --> *)
 
-   type recs = Unit.t Ref.t List.t
+   structure Set :> sig
+      type 'a t
+      val empty : 'a t
+      val isEmpty : 'a t UnPr.t
+      val singleton : 'a -> 'a t
+      val union : 'a t BinOp.t
+      val remIf : 'a UnPr.t -> 'a t UnOp.t
+   end = struct
+      type 'a t = 'a UnPr.t UnPr.t
+      fun empty _ = true
+      fun isEmpty isEmpty = isEmpty (fn _ => false)
+      fun singleton x rem = rem x
+      fun union (isEmptyL, isEmptyR) rem = isEmptyL rem andalso isEmptyR rem
+      fun remIf p isEmpty rem = isEmpty (fn x => p x orelse rem x)
+   end
 
-   fun rem x : recs UnOp.t =
-    fn []  => []
-     | [y] => if x = y then [] else [y]
-     | ys  => List.filter (notEq x) ys
+   type recs = Exn.t Set.t
 
-   val merge : recs BinOp.t =
-    fn ([], ys)   => ys
-     | (xs, [])   => xs
-     | ([x], [y]) => if x = y then [x] else [x, y]
-     | (xs, ys)   =>
-       foldl (fn (x, ys) => if List.exists (eq x) ys then ys else x::ys) ys xs
-
    datatype t = INT of {exn : Bool.t, recs : recs, pure : Bool.t}
    datatype s = INS of {exn : Bool.t, recs : recs}
    datatype p = INP of {exn : Bool.t, recs : recs}
 
-   val base = INT {exn = false, pure = true, recs = []}
+   val base = INT {exn = false, pure = true, recs = Set.empty}
    fun pure (INT {exn, recs, ...}) = INT {exn = exn, pure = true, recs = recs}
    fun mutable (INT {exn, recs, ...}) =
        INT {exn = exn, pure = false, recs = recs}
@@ -47,7 +51,7 @@
    fun outT (INT r) = r
 
    fun mayContainExn ? = (#exn o outT o getT) ?
-   fun mayBeRecData  ? = (not o null o #recs o outT o getT) ?
+   fun mayBeRecData  ? = (not o Set.isEmpty o #recs o outT o getT) ?
    fun isMutableType ? = (not o #pure o outT o getT) ?
    fun mayBeCyclic   ? =
        (isMutableType andAlso (mayContainExn orElse mayBeRecData)) ?
@@ -58,7 +62,7 @@
       val isoSum     = const
 
       fun op *` (INP l, INP r) =
-          INP {exn = #exn l orelse #exn r, recs = merge (#recs l, #recs r)}
+          INP {exn = #exn l orelse #exn r, recs = Set.union (#recs l, #recs r)}
       fun T (INT {exn, recs, ...}) = INP {exn = exn, recs = recs}
       fun R _ = T
       fun tuple (INP {exn, recs, ...}) =
@@ -66,25 +70,25 @@
       val record = tuple
 
       fun op +` (INS l, INS r) =
-          INS {exn = #exn l orelse #exn r, recs = merge (#recs l, #recs r)}
+          INS {exn = #exn l orelse #exn r, recs = Set.union (#recs l, #recs r)}
       val unit = base
-      fun C0 _ = INS {exn = false, recs = []}
+      fun C0 _ = INS {exn = false, recs = Set.empty}
       fun C1 _ (INT {exn, recs, ...}) = INS {exn = exn, recs = recs}
       fun data (INS {exn, recs, ...}) =
           INT {exn = exn, pure = true, recs = recs}
 
-      val Y = Tie.pure
-                 (fn () => let
-                        val me = ref ()
-                     in
-                        (INT {exn = false, pure = true, recs = [me]},
-                         fn INT {exn, pure, recs} =>
-                            INT {exn = exn, pure = pure, recs = rem me recs})
-                     end)
+      val Y = Tie.pure (fn () => let
+         exception Me
+      in
+         (INT {exn = false, pure = true, recs = Set.singleton Me},
+          fn INT {exn, pure, recs} =>
+             INT {exn = exn, pure = pure,
+                  recs = Set.remIf (fn Me => true | _ => false) recs})
+      end)
 
       fun op --> _ = base
 
-      val exn = INT {exn = true, pure = true, recs = []}
+      val exn = INT {exn = true, pure = true, recs = Set.empty}
       fun regExn0 _ _ = ()
       fun regExn1 _ _ _ = ()