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

SCM Repository

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

Diff of /sml/trunk/src/system/Basis/Implementation/real64-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 7  Line 7 
7  structure Real64Array : MONO_ARRAY =  structure Real64Array : MONO_ARRAY =
8    struct    struct
9    
10        (* fast add/subtract avoiding the overflow test *)
11        infix -- ++
12        fun x -- y = InlineT.Word31.copyt_int31 (InlineT.Word31.copyf_int31 x -
13                                                 InlineT.Word31.copyf_int31 y)
14        fun x ++ y = InlineT.Word31.copyt_int31 (InlineT.Word31.copyf_int31 x +
15                                                 InlineT.Word31.copyf_int31 y)
16    
17    
18    (* unchecked access operations *)    (* unchecked access operations *)
19      val unsafeUpdate = InlineT.Real64Array.update      val uupd = InlineT.Real64Array.update
20      val unsafeSub = InlineT.Real64Array.sub      val usub = InlineT.Real64Array.sub
21  (*    val vecUpdate = InlineT.Real64Vector.update*) (** not yet **)  (*    val vecUpdate = InlineT.Real64Vector.update*) (** not yet **)
22      val vecSub = InlineT.Real64Vector.sub      val vusub = InlineT.Real64Vector.sub
23      val vecLength = InlineT.Real64Vector.length      val vlength = InlineT.Real64Vector.length
24    
25      type array = Assembly.A.real64array      type array = Assembly.A.real64array
26      type elem = Real64.real      type elem = Real64.real
# Line 26  Line 34 
34              else let              else let
35                val arr = Assembly.A.create_r len                val arr = Assembly.A.create_r len
36                fun init i = if (i < len)                fun init i = if (i < len)
37                      then (unsafeUpdate(arr, i, v); init(i+1))                      then (uupd(arr, i, v); init(i+1))
38                      else ()                      else ()
39                in                in
40                  init 0; arr                  init 0; arr
# Line 38  Line 46 
46              else let              else let
47                val arr = Assembly.A.create_r len                val arr = Assembly.A.create_r len
48                fun init i = if (i < len)                fun init i = if (i < len)
49                      then (unsafeUpdate(arr, i, f i); init(i+1))                      then (uupd(arr, i, f i); init(i+1))
50                      else ()                      else ()
51                in                in
52                  init 0; arr                  init 0; arr
# Line 52  Line 60 
60            val _ = if (maxLen < len) then raise General.Size else ()            val _ = if (maxLen < len) then raise General.Size else ()
61            val arr = Assembly.A.create_r len            val arr = Assembly.A.create_r len
62            fun init ([], _) = ()            fun init ([], _) = ()
63              | init (c::r, i) = (unsafeUpdate(arr, i, c); init(r, i+1))              | init (c::r, i) = (uupd(arr, i, c); init(r, i+1))
64            in            in
65              init (l, 0); arr              init (l, 0); arr
66            end            end
# Line 61  Line 69 
69      val sub    = InlineT.Real64Array.chkSub      val sub    = InlineT.Real64Array.chkSub
70      val update = InlineT.Real64Array.chkUpdate      val update = InlineT.Real64Array.chkUpdate
71    
72      fun extract (v, base, optLen) = let      fun vector a = Real64Vector.tabulate (length a, fn i => usub (a, i))
73            val len = length v  
74            fun newVec n = let      fun copy { src, dst, di } = let
75                  fun tab (~1, l) = Assembly.A.create_v(n, l)          val sl = length src
76                    | tab (i, l) = tab(i-1, unsafeSub(v, base+i)::l)          val de = sl + di
77                  in          fun copyDn (s, d) =
78                    tab (n-1, [])              if s < 0 then () else (uupd (dst, d, usub (src, s));
79                  end                                     copyDn (s -- 1, d -- 1))
           in  
             case (base, optLen)  
              of (0, NONE) => if (0 < len) then newVec len else Assembly.vector0  
               | (_, SOME 0) => if ((base < 0) orelse (len < base))  
                   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 (  
                   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 ()  
80            in            in
81              if ((di < 0) orelse (length src < sstop))          if di < 0 orelse de > length dst then raise Subscript
82                then raise Subscript          else copyDn (sl -- 1, de -- 1)
83              else if (si < di)      end
84                then copyDown (sstop-1, dstop-1)  
85                else copyUp (si, di)      fun copyVec { src, dst, di } = let
86            end          val sl = vlength src
87            val de = sl + di
88      fun copyVec {src, si, len, dst, di} = let          fun copyDn (s, d) =
89            val (sstop, dstop) = let              if s < 0 then () else (uupd (dst, d, vusub (src, s));
90                  val srcLen = vecLength src                                     copyDn (s -- 1, d -- 1))
                 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, vecSub(src, j));  
                   copyUp (j+1, k+1))  
                 else ()  
91            in            in
92              if ((di < 0) orelse (vecLength src < sstop))          if di < 0 orelse de > length dst then raise Subscript
93                then raise Subscript          else copyDn (sl -- 1, de -- 1)
               else copyUp (si, di)  
94            end            end
95    
96      fun app f arr = let      fun appi f arr = let
97            val len = length arr            val len = length arr
98            fun app i = if (i < len)          fun app i =
99                  then (f (unsafeSub(arr, i)); app(i+1))              if i >= len then () else (f (i, usub (arr, i)); app (i ++ 1))
                 else ()  
100            in            in
101              app 0              app 0
102            end            end
103    
104      fun foldl f init arr = let      fun app f arr = let
105            val len = length arr            val len = length arr
106            fun fold (i, accum) = if (i < len)          fun app i =
107                  then fold (i+1, f (unsafeSub(arr, i), accum))              if i >= len then () else (f (usub (arr, i)); app (i ++ 1))
                 else accum  
108            in            in
109              fold (0, init)          app 0
110            end            end
111    
112      fun foldr f init arr = let      fun modifyi f arr = let
113            fun fold (i, accum) = if (i >= 0)          val len = length arr
114                  then fold (i-1, f (unsafeSub(arr, i), accum))          fun mdf i =
115                  else accum              if i >= len then ()
116                else (uupd (arr, i, f (i, usub (arr, i))); mdf (i ++ 1))
117            in            in
118              fold (length arr - 1, init)          mdf 0
119            end            end
120    
121     fun modify f arr = let     fun modify f arr = let
122            val len = length arr            val len = length arr
123            fun modify' i = if (i < len)          fun mdf i =
124                  then (              if i >= len then ()
125                    unsafeUpdate(arr, i, f (unsafeSub(arr, i)));              else (uupd (arr, i, f (usub (arr, i))); mdf (i ++ 1))
                   modify'(i+1))  
                 else ()  
126            in            in
127              modify' 0          mdf 0
128            end            end
129    
130      fun chkSlice (arr, i, NONE) = let val len = length arr      fun foldli f init arr = let
131            val len = length arr
132            fun fold (i, a) =
133                if i >= len then a else fold (i ++ 1, f (i, usub (arr, i), a))
134            in            in
135              if (InlineT.DfltInt.ltu(len, i))          fold (0, init)
               then raise Subscript  
               else (arr, i, len)  
136            end            end
137        | chkSlice (arr, i, SOME n) = let val len = length arr  
138        fun foldl f init arr = let
139            val len = length arr
140            fun fold (i, a) =
141                if i >= len then a else fold (i ++ 1, f (usub (arr, i), a))
142            in            in
143              if ((0 <= i) andalso (0 <= n) andalso (i+n <= len))          fold (0, init)
               then (arr, i, i+n)  
               else raise Subscript  
144            end            end
145    
146      fun appi f slice = let      fun foldri f init arr = let
147            val (arr, start, stop) = chkSlice slice          fun fold (i, a) =
148            fun app i = if (i < stop)              if i < 0 then a else fold (i -- 1, f (i, usub (arr, i), a))
                 then (f (i, unsafeSub(arr, i)); app(i+1))  
                 else ()  
149            in            in
150              app start          fold (length arr -- 1, init)
151            end            end
152    
153      fun foldli f init slice = let      fun foldr f init arr = let
154            val (arr, start, stop) = chkSlice slice          fun fold (i, a) =
155            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, unsafeSub(arr, i), accum))  
                 else accum  
156            in            in
157              fold (start, init)          fold (length arr -- 1, init)
158            end            end
159    
160      fun foldri f init slice = let      fun findi p arr = let
161            val (arr, start, stop) = chkSlice slice          val len = length arr
162            fun fold (i, accum) = if (i >= start)          fun fnd i =
163                  then fold (i-1, f (i, unsafeSub(arr, i), accum))              if i >= len then NONE
164                  else accum              else let val x = usub (arr, i)
165            in            in
166              fold (stop - 1, init)                       if p (i, x) then SOME (i, x) else fnd (i ++ 1)
167                     end
168        in
169            fnd 0
170            end            end
171    
172      fun modifyi f slice = let      fun find p arr = let
173            val (arr, start, stop) = chkSlice slice          val len = length arr
174            fun modify' i = if (i < stop)          fun fnd i =
175                  then (              if i >= len then NONE
176                    unsafeUpdate(arr, i, f (i, unsafeSub(arr, i)));              else let val x = usub (arr, i)
177                    modify'(i+1))                   in
178                  else ()                       if p x then SOME x else fnd (i ++ 1)
179                     end
180            in            in
181              modify' start          fnd 0
182            end            end
183    
184    end (* structure Real64Array *)      fun exists p arr = let
185            val len = length arr
186            fun ex i = i < len andalso (p (usub (arr, i)) orelse ex (i ++ 1))
187        in
188            ex 0
189        end
190    
191        fun all p arr = let
192            val len = length arr
193            fun al i = i >= len orelse (p (usub (arr, i)) andalso al (i ++ 1))
194        in
195            al 0
196        end
197    
198        fun collate c (a1, a2) = let
199            val l1 = length a1
200            val l2 = length a2
201            val l12 = InlineT.Int31.min (l1, l2)
202            fun col i =
203                if i >= l12 then IntImp.compare (l1, l2)
204                else case c (usub (a1, i), usub (a2, i)) of
205                         EQUAL => col (i ++ 1)
206                       | unequal => unequal
207        in
208            col 0
209        end
210      end (* structure Real64Array *)

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