duskos

commit fcbb5efe862b8e8e98ae6edd7817d0aa5a6e992f
parent 9fe01e30306100af8853b32db277b538bdd18978
Author: Virgil Dupras <hsoft@hardcoded.net>
Date:   Thu,  9 Jun 2022 21:55:38 -0400

cc: begin simplifying ast.fs

My previous approach was too complicated. Let's unwind it to something simpler.

Diffstat:
M
fs/cc/ast.fs
 | 
113
++++++++++++++++++++++++++++++++++---------------------------------------------

1 file changed, 48 insertions(+), 65 deletions(-)
diff --git a/fs/cc/ast.fs b/fs/cc/ast.fs
@@ -65,11 +65,9 @@ create astidnames 7 c, ," declare"  4 c, ," unit"     8 c, ," function"
 
 0 value curunit \ points to current Unit, the beginning of the AST
 0 value activenode \ node we're currently adding to
-0 value _skip \ if 1, skip the next "nextt" in parseast
 
 : astid ( node -- id ) nodeid $3f and ;
 : idname ( id -- str ) astidnames slistiter ;
-: skipnext 1 to _skip ;
 \ is currently active node empty?
 : activeempty? ( -- f ) activenode firstchild not ;
 : seqclose ( -- )
@@ -152,12 +150,6 @@ ASTIDCNT wordtbl astdatatbl ( node -- node )
 : expectChar ( tok c -- )
   over 1+ c@ = _assert dup c@ 1 = _assert drop ;
 
-\ Search the given token in a string list. if found, run the corresponding word
-\ in optbl. Otherwise, parse error.
-: tokenfromlist ( tok list optbl -- )
-  >r ( tok list R:optbl ) over swap sfind ( tok idx )
-  tuck 0>= _assert ( idx tok ) drop r> swap wexec ;
-
 \ The binopswap operation is funky. It happens when we want to add a binop that
 \ "eats up" the preceding node. There are 3 scenarios.
 \ 1. the preceding sibling (let's call it the target node) is not a binop.
@@ -175,37 +167,22 @@ ASTIDCNT wordtbl astdatatbl ( node -- node )
   swap removenode to activenode ( bopid tgt )
   swap BinaryOp ( tgt ) activenode addnode ;
 
-\ Parse words. Each of those words have the signature "tok -- ".
-\ Some words call "skipnext" to skip the next "nextt" call. In that case, the
-\ signature is "tok -- tok".
-\ To be clear on the semantics, the word represents the *context*, not the
-\ node being parsed. For example, in "Function", we're not parsing the
-\ Function AST node, but we're parsing its *children*.
-
-create StatementsTList 1 c, ," }" 6 c, ," return" 3 c, ," int" 0 c,
-3 wordtbl StatementsOps ( -- )
-'w seqclose ( } )
-:w ( return ) Return Expression ;
-:w ( int ) DeclarationList ;
-
-ASTIDCNT wordtbl astparsetbl
-:w ( Declare )
-  '=' expectChar activenode data1 Assign Expression ;
-:w ( Unit ) isType? _assert _nextt expectIdent Function ;
-:w ( Function ) activenode cslots 2 = if
-    '(' expectChar ArgSpecs else
-    '{' expectChar Statements then ;
-'w _err ( Return )
-'w _err ( Constant )
-:w ( Statements ) StatementsTList StatementsOps tokenfromlist ;
-:w ( ArgSpecs )
-  dup S" )" s= if drop seqclose exit then
-  begin ( tok )
-    expectType drop _nextt expectIdent Declare seqclose
-    _nextt dup S" )" s= if drop seqclose exit then
-    ',' expectChar _nextt again ;
-:w ( Expression )
-  activeempty? if dup uopid if UnaryOp drop exit then then
+\ New parse words
+
+: parseFactor ( tok -- nexttok )
+  dup isIdent? if \ Variable or FunCall
+    _nextt ( prevtok newtok ) dup S" (" s= if \ FunCall
+      drop FunCall _nextt ')' expectChar _nextt
+    else \ Variable
+      swap Variable ( nexttok ) then
+  else \ Constant
+    expectConst Constant _nextt then
+  seqclose ;
+
+: parseExpression ( tok -- )
+  dup S" ;" s= if drop AST_STATEMENTS closeuntil exit then
+  activeempty? if dup uopid if
+    UnaryOp drop Factor _nextt parseFactor parseExpression exit then then
   dup bopid if ( tok binopid )
     swap activeempty? if _err then \ can't start an expression with a binop
     ( bopid tok ) drop
@@ -213,30 +190,36 @@ ASTIDCNT wordtbl astparsetbl
       ( bopid tgt ) 2dup data1 bopprec swap bopprec > if ( bopid tgt )
         \ new binop has a higher precedence, steal right operand!
         firstchild nextsibling then then
-    binopswap exit then
-  skipnext Factor ;
-:w ( UnaryOp ) skipnext Factor ;
-:w ( Factor )
-  dup isIdent? if \ Variable or FunCall
-    _nextt ( prevtok newtok ) dup S" (" s= if \ FunCall
-      drop FunCall _nextt ')' expectChar
-    else \ Variable
-      skipnext swap Variable then
-  else \ Constant
-    expectConst Constant then
-  seqclose ;
-:w ( BinaryOp ) skipnext Factor ;
-'w _err ( Assign )
-:w ( DeclarationList )
-  expectIdent Declare ;
-'w _err ( Variable )
-'w _err ( FunCall )
-
-: parseast ( -- ) Unit begin
-    _skip if 0 to _skip else nextt ?dup not if exit then then
-    \ When we encounter a ;, we always close all nodes until we hit a Statements
-    \ element.
-    dup S" ;" s= if drop AST_STATEMENTS closeuntil else
-      astparsetbl activenode astid wexec then
-  again ;
+    binopswap Factor _nextt parseFactor parseExpression exit then
+  Factor parseFactor parseExpression ;
 
+: parseDeclare ( tok -- )
+  '=' expectChar activenode data1 Assign Expression _nextt parseExpression ;
+
+: parseDeclarationList ( tok -- ) expectIdent Declare _nextt parseDeclare ;
+
+: parseArgSpecs ( tok -- )
+  dup S" )" s= if drop seqclose exit then
+  begin ( tok )
+    expectType drop _nextt expectIdent Declare seqclose
+    _nextt dup S" )" s= if drop seqclose exit then
+    ',' expectChar _nextt again ;
+
+: parseStatements ( tok -- )
+  begin ( tok )
+    dup S" }" s= if drop seqclose exit then
+    dup S" return" s= if
+      drop Return Expression _nextt parseExpression else
+      expectType drop _nextt parseDeclarationList then
+    _nextt again ;
+
+: parseFunction ( tok -- )
+  '(' expectChar ArgSpecs _nextt parseArgSpecs _nextt
+  '{' expectChar Statements _nextt parseStatements ;
+
+: parseUnit ( -- )
+  nextt ?dup not if exit then begin ( tok )
+    isType? _assert _nextt expectIdent Function _nextt parseFunction
+    nextt ?dup not until ;
+
+: parseast ( -- ) Unit parseUnit ;