/runlibfile where { pop }{ /runlibfile { run } def } ifelse % (types.ps) runlibfile (reader.ps) runlibfile (printer.ps) runlibfile (env.ps) runlibfile (core.ps) runlibfile % read /_readline { print flush (%stdin) (r) file 1024 string readline } def /READ { /str exch def str read_str } def % eval % is_pair?: ast -> is_pair? -> bool % return true if non-empty list, otherwise false /is_pair? { dup _sequential? { _count 0 gt }{ pop false } ifelse } def % ast -> quasiquote -> new_ast /quasiquote { 3 dict begin /ast exch def ast is_pair? not { %if not is_pair? /quote ast 2 _list }{ /a0 ast 0 _nth def a0 /unquote eq { %if a0 unquote symbol ast 1 _nth }{ a0 is_pair? { %elseif a0 is_pair? /a00 a0 0 _nth def a00 /splice-unquote eq { %if splice-unquote /concat a0 1 _nth ast _rest quasiquote 3 _list }{ %else not splice-unquote /cons a0 quasiquote ast _rest quasiquote 3 _list } ifelse }{ % else not a0 is_pair? /cons a0 quasiquote ast _rest quasiquote 3 _list } ifelse } ifelse } ifelse end } def /is_macro_call? { 3 dict begin /env exch def /ast exch def ast _list? { /a0 ast 0 _nth def a0 _symbol? { %if a0 is symbol env a0 env_find null ne { %if a0 is in env env a0 env_get _mal_function? { %if user defined function env a0 env_get /macro? get true eq %if marked as macro }{ false } ifelse }{ false } ifelse }{ false } ifelse }{ false } ifelse end } def /macroexpand { 3 dict begin /env exch def /ast exch def { ast env is_macro_call? { /mac env ast 0 _nth env_get def /ast ast _rest mac fload EVAL def }{ exit } ifelse } loop ast end } def /eval_ast { 2 dict begin /env exch def /ast exch def %(eval_ast: ) print ast == ast _symbol? { %if symbol env ast env_get }{ ast _sequential? { %elseif list or vector [ ast /data get { %forall items env EVAL } forall ] ast _list? { _list_from_array }{ _vector_from_array } ifelse }{ ast _hash_map? { %elseif list or vector << ast /data get { %forall entries env EVAL } forall >> _hash_map_from_dict }{ % else ast } ifelse } ifelse } ifelse end } def /EVAL { 13 dict begin { %loop (TCO) /env exch def /ast exch def /loop? false def %(EVAL: ) print ast true _pr_str print (\n) print ast _list? not { %if not a list ast env eval_ast }{ %else apply the list /ast ast env macroexpand def ast _list? not { %if no longer a list ast env eval_ast }{ %else still a list /a0 ast 0 _nth def a0 _nil? { %if () ast }{ /def! a0 eq { %if def! /a1 ast 1 _nth def /a2 ast 2 _nth def env a1 a2 env EVAL env_set }{ /let* a0 eq { %if let* /a1 ast 1 _nth def /a2 ast 2 _nth def /let_env env null null env_new def 0 2 a1 _count 1 sub { %for each pair /idx exch def let_env a1 idx _nth a1 idx 1 add _nth let_env EVAL env_set pop % discard the return value } for a2 let_env /loop? true def % loop }{ /quote a0 eq { %if quote ast 1 _nth }{ /quasiquote a0 eq { %if quasiquote ast 1 _nth quasiquote env /loop? true def % loop }{ /defmacro! a0 eq { %if defmacro! /a1 ast 1 _nth def /a2 ast 2 _nth def a2 env EVAL dup /macro? true put % set macro flag env exch a1 exch env_set % def! it }{ /macroexpand a0 eq { %if defmacro! ast 1 _nth env macroexpand }{ /ps* a0 eq { %if ps* count /stackcnt exch def ast 1 _nth cvx exec count stackcnt gt { % if new operands on stack % return an list of new operands count stackcnt sub array astore }{ null % return nil } ifelse }{ /do a0 eq { %if do ast _count 2 gt { %if ast has more than 2 elements ast 1 ast _count 2 sub _slice env eval_ast pop } if ast ast _count 1 sub _nth % last ast becomes new ast env /loop? true def % loop }{ /try* a0 eq { %if try* ast _count 2 gt { %if has catch* block { %try countdictstack /dictcnt exch def count /stackcnt exch def ast 1 _nth env EVAL } stopped { %catch % clean up the dictionary stack 1 1 countdictstack dictcnt sub { %foreach added dict %(popping dict\n) print pop end % pop idx and pop dict %(new ast: ) print ast true _pr_str print (\n) print } for % clean up the operand stack count 1 exch 1 exch stackcnt sub { %foreach added operand %(op stack: ) print pstack pop pop % pop idx and operand %(popped op stack\n) print pstack } for % get error data and reset $error dict /errdata get_error_data def $error /newerror false put $error /errorinfo null put ast _count 3 lt { %if no third (catch*) form errdata throw } if ast 2 _nth 0 _nth (catch*) eq not { %if third form not catch* (No catch* in throw form) _throw } if ast 2 _nth 2 _nth env ast 2 _nth 1 _nth 1 _list errdata 1 _list env_new EVAL } if }{ % else no catch* block ast 1 _nth env EVAL } ifelse }{ /if a0 eq { %if if /a1 ast 1 _nth def /cond a1 env EVAL def cond null eq cond false eq or { % if cond is nil or false ast _count 3 gt { %if false branch with a3 ast 3 _nth env /loop? true def }{ % else false branch with no a3 null } ifelse }{ % true branch ast 2 _nth env /loop? true def } ifelse }{ /fn* a0 eq { %if fn* /a1 ast 1 _nth def /a2 ast 2 _nth def a2 env a1 _mal_function }{ /el ast env eval_ast def el _rest el _first % stack: ast function dup _mal_function? { %if user defined function fload % stack: ast new_env /loop? true def }{ dup _function? { %else if builtin function /data get exec }{ %else (regular procedure/function) (cannot apply native proc!\n) print quit } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse loop? not { exit } if } loop % TCO end } def % print /PRINT { true _pr_str } def % repl /repl_env null null null env_new def /RE { READ repl_env EVAL } def /REP { READ repl_env EVAL PRINT } def % core.ps: defined using postscript /_ref { repl_env 3 1 roll env_set pop } def core_ns { _function _ref } forall (eval) { 0 _nth repl_env EVAL } _function _ref (*ARGV*) [ ] _list_from_array _ref % core.mal: defined using the language itself (\(def! *host-language* "postscript"\)) RE pop (\(def! not \(fn* \(a\) \(if a false true\)\)\)) RE pop (\(def! load-file \(fn* \(f\) \(eval \(read-string \(str "\(do " \(slurp f\) "\)"\)\)\)\)\)) RE pop (\(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 (\(def! *gensym-counter* \(atom 0\)\)) RE pop (\(def! gensym \(fn* [] \(symbol \(str "G__" \(swap! *gensym-counter* \(fn* [x] \(+ 1 x\)\)\)\)\)\)\)) RE pop (\(defmacro! or \(fn* \(& xs\) \(if \(empty? xs\) nil \(if \(= 1 \(count xs\)\) \(first xs\) \(let* \(condvar \(gensym\)\) `\(let* \(~condvar ~\(first xs\)\) \(if ~condvar ~condvar \(or ~@\(rest xs\)\)\)\)\)\)\)\)\)) RE pop userdict /ARGUMENTS known { %if command line arguments ARGUMENTS length 0 gt { %if more than 0 arguments (*ARGV*) ARGUMENTS 1 ARGUMENTS length 1 sub getinterval _list_from_array _ref ARGUMENTS 0 get (\(load-file ") exch ("\)) concatenate concatenate RE pop quit } if } if % repl loop (\(println \(str "Mal [" *host-language* "]"\)\)) RE pop { %loop (user> ) _readline not { exit } if % exit if EOF { %try REP print (\n) print } stopped { (Error: ) print get_error_data false _pr_str print (\n) print $error /newerror false put $error /errorinfo null put clear cleardictstack } if } bind loop (\n) print % final newline before exit for cleanliness quit