ps/step5_tco.ps

   1 /runlibfile where { pop }{ /runlibfile { run } def } ifelse %
   2 (types.ps) runlibfile
   3 (reader.ps) runlibfile
   4 (printer.ps) runlibfile
   5 (env.ps) runlibfile
   6 (core.ps) runlibfile
   7
   8 % read
   9 /_readline { print flush (%stdin) (r) file 1024 string readline } def
  10
  11 /READ {
  12     /str exch def
  13     str read_str
  14 } def
  15
  16
  17 % eval
  18 /eval_ast { 2 dict begin
  19     /env exch def
  20     /ast exch def
  21     %(eval_ast: ) print ast ==
  22     ast _symbol? { %if symbol
  23         env ast env_get
  24     }{ ast _sequential? { %elseif list or vector
  25         [
  26             ast /data get { %forall items
  27                 env EVAL
  28             } forall
  29         ] ast _list? { _list_from_array }{ _vector_from_array } ifelse
  30     }{ ast _hash_map? { %elseif list or vector
  31         <<
  32             ast /data get { %forall entries
  33                 env EVAL
  34             } forall
  35         >> _hash_map_from_dict
  36     }{ % else
  37         ast
  38     } ifelse } ifelse } ifelse
  39 end } def
  40
  41 /EVAL { 13 dict begin
  42     { %loop (TCO)
  43
  44     /env exch def
  45     /ast exch def
  46     /loop? false def
  47
  48     %(EVAL: ) print ast true _pr_str print (\n) print
  49     ast _list? not { %if not a list
  50         ast env eval_ast
  51     }{ %else apply the list
  52         /a0 ast 0 _nth def
  53         a0 _nil? { %if ()
  54             ast
  55         }{ /def! a0 eq { %if def!
  56             /a1 ast 1 _nth def
  57             /a2 ast 2 _nth def
  58             env a1  a2 env EVAL  env_set
  59         }{ /let* a0 eq { %if let*
  60             /a1 ast 1 _nth def
  61             /a2 ast 2 _nth def
  62             /let_env env null null env_new def
  63             0 2 a1 _count 1 sub { %for each pair
  64                 /idx exch def
  65                 let_env
  66                     a1 idx _nth
  67                     a1 idx 1 add _nth let_env EVAL
  68                     env_set
  69                     pop % discard the return value
  70             } for
  71             a2
  72             let_env
  73             /loop? true def % loop
  74         }{ /do a0 eq { %if do
  75             ast _count 2 gt { %if ast has more than 2 elements
  76                 ast 1 ast _count 2 sub _slice env eval_ast pop
  77             } if
  78             ast ast _count 1 sub _nth % last ast becomes new ast
  79             env
  80             /loop? true def % loop
  81         }{ /if a0 eq { %if if
  82             /a1 ast 1 _nth def
  83             /cond a1 env EVAL def
  84             cond null eq cond false eq or { % if cond is nil or false
  85                 ast _count 3 gt { %if false branch with a3
  86                     ast 3 _nth env
  87                     /loop? true def
  88                 }{ % else false branch with no a3
  89                     null
  90                 } ifelse
  91             }{ % true branch
  92                 ast 2 _nth env
  93                 /loop? true def
  94             } ifelse
  95         }{ /fn* a0 eq { %if fn*
  96             /a1 ast 1 _nth def
  97             /a2 ast 2 _nth def
  98             a2 env a1 _mal_function
  99         }{
 100             /el ast env eval_ast def
 101             el _rest el _first % stack: ast function
 102             dup _mal_function? { %if user defined function
 103                 fload % stack: ast new_env
 104                 /loop? true def
 105             }{ dup _function? { %else if builtin function
 106                 /data get exec
 107             }{ %else (regular procedure/function)
 108                 (cannot apply native proc!\n) print quit
 109             } ifelse } ifelse
 110         } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse
 111     } ifelse
 112
 113     loop? not { exit } if
 114     } loop % TCO
 115 end } def
 116
 117
 118 % print
 119 /PRINT {
 120     true _pr_str
 121 } def
 122
 123
 124 % repl
 125 /repl_env null null null env_new def
 126
 127 /RE { READ repl_env EVAL } def
 128 /REP { READ repl_env EVAL PRINT } def
 129
 130 % core.ps: defined using postscript
 131 /_ref { repl_env 3 1 roll env_set pop } def
 132 core_ns { _function _ref } forall
 133
 134 % core.mal: defined using the language itself
 135 (\(def! not \(fn* \(a\) \(if a false true\)\)\)) RE pop
 136
 137 % repl loop
 138 { %loop
 139     (user> ) _readline
 140     not { exit } if  % exit if EOF
 141
 142     { %try
 143         REP print (\n) print
 144     } stopped {
 145         (Error: ) print
 146         get_error_data false _pr_str print (\n) print
 147         $error /newerror false put
 148         $error /errorinfo null put
 149         clear
 150         cleardictstack
 151     } if
 152 } bind loop
 153
 154 (\n) print  % final newline before exit for cleanliness
 155 quit