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
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
|
############################################################################
#
# File: models.icn
#
# Subject: Procedure to model Icon functions
#
# Author: Ralph E. Griswold
#
# Date: May 1, 1993
#
############################################################################
#
# This file is in the public domain.
#
############################################################################
#
# These procedures model built-in Icon functions. Their purpose is
# primarily pedagogical.
#
# See Icon Analyst 11, pp. 5-7.
#
############################################################################
procedure tab(i)
suspend .&subject[.&pos : &pos <- i]
end
procedure upto(c, s, i, j)
local k
if /s := &subject then { # handle defaults
/i := &pos
}
else {
s := string(s) | runerr(103, s)
/i := 1
}
i := integer(i) | runerr(101, i)
i := cvpos(i, s) | fail
if not(/j := *s + 1) then {
j := integer(j) | runerr(101, j)
j := cvpos(j, s) | fail
if i > j then i :=: j
}
every k := i to j do
if !c == s[k] then suspend k # perform the actual mapping
# The following is faster, but not as clear.
#
# every k := i to j do
# if any(c, s[k]) then suspend k
fail
end
procedure map(s1, s2, s3)
local i, result
static last_s2, last_s3, map_array
initial map_array := list(256)
s1 := string(s1) | runerr(103, s1) # check types
s2 := def_str(s2, string(&ucase)) | runerr(103, s2) # default null values
s3 := def_str(s3, string(&lcase)) | runerr(103, s3)
if *s2 ~= *s3 then runerr(208)
# See if mapping array needs to be rebuilt
if (s2 ~=== last_s2) | (s3 ~=== last_s3) then {
last_s2 := s2
last_s3 := s3
every i := 1 to 256 do
map_array[i] := char(i - 1)
every i := 1 to *s2 do
map_array[ord(s2[i]) + 1] := s3[i]
}
result := ""
# every result ||:= map_array[ord(!s1) + 1] # do actual mapping
every i := 1 to *s1 do # do actual mapping
result ||:= map_array[ord(s1[i]) + 1]
return result
end
# Support procedures
# Produce the positive equivalent of i with respect to s.
procedure cvpos(i, s)
if i <= 0 then i +:= *s + 1
if i <= i <= *s + 1 then return i
else fail
end
# Default the null value to a specified string.
procedure def_str(s1, s2)
if /s1 then return s2
else return string(s1) # may fail
end
|
