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 / skin.icn < prev    next >
Text File  |  2000-07-29  |  5KB  |  234 lines
  1. ############################################################################
  2. #
  3. #    Name:    skin.icn
  4. #
  5. #    Title:    Scheme in Icon
  6. #
  7. #    Author: Bob Alexander
  8. #
  9. #    Date:    February 19, 1995
  10. #
  11. #    Description: see skeem.icn
  12. #
  13. ############################################################################
  14.  
  15. #
  16. # skeem -- Scheme in Icon
  17. #
  18. # Input utility procedures
  19. #
  20.  
  21. global BackToken
  22.  
  23. #
  24. # ReadAllExprs() - Generate expressions from file f
  25. #
  26. procedure ReadAllExprs(f)
  27.    "" ? (suspend |ScanExpr(FileRec(f)))
  28. end
  29.  
  30. #
  31. # ReadOneExpr() - Read one expression from f.
  32. #
  33. procedure ReadOneExpr(f)
  34.    local result,fRec
  35.    "" ? {
  36.       result := ScanExpr(fRec := FileRec(f))
  37.       seek(f,fRec.where + &pos - 1)
  38.       }
  39.    return result
  40. end
  41.  
  42. #
  43. # StringToExpr() - Generate expressions from string s
  44. #
  45. procedure StringToExpr(s)
  46.    s ? (suspend |ScanExpr())
  47. end
  48.  
  49. procedure ScanExpr(f)
  50.    local token
  51.    return case token := ScanToken(f) | fail of {
  52.       "(": ScanList(f)
  53.       "#(": ScanVector(f)
  54.       !"'`," | ",@": ScanQuote(f,token)
  55.       default:
  56.      if type(token) == "Symbol" then token.string
  57.      else token
  58.       }
  59. end
  60.  
  61. procedure ScanList(f)
  62.    local result,token,dot
  63.    result := LLNull
  64.    while (token := ScanToken(f)) ~=== ")" do {
  65.       if token === "." then {
  66.      dot := ScanExpr(f)
  67.      }
  68.       else {
  69.      BackToken := token
  70.      result := LLPair(ScanExpr(f),result)
  71.      }
  72.       }
  73.    return LLInvert(result,dot)
  74. end
  75.  
  76. procedure ScanVector(f)
  77.    local result,token
  78.    result := []
  79.    while (token := ScanToken(f)) ~=== ")" do {
  80.       BackToken := token
  81.       put(result,ScanExpr(f))
  82.       }
  83.    return result
  84. end
  85.  
  86. procedure ScanQuote(f,token)
  87.    return LList(
  88.       case token of {
  89.      "'": "QUOTE"
  90.      "`": "QUASIQUOTE"
  91.      ",": "UNQUOTE"
  92.      ",@": "UNQUOTE-SPLICING"
  93.      },
  94.       ScanExpr(f))
  95. end
  96.  
  97. procedure ScanToken(f)
  98.    return 1(\.BackToken,BackToken := &null) | {
  99.       #
  100.       # Skip over leading white space (including comments, possibly
  101.       # spanning lines).
  102.       #
  103.       #showscan("before space")
  104.       while {
  105.      tab(many(Space)) |
  106.      (if pos(0) then &subject := ReadFileRec(\f)) |
  107.      (if =";" then tab(0)) |
  108.      (if ="#|" then {
  109.         until tab(find("|#") + 2) do &subject := ReadFileRec(\f) | fail
  110.         &null
  111.         })
  112.      }
  113.       #showscan("after space")
  114.       #
  115.       # Scan then token.
  116.       #
  117.       ScanSymbol() | ScanNumber() | ScanSpecial() | ScanString() |
  118.         ScanChar() | ScanBoolean() | move(1)
  119.       }
  120. end
  121.  
  122. procedure ScanSymbol()
  123.    static symFirst,symRest,nonSym
  124.    initial {
  125.       symFirst := &letters ++ '!$%&*/:<=>?~_^'
  126.       symRest := symFirst ++ &digits ++ '.+-'
  127.       nonSym := ~symRest
  128.       }
  129.    return Symbol(
  130.       (match("|"),escape(quotedstring("|")[2:-1])) |
  131.       map(1((tab(any(symFirst)) || (tab(many(symRest)) | "") |
  132.         =("+" | "-" | "...")),
  133.      (any(nonSym) | pos(0))),&lcase,&ucase))
  134. end
  135.  
  136. procedure ScanNumber()
  137.    local nbr
  138.    static nbrFirst,nbrRest
  139.    initial {
  140.       nbrFirst := &digits ++ 'eE.'
  141.       nbrRest := nbrFirst ++ &letters ++ '#+-'
  142.       }
  143.    (nbr := ((tab(any('+-')) | "") || tab(any(nbrFirst))  |
  144.       ="#" || tab(any('bodxeiBODXEI'))) || (tab(many(nbrRest)) | "") &
  145.       nbr ~== ".") | fail
  146.    return StringToNumber(nbr) |
  147.       Error("READER","bad number: ",image(nbr))
  148. end
  149.  
  150. procedure StringToNumber(nbr,radix)
  151.    local exact,sign,number,c
  152.    radix := if \radix ~= 10 then radix || "r" else ""
  153.    sign := ""
  154.    exact := 1
  155.    map(nbr) ? return {
  156.       while ="#" do case move(1) of {
  157.      "b": radix := "2r"
  158.      "o": radix := "8r"
  159.      "d": radix := ""
  160.      "x": radix := "16r"
  161.      "e": exact := Round
  162.      "i": exact := real
  163.      default: &null # this case prevents the expression from failing
  164.      }
  165.       sign := tab(any('+-'))
  166.       number := ""
  167.       while number ||:= tab(upto('#sfdl')) do {
  168.      c := move(1)
  169.      number ||:=
  170.         if c == "#" then {
  171.            if exact === 1 then exact := real
  172.            "0"
  173.            }
  174.         else "e"
  175.      }
  176.       number ||:= tab(0)
  177.       #write(&errout,"+++++ exact = ",image(exact),
  178.       #  "; radix = ",image(radix),"; sign = ",image(sign),
  179.       #  "; number = ",image(number))
  180.       exact(numeric(sign || radix || number))
  181.       }
  182. end
  183.  
  184. procedure ScanSpecial()
  185.    return =("#(" | ",@" | !"()'`,") |
  186.       (="#<",Error("READER","unreadable object #<",tab(find(">") + 1 | 0)),F)
  187. end
  188.  
  189. procedure ScanBoolean()
  190.    return (="#",(=!"fF",F) | (=!"tT",T))
  191. end
  192.  
  193. procedure ScanString()
  194.    return String((match("\""),escape(quotedstring()[2:-1])))
  195. end
  196.  
  197. procedure ScanChar()
  198.    local chName
  199.    return Char((="#\\",
  200.       (case map(1(chName := tab(many(&letters)),*chName > 1)) of {
  201.      "space": " "
  202.      "tab": "\t"
  203.      "newline": "\n"
  204.      "backspace": "\b"
  205.      "delete": "\d"
  206.      "escape": "\e"
  207.      "formfeed": "\f"
  208.      "return": "\r"
  209.      "verticaltab": "\v"
  210.      default: Error("READER","unknown character name")
  211.      }) | move(1)))
  212. end
  213.  
  214. record FileRec(file,where)
  215.  
  216. procedure ReadFileRec(f)
  217.    local line
  218.    static doPrompt
  219.    initial  doPrompt := if find("MPW",&host) then &null else "true"
  220.    f.where := where(f.file)
  221.    if f.file === &input then {
  222.       if \doPrompt then
  223.      writes(if BreakLevel = 0 then "> " else "[" || BreakLevel || "] ")
  224.       line := read() | fail
  225. ##     line ? {
  226. ##        if =">" | (="[" || tab(find("]") + 1)) then
  227. ##           \f.where +:= &pos - 1
  228. ##        line := tab(0)
  229. ##        }
  230.       return line
  231.       }
  232.    else return read(f.file)
  233. end
  234.