commit 9961fac9d849d9ec27757d80aef544957052835a
parent 93ff71f54c74b8d5e26f93085b0fd9d3e5a311fd
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Fri, 10 Jun 2022 11:37:09 -0400
cc: complete overhaul of parseExpression
whew, that was a big one!
Diffstat:
3 files changed, 51 insertions(+), 52 deletions(-)
diff --git a/fs/cc/ast.fs b/fs/cc/ast.fs
@@ -47,7 +47,7 @@ create bopsprectbl 1 c, 1 c, 0 c, 0 c, 2 c, 2 c, 2 c, 2 c,
4 value AST_CONSTANT \ data1=value
5 value AST_STATEMENTS
6 value AST_ARGSPECS
-7 value AST_EXPRESSION
+\ 7 = unused
8 value AST_UNARYOP \ data1=uopid
\ 9 = unused
10 value AST_BINARYOP \ data1=bopid
@@ -89,7 +89,7 @@ ASTIDCNT wordtbl astdatatbl ( node -- node )
'w _i ( Constant )
'w noop ( Statements )
'w noop ( ArgSpecs )
-'w noop ( Expression )
+'w noop ( Unused )
:w ( UnaryOp ) _[ dup data1 uopchar emit _] ;
'w noop ( Unused )
:w ( BinaryOp ) _[ dup data1 boptoken stype _] ;
@@ -120,11 +120,10 @@ ASTIDCNT wordtbl astdatatbl ( node -- node )
: Unit ( -- node ) -1 AST_UNIT createnode dup to curunit dup to activenode ;
: Function ( unitnode name -- node )
swap 2 AST_FUNCTION newnode2 swap , 0 , ;
-: Return ( -- ) 1 AST_RETURN newnode ;
+: Return ( -- ) -1 AST_RETURN newnode ;
: Constant ( parent n -- ) swap 0 AST_CONSTANT newnode2 drop , ;
: Statements ( funcnode -- node ) -1 AST_STATEMENTS newnode2 ;
: ArgSpecs ( funcnode -- node ) -1 AST_ARGSPECS newnode2 ;
-: Expression ( -- ) -1 AST_EXPRESSION newnode ;
: UnaryOp ( parentnode opid -- ) swap 1 AST_UNARYOP newnode2 swap , ;
: BinaryOp ( opid -- node ) 2 AST_BINARYOP newnode , ;
: Assign ( name -- ) 1 AST_ASSIGN newnode , ;
@@ -153,57 +152,55 @@ ASTIDCNT wordtbl astdatatbl ( node -- node )
\ Parse words
\ parse a constant, variable or function call
-: parseFactor ( parentnode tok -- nexttok )
+: parseFactor ( tok -- node nexttok )
dup isIdent? if \ Variable or FunCall
- _nextt ( pn prevtok newtok ) dup S" (" s= if \ FunCall
- drop FunCall _nextt ')' expectChar _nextt
+ _nextt ( prevtok newtok ) dup S" (" s= if \ FunCall
+ drop 0 AST_FUNCALL createnode swap , _nextt ')' expectChar _nextt
else \ Variable
- rot> Variable ( nexttok ) then
+ swap ( newtok prevtok ) 0 AST_VARIABLE createnode swap , swap then
else \ Constant
- expectConst Constant _nextt then ;
-
-: parseUnaryOp ( parentnode uopid -- nexttok )
- UnaryOp _nextt parseFactor ;
-
-\ 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.
-\ We want our binop to take its place and have the number be the first
-\ operand of our new binop.
-\ 2. The preceding node is a binop with a lower precedence than our new
-\ binop. In this case, we want to "steal" the second operator from the first
-\ binop and place the new binop "under" the old binop as the second operator.
-\ the "target" is the second operand of the old binop.
-\ 3. The preceding node is a binop with a higher precedence than our new
-\ binop. Like in scenario 1, we want to take its place. the target is the
-\ old binop.
-: binopswap ( bopid target -- )
- dup dup parentnode ( op tgt tgt parent )
- swap removenode to activenode ( bopid tgt )
- swap BinaryOp ( tgt ) activenode addnode ;
-
-: parseBinaryOp ( parentnode bopid -- nexttok )
- over lastchild ( pn bopid prev ) dup astid AST_BINARYOP = if
- ( pn bopid tgt ) 2dup data1 bopprec swap bopprec > if ( pn bopid tgt )
- \ new binop has a higher precedence, steal right operand!
- firstchild nextsibling then then
- binopswap lastchild _nextt parseFactor ;
-
-: parseExpression ( parent tok -- )
- swap to activenode begin ( tok )
- dup S" ;" s= if drop seqclose exit then
- dup uopid activeempty? and if \ unaryop
- nip activenode swap parseUnaryOp
- else \ not unaryop
- dup bopid if ( tok binopid )
- swap activeempty? if _err then \ can't start an expression with a binop
- ( bopid tok ) drop activenode swap parseBinaryOp
- else \ not binop
- activenode swap parseFactor then then
- again ;
+ expectConst 0 AST_CONSTANT createnode swap , _nextt then ;
+
+\ An expression can be 3 things:
+\ 1. a factor
+\ 2. an unaryop containing an expression
+\ 3. A binaryop containing two expressions.
+: parseExpression ( tok -- exprnode nexttok )
+ dup uopid if ( tok uopid )
+ nip -1 AST_UNARYOP createnode ( uopid node ) swap , ( node )
+ _nextt parseExpression ( uopnode expr tok )
+ rot> over addnode swap ( node tok )
+ else ( tok ) \ binaryop or factor
+ \ tok is expected to be a factor
+ parseFactor ( factor nexttok )
+ dup bopid if ( factor tok binop )
+ nip ( factor binop ) -1 AST_BINARYOP createnode swap , ( factor node )
+ tuck addnode _nextt ( binnode tok )
+ \ now, let's consume tokens as long as we have binops coming.
+ begin ( bn tok )
+ parseFactor ( bn factor tok ) dup bopid if ( bn fn tok bopid )
+ nip -1 AST_BINARYOP createnode swap , ( bn1 fn bn2 )
+ \ another binop! who will get fn? bn1 or bn2? the one that has the
+ \ best precedence!
+ rot ( fn bn2 bn1 ) over data1 bopprec over data1 bopprec < if
+ \ bn2 wins. add fn to bn2, add bn2 to bn1, bn2 becomes bn
+ rot> tuck addnode ( bn1 bn2 ) dup rot addnode ( bn2->bn )
+ else \ bn1 wins. add fn to bn1, bn1 to bn2, bn2 becomes bn
+ rot over addnode ( bn2 bn1 ) over addnode ( bn2->bn )
+ then ( bn )
+ _nextt 0 ( bn tok 0 )
+ else ( bn fn tok ) \ not a binop
+ \ tok becomes nexttok and we add fn to bn to complete the chain
+ rot> over addnode swap 1 ( bn tok 1 ) then
+ until ( bn tok )
+ \ nb is not necessarily our result, the root node is.
+ swap rootnode swap
+ then \ if not binop we have nothing to do, we're done
+ then ;
: parseDeclare ( tok -- )
- '=' expectChar activenode data1 Assign Expression activenode _nextt parseExpression ;
+ '=' expectChar activenode data1 Assign
+ _nextt parseExpression ';' expectChar activenode addnode seqclose ;
: parseDeclarationList ( stmtsnode -- )
_nextt expectIdent Declare to activenode _nextt parseDeclare ;
@@ -221,7 +218,9 @@ ASTIDCNT wordtbl astdatatbl ( node -- node )
begin ( tok )
dup S" }" s= if drop exit then
dup S" return" s= if
- drop Return Expression activenode _nextt parseExpression else
+ drop Return _nextt parseExpression ';' expectChar
+ activenode addnode seqclose
+ else
expectType drop activenode parseDeclarationList then
_nextt again ;
diff --git a/fs/cc/tree.fs b/fs/cc/tree.fs
@@ -41,6 +41,7 @@
: data3! ( n node -- ) 'data 8 + ! ;
: data4 ( node -- n ) 'data 12 + @ ;
: data4! ( n node -- ) 'data 12 + ! ;
+: rootnode ( n -- n ) dup parentnode if parentnode rootnode then ;
\ iterate to the next node, descending into children before continuing to
\ siblings. we stop when we reach the last child of "ref"
: nextnode ( ref node -- ref next )
diff --git a/fs/tests/ccast.fs b/fs/tests/ccast.fs
@@ -10,7 +10,6 @@ curunit firstchild dup astid AST_FUNCTION #eq ( fnode )
dup data1 s s= #
firstchild nextsibling dup astid AST_STATEMENTS #eq ( snode )
firstchild dup astid AST_RETURN #eq ( rnode )
-firstchild ( expr )
firstchild dup astid AST_CONSTANT #eq ( cnode )
data1 42 #eq
testend
