diff --git a/lib2/h3-compilers.ads b/lib2/h3-compilers.ads index f5c3855..d57b3ba 100644 --- a/lib2/h3-compilers.ads +++ b/lib2/h3-compilers.ads @@ -1,5 +1,6 @@ with H3.Runes; with H3.Strings; +with H3.Trees; with Ada.Finalization; with Ada.Text_IO; diff --git a/lib2/h3-trees.adb b/lib2/h3-trees.adb index 115e9e8..35720c0 100644 --- a/lib2/h3-trees.adb +++ b/lib2/h3-trees.adb @@ -1,12 +1,14 @@ +with Ada.Unchecked_Deallocation; package body H3.Trees is - procedure Add_Node (Tr: in out Tree; N: in Node) is - begin - --Tr.Nodes, - - null; - end Add_Node; + procedure New_Node (Tr: in out Tree; Code: Node_Code) is + N: Node_Pointer; + begin + N := new Node(Code); + N.Next := Tr.Top; + Tr.Top := N; + end New_Node; procedure Free_Node (Tr: in out Tree; N: in out Node) is begin @@ -16,4 +18,15 @@ package body H3.Trees is null; end Free_Node; + -- ------------------------------------------------------------------ + + overriding procedure Initialize (C: in out Tree) is + begin + null; + end Initialize; + + overriding procedure Finalize (C: in out Tree) is + begin + null; + end Finalize; end H3.Trees; diff --git a/lib2/h3-trees.ads b/lib2/h3-trees.ads index 0e9642a..10783e1 100644 --- a/lib2/h3-trees.ads +++ b/lib2/h3-trees.ads @@ -1,23 +1,25 @@ -use H3.Arrays; +with Ada.Finalization; package H3.Trees is - -- parse tree - --package A is new H3.Arrays(XXXX, 0); type Node_Code is ( NODE_ASSIGN, NODE_CALL, - NODE_CLASS + NODE_CLASS, NODE_IF, NODE_FUN, NODE_VOID, NODE_WHILE ); + type Node; + type Node_Pointer is access Node; + type Node(Code: Node_Code := NODE_VOID) is record -- Loc: location. + Next: Node_Pointer; case Code is when NODE_ASSIGN => null; @@ -33,11 +35,18 @@ package H3.Trees is null; when NODE_WHILE => null; + end case; end record; - type Tree is record - Next_Node: System_Index := System_Index'First; - Toplevel_Node := Node - end Tree; + + -- parse tree + type Tree is new Ada.Finalization.Limited_Controlled with record + --Next_Node: System_Index := System_Index'First; + --Toplevel_Node := Node; + Top: Node_Pointer := null; + end record; + + overriding procedure Initialize (C: in out Tree); + overriding procedure Finalize (C: in out Tree); end H3.Trees;