duskos

commit a0bf382be10b3cda1210a826543c88a2f683839c
parent 92dea750dbe0c60307046301462264cfc8bfb590
Author: Virgil Dupras <hsoft@hardcoded.net>
Date:   Fri, 10 Jun 2022 12:31:15 -0400

cc: cleanup ast.fs some more

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

1 file changed, 22 insertions(+), 27 deletions(-)
diff --git a/fs/cc/ast.fs b/fs/cc/ast.fs
@@ -64,7 +64,6 @@ create astidnames 7 c, ," declare"  4 c, ," unit"     8 c, ," function"
                   0 c,
 
 0 value curunit \ points to current Unit, the beginning of the AST
-0 value activenode \ node we're currently adding to
 
 : astid ( node -- id ) nodeid $3f and ;
 : idname ( id -- str ) astidnames slistiter ;
@@ -101,26 +100,20 @@ ASTIDCNT wordtbl astdatatbl ( node -- node )
       ')' emit then ;
 
 
-: newnode ( parent cslots astid -- newnode )
-  createnode ( parent node ) dup rot addnode ( node ) ;
+: newnode ( parent astid -- newnode )
+  -1 swap createnode ( parent node ) dup rot addnode ( node ) ;
 
 \ AST nodes
 : Declare ( parent name -- node )
-  swap -1 AST_DECLARE newnode swap , ;
-: Unit ( -- node ) -1 AST_UNIT createnode dup to curunit dup to activenode ;
+  swap AST_DECLARE newnode swap , ;
+: Unit ( -- node ) -1 AST_UNIT createnode dup to curunit ;
 : Function ( unitnode name -- node )
-  swap 2 AST_FUNCTION newnode swap , 0 , ;
-: Constant ( parent n -- ) swap 0 AST_CONSTANT newnode drop , ;
-: Statements ( funcnode -- node ) -1 AST_STATEMENTS newnode ;
-: ArgSpecs ( funcnode -- node ) -1 AST_ARGSPECS newnode ;
-: UnaryOp ( parentnode opid -- ) swap 1 AST_UNARYOP newnode swap , ;
-: Variable ( parentnode name -- ) swap 0 AST_VARIABLE newnode drop , ;
-: FunCall ( parentnode name -- ) swap 0 AST_FUNCALL newnode drop , ;
+  swap AST_FUNCTION newnode swap , 0 , ;
+: Statements ( funcnode -- node ) AST_STATEMENTS newnode ;
+: ArgSpecs ( funcnode -- node ) AST_ARGSPECS newnode ;
 
 : _err ( tok -- )
-  stype spc>
-  activenode ?dup if astid .x1 spc> then
-  abort"  parsing error" ;
+  stype spc> abort"  parsing error" ;
 : _assert ( tok f -- ) not if _err then ;
 : _nextt nextt ?dup not if abort" expecting token!" then ;
 
@@ -180,18 +173,19 @@ ASTIDCNT wordtbl astdatatbl ( node -- node )
           \ 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.
+      \ bn 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 _nextt parseExpression ';' expectChar ( expr )
-  -1 AST_ASSIGN createnode activenode data1 ( name ) ,
-  ( expr assign ) tuck addnode activenode addnode ;
+: parseDeclare ( parentnode tok -- )
+  '=' expectChar
+  -1 AST_ASSIGN createnode ( pnode anode ) over data1 ( name ) ,
+   dup rot addnode ( anode )
+  _nextt parseExpression ';' expectChar ( anode expr ) swap addnode ;
 
 : parseDeclarationList ( stmtsnode -- )
-  _nextt expectIdent Declare to activenode _nextt parseDeclare ;
+  _nextt expectIdent Declare _nextt parseDeclare ;
 
 : parseArgSpecs ( funcnode -- )
   _nextt '(' expectChar ArgSpecs _nextt ( argsnode tok )
@@ -202,14 +196,15 @@ ASTIDCNT wordtbl astdatatbl ( node -- node )
     ',' expectChar _nextt again ;
 
 : parseStatements ( funcnode -- )
-  _nextt '{' expectChar Statements to activenode _nextt
-  begin ( tok )
-    dup S" }" s= if drop exit then
+  _nextt '{' expectChar Statements _nextt
+  begin ( snode tok )
+    dup S" }" s= if 2drop exit then
     dup S" return" s= if
-      drop _nextt parseExpression ';' expectChar
-      -1 AST_RETURN createnode tuck addnode activenode addnode
+      drop -1 AST_RETURN createnode ( snode rnode ) 2dup swap addnode
+      _nextt parseExpression ';' expectChar ( snode rnode expr )
+      swap addnode ( snode )
     else
-      expectType drop activenode parseDeclarationList then
+      expectType drop dup parseDeclarationList then
     _nextt again ;
 
 : parseFunction ( unitnode tok -- )