ps/step6_file.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 /eval_ast { 2 dict begin
  19     /env exch def
  20     /ast exch def
  21     %(eval_ast: ) print ast ==
  22     ast _symbol? { %if symbol
  23         env ast env_get
  24     }{ ast _sequential? { %elseif list or vector
  25         [
  26             ast /data get { %forall items
  27                 env EVAL
  28             } forall
  29         ] ast _list? { _list_from_array }{ _vector_from_array } ifelse
  30     }{ ast _hash_map? { %elseif list or vector
  31         <<
  32             ast /data get { %forall entries
  33                 env EVAL
  34             } forall
  35         >> _hash_map_from_dict
  36     }{ % else
  37         ast
  38     } ifelse } ifelse } ifelse
  39 end } def
  40
  41 /EVAL { 13 dict begin
  42     { %loop (TCO)
  43
  44     /env exch def
  45     /ast exch def
  46     /loop? false def
  47
  48     %(EVAL: ) print ast true _pr_str print (\n) print
  49     ast _list? not { %if not a list
  50         ast env eval_ast
  51     }{ %else apply the list
  52         /a0 ast 0 _nth def
  53         /def! a0 eq { %if def!
  54             /a1 ast 1 _nth def
  55             /a2 ast 2 _nth def
  56             env a1  a2 env EVAL  env_set
  57         }{ /let* a0 eq { %if let*
  58             /a1 ast 1 _nth def
  59             /a2 ast 2 _nth def
  60             /let_env env null null env_new def
  61             0 2 a1 _count 1 sub { %for each pair
  62                 /idx exch def
  63                 let_env
  64                     a1 idx _nth
  65                     a1 idx 1 add _nth let_env EVAL
  66                     env_set
  67                     pop % discard the return value
  68             } for
  69             a2
  70             let_env
  71             /loop? true def % loop
  72         }{ /do a0 eq { %if do
  73             ast _count 2 gt { %if ast has more than 2 elements
  74                 ast 1 ast _count 2 sub _slice env eval_ast pop
  75             } if
  76             ast ast _count 1 sub _nth % last ast becomes new ast
  77             env
  78             /loop? true def % loop
  79         }{ /if a0 eq { %if if
  80             /a1 ast 1 _nth def
  81             /cond a1 env EVAL def
  82             cond null eq cond false eq or { % if cond is nil or false
  83                 ast _count 3 gt { %if false branch with a3
  84                     ast 3 _nth env
  85                     /loop? true def
  86                 }{ % else false branch with no a3
  87                     null
  88                 } ifelse
  89             }{ % true branch
  90                 ast 2 _nth env
  91                 /loop? true def
  92             } ifelse
  93         }{ /fn* a0 eq { %if fn*
  94             /a1 ast 1 _nth def
  95             /a2 ast 2 _nth def
  96             a2 env a1 _mal_function
  97         }{
  98             /el ast env eval_ast def
  99             el _rest el _first % stack: ast function
 100             dup _mal_function? { %if user defined function
 101                 fload % stack: ast new_env
 102                 /loop? true def
 103             }{ dup _function? { %else if builtin function
 104                 /data get exec
 105             }{ %else (regular procedure/function)
 106                 (cannot apply native proc!\n) print quit
 107             } ifelse } ifelse
 108         } ifelse } ifelse } ifelse } ifelse } ifelse
 109     } ifelse
 110
 111     loop? not { exit } if
 112     } loop % TCO
 113 end } def
 114
 115
 116 % print
 117 /PRINT {
 118     true _pr_str
 119 } def
 120
 121
 122 % repl
 123 /repl_env null null null env_new def
 124
 125 /RE { READ repl_env EVAL } def
 126 /REP { READ repl_env EVAL PRINT } def
 127
 128 % core.ps: defined using postscript
 129 /_ref { repl_env 3 1 roll env_set pop } def
 130 core_ns { _function _ref } forall
 131 (eval) { 0 _nth repl_env EVAL } _function _ref
 132 (*ARGV*) [ ] _list_from_array _ref
 133
 134 % core.mal: defined using the language itself
 135 (\(def! not \(fn* \(a\) \(if a false true\)\)\)) RE pop
 136 (\(def! load-file \(fn* \(f\) \(eval \(read-string \(str "\(do " \(slurp f\) "\)"\)\)\)\)\)) RE pop
 137
 138 userdict /ARGUMENTS known { %if command line arguments
 139     ARGUMENTS length 0 gt { %if more than 0 arguments
 140         (*ARGV*) ARGUMENTS 1 ARGUMENTS length 1 sub getinterval
 141         _list_from_array _ref
 142         ARGUMENTS 0 get
 143         (\(load-file ") exch ("\)) concatenate concatenate RE pop
 144         quit
 145     } if
 146 } if
 147
 148 % repl loop
 149 { %loop
 150     (user> ) _readline
 151     not { exit } if  % exit if EOF
 152
 153     { %try
 154         REP print (\n) print
 155     } stopped {
 156         (Error: ) print
 157         get_error_data false _pr_str print (\n) print
 158         $error /newerror false put
 159         $error /errorinfo null put
 160         clear
 161         cleardictstack
 162     } if
 163 } bind loop
 164
 165 (\n) print  % final newline before exit for cleanliness
 166 quit