From 39a112952e328ce52e5f7b08bf18bbadd3fca03f Mon Sep 17 00:00:00 2001 From: Jedidiah Barber Date: Wed, 19 Nov 2025 16:51:08 +1300 Subject: Reification, including Term flattening and Treeification --- test/trees.adb | 71 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 71 insertions(+) create mode 100644 test/trees.adb (limited to 'test/trees.adb') diff --git a/test/trees.adb b/test/trees.adb new file mode 100644 index 0000000..7f199ad --- /dev/null +++ b/test/trees.adb @@ -0,0 +1,71 @@ + + +-- Programmed by Jedidiah Barber +-- Licensed under the Sunset License v1.0 + +-- See license.txt for further details + + +with + + Ada.Containers.Multiway_Trees, + Ada.Text_IO, + Kompsos.Advanced_Reify, + Kompsos.Pretty_Print; + + +procedure Trees is + + package TIO renames Ada.Text_IO; + + + package InKomp is new Kompsos (Integer); + use InKomp; + + + type Integer_Array is array (Positive range <>) of Integer; + + function Var_Minus_One + (Item : in Term) + return Integer is + begin + return -1; + end Var_Minus_One; + + package Int_Trees is new Ada.Containers.Multiway_Trees (Integer); + + package Reify is new InKomp.Advanced_Reify + (Element_Array => Integer_Array, + Null_Element => 0, + Variable_Convert => Var_Minus_One, + Element_Trees => Int_Trees); + + + package Printer is new InKomp.Pretty_Print (Integer'Image); + + + Test_Item : constant Term := T (T (T (1) & T (2) & T (3)) & T (T (10) & T (20))); + + Result : constant Int_Trees.Tree := Reify.To_Tree (Test_Item); + +begin + + TIO.Put_Line ("Test term is " & Printer.Image (Test_Item)); + + TIO.New_Line; + + TIO.Put_Line ("Root has " & + Printer.Image (Integer (Int_Trees.Child_Count (Result.Root))) & " children."); + + for Child in Result.Iterate_Children (Result.Root) loop + TIO.Put ("Child has " & + Printer.Image (Integer (Int_Trees.Child_Count (Child))) & " children:"); + for Child_Child in Result.Iterate_Children (Child) loop + TIO.Put (" " & Printer.Image (Int_Trees.Element (Child_Child))); + end loop; + TIO.New_Line; + end loop; + +end Trees; + + -- cgit