diff options
| -rw-r--r-- | docs/TODO | 1 | ||||
| -rw-r--r-- | ps/core.ps | 261 | ||||
| -rw-r--r-- | ps/env.ps | 60 | ||||
| -rw-r--r-- | ps/printer.ps | 25 | ||||
| -rw-r--r-- | ps/reader.ps | 60 | ||||
| -rw-r--r-- | ps/step2_eval.ps | 29 | ||||
| -rw-r--r-- | ps/step3_env.ps | 42 | ||||
| -rw-r--r-- | ps/step4_if_fn_do.ps | 50 | ||||
| -rw-r--r-- | ps/step5_tco.ps | 54 | ||||
| -rw-r--r-- | ps/step6_file.ps | 60 | ||||
| -rw-r--r-- | ps/step7_quote.ps | 76 | ||||
| -rw-r--r-- | ps/step8_macros.ps | 84 | ||||
| -rw-r--r-- | ps/step9_interop.ps | 86 | ||||
| -rw-r--r-- | ps/stepA_more.ps | 112 | ||||
| -rw-r--r-- | ps/types.ps | 144 | ||||
| -rw-r--r-- | tests/stepA_more.mal | 9 |
16 files changed, 784 insertions, 369 deletions
@@ -50,7 +50,6 @@ Java: Postscript: - negative numbers - quotes/backslashes in strings - - vectors, hash-maps, metadata, atoms Rust: - http://www.rustforrubyists.com/book/index.html @@ -5,122 +5,257 @@ % Errors/Exceptions % data -> throw -> -% Takes an arbitrary data and puts it in $error:/errorinfo. Then calls -% stop to transfer control to end of nearest stopped context. -/throw { - $error exch /errorinfo exch put - $error /command /throw put - stop +% Takes arbitrary data and throws it as an exception. +/throw { 0 _nth _throw } def + + +% Hash Map functions + +% [hashmap key val ...] -> assoc -> new_hashmap +/assoc { 4 dict begin + /args exch def + /src_dict args 0 _nth /data get def + /new_dict src_dict + dup length args _count 1 sub 2 idiv add % new length + dict % new dict of that length + copy def + 1 2 args _count 1 sub { %for each key idx + /idx exch def + new_dict args idx _nth args idx 1 add _nth put + } for + new_dict _hash_map_from_dict +end } def + +% [hashmap key...] -> dissoc -> new_hashmap +/dissoc { 4 dict begin + /args exch def + /src_dict args 0 _nth /data get def + /new_dict src_dict dup length dict copy def + 1 1 args _count 1 sub { %for each key idx + /idx exch def + new_dict args idx _nth undef + } for + new_dict _hash_map_from_dict +end } def + +% [hashmap key] -> hash_map_get -> value +/hash_map_get { + dup 0 _nth /data get % stack: args dict + exch 1 _nth % stack: dict key + 2 copy known { %if has key + get + }{ + pop pop null + } ifelse +} def + +% [hashmap key] -> contains? -> bool +/contains? { + dup 0 _nth /data get % stack: args dict + exch 1 _nth % stack: dict key + known +} def + +% [hashmap] -> keys -> key_list +/keys { + 0 _nth /data get + [ exch { pop dup length string cvs } forall ] + _list_from_array +} def + +% [hashmap] -> vals -> val_list +/vals { + 0 _nth /data get + [ exch { exch pop } forall ] + _list_from_array } def % sequence functions % [obj list] -> cons -> new_list -/cons { +/cons { 3 dict begin /args exch def - /elem args 0 get def - /lst args 1 get def - lst length 1 add array + /elem args 0 _nth def + /lst args 1 _nth def + lst _count 1 add array dup 0 elem put % first element - dup 1 lst putinterval % rest of the elements -} def + dup 1 lst /data get putinterval % rest of the elements + _list_from_array +end } def % [listA listB] -> concat -> [listA... listB...] /concat { % replaces matric concat - dup length 0 eq { %if just concat + dup _count 0 eq { %if just concat 0 _list - }{ dup length 1 eq { %elseif concat of single item - 0 get % noop + }{ dup _count 1 eq { %elseif concat of single item + 0 _nth % noop }{ % else [] exch - { - concatenate + /data get { + /data get concatenate } forall + _list_from_array } ifelse } ifelse } def % [obj ...] -> first -> obj /first { - 0 get _first + 0 _nth _first } def % [obj objs...] -> first -> [objs..] /rest { - 0 get _rest + 0 _nth _rest } def +% [vect elem...] -> conj -> new_vect +% [list elem...] -> conj -> new_list +/conj { 5 dict begin + /args exch def + /src_arr args 0 _nth /data get def + /new_len src_arr length args _count 1 sub add def + /new_arr new_len array def + args 0 _nth _list? { %if list + new_arr new_len src_arr length sub src_arr putinterval + args _count 1 sub -1 1 { + /idx exch def + new_arr args _count idx sub 1 sub args idx _nth put + } for + new_arr _list_from_array + }{ %else vector + src_arr new_arr copy + 1 1 args _count 1 sub { + /idx exch def + new_arr src_arr length idx add 1 sub args idx _nth put + } for + new_arr _vector_from_array + } ifelse +end } def + % [function args... arg_list] -> apply -> result /apply { 1 dict begin /args exch def - args 0 get callable % make sure function is callable - args 1 args length 2 sub getinterval - args args length 1 sub get - concatenate args 0 get % stack: args function + args 0 _nth callable % make sure function is callable + args /data get 1 args _count 2 sub getinterval % get args slice + args args _count 1 sub _nth /data get % get arg_list array + concatenate _list_from_array exch % stack: args function exec end } def % [function list] -> _map -> new_list /map { 1 dict begin - dup 0 get exch 1 get % stack: function list + dup 0 _nth exch 1 _nth % stack: function list /args exch def callable % make sure function is callable %/new_list args length array def - args { - 1 array astore - exch dup 3 1 roll % stack: fn arg fn + args /data get { %foreach arg + 1 array astore _list_from_array % stack: fn arglist + exch dup 3 1 roll % stack: fn arglist fn exec exch % stack: result fn } forall pop % remove the function - args length array astore + args _count array astore + _list_from_array end } def -/conj { 5 dict begin + +% Metadata functions + +% [obj meta] -> with_meta -> new_obj +/with_meta { + dup 1 _nth exch 0 _nth % stack: meta obj + dup length dict copy % stack: meta new_obj + dup 3 -1 roll % stack: new_obj new_obj meta + /meta exch put +} def + +% [obj] -> meta -> meta +/meta { + 0 _nth /meta get +} def + + +% Atom functions + +/deref { + 0 _nth /data get +} def + +% [atm val] -> reset! -> val +/reset! { + dup 0 _nth exch 1 _nth % stack: atm val + dup 3 1 roll % stack: val atm val + /data exch put +} def + +% [atm f args...] -> swap! -> new_val +/swap! { 3 dict begin /args exch def - /src_list args 0 get def - /new_len src_list length args length 1 sub add def - /new_list new_len array def - new_list new_len src_list length sub src_list putinterval - args length 1 sub -1 1 { - /idx exch def - new_list args length idx sub 1 sub args idx get put - } for - new_list + /atm args 0 _nth def + [ atm /data get ] + args 2 args _count 2 sub _slice /data get + concatenate _list_from_array + args 1 _nth callable % make sure function is callable + exec + /new_val exch def + atm /data new_val put + new_val end } def % core_ns is namespace of core functions /core_ns << - (pr-str) { ( ) true _pr_str_args } - (str) { () false _pr_str_args } - (prn) { ( ) true _pr_str_args print (\n) print null } - (println) { () false _pr_str_args print (\n) print null } - (=) { dup 0 get exch 1 get _equal? } - (symbol?) { 0 get _symbol? } - (nil?) { 0 get _nil? } - (true?) { 0 get _true? } - (false?) { 0 get _false? } - (<) { dup 0 get exch 1 get lt } - (<=) { dup 0 get exch 1 get le } - (>) { dup 0 get exch 1 get gt } - (>=) { dup 0 get exch 1 get ge } - (+) { dup 0 get exch 1 get add } - (-) { dup 0 get exch 1 get sub } - (*) { dup 0 get exch 1 get mul } - (/) { dup 0 get exch 1 get idiv } - (throw) { 0 get throw } - (list) { dup pop } % noop - (list?) { 0 get _list? } + (=) { dup 0 _nth exch 1 _nth _equal? } + (throw) { throw } + (nil?) { 0 _nth _nil? } + (true?) { 0 _nth _true? } + (false?) { 0 _nth _false? } + (symbol?) { 0 _nth _symbol? } + (pr-str) { /data get ( ) true _pr_str_args } + (str) { /data get () false _pr_str_args } + (prn) { /data get ( ) true _pr_str_args print (\n) print null } + (println) { /data get () false _pr_str_args print (\n) print null } + (<) { dup 0 _nth exch 1 _nth lt } + (<=) { dup 0 _nth exch 1 _nth le } + (>) { dup 0 _nth exch 1 _nth gt } + (>=) { dup 0 _nth exch 1 _nth ge } + (+) { dup 0 _nth exch 1 _nth add } + (-) { dup 0 _nth exch 1 _nth sub } + (*) { dup 0 _nth exch 1 _nth mul } + (/) { dup 0 _nth exch 1 _nth idiv } + + (list) { /data get _list_from_array } + (list?) { 0 _nth _list? } + (vector) { /data get _vector_from_array } + (vector?) { 0 _nth _vector? } + (hash-map) { /data get _hash_map_from_array } + (map?) { 0 _nth _hash_map? } + (assoc) { assoc } + (dissoc) { dissoc } + (get) { hash_map_get } + (contains?) { contains? } + (keys) { keys } + (vals) { vals } + + (sequential?) { 0 _nth _sequential? } (cons) { cons } (concat) { concat } - (sequential?) { 0 get _sequential? } - (empty?) { 0 get length 0 eq } - (count) { 0 get length } - (nth) { dup 0 get exch 1 get _nth } + (nth) { dup 0 _nth exch 1 _nth _nth } (first) { first } (rest) { rest } + (empty?) { 0 _nth _count 0 eq } + (count) { 0 _nth _count } + (conj) { conj } (apply) { apply } (map) { map } - (conj) { conj } + + (with-meta) { with_meta } + (meta) { meta } + (atom) { 0 _nth _atom } + (atom?) { 0 _nth _atom? } + (deref) { deref } + (reset!) { reset! } + (swap!) { swap! } >> def diff --git a/ps/env.ps b/ps/env.ps new file mode 100644 index 0000000..b8752af --- /dev/null +++ b/ps/env.ps @@ -0,0 +1,60 @@ +(in env.ps\n) print + +% outer binds exprs -> env_new -> new_env +/env_new { 3 dict begin + %(in env_new\n) print + /exprs exch dup _sequential? { /data get }{ pop [ ] } ifelse def + /binds exch dup _sequential? { /data get }{ pop [ ] } ifelse def + /outer exch def + << + /__outer__ outer + 0 1 binds length 1 sub { + /idx exch def + binds idx get (&) eq { %if & + binds idx 1 add get % key + exprs idx exprs length idx sub getinterval % value + _list_from_array + exit + } if + binds idx get % key + exprs idx get % value + } for + >> +end } def + +/env_find { 2 dict begin + /key exch def + /env exch def + env key known { %if key in env + env + }{ env /__outer__ get null ne { %elseif __outer__ not null + env /__outer__ get key env_find + }{ %else + null + } ifelse } ifelse +end } def + +/env_set { 4 dict begin + dup + /func? exch xcheck def % executable function + /val exch cvlit def + /key exch def + /env exch def + env key val func? { cvx } if put + val func? { cvx } if +end } def + +/env_get { 2 dict begin + /key exch def + /env exch def + env key env_find + dup null eq { + (') + key dup length string cvs + (' not found) + concatenate concatenate + _throw + }{ + key get + } ifelse +end } def diff --git a/ps/printer.ps b/ps/printer.ps index c2e42a5..956bb18 100644 --- a/ps/printer.ps +++ b/ps/printer.ps @@ -1,19 +1,36 @@ -(in types.ps\n) print +(in printer.ps\n) print % requires types.ps to be included first +% ast print_readably -> _pr_str -> string /_pr_str { 4 dict begin /print_readably exch def dup /func? exch xcheck def % executable function /obj exch cvlit def - obj _mal_function? { % if user defined function + obj _sequential? { + obj _list? { (\() (\)) }{ ([) (]) } ifelse + obj /data get ( ) print_readably _pr_str_args + exch concatenate concatenate + }{ obj _hash_map? { + ({) + % get array of contents with keys stringified + [ obj /data get { exch dup length string cvs exch } forall ] + ( ) print_readably _pr_str_args + concatenate + (}) concatenate + }{ obj _mal_function? { % if user defined function (<\(fn* ) obj /params get print_readably _pr_str ( ) obj /ast get print_readably _pr_str (\)>) concatenate concatenate concatenate concatenate + }{ obj _atom? { % if atom + (\(atom ) + obj /data get print_readably _pr_str + (\)) + concatenate concatenate }{ /arraytype obj type eq { % if list or code block % accumulate an array of strings func? { (<builtin_fn* { ) }{ (\() } ifelse @@ -39,8 +56,8 @@ }{ /nametype obj type eq { % if symbol obj dup length string cvs }{ - (<unknown>) - } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse + (<unknown>) + } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse end } def % array delim print_readably -> _pr_str_args -> new_string diff --git a/ps/reader.ps b/ps/reader.ps index 948bf3b..bdc4580 100644 --- a/ps/reader.ps +++ b/ps/reader.ps @@ -64,8 +64,7 @@ /cnt 0 def { % loop idx str length ge { %if EOF - (unexpected EOF reading string) - throw + (unexpected EOF reading string) _throw } if /ch str idx get def % current character /idx idx 1 add def @@ -110,21 +109,21 @@ % return: atom string new_idx } def -% read_list: read a single list from string/idx -% string idx -> read_list -> list string new_idx -/read_list { - %(in read_list\n) print +% read_until: read a list from string/idx until stopchar is found +% string idx stopchar -> read_until -> list string new_idx +/read_until { + %(in read_until\n) print + /stopchar exch def /idx exch 1 add def /str exch def [ { % loop str idx read_spaces /idx exch def pop str length idx le { %if EOF - (unexpected EOF reading list) - throw + (unexpected EOF reading list) _throw } if /ch str idx get def % current character - ch 41 eq { exit } if % ')' is end of list + ch stopchar eq { exit } if % stop at stopchar str idx read_form /idx exch def pop } loop ] @@ -156,9 +155,21 @@ /idx exch def /str exch def - idx str length ge { exit } if % EOF, break loop + idx str length ge { (unexpected EOF) _throw } if % EOF /ch str idx get def % current character - ch 39 eq { %if '\'' + ch 59 eq { %if ';' + { % loop + /idx idx 1 add def % increment idx + str length idx le { exit } if % EOF, break loop + /ch str idx get def % current character + % if newline then add 1 more idx and exit + ch 10 eq { + /idx idx 1 add def + exit + } if + } loop + str idx read_form % recur to get next form + }{ ch 39 eq { %if '\'' /idx idx 1 add def str idx read_form 3 -1 roll /quote exch 2 _list 3 1 roll @@ -177,21 +188,32 @@ str idx read_form 3 -1 roll /unquote exch 2 _list 3 1 roll } ifelse + }{ ch 94 eq { %if '^' + /idx idx 1 add def + str idx read_form read_form % stack: meta form str idx + 4 2 roll exch /with-meta 3 1 roll 3 _list 3 1 roll + }{ ch 64 eq { %if '@' + /idx idx 1 add def + str idx read_form + 3 -1 roll /deref exch 2 _list 3 1 roll }{ ch 40 eq { %if '(' - str idx read_list + str idx 41 read_until + 3 -1 roll _list_from_array 3 1 roll }{ ch 41 eq { %elseif ')' - (unexpected '\)') throw - }{ ch 91 eq { %elseif '[' - (unexpected '[') throw + (unexpected '\)') _throw + }{ ch 91 eq { %if '(' + str idx 93 read_until + 3 -1 roll _vector_from_array 3 1 roll }{ ch 93 eq { %elseif ']' - (unexpected ']') throw + (unexpected ']') _throw }{ ch 123 eq { %elseif '{' - (unexpected '{') throw + str idx 125 read_until + 3 -1 roll _hash_map_from_array 3 1 roll }{ ch 125 eq { %elseif '}' - (unexpected '}') throw + (unexpected '}') _throw }{ % else str idx read_atom - } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse + } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse % return: ast string new_idx end } def diff --git a/ps/step2_eval.ps b/ps/step2_eval.ps index 7b03a99..d5c956b 100644 --- a/ps/step2_eval.ps +++ b/ps/step2_eval.ps @@ -20,24 +20,31 @@ env ast known { env ast get }{ - (') ast pr_str (' not found) - concatenate concatenate throw + (') ast false _pr_str (' not found) + concatenate concatenate _throw } ifelse - }{ 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 { 3 dict begin /env exch def /ast exch def - %(EVAL: ) print ast == + + %(EVAL: ) print ast true _pr_str print (\n) print ast _list? not { %if not a list ast env eval_ast }{ %else apply the list @@ -56,10 +63,10 @@ end } def % repl /repl_env << - (+) { dup 0 get exch 1 get add } - (-) { dup 0 get exch 1 get sub } - (*) { dup 0 get exch 1 get mul } - (/) { dup 0 get exch 1 get idiv } + (+) { dup 0 _nth exch 1 _nth add } + (-) { dup 0 _nth exch 1 _nth sub } + (*) { dup 0 _nth exch 1 _nth mul } + (/) { dup 0 _nth exch 1 _nth idiv } >> def /REP { READ repl_env EVAL PRINT } def diff --git a/ps/step3_env.ps b/ps/step3_env.ps index 49d37c4..e94f92c 100644 --- a/ps/step3_env.ps +++ b/ps/step3_env.ps @@ -19,15 +19,21 @@ %(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 { 8 dict begin @@ -38,20 +44,20 @@ 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 @@ -72,15 +78,15 @@ end } def % repl -/repl_env null [ ] [ ] env_new def +/repl_env null null null env_new def /REP { READ repl_env EVAL PRINT } def /_ref { repl_env 3 1 roll env_set pop } def -(+) { dup 0 get exch 1 get add } _ref -(-) { dup 0 get exch 1 get sub } _ref -(*) { dup 0 get exch 1 get mul } _ref -(/) { dup 0 get exch 1 get idiv } _ref +(+) { dup 0 _nth exch 1 _nth add } _ref +(-) { dup 0 _nth exch 1 _nth sub } _ref +(*) { dup 0 _nth exch 1 _nth mul } _ref +(/) { dup 0 _nth exch 1 _nth idiv } _ref { % loop (user> ) _readline diff --git a/ps/step4_if_fn_do.ps b/ps/step4_if_fn_do.ps index f703830..cd14b18 100644 --- a/ps/step4_if_fn_do.ps +++ b/ps/step4_if_fn_do.ps @@ -20,15 +20,21 @@ %(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 { 9 dict begin @@ -39,46 +45,46 @@ 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 }{ /do a0 eq { %if do /el ast _rest env eval_ast def - el el length 1 sub get % return last value + el el _count 1 sub _nth % return last value }{ /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 EVAL }{ % else false branch with no a3 null } ifelse }{ % true branch - ast 2 get env + ast 2 _nth env EVAL } 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 @@ -110,7 +116,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 diff --git a/ps/step5_tco.ps b/ps/step5_tco.ps index 2bc898a..96c44ee 100644 --- a/ps/step5_tco.ps +++ b/ps/step5_tco.ps @@ -20,15 +20,21 @@ %(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 @@ -42,50 +48,50 @@ 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 }{ /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 @@ -120,7 +126,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 diff --git a/ps/step6_file.ps b/ps/step6_file.ps index f6f4377..1eff14f 100644 --- a/ps/step6_file.ps +++ b/ps/step6_file.ps @@ -20,15 +20,21 @@ %(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 @@ -42,50 +48,50 @@ 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 }{ /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 @@ -120,7 +126,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 @@ -128,10 +134,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 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 diff --git a/ps/step8_macros.ps b/ps/step8_macros.ps index 869bf96..330f6f7 100644 --- a/ps/step8_macros.ps +++ b/ps/step8_macros.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 @@ -46,7 +46,7 @@ end } def /env exch def /ast exch def ast _list? { - /a0 ast 0 get def + /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 @@ -62,7 +62,7 @@ end } def /ast exch def { ast env is_macro_call? { - /mac env ast 0 get env_get def + /mac env ast 0 _nth env_get def /ast ast _rest mac fload EVAL def }{ exit @@ -77,15 +77,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 @@ -103,62 +109,62 @@ end } def ast _list? not { %if no longer a list ast }{ %else still a 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 }{ /defmacro! a0 eq { %if defmacro! - /a1 ast 1 get def - /a2 ast 2 get def + /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 get env macroexpand + ast 1 _nth env macroexpand }{ /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 /macro? false % macro flag, false by default /params null % close over parameters /ast null % close over ast @@ -195,7 +201,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 @@ -203,10 +209,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 diff --git a/ps/step9_interop.ps b/ps/step9_interop.ps index f8d3250..5a7f3ec 100644 --- a/ps/step9_interop.ps +++ b/ps/step9_interop.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 @@ -46,7 +46,7 @@ end } def /env exch def /ast exch def ast _list? { - /a0 ast 0 get def + /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 @@ -62,7 +62,7 @@ end } def /ast exch def { ast env is_macro_call? { - /mac env ast 0 get env_get def + /mac env ast 0 _nth env_get def /ast ast _rest mac fload EVAL def }{ exit @@ -77,15 +77,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 @@ -103,39 +109,39 @@ end } def ast _list? not { %if no longer a list ast }{ %else still a 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 }{ /defmacro! a0 eq { %if defmacro! - /a1 ast 1 get def - /a2 ast 2 get def + /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 get env macroexpand + ast 1 _nth env macroexpand }{ /ps* a0 eq { %if ps* count /stackcnt exch def - ast 1 get + ast 1 _nth { token not { exit } if exch @@ -148,31 +154,31 @@ end } def null % return nil } ifelse }{ /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 /macro? false % macro flag, false by default /params null % close over parameters /ast null % close over ast @@ -209,7 +215,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 @@ -217,10 +223,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 diff --git a/ps/stepA_more.ps b/ps/stepA_more.ps index a273c02..5704413 100644 --- a/ps/stepA_more.ps +++ b/ps/stepA_more.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 @@ -46,7 +46,7 @@ end } def /env exch def /ast exch def ast _list? { - /a0 ast 0 get def + /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 @@ -62,7 +62,7 @@ end } def /ast exch def { ast env is_macro_call? { - /mac env ast 0 get env_get def + /mac env ast 0 _nth env_get def /ast ast _rest mac fload EVAL def }{ exit @@ -77,15 +77,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 @@ -103,39 +109,39 @@ end } def ast _list? not { %if no longer a list ast }{ %else still a 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 }{ /defmacro! a0 eq { %if defmacro! - /a1 ast 1 get def - /a2 ast 2 get def + /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 get env macroexpand + ast 1 _nth env macroexpand }{ /ps* a0 eq { %if ps* count /stackcnt exch def - ast 1 get + ast 1 _nth { token not { exit } if exch @@ -148,21 +154,18 @@ end } def null % return nil } ifelse }{ /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 }{ /try* a0 eq { %if try* { %try countdictstack /dictcnt exch def count /stackcnt exch def - %(here1:\n) print pstack - ast 1 get env EVAL - %(here2\n) print + ast 1 _nth env EVAL } stopped { %catch - %(here3:\n) print pstack % clean up the dictionary stack 1 1 countdictstack dictcnt sub { %foreach added dict %(popping dict\n) print @@ -170,7 +173,6 @@ end } def %(new ast: ) print ast true _pr_str print (\n) print } for % clean up the operand stack - %(op stack cleanup: ) print count stackcnt sub == count 1 exch 1 exch stackcnt sub { %foreach added operand %(op stack: ) print pstack pop pop % pop idx and operand @@ -181,40 +183,38 @@ end } def $error /newerror false put $error /errorinfo null put - ast length 3 lt { %if no third (catch*) form + ast _count 3 lt { %if no third (catch*) form errdata throw } if - %(here4: ) print ast true _pr_str print (\n) print - ast 2 get 0 get (catch*) eq not { %if third form not catch* - (No catch* in throw form) throw + ast 2 _nth 0 _nth (catch*) eq not { %if third form not catch* + (No catch* in throw form) _throw } if - %(here5: ) print ast 2 get 2 get true _pr_str print (\n) print - ast 2 get 2 get - %(here5: ) print ast 2 get 1 get true _pr_str print (\n) print - %(here6: ) print errdata true _pr_str print (\n) print - env [ ast 2 get 1 get ] [ errdata ] env_new - %(here7:\n) print pstack + 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 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 /macro? false % macro flag, false by default /params null % close over parameters /ast null % close over ast @@ -251,7 +251,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 @@ -259,11 +259,11 @@ end } def core_ns { _ref } forall -(readline) { 0 get _readline not { null } if } _ref -(read-string) { 0 get read_str } _ref -(eval) { 0 get repl_env EVAL } _ref +(readline) { 0 _nth _readline not { null } if } _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 (\(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 diff --git a/ps/types.ps b/ps/types.ps index c696d35..03c772f 100644 --- a/ps/types.ps +++ b/ps/types.ps @@ -40,18 +40,18 @@ /otb b type def a type b type eq - a _list? b _list? and + a _sequential? b _sequential? and or not { %if type mismatch and not sequential false }{ - a _list? { %if list + a _sequential? { %if list /ret true def - a length b length eq not { %if length mismatch + a _count b _count eq not { %if length mismatch /ret false def }{ %else (length is the same) - 0 1 a length 1 sub { + 0 1 a _count 1 sub { /idx exch def - a idx get b idx get _equal? not { %if not items _equal? + a idx _nth b idx _nth _equal? not { %if not items _equal? /ret false def exit } if @@ -64,23 +64,55 @@ } ifelse end } def -/_sequential? { _list? } def + +% Low-level sequence operations + +/_sequential? { dup _list? exch _vector? or } def + +/_count { /data get length } def /_first { + /data get dup length 0 gt { 0 get }{ pop null } ifelse } def + +% seq start count -> _slice -> new_seq +/_slice { + 3 -1 roll /data get 3 1 roll % stack: array start count + getinterval + _list_from_array +} def + +% seq idx -> _nth -> ith_item +/_nth { + exch /data get % stack: idx array + dup length 0 gt { exch get }{ pop pop null } ifelse +} def + +% seq -> _rest -> rest_seq /_rest { + /data get dup length 0 gt { dup length 1 sub 1 exch getinterval }{ pop 0 array } ifelse + _list_from_array } def % Errors/Exceptions +% data -> _throw -> +% Takes arbitrary data and puts it in $error:/errorinfo. Then calls +% stop to transfer control to end of nearest stopped context. +/_throw { + $error exch /errorinfo exch put + $error /command /throw put + stop +} def + /errorinfo? { $error /errorinfo known { % if set $error /errorinfo get null ne { @@ -128,7 +160,7 @@ end } def /_mal_function? { dup type /dicttype eq { - /type get /_maltype_function eq + /_maltype_ get /function eq }{ pop false } ifelse @@ -150,11 +182,103 @@ end } def % Lists +% array -> _list_from_array -> mal_list +/_list_from_array { + << + /data 3 -1 roll % grab the array argument + /_maltype_ /list + /meta null + >> +} def +% elem... cnt -> _list -> mal_list /_list { - array astore + array astore _list_from_array } def /_list? { - dup xcheck not exch type /arraytype eq and + dup type /dicttype eq { + /_maltype_ get /list eq + }{ + pop false + } ifelse +} def + + +% Vectors + +% array -> _vector_from_array -> mal_vector +/_vector_from_array { + << + /data 3 -1 roll % grab the array argument + /_maltype_ /vector + /meta null + >> +} def +% elem... cnt -> _vector -> mal_vector +/_vector { + array astore _vector_from_array +} def +/_vector? { + dup type /dicttype eq { + /_maltype_ get /vector eq + }{ + pop false + } ifelse +} def + + +% Hash Maps + +% dict -> _hash_map_from_dict -> mal_hash_map +/_hash_map_from_dict { + << + /data 3 -1 roll + /_maltype_ /hash_map + /meta null + >> +} def +% array -> _hash_map_from_array -> mal_hash_map +/_hash_map_from_array { + << + /data << + 4 -1 roll % grab the array argument + aload pop % unpack the array + >> + /_maltype_ /hash_map + /meta null + >> +} def +% elem... cnt -> _hash_map -> mal_hash_map +/_hash_map { + array astore _hash_map_from_array +} def +/_hash_map? { + dup type /dicttype eq { + /_maltype_ get /hash_map eq + }{ + pop false + } ifelse } def -/_nth { get } def + +% Atoms + +% obj -> atom -> new_atom +/_atom { + << + /data 3 -1 roll + /_maltype_ /atom + /meta null + >> +} def + +/_atom? { + dup type /dicttype eq { + /_maltype_ get /atom eq + }{ + pop false + } ifelse +} def + + + +% Sequence operations diff --git a/tests/stepA_more.mal b/tests/stepA_more.mal index 31eb2bb..aac1bac 100644 --- a/tests/stepA_more.mal +++ b/tests/stepA_more.mal @@ -214,6 +214,9 @@ (dissoc hm3 "a" "b") ;=>{} +(dissoc hm3 "a" "b" "c") +;=>{} + (count (keys hm3)) ;=>2 @@ -236,6 +239,10 @@ (meta f-wm) ;=>{"abc" 1} +(def! f-wm2 ^"str meta" (fn* [a] (+ 1 a))) +(meta f-wm2) +;=>"str meta" + ;; ;; Testing atoms @@ -272,6 +279,8 @@ (swap! a (fn* (a) (* 2 a))) ;=>12 +(swap! a + 3) +;=>15 ;; ;; Testing read-str and eval |