path: root/ps/types.ps

(in types.ps\n) print

% 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? {
    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