PS: add step4_if_fn_do

5 files changed, 201 insertions, 6 deletions

diff --git a/ps/step1_read_print.ps b/ps/step1_read_print.ps
index e03c8cc..0cd4b5d 100644
--- a/ps/step1_read_print.ps
+++ b/ps/step1_read_print.ps
@@ -19,7 +19,7 @@ end } def
 
 % print
 /PRINT {
-    pr_str
+    true _pr_str
 } def
 
 
@@ -37,11 +37,12 @@ end } def
     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 pr_str print (\n) print
+        get_error_data false _pr_str print (\n) print
         clear
     } if
 } bind loop
diff --git a/ps/step2_eval.ps b/ps/step2_eval.ps
index dec403c..daaf2cb 100644
--- a/ps/step2_eval.ps
+++ b/ps/step2_eval.ps
@@ -49,7 +49,7 @@ end } def
 
 % print
 /PRINT {
-    pr_str
+    true _pr_str
 } def
 
 
@@ -74,11 +74,12 @@ end } def
     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 pr_str print (\n) print
+        get_error_data false _pr_str print (\n) print
         clear
     } if
 } bind loop
diff --git a/ps/step3_env.ps b/ps/step3_env.ps
index 908ff43..656ca10 100644
--- a/ps/step3_env.ps
+++ b/ps/step3_env.ps
@@ -63,7 +63,7 @@ end } def
 
 % print
 /PRINT {
-    pr_str
+    true _pr_str
 } def
 
 
@@ -89,11 +89,12 @@ end } def
     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 pr_str print (\n) print
+        get_error_data false _pr_str print (\n) print
         clear
     } if
 } bind loop
diff --git a/ps/step4_if_fn_do.ps b/ps/step4_if_fn_do.ps
new file mode 100644
index 0000000..891652e
--- /dev/null
+++ b/ps/step4_if_fn_do.ps
@@ -0,0 +1,137 @@
+(types.ps) run
+(reader.ps) run
+
+% read
+/READ {
+    /str exch def
+    str read_str
+} def
+
+
+% eval
+/eval_ast { 2 dict begin
+    /env exch def
+    /ast exch def
+    %(eval_ast: ) print ast ==
+    /nametype ast type eq { %if symbol
+        env ast env_get
+    }{ /arraytype ast type eq { %elseif list
+        [
+            ast {
+                env EVAL
+            } forall
+        ]
+    }{ % else
+        ast
+    } ifelse } ifelse
+end } def
+
+/EVAL { 10 dict begin
+    /env exch def
+    /ast exch def
+    %(EVAL: ) print ast ==
+    /arraytype ast type ne { %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
+            } for
+            a2 let_env EVAL
+        }{ /do a0 eq { %if do
+            /el ast _rest env eval_ast def
+            el el length 1 sub get % return last value
+        }{ /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 (a3) provided
+                    ast 3 get env EVAL % EVAL false branch (a3)
+                }{
+                    null
+                } ifelse
+            }{
+                ast 2 get env EVAL % EVAL true branch (a2)
+            } ifelse
+        }{ /fn* a0 eq { %if fn*
+            /a1 ast 1 get def
+            /a2 ast 2 get def
+            { 4 dict begin
+                /A1  __a1__  def % close over positino 4
+                /A2  __a2__  def % close over position 7
+                /ENV __env__ def % close over position 10
+                /args exch def
+                %(inside fn*:\n) print
+                %(  A1: ) print A1 ==
+                %(  A2: ) print A2 ==
+                %(  ENV: ) print ENV ==
+                %(  args: ) print args ==
+                A2   ENV A1 args env_new   EVAL
+            end }
+            dup length array copy cvx % make an actual copy/new instance
+            dup 4 a1 put   % insert closed over a1 into position 4
+            dup 7 a2 put   % insert closed over a1 into position 7
+            dup 10 env put % insert closed over a1 into position 10
+        }{
+            /el ast env eval_ast def
+            el _rest % args array
+            el _first cvx % function
+            %(vvv\n) print pstack (^^^\n) print
+            exec % apply function to args
+        } ifelse } ifelse } ifelse } ifelse } ifelse
+    } ifelse
+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
+
+/stdin (%stdin) (r) file def 
+
+{ % loop
+    (user> ) print flush
+
+    %(%lineedit) (r) file 99 string readline
+    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
+        clear
+    } if
+} bind loop
+
+(\n) print  % final newline before exit for cleanliness
+quit
diff --git a/ps/types.ps b/ps/types.ps
index 8843841..0cc6372 100644
--- a/ps/types.ps
+++ b/ps/types.ps
@@ -81,6 +81,38 @@ end } def
     } if
 } 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
+
 
 %
 % errors/exceptions
@@ -196,3 +228,26 @@ end } def
         key get
     } ifelse
 end } def
+
+%
+% types_ns is namespace of type functions
+%
+/types_ns <<
+    (pr-str)  { ( ) true _pr_str_args }
+    (str)     { () false _pr_str_args }
+    (prn)     { ( ) true _pr_str_args print (\n) print null }
+    (println) { () false _pr_str_args print (\n) print null }
+    (=)       { dup 0 get exch 1 get _equal? }
+    (<)       { dup 0 get exch 1 get lt }
+    (<=)      { dup 0 get exch 1 get le }
+    (>)       { dup 0 get exch 1 get gt }
+    (>=)      { dup 0 get exch 1 get ge }
+    (+)       { dup 0 get exch 1 get add }
+    (-)       { dup 0 get exch 1 get sub }
+    (*)       { dup 0 get exch 1 get mul }
+    (/)       { dup 0 get exch 1 get idiv }
+    (list)    { }
+    (list?)   { 0 get _list? }
+    (empty?)  { 0 get length 0 eq }
+    (count)   { 0 get length }
+>> def