(in types.ps\n) print % General functions % concatenate: concatenate two strings or two arrays % From Thinking in PostScript 1990 Reid % (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 % objA objB -> _equal? -> bool /_equal? { 6 dict begin /b exch def /a exch def /ota a type def /otb b type def a type b type eq a _sequential? b _sequential? and or not { %if type mismatch and not sequential false }{ a _sequential? { %if list /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 a list a b eq } 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 % 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 % Symbols /_symbol? { type /nametype eq } def % Functions /_mal_function? { dup type /dicttype eq { /_maltype_ get /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_block -> callable -> block % if this is a user defined mal function, get its executable block /callable { dup _mal_function? { /data get } if } 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