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/src/system/Init/pre-string.sml
ViewVC logotype

Annotation of /sml/trunk/src/system/Init/pre-string.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 499 - (view) (download)

1 : monnier 416 (* pre-string.sml
2 :     *
3 :     * COPYRIGHT (c) 1995 AT&T Bell Laboratories.
4 :     *
5 :     * Some common operations that are used by both the String and
6 :     * Substring structures.
7 :     *
8 :     *)
9 :    
10 : monnier 429 local
11 :     infix 7 * / mod div
12 :     infix 6 ^ + -
13 :     infix 3 := o
14 :     infix 4 > < >= <= = <>
15 :     infixr 5 :: @
16 :     infix 0 before
17 :    
18 :     open PrimTypes
19 :     in
20 :    
21 : monnier 416 structure PreString =
22 :     struct
23 :    
24 :     local
25 :     open PrePervasive
26 :    
27 :     structure C = InlineT.Char
28 :    
29 :     val op + = InlineT.DfltInt.+
30 :     val op - = InlineT.DfltInt.-
31 :     val op * = InlineT.DfltInt.*
32 :     val op quot = InlineT.DfltInt.quot
33 :     val op < = InlineT.DfltInt.<
34 :     val op <= = InlineT.DfltInt.<=
35 :     val op > = InlineT.DfltInt.>
36 :     val op >= = InlineT.DfltInt.>=
37 : monnier 498 (* val op = = InlineT.= *)
38 : monnier 416 val unsafeSub = InlineT.CharVector.sub
39 :     val unsafeUpdate = InlineT.CharVector.update
40 :     val unsafeCreate = Assembly.A.create_s
41 :     val maxSize = Core.max_length
42 :     val size = InlineT.CharVector.length
43 :     in
44 :    
45 :     (* allocate an uninitialized string of given length (with a size check) *)
46 :     fun create n = if (InlineT.DfltInt.ltu(maxSize, n))
47 :     then raise Core.Size
48 :     else unsafeCreate n
49 :    
50 :     (* a vector of single character strings *)
51 :     val chars = let
52 :     fun next i = if (i <= C.maxOrd)
53 :     then let
54 :     val s = unsafeCreate 1
55 :     in
56 :     unsafeUpdate(s, 0, C.chr i); s :: next(i+1)
57 :     end
58 :     else []
59 :     in
60 :     Assembly.A.create_v(C.maxOrd+1, next 0)
61 :     end
62 :    
63 :     fun unsafeSubstring (_, _, 0) = ""
64 :     | unsafeSubstring (s, i, 1) =
65 :     InlineT.PolyVector.sub (chars, InlineT.cast (unsafeSub (s, i)))
66 :     | unsafeSubstring (s, i, n) = let
67 :     val ss = unsafeCreate n
68 :     fun copy j = if (j = n)
69 :     then ()
70 :     else (unsafeUpdate(ss, j, unsafeSub(s, i+j)); copy(j+1))
71 :     in
72 :     copy 0; ss
73 :     end
74 :    
75 :     (* concatenate a pair of non-empty strings *)
76 :     fun concat2 (x, y) = let
77 :     val xl = size x and yl = size y
78 :     val ss = create(xl+yl)
79 :     fun copyx n = if (n = xl)
80 :     then ()
81 :     else (unsafeUpdate(ss, n, unsafeSub(x, n)); copyx(n+1))
82 :     fun copyy n = if (n = yl)
83 :     then ()
84 :     else (unsafeUpdate(ss, xl+n, unsafeSub(y,n)); copyy(n+1))
85 :     in
86 :     copyx 0; copyy 0;
87 :     ss
88 :     end
89 :    
90 :     (* given a reverse order list of strings and a total length, return
91 :     * the concatenation of the list.
92 :     *)
93 :     fun revConcat (0, _) = ""
94 :     | revConcat (1, lst) = let
95 :     fun find ("" :: r) = find r
96 :     | find (s :: _) = s
97 :     | find _ = "" (** impossible **)
98 :     in
99 :     find lst
100 :     end
101 :     | revConcat (totLen, lst) = let
102 :     val ss = create totLen
103 :     fun copy ([], _) = ()
104 :     | copy (s::r, i) = let
105 :     val len = size s
106 :     val i = i - len
107 :     fun copy' j = if (j = len)
108 :     then ()
109 :     else (
110 :     unsafeUpdate(ss, i+j, unsafeSub(s, j));
111 :     copy'(j+1))
112 :     in
113 :     copy' 0;
114 :     copy (r, i)
115 :     end
116 :     in
117 :     copy (lst, totLen); ss
118 :     end
119 :    
120 :     (* map a translation function across the characters of a substring *)
121 :     fun translate (tr, s, i, n) = let
122 :     val stop = i+n
123 :     fun mkList (j, totLen, lst) = if (j < stop)
124 :     then let val s' = tr (unsafeSub (s, j))
125 :     in
126 :     mkList (j+1, totLen + size s', s' :: lst)
127 :     end
128 :     else revConcat (totLen, lst)
129 :     in
130 :     mkList (i, 0, [])
131 :     end
132 :    
133 :     (* implode a non-empty list of characters into a string where both the
134 :     * length and list are given as arguments.
135 :     *)
136 :     fun implode (len, cl) = let
137 :     val ss = create len
138 :     fun copy ([], _) = ()
139 :     | copy (c::r, i) = (InlineT.CharVector.update(ss, i, c); copy(r, i+1))
140 :     in
141 :     copy (cl, 0); ss
142 :     end
143 :    
144 :     (* implode a reversed non-empty list of characters into a string where both the
145 :     * length and list are given as arguments.
146 :     *)
147 :     fun revImplode (len, cl) = let
148 :     val ss = create len
149 :     fun copy ([], _) = ()
150 :     | copy (c::r, i) = (InlineT.CharVector.update(ss, i, c); copy(r, i-1))
151 :     in
152 :     copy (cl, len-1); ss
153 :     end
154 :    
155 :     fun isPrefix (s1, s2, i2, n2) = let
156 :     val n1 = size s1
157 :     fun eq (i, j) =
158 :     (i >= n1)
159 :     orelse ((unsafeSub(s1, i) = unsafeSub(s2, j)) andalso eq(i+1, j+1))
160 :     in
161 :     (n2 >= n1) andalso eq (0, i2)
162 :     end
163 :    
164 :     fun collate cmpFn (s1, i1, n1, s2, i2, n2) = let
165 :     val (n, order) =
166 :     if (n1 = n2) then (n1, EQUAL)
167 :     else if (n1 < n2) then (n1, LESS)
168 :     else (n2, GREATER)
169 :     fun cmp' i = if (i = n)
170 :     then order
171 :     else let
172 :     val c1 = unsafeSub(s1, i1+i)
173 :     val c2 = unsafeSub(s2, i2+i)
174 :     in
175 :     case (cmpFn(c1, c2))
176 :     of EQUAL => cmp' (i+1)
177 :     | order => order
178 :     (* end case *)
179 :     end
180 :     in
181 :     cmp' 0
182 :     end
183 :    
184 :     fun cmp (s1, i1, n1, s2, i2, n2) = let
185 :     fun cmpFn (c1, c2) =
186 :     if (c1 = c2) then EQUAL
187 :     else if (C.>(c1, c2)) then GREATER
188 :     else LESS
189 :     in
190 :     collate cmpFn (s1, i1, n1, s2, i2, n2)
191 :     end
192 :    
193 :     end (* local *)
194 :     end; (* PreString *)
195 : monnier 429 end

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