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 /sml/trunk/src/smlnj-lib/Util/uref.sml
ViewVC logotype

Diff of /sml/trunk/src/smlnj-lib/Util/uref.sml

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

revision 475, Wed Nov 10 22:59:58 1999 UTC revision 498, Tue Dec 7 15:44:50 1999 UTC
# Line 25  Line 25 
25    
26      fun uRef x = ref (ECR(x, 0))      fun uRef x = ref (ECR(x, 0))
27    
28      fun !! p = let val ECR(x, _) = !(find p) in x end      fun !! p = (case !(find p)
29               of ECR (x, _) => x
30                | _ => raise Match
31              (* end case *))
32    
33      fun equal (p, p') = (find p = find p')      fun equal (p, p') = (find p = find p')
34    
35      fun update (p, x) = let val (p' as ref(ECR(_, r))) = find p      fun update (p, x) = (case find p
36            in             of (p' as ref(ECR(_, r))) => p' := ECR(x, r)
37              p' := ECR(x, r)              | _ => raise Match
38            end            (* end case *))
39    
40      fun link (p, q) = let      fun link (p, q) = let
41            val p' = find p            val p' = find p
# Line 41  Line 44 
44              if (p' = q') then false else (p' := PTR q; true)              if (p' = q') then false else (p' := PTR q; true)
45            end            end
46    
47      fun unify f (p, q) = let      fun unify f (p, q) = (case (find p, find q)
48            val (p' as ref(ECR(pc, pr))) = find p             of (p' as ref(ECR(pc, pr)), q' as ref(ECR(qc, qr))) =>
49            val (q' as ref(ECR(qc, qr))) = find q                  let
50            val newC = f (pc, qc)            val newC = f (pc, qc)
51            in            in
52              if p' = q'              if p' = q'
53                then (p' := ECR(newC, pr); false)                then (p' := ECR(newC, pr); false)
54                else (                else (
55                  if pr = qr                  if pr = qr
56                    then (                          then (q' := ECR(newC, qr+1); p' := PTR q')
                     q' := ECR(newC, qr+1);  
                     p' := PTR q')  
57                  else if pr < qr                  else if pr < qr
58                    then (                          then (q' := ECR(newC, qr); p' := PTR q')
                     q' := ECR(newC, qr);  
                     p' := PTR q')  
59                    else ((* pr > qr *)                    else ((* pr > qr *)
60                      p' := ECR(newC, pr);                      p' := ECR(newC, pr);
61                      q':= PTR p');                      q':= PTR p');
62                  true)                  true)
63            end            end
64                | _ => raise Match
65              (* end case *))
66    
67      fun union (p, q) = let      fun union (p, q) = let
68            val p' = find p            val p' = find p
69            val q' = find q            val q' = find q
70            in            in
71              if p' = q'              if (p' = q')
72                then false                then false
73                else let                else (case (!p', !q')
74                  val ECR(pc, pr) = !p' and ECR(qc, qr) = !q'                   of (ECR(pc, pr), ECR(qc, qr)) => (
                 in  
75                    if pr = qr                    if pr = qr
76                      then (                          then (q' := ECR(qc, qr+1); p' := PTR q')
                       q' := ECR(qc, qr+1);  
                       p' := PTR q')  
77                    else if pr < qr                    else if pr < qr
78                      then p' := PTR q'                      then p' := PTR q'
79                      else q':= PTR p';                      else q':= PTR p';
80                    true                        true)
81                  end                    | _ => raise Match
82                    (* end case *))
83            end            end
84    
85    end    end

Legend:
Removed from v.475  
changed lines
  Added in v.498

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