home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.cs.arizona.edu
/
ftp.cs.arizona.edu.tar
/
ftp.cs.arizona.edu
/
icon
/
historic
/
v941.tgz
/
icon.v941src.tar
/
icon.v941src
/
ipl
/
packs
/
skeem
/
skextra.icn
< prev
next >
Wrap
Text File
|
2000-07-29
|
3KB
|
178 lines
############################################################################
#
# Name: skextra.icn
#
# Title: Scheme in Icon
#
# Author: Bob Alexander
#
# Date: March 23, 1995
#
# Description: see skeem.icn
#
############################################################################
#
# skeem -- Scheme in Icon
#
# Some additional stuff not in the standard
#
#
# Initialize
#
# List entries are described in skfun.icn.
#
procedure InitExtra()
#
# Functions
#
DefFunction([
ADD1,
ATOM_P,
BREAK,0,
BREAK_LEVEL,0,
EVAL,1,2,
QUIT,0,1,
READ_LINE,0,1,
RESUME,0,1,
SUB1,
TOP,0,
TRACE,&null,
UNTRACE,&null])
#
# Syntaxes
#
DefSyntax([
DEFINE_MACRO,"twoOrMore",
ITRACE,
ITRACEOFF,0,
ITRACEON,0,
REPEAT,"oneOrMore",
TRACE_ALL,0,
UNLESS,"oneOrMore",
WHEN,"oneOrMore"])
return
end
procedure EVAL(ex,env)
return Eval(ex,env)
end
procedure QUIT(exitCode)
exit(exitCode)
end
procedure WHEN(test,body[])
return if F ~=== (Eval(test) | fail)\1 then
EvalSeq(LList!body) | fail
end
procedure UNLESS(test,body[])
return if F === (Eval(test) | fail)\1 then
EvalSeq(LList!body) | fail
end
procedure REPEAT(count,body[])
local result
body := LList!body
every 1 to count do
result := EvalSeq(body) | fail
return result
end
procedure ATOM_P(arg)
return (LLIsNotPair(arg),T) | F
end
procedure BREAK()
local result
BreakLevel +:= 1
result := ReadEvalPrint((InputPortStack[1].file | &input)\1) | Failure
BreakLevel -:= 1
return Failure ~=== result
end
procedure BREAK_LEVEL()
return BreakLevel
end
procedure RESUME(value)
Resume := Value(\value | F)
fail
end
procedure TOP()
Resume := "top"
fail
end
procedure TRACE(funcs[])
local fn,result,element
if *funcs = 0 then {
result := LLNull
every result := LLPair((!sort(TraceSet)).name,result)
return LLInvert(result)
}
else every element := !funcs do {
fn := Eval(element) | fail
fn.traced := "true"
insert(TraceSet,fn)
return NIL
}
end
procedure UNTRACE(funcs[])
local fn,element
if *funcs = 0 then {
FTrace := &null
every (!TraceSet).traced := &null
}
else every element := !funcs do {
fn := Eval(element) | fail
fn.traced := &null
delete(TraceSet,fn)
}
return NIL
end
procedure ITRACEON()
return (&trace := -1,T)
end
procedure ITRACEOFF()
return (&trace := 0,F)
end
procedure ITRACE(expr)
local value
&trace := -1
value := Eval(expr) | Failure
&trace := 0
return Failure ~=== value
end
procedure TRACE_ALL()
return FTrace := T
end
procedure DEFINE_MACRO(arg)
local sym,value
return Error(DEFINE_MACRO,"Not implemented for now")
## return DEFINE(arg,,Macro)
end
procedure ADD1(n)
return n + 1
end
procedure SUB1(n)
return n - 1
end
procedure READ_LINE(port)
local f
f := (\port | InputPortStack[1]).file
return String(read(f)) | EOFObject
end