mal/ps/step5_tco.ps

(types.ps) run
(reader.ps) run

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

/READ {
    /str exch def
    str read_str
} def


% eval
/eval_ast { 2 dict begin
    /env exch def
    /ast exch def
    %(eval_ast: ) print ast ==
    ast _symbol? { %if symbol
        env ast env_get
    }{ ast _list? { %elseif list
        [
            ast {
                env EVAL
            } forall
        ]
    }{ % else
        ast
    } 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
        /a0 ast 0 get def
        /def! a0 eq { %if def!
            /a1 ast 1 get def
            /a2 ast 2 get def
            env a1  a2 env EVAL  env_set
        }{ /let* a0 eq { %if let*
            /a1 ast 1 get def
            /a2 ast 2 get def
            /let_env env [ ] [ ] env_new def
            0 2 a1 length 1 sub { %for each pair
                /idx exch def
                let_env
                    a1 idx get
                    a1 idx 1 add get let_env EVAL
                    env_set
                    pop % discard the return value
            } for
            a2 let_env EVAL
        }{ /do a0 eq { %if do
            ast length 2 gt { %if ast has more than 2 elements
                ast 1 ast length 2 sub getinterval env eval_ast pop
            } if
            ast ast length 1 sub get % last ast becomes new ast
            env
            /loop? true def % loop
        }{ /if a0 eq { %if if
            /a1 ast 1 get def
            /cond a1 env EVAL def
            cond null eq cond false eq or { % if cond is nil or false
                ast length 3 gt { %if false branch with a3
                    ast 3 get env
                    /loop? true def
                }{ % else false branch with no a3
                    null
                } ifelse
            }{ % true branch
                ast 2 get env
                /loop? true def
            } ifelse
        }{ /fn* a0 eq { %if fn*
            /a1 ast 1 get def
            /a2 ast 2 get def
            <<
                /type /_maltype_function % user defined function
                /params null % close over parameters
                /ast null    % close over ast
                /env null    % close over environment
                /data { __self__ fload EVAL }
            >>
            dup length dict copy % make an actual copy/new instance
            dup /params a1 put  % insert closed over a1 into position 2
            dup /ast a2 put  % insert closed over a2 into position 3
            dup /env env put % insert closed over env into position 4
            dup   dup /data get   exch 0 exch put % insert self reference
        }{
            /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
            }{ %else (regular procedure/function)
                exec % apply function to args
            } 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 [ ] [ ] env_new def

/RE { READ repl_env EVAL } def
/REP { READ repl_env EVAL PRINT } def
/_ref { repl_env 3 1 roll env_set pop } def

types_ns { _ref } forall

(\(def! not \(fn* \(a\) \(if a false true\)\)\)) 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