mal/ps/types.ps

(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 _list? b _list? and
    or not { %if type mismatch and not sequential
        false
    }{
        a _list? { %if list
            /ret true def
            a length b length eq not { %if length mismatch
                /ret false def
            }{ %else (length is the same)
                0 1 a length 1 sub {
                    /idx exch def
                    a idx get b idx get _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

/_sequential? { _list? } def

/_first {
    dup length 0 gt { 0 get }{ pop null } ifelse
} def
/_rest {
    dup length 0 gt {
        dup length 1 sub 1 exch getinterval
    }{
        pop 0 array
    } ifelse
} def



% Errors/Exceptions

/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 {
        /type get /_maltype_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

/_list {
    array astore
} def
/_list? {
    dup xcheck not exch type /arraytype eq and
} def
/_nth { get } def