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 417 - (view) (download)
Original Path: sml/branches/SMLNJ/src/system/Init/pre-string.sml

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

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