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

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