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
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
############################################################################
#
# Name: skeem.icn
#
# Title: Scheme in Icon
#
# Author: Bob Alexander
#
# Date: February 19, 1995
#
# Description: R4RS Scheme, with the exception that continuations
# are escape procedures only (i.e. do no have unlimited
# extent)
#
############################################################################
#
# skeem -- Scheme in Icon
#
# Main program, initialization, and read/eval/print procedure
#
link llist,escapesq,options
link skfun,skbasic,skcontrl,skio,sklist,skmisc,sknumber,skstring,skextra
link skutil,skin,skout
#link skdebug
#link ximage
global GlobalEnv,UserEnv,CurrentEnv, # environments
T,F,NIL,Unbound,Failure, # universal constants
InputPortStack,
OutputPortStack,
EscapeData,FailProc,Resume,BreakLevel,FuncName,
EOFObject,
Space
global TraceSet, # set of currently traced functions
FTrace # flag for tracing all functions
global TraceReader,EchoReader,NoError
record String(value) # used for string datatyepe
record Char(value) # used for character datatyepe
record Port(file,option) # used for port datatyepe
record Symbol(string,value)
record Promise(proc,ready,result)
record UniqueObject(name)
record Value(value)
record Function(proc,name,minArgs,maxArgs,traced)
record Lambda(proc,name,minArgs,maxArgs,env,traced)
record Macro(proc,name,minArgs,maxArgs,env,traced)
record Syntax(proc,name,minArgs,maxArgs,traced)
#
# main() -- Analyzes the arguments and invokes the read/eval/print loop.
#
procedure main(arg)
local fn,f
Initialize(arg)
if *arg = 0 then arg := ["-"]
if \TraceReader then &trace := -1
every fn := !arg do {
f := if fn == "-" then &input else open(fn) | stop("Can't open ",fn)
ReadEvalPrint(f,,"top")
}
end
#
# Initialize() - Set up global values
#
procedure Initialize(arg)
Options(arg)
Space := ' \t\n\r\l\v\f'
T := UniqueObject("#t")
F := UniqueObject("#f")
Unbound := UniqueObject("unbound")
Failure := UniqueObject("failure")
EOFObject := UniqueObject("EOF object")
NIL := &null
BreakLevel := 0
InputPortStack := [Port(&input,"r")]
OutputPortStack := [Port(&output,"w")]
TraceSet := set()
GlobalEnv := PushFrame()
InitFunctions()
UserEnv := PushFrame()
#########
## every x := !sort(LLFirst(GlobalEnv)) do {
## y := x[2]
## sname := if ProcName(y.proc) == y.name then "" else " " || y.name
## write(right(y.minArgs,2),right(\y.maxArgs,2) | " -"," ",image(y.proc)[11:0],sname)
## }
#########
return
end
procedure Options(arg)
local opt
opt := options(arg,"tre")
TraceReader := opt["t"]
EchoReader := opt["r"]
NoError := opt["e"]
return opt
end
#
# ReadEvalPrint() -- The R/E/P loop.
#
procedure ReadEvalPrint(f,quiet,top)
local sexpr,value,saveEnv
every sexpr := ReadAllExprs(f) do {
if \EchoReader then write("Read: ",Print(sexpr))
saveEnv := CurrentEnv
EscapeData := Resume := &null
if /NoError then &error := 1
if value := Eval(sexpr) then (if /quiet then write(Print(value)))
else {
#
# The expression failed -- why?
#
if \Resume then {
if /top then {
if Resume === "top" then fail # (top)
return 1(.Resume.value,Resume := &null) # (resume x)
}
if Resume ~=== "top" then {
Error("READ-EVAL-PRINT","Can't resume from top level")
Resume := &null
}
}
else {
EscapeCheck() # escape that doesn't exist (any more)
ErrorCheck() # run-time error
}
CurrentEnv := saveEnv
}
}
return value
end
procedure ErrorCheck()
if &errornumber then {
Error(FailProc,"Icon run-time error: ",&errortext,
("\n offending value:_
\n skeem representation: " || Print(&errorvalue) || "_
\n Icon representation: " || image(&errorvalue) | "")\1)
FailProc := &null
errorclear()
}
else return
end
|
