From 2ab1e5845c213a9951bee46a0c991202e6c46d5c Mon Sep 17 00:00:00 2001 From: Joel Martin Date: Sat, 28 Feb 2015 10:35:04 -0600 Subject: Multiple: interop enhancements. --- ps/interop.ps | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'ps') diff --git a/ps/interop.ps b/ps/interop.ps index fb3b88d..8020ab0 100644 --- a/ps/interop.ps +++ b/ps/interop.ps @@ -1,6 +1,6 @@ -% ps_val -> ps2mal -> mal_val +% [ ps_val1...] -> ps2mal -> [ mal_val1...] /ps2mal { - % convert a PS value to a Mal value (recursively) + % convert returned values to Mal types [ exch { %forall returned values dup == -- cgit v1.2.3 From 90f618cbe7ac7740accf501a75be6972bd95be1a Mon Sep 17 00:00:00 2001 From: Joel Martin Date: Sat, 28 Feb 2015 11:09:54 -0600 Subject: All: rename stepA_interop to stepA_mal Also, add missed postscript interop tests. --- ps/Makefile | 2 +- ps/stepA_interop.ps | 298 ------------------------------------------------- ps/stepA_mal.ps | 298 +++++++++++++++++++++++++++++++++++++++++++++++++ ps/tests/stepA_mal.mal | 23 ++++ 4 files changed, 322 insertions(+), 299 deletions(-) delete mode 100644 ps/stepA_interop.ps create mode 100644 ps/stepA_mal.ps create mode 100644 ps/tests/stepA_mal.mal (limited to 'ps') diff --git a/ps/Makefile b/ps/Makefile index 26056a6..9131674 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_interop.ps +SOURCES_LISP = env.ps core.ps stepA_mal.ps SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) .PHONY: stats tests $(TESTS) diff --git a/ps/stepA_interop.ps b/ps/stepA_interop.ps deleted file mode 100644 index c879294..0000000 --- a/ps/stepA_interop.ps +++ /dev/null @@ -1,298 +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 - count stackcnt sub 1 roll % send leftover string to bottom - exec - count stackcnt sub -1 roll % bring leftover string to top - } loop - 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_mal.ps b/ps/stepA_mal.ps new file mode 100644 index 0000000..c879294 --- /dev/null +++ b/ps/stepA_mal.ps @@ -0,0 +1,298 @@ +/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 + count stackcnt sub 1 roll % send leftover string to bottom + exec + count stackcnt sub -1 roll % bring leftover string to top + } loop + 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/tests/stepA_mal.mal b/ps/tests/stepA_mal.mal new file mode 100644 index 0000000..fffa178 --- /dev/null +++ b/ps/tests/stepA_mal.mal @@ -0,0 +1,23 @@ +;; Testing basic ps interop + +(ps* "7") +;=>(7) + +(ps* "(7)") +;=>("7") + +(ps* "7 8 9 3 array astore") +;=>((7 8 9)) + +(ps* "1 1 eq") +;=>(true) + +(ps* "/sym") +;=>sym + +(ps* "1 1 eq { (yep) }{ (nope) } ifelse") +;=>("yep") + +(ps* "1 0 eq { (yep) }{ (nope) } ifelse") +;=>("nope") + -- cgit v1.2.3