PS: add step7_quote

9 files changed, 288 insertions, 53 deletions

diff --git a/docs/step_notes.txt b/docs/step_notes.txt
index 840d0c8..4947edf 100644
--- a/docs/step_notes.txt
+++ b/docs/step_notes.txt
@@ -138,16 +138,16 @@ Step Notes:
     - if files on command line, use load-file to run
 
 - step7_quote
-    - reader module:
-        - add reader macros to read_form for quote, unquote,
-          splice-unquote and quasiquote
-    - types module:
-        - add cons and concat functions
     - add is_pair and quasiquote functions
         - rewrite ast using cons/concat functions
         - if vectors, use sequential? instead of list? in is_pair
     - EVAL:
         - add 'quote', 'quasiquote' cases
+    - types module:
+        - add cons and concat functions
+    - reader module:
+        - add reader macros to read_form for quote, unquote,
+          splice-unquote and quasiquote
 
 - step8_macros
     - types module:
diff --git a/ps/reader.ps b/ps/reader.ps
index 8575d64..e524d4c 100644
--- a/ps/reader.ps
+++ b/ps/reader.ps
@@ -149,7 +149,7 @@
 
 % read_form: read the next form from string start at idx
 % string idx -> read_form -> ast string new_idx
-/read_form {
+/read_form { 3 dict begin
     %(in read_form\n) print
     read_spaces
     /idx exch def
@@ -157,22 +157,39 @@
 
     idx str length ge { exit } if % EOF, break loop
     /ch str idx get def  % current character
-    ch 40 eq { %if (
+    ch 39 eq { %if '\''
+        /idx idx 1 add def
+        str idx read_form
+        3 -1 roll   /quote exch 2 _list   3 1 roll
+    }{ ch 96 eq { %if '`'
+        /idx idx 1 add def
+        str idx read_form
+        3 -1 roll   /quasiquote exch 2 _list   3 1 roll
+    }{ ch 126 eq { %if '~'
+        /idx idx 1 add def
+        /ch str idx get def  % current character
+        ch 64 eq { %if '~@'
+            /idx idx 1 add def
+            str idx read_form
+            3 -1 roll   /splice-unquote exch 2 _list   3 1 roll
+        }{ %else just '~'
+            str idx read_form
+            3 -1 roll   /unquote exch 2 _list   3 1 roll
+        } ifelse
+    }{ ch 40 eq { %if '('
         str idx read_list
-    }{ ch 91 eq { %elseif [
+    }{ ch 41 eq { %elseif ')'
+        (unexpected '\)') throw
+    }{ ch 91 eq { %elseif '['
         (unexpected '[') throw
-    }{ ch 93 eq { %elseif ]
+    }{ ch 93 eq { %elseif ']'
         (unexpected ']') throw
     }{ % else
         str idx read_atom
-    } ifelse } ifelse } ifelse
-
-    %(stack vvv\n) print
-    %pstack
-    %(stack ^^^\n) print
+    } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse
 
     % return: ast string new_idx
-} def
+end } def
 
 % string -> read_str -> ast
 /read_str {
diff --git a/ps/step2_eval.ps b/ps/step2_eval.ps
index 4328e2f..04e6a50 100644
--- a/ps/step2_eval.ps
+++ b/ps/step2_eval.ps
@@ -41,7 +41,6 @@ end } def
         /el ast env eval_ast def
         el _rest % args array
         el _first % function
-        %(vvv\n) print pstack (^^^\n) print
         exec % apply function to args
     } ifelse
 end } def
diff --git a/ps/step3_env.ps b/ps/step3_env.ps
index 02b3e8d..5feae46 100644
--- a/ps/step3_env.ps
+++ b/ps/step3_env.ps
@@ -13,9 +13,9 @@
     /env exch def
     /ast exch def
     %(eval_ast: ) print ast ==
-    /nametype ast type eq { %if symbol
+    ast _symbol? { %if symbol
         env ast env_get
-    }{ /arraytype ast type eq { %elseif list
+    }{ ast _list? { %elseif list
         [
             ast {
                 env EVAL
@@ -30,7 +30,7 @@ end } def
     /env exch def
     /ast exch def
     %(EVAL: ) print ast ==
-    /arraytype ast type ne { %if not a list
+    ast _list? not { %if not a list
         ast env eval_ast
     }{ %else apply the list
         /a0 ast 0 get def
@@ -54,7 +54,6 @@ end } def
             /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
diff --git a/ps/step4_if_fn_do.ps b/ps/step4_if_fn_do.ps
index 72dafef..d92d75a 100644
--- a/ps/step4_if_fn_do.ps
+++ b/ps/step4_if_fn_do.ps
@@ -13,9 +13,9 @@
     /env exch def
     /ast exch def
     %(eval_ast: ) print ast ==
-    /nametype ast type eq { %if symbol
+    ast _symbol? { %if symbol
         env ast env_get
-    }{ /arraytype ast type eq { %elseif list
+    }{ ast _list? { %elseif list
         [
             ast {
                 env EVAL
@@ -30,7 +30,7 @@ end } def
     /env exch def
     /ast exch def
     %(EVAL: ) print ast ==
-    /arraytype ast type ne { %if not a list
+    ast _list? not { %if not a list
         ast env eval_ast
     }{ %else apply the list
         /a0 ast 0 get def
@@ -74,12 +74,8 @@ end } def
                 /ENV    exch def % closed over above, pos 3
                 /AST    exch def % closed over above, pos 2
                 /PARAMS exch def % closed over above, pos 1
+                pop % remove the type
                 /args   exch def
-                %(inside fn*:\n) print
-                %(  A1: ) print A1 ==
-                %(  A2: ) print A2 ==
-                %(  ENV: ) print ENV ==
-                %(  args: ) print args ==
                 AST   ENV PARAMS args env_new   EVAL
             end }
             dup length array copy cvx % make an actual copy/new instance
@@ -90,7 +86,6 @@ end } def
             /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
@@ -130,6 +125,8 @@ types_ns { _ref } forall
     } stopped {
         (Error: ) print
         get_error_data false _pr_str print (\n) print
+        $error /newerror false put
+        $error /errorinfo null put
         clear
     } if
 } bind loop
diff --git a/ps/step5_tco.ps b/ps/step5_tco.ps
index 5209a14..0984a8f 100644
--- a/ps/step5_tco.ps
+++ b/ps/step5_tco.ps
@@ -13,9 +13,9 @@
     /env exch def
     /ast exch def
     %(eval_ast: ) print ast ==
-    /nametype ast type eq { %if symbol
+    ast _symbol? { %if symbol
         env ast env_get
-    }{ /arraytype ast type eq { %elseif list
+    }{ ast _list? { %elseif list
         [
             ast {
                 env EVAL
@@ -34,7 +34,7 @@ end } def
     /loop? false def
 
     %(EVAL: ) print ast ==
-    /arraytype ast type ne { %if not a list
+    ast _list? not { %if not a list
         ast env eval_ast
     }{ %else apply the list
         /a0 ast 0 get def
@@ -84,12 +84,8 @@ end } def
                 /ENV    exch def % closed over above, pos 3
                 /AST    exch def % closed over above, pos 2
                 /PARAMS exch def % closed over above, pos 1
+                pop % remove the type
                 /args   exch def
-                %(inside fn*:\n) print
-                %(  A1: ) print A1 ==
-                %(  A2: ) print A2 ==
-                %(  ENV: ) print ENV ==
-                %(  args: ) print args ==
                 AST   ENV PARAMS args env_new   EVAL
             end }
             dup length array copy cvx % make an actual copy/new instance
@@ -108,7 +104,6 @@ end } def
             }{ %else (regular procedure/function)
                 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
@@ -152,6 +147,8 @@ types_ns { _ref } forall
     } stopped {
         (Error: ) print
         get_error_data false _pr_str print (\n) print
+        $error /newerror false put
+        $error /errorinfo null put
         clear
     } if
 } bind loop
diff --git a/ps/step6_file.ps b/ps/step6_file.ps
index 24e5b4c..70c1357 100644
--- a/ps/step6_file.ps
+++ b/ps/step6_file.ps
@@ -13,9 +13,9 @@
     /env exch def
     /ast exch def
     %(eval_ast: ) print ast ==
-    /nametype ast type eq { %if symbol
+    ast _symbol? { %if symbol
         env ast env_get
-    }{ /arraytype ast type eq { %elseif list
+    }{ ast _list? { %elseif list
         [
             ast {
                 env EVAL
@@ -34,7 +34,7 @@ end } def
     /loop? false def
 
     %(EVAL: ) print ast ==
-    /arraytype ast type ne { %if not a list
+    ast _list? not { %if not a list
         ast env eval_ast
     }{ %else apply the list
         /a0 ast 0 get def
@@ -84,12 +84,8 @@ end } def
                 /ENV    exch def % closed over above, pos 3
                 /AST    exch def % closed over above, pos 2
                 /PARAMS exch def % closed over above, pos 1
+                pop % remove the type
                 /args   exch def
-                %(inside fn*:\n) print
-                %(  A1: ) print A1 ==
-                %(  A2: ) print A2 ==
-                %(  ENV: ) print ENV ==
-                %(  args: ) print args ==
                 AST   ENV PARAMS args env_new   EVAL
             end }
             dup length array copy cvx % make an actual copy/new instance
@@ -108,7 +104,6 @@ end } def
             }{ %else (regular procedure/function)
                 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
@@ -145,10 +140,12 @@ types_ns { _ref } forall
 /stdin (%stdin) (r) file def 
 
 userdict /ARGUMENTS known { %if command line arguments
-    ARGUMENTS {
-        (\(load-file ") exch ("\)) concatenate concatenate RE pop
-    } forall
-    quit
+    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
@@ -164,6 +161,8 @@ userdict /ARGUMENTS known { %if command line arguments
     } stopped {
         (Error: ) print
         get_error_data false _pr_str print (\n) print
+        $error /newerror false put
+        $error /errorinfo null put
         clear
     } if
 } bind loop
diff --git a/ps/step7_quote.ps b/ps/step7_quote.ps
new file mode 100644
index 0000000..91cd803
--- /dev/null
+++ b/ps/step7_quote.ps
@@ -0,0 +1,203 @@
+(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
+
+/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 ==
+    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
+            } for
+            a2 let_env EVAL
+        }{ /quote a0 eq { %if quote
+            ast 1 get
+        }{ /quasiquote a0 eq { %if quasiquote
+            ast 1 get quasiquote   env EVAL
+        }{ /do a0 eq { %if do
+            ast length 2 ge { %if ast has more than 2 elements
+                ast 1 ast length 1 sub getinterval env eval_ast
+            } 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 (a3) provided
+                    ast 3 get env % new ast is false branch (a3)
+                    /loop? true def
+                }{
+                    null
+                } ifelse
+            }{
+                ast 2 get env % new ast is true branch (a2)
+                /loop? true def
+            } ifelse
+        }{ /fn* a0 eq { %if fn*
+            /a1 ast 1 get def
+            /a2 ast 2 get def
+            {   /user_defined  % mark this as user defined
+                __PARAMS__ __AST__ __ENV__ % closed over variables
+                4 dict begin
+                /ENV    exch def % closed over above, pos 3
+                /AST    exch def % closed over above, pos 2
+                /PARAMS exch def % closed over above, pos 1
+                pop % remove the type
+                /args   exch def
+                AST   ENV PARAMS args env_new   EVAL
+            end }
+            dup length array copy cvx % make an actual copy/new instance
+            dup 1 a1 put  % insert closed over a1 into position 1
+            dup 2 a2 put  % insert closed over a2 into position 2
+            dup 3 env put % insert closed over env into position 3
+        }{
+            /el ast env eval_ast def
+            el _first 0 get /user_defined eq { %if userdefined function
+                /PARAMS el _first 1 get def
+                /AST    el _first 2 get def
+                /ENV    el _first 3 get def
+                AST % new ast is one stored in function
+                ENV PARAMS el _rest env_new % new environment 
+                /loop? true def
+            }{ %else (regular procedure/function)
+                el _rest % args array
+                el _first cvx % function
+                exec % apply function to args
+            } 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
+
+(\(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
diff --git a/ps/types.ps b/ps/types.ps
index 0e530b5..a830108 100644
--- a/ps/types.ps
+++ b/ps/types.ps
@@ -113,9 +113,16 @@ end } def
     } ifelse
 end } def
 
+%
+% Symbols
+%
+/_symbol? {
+    type /nametype eq
+} def
+
 
 %
-% errors/exceptions
+% Errors/Exceptions
 %
 
 % data -> throw ->
@@ -160,6 +167,9 @@ end } def
 %
 % list operations
 %
+/_list {
+    array astore
+} def
 /_list? {
     dup xcheck not exch type /arraytype eq and
 } def
@@ -167,6 +177,18 @@ end } def
 /_rest { dup length 1 sub 1 exch getinterval } def
 /_nth { get } def
 
+/_cons {
+    /lst exch def
+    /elem exch def
+    lst length 1 add array
+    dup 0 elem put % first element
+    dup 1 lst putinterval % rest of the elements
+} def
+
+/_concat {
+    concatenate
+} def
+
 
 %
 % Env implementation
@@ -246,8 +268,10 @@ end } def
     (-)       { dup 0 get exch 1 get sub }
     (*)       { dup 0 get exch 1 get mul }
     (/)       { dup 0 get exch 1 get idiv }
-    (list)    { }
+    (list)    { dup pop } % noop
     (list?)   { 0 get _list? }
+    (cons)    { dup 0 get exch 1 get _cons }
+    (concat)  { dup 0 get exch 1 get _concat }
     (empty?)  { 0 get length 0 eq }
     (count)   { 0 get length }
 >> def