diff options
Diffstat (limited to 'ps/step7_quote.ps')
| -rw-r--r-- | ps/step7_quote.ps | 76 |
1 files changed, 41 insertions, 35 deletions
diff --git a/ps/step7_quote.ps b/ps/step7_quote.ps index 9858b4f..4708aa0 100644 --- a/ps/step7_quote.ps +++ b/ps/step7_quote.ps @@ -17,7 +17,7 @@ % is_pair?: ast -> is_pair? -> bool % return true if non-empty list, otherwise false /is_pair? { - dup _list? { length 0 gt }{ pop false } ifelse + dup _list? { _count 0 gt }{ pop false } ifelse } def % ast -> quasiquote -> new_ast @@ -26,13 +26,13 @@ ast is_pair? not { %if not is_pair? /quote ast 2 _list }{ - /a0 ast 0 get def + /a0 ast 0 _nth def a0 /unquote eq { %if a0 unquote symbol - ast 1 get + ast 1 _nth }{ a0 is_pair? { %elseif a0 is_pair? - /a00 a0 0 get def + /a00 a0 0 _nth def a00 /splice-unquote eq { %if splice-unquote - /concat a0 1 get ast _rest quasiquote 3 _list + /concat a0 1 _nth ast _rest quasiquote 3 _list }{ %else not splice-unquote /cons a0 quasiquote ast _rest quasiquote 3 _list } ifelse @@ -48,15 +48,21 @@ end } def %(eval_ast: ) print ast == ast _symbol? { %if symbol env ast env_get - }{ ast _list? { %elseif list + }{ ast _sequential? { %elseif list or vector [ - ast { + 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 } ifelse } ifelse end } def /EVAL { 13 dict begin @@ -70,54 +76,54 @@ end } def ast _list? not { %if not a list ast env eval_ast }{ %else apply the list - /a0 ast 0 get def + /a0 ast 0 _nth def /def! a0 eq { %if def! - /a1 ast 1 get def - /a2 ast 2 get 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 get def - /a2 ast 2 get def - /let_env env [ ] [ ] env_new def - 0 2 a1 length 1 sub { %for each pair + /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 get - a1 idx 1 add get let_env EVAL + a1 idx _nth + a1 idx 1 add _nth let_env EVAL env_set pop % discard the return value } for a2 let_env EVAL }{ /quote a0 eq { %if quote - ast 1 get + ast 1 _nth }{ /quasiquote a0 eq { %if quasiquote - ast 1 get quasiquote env EVAL + ast 1 _nth quasiquote env EVAL }{ /do a0 eq { %if do - ast length 2 gt { %if ast has more than 2 elements - ast 1 ast length 2 sub getinterval env eval_ast pop + 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 length 1 sub get % last ast becomes new ast + ast ast _count 1 sub _nth % last ast becomes new ast env /loop? true def % loop }{ /if a0 eq { %if if - /a1 ast 1 get def + /a1 ast 1 _nth def /cond a1 env EVAL def cond null eq cond false eq or { % if cond is nil or false - ast length 3 gt { %if false branch with a3 - ast 3 get env + 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 get env + ast 2 _nth env /loop? true def } ifelse }{ /fn* a0 eq { %if fn* - /a1 ast 1 get def - /a2 ast 2 get def + /a1 ast 1 _nth def + /a2 ast 2 _nth def << - /type /_maltype_function % user defined function + /_maltype_ /function % user defined function /params null % close over parameters /ast null % close over ast /env null % close over environment @@ -137,7 +143,7 @@ end } def }{ %else (regular procedure/function) exec % apply function to args } ifelse - } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse + } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse loop? not { exit } if @@ -152,7 +158,7 @@ end } def % repl -/repl_env null [ ] [ ] env_new def +/repl_env null null null env_new def /RE { READ repl_env EVAL } def /REP { READ repl_env EVAL PRINT } def @@ -160,10 +166,10 @@ end } def core_ns { _ref } forall -(read-string) { 0 get read_str } _ref -(eval) { 0 get repl_env EVAL } _ref +(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 get slurp } _ref +(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 |