1(* 2 Title: Standard Basis Library: Array Structure 3 Author: David Matthews 4 Copyright David Matthews 1999, 2005, 2015-16 5 6 This library is free software; you can redistribute it and/or 7 modify it under the terms of the GNU Lesser General Public 8 License version 2.1 as published by the Free Software Foundation. 9 10 This library is distributed in the hope that it will be useful, 11 but WITHOUT ANY WARRANTY; without even the implied warranty of 12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 Lesser General Public License for more details. 14 15 You should have received a copy of the GNU Lesser General Public 16 License along with this library; if not, write to the Free Software 17 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 18*) 19 20local 21 type 'a array = 'a array (* Predeclared in the basis with special equality props. *) 22 23 val arrayAsWord: 'a array -> word = RunCall.unsafeCast 24 val intAsWord: int -> word = RunCall.unsafeCast 25 26 (* Unsafe subscript and update functions used internally for cases 27 where we've already checked the range. *) 28 fun unsafeSub(v: 'a array, i: int): 'a = RunCall.loadWord(arrayAsWord v, intAsWord i) 29 30 and unsafeUpdate(v: 'a array, i: int, new: 'a): unit = 31 RunCall.storeWord (arrayAsWord v, intAsWord i, RunCall.unsafeCast new); 32 33 val intAsWord: int -> word = RunCall.unsafeCast 34 and wordAsInt: word -> int = RunCall.unsafeCast 35 36 (* "vector" creates a vector from an array so the representation of a 37 zero-length object is different. Locking the resultant object turns 38 into an immutable object and changes the equality function from pointer 39 equality to value equality. *) 40 fun makeVector(v: 'a array, start, length): 'a vector = 41 if length = 0 then RunCall.unsafeCast LibrarySupport.emptyVector (* Special case for zero *) 42 else (* The size must have already been checked. *) 43 let 44 (* Make a vector initialised to zero. *) 45 val new_vec = RunCall.allocateWordMemory(Word.fromInt length, 0wx40, 0w0) 46 in 47 RunCall.moveWords(RunCall.unsafeCast v, new_vec, Word.fromInt start, 0w0, Word.fromInt length); 48 RunCall.clearMutableBit new_vec; 49 RunCall.unsafeCast new_vec 50 end 51in 52structure Array: ARRAY = 53struct 54 type 'a array = 'a array 55 type 'a vector = 'a Vector.vector 56 57 val maxLen = RunCall.unsafeCast LibrarySupport.maxAllocation 58 59 (* Internal function: Construct an array initialised to zero. *) 60 fun alloc len = 61 let 62 val () = if len >= maxLen then raise General.Size else () 63 val vec = RunCall.allocateWordMemory(Word.fromInt len, 0wx40, 0w0) 64 in 65 RunCall.unsafeCast vec 66 end 67 68 fun array(len, a) = 69 let 70 val () = if len < 0 orelse len >= maxLen then raise General.Size else () 71 val vec = RunCall.allocateWordMemory(Word.fromInt len, 0wx40, RunCall.unsafeCast a) 72 in 73 RunCall.unsafeCast vec 74 end 75 76 val listLength = length; (* Pick this up from the prelude. *) 77 fun length (vec: 'a array): int = wordAsInt(RunCall.memoryCellLength(arrayAsWord vec)) 78 79 fun op sub (vec: 'a array, i: int): 'a = 80 if not (LibrarySupport.isShortInt i) orelse intAsWord i >= RunCall.memoryCellLength vec 81 then raise General.Subscript 82 else unsafeSub(vec, i) 83 84 fun update (vec: 'a array, i: int, new: 'a) : unit = 85 if not (LibrarySupport.isShortInt i) orelse intAsWord i >= RunCall.memoryCellLength vec 86 then raise General.Subscript 87 else RunCall.storeWord (arrayAsWord vec, intAsWord i, RunCall.unsafeCast new); 88 89 (* Create an array from a list. *) 90 fun fromList (l : 'a list) : 'a array = 91 let 92 val length = listLength l; 93 94 (* Make a array initialised to zero. *) 95 val vec = alloc length 96 97 (* Copy the list elements into the array. *) 98 fun init (v, i, a :: l) = 99 ( 100 unsafeUpdate(v, i, a); 101 init(v, i + 1, l) 102 ) 103 | init (_, _, []) = (); 104 105 in 106 init(vec, 0, l); 107 vec 108 end 109 110 fun tabulate (length: int , f : int->'a): 'a array = 111 let 112 val vec = 113 if length < 0 then raise General.Size 114 else alloc length; 115 (* Initialise it to the function values. *) 116 fun init i = 117 if length <= i then () 118 else (unsafeUpdate(vec, i, f i); init(i+1)) 119 in 120 init 0; 121 vec 122 end 123 124 (* "vector" creates a vector from an array so the representation of a 125 zero-length object is different. Locking the resultant object turns 126 into an immutable object and changes the equality function from pointer 127 equality to value equality. *) 128 fun vector (vec: 'a array): 'a vector = makeVector(vec, 0, length vec) 129 130 (* Copy one array into another. It's possible for the arrays 131 to be the same but in that case di would have to be zero otherwise the length 132 check would fail. *) 133 fun copy {src: 'a array as s, dst: 'a array as d, di: int} = 134 let 135 val len = length src 136 in 137 if di < 0 orelse di+len > length dst 138 then raise General.Subscript 139 else RunCall.moveWords(s, d, 0w0, Word.fromInt di, Word.fromInt len) 140 end 141 142 (* Copy a vector into an array. *) 143 fun copyVec {src: 'a vector, dst: 'a array as d, di: int} = 144 let 145 val len = Vector.length src 146 in 147 if di < 0 orelse di+len > length dst 148 then raise General.Subscript 149 else RunCall.moveWords(src, RunCall.unsafeCast d, 0w0, Word.fromInt di, Word.fromInt len) 150 end 151 152 153 (* Create the other functions. *) 154 structure VectorOps = 155 PolyVectorOperations( 156 struct 157 type 'a vector = 'a array 158 local val l = length in fun length(v: 'a array):word = intAsWord(l v) end 159 local val u = unsafeSub in fun unsafeSub (v: 'a array, i: word) = u(v, wordAsInt i) end 160 fun unsafeSet(v, i: word, e: 'a) = unsafeUpdate(v, wordAsInt i, e) 161 end); 162 163 open VectorOps; 164 165 local 166 (* Install the pretty printer for arrays *) 167 (* We may have to do this outside the structure if we 168 have opaque signature matching. *) 169 fun pretty(depth: FixedInt.int) 170 (printElem: 'a * FixedInt.int -> PolyML.pretty) 171 (x: 'a array) = 172 let 173 open PolyML 174 val last = length x - 1 175 fun put_elem (index, w, (l, d)) = 176 if d = 0 then ([PrettyString "...]"], d+1) 177 else if d < 0 then ([], d+1) 178 else 179 ( 180 printElem(w, d-1) :: 181 (if index <> last then PrettyString "," :: PrettyBreak(1, 0) :: l else l), 182 d+1 183 ) 184 in 185 PrettyBlock(3, false, [], 186 PrettyString "fromList[" :: 187 (if depth <= 0 then [PrettyString "...]"] 188 else #1 (foldri put_elem ([PrettyString "]"], depth - FixedInt.fromInt last) x) ) 189 ) 190 end 191 in 192 val () = PolyML.addPrettyPrinter pretty 193 end 194 195end (* Array *) 196 197structure ArraySlice = 198struct 199 200 datatype 'a slice = Slice of { array: 'a Array.array, start: int, length: int }; 201 202 fun length(Slice{length, ...}) = length 203 204 fun op sub (Slice{array, start, length}, i: int): 'a = 205 if i < 0 orelse i >= length then raise General.Subscript 206 else unsafeSub(array, i+start) 207 208 fun update (Slice{array, start, length}, i: int, new: 'a) : unit = 209 if i < 0 orelse i >= length 210 then raise General.Subscript 211 else unsafeUpdate (array, i+start, new); 212 213 (* Create a slice, checking the sizes so that the resulting slice is always valid. *) 214 fun slice(vec: 'a array, i: int, NONE) = 215 let 216 val len = Array.length vec 217 in 218 if i >= 0 andalso i <= len 219 then Slice{array=vec, start=i, length=len-i} (* Length is rest of array. *) 220 else raise General.Subscript 221 end 222 | slice(vec: 'a array, i: int, SOME l) = 223 let 224 val len = Array.length vec 225 in 226 if i >= 0 andalso l >= 0 andalso i+l <= len 227 then Slice{array=vec, start=i, length=l} (* Length is as given. *) 228 else raise General.Subscript 229 end 230 231 (* Slice from the whole array. *) 232 fun full a = Slice{array=a, start=0, length=Array.length a} 233 234 (* Slice from existing slice *) 235 fun subslice(Slice{array, start, length}, i: int, NONE) = 236 if i >= 0 andalso i <= length 237 then Slice{array=array, start=i+start, length=length-i} (* Length is rest of array. *) 238 else raise General.Subscript 239 240 | subslice(Slice{array, start, length}, i: int, SOME l) = 241 if i >= 0 andalso l >= 0 andalso i+l <= length 242 then Slice{array=array, start=i+start, length=l} (* Length is as given. *) 243 else raise General.Subscript 244 245 fun base(Slice{array, start, length}) = (array, start, length) 246 247 fun vector (Slice{array, start, length}): 'a vector = makeVector(array, start, length) 248 249 (* Copy one array into another. It's possible for the arrays 250 to be the same and for the source and destinations to overlap so we 251 have to take care of that. If they are not the same we could simply 252 use a WordMove. *) 253 fun copy {src = Slice{array=s, start=srcStart, length=srcLen}, dst, di: int} = 254 let 255 fun copyUp n = 256 if n = srcLen then () 257 else (Array.update(dst, n+di, Array.sub(s, n+srcStart)); copyUp(n+1)) 258 259 and copyDown n = 260 if n < 0 then () 261 else (Array.update(dst, n+di, Array.sub(s, n+srcStart)); copyDown(n-1)) 262 in 263 if di < 0 orelse di+srcLen > Array.length dst 264 then raise General.Subscript 265 else if di > srcStart 266 then copyDown(srcLen-1) 267 else copyUp 0 268 end 269 270 (* Copy a vector into an array. *) 271 fun copyVec {src: 'a VectorSlice.slice, dst: 'a array as d, di: int} = 272 let 273 val (v, i, len) = VectorSlice.base src 274 in 275 if di < 0 orelse di+len > Array.length dst 276 then raise General.Subscript 277 else RunCall.moveWords(v, RunCall.unsafeCast d, Word.fromInt i, Word.fromInt di, Word.fromInt len) 278 end 279 280 fun isEmpty(Slice{length, ...}) = length = 0 281 282 (* Return the first item of the slice and the rest of the slice. *) 283 fun getItem(Slice{length=0, ...}) = NONE 284 | getItem(Slice{array, start, length}) = 285 SOME(unsafeSub(array, start), Slice{array=array, start=start+1, length=length-1}) 286 287 (* Create the other functions. *) 288 structure VectorOps = 289 PolyVectorOperations( 290 struct 291 type 'a vector = 'a slice 292 fun length(Slice{length, ...}) = intAsWord length 293 local 294 val u = unsafeSub 295 in 296 fun unsafeSub (Slice{array, start, ...}, i: word) = u(array, wordAsInt i + start) 297 end 298 fun unsafeSet(Slice{array, start, ...}, i: word, e: 'a) = unsafeUpdate(array, wordAsInt i + start, e) 299 end); 300 301 open VectorOps; 302 303end (* ArraySlice *) 304 305end; (* Local in end *) 306 307structure ArraySlice :> ARRAY_SLICE = ArraySlice; 308 309local 310 open ArraySlice 311 312 (* Install the pretty printer for array slices *) 313 (* We may have to do this outside the structure if we 314 have opaque signature matching. *) 315 fun pretty(depth: FixedInt.int) 316 (printElem: 'a * FixedInt.int -> PolyML.pretty) 317 (x: 'a slice) = 318 let 319 open PolyML 320 val last = length x - 1 321 fun put_elem (index, w, (l, d)) = 322 if d = 0 then ([PrettyString "...]"], d+1) 323 else if d < 0 then ([], d+1) 324 else 325 ( 326 printElem(w, d-1) :: 327 (if index <> last then PrettyString "," :: PrettyBreak(1, 0) :: l else l), 328 d+1 329 ) 330 in 331 PrettyBlock(3, false, [], 332 PrettyString "fromList[" :: 333 (if depth <= 0 then [PrettyString "...]"] 334 else #1 (foldri put_elem ([PrettyString "]"], depth - FixedInt.fromInt last) x) ) 335 ) 336 end 337in 338 val _ = PolyML.addPrettyPrinter pretty 339end 340