path: root/ps/types.ps

% 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