ps/step4_if_fn_do.ps

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