ps/step4_if_fn_do.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 { 9 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         }{ /do a0 eq { %if do
  54             /el ast _rest env eval_ast def
  55             el el length 1 sub get % return last value
  56         }{ /if a0 eq { %if if
  57             /a1 ast 1 get def
  58             /cond a1 env EVAL def
  59             cond null eq cond false eq or { % if cond is nil or false
  60                 ast length 3 gt { %if false branch (a3) provided
  61                     ast 3 get env EVAL % EVAL false branch (a3)
  62                 }{
  63                     null
  64                 } ifelse
  65             }{
  66                 ast 2 get env EVAL % EVAL true branch (a2)
  67             } ifelse
  68         }{ /fn* a0 eq { %if fn*
  69             /a1 ast 1 get def
  70             /a2 ast 2 get def
  71             {   /user_defined  % mark this as user defined
  72                 __PARAMS__ __AST__ __ENV__ % closed over variables
  73                 4 dict begin
  74                 /ENV    exch def % closed over above, pos 3
  75                 /AST    exch def % closed over above, pos 2
  76                 /PARAMS exch def % closed over above, pos 1
  77                 /args   exch def
  78                 %(inside fn*:\n) print
  79                 %(  A1: ) print A1 ==
  80                 %(  A2: ) print A2 ==
  81                 %(  ENV: ) print ENV ==
  82                 %(  args: ) print args ==
  83                 AST   ENV PARAMS args env_new   EVAL
  84             end }
  85             dup length array copy cvx % make an actual copy/new instance
  86             dup 1 a1 put  % insert closed over a1 into position 1
  87             dup 2 a2 put  % insert closed over a2 into position 2
  88             dup 3 env put % insert closed over env into position 3
  89         }{
  90             /el ast env eval_ast def
  91             el _rest % args array
  92             el _first cvx % function
  93             %(vvv\n) print pstack (^^^\n) print
  94             exec % apply function to args
  95         } ifelse } ifelse } ifelse } ifelse } ifelse
  96     } ifelse
  97 end } def
  98
  99
 100 % print
 101 /PRINT {
 102     true _pr_str
 103 } def
 104
 105
 106 % repl
 107 /repl_env null [ ] [ ] env_new def
 108
 109 /RE { READ repl_env EVAL } def
 110 /REP { READ repl_env EVAL PRINT } def
 111 /_ref { repl_env 3 1 roll env_set pop } def
 112
 113 types_ns { _ref } forall
 114
 115 (\(def! not \(fn* \(a\) \(if a false true\)\)\)) RE pop
 116
 117 /stdin (%stdin) (r) file def
 118
 119 { % loop
 120     (user> ) print flush
 121
 122     stdin 99 string readline
 123
 124     not { exit } if  % exit if EOF
 125
 126     %(\ngot line: ) print dup print (\n) print flush
 127
 128     { %try
 129         REP print (\n) print
 130     } stopped {
 131         (Error: ) print
 132         get_error_data false _pr_str print (\n) print
 133         clear
 134     } if
 135 } bind loop
 136
 137 (\n) print  % final newline before exit for cleanliness
 138 quit