Printing of conditional dependencies/properties

src/alire-conditional_values.adb

@@ -5,27 +5,38 @@ package body Alire.Conditional_Values is
    -----------
 
    function "and" (L, R : Conditional_Value) return Conditional_Value is
-   --  FIXME: we could do an effort to flatten this binary tree that's forming here in longer vectors
+      Inner : Vector_Inner;
+
+      -------------
+      -- Flatten --
+      -------------
+
+      procedure Flatten (This : Inner_Node'Class) is
+      begin
+         case This.Kind is
+            when Value | Condition =>
+               Inner.Values.Append (This);
+            when Vector =>
+               for Child of Vector_Inner (This).Values loop
+                  Flatten (Child);
+               end loop;
+         end case;
+      end Flatten;
+
    begin
-      return Result : Conditional_Value do
-         if L.Is_Empty and then R.Is_Empty then
-            null; -- nothing to do nor return
-         else
-            declare
-               Inner : Vector_Inner;
-            begin
-               if not L.Is_Empty then
-                  Inner.Values.Append (L.Constant_Reference);
-               end if;
+      if not L.Is_Empty then
+         Flatten (L.Constant_Reference);
+      end if;
 
-               if not R.Is_Empty then
-                  Inner.Values.Append (R.Constant_Reference);
-               end if;
+      if not R.Is_Empty then
+         Flatten (R.Constant_Reference);
+      end if;
 
-               Result.Replace_Element (Inner);
-            end;
-         end if;
-      end return;
+      if Inner.Values.Is_Empty then
+         return Empty;
+      else
+         return (To_Holder (Inner));
+      end if;
    end "and";
 
    --------------
@@ -34,7 +45,7 @@ package body Alire.Conditional_Values is
 
    function Evaluate (This : Conditional_Value; Against : Properties.Vector) return Values is
 
-      function Evaluate (This : Inner_Value'Class) return Values is
+      function Evaluate (This : Inner_Node'Class) return Values is
       begin
          case This.Kind is
             when Condition =>
@@ -82,12 +93,34 @@ package body Alire.Conditional_Values is
    procedure Iterate_Children (This    : Conditional_Value;
                                Visitor : access procedure (CV : Conditional_Value))
    is
-   begin
-      for Inner of Vector_Inner (This.Constant_Reference.Element.all).Values loop
-         case Inner.Kind is
-            when others => BANG
+
+      procedure Iterate (This : Inner_Node'Class) is
+      begin
+         case This.Kind is
+            when Value | Condition =>
+               Visitor (To_Holder (This));
+            when Vector =>
+               for Inner of Vector_Inner (This).Values loop
+                  case Inner.Kind is
+                     when Value =>
+                        Visitor (New_Value (Value_Inner (Inner).Value));
+                     when Condition =>
+                        declare
+                           Cond : Conditional_Inner renames Conditional_Inner (Inner);
+                        begin
+                           Visitor (New_Conditional (Cond.Condition, Cond.Then_Value, Cond.Else_Value));
+                        end;
+                     when Vector =>
+                        Iterate (Inner);
+                  end case;
+               end loop;
          end case;
-      end loop;
+      end Iterate;
+
+   begin
+      if not This.Is_Empty then
+         Iterate (This.Constant_Reference);
+      end if;
    end Iterate_Children;
 
 end Alire.Conditional_Values;

src/alire-conditional_values.ads

@@ -26,6 +26,11 @@ package Alire.Conditional_Values with Preelaborate is
 
    function Empty return Conditional_Value;
 
+   procedure Iterate_Children (This    : Conditional_Value;
+                               Visitor : access procedure (CV : Conditional_Value));
+   --  Visitor will be called for any immediate non-vector value
+   --  Vector children will be iterated too, so a flat hierarchy will be mimicked for those
+
    ---------------
    --  SINGLES  --
    ---------------
@@ -42,10 +47,6 @@ package Alire.Conditional_Values with Preelaborate is
    function "and" (L, R : Conditional_Value) return Conditional_Value;
    --  Concatenation
 
-   procedure Iterate_Children (This    : Conditional_Value;
-                               Visitor : access procedure (CV : Conditional_Value))
-     with Pre => This.Kind = Vector;
-
    --------------------
    --  CONDITIONALS  --
    --------------------
@@ -65,25 +66,25 @@ package Alire.Conditional_Values with Preelaborate is
 
 private
 
-   type Inner_Value is abstract tagged null record;
+   type Inner_Node is abstract tagged null record;
 
-   function Kind (This : Inner_Value'Class) return Kinds;
+   function Kind (This : Inner_Node'Class) return Kinds;
 
-   package Holders is new Ada.Containers.Indefinite_Holders (Inner_Value'Class);
-   package Vectors is new Ada.Containers.Indefinite_Vectors (Positive, Inner_Value'Class);
+   package Holders is new Ada.Containers.Indefinite_Holders (Inner_Node'Class);
+   package Vectors is new Ada.Containers.Indefinite_Vectors (Positive, Inner_Node'Class);
 
    type Conditional_Value is new Holders.Holder with null record;
    --  Instead of dealing with pointers and finalization, we use this class-wide container
 
-   type Value_Inner is new Inner_Value with record
+   type Value_Inner is new Inner_Node with record
       Value : Values;
    end record;
 
-   type Vector_Inner is new Inner_Value with record
+   type Vector_Inner is new Inner_Node with record
       Values : Vectors.Vector;
    end record;
 
-   type Conditional_Inner is new Inner_Value with record
+   type Conditional_Inner is new Inner_Node with record
       Condition  : Requisites.Tree;
       Then_Value : Conditional_Value;
       Else_Value : Conditional_Value;
@@ -177,7 +178,7 @@ private
    -- Kind --
    ----------
 
-   function Kind (This : Inner_Value'Class) return Kinds is
+   function Kind (This : Inner_Node'Class) return Kinds is
      (if This in Value_Inner'Class
       then Value
       else (if This in Vector_Inner'Class

src/alire-properties.ads

@@ -13,6 +13,8 @@ package Alire.Properties with Preelaborate is
 
    function Image (P : Property) return String is abstract;
 
+   function Image_Classwide (P : Property'Class) return String is (P.Image);
+
    package Vectors is new Ada.Containers.Indefinite_Vectors (Positive, Property'Class);
 
    type Vector is new Vectors.Vector with null record;

src/alire-releases.adb

@@ -1,3 +1,5 @@
+with Alire.Conditional_Values;
+
 with GNAT.IO; -- To keep preelaborable
 
 package body Alire.Releases is
@@ -58,30 +60,43 @@ package body Alire.Releases is
       end return;
    end GPR_Files;
 
-   --------------------------------
-   -- Print_Conditional_Property --
-   --------------------------------
+   -----------------------
+   -- Print_Conditional --
+   -----------------------
 
-   procedure Print_Conditional_Property (Cond : Conditional.Properties) is
+   generic
+      with package Cond is new Conditional_Values (<>);
+      with procedure Print (Prefix : String; V : Cond.Values);
+   procedure Print_Conditional (Prefix : String; This : Cond.Conditional_Value);
+
+   procedure Print_Conditional (Prefix : String; This : Cond.Conditional_Value) is
       use GNAT.IO;
+
+      procedure Visit (This : Cond.Conditional_Value) is
+      begin
+         case This.Kind is
+            when Cond.Value =>
+               Print (Prefix, This.Value);
+            when Cond.Condition =>
+               if This.True_Value.Is_Empty then
+                  Put_Line (Prefix & "when not (" & This.Condition.Image & "):");
+                  Print_Conditional (Prefix & "   ", This.False_Value);
+               else
+                  Put_Line (Prefix & "when " & This.Condition.Image & ":");
+                  Print_Conditional (Prefix & "   ", This.True_Value);
+                  if not This.False_Value.Is_Empty then
+                     Put_Line (Prefix & "else:");
+                     Print_Conditional (Prefix & "   ", This.False_Value);
+                  end if;
+               end if;
+            when Cond.Vector =>
+               raise Program_Error with "Shouldn't happen";
+         end case;
+      end Visit;
+
    begin
-      Put_Line ("   (unimplemented)");
---        if Cond.Is_Unconditional then
---           Cond.True_Value.Print (Prefix => "   ");
---        else
---           if Cond.True_Value.Is_Empty then
---              Put_Line ("   when not (" & Cond.Condition.Image & "):");
---              Cond.False_Value.Print (Prefix => "      ");
---           else
---              Put_Line ("   when " & Cond.Condition.Image & ":");
---              Cond.True_Value.Print (Prefix => "      ");
---              if not Cond.False_Value.Is_Empty then
---                 Put_Line ("   else:");
---                 Cond.False_Value.Print (Prefix => "      ");
---              end if;
---           end if;
---        end if;
-   end Print_Conditional_Property;
+      This.Iterate_Children (Visit'Access);
+   end Print_Conditional;
 
    -----------
    -- Print --
@@ -89,6 +104,21 @@ package body Alire.Releases is
 
    procedure Print (R : Release) is
       use GNAT.IO;
+
+      procedure Print_Propvec (Prefix : String; V : Properties.Vector) is
+      begin
+         Properties.Print (V, Prefix);
+      end Print_Propvec;
+
+      procedure Print_Depvec (Prefix : String; V : Dependencies.Vectors.Vector) is
+      begin
+         for Dep of V loop
+            Put_Line (Prefix & Dep.Image);
+         end loop;
+      end Print_Depvec;
+
+      procedure Print_Properties is new Print_Conditional (Conditional.For_Properties, Print_Propvec);
+      procedure Print_Dependencies is new Print_Conditional (Conditional.For_Dependencies, Print_Depvec);
    begin
       --  MILESTONE
       Put_Line (R.Milestone.Image & ": " & R.Description);
@@ -104,17 +134,13 @@ package body Alire.Releases is
       --  PROPERTIES
       if not R.Properties.Is_Empty then
          Put_Line ("Properties:");
---           for Cond of R.Properties loop
---              Print_Conditional_Property (Cond);
---           end loop;
+         Print_Properties ("   ", R.Properties);
       end if;
 
       --  DEPENDENCIES
       if not R.Dependencies.Is_Empty then
          Put_Line ("Dependencies (direct):");
---           for Dep of R.Depends loop
---              Put_Line ("   " & Dep.Image);
---           end loop;
+         Print_Dependencies ("   ", R.Dependencies);
       end if;
    end Print;