ps/stepA_mal.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 % is_pair?: ast -> is_pair? -> bool
  19 % return true if non-empty list, otherwise false
  20 /is_pair? {
  21     dup _sequential? { _count 0 gt }{ pop false } ifelse
  22 } def
  23
  24 % ast -> quasiquote -> new_ast
  25 /quasiquote { 3 dict begin
  26     /ast exch def
  27     ast is_pair? not { %if not is_pair?
  28         /quote ast 2 _list
  29     }{
  30         /a0 ast 0 _nth def
  31         a0 /unquote eq { %if a0 unquote symbol
  32             ast 1 _nth
  33         }{ a0 is_pair? { %elseif a0 is_pair?
  34             /a00 a0 0 _nth def
  35             a00 /splice-unquote eq { %if splice-unquote
  36                 /concat a0 1 _nth ast _rest quasiquote 3 _list
  37             }{ %else not splice-unquote
  38                 /cons a0 quasiquote ast _rest quasiquote 3 _list
  39             } ifelse
  40         }{ % else not a0 is_pair?
  41             /cons a0 quasiquote ast _rest quasiquote 3 _list
  42         } ifelse } ifelse
  43     } ifelse
  44 end } def
  45
  46 /is_macro_call? { 3 dict begin
  47     /env exch def
  48     /ast exch def
  49     ast _list? {
  50         /a0 ast 0 _nth def
  51         a0 _symbol? { %if a0 is symbol
  52             env a0 env_find null ne { %if a0 is in env
  53                 env a0 env_get _mal_function? { %if user defined function
  54                     env a0 env_get /macro? get true eq %if marked as macro
  55                 }{ false } ifelse
  56             }{ false } ifelse
  57         }{ false } ifelse
  58     }{ false } ifelse
  59 end } def
  60
  61 /macroexpand { 3 dict begin
  62     /env exch def
  63     /ast exch def
  64     {
  65         ast env is_macro_call? {
  66             /mac env   ast 0 _nth   env_get def
  67             /ast ast _rest mac fload EVAL def
  68         }{
  69             exit
  70         } ifelse
  71     } loop
  72     ast
  73 end } def
  74
  75 /eval_ast { 2 dict begin
  76     /env exch def
  77     /ast exch def
  78     %(eval_ast: ) print ast ==
  79     ast _symbol? { %if symbol
  80         env ast env_get
  81     }{ ast _sequential? { %elseif list or vector
  82         [
  83             ast /data get { %forall items
  84                 env EVAL
  85             } forall
  86         ] ast _list? { _list_from_array }{ _vector_from_array } ifelse
  87     }{ ast _hash_map? { %elseif list or vector
  88         <<
  89             ast /data get { %forall entries
  90                 env EVAL
  91             } forall
  92         >> _hash_map_from_dict
  93     }{ % else
  94         ast
  95     } ifelse } ifelse } ifelse
  96 end } def
  97
  98 /EVAL { 13 dict begin
  99     { %loop (TCO)
 100
 101     /env exch def
 102     /ast exch def
 103     /loop? false def
 104
 105     %(EVAL: ) print ast true _pr_str print (\n) print
 106     ast _list? not { %if not a list
 107         ast env eval_ast
 108     }{ %else apply the list
 109       /ast ast env macroexpand def
 110       ast _list? not { %if no longer a list
 111           ast env eval_ast
 112       }{ %else still a list
 113         /a0 ast 0 _nth def
 114         a0 _nil? { %if ()
 115             ast
 116         }{ /def! a0 eq { %if def!
 117             /a1 ast 1 _nth def
 118             /a2 ast 2 _nth def
 119             env a1  a2 env EVAL  env_set
 120         }{ /let* a0 eq { %if let*
 121             /a1 ast 1 _nth def
 122             /a2 ast 2 _nth def
 123             /let_env env null null env_new def
 124             0 2 a1 _count 1 sub { %for each pair
 125                 /idx exch def
 126                 let_env
 127                     a1 idx _nth
 128                     a1 idx 1 add _nth let_env EVAL
 129                     env_set
 130                     pop % discard the return value
 131             } for
 132             a2
 133             let_env
 134             /loop? true def % loop
 135         }{ /quote a0 eq { %if quote
 136             ast 1 _nth
 137         }{ /quasiquote a0 eq { %if quasiquote
 138             ast 1 _nth quasiquote
 139             env
 140             /loop? true def % loop
 141         }{ /defmacro! a0 eq { %if defmacro!
 142             /a1 ast 1 _nth def
 143             /a2 ast 2 _nth def
 144             a2 env EVAL
 145             dup /macro? true put % set macro flag
 146             env exch a1 exch env_set % def! it
 147         }{ /macroexpand a0 eq { %if defmacro!
 148             ast 1 _nth env macroexpand
 149         }{ /ps* a0 eq { %if ps*
 150             count /stackcnt exch def
 151             ast 1 _nth cvx exec
 152             count stackcnt gt { % if new operands on stack
 153                 % return an list of new operands
 154                 count stackcnt sub array astore
 155             }{
 156                 null % return nil
 157             } ifelse
 158         }{ /do a0 eq { %if do
 159             ast _count 2 gt { %if ast has more than 2 elements
 160                 ast 1 ast _count 2 sub _slice env eval_ast pop
 161             } if
 162             ast ast _count 1 sub _nth % last ast becomes new ast
 163             env
 164             /loop? true def % loop
 165         }{ /try* a0 eq { %if try*
 166             ast _count 2 gt { %if has catch* block
 167                 { %try
 168                     countdictstack /dictcnt exch def
 169                     count /stackcnt exch def
 170                     ast 1 _nth env EVAL
 171                 } stopped { %catch
 172                     % clean up the dictionary stack
 173                     1 1 countdictstack dictcnt sub { %foreach added dict
 174                         %(popping dict\n) print
 175                         pop end % pop idx and pop dict
 176                         %(new ast: ) print ast true _pr_str print (\n) print
 177                     } for
 178                     % clean up the operand stack
 179                     count 1 exch 1 exch stackcnt sub { %foreach added operand
 180                         %(op stack: ) print pstack
 181                         pop pop % pop idx and operand
 182                         %(popped op stack\n) print pstack
 183                     } for
 184                     % get error data and reset $error dict
 185                     /errdata get_error_data def
 186                     $error /newerror false put
 187                     $error /errorinfo null put
 188
 189                     ast _count 3 lt { %if no third (catch*) form
 190                         errdata throw
 191                     } if
 192                     ast 2 _nth 0 _nth (catch*) eq not { %if third form not catch*
 193                         (No catch* in throw form) _throw
 194                     } if
 195                     ast 2 _nth 2 _nth
 196                     env
 197                         ast 2 _nth 1 _nth 1 _list
 198                         errdata 1 _list
 199                         env_new
 200                     EVAL
 201                 } if
 202             }{ % else no catch* block
 203                 ast 1 _nth env EVAL
 204             } ifelse
 205         }{ /if a0 eq { %if if
 206             /a1 ast 1 _nth def
 207             /cond a1 env EVAL def
 208             cond null eq cond false eq or { % if cond is nil or false
 209                 ast _count 3 gt { %if false branch with a3
 210                     ast 3 _nth env
 211                     /loop? true def
 212                 }{ % else false branch with no a3
 213                     null
 214                 } ifelse
 215             }{ % true branch
 216                 ast 2 _nth env
 217                 /loop? true def
 218             } ifelse
 219         }{ /fn* a0 eq { %if fn*
 220             /a1 ast 1 _nth def
 221             /a2 ast 2 _nth def
 222             a2 env a1 _mal_function
 223         }{
 224             /el ast env eval_ast def
 225             el _rest el _first % stack: ast function
 226             dup _mal_function? { %if user defined function
 227                 fload % stack: ast new_env
 228                 /loop? true def
 229             }{ dup _function? { %else if builtin function
 230                 /data get exec
 231             }{ %else (regular procedure/function)
 232                 (cannot apply native proc!\n) print quit
 233             } ifelse } ifelse
 234         } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse
 235       } ifelse
 236     } ifelse
 237
 238     loop? not { exit } if
 239     } loop % TCO
 240 end } def
 241
 242
 243 % print
 244 /PRINT {
 245     true _pr_str
 246 } def
 247
 248
 249 % repl
 250 /repl_env null null null env_new def
 251
 252 /RE { READ repl_env EVAL } def
 253 /REP { READ repl_env EVAL PRINT } def
 254
 255 % core.ps: defined using postscript
 256 /_ref { repl_env 3 1 roll env_set pop } def
 257 core_ns { _function _ref } forall
 258 (eval) { 0 _nth repl_env EVAL } _function _ref
 259 (*ARGV*) [ ] _list_from_array _ref
 260
 261 % core.mal: defined using the language itself
 262 (\(def! *host-language* "postscript"\)) RE pop
 263 (\(def! not \(fn* \(a\) \(if a false true\)\)\)) RE pop
 264 (\(def! load-file \(fn* \(f\) \(eval \(read-string \(str "\(do " \(slurp f\) "\nnil\)"\)\)\)\)\)) RE pop
 265 (\(defmacro! cond \(fn* \(& xs\) \(if \(> \(count xs\) 0\) \(list 'if \(first xs\) \(if \(> \(count xs\) 1\) \(nth xs 1\) \(throw "odd number of forms to cond"\)\) \(cons 'cond \(rest \(rest xs\)\)\)\)\)\)\)) RE pop
 266
 267 userdict /ARGUMENTS known { %if command line arguments
 268     ARGUMENTS length 0 gt { %if more than 0 arguments
 269         (*ARGV*) ARGUMENTS 1 ARGUMENTS length 1 sub getinterval
 270         _list_from_array _ref
 271         ARGUMENTS 0 get
 272         (\(load-file ") exch ("\)) concatenate concatenate RE pop
 273         quit
 274     } if
 275 } if
 276
 277 % repl loop
 278 (\(println \(str "Mal [" *host-language* "]"\)\)) RE pop
 279 { %loop
 280     (user> ) _readline
 281     not { exit } if  % exit if EOF
 282
 283     { %try
 284         REP print (\n) print
 285     } stopped {
 286         (Error: ) print
 287         get_error_data false _pr_str print (\n) print
 288         $error /newerror false put
 289         $error /errorinfo null put
 290         clear
 291         cleardictstack
 292     } if
 293 } bind loop
 294
 295 (\n) print  % final newline before exit for cleanliness
 296 quit