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 / skeem.icn < prev    next >
Text File  |  2000-07-29  |  4KB  |  153 lines
  1. ############################################################################
  2. #
  3. #    Name:    skeem.icn
  4. #
  5. #    Title:    Scheme in Icon
  6. #
  7. #    Author: Bob Alexander
  8. #
  9. #    Date:    February 19, 1995
  10. #
  11. #    Description: R4RS Scheme, with the exception that continuations
  12. #        are escape procedures only (i.e. do no have unlimited
  13. #        extent)
  14. #
  15. ############################################################################
  16.  
  17. #
  18. # skeem -- Scheme in Icon
  19. #
  20. # Main program, initialization, and read/eval/print procedure
  21. #
  22.  
  23. link llist,escapesq,options
  24. link skfun,skbasic,skcontrl,skio,sklist,skmisc,sknumber,skstring,skextra
  25. link skutil,skin,skout
  26. #link skdebug
  27. #link ximage
  28.  
  29. global    GlobalEnv,UserEnv,CurrentEnv,  # environments
  30.     T,F,NIL,Unbound,Failure,       # universal constants
  31.     InputPortStack,
  32.     OutputPortStack,
  33.     EscapeData,FailProc,Resume,BreakLevel,FuncName,
  34.     EOFObject,
  35.     Space
  36.  
  37. global    TraceSet,               # set of currently traced functions
  38.     FTrace                   # flag for tracing all functions
  39.  
  40. global    TraceReader,EchoReader,NoError
  41.  
  42. record String(value)               # used for string datatyepe
  43. record Char(value)               # used for character datatyepe
  44. record Port(file,option)           # used for port datatyepe
  45. record Symbol(string,value)
  46. record Promise(proc,ready,result)
  47. record UniqueObject(name)
  48. record Value(value)
  49.  
  50. record Function(proc,name,minArgs,maxArgs,traced)
  51. record Lambda(proc,name,minArgs,maxArgs,env,traced)
  52. record Macro(proc,name,minArgs,maxArgs,env,traced)
  53. record Syntax(proc,name,minArgs,maxArgs,traced)
  54.  
  55. #
  56. # main() -- Analyzes the arguments and invokes the read/eval/print loop.
  57. #
  58. procedure main(arg)
  59.    local fn,f
  60.    Initialize(arg)
  61.    if *arg = 0 then arg := ["-"]
  62.    if \TraceReader then &trace := -1
  63.    every fn := !arg do {
  64.       f := if fn == "-" then &input else open(fn) | stop("Can't open ",fn)
  65.       ReadEvalPrint(f,,"top")
  66.       }
  67. end
  68.  
  69. #
  70. # Initialize() - Set up global values
  71. #
  72. procedure Initialize(arg)
  73.    Options(arg)
  74.    Space := ' \t\n\r\l\v\f'
  75.    T := UniqueObject("#t")
  76.    F := UniqueObject("#f")
  77.    Unbound := UniqueObject("unbound")
  78.    Failure := UniqueObject("failure")
  79.    EOFObject := UniqueObject("EOF object")
  80.    NIL := &null
  81.    BreakLevel := 0
  82.    InputPortStack := [Port(&input,"r")]
  83.    OutputPortStack := [Port(&output,"w")]
  84.    TraceSet := set()
  85.    GlobalEnv := PushFrame()
  86.    InitFunctions()
  87.    UserEnv := PushFrame()
  88. #########
  89. ##    every x := !sort(LLFirst(GlobalEnv)) do {
  90. ##     y := x[2]
  91. ##     sname := if ProcName(y.proc) == y.name then "" else " " || y.name
  92. ##     write(right(y.minArgs,2),right(\y.maxArgs,2) | " -"," ",image(y.proc)[11:0],sname)
  93. ##     }
  94. #########
  95.    return
  96. end
  97.  
  98. procedure Options(arg)
  99.    local opt
  100.    opt := options(arg,"tre")
  101.    TraceReader := opt["t"]
  102.    EchoReader := opt["r"]
  103.    NoError := opt["e"]
  104.    return opt
  105. end
  106.  
  107. #
  108. # ReadEvalPrint() -- The R/E/P loop.
  109. #
  110. procedure ReadEvalPrint(f,quiet,top)
  111.    local sexpr,value,saveEnv
  112.    every sexpr := ReadAllExprs(f) do {
  113.       if \EchoReader then write("Read: ",Print(sexpr))
  114.       saveEnv := CurrentEnv
  115.       EscapeData := Resume := &null
  116.       if /NoError then &error := 1
  117.       if value := Eval(sexpr) then (if /quiet then write(Print(value)))
  118.       else {
  119.      #
  120.      # The expression failed -- why?
  121.      #
  122.      if \Resume then {
  123.         if /top then {
  124.            if Resume === "top" then fail         # (top)
  125.            return 1(.Resume.value,Resume := &null)     # (resume x)
  126.            }
  127.         if Resume ~=== "top" then {
  128.            Error("READ-EVAL-PRINT","Can't resume from top level")
  129.            Resume := &null
  130.            }
  131.         }
  132.      else {
  133.         EscapeCheck()     # escape that doesn't exist (any more)
  134.         ErrorCheck()     # run-time error
  135.         }
  136.      CurrentEnv := saveEnv
  137.      }
  138.       }
  139.    return value
  140. end
  141.  
  142. procedure ErrorCheck()
  143.    if &errornumber then {
  144.       Error(FailProc,"Icon run-time error: ",&errortext,
  145.      ("\n   offending value:_
  146.        \n      skeem representation:  " || Print(&errorvalue) || "_
  147.        \n      Icon  representation:  " || image(&errorvalue) | "")\1)
  148.       FailProc := &null
  149.       errorclear()
  150.       }
  151.    else return
  152. end
  153.