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

SCM Repository

[smlnj] Annotation of /MLRISC/releases/release-110.60/library/regset.sml
ViewVC logotype

Annotation of /MLRISC/releases/release-110.60/library/regset.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2203 - (view) (download)

1 : monnier 411 (*
2 :     * Register set datatype. Implemented as sorted lists.
3 :     *
4 :     * -- Allen
5 :     *)
6 :    
7 : monnier 245 structure RegSet :> REGISTER_SET =
8 :     struct
9 :    
10 :     type reg = int
11 :    
12 :     type regset = reg list
13 :    
14 :     val empty = []
15 :    
16 :     fun sort [] = []
17 :     | sort (l as [_]) = l
18 :     | sort (l as [x,y]) = if Int.<(x,y) then l else
19 :     if x = y then [x] else [y,x]
20 :     | sort l =
21 :     let val (a,b) = split (l,[],[])
22 :     in mergeUniq(sort a, sort b)
23 :     end
24 :    
25 :     and split ([],a,b) = (a,b)
26 :     | split (r::rs,a,b) = split(rs,r::b,a)
27 :    
28 :     and mergeUniq(l as u::us, l' as v::vs) =
29 :     if u = v then mergeUniq(l,vs)
30 :     else if Int.<(u,v) then u::mergeUniq(us,l')
31 :     else v::mergeUniq(l,vs)
32 :     | mergeUniq(l,[]) = l
33 :     | mergeUniq([],l) = l
34 :    
35 :     fun union [] = []
36 :     | union (r::rs) = mergeUniq(r,union rs)
37 :    
38 :     fun difference ([],_) = []
39 :     | difference (set,[]) = set
40 :     | difference (set as r::rs,set' as r'::rs') =
41 :     if r = r' then difference(rs,set')
42 :     else if r < r' then r::difference(rs,set')
43 :     else (* r > r' *) difference(set,rs')
44 :    
45 :     fun intersect (set,[]) = []
46 :     | intersect ([],set) = []
47 :     | intersect (set as r::rs,set' as r'::rs') =
48 :     if r = r' then r::intersect(rs,rs')
49 :     else if r < r' then intersect(rs,set')
50 :     else intersect(set,rs')
51 :    
52 :     fun intersects [] = []
53 :     | intersects [a] = a
54 :     | intersects (a::b) = intersect(a,intersects b)
55 :    
56 :     fun ==([],[]) = true
57 :     | ==(r::rs,r'::rs') = (r : int) = r' andalso ==(rs,rs')
58 :     | ==(_,_) = false
59 :    
60 :     fun isEmpty [] = true
61 :     | isEmpty _ = false
62 :    
63 :     val app = List.app
64 :    
65 :     fun contains ([], r) = false
66 :     | contains (r'::rs,r) = r' = r orelse (r > r' andalso contains(rs,r))
67 :    
68 :     fun exists (set, []) = false
69 :     | exists (set, r::rs) = contains(set,r) orelse exists(set,rs)
70 :    
71 :     fun insert([],r) = [r]
72 :     | insert(set as r'::rs,r) =
73 :     if r = r' then set
74 :     else if r' < r then r'::insert(rs,r)
75 :     else r::set
76 :    
77 :     fun insertChanged (set,r) =
78 :     let fun ins [] = ([r],true)
79 :     | ins (set as r'::rs) =
80 :     if r = r' then (set,false)
81 :     else if r > r' then
82 :     let val (rs,changed) = ins rs
83 :     in if changed then (r'::rs,true)
84 :     else (set,false)
85 :     end
86 :     else (r::set,true)
87 :     in ins set
88 :     end
89 :    
90 :     fun remove ([],r) = []
91 :     | remove (set as r'::rs,r) =
92 :     if r' = r then rs
93 :     else if r' < r then r'::remove(rs,r)
94 :     else set
95 :    
96 :     fun removeChanged (set,r) =
97 :     let fun rmv [] = ([],false)
98 :     | rmv (set as r'::rs) =
99 :     if r = r' then (rs,true)
100 :     else if r > r' then
101 :     let val (rs,changed) = rmv rs
102 :     in if changed then (r'::rs,true)
103 :     else (set,false)
104 :     end
105 :     else (set,false)
106 :     in
107 :     rmv set
108 :     end
109 :    
110 :     fun fromList l = sort l
111 :     fun fromSortedList l = l
112 :     fun toList set = set
113 :    
114 :     fun toString set =
115 :     let fun collect([],l) = l
116 :     | collect(r::rs,l) = Int.toString r::collect'(rs,l)
117 :     and collect'(rs,l) =
118 :     let val l = collect(rs,l)
119 :     in case l of [_] => l
120 :     | l => ","::l
121 :     end
122 :     in String.concat("{"::collect(set,["}"]))
123 :     end
124 :    
125 :     val op + = mergeUniq
126 :     val op - = difference
127 :     val op * = intersect
128 :    
129 :     end
130 :    

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