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 / skout.icn < prev    next >
Text File  |  2000-07-29  |  3KB  |  106 lines
  1. ############################################################################
  2. #
  3. #    Name:    skout.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. # Output utility procedures
  19. #
  20.  
  21. procedure Print(x,display)
  22.    local s,node,sep
  23.    static symFirst,symRest
  24.    initial {
  25.       symFirst := &ucase ++ '!$%&*/:<=>?~_^'
  26.       symRest := symFirst ++ &digits ++ '.+-'
  27.       }
  28.    return {
  29.       if LLIsNull(x) then "()"
  30.       else if LLIsPair(x) then {
  31.      s := "("
  32.      sep := ""
  33.      every node := LLPairs(x) do {
  34.         s ||:= sep || Print(LLFirst(node),display)
  35.         sep := " "
  36.         }
  37.      s ||:= if LLIsNull(LLRest(node)) then ")"
  38.      else " . " || Print(LLRest(node),display) || ")"
  39.      }
  40.       else if x === T then "#t"
  41.       else if x === F then "#f"
  42.       else if x === Unbound then "#<unbound>"
  43.       else if x === EOFObject then "#<eof>"
  44.       else if type(x) == "Promise" then "#<promise>"
  45.       else if type(x) == "Port" then "#<" ||
  46.         (if find("w",x.option) then "output " else "input ") ||
  47.         image(x.file) || ">"
  48.       else if VectorP(x) then {
  49.      s := "#("
  50.      sep := ""
  51.      every node := !x do {
  52.         s ||:= sep || Print(node,display)
  53.         sep := " "
  54.         }
  55.      s ||:= ")"
  56.      }
  57.       else if s := case type(x) of {
  58.      "Function": PrintFunction(x,"built-in function")
  59.      "Lambda": PrintFunction(x,"interpreted function")
  60.      "Macro": PrintFunction(x,"macro")
  61.      "Syntax":  PrintFunction(x,"syntax")
  62.      } then s
  63.       else if StringP(x) then if \display then x.value else image(x.value)
  64.       else if CharP(x) then if \display then x.value else {
  65.      "#\\" || (case x.value of {
  66.         " ": "space"
  67.         "\t": "tab"
  68.         "\n": "newline"
  69.         "\b": "backspace"
  70.         "\d": "delete"
  71.         "\e": "escape"
  72.         "\f": "formfeed"
  73.         "\r": "return"
  74.         "\v": "verticaltab"
  75.         default: x.value
  76.         })
  77.      }
  78.       else if SymbolP(x) then if \display then x else {
  79.      (x ? ((=("+" | "-" | "...") |
  80.            (tab(any(symFirst)) & tab(many(symRest)) | &null)) &
  81.            pos(0)),x) | {
  82.         x ? {
  83.            s := ""
  84.            while s ||:= tab(upto('|\\')) do s ||:= case move(1) of {
  85.           "|": "\\|"
  86.           default: "\\\\"
  87.           }
  88.            s ||:= tab(0)
  89.            }
  90.         "|" || s || "|"
  91.         }
  92.      }
  93.       else if numeric(x) then string(x)
  94.       else "#<Icon(" || image(x) || ")>"
  95.       }
  96. end
  97.  
  98. procedure PrintFunction(fun,fType)
  99.    local p
  100.    return case type(p := fun.proc) of {
  101.       "LLPair": "#<" || fType || " " || (\fun.name | "???") || ">"
  102.       "procedure": "#<" || image(p) || ">"
  103.       default: runerr(500,type(p))
  104.       }
  105. end
  106.