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 >
Text File  |  2000-07-29  |  4KB  |  189 lines
  1. ############################################################################
  2. #
  3. #    Name:    skio.icn
  4. #
  5. #    Title:    Scheme in Icon
  6. #
  7. #    Author: Bob Alexander
  8. #
  9. #    Date:    March 23, 1995
  10. #
  11. #    Description: see skeem.icn
  12. #
  13. ############################################################################
  14.  
  15. #
  16. # skeem -- Scheme in Icon
  17. #
  18. # Output procedures
  19. #
  20.  
  21. #
  22. # Initialize
  23. #
  24. # List entries are described in skfun.icn.
  25. #
  26. procedure InitIO()
  27.    DefFunction([
  28.       CALL_WITH_INPUT_FILE,2,
  29.       CALL_WITH_OUTPUT_FILE,2,
  30.       CLOSE_INPUT_PORT,
  31.       CLOSE_OUTPUT_PORT,
  32.       CURRENT_INPUT_PORT,0,
  33.       CURRENT_OUTPUT_PORT,0,
  34.       DISPLAY,1,2,
  35.       EOF_OBJECT_P,
  36.       INPUT_PORT_P,
  37.       NEWLINE,0,1,
  38.       OPEN_INPUT_FILE,
  39.       OPEN_OUTPUT_FILE,
  40.       OUTPUT_PORT_P,
  41.       PEEK_CHAR,0,1,
  42.       READ,0,1,
  43.       READ_CHAR,0,1,
  44.       WITH_INPUT_FROM_FILE,2,
  45.       WITH_OUTPUT_FROM_FILE,2,
  46.       WRITE,1,2,
  47.       WRITE_CHAR,1,2])
  48.    return
  49. end
  50.  
  51.  
  52. #
  53. # Input and Output
  54. #
  55. # Ports
  56. #
  57.  
  58. procedure CALL_WITH_INPUT_FILE(file,func)
  59.    return CallWithFile(file,func,"r",CALL_WITH_INPUT_FILE)
  60. end
  61.  
  62. procedure CALL_WITH_OUTPUT_FILE(file,func)
  63.    return CallWithFile(file,func,"w",CALL_WITH_OUTPUT_FILE)
  64. end
  65.  
  66. procedure CallWithFile(file,func,option,funName)
  67.    local f,result
  68.    f := OpenFile(file,option,funName) | fail
  69.    result := Apply(func,LLPair(Port(f,option))) | fail
  70.    close(f)
  71.    return result
  72. end
  73.  
  74. procedure INPUT_PORT_P(x)
  75.    return (type(x) == "Port",find("w",x.option),F) | T
  76. end
  77.  
  78. procedure OUTPUT_PORT_P(x)
  79.    return (type(x) == "Port",find("w",x.option),T) | F
  80. end
  81.  
  82. procedure CURRENT_INPUT_PORT()
  83.    return InputPortStack[1]
  84. end
  85.  
  86. procedure CURRENT_OUTPUT_PORT()
  87.    return OutputPortStack[1]
  88. end
  89.  
  90. procedure WITH_INPUT_FROM_FILE(file,func)
  91.    return WithFile(file,func,"r",WITH_INPUT_FROM_FILE,InputPortStack)
  92. end
  93.  
  94. procedure WITH_OUTPUT_FROM_FILE(file,func)
  95.    return WithFile(file,func,"w",WITH_OUTPUT_FROM_FILE,OutputPortStack)
  96. end
  97.  
  98. procedure WithFile(file,func,option,funName,portStack)
  99.    local f,result
  100.    f := OpenFile(file,option,funName) | fail
  101.    push(portStack,Port(f,option))
  102.    result := Apply(func,LLNull) | fail
  103.    close(f)
  104.    pop(portStack)
  105.    return result
  106. end
  107.  
  108. procedure OpenFile(file,option,funName)
  109.    local fn
  110.    fn := file.value | fail
  111.    return open(fn,option) |
  112.       Error(funName,"Can't open file ",file)
  113. end
  114.  
  115. procedure OPEN_INPUT_FILE(file)
  116.    return Port(OpenFile(file,"r",OPEN_INPUT_FILE),"r")
  117. end
  118.  
  119. procedure OPEN_OUTPUT_FILE(file)
  120.    return Port(OpenFile(file,"w",OPEN_OUTPUT_FILE),"w")
  121. end
  122.  
  123. procedure CLOSE_INPUT_PORT(port)
  124.    return ClosePort(port)
  125. end
  126.  
  127. procedure CLOSE_OUTPUT_PORT(port)
  128.    return ClosePort(port)
  129. end
  130.  
  131. procedure ClosePort(port)
  132.    close(port.file)
  133.    return port
  134. end
  135.  
  136. #
  137. # Input
  138. #
  139.  
  140. procedure READ(port)
  141.    local f
  142.    f := (\port | InputPortStack[1]).file
  143.    return ReadOneExpr(f) | EOFObject
  144. end
  145.  
  146. procedure READ_CHAR(port)
  147.    local f
  148.    f := (\port | InputPortStack[1]).file
  149.    return Char(reads(f)) | EOFObject
  150. end
  151.  
  152. procedure PEEK_CHAR(port)
  153.    local f
  154.    f := (\port | InputPortStack[1]).file
  155.    return Char(1(reads(f),seek(f,where(f) - 1))) | EOFObject
  156. end
  157.  
  158. procedure EOF_OBJECT_P(x)
  159.    return (x === EOFObject,T) | F
  160. end
  161.  
  162. #
  163. # Output.
  164. #
  165.  
  166. procedure WRITE(value,port)
  167.    /port := OutputPortStack[1]
  168.    writes(port.file,Print(value))
  169.    return port
  170. end
  171.  
  172. procedure DISPLAY(value,port)
  173.    /port := OutputPortStack[1]
  174.    writes(port.file,Print(value,"display"))
  175.    return port
  176. end
  177.  
  178. procedure NEWLINE(port)
  179.    /port := OutputPortStack[1]
  180.    write(port.file)
  181.    return port
  182. end
  183.  
  184. procedure WRITE_CHAR(char,port)
  185.    /port := OutputPortStack[1]
  186.    writes(port.file,char.value)
  187.    return port
  188. end
  189.