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 /sml/trunk/system/Basis/Implementation/char-array.sml
ViewVC logotype

Annotation of /sml/trunk/system/Basis/Implementation/char-array.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5073 - (view) (download)

1 : monnier 416 (* char-array.sml
2 :     *
3 : jhr 4092 * COPYRIGHT (c) 2015 The Fellowship of SML/NJ (http://www.smlnj.org)
4 :     * All rights reserved.
5 : monnier 416 *)
6 :    
7 : jhr 4111 structure CharArray : MONO_ARRAY =
8 : monnier 416 struct
9 :     structure String = StringImp
10 :     structure A = InlineT.CharArray
11 :    
12 : mblume 1350 (* fast add/subtract avoiding the overflow test *)
13 :     infix -- ++
14 : jhr 5073 fun x -- y = InlineT.Int.fast_sub(x, y)
15 :     fun x ++ y = InlineT.Int.fast_add(x, y)
16 : mblume 1350
17 : monnier 416 (* unchecked access operations *)
18 : mblume 1350 val uupd = A.update
19 :     val usub = A.sub
20 :     val vuupd = InlineT.CharVector.update
21 :     val vusub = InlineT.CharVector.sub
22 :     val vlength = InlineT.CharVector.length
23 : monnier 416
24 :     type elem = char
25 :     type vector = string
26 :     type array = A.array
27 :    
28 :     val maxLen = Core.max_length
29 :    
30 :     fun array (0, c) = A.newArray0()
31 : jhr 5073 | array (len, c) = if (InlineT.Int.ltu(maxLen, len))
32 : monnier 416 then raise General.Size
33 :     else let
34 :     val arr = A.create len
35 :     fun init i = if (i < len)
36 : mblume 1350 then (uupd(arr, i, c); init(i+1))
37 : monnier 416 else ()
38 :     in
39 :     init 0; arr
40 :     end
41 :    
42 :     fun tabulate (0, _) = A.newArray0()
43 : jhr 5073 | tabulate (len, f) = if (InlineT.Int.ltu(maxLen, len))
44 : monnier 416 then raise General.Size
45 :     else let
46 :     val arr = A.create len
47 :     fun init i = if (i < len)
48 : mblume 1350 then (uupd(arr, i, f i); init(i+1))
49 : monnier 416 else ()
50 :     in
51 :     init 0; arr
52 :     end
53 :    
54 :     fun fromList [] = A.newArray0()
55 :     | fromList l = let
56 :     fun length ([], n) = n
57 :     | length (_::r, n) = length (r, n+1)
58 :     val len = length (l, 0)
59 :     val _ = if (maxLen < len) then raise General.Size else ()
60 :     val arr = A.create len
61 :     fun init ([], _) = ()
62 : mblume 1350 | init (c::r, i) = (uupd(arr, i, c); init(r, i+1))
63 : monnier 416 in
64 :     init (l, 0); arr
65 :     end
66 :    
67 :     val length : array -> int = InlineT.CharArray.length
68 :     val sub : (array * int) -> elem = InlineT.CharArray.chkSub
69 : jhr 4785 val update : (array * int * elem) -> unit
70 : monnier 416 = InlineT.CharArray.chkUpdate
71 :    
72 : mblume 1350 fun vector a =
73 :     case length a of
74 :     0 => ""
75 :     | len => let
76 :     val s = Assembly.A.create_s len
77 :     fun fill i =
78 :     if i >= len then ()
79 :     else (vuupd (s, i, usub (a, i)); fill (i ++ 1))
80 :     in
81 :     fill 0;
82 :     s
83 :     end
84 : monnier 416
85 : mblume 1350 fun copy { src, dst, di } = let
86 :     val sl = length src
87 :     val de = sl + di
88 :     fun copyDn (s, d) =
89 :     if s < 0 then () else (uupd (dst, d, usub (src, s));
90 :     copyDn (s -- 1, d -- 1))
91 :     in
92 :     if di < 0 orelse de > length dst then raise Subscript
93 :     else copyDn (sl -- 1, de -- 1)
94 :     end
95 : monnier 416
96 : mblume 1350 fun copyVec { src, dst, di } = let
97 :     val sl = vlength src
98 :     val de = sl + di
99 :     fun copyDn (s, d) =
100 :     if s < 0 then () else (uupd (dst, d, vusub (src, s));
101 :     copyDn (s -- 1, d -- 1))
102 :     in
103 :     if di < 0 orelse de > length dst then raise Subscript
104 :     else copyDn (sl -- 1, de -- 1)
105 :     end
106 : monnier 416
107 : mblume 1350 fun appi f arr = let
108 :     val len = length arr
109 :     fun app i =
110 :     if i >= len then () else (f (i, usub (arr, i)); app (i ++ 1))
111 :     in
112 :     app 0
113 :     end
114 :    
115 : monnier 416 fun app f arr = let
116 : mblume 1350 val len = length arr
117 :     fun app i =
118 :     if i >= len then () else (f (usub (arr, i)); app (i ++ 1))
119 :     in
120 :     app 0
121 :     end
122 : monnier 416
123 : mblume 1350 fun modifyi f arr = let
124 :     val len = length arr
125 :     fun mdf i =
126 :     if i >= len then ()
127 :     else (uupd (arr, i, f (i, usub (arr, i))); mdf (i ++ 1))
128 :     in
129 :     mdf 0
130 :     end
131 : monnier 416
132 :     fun modify f arr = let
133 : mblume 1350 val len = length arr
134 :     fun mdf i =
135 :     if i >= len then ()
136 :     else (uupd (arr, i, f (usub (arr, i))); mdf (i ++ 1))
137 :     in
138 :     mdf 0
139 :     end
140 : monnier 416
141 : mblume 1350 fun foldli f init arr = let
142 :     val len = length arr
143 :     fun fold (i, a) =
144 :     if i >= len then a else fold (i ++ 1, f (i, usub (arr, i), a))
145 :     in
146 :     fold (0, init)
147 :     end
148 : monnier 416
149 : mblume 1350 fun foldl f init arr = let
150 :     val len = length arr
151 :     fun fold (i, a) =
152 :     if i >= len then a else fold (i ++ 1, f (usub (arr, i), a))
153 :     in
154 :     fold (0, init)
155 :     end
156 : monnier 416
157 : mblume 1350 fun foldri f init arr = let
158 :     fun fold (i, a) =
159 :     if i < 0 then a else fold (i -- 1, f (i, usub (arr, i), a))
160 :     in
161 :     fold (length arr -- 1, init)
162 :     end
163 : monnier 416
164 : mblume 1350 fun foldr f init arr = let
165 :     fun fold (i, a) =
166 :     if i < 0 then a else fold (i -- 1, f (usub (arr, i), a))
167 :     in
168 :     fold (length arr -- 1, init)
169 :     end
170 : monnier 416
171 : mblume 1350 fun findi p arr = let
172 :     val len = length arr
173 :     fun fnd i =
174 :     if i >= len then NONE
175 :     else let val x = usub (arr, i)
176 :     in
177 :     if p (i, x) then SOME (i, x) else fnd (i ++ 1)
178 :     end
179 :     in
180 :     fnd 0
181 :     end
182 : monnier 416
183 : mblume 1350 fun find p arr = let
184 :     val len = length arr
185 :     fun fnd i =
186 :     if i >= len then NONE
187 :     else let val x = usub (arr, i)
188 :     in
189 :     if p x then SOME x else fnd (i ++ 1)
190 :     end
191 :     in
192 :     fnd 0
193 :     end
194 : monnier 416
195 : mblume 1350 fun exists p arr = let
196 :     val len = length arr
197 :     fun ex i = i < len andalso (p (usub (arr, i)) orelse ex (i ++ 1))
198 :     in
199 :     ex 0
200 :     end
201 : monnier 416
202 : mblume 1350 fun all p arr = let
203 :     val len = length arr
204 :     fun al i = i >= len orelse (p (usub (arr, i)) andalso al (i ++ 1))
205 :     in
206 :     al 0
207 :     end
208 :    
209 :     fun collate c (a1, a2) = let
210 :     val l1 = length a1
211 :     val l2 = length a2
212 : jhr 5073 val l12 = InlineT.Int.min (l1, l2)
213 : mblume 1350 fun coll i =
214 :     if i >= l12 then IntImp.compare (l1, l2)
215 :     else case c (usub (a1, i), usub (a2, i)) of
216 :     EQUAL => coll (i ++ 1)
217 :     | unequal => unequal
218 :     in
219 :     coll 0
220 :     end
221 : jhr 4092
222 :     (* added for Basis Library proposal 2015-003 *)
223 :     fun toList arr = foldr op :: [] arr
224 :    
225 :     fun fromVector v = let
226 :     val n = vlength v
227 :     in
228 :     if (n = 0)
229 :     then A.newArray0()
230 :     else let
231 :     val arr = A.create n
232 :     fun fill i = if (i < n)
233 :     then (uupd(arr, i, vusub(v, i)); fill(i ++ 1))
234 :     else arr
235 :     in
236 :     fill 0
237 :     end
238 :     end
239 :    
240 :     val toVector = vector
241 :    
242 : mblume 1350 end (* CharArray *)

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