From e382e2fb1adfce7d3606a7946076a0d7b775fc7e Mon Sep 17 00:00:00 2001
From: d6 <d_m@plastic-idolatry.com>
Date: Thu, 8 Dec 2022 00:33:04 -0500
Subject: [PATCH] parsing progress

---
 hoax.tal | 148 ++++++++++++++++++++++++++++++++++++++++++-------------
 1 file changed, 114 insertions(+), 34 deletions(-)

diff --git a/hoax.tal b/hoax.tal
index 0e942a1..26e012c 100644
--- a/hoax.tal
+++ b/hoax.tal
@@ -112,29 +112,30 @@
     ( 04 comment )
     @state $1
     @stack $2
-    @buffer [ &pos $1 &input $40 ] ( max symbol size 64 )
+    @buffer [ &pos $2 &input $40 ] ( max symbol size 64 )
 
 |0100
     ;init-hoax JSR2
     #00 .state STZ
-    ;on-key #10 DEO2
-    ;reset-input JSR2
+    ;buf-reset JSR2
+    ;on-key-ready #10 DEO2
+(    ;reset-input JSR2 )
     ;demo JSR2
 (    DEBUG EXIT )
     BRK
 
-@reset-input ( -> )
+( @reset-input ( -> )
     #0000 #0000 ;cons JSR2      ( pair$ )
     .stack STZ2                 ( ; stack<-pair )
-    JMP2r
+    JMP2r )
 
-@complete-with ( v$ -> )
+( @complete-with ( v$ -> )
     .stack LDZ2                 ( v$ stack$ )
     STH2k SWP2 ;car! JSR2       ( [stack] ; car(stack)<-v )
     #0000 STH2r ;cons JSR2      ( cell$ )
-    .stack STZ2                 ( stack<- )
+    .stack STZ2                 ( stack<- ) )
 
-@start-list ( -> )
+( @start-list ( -> )
     #0000 .stack LDZ2           ( 0000 stack$ )
     ;cons JSR2                  ( pair$ )
     DUP2 .stack STZ2            ( pair$ ; stack<-pair )
@@ -146,39 +147,118 @@
     POP2 STH2r                  ( cell$ [a^] )
     INCr INCr STHkr             ( cell$ a+2^ [a+2^] )
     STZ2 STHr .stack/pos STZ    ( ; pos<-a+2 )
+    JMP2r )
+
+( @end-list ( -> )
+    ;stack/pos LDA2k LDA2 ( pos* elem$ )
+    STH2 #0004 SUB2       ( pos-4* [elem$] ) )
+
+
+@buf-end ( -> )
+    #00 ;buffer/pos LDA2 STA       ( ; addr<-00 )
+@buf-reset
+    ;buffer/input ;buffer/pos STA2 ( ; pos<-start )
     JMP2r
 
-@end-list ( -> )
-    ;stack/pos LDA2k LDA2 ( pos* elem$ )
-    STH2 #0004 SUB2       ( pos-4* [elem$] )
+@buf-add ( c -> )
+    ;buffer/pos LDA2 STAk ( c^ addr* )
+    INC2 ;buffer/pos STA2 ( c^ ; pos<-addr+1 )
+    POP JMP2r             ( )
 
+@start-list ( c -> )
+    ;echo JSR2 "start 20 "list 0a 00 POP BRK
 
-@on-key-start ( -> )
+@end-list ( c -> )
+    ;echo JSR2 "end 20 "list 0a 00 POP BRK
+
+@start-string ( c -> )
+    ;on-key-string #10 DEO2
+    ;echo JSR2 "start 20 "string 0a 00 POP BRK
+
+@append-string ( c -> )
+    ;echo JSR2 "append 20 "string 20 00
+    DUP #18 DEO NL
+    ;buf-add JSR2 BRK
+
+@end-string ( c -> )
+    ;on-key-ready #10 DEO2
+    ;echo JSR2 "end 20 "string 0a 00 POP
+    ;buf-end JSR2
+    ;buffer/input ;print JSR2 NL
+    BRK
+
+@start-word ( c -> )
+    ;on-key-word #10 DEO2
+    ;echo JSR2 "start 20 "word 20 00
+    DUP #18 DEO NL
+    ;buf-add JSR2 BRK
+
+@append-word ( c -> )
+    ;echo JSR2 "append 20 "word 20 00
+    DUP #18 DEO NL
+    ;buf-add JSR2 BRK
+
+@end-word0 ( c -> )
+    ;on-key-ready #10 DEO2
+    ;echo JSR2 "end 20 "word 0a 00 POP
+    ;buf-end JSR2
+    ;buffer/input ;print JSR2 NL
+    JMP2r
+
+@start-escape ( c -> )
+    ;on-key-escaped #10 DEO2
+    ;echo JSR2 "start 20 "escape 0a 00 POP BRK
+
+( TODO: more sophisticated escapes )
+@on-key-escaped ( -> )
+    ;on-key-string #10 DEO2
+    #12 DEI ;append-string JMP2
+
+( string state means we're inside a string literal )
+( waiting to see an unecaped closing double quote )
+@on-key-string ( -> )
     #12 DEI
-    DUP #09 EQU ,&skip JCN ( tab )
-    DUP #0a EQU ,&skip JCN ( nl )
-    DUP #0d EQU ,&skip JCN ( cr )
-    DUP #20 EQU ,&skip JCN ( sp )
-    DUP #20 LTH ,&control JCN ( control chars )
-    DUP #7e GTH ,&control JCN ( delete + 8bit )
-    DUP #28 EQU ,start-list JCN ( lpar )
-    DUP #29 EQU ,&rpar JCN ( rpar )
-                ,&printable JMP
+    DUP #5c EQU ;start-escape JCN2 ( backslash )
+    DUP #22 EQU ;end-string JCN2 ( dquote )
+                ;append-string JMP2
 
-    &rpar
+( word state means we're in a word until whitespace )
+@on-key-word ( -> )
+    #12 DEI
+    DUP #29 EQU ,&end JCN ( rpar )
+    DUP #09 EQU ,&space JCN ( tab )
+    DUP #0a EQU ,&space JCN ( nl )
+    DUP #0d EQU ,&space JCN ( cr )
+    DUP #20 EQU ,&space JCN ( sp )
+    DUP #20 LTH ,&skip JCN ( control chars )
+    DUP #7e GTH ,&skip JCN ( delete + 8bit )
+                ;append-word JMP2
+    &skip
+        ;echo JSR2 "skipped 0a 00 POP BRK
+    &space
+        ;end-word0 JSR2
+        ;echo JSR2 "whitespace 0a 00 BRK
+    &end
+        ;end-word0 JSR2
+        #00 ;end-list JMP2
 
-
-    &skip POP BRK
-    &control POP BRK ( todo )
-    &printable
-
-@on-key ( -> )
-    .state LDZ #00 EQU ,on-key-start JCN
-    .state LDZ #01 EQU ,on-key-symbol JCN
-    .state LDZ #02 EQU ,on-key-string JCN
-    .state LDZ #03 EQU ,on-key-escape JCN
-    .state LDZ #04 EQU ,on-key-comment JCN
-    #0000 DIV
+( ready state means we are expecing a complete value )
+@on-key-ready ( -> )
+    #12 DEI
+    DUP #28 EQU ;start-list JCN2 ( lpar )
+    DUP #29 EQU ;end-list JCN2 ( rpar )
+    DUP #22 EQU ;start-string JCN2 ( dquote )
+    DUP #09 EQU ,&space JCN ( tab )
+    DUP #0a EQU ,&space JCN ( nl )
+    DUP #0d EQU ,&space JCN ( cr )
+    DUP #20 EQU ,&space JCN ( sp )
+    DUP #20 LTH ,&skip JCN ( control chars )
+    DUP #7e GTH ,&skip JCN ( delete + 8bit )
+                ;start-word JMP2
+    &space
+        ;echo JSR2 "whitespace 0a 00 POP BRK
+    &skip
+        ;echo JSR2 "skipped 0a 00 POP BRK
 
 (    #12 DEI #0a EQU ,&newline JCN
         #12 DEI ;buffer/pos LDA2 STAk ( c pos ; addr<-c )