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

SCM Repository

[smlnj] Diff of /sml/trunk/system/Basis/Implementation/char-array.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

sml/trunk/src/system/Basis/Implementation/char-array.sml revision 651, Thu Jun 1 18:34:03 2000 UTC sml/trunk/system/Basis/Implementation/char-array.sml revision 4785, Wed Sep 5 14:05:17 2018 UTC
# Line 1  Line 1 
1  (* char-array.sml  (* char-array.sml
2   *   *
3   * COPYRIGHT (c) 1994 AT&T Bell Labs.   * COPYRIGHT (c) 2015 The Fellowship of SML/NJ (http://www.smlnj.org)
4   *   * All rights reserved.
5   *)   *)
6    
7  structure CharArray : MONO_ARRAY =  structure CharArray : MONO_ARRAY =
8    struct    struct
9      structure String = StringImp      structure String = StringImp
10      structure A = InlineT.CharArray      structure A = InlineT.CharArray
11      val (op <)  = InlineT.DfltInt.<  
12      val (op >=) = InlineT.DfltInt.>=      (* fast add/subtract avoiding the overflow test *)
13      val (op +)  = InlineT.DfltInt.+      infix -- ++
14    (* 64BIT: FIXME *)
15        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    (* unchecked access operations *)    (* unchecked access operations *)
22      val unsafeUpdate = A.update      val uupd = A.update
23      val unsafeSub = A.sub      val usub = A.sub
24      val vecUpdate = InlineT.CharVector.update      val vuupd = InlineT.CharVector.update
25      val vecSub = InlineT.CharVector.sub      val vusub = InlineT.CharVector.sub
26        val vlength = InlineT.CharVector.length
27    
28      type elem = char      type elem = char
29      type vector = string      type vector = string
# Line 30  Line 37 
37              else let              else let
38                val arr = A.create len                val arr = A.create len
39                fun init i = if (i < len)                fun init i = if (i < len)
40                      then (unsafeUpdate(arr, i, c); init(i+1))                      then (uupd(arr, i, c); init(i+1))
41                      else ()                      else ()
42                in                in
43                  init 0; arr                  init 0; arr
# Line 42  Line 49 
49              else let              else let
50                val arr = A.create len                val arr = A.create len
51                fun init i = if (i < len)                fun init i = if (i < len)
52                      then (unsafeUpdate(arr, i, f i); init(i+1))                      then (uupd(arr, i, f i); init(i+1))
53                      else ()                      else ()
54                in                in
55                  init 0; arr                  init 0; arr
# Line 56  Line 63 
63            val _ = if (maxLen < len) then raise General.Size else ()            val _ = if (maxLen < len) then raise General.Size else ()
64            val arr = A.create len            val arr = A.create len
65            fun init ([], _) = ()            fun init ([], _) = ()
66              | init (c::r, i) = (unsafeUpdate(arr, i, c); init(r, i+1))              | init (c::r, i) = (uupd(arr, i, c); init(r, i+1))
67            in            in
68              init (l, 0); arr              init (l, 0); arr
69            end            end
# Line 66  Line 73 
73      val update      : (array * int * elem) -> unit      val update      : (array * int * elem) -> unit
74                                                 = InlineT.CharArray.chkUpdate                                                 = InlineT.CharArray.chkUpdate
75    
76      fun extract (arr, base, optLen) = let      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    
89        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    
100        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    
111        fun appi f arr = let
112            val len = length arr            val len = length arr
113            fun newVec n = let          fun app i =
114                  val newV = Assembly.A.create_s n              if i >= len then () else (f (i, usub (arr, i)); app (i ++ 1))
                 fun fill i = if (i < n)  
                       then (vecUpdate(newV, i, unsafeSub(arr, base+i)); fill(i+1))  
                       else ()  
115                  in                  in
116                    fill 0; newV          app 0
117                  end                  end
118    
119        fun app f arr = let
120            val len = length arr
121            fun app i =
122                if i >= len then () else (f (usub (arr, i)); app (i ++ 1))
123            in            in
124              case (base, optLen)          app 0
125               of (0, NONE) => if (0 < len) then newVec len else ""      end
126                | (_, SOME 0) => if ((base < 0) orelse (len < base))  
127                    then raise General.Subscript      fun modifyi f arr = let
128                    else ""          val len = length arr
129                | (_, SOME 1) => String.str(sub(arr, base))          fun mdf i =
130                | (_, NONE) => if ((base < 0) orelse (len < base))              if i >= len then ()
131                      then raise General.Subscript              else (uupd (arr, i, f (i, usub (arr, i))); mdf (i ++ 1))
                   else if (len = base)  
                     then ""  
                     else newVec (len - base)  
               | (_, SOME n) =>  
                   if ((base < 0) orelse (n < 0) orelse (len < (base+n)))  
                     then raise General.Subscript  
                     else newVec n  
           end  
   
     fun copy {src, si, len, dst, di} = let  
           val (sstop, dstop) = let  
                 val srcLen = length src  
                 in  
                   case len  
                    of NONE => if ((si < 0) orelse (srcLen < si))  
                         then raise Subscript  
                         else (srcLen, di+srcLen-si)  
                     | (SOME n) => if ((n < 0) orelse (si < 0) orelse (srcLen < si+n))  
                         then raise Subscript  
                         else (si+n, di+n)  
                   (* end case *)  
                 end  
           fun copyUp (j, k) = if (j < sstop)  
                 then (  
                   unsafeUpdate(dst, k, unsafeSub(src, j));  
                   copyUp (j+1, k+1))  
                 else ()  
           fun copyDown (j, k) = if (si <= j)  
                 then (  
                   unsafeUpdate(dst, k, unsafeSub(src, j));  
                   copyDown (j-1, k-1))  
                 else ()  
132            in            in
133              if (di < 0) orelse (length dst < dstop)          mdf 0
               then raise Subscript  
             else if (si < di)  
               then copyDown (sstop-1, dstop-1)  
               else copyUp (si, di)  
           end  
   
     fun copyVec {src, si, len, dst, di} = let  
           val (sstop, dstop) = let  
                 val srcLen = String.size src  
                 in  
                   case len  
                    of NONE => if ((si < 0) orelse (srcLen < si))  
                         then raise Subscript  
                         else (srcLen, di+srcLen-si)  
                     | (SOME n) => if ((n < 0) orelse (si < 0) orelse (srcLen < si+n))  
                         then raise Subscript  
                         else (si+n, di+n)  
                   (* end case *)  
134                  end                  end
135            fun copyUp (j, k) = if (j < sstop)  
136                  then (unsafeUpdate(dst, k, vecSub(src, j)); copyUp (j+1, k+1))      fun modify f arr = let
137                  else ()          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            in
142              if ((di < 0) orelse (length dst < dstop))          mdf 0
               then raise Subscript  
               else copyUp (si, di)  
143            end            end
144    
145      fun app f arr = let      fun foldli f init arr = let
146            val len = length arr            val len = length arr
147            fun app i = if (i < len)          fun fold (i, a) =
148                  then (f (unsafeSub(arr, i)); app(i+1))              if i >= len then a else fold (i ++ 1, f (i, usub (arr, i), a))
                 else ()  
149            in            in
150              app 0          fold (0, init)
151            end            end
152    
153      fun foldl f init arr = let      fun foldl f init arr = let
154            val len = length arr            val len = length arr
155            fun fold (i, accum) = if (i < len)          fun fold (i, a) =
156                  then fold (i+1, f (unsafeSub(arr, i), accum))              if i >= len then a else fold (i ++ 1, f (usub (arr, i), a))
                 else accum  
157            in            in
158              fold (0, init)              fold (0, init)
159            end            end
160    
161        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    
168      fun foldr f init arr = let      fun foldr f init arr = let
169            fun fold (i, accum) = if (i >= 0)          fun fold (i, a) =
170                  then fold (i-1, f (unsafeSub(arr, i), accum))              if i < 0 then a else fold (i -- 1, f (usub (arr, i), a))
                 else accum  
171            in            in
172              fold (length arr - 1, init)          fold (length arr -- 1, init)
173            end            end
174    
175      fun modify f arr = let      fun findi p arr = let
176            val len = length arr            val len = length arr
177            fun modify' i = if (i < len)          fun fnd i =
178                  then (              if i >= len then NONE
179                    unsafeUpdate(arr, i, f (unsafeSub(arr, i)));              else let val x = usub (arr, i)
180                    modify'(i+1))                   in
181                  else ()                       if p (i, x) then SOME (i, x) else fnd (i ++ 1)
182                     end
183            in            in
184              modify' 0          fnd 0
185            end            end
186    
187      fun chkSlice (arr, i, NONE) = let val len = length arr      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            in
193              if (InlineT.DfltInt.ltu(len, i))                       if p x then SOME x else fnd (i ++ 1)
               then raise Subscript  
               else (arr, i, len)  
194            end            end
       | chkSlice (arr, i, SOME n) = let val len = length arr  
195            in            in
196              if ((0 <= i) andalso (0 <= n) andalso (i+n <= len))          fnd 0
               then (arr, i, i+n)  
               else raise Subscript  
197            end            end
198    
199      fun appi f slice = let      fun exists p arr = let
200            val (arr, start, stop) = chkSlice slice          val len = length arr
201            fun app i = if (i < stop)          fun ex i = i < len andalso (p (usub (arr, i)) orelse ex (i ++ 1))
                 then (f (i, unsafeSub(arr, i)); app(i+1))  
                 else ()  
202            in            in
203              app start          ex 0
204            end            end
205    
206      fun foldli f init slice = let      fun all p arr = let
207            val (arr, start, stop) = chkSlice slice          val len = length arr
208            fun fold (i, accum) = if (i < stop)          fun al i = i >= len orelse (p (usub (arr, i)) andalso al (i ++ 1))
                 then fold (i+1, f (i, unsafeSub(arr, i), accum))  
                 else accum  
209            in            in
210              fold (start, init)          al 0
211            end            end
212    
213      fun foldri f init slice = let      fun collate c (a1, a2) = let
214            val (arr, start, stop) = chkSlice slice          val l1 = length a1
215            fun fold (i, accum) = if (i >= start)          val l2 = length a2
216                  then fold (i-1, f (i, unsafeSub(arr, i), accum))          val l12 = InlineT.Int31.min (l1, l2)
217                  else accum          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            in
223              fold (stop - 1, init)          coll 0
224            end            end
225    
226      fun modifyi f slice = let    (* added for Basis Library proposal 2015-003 *)
227            val (arr, start, stop) = chkSlice slice      fun toList arr = foldr op :: [] arr
228            fun modify' i = if (i < stop)  
229                  then (      fun fromVector v = let
230                    unsafeUpdate(arr, i, f (i, unsafeSub(arr, i)));            val n = vlength v
                   modify'(i+1))  
                 else ()  
231            in            in
232              modify' start              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            end
243    
244    end (* CharArray *)      val toVector = vector
   
245    
246      end (* CharArray *)

Legend:
Removed from v.651  
changed lines
  Added in v.4785

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