ps/step3_env.ps

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