Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /smlnj-lib/releases/release-110.61/Util/int-redblack-set.sml
ViewVC logotype

Diff of /smlnj-lib/releases/release-110.61/Util/int-redblack-set.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

sml/branches/SMLNJ/src/smlnj-lib/Util/int-redblack-set.sml revision 468, Wed Nov 10 22:42:52 1999 UTC smlnj-lib/releases/release-110.61/Util/int-redblack-set.sml revision 2253, Thu Dec 14 18:21:10 2006 UTC
# Line 136  Line 136 
136            fun delMin (T(R, E, y, b), z) = (y, (false, zip(z, b)))            fun delMin (T(R, E, y, b), z) = (y, (false, zip(z, b)))
137              | delMin (T(B, E, y, b), z) = (y, bbZip(z, b))              | delMin (T(B, E, y, b), z) = (y, bbZip(z, b))
138              | delMin (T(color, a, y, b), z) = delMin(a, LEFT(color, y, b, z))              | delMin (T(color, a, y, b), z) = delMin(a, LEFT(color, y, b, z))
139                | delMin (E, _) = raise Match
140            fun join (R, E, E, z) = zip(z, E)            fun join (R, E, E, z) = zip(z, E)
141              | join (_, a, E, z) = #2(bbZip(z, a))       (* color = black *)              | join (_, a, E, z) = #2(bbZip(z, a))       (* color = black *)
142              | join (_, E, b, z) = #2(bbZip(z, b))       (* color = black *)              | join (_, E, b, z) = #2(bbZip(z, b))       (* color = black *)
# Line 242  Line 243 
243              cmp (start s1, start s2)              cmp (start s1, start s2)
244            end            end
245    
246    (* support for constructing red-black trees in linear time from ordered    (* support for constructing red-black trees in linear time from increasing
247     * sequences (based on a description by R. Hinze).     * ordered sequences (based on a description by R. Hinze).  Note that the
248       * elements in the digits are ordered with the largest on the left, whereas
249       * the elements of the trees are ordered with the largest on the right.
250     *)     *)
251      datatype digit      datatype digit
252        = ZERO        = ZERO
253        | ONE of (int * tree * digit)        | ONE of (int * tree * digit)
254        | TWO of (int * tree * int * tree * digit)        | TWO of (int * tree * int * tree * digit)
255      (* add an item that is guaranteed to be larger than any in l *)
256      fun addItem (a, l) = let      fun addItem (a, l) = let
257            fun incr (a, t, ZERO) = ONE(a, t, ZERO)            fun incr (a, t, ZERO) = ONE(a, t, ZERO)
258              | incr (a1, t1, ONE(a2, t2, r)) = TWO(a1, t1, a2, t2, r)              | incr (a1, t1, ONE(a2, t2, r)) = TWO(a1, t1, a2, t2, r)
259              | incr (a1, t1, TWO(a2, t2, a3, t3, r)) =              | incr (a1, t1, TWO(a2, t2, a3, t3, r)) =
260                  ONE(a1, t1, incr(a2, T(B, t2, a3, t3), r))                  ONE(a1, t1, incr(a2, T(B, t3, a3, t2), r))
261            in            in
262              incr(a, E, l)              incr(a, E, l)
263            end            end
264      (* link the digits into a tree *)
265      fun linkAll t = let      fun linkAll t = let
266            fun link (t, ZERO) = t            fun link (t, ZERO) = t
267              | link (t1, ONE(a, t2, r)) = link(T(B, t1, a, t2), r)              | link (t1, ONE(a, t2, r)) = link(T(B, t2, a, t1), r)
268              | link (t, TWO(a1, t1, a2, t2, r)) =              | link (t, TWO(a1, t1, a2, t2, r)) =
269                  link(T(B, T(R, t, a1, t1), a2, t2), r)                  link(T(B, T(R, t2, a2, t1), a1, t), r)
270            in            in
271              link (E, t)              link (E, t)
272            end            end
# Line 353  Line 358 
358              SET(n, linkAll result)              SET(n, linkAll result)
359            end            end
360    
361        fun partition pred (SET(_, t)) = let
362              fun walk (E, n1, result1, n2, result2) = (n1, result1, n2, result2)
363                | walk (T(_, a, x, b), n1, result1, n2, result2) = let
364                    val (n1, result1, n2, result2) = walk(a, n1, result1, n2, result2)
365                    in
366                      if (pred x)
367                        then walk(b, n1+1, addItem(x, result1), n2, result2)
368                        else walk(b, n1, result1, n2+1, addItem(x, result2))
369                    end
370              val (n1, result1, n2, result2) = walk (t, 0, ZERO, 0, ZERO)
371              in
372                (SET(n1, linkAll result1), SET(n2, linkAll result2))
373              end
374    
375      fun exists pred = let      fun exists pred = let
376            fun test E = false            fun test E = false
377              | test (T(_, a, x, b)) = test a orelse pred x orelse test b              | test (T(_, a, x, b)) = test a orelse pred x orelse test b

Legend:
Removed from v.468  
changed lines
  Added in v.2253

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0