(types.ps) run (reader.ps) run (printer.ps) run (env.ps) run (core.ps) run % read /_readline { print flush (%stdin) (r) file 99 string readline } def /READ { /str exch def str read_str } def % eval /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 /a0 ast 0 _nth def /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 EVAL }{ /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 }{ /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 << /_maltype_ /function % user defined function /params null % close over parameters /ast null % close over ast /env null % close over environment /data { __self__ fload EVAL } >> dup length dict copy % make an actual copy/new instance dup /params a1 put % insert closed over a1 into position 2 dup /ast a2 put % insert closed over a2 into position 3 dup /env env put % insert closed over env into position 4 dup dup /data get exch 0 exch put % insert self reference }{ /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 }{ %else (regular procedure/function) exec % apply function to args } 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 /_ref { repl_env 3 1 roll env_set pop } def core_ns { _ref } forall (read-string) { 0 _nth read_str } _ref (eval) { 0 _nth repl_env EVAL } _ref /slurp { (r) file dup bytesavailable string readstring pop } def (slurp) { 0 _nth slurp } _ref (\(def! not \(fn* \(a\) \(if a false true\)\)\)) RE pop (\(def! load-file \(fn* \(f\) \(eval \(read-string \(str "\(do " \(slurp f\) "\)"\)\)\)\)\)) RE pop userdict /ARGUMENTS known { %if command line arguments ARGUMENTS length 0 gt { %if more than 0 arguments ARGUMENTS { (\(load-file ") exch ("\)) concatenate concatenate RE pop } forall quit } if } if { % 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