Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Tracker SCM

SCM Repository

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

Diff of /sml/trunk/src/system/Basis/Implementation/array.sml

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

revision 1349, Wed Sep 3 22:22:18 2003 UTC revision 1350, Fri Sep 5 21:34:27 2003 UTC
# Line 4  Line 4 
4   *   *
5   *)   *)
6    
7  structure Array : ARRAY =  structure Array : ARRAY = struct
   struct  
     val (op +)  = InlineT.DfltInt.+  
     val (op <)  = InlineT.DfltInt.<  
     val (op >=) = InlineT.DfltInt.>=  
8    
9      type 'a array = 'a PrimTypes.array      type 'a array = 'a PrimTypes.array
10      type 'a vector = 'a PrimTypes.vector      type 'a vector = 'a PrimTypes.vector
11    
12        (* fast add/subtract avoiding the overflow test *)
13        infix -- ++
14        fun x -- y = InlineT.Word31.copyt_int31 (InlineT.Word31.copyf_int31 x -
15                                                 InlineT.Word31.copyf_int31 y)
16        fun x ++ y = InlineT.Word31.copyt_int31 (InlineT.Word31.copyf_int31 x +
17                                                 InlineT.Word31.copyf_int31 y)
18    
19      val maxLen = Core.max_length      val maxLen = Core.max_length
20    
21      val array : int * 'a -> 'a array = InlineT.PolyArray.array      val array : int * 'a -> 'a array = InlineT.PolyArray.array
# Line 23  Line 26 
26            else Assembly.A.array (n, init)            else Assembly.A.array (n, init)
27  *)  *)
28    
     fun tabulate (0, _) = InlineT.PolyArray.newArray0()  
       | tabulate (n, f : int -> 'a) : 'a array =  
           let val a = array(n, f 0)  
               fun tab i =  
                 if (i < n) then (InlineT.PolyArray.update(a, i, f i); tab(i+1))  
                 else a  
            in tab 1  
           end  
   
29      fun fromList [] = InlineT.PolyArray.newArray0()      fun fromList [] = InlineT.PolyArray.newArray0()
30        | fromList (l as (first::rest)) =        | fromList (l as (first::rest)) =
31            let fun len(_::_::r, i) = len(r, i+2)            let fun len(_::_::r, i) = len(r, i ++ 2)
32                  | len([x], i) = i+1                  | len([x], i) = i ++ 1
33                  | len([], i) = i                  | len([], i) = i
34                val n = len(l, 0)                val n = len(l, 0)
35                val a = array(n, first)                val a = array(n, first)
36                fun fill (i, []) = a                fun fill (i, []) = a
37                  | fill (i, x::r) =                  | fill (i, x::r) =
38                      (InlineT.PolyArray.update(a, i, x); fill(i+1, r))                      (InlineT.PolyArray.update(a, i, x); fill(i ++ 1, r))
39             in fill(1, rest)             in fill(1, rest)
40            end            end
41    
42        fun tabulate (0, _) = InlineT.PolyArray.newArray0()
43          | tabulate (n, f : int -> 'a) : 'a array =
44              let val a = array(n, f 0)
45                  fun tab i =
46                    if (i < n) then (InlineT.PolyArray.update(a, i, f i);
47                                     tab(i ++ 1))
48                    else a
49               in tab 1
50              end
51    
52    
53      val length : 'a array -> int = InlineT.PolyArray.length      val length : 'a array -> int = InlineT.PolyArray.length
54      val sub : 'a array * int -> 'a = InlineT.PolyArray.chkSub      val sub : 'a array * int -> 'a = InlineT.PolyArray.chkSub
55      val update : 'a array * int * 'a -> unit = InlineT.PolyArray.chkUpdate      val update : 'a array * int * 'a -> unit = InlineT.PolyArray.chkUpdate
56    
57      fun extract (v, base, optLen) = let      val usub = InlineT.PolyArray.sub
58            val len = length v      val uupd = InlineT.PolyArray.update
59            fun newVec n = let      val vusub = InlineT.PolyVector.sub
60                  fun tab (~1, l) = Assembly.A.create_v(n, l)      val vlength = InlineT.PolyVector.length
61                    | tab (i, l) = tab(i-1, InlineT.PolyArray.sub(v, base+i)::l)  
62                  in  
63                    tab (n-1, [])      fun copy { src, dst, di } = let
64                  end          val sl = length src
65            in          val de = sl + di
66              case (base, optLen)          fun copyDn (s,  d) =
67               of (0, NONE) => if (0 < len) then newVec len else Assembly.vector0              if s < 0 then () else (uupd (dst, d, usub (src, s));
68                | (_, SOME 0) => if ((base < 0) orelse (len < base))                                     copyDn (s -- 1, d -- 1))
                   then raise General.Subscript  
                   else Assembly.vector0  
               | (_, NONE) => if ((base < 0) orelse (len < base))  
                     then raise General.Subscript  
                   else if (len = base)  
                     then Assembly.vector0  
                     else newVec (len - base)  
               | (_, SOME n) =>  
                   if ((base < 0) orelse (n < 0) orelse (len < (base+n)))  
                     then raise General.Subscript  
                     else newVec n  
             (* end case *)  
           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 (  
                   InlineT.PolyArray.update(dst, k, InlineT.PolyArray.sub(src, j));  
                   copyUp (j+1, k+1))  
                 else ()  
           fun copyDown (j, k) = if (si <= j)  
                 then (  
                   InlineT.PolyArray.update(dst, k, InlineT.PolyArray.sub(src, j));  
                   copyDown (j-1, k-1))  
                 else ()  
69            in            in
70              if ((di < 0) orelse (length dst < dstop))          if di < 0 orelse de > length dst then raise Subscript
71                then raise Subscript          else
72              else if (si < di)              copyDn (sl -- 1, de -- 1)
73                then copyDown (sstop-1, dstop-1)      end
74                else copyUp (si, di)  
75            end      fun copyVec { src, dst, di } = let
76            val sl = vlength src
77      fun copyVec {src, si, len, dst, di} = let          val de = sl + di
78            val (sstop, dstop) = let          fun copyDn (s, d) =
79                  val srcLen = InlineT.PolyVector.length src              if s < 0 then () else (uupd (dst, d, vusub (src, s));
80                  in                                     copyDn (s -- 1, d -- 1))
                   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 (  
                   InlineT.PolyArray.update(dst, k, InlineT.PolyVector.sub(src, j));  
                   copyUp (j+1, k+1))  
                 else ()  
81            in            in
82              if ((di < 0) orelse (length dst < dstop))          if di < 0 orelse de > length dst then raise Subscript
83                then raise Subscript          else copyDn (sl -- 1, de -- 1)
               else copyUp (si, di)  
84            end            end
85    
86      fun app f arr = let      fun appi f arr = let
87            val len = length arr            val len = length arr
88            fun app i = if (i < len)          fun app i =
89                  then (f (InlineT.PolyArray.sub(arr, i)); app(i+1))              if i < len then (f (i, usub (arr, i)); app (i ++ 1))
90                  else ()                  else ()
91            in            in
92              app 0              app 0
93            end            end
94    
95      fun foldl f init arr = let      fun app f arr = let
96            val len = length arr            val len = length arr
97            fun fold (i, accum) = if (i < len)          fun app i =
98                  then fold (i+1, f (InlineT.PolyArray.sub(arr, i), accum))              if i < len then (f (usub (arr, i)); app (i ++ 1))
99                  else accum              else ()
100            in            in
101              fold (0, init)          app 0
102            end            end
103    
104      fun foldr f init arr = let      fun modifyi f arr = let
105            fun fold (i, accum) = if (i >= 0)          val len = length arr
106                  then fold (i-1, f (InlineT.PolyArray.sub(arr, i), accum))          fun mdf i =
107                  else accum              if i < len then (uupd (arr, i, f (i, usub (arr, i))); mdf (i ++ 1))
108                else ()
109            in            in
110              fold (length arr - 1, init)          mdf 0
111            end            end
112    
113      fun modify f arr = let      fun modify f arr = let
114            val len = length arr            val len = length arr
115            fun modify' i = if (i < len)          fun mdf i =
116                  then (              if i < len then (uupd (arr, i, f (usub (arr, i))); mdf (i ++ 1))
                   InlineT.PolyArray.update(arr, i, f (InlineT.PolyArray.sub(arr, i)));  
                   modify'(i+1))  
117                  else ()                  else ()
118            in            in
119              modify' 0          mdf 0
120            end            end
121    
122      fun chkSlice (arr, i, NONE) = let val len = length arr      fun foldli f init arr = let
123            val len = length arr
124            fun fold (i, a) =
125                if i < len then fold (i ++ 1, f (i, usub (arr, i), a)) else a
126            in            in
127              if (InlineT.DfltInt.ltu(len, i))          fold (0, init)
               then raise Subscript  
               else (arr, i, len)  
128            end            end
129        | chkSlice (arr, i, SOME n) = let val len = length arr  
130        fun foldl f init arr = let
131              val len = length arr
132              fun fold (i, a) =
133                  if i < len then fold (i ++ 1, f (usub (arr, i), a)) else a
134            in            in
135              if ((0 <= i) andalso (0 <= n) andalso (i+n <= len))          fold (0, init)
               then (arr, i, i+n)  
               else raise Subscript  
136            end            end
137    
138      fun appi f slice = let      fun foldri f init arr = let
139            val (arr, start, stop) = chkSlice slice          fun fold (i, a) =
140            fun app i = if (i < stop)              if i < 0 then a else fold (i -- 1, f (i, usub (arr, i), a))
                 then (f (i, InlineT.PolyArray.sub(arr, i)); app(i+1))  
                 else ()  
141            in            in
142              app start          fold (length arr -- 1, init)
143            end            end
144    
145      fun foldli f init slice = let      fun foldr f init arr = let
146            val (arr, start, stop) = chkSlice slice          fun fold (i, a) =
147            fun fold (i, accum) = if (i < stop)              if i < 0 then a else fold (i -- 1, f (usub (arr, i), a))
                 then fold (i+1, f (i, InlineT.PolyArray.sub(arr, i), accum))  
                 else accum  
148            in            in
149              fold (start, init)          fold (length arr -- 1, init)
150            end            end
151    
152      fun foldri f init slice = let      fun findi p arr = let
153            val (arr, start, stop) = chkSlice slice          val len = length arr
154            fun fold (i, accum) = if (i >= start)          fun fnd i =
155                  then fold (i-1, f (i, InlineT.PolyArray.sub(arr, i), accum))              if i >= len then NONE
156                  else accum              else let val x = usub (arr, i)
157            in            in
158              fold (stop - 1, init)                       if p (i, x) then SOME (i, x) else fnd (i ++ 1)
159                     end
160        in
161            fnd 0
162            end            end
163    
164      fun modifyi f slice = let      fun find p arr = let
165            val (arr, start, stop) = chkSlice slice          val len = length arr
166            fun modify' i = if (i < stop)          fun fnd i =
167                  then (              if i >= len then NONE
168                    InlineT.PolyArray.update(arr, i,              else let val x = usub (arr, i)
169                      f (i, InlineT.PolyArray.sub(arr, i)));                   in
170                    modify'(i+1))                       if p x then SOME x else fnd (i ++ 1)
171                  else ()                   end
172            in            in
173              modify' start          fnd 0
174            end            end
175    
176    end (* structure Array *)      fun exists p arr = let
177            val len = length arr
178            fun ex i = i < len andalso (p (usub (arr, i)) orelse ex (i ++ 1))
179        in
180            ex 0
181        end
182    
183        fun all p arr = let
184            val len = length arr
185            fun al i = i >= len orelse (p (usub (arr, i)) andalso al (i ++ 1))
186        in
187            al 0
188        end
189    
190        fun collate c (a1, a2) = let
191            val l1 = length a1
192            val l2 = length a2
193            val l12 = InlineT.Int31.min (l1, l2)
194            fun coll i =
195                if i >= l12 then IntImp.compare (l1, l2)
196                else case c (usub (a1, i), usub (a2, i)) of
197                         EQUAL => coll (i ++ 1)
198                       | unequal => unequal
199        in
200            coll 0
201        end
202    
203        (* FIXME: this is inefficient (going through intermediate list) *)
204        fun vector arr =
205            case length arr of
206                0 => Assembly.vector0
207              | len => Assembly.A.create_v (len, foldr op :: [] arr)
208    
209    end (* structure Array *)

Legend:
Removed from v.1349  
changed lines
  Added in v.1350

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