mirror of
https://github.com/kanaka/mal.git
synced 2024-09-20 10:07:45 +03:00
385 lines
8.2 KiB
PostScript
385 lines
8.2 KiB
PostScript
% 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
|
|
/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 {
|
|
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 {
|
|
0 get 127 eq
|
|
}{
|
|
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
|