ps/step3_env.ps

   1 (types.ps) run
   2 (reader.ps) run
   3
   4 % read
   5 /_readline { print flush (%stdin) (r) file 99 string readline } def
   6
   7 /READ {
   8     /str exch def
   9     str read_str
  10 } def
  11
  12
  13 % eval
  14 /eval_ast { 2 dict begin
  15     /env exch def
  16     /ast exch def
  17     %(eval_ast: ) print ast ==
  18     ast _symbol? { %if symbol
  19         env ast env_get
  20     }{ ast _list? { %elseif list
  21         [
  22             ast {
  23                 env EVAL
  24             } forall
  25         ]
  26     }{ % else
  27         ast
  28     } ifelse } ifelse
  29 end } def
  30
  31 /EVAL { 8 dict begin
  32     /env exch def
  33     /ast exch def
  34
  35     %(EVAL: ) print ast true _pr_str print (\n) print
  36     ast _list? not { %if not a list
  37         ast env eval_ast
  38     }{ %else apply the list
  39         /a0 ast 0 get def
  40         /def! a0 eq { %if def!
  41             /a1 ast 1 get def
  42             /a2 ast 2 get def
  43             env a1  a2 env EVAL  env_set
  44         }{ /let* a0 eq { %if let*
  45             /a1 ast 1 get def
  46             /a2 ast 2 get def
  47             /let_env env [ ] [ ] env_new def
  48             0 2 a1 length 1 sub { %for each pair
  49                 /idx exch def
  50                 let_env
  51                     a1 idx get
  52                     a1 idx 1 add get let_env EVAL
  53                     env_set
  54                     pop % discard the return value
  55             } for
  56             a2 let_env EVAL
  57         }{
  58             /el ast env eval_ast def
  59             el _rest el _first % stack: ast function
  60             exec % apply function to args
  61         } ifelse } ifelse
  62     } ifelse
  63 end } def
  64
  65
  66 % print
  67 /PRINT {
  68     true _pr_str
  69 } def
  70
  71
  72 % repl
  73 /repl_env null [ ] [ ] env_new def
  74
  75 /REP { READ repl_env EVAL PRINT } def
  76 /_ref { repl_env 3 1 roll env_set pop } def
  77
  78 (+) { dup 0 get exch 1 get add } _ref
  79 (-) { dup 0 get exch 1 get sub } _ref
  80 (*) { dup 0 get exch 1 get mul } _ref
  81 (/) { dup 0 get exch 1 get idiv } _ref
  82
  83 { % loop
  84     (user> ) _readline
  85     not { exit } if  % exit if EOF
  86
  87     { %try
  88         REP print (\n) print
  89     } stopped {
  90         (Error: ) print
  91         get_error_data false _pr_str print (\n) print
  92         $error /newerror false put
  93         $error /errorinfo null put
  94         clear
  95         cleardictstack
  96     } if
  97 } bind loop
  98
  99 (\n) print  % final newline before exit for cleanliness
 100 quit