mal/ps/stepA_interop.ps

/runlibfile where { pop }{ /runlibfile { run } def } ifelse % 
(types.ps) runlibfile
(reader.ps) runlibfile
(printer.ps) runlibfile
(env.ps) runlibfile
(core.ps) runlibfile

% read
/_readline { print flush (%stdin) (r) file 99 string readline } def

/READ {
    /str exch def
    str read_str
} def


% eval
% is_pair?: ast -> is_pair? -> bool
% return true if non-empty list, otherwise false
/is_pair? { 
    dup _sequential? { _count 0 gt }{ pop false } ifelse
} def

% ast -> quasiquote -> new_ast
/quasiquote { 3 dict begin
    /ast exch def
    ast is_pair? not { %if not is_pair?
        /quote ast 2 _list
    }{ 
        /a0 ast 0 _nth def
        a0 /unquote eq { %if a0 unquote symbol
            ast 1 _nth
        }{ a0 is_pair? { %elseif a0 is_pair?
            /a00 a0 0 _nth def
            a00 /splice-unquote eq { %if splice-unquote
                /concat a0 1 _nth ast _rest quasiquote 3 _list
            }{ %else not splice-unquote
                /cons a0 quasiquote ast _rest quasiquote 3 _list
            } ifelse
        }{ % else not a0 is_pair?
            /cons a0 quasiquote ast _rest quasiquote 3 _list
        } ifelse } ifelse
    } ifelse
end } def

/is_macro_call? { 3 dict begin
    /env exch def
    /ast exch def
    ast _list? {
        /a0 ast 0 _nth def
        a0 _symbol? { %if a0 is symbol
            env a0 env_find null ne { %if a0 is in env
                env a0 env_get _mal_function? { %if user defined function
                    env a0 env_get /macro? get true eq %if marked as macro
                }{ false } ifelse
            }{ false } ifelse
        }{ false } ifelse
    }{ false } ifelse
end } def

/macroexpand { 3 dict begin
    /env exch def
    /ast exch def
    {
        ast env is_macro_call? {
            /mac env   ast 0 _nth   env_get def
            /ast ast _rest mac fload EVAL def
        }{
            exit
        } ifelse
    } loop 
    ast
end } def

/eval_ast { 2 dict begin
    /env exch def
    /ast exch def
    %(eval_ast: ) print ast ==
    ast _symbol? { %if symbol
        env ast env_get
    }{ ast _sequential? { %elseif list or vector
        [
            ast /data get { %forall items
                env EVAL
            } forall
        ] ast _list? { _list_from_array }{ _vector_from_array } ifelse
    }{ ast _hash_map? { %elseif list or vector
        <<
            ast /data get { %forall entries
                env EVAL
            } forall
        >> _hash_map_from_dict
    }{ % else
        ast
    } ifelse } ifelse } ifelse
end } def

/EVAL { 13 dict begin
    { %loop (TCO) 

    /env exch def
    /ast exch def
    /loop? false def

    %(EVAL: ) print ast true _pr_str print (\n) print
    ast _list? not { %if not a list
        ast env eval_ast
    }{ %else apply the list
      /ast ast env macroexpand def
      ast _list? not { %if no longer a list
          ast
      }{ %else still a list
        /a0 ast 0 _nth def
        /def! a0 eq { %if def!
            /a1 ast 1 _nth def
            /a2 ast 2 _nth def
            env a1  a2 env EVAL  env_set
        }{ /let* a0 eq { %if let*
            /a1 ast 1 _nth def
            /a2 ast 2 _nth def
            /let_env env null null env_new def
            0 2 a1 _count 1 sub { %for each pair
                /idx exch def
                let_env
                    a1 idx _nth
                    a1 idx 1 add _nth let_env EVAL
                    env_set
                    pop % discard the return value
            } for
            a2
            let_env
            /loop? true def % loop
        }{ /quote a0 eq { %if quote
            ast 1 _nth
        }{ /quasiquote a0 eq { %if quasiquote
            ast 1 _nth quasiquote
            env
            /loop? true def % loop
        }{ /defmacro! a0 eq { %if defmacro!
            /a1 ast 1 _nth def
            /a2 ast 2 _nth def
            a2 env EVAL
            dup /macro? true put % set macro flag
            env exch a1 exch env_set % def! it
        }{ /macroexpand a0 eq { %if defmacro!
            ast 1 _nth env macroexpand
        }{ /ps* a0 eq { %if ps*
            count /stackcnt exch def
            ast 1 _nth
            {
                token not { exit } if
                exch
                count stackcnt sub 1 roll % send leftover string to bottom
                exec
                count stackcnt sub -1 roll % bring leftover string to top
            } loop
            count stackcnt gt { % if new operands on stack
                % return an list of new operands
                count stackcnt sub array astore
            }{
                null % return nil
            } ifelse
        }{ /do a0 eq { %if do
            ast _count 2 gt { %if ast has more than 2 elements
                ast 1 ast _count 2 sub _slice env eval_ast pop
            } if
            ast ast _count 1 sub _nth % last ast becomes new ast
            env
            /loop? true def % loop
        }{ /try* a0 eq { %if try*
            { %try
                countdictstack /dictcnt exch def
                count /stackcnt exch def
                ast 1 _nth env EVAL
            } stopped { %catch
                % clean up the dictionary stack
                1 1 countdictstack dictcnt sub { %foreach added dict
                    %(popping dict\n) print
                    pop end % pop idx and pop dict
                    %(new ast: ) print ast true _pr_str print (\n) print
                } for
                % clean up the operand stack
                count 1 exch 1 exch stackcnt sub { %foreach added operand
                    %(op stack: ) print pstack
                    pop pop % pop idx and operand
                    %(popped op stack\n) print pstack
                } for
                % get error data and reset $error dict
                /errdata get_error_data def
                $error /newerror false put
                $error /errorinfo null put

                ast _count 3 lt { %if no third (catch*) form
                    errdata throw
                } if
                ast 2 _nth 0 _nth (catch*) eq not { %if third form not catch*
                    (No catch* in throw form) _throw
                } if
                ast 2 _nth 2 _nth
                env
                    ast 2 _nth 1 _nth 1 _list
                    errdata 1 _list
                    env_new
                EVAL
            } if
        }{ /if a0 eq { %if if
            /a1 ast 1 _nth def
            /cond a1 env EVAL def
            cond null eq cond false eq or { % if cond is nil or false
                ast _count 3 gt { %if false branch with a3
                    ast 3 _nth env
                    /loop? true def
                }{ % else false branch with no a3
                    null
                } ifelse
            }{ % true branch
                ast 2 _nth env
                /loop? true def
            } ifelse
        }{ /fn* a0 eq { %if fn*
            /a1 ast 1 _nth def
            /a2 ast 2 _nth def
            a2 env a1 _mal_function
        }{
            /el ast env eval_ast def
            el _rest el _first % stack: ast function
            dup _mal_function? { %if user defined function
                fload % stack: ast new_env
                /loop? true def
            }{ dup _function? { %else if builtin function
                /data get exec
            }{ %else (regular procedure/function)
                (cannot apply native proc!\n) print quit
            } ifelse } ifelse
        } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse
      } ifelse
    } ifelse

    loop? not { exit } if
    } loop % TCO
end } def


% print
/PRINT {
    true _pr_str
} def


% repl
/repl_env null null null env_new def

/RE { READ repl_env EVAL } def
/REP { READ repl_env EVAL PRINT } def

% core.ps: defined using postscript
/_ref { repl_env 3 1 roll env_set pop } def
core_ns { _function _ref } forall
(eval) { 0 _nth repl_env EVAL } _function _ref
(*ARGV*) [ ] _list_from_array _ref

% core.mal: defined using the language itself
(\(def! *host-language* "postscript"\)) RE pop
(\(def! not \(fn* \(a\) \(if a false true\)\)\)) RE pop
(\(def! load-file \(fn* \(f\) \(eval \(read-string \(str "\(do " \(slurp f\) "\)"\)\)\)\)\)) RE pop
(\(defmacro! cond \(fn* \(& xs\) \(if \(> \(count xs\) 0\) \(list 'if \(first xs\) \(if \(> \(count xs\) 1\) \(nth xs 1\) \(throw "odd number of forms to cond"\)\) \(cons 'cond \(rest \(rest xs\)\)\)\)\)\)\)) RE pop
(\(defmacro! or \(fn* \(& xs\) \(if \(empty? xs\) nil \(if \(= 1 \(count xs\)\) \(first xs\) `\(let* \(or_FIXME ~\(first xs\)\) \(if or_FIXME or_FIXME \(or ~@\(rest xs\)\)\)\)\)\)\)\)) RE pop

userdict /ARGUMENTS known { %if command line arguments
    ARGUMENTS length 0 gt { %if more than 0 arguments
        (*ARGV*) ARGUMENTS 1 ARGUMENTS length 1 sub getinterval
        _list_from_array _ref
        ARGUMENTS 0 get 
        (\(load-file ") exch ("\)) concatenate concatenate RE pop
        quit
    } if
} if

% repl loop
(\(println \(str "Mal [" *host-language* "]"\)\)) RE pop
{ %loop
    (user> ) _readline
    not { exit } if  % exit if EOF

    { %try
        REP print (\n) print
    } stopped {
        (Error: ) print
        get_error_data false _pr_str print (\n) print
        $error /newerror false put
        $error /errorinfo null put
        clear
        cleardictstack
    } if
} bind loop

(\n) print  % final newline before exit for cleanliness
quit