PS: add step9_interop: (ps* str)

Needs some work, but function. Also need (. x y z) form.

diff --git a/ps/step9_interop.ps b/ps/step9_interop.ps
new file mode 100644 (file)
index 0000000..5ccadf5
--- /dev/null
+++ b/ps/step9_interop.ps
@@ -0,0 +1,253 @@
+(types.ps) run
+(reader.ps) run
+
+% read
+/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 _list? { length 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 get def
+        a0 /unquote eq { %if a0 unquote symbol
+            ast 1 get
+        }{ a0 is_pair? { %elseif a0 is_pair?
+            /a00 a0 0 get def
+            a00 /splice-unquote eq { %if splice-unquote
+                /concat a0 1 get 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 get 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 get   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 _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
+      /ast ast env macroexpand def
+      ast _list? not { %if no longer a list
+          ast
+      }{ %else still a 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
+        }{ /quote a0 eq { %if quote
+            ast 1 get
+        }{ /quasiquote a0 eq { %if quasiquote
+            ast 1 get quasiquote   env EVAL
+        }{ /defmacro! a0 eq { %if defmacro!
+            /a1 ast 1 get def
+            /a2 ast 2 get 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 get env macroexpand
+        }{ /ps* a0 eq { %if ps*
+            count /stackcnt exch def
+            ast 1 get
+            {
+                token not { exit } if
+                exch
+            } loop
+            exec
+            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 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
+                /macro? false % macro flag, false by default
+                /params null % close over parameters
+                /ast null    % close over ast
+                /env null    % close over environment
+            >>
+            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
+        }{
+            /el ast env eval_ast def
+            el _first _mal_function? { % if user defined function
+                el _rest el _first fload % stack: ast new_env
+                /loop? true def
+            }{ %else (regular procedure/function)
+                el _rest el _first exec % apply function to args
+            } 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 [ ] [ ] 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
+
+(read-string) { 0 get read_str } _ref
+(eval) { 0 get repl_env EVAL } _ref
+/slurp { (r) file dup bytesavailable string readstring pop } def
+(slurp) { 0 get slurp } _ref
+(pstack) { (vvv\n) print pstack (^^^\n) print } _ref
+(p1) { 1 index true _pr_str print (\n) print } _ref
+
+(\(def! not \(fn* \(a\) \(if a false true\)\)\)) RE pop
+(\(def! load-file \(fn* \(f\) \(eval \(read-string \(str "\(do " \(slurp f\) "\)"\)\)\)\)\)) RE pop
+
+/stdin (%stdin) (r) file def 
+
+userdict /ARGUMENTS known { %if command line arguments
+    ARGUMENTS length 0 gt { %if more than 0 arguments
+        ARGUMENTS {
+            (\(load-file ") exch ("\)) concatenate concatenate RE pop
+        } forall
+        quit
+    } if
+} if
+{ % loop
+    (user> ) print flush
+
+    stdin 99 string readline
+
+    not { exit } if  % exit if EOF
+
+    %(\ngot line: ) print dup print (\n) print flush
+
+    { %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
+    } if
+} bind loop
+
+(\n) print  % final newline before exit for cleanliness
+quit