From 01c9731649a7ed97fad0bdeac9cb75b7323c0ad6 Mon Sep 17 00:00:00 2001 From: Joel Martin Date: Thu, 9 Oct 2014 23:48:47 -0500 Subject: All: swap step9,A. Fixes for bash, C, perl. step9_interop -> stepA_interop stepA_more -> step9_try C: fix glib headers bash: behavior change of declare -A and pattern replacement. perl: squelch new 5.18 warnings related to switch/given statement. Also, include some in-progress interop related files. --- ps/Makefile | 2 +- ps/interop.ps | 21 ++++ ps/step9_interop.ps | 258 --------------------------------------------- ps/step9_try.ps | 282 +++++++++++++++++++++++++++++++++++++++++++++++++ ps/stepA_interop.ps | 296 ++++++++++++++++++++++++++++++++++++++++++++++++++++ ps/stepA_more.ps | 296 ---------------------------------------------------- 6 files changed, 600 insertions(+), 555 deletions(-) create mode 100644 ps/interop.ps delete mode 100644 ps/step9_interop.ps create mode 100644 ps/step9_try.ps create mode 100644 ps/stepA_interop.ps delete mode 100644 ps/stepA_more.ps (limited to 'ps') diff --git a/ps/Makefile b/ps/Makefile index 43b5b70..26056a6 100644 --- a/ps/Makefile +++ b/ps/Makefile @@ -2,7 +2,7 @@ TESTS = SOURCES_BASE = types.ps reader.ps printer.ps -SOURCES_LISP = env.ps core.ps stepA_more.ps +SOURCES_LISP = env.ps core.ps stepA_interop.ps SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) .PHONY: stats tests $(TESTS) diff --git a/ps/interop.ps b/ps/interop.ps new file mode 100644 index 0000000..fb3b88d --- /dev/null +++ b/ps/interop.ps @@ -0,0 +1,21 @@ +% ps_val -> ps2mal -> mal_val +/ps2mal { + % convert a PS value to a Mal value (recursively) + [ exch + { %forall returned values + dup == + dup type /arraytype eq { + (here1\n) print + _list_from_array + }{ dup type /dicttype eq { + (here2\n) print + _hash_map_from_dict + }{ + (here3\n) print + % no-op + } ifelse } ifelse + } forall + ] + (here4\n) print +} def + diff --git a/ps/step9_interop.ps b/ps/step9_interop.ps deleted file mode 100644 index 7f90d20..0000000 --- a/ps/step9_interop.ps +++ /dev/null @@ -1,258 +0,0 @@ -/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 99 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 - }{ %else still a 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 - /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 - { - token not { exit } if - exch - } loop - 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 - }{ /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 - - 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! 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 -(\(defmacro! or \(fn* \(& xs\) \(if \(empty? xs\) nil \(if \(= 1 \(count xs\)\) \(first xs\) `\(let* \(or_FIXME ~\(first xs\)\) \(if or_FIXME or_FIXME \(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 -{ %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 diff --git a/ps/step9_try.ps b/ps/step9_try.ps new file mode 100644 index 0000000..9c5c240 --- /dev/null +++ b/ps/step9_try.ps @@ -0,0 +1,282 @@ +/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 99 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 + }{ %else still a 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 + /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 + }{ /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* + { %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 + }{ /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 + + 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 +(\(defmacro! or \(fn* \(& xs\) \(if \(empty? xs\) nil \(if \(= 1 \(count xs\)\) \(first xs\) `\(let* \(or_FIXME ~\(first xs\)\) \(if or_FIXME or_FIXME \(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 diff --git a/ps/stepA_interop.ps b/ps/stepA_interop.ps new file mode 100644 index 0000000..a24ee28 --- /dev/null +++ b/ps/stepA_interop.ps @@ -0,0 +1,296 @@ +/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 99 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 + }{ %else still a 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 + /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 + { + token not { exit } if + exch + } loop + 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* + { %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 + }{ /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 + + 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 +(\(defmacro! or \(fn* \(& xs\) \(if \(empty? xs\) nil \(if \(= 1 \(count xs\)\) \(first xs\) `\(let* \(or_FIXME ~\(first xs\)\) \(if or_FIXME or_FIXME \(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 diff --git a/ps/stepA_more.ps b/ps/stepA_more.ps deleted file mode 100644 index a24ee28..0000000 --- a/ps/stepA_more.ps +++ /dev/null @@ -1,296 +0,0 @@ -/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 99 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 - }{ %else still a 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 - /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 - { - token not { exit } if - exch - } loop - 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* - { %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 - }{ /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 - - 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 -(\(defmacro! or \(fn* \(& xs\) \(if \(empty? xs\) nil \(if \(= 1 \(count xs\)\) \(first xs\) `\(let* \(or_FIXME ~\(first xs\)\) \(if or_FIXME or_FIXME \(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 -- cgit v1.2.3