1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
|
############################################################################
#
# File: array.icn
#
# Subject: Procedures for n-dimensional arrays
#
# Author: Ralph E. Griswold
#
# Date: April 30, 1993
#
############################################################################
#
# This file is in the public domain.
#
############################################################################
#
# create_array([lbs], [ubs], value) creates a n-dimensional array
# with the specified lower bounds, upper bounds, and with each array element
# having the specified initial value.
#
# ref_array(A, i1, i2, ...) references the i1-th i2-th ... element of A.
#
############################################################################
record array(structure, lbs)
procedure create_array(lbs, ubs, value)
local lengths, i
if (*lbs ~= *ubs) | (*lbs = 0) then stop("*** bad specification")
lengths :=list(*lbs)
every i := 1 to *lbs do
lengths[i] := ubs[i] - lbs[i] + 1
return array(create_struct(lengths, value), lbs)
end
procedure create_struct(lengths, value)
local A
lengths := copy(lengths)
A := list(get(lengths), value)
if *lengths > 0 then
every !A := create_struct(lengths, value)
return A
end
procedure ref_array(A, subscrs[])
local lbs, i, A1
if *A.lbs ~= *subscrs then
stop("*** bad specification")
lbs := A.lbs
A1 := A.structure
every i := 1 to *subscrs - 1 do
A1 := A1[subscrs[i] - lbs[i] + 1] | fail
return A1[subscrs[-1] - lbs[-1] + 1]
end
|
