% General functions % concatenate: concatenate two strings or two arrays % From Thinking in PostScript 1990 Reid, Example 11.7 % (string1) (string2) concatenate string3 % array1 array2 concatenate array3 /concatenate { %def dup type 2 index type 2 copy ne { %if pop pop errordict begin (concatenate) typecheck end }{ %else /stringtype ne exch /arraytype ne and { errordict begin (concatenate) typecheck end } if } ifelse dup length 2 index length add 1 index type /arraytype eq { array }{ string } ifelse % stack: arg1 arg2 new dup 0 4 index putinterval % stack: arg1 arg2 new dup 4 -1 roll length 4 -1 roll putinterval % stack: new } bind def % reverse: array1 -> reverse -> array2 /reverse { [ exch aload % push array onto stack length -1 0 { 1 roll } for % reverse ] } bind def % string1 string2 string3 -> replace -> string4 % Return a string4 with all occurrences of string2 in string1 replaced % with string3 /replace { 4 dict begin /repstr exch def /needle exch def /haystack exch def /result () def { % loop haystack needle search { %if found % stack: post match pre repstr concatenate 3 1 roll pop % stack: pre+ post /haystack exch def % stack: pre+ result exch concatenate /result exch def }{ result exch concatenate /result exch def exit } ifelse } loop result end } def % objA objB -> _equal? -> bool /_equal? { 6 dict begin /b exch def /a exch def a type b type eq a _sequential? b _sequential? and or not { %if type mismatch and not sequential false }{ a _sequential? b _sequential? and { %if list/vector /ret true def a _count b _count eq not { %if length mismatch /ret false def }{ %else (length is the same) 0 1 a _count 1 sub { /idx exch def a idx _nth b idx _nth _equal? not { %if not items _equal? /ret false def exit } if } for } ifelse ret }{ %else not list/vector a _hash_map? b _hash_map? and { %if hash_map /ret true def /a_keys a _keys def a_keys _count b _keys _count eq not { /ret false def }{ a_keys /data get { %foreach key in a_keys /key exch def a key _hash_map_get b key _hash_map_get _equal? not { %if not items _equal? /ret false def exit } if } forall } ifelse ret }{ %else not hash_map a b eq } ifelse } ifelse } ifelse end } 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 % hashmap -> _keys -> key_list /_keys { /data get [ exch { pop dup length string cvs } forall ] _list_from_array } def % hashmap key -> _hash_map_get -> val /_hash_map_get { exch % stack: key hashmap /data get % stack: key dict exch % stack: dict key 2 copy known { %if has key get }{ pop pop null } ifelse } 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 { true }{ false } ifelse }{ false } ifelse } def /get_error_data { errorinfo? { %if $error /errorinfo get }{ $error /errorname get 255 string cvs (: ) $error /command get 99 string cvs ( at ) $error /position get 10 99 string cvrs concatenate concatenate concatenate concatenate } ifelse } def % Scalars /_nil? { null eq } def /_true? { true eq } def /_false? { false eq } def /_string? { dup type /stringtype eq { dup length 0 eq { % if length == 0 pop true }{ 0 get 127 eq not } ifelse }{ pop false } ifelse } def % Symbols /_symbol { dup length string copy cvn } def /_symbol? { type /nametype eq } def % Keywords /_keyword { 1 dict begin /str exch def str length 1 add string % str2 dup 1 str putinterval dup 0 127 put % TODO: something like (\x029e) would be better end } def /_keyword? { dup type /stringtype eq { dup length 0 eq { % if length == 0 pop false }{ 0 get 127 eq } ifelse }{ pop false } ifelse } def % Functions % block -> _function -> boxed_function /_function { << /_maltype_ /function %/data 5 -1 roll cvlit /data 5 -1 roll >> %%dup length dict copy } def % ast env params -> _mal_function -> boxed_mal_function /_mal_function { << /_maltype_ /mal_function % user defined function /macro? false % macro flag, false by default /params null % close over parameters /ast null % close over ast /env null % close over environment /data { __self__ fload EVAL } % forward reference to EVAL dup length array copy cvx % actual copy/new instance of block >> % make an actual copy/new instance of dict dup length dict copy % stack: ast env params mal_fn % "Close over" parameters dup 3 -1 roll % stack: ast env mal_fn mal_fn params /params exch put % stack: ast env mal_fn dup 3 -1 roll % stack: ast mal_fn mal_fn env /env exch put % stack: ast mal_fn dup 3 -1 roll % stack: mal_fn mal_fn ast /ast exch put % stack: mal_fn % insert self reference into position 0 of data dup /data get % stack: mal_fn data 1 index % stack: mal_fn data mal_fn 0 exch % stack: mal_fn data 0 mal_fn put % stack: mal_fn } def /_function? { dup type /dicttype eq { /_maltype_ get /function eq }{ pop false } ifelse } def /_mal_function? { dup type /dicttype eq { /_maltype_ get /mal_function eq }{ pop false } ifelse } def % args mal_function -> fload -> ast new_env % fload: sets up arguments on the stack for an EVAL call /fload { dup /ast get 3 1 roll % stack: ast args mal_function dup /env get 3 1 roll % stack: ast env args mal_function /params get exch % stack: ast env params args env_new % stack: ast new_env } def % function_or_mal_function -> callable -> block % if this is a function or mal_function, get its executable block /callable { dup _mal_function? { %if mal_function /data get }{ dup _function? { %else if function /data get }{ %else something invalid (callable called on non-function!\n) print quit cvx } ifelse } ifelse } 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 _list_from_array } def /_list? { 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 % 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