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
/
skio.icn
< prev
next >
Wrap
Text File
|
2000-07-29
|
4KB
|
189 lines
############################################################################
#
# Name: skio.icn
#
# Title: Scheme in Icon
#
# Author: Bob Alexander
#
# Date: March 23, 1995
#
# Description: see skeem.icn
#
############################################################################
#
# skeem -- Scheme in Icon
#
# Output procedures
#
#
# Initialize
#
# List entries are described in skfun.icn.
#
procedure InitIO()
DefFunction([
CALL_WITH_INPUT_FILE,2,
CALL_WITH_OUTPUT_FILE,2,
CLOSE_INPUT_PORT,
CLOSE_OUTPUT_PORT,
CURRENT_INPUT_PORT,0,
CURRENT_OUTPUT_PORT,0,
DISPLAY,1,2,
EOF_OBJECT_P,
INPUT_PORT_P,
NEWLINE,0,1,
OPEN_INPUT_FILE,
OPEN_OUTPUT_FILE,
OUTPUT_PORT_P,
PEEK_CHAR,0,1,
READ,0,1,
READ_CHAR,0,1,
WITH_INPUT_FROM_FILE,2,
WITH_OUTPUT_FROM_FILE,2,
WRITE,1,2,
WRITE_CHAR,1,2])
return
end
#
# Input and Output
#
# Ports
#
procedure CALL_WITH_INPUT_FILE(file,func)
return CallWithFile(file,func,"r",CALL_WITH_INPUT_FILE)
end
procedure CALL_WITH_OUTPUT_FILE(file,func)
return CallWithFile(file,func,"w",CALL_WITH_OUTPUT_FILE)
end
procedure CallWithFile(file,func,option,funName)
local f,result
f := OpenFile(file,option,funName) | fail
result := Apply(func,LLPair(Port(f,option))) | fail
close(f)
return result
end
procedure INPUT_PORT_P(x)
return (type(x) == "Port",find("w",x.option),F) | T
end
procedure OUTPUT_PORT_P(x)
return (type(x) == "Port",find("w",x.option),T) | F
end
procedure CURRENT_INPUT_PORT()
return InputPortStack[1]
end
procedure CURRENT_OUTPUT_PORT()
return OutputPortStack[1]
end
procedure WITH_INPUT_FROM_FILE(file,func)
return WithFile(file,func,"r",WITH_INPUT_FROM_FILE,InputPortStack)
end
procedure WITH_OUTPUT_FROM_FILE(file,func)
return WithFile(file,func,"w",WITH_OUTPUT_FROM_FILE,OutputPortStack)
end
procedure WithFile(file,func,option,funName,portStack)
local f,result
f := OpenFile(file,option,funName) | fail
push(portStack,Port(f,option))
result := Apply(func,LLNull) | fail
close(f)
pop(portStack)
return result
end
procedure OpenFile(file,option,funName)
local fn
fn := file.value | fail
return open(fn,option) |
Error(funName,"Can't open file ",file)
end
procedure OPEN_INPUT_FILE(file)
return Port(OpenFile(file,"r",OPEN_INPUT_FILE),"r")
end
procedure OPEN_OUTPUT_FILE(file)
return Port(OpenFile(file,"w",OPEN_OUTPUT_FILE),"w")
end
procedure CLOSE_INPUT_PORT(port)
return ClosePort(port)
end
procedure CLOSE_OUTPUT_PORT(port)
return ClosePort(port)
end
procedure ClosePort(port)
close(port.file)
return port
end
#
# Input
#
procedure READ(port)
local f
f := (\port | InputPortStack[1]).file
return ReadOneExpr(f) | EOFObject
end
procedure READ_CHAR(port)
local f
f := (\port | InputPortStack[1]).file
return Char(reads(f)) | EOFObject
end
procedure PEEK_CHAR(port)
local f
f := (\port | InputPortStack[1]).file
return Char(1(reads(f),seek(f,where(f) - 1))) | EOFObject
end
procedure EOF_OBJECT_P(x)
return (x === EOFObject,T) | F
end
#
# Output.
#
procedure WRITE(value,port)
/port := OutputPortStack[1]
writes(port.file,Print(value))
return port
end
procedure DISPLAY(value,port)
/port := OutputPortStack[1]
writes(port.file,Print(value,"display"))
return port
end
procedure NEWLINE(port)
/port := OutputPortStack[1]
write(port.file)
return port
end
procedure WRITE_CHAR(char,port)
/port := OutputPortStack[1]
writes(port.file,char.value)
return port
end