1)abbrev domain PRIMARR PrimitiveArray 2++ This provides a fast array type with no bound checking on elt's. 3++ Minimum index is 0 in this type, cannot be changed 4PrimitiveArray(S : Type) : OneDimensionalArrayAggregate S == add 5 Qmax ==> QVMAXINDEX$Lisp 6 Qsize ==> QVSIZE$Lisp 7 Qelt ==> QAREF1$Lisp 8 Qsetelt ==> QSETAREF1$Lisp 9 Qnew ==> MAKE_-ARRAY$Lisp 10 Qnew1 ==> MAKEARR1$Lisp 11 12 #x == Qsize x 13 minIndex x == 0 14 empty() == Qnew(0$Lisp) 15 new(n, x) == Qnew1(n, x) 16 qelt(x, i) == Qelt(x, i) 17 elt(x : %, i : Integer) == Qelt(x, i) 18 qsetelt!(x, i, s) == Qsetelt(x, i, s) 19 setelt!(x : %, i : Integer, s : S) == Qsetelt(x, i, s) 20 fill!(x, s) == (for i in 0..Qmax x repeat Qsetelt(x, i, s); x) 21 22 -- logically unnecessary, but we want to take advantage from 23 -- fast indexing. 24 if S has SetCategory then 25 hashUpdate!(s : HashState, x : %) : HashState == 26 for i in 0..Qmax x repeat 27 s := hashUpdate!(s, Qelt(x, i))$S 28 s 29 30 31)abbrev package PRIMARR2 PrimitiveArrayFunctions2 32++ This package provides tools for operating on primitive arrays 33++ with unary and binary functions involving different underlying types 34PrimitiveArrayFunctions2(A, B) : Exports == Implementation where 35 A, B : Type 36 37 VA ==> PrimitiveArray A 38 VB ==> PrimitiveArray B 39 O2 ==> FiniteLinearAggregateFunctions2(A, VA, B, VB) 40 Exports ==> with 41 scan : ((A, B) -> B, VA, B) -> VB 42 ++ scan(f, a, r) successively applies 43 ++ \spad{reduce(f, x, r)} to more and more leading sub-arrays 44 ++ x of primitive array \spad{a}. 45 ++ More precisely, if \spad{a} is \spad{[a1, a2, ...]}, then 46 ++ \spad{scan(f, a, r)} returns 47 ++ \spad{[reduce(f, [a1], r), reduce(f, [a1, a2], r), ...]}. 48 reduce : ((A, B) -> B, VA, B) -> B 49 ++ reduce(f, a, r) applies function f to each 50 ++ successive element of the 51 ++ primitive array \spad{a} and an accumulant initialized to r. 52 ++ For example, 53 ++ \spad{reduce(_+$Integer, [1, 2, 3], 0)} 54 ++ does \spad{3+(2+(1+0))}. Note: third argument r 55 ++ may be regarded as the 56 ++ identity element for the function f. 57 map : (A -> B, VA) -> VB 58 ++ map(f, a) applies function f to each member of primitive array 59 ++ \spad{a} resulting in a new primitive array over a 60 ++ possibly different underlying domain. 61 62 Implementation ==> add 63 map(f, v) == map(f, v)$O2 64 scan(f, v, b) == scan(f, v, b)$O2 65 reduce(f, v, b) == reduce(f, v, b)$O2 66 67)abbrev domain TUPLE Tuple 68++ This domain is used to interface with the interpreter's notion 69++ of comma-delimited sequences of values. 70Tuple(S : Type) : CoercibleTo(PrimitiveArray S) with 71 coerce : PrimitiveArray S -> % 72 ++ coerce(a) makes a tuple from primitive array a 73 select : (%, NonNegativeInteger) -> S 74 ++ select(x, n) returns the n-th element of tuple x. 75 ++ tuples are 0-based 76 "#" : % -> NonNegativeInteger 77 ++ #(x) returns the number of elements in tuple x 78 if S has CoercibleTo(OutputForm) then CoercibleTo(OutputForm) 79 if S has SetCategory then SetCategory 80 == add 81 Rep := Record(len : NonNegativeInteger, elts : PrimitiveArray S) 82 83 coerce(x : PrimitiveArray S) : % == [#x, x] 84 coerce(x : %) : PrimitiveArray(S) == x.elts 85 #x == x.len 86 87 select(x, n) == 88 n >= x.len => error "Index out of bounds" 89 x.elts.n 90 91 if S has SetCategory then 92 x = y == (x.len = y.len) and (x.elts =$PrimitiveArray(S) y.elts) 93 94 if S has CoercibleTo(OutputForm) then 95 96 coerce(x : %) : OutputForm == 97 paren [(x.elts.i)::OutputForm 98 for i in minIndex x.elts .. maxIndex x.elts]$List(OutputForm) 99 100)abbrev domain IFARRAY IndexedFlexibleArray 101++ Author: Michael Monagan July/87, modified SMW June/91 102++ A FlexibleArray is the notion of an array intended to allow for growth 103++ at the end only. Hence the following efficient operations 104++ \spad{concat!(a, x)} meaning append item x at the end of the array \spad{a} 105++ \spad{delete!(a, n)} meaning delete the last item from the array \spad{a} 106++ Flexible arrays support the other operations inherited from 107++ \spadtype{ExtensibleLinearAggregate}. However, these are not efficient. 108++ Flexible arrays combine the \spad{O(1)} access time property of arrays 109++ with growing and shrinking at the end in \spad{O(1)} (average) time. 110++ This is done by using an ordinary array which may have zero or more 111++ empty slots at the end. When the array becomes full it is copied 112++ into a new larger (50% larger) array. Conversely, when the array 113++ becomes less than 1/2 full, it is copied into a smaller array. 114++ Flexible arrays provide for an efficient implementation of many 115++ data structures in particular heaps, stacks and sets. 116 117IndexedFlexibleArray(S : Type, mn : Integer) : Exports == Implementation where 118 A ==> PrimitiveArray S 119 I ==> Integer 120 N ==> NonNegativeInteger 121 U ==> UniversalSegment Integer 122 Exports == 123 Join(OneDimensionalArrayAggregate S, ExtensibleLinearAggregate S) with 124 flexibleArray : List S -> % 125 ++ flexibleArray(l) creates a flexible array from the list of elements l 126 physicalLength : % -> NonNegativeInteger 127 ++ physicalLength(x) returns the number of elements x can accommodate before growing 128 physicalLength! : (%, I) -> % 129 ++ physicalLength!(x, n) changes the physical length of x to be n and returns the new array. 130 shrinkable : Boolean -> Boolean 131 ++ shrinkable(b) sets the shrinkable attribute of flexible arrays to b and returns the previous value 132 removeRepeats! : % -> % 133 ++ removeRepeats!(u) destructively replaces runs of consecutive 134 ++ equal elements of u by single elements. 135 136 Implementation == add 137 Rep := Record(physLen : I, logLen : I, f : A) 138 shrinkable? : Boolean := true 139 growAndFill : (%, I, S) -> % 140 growWith : (%, I, S) -> % 141 growAdding : (%, I, %) -> % 142 shrink : (%, I) -> % 143 newa : (N, A) -> A 144 145 physicalLength(r) == qcoerce(r.physLen)@NonNegativeInteger 146 physicalLength!(r, n) == 147 r.physLen = 0 => error "flexible array must be non-empty" 148 growWith(r, n, r.f.0) 149 150 empty() == [0, 0, empty()] 151 #r == (r.logLen)::N 152 fill!(r, x) == (fill!(r.f, x); r) 153 maxIndex r == r.logLen - 1 + mn 154 minIndex r == mn 155 new(n, a) == [n, n, new(n, a)] 156 157 shrinkable(b) == 158 oldval := shrinkable? 159 shrinkable? := b 160 oldval 161 162 flexibleArray l == 163 n := #l 164 n = 0 => empty() 165 x := l.1 166 a := new(n, x) 167 for i in mn + 1..mn + n-1 for y in rest l repeat a.i := y 168 a 169 170 -- local utility operations 171 newa(n, a) == 172 zero? n => empty() 173 new(n, a.0) 174 175 growAdding(r, b, s) == 176 b = 0 => r 177 #r > 0 => growAndFill(r, b, (r.f).0) 178 #s > 0 => growAndFill(r, b, (s.f).0) 179 error "no default filler element" 180 181 growAndFill(r, b, x) == 182 (r.logLen := r.logLen + b) <= r.physLen => r 183 -- enlarge by 50% + b 184 n := r.physLen + r.physLen quo 2 + 1 185 if r.logLen > n then n := r.logLen 186 growWith(r, n, x) 187 188 growWith(r, n, x) == 189 y := new(n::N, x)$PrimitiveArray(S) 190 a := r.f 191 for k in 0 .. r.physLen-1 repeat y.k := a.k 192 r.physLen := n 193 r.f := y 194 r 195 196 shrink(r, i) == 197 r.logLen := r.logLen - i 198 negative?(n := r.logLen) => error "internal bug in flexible array" 199 2*n+2 > r.physLen => r 200 not shrinkable? => r 201 if n < r.logLen then error "cannot shrink flexible array to indicated size" 202 n = 0 => empty() 203 r.physLen := n 204 y := newa(n::N, a := r.f) 205 for k in 0 .. n-1 repeat y.k := a.k 206 r.f := y 207 r 208 209 copy r == 210 n := #r 211 a := r.f 212 v := newa(n, a := r.f) 213 for k in 0..n-1 repeat v.k := a.k 214 [n, n, v] 215 216 217 elt(r : %, i : I) == 218 i < mn or i >= r.logLen + mn => 219 error "index out of range" 220 r.f.(i-mn) 221 222 setelt!(r : %, i : I, x : S) == 223 i < mn or i >= r.logLen + mn => 224 error "index out of range" 225 r.f.(i-mn) := x 226 227 -- operations inherited from extensible aggregate 228 merge(g, a, b) == merge!(g, copy a, b) 229 230 concat!(r : %, x : S) == 231 growAndFill(r, 1, x) 232 r.f.(r.logLen-1) := x 233 r 234 235 concat!(a : %, b : %) == 236 if eq?(a, b) then b := copy b 237 n := #a 238 growAdding(a, #b, b) 239 copyInto!(a, b, n + mn) 240 241 remove!(g : (S->Boolean), a : %) == 242 k : I := 0 243 for i in 0..maxIndex a - mn repeat 244 if not g(a.i) then (a.k := a.i; k := k+1) 245 shrink(a, #a - k) 246 247 delete!(r : %, i1 : I) == 248 i := i1 - mn 249 i < 0 or i > r.logLen => error "index out of range" 250 for k in i..r.logLen-2 repeat r.f.k := r.f.(k+1) 251 shrink(r, 1) 252 253 delete!(r : %, i : U) == 254 l := low(i) - mn; m := maxIndex r - mn 255 h := (hasHi i => high(i) - mn; m) 256 l < 0 or h > m => error "index out of range" 257 for j in l.. for k in h+1..m repeat r.f.j := r.f.k 258 shrink(r, max(0, h-l+1)) 259 260 insert!(x : S, r : %, i1 : I) : % == 261 i := i1 - mn 262 n := r.logLen 263 i < 0 or i > n => error "index out of range" 264 growAndFill(r, 1, x) 265 for k in n-1 .. i by -1 repeat r.f.(k+1) := r.f.k 266 r.f.i := x 267 r 268 269 insert!(a : %, b : %, i1 : I) : % == 270 i := i1 - mn 271 if eq?(a, b) then b := copy b 272 m := #a; n := #b 273 i < 0 or i > n => error "index out of range" 274 growAdding(b, m, a) 275 for k in n-1 .. i by -1 repeat b.f.(m+k) := b.f.k 276 for k in m-1 .. 0 by -1 repeat b.f.(i+k) := a.f.k 277 b 278 279 merge!(g, a, b) == 280 m := #a; n := #b; growAdding(a, n, b) 281 for i in m-1..0 by -1 for j in m+n-1.. by -1 repeat a.f.j := a.f.i 282 i := n; j := 0 283 for k in 0.. while i < n+m and j < n repeat 284 if g(a.f.i, b.f.j) then (a.f.k := a.f.i; i := i+1) 285 else (a.f.k := b.f.j; j := j+1) 286 for k in k.. for j in j..n-1 repeat a.f.k := b.f.j 287 a 288 289 select!(g : (S->Boolean), a : %) == 290 k : I := 0 291 for i in 0..maxIndex a - mn repeat if g(a.f.i) then (a.f.k := a.f.i;k := k+1) 292 shrink(a, #a - k) 293 294 if S has BasicType then 295 removeDuplicates! a == 296 ct := #a 297 ct < 2 => a 298 299 i := mn 300 nlim := mn + ct 301 nlim0 := nlim 302 while i < nlim repeat 303 j := i+1 304 for k in j..nlim-1 | a.k ~= a.i repeat 305 a.j := a.k 306 j := j+1 307 nlim := j 308 i := i+1 309 nlim ~= nlim0 => delete!(a, i..) 310 a 311 312 removeRepeats! a == 313 ct := #a 314 ct < 2 => a 315 316 j := mn 317 nlim := mn + ct 318 t := a(j) 319 i := j + 1 320 while i < nlim repeat 321 s := a(i) 322 if s ~= t then 323 j := j + 1 324 a(j) := (t := s) 325 i := i + 1 326 j + 1 < nlim => delete!(a, (j + 1)..) 327 a 328 329)abbrev domain FARRAY FlexibleArray 330++ A FlexibleArray is the notion of an array intended to allow for growth 331++ at the end only. Hence the following efficient operations 332++ \spad{concat!(a, x)} meaning append item x at the end of the array \spad{a} 333++ \spad{delete!(a, n)} meaning delete the last item from the array \spad{a} 334++ Flexible arrays support the other operations inherited from 335++ \spadtype{ExtensibleLinearAggregate}. However, these are not efficient. 336++ Flexible arrays combine the \spad{O(1)} access time property of arrays 337++ with growing and shrinking at the end in \spad{O(1)} (average) time. 338++ This is done by using an ordinary array which may have zero or more 339++ empty slots at the end. When the array becomes full it is copied 340++ into a new larger (50% larger) array. Conversely, when the array 341++ becomes less than 1/2 full, it is copied into a smaller array. 342++ Flexible arrays provide for an efficient implementation of many 343++ data structures in particular heaps, stacks and sets. 344 345FlexibleArray(S : Type) == Implementation where 346 ARRAYMININDEX ==> 1 -- if you want to change this, be my guest 347 Implementation ==> IndexedFlexibleArray(S, ARRAYMININDEX) 348-- Join(OneDimensionalArrayAggregate S, ExtensibleLinearAggregate S) 349 350)abbrev domain IARRAY1 IndexedOneDimensionalArray 351++ Author Micheal Monagan Aug/87 352++ This is the basic one dimensional array data type. 353 354IndexedOneDimensionalArray(S : Type, mn : Integer): 355 OneDimensionalArrayAggregate S == add 356 Qmax ==> QVMAXINDEX$Lisp 357 Qsize ==> QVSIZE$Lisp 358 Qelt ==> QAREF1$Lisp 359 Qsetelt ==> QSETVELT$Lisp 360 Qnew ==> MAKE_-ARRAY$Lisp 361 Qnew1 ==> MAKEARR1$Lisp 362 I ==> Integer 363 364 #x == Qsize x 365 fill!(x, s) == (for i in 0..Qmax x repeat Qsetelt(x, i, s); x) 366 minIndex x == mn 367 368 empty() == Qnew(0$Lisp) 369 new(n, s) == Qnew1(n, s) 370 371 map!(f, s1) == 372 n : Integer := Qmax(s1) 373 n < 0 => s1 374 for i in 0..n repeat Qsetelt(s1, i, f(Qelt(s1, i))) 375 s1 376 377 map(f, s1) == 378 n : Integer := Qmax(s1) 379 n < 0 => s1 380 ss2 : % := Qnew(n+1) 381 for i in 0..n repeat Qsetelt(ss2, i, f(Qelt(s1, i))) 382 ss2 383 384 map(f, a, b) == 385 maxind : Integer := min(Qmax a, Qmax b) 386 maxind < 0 => empty() 387 c : % := Qnew(maxind+1) 388 for i in 0..maxind repeat 389 Qsetelt(c, i, f(Qelt(a, i), Qelt(b, i))) 390 c 391 392 -- logically unnecessary, but we want to take advantage from 393 -- fast indexing. 394 if S has SetCategory then 395 396 hashUpdate!(s : HashState, x : %) : HashState == 397 for i in 0..Qmax x repeat 398 s := hashUpdate!(s, Qelt(x, i))$S 399 s 400 401 if zero? mn then 402 qelt(x, i) == Qelt(x, i) 403 qsetelt!(x, i, s) == Qsetelt(x, i, s) 404 405 elt(x : %, i : I) == 406 negative? i or i > maxIndex(x) => error "index out of range" 407 qelt(x, i) 408 409 setelt!(x : %, i : I, s : S) == 410 negative? i or i > maxIndex(x) => error "index out of range" 411 qsetelt!(x, i, s) 412 413 else if (mn = 1) then 414 maxIndex x == Qsize x 415 qelt(x, i) == Qelt(x, i-1) 416 qsetelt!(x, i, s) == Qsetelt(x, i-1, s) 417 418 elt(x : %, i : I) == 419 less_SI(i, 1$Lisp)$Lisp or less_SI(Qsize x, i)$Lisp => 420 error "index out of range" 421 Qelt(x, i-1) 422 423 setelt!(x : %, i : I, s : S) == 424 less_SI(i, 1$Lisp)$Lisp or less_SI(Qsize x, i)$Lisp => 425 error "index out of range" 426 Qsetelt(x, i-1, s) 427 428 else 429 qelt(x, i) == Qelt(x, i - mn) 430 qsetelt!(x, i, s) == Qsetelt(x, i - mn, s) 431 432 elt(x : %, i : I) == 433 i < mn or i > maxIndex(x) => error "index out of range" 434 qelt(x, i) 435 436 setelt!(x : %, i : I, s : S) == 437 i < mn or i > maxIndex(x) => error "index out of range" 438 qsetelt!(x, i, s) 439 440)abbrev domain ARRAY1 OneDimensionalArray 441++ This is the domain of 1-based one dimensional arrays 442 443OneDimensionalArray(S : Type) : Exports == Implementation where 444 ARRAYMININDEX ==> 1 -- if you want to change this, be my guest 445 Exports == OneDimensionalArrayAggregate S with 446 oneDimensionalArray : List S -> % 447 ++ oneDimensionalArray(l) creates an array from a list of elements l 448 oneDimensionalArray : (NonNegativeInteger, S) -> % 449 ++ oneDimensionalArray(n, s) creates an array from n copies of element s 450 Implementation == IndexedOneDimensionalArray(S, ARRAYMININDEX) add 451 452 -- qelt and qsetelt! are logically unnecessary, but good for 453 -- performance 454 Qelt1 ==> QAREF1O$Lisp 455 Qsetelt1 ==> QSETAREF1O$Lisp 456 457 qelt(x, i) == Qelt1(x, i, ARRAYMININDEX) 458 qsetelt!(x, i, s) == Qsetelt1(x, i, s, ARRAYMININDEX) 459 460 oneDimensionalArray(u) == 461 n := #u 462 n = 0 => empty() 463 a := new(n, first u) 464 for i in 2..n for x in rest u repeat a.i := x 465 a 466 oneDimensionalArray(n, s) == new(n, s) 467 468)abbrev package ARRAY12 OneDimensionalArrayFunctions2 469++ This package provides tools for operating on one-dimensional arrays 470++ with unary and binary functions involving different underlying types 471OneDimensionalArrayFunctions2(A, B) : Exports == Implementation where 472 A, B : Type 473 474 VA ==> OneDimensionalArray A 475 VB ==> OneDimensionalArray B 476 O2 ==> FiniteLinearAggregateFunctions2(A, VA, B, VB) 477 478 Exports ==> with 479 scan : ((A, B) -> B, VA, B) -> VB 480 ++ scan(f, a, r) successively applies 481 ++ \spad{reduce(f, x, r)} to more and more leading sub-arrays 482 ++ x of one-dimensional array \spad{a}. 483 ++ More precisely, if \spad{a} is \spad{[a1, a2, ...]}, then 484 ++ \spad{scan(f, a, r)} returns 485 ++ \spad{[reduce(f, [a1], r), reduce(f, [a1, a2], r), ...]}. 486 reduce : ((A, B) -> B, VA, B) -> B 487 ++ reduce(f, a, r) applies function f to each 488 ++ successive element of the 489 ++ one-dimensional array \spad{a} and an accumulant initialized to r. 490 ++ For example, 491 ++ \spad{reduce(_+$Integer, [1, 2, 3], 0)} 492 ++ does \spad{3+(2+(1+0))}. Note: third argument r 493 ++ may be regarded as the 494 ++ identity element for the function f. 495 map : (A -> B, VA) -> VB 496 ++ map(f, a) applies function f to each member of one-dimensional array 497 ++ \spad{a} resulting in a new one-dimensional array over a 498 ++ possibly different underlying domain. 499 500 Implementation ==> add 501 map(f, v) == map(f, v)$O2 502 scan(f, v, b) == scan(f, v, b)$O2 503 reduce(f, v, b) == reduce(f, v, b)$O2 504 505--Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. 506--All rights reserved. 507-- 508--Redistribution and use in source and binary forms, with or without 509--modification, are permitted provided that the following conditions are 510--met: 511-- 512-- - Redistributions of source code must retain the above copyright 513-- notice, this list of conditions and the following disclaimer. 514-- 515-- - Redistributions in binary form must reproduce the above copyright 516-- notice, this list of conditions and the following disclaimer in 517-- the documentation and/or other materials provided with the 518-- distribution. 519-- 520-- - Neither the name of The Numerical ALgorithms Group Ltd. nor the 521-- names of its contributors may be used to endorse or promote products 522-- derived from this software without specific prior written permission. 523-- 524--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS 525--IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED 526--TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A 527--PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER 528--OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 529--EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 530--PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 531--PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 532--LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 533--NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 534--SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 535 536 537--%% TupleFunctions2 538--TupleFunctions2(A: Type, B: Type): with 539-- map: (A -> B, Tuple A) -> Tuple B 540-- == add 541-- map(f, t) == 542-- p: PrimitiveArray(B) := new length t 543-- for i in minIndex p .. maxIndex p repeat 544-- p.i := f select(t, i) 545-- p::Tuple(B) 546