PS: minimal step1_read_print

3 files changed, 290 insertions, 0 deletions

diff --git a/ps/reader.ps b/ps/reader.ps
new file mode 100644
index 0000000..4be0c0f
--- /dev/null
+++ b/ps/reader.ps
@@ -0,0 +1,179 @@
+(in reader\n) print
+
+
+/token_delim (;,"` \n{}\(\)[]) def
+/token_number (0123456789-) def
+
+% read_number: read a single number from string/idx
+% string idx -> read_number -> number string new_idx
+/read_number {
+    %(in read_number\n) print
+    /idx exch def
+    /str exch def
+    /start idx def
+    /cnt 0 def
+    { % loop
+        idx str length ge { exit } if % EOF, break loop
+        /ch str idx get def  % current character
+        ch 48 ge ch 57 le and 45 ch eq or { %if number
+            /cnt cnt 1 add def
+        }{ % else
+            exit
+        } ifelse
+        /idx idx 1 add def % increment idx
+    } loop
+
+    str start cnt getinterval cvi % the matched number
+    str idx % return: number string new_idx
+} def
+
+
+% read_symbol: read a single symbol from string/idx
+% string idx -> read_symbol -> name string new_idx
+/read_symbol {
+    %(in read_symbol\n) print
+    /idx exch def
+    /str exch def
+    /start idx def
+    /cnt 0 def
+    { % loop
+        idx str length ge { exit } if % EOF, break loop
+        /ch str idx 1 getinterval def
+        token_delim ch search { % if token delimeter
+            pop pop pop exit
+        }{ % else not a delim
+            pop
+            /cnt cnt 1 add def
+        } ifelse
+        /idx idx 1 add def % increment idx
+    } loop
+
+    str start cnt getinterval cvn % the matched symbol
+    str idx % return: symbol string new_idx
+} def
+
+
+% read_string: read a single string from string/idx
+% string idx -> read_string -> new_string string new_idx
+/read_string {
+    %(in read_string\n) print
+    /idx exch 1 add def
+    /str exch def
+    /start idx def
+    /cnt 0 def
+    { % loop
+        idx str length ge { %if EOF
+            (Error: unexpected EOF reading string\n) print
+            error
+        } if
+        /ch str idx get def  % current character
+        /idx idx 1 add def
+        ch 34 eq { exit } if % '"' is end of string
+        /cnt cnt 1 add def
+    } loop
+    str start cnt getinterval % the matched string
+    str idx % return: new_string string new_idx
+} def
+
+
+% read_atom: read a single atom from string/idx
+% string idx -> read_atom -> int string new_idx
+/read_atom {
+    %(in read_atom\n) print
+    /idx exch def
+    /str exch def
+    str length idx le { % ifelse
+        exit % EOF
+    }{
+        /ch str idx get def  % current character
+        ch 48 ge ch 57 le and 45 ch eq or { %if number
+            str idx read_number
+        }{ ch 34 eq { %elseif double-quote
+            str idx read_string
+        }{
+            str idx read_symbol
+            /idx exch def pop
+            dup /nil eq { %if nil
+                pop null str idx
+            }{ dup /true eq { %elseif true
+                pop true str idx
+            }{ dup /false eq { %elseif false
+                pop false str idx
+            }{ %else
+                str idx % return the original symbol/name
+            } ifelse } ifelse } ifelse
+        } ifelse } ifelse
+    }ifelse
+
+    % return: atom string new_idx
+} def
+
+% read_list: read a single list from string/idx
+% string idx -> read_list -> list string new_idx
+/read_list {
+    %(in read_list\n) print
+    /idx exch 1 add def
+    /str exch def
+    [
+    { % loop
+        str idx read_spaces /idx exch def pop
+        str length idx le { %if EOF
+            (Error: unexpected EOF reading list\n) print
+            error
+        } if
+        /ch str idx get def  % current character
+        ch 41 eq { exit } if % ')' is end of list
+        str idx read_form /idx exch def pop
+    } loop
+    ]
+    str idx 1 add
+} def
+
+% read_spaces: advance idx to the first non-whitespace
+% string idx -> read_form -> string new_idx
+/read_spaces {
+    %(in read_spaces\n) print
+    /idx exch def
+    /str exch def
+    { % loop
+        str length idx le { exit } if % EOF, break loop
+        /ch str idx get def  % current character
+        % if not whitespace then exit
+        ch 32 ne ch 10 ne ch 44 ne and and { exit } if
+        /idx idx 1 add def % increment idx
+    } loop
+
+    str idx % return: string new_idx
+} def
+
+% read_form: read the next form from string start at idx
+% string idx -> read_form -> ast string new_idx
+/read_form {
+    %(in read_form\n) print
+    read_spaces
+    /idx exch def
+    /str exch def
+
+    idx str length ge { exit } if % EOF, break loop
+    /ch str idx get def  % current character
+    ch 40 eq { %if (
+        str idx read_list
+    }{ % else
+        str idx read_atom
+    } ifelse
+
+    %(stack vvv\n) print
+    %pstack
+    %(stack ^^^\n) print
+
+    % return: ast string new_idx
+} def
+
+% string -> read_str -> ast
+/read_str {
+    %(in read_str\n) print
+    0  % current index into the string
+    read_form
+
+    pop pop  % drop the string, idx. return: ast
+} def
diff --git a/ps/step1_read_print.ps b/ps/step1_read_print.ps
new file mode 100644
index 0000000..8c54012
--- /dev/null
+++ b/ps/step1_read_print.ps
@@ -0,0 +1,48 @@
+(types.ps) run
+(reader.ps) run
+
+% read
+/READ {
+    /str exch def
+    str read_str
+} def
+
+
+% eval
+/EVAL {
+    % just "return" the "ast"
+    /env exch def
+    /ast exch def
+    ast
+} def
+
+
+% print
+/PRINT {
+    /exp exch def
+    %(printing: ) print exp ==
+    exp pr_str
+} def
+
+
+% repl
+/REP {
+    READ (stub env) EVAL PRINT
+} def
+
+/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
+    REP print (\n) print
+} bind loop
+
+(\n) print  % final newline before exit for cleanliness
+quit
diff --git a/ps/types.ps b/ps/types.ps
new file mode 100644
index 0000000..a9d5023
--- /dev/null
+++ b/ps/types.ps
@@ -0,0 +1,63 @@
+(in types.ps\n) print
+
+/MAX_SYM_SIZE 256
+
+% concatenate: concatenate two strings or two arrays
+% From Thinking in PostScript 1990 Reid
+% (string1) (string2) concatenate string3
+% array1 array2 concatenate array3
+/concatenate { %def
+    dup type 2 index type 2 copy ne { %if
+        pop pop
+        errordict begin (concatentate) typecheck end
+    }{ %else
+        /stringtype ne exch /arraytype ne and {
+            errordict begin (concatenate) typecheck end
+        } if
+    } ifelse
+    dup length 2 index length add 1 index type
+    /arraytype eq { array }{ string } ifelse
+    % stack: arg1 arg2 new
+    dup 0 4 index putinterval
+    % stack: arg1 arg2 new
+    dup 4 -1 roll length 4 -1 roll putinterval
+    % stack: new
+} bind def
+
+/pr_str {
+    %(in pr_str\n) print
+    /obj exch def
+    /arraytype obj type eq { % if list
+        % accumulate an array of strings
+        (\()
+        obj length 0 gt { %if any elements
+            [
+                obj {
+                    pr_str
+                } forall
+            ]
+            { concatenate ( ) concatenate } forall
+            dup length 1 sub 0 exch getinterval % strip off final space
+        } if
+        (\)) concatenate
+    }{ /integertype obj type eq { % if number
+        /slen obj 10 idiv 1 add def
+        obj 10 slen string cvrs
+    }{ /stringtype obj type eq { % if string
+        (") obj (") concatenate concatenate
+    }{ null obj eq { % if nil
+        (nil)
+    }{ true obj eq { % if true
+        (true)
+    }{ false obj eq { % if false
+        (false)
+    }{ /nametype obj type eq { % if symbol
+        obj obj length string cvs
+    }{
+        (<unknown>) 
+    } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse
+
+    %(pr_str2 stack vvv\n) print
+    %pstack
+    %(pr_str2 stack ^^^\n) print
+} def