alire-index-community/src/alire-conditional_trees.ads

with Ada.Containers; use Ada.Containers;
with Ada.Iterator_Interfaces;

with Alire.Properties;
with Alire.Requisites;
with Alire.Utils;

private with Ada.Containers.Indefinite_Holders;
private with Ada.Containers.Indefinite_Vectors;

generic
   type Values (<>) is private;
   with function Image (V : Values) return String;
package Alire.Conditional_Trees with Preelaborate is

   type Kinds is (Condition, Value, Vector);

   type Tree is tagged private with
     Default_Iterator => Iterate,
     Iterator_Element => Tree,
     Constant_Indexing => Indexed_Element;
   --  Recursive type that stores conditions (requisites) and values/further conditions if they are met or not

   function Leaf_Count (This : Tree) return Natural;

   generic
      type Collection is private;
      with procedure Append (C : in out Collection; V : Values; Count : Count_Type := 1);
   function Materialize (This : Tree; Against : Properties.Vector) return Collection;
   --  Materialize against the given properties, and return as list
   --  NOTE: this presumes there are no OR conditions along the tree
   --  In Alire context, this is always true for properties and
   --    potentially never for dependencies

   generic
      type Collection is private;
      with procedure Append (C : in out Collection; V : Values; Count : Count_Type := 1);
   function Enumerate (This : Tree) return Collection;
   --  Return all value nodes, regardless of dependencies/conjunctions
   --  This is used for textual search and has no semantic trascendence

   function Evaluate (This : Tree; Against : Properties.Vector) return Tree;
   --  Materialize against the given properties, returning values as an unconditional tree
   --  NOTE: the result is unconditional but can still contain a mix of AND/OR subtrees

   function Kind (This : Tree) return Kinds;

   function Is_Empty (This : Tree) return Boolean;

   function Empty return Tree;

   function Image_One_Line (This : Tree) return String;

   function Is_Unconditional (This : Tree) return Boolean;
   -- Recursively!

   function Contains_ORs (This : Tree) return Boolean;

   ---------------
   --  SINGLES  --
   ---------------

   function New_Value (V : Values) return Tree; -- when we don't really need a condition

   function Value (This : Tree) return Values
     with Pre => This.Kind = Value;

   ---------------
   --  VECTORS  --
   ---------------

   function "and" (L, R : Tree) return Tree;
   --  Concatenation

   function "or" (L, R : Tree) return Tree;

   type Conjunctions is (Anded, Ored);

   function Conjunction (This : Tree) return Conjunctions
     with Pre => This.Kind = Vector;

   procedure Iterate_Children (This    : Tree;
                               Visitor : access procedure (CV : Tree));
   --  There is "of" notation too, but that bugs out when using this package as generic formal

   type Children_Array is array (Positive range <>) of Tree;

   function First_Child (This : Tree) return Tree;

   function All_But_First_Children (This : Tree) return Tree;

   --------------------
   --  CONDITIONALS  --
   --------------------

   function New_Conditional (If_X   : Requisites.Tree;
                             Then_X : Tree;
                             Else_X : Tree) return Tree;

   function Condition (This : Tree) return Requisites.Tree
     with Pre => This.Kind = Condition;

   function True_Value (This : Tree) return Tree
     with Pre => This.Kind = Condition;

   function False_Value (This : Tree) return Tree
     with Pre => This.Kind = Condition;

   generic
      type Enum is (<>);
      with function Requisite_Equal (V : Enum) return Requisites.Tree;
      --  Function which creates an equality requisite on V
   package Case_Statements is

      type Arrays is array (Enum) of Tree;

      function Case_Is (Arr : Arrays) return Tree;

   end Case_Statements;

   -----------
   -- Print --
   -----------

   procedure Print (This   : Tree;
                    Prefix : String := "";
                    And_Or : Boolean := True);
   --  And_Or is false if only And can appear, thus no necessity to distinguish

   -----------------
   --  ITERATORS  --
   -----------------

   type Cursor is private;

   function Has_Element (This : Cursor) return Boolean;

   function Next (This : Cursor) return Cursor;

   package Iterators is new Ada.Iterator_Interfaces (Cursor, Has_Element);

   function Iterate (Container : Tree)
      return Iterators.Forward_Iterator'Class;
   -- Returns our own iterator, which in general will be defined in the
   -- private part or the body.

   function Indexed_Element (Container : Tree; Pos : Cursor)
      return Tree;

private

   type Inner_Node is abstract tagged null record;

   function Image (Node : Inner_Node) return String is abstract;

   function Image_Classwide (Node : Inner_Node'Class) return String is (Node.Image);

   function Kind (This : Inner_Node'Class) return Kinds;

   package Holders is new Ada.Containers.Indefinite_Holders (Inner_Node'Class);
   package Vectors is new Ada.Containers.Indefinite_Vectors (Positive, Inner_Node'Class);

   type Cursor is new Vectors.Cursor;

   type Tree is new Holders.Holder with null record;
   --  Instead of dealing with pointers and finalization, we use this class-wide container

   package Definite_Values is new Ada.Containers.Indefinite_Holders (Values);

   type Value_Inner is new Inner_Node with record
      Value : Definite_Values.Holder;
   end record;

   overriding function Image (V : Value_Inner) return String is
     (Image (V.Value.Constant_Reference));

--     overriding function To_Code (This : Tree) return Utils.String_Vector;

   type Vector_Inner is new Inner_Node with record
      Conjunction : Conjunctions;
      Values      : Vectors.Vector;
   end record;

   function Conjunction (This : Vector_Inner) return Conjunctions is
     (This.Conjunction);

   package Non_Primitive is
      function One_Liner_And is new Utils.Image_One_Line
        (Vectors,
         Vectors.Vector,
         Image_Classwide,
         " and ",
         "(empty condition)");

      function One_Liner_Or is new Utils.Image_One_Line
        (Vectors,
         Vectors.Vector,
         Image_Classwide,
         " or ",
         "(empty condition)");
   end Non_Primitive;

   overriding function Image (V : Vector_Inner) return String is
     ("(" & (if V.Conjunction = Anded
             then Non_Primitive.One_Liner_And (V.Values)
             else Non_Primitive.One_Liner_Or (V.Values)) & ")");

   type Conditional_Inner is new Inner_Node with record
      Condition  : Requisites.Tree;
      Then_Value : Tree;
      Else_Value : Tree;
   end record;

   overriding function Image (V : Conditional_Inner) return String is
     ("if " & V.Condition.Image &
        " then " & V.Then_Value.Image_One_Line &
        " else " & V.Else_Value.Image_One_Line);

   --------------
   -- As_Value --
   --------------

   function As_Value (This : Tree) return Values
   is
     (Value_Inner (This.Element).Value.Element)
   with Pre => This.Kind = Value;

   --------------------
   -- As_Conditional --
   --------------------

   function As_Conditional (This : Tree) return Conditional_Inner'Class is
     (Conditional_Inner'Class (This.Element))
   with Pre => This.Kind = Condition;

   ---------------
   -- As_Vector --
   ---------------

   function As_Vector (This : Tree) return Vectors.Vector is
     (Vector_Inner'Class (This.Element).Values)
   with Pre => This.Kind = Vector;

   -----------------
   -- Conjunction --
   -----------------

   function Conjunction (This : Tree) return Conjunctions is
     (Vector_Inner'Class (This.Element).Conjunction);

   -----------------
   -- First_Child --
   -----------------

   function First_Child (This : Tree) return Tree is
      (To_Holder (This.As_Vector.First_Element));

   ---------------------
   -- New_Conditional --
   ---------------------

   function New_Conditional (If_X   : Requisites.Tree;
                             Then_X : Tree;
                             Else_X : Tree) return Tree is
     (To_Holder (Conditional_Inner'(Condition  => If_X,
                                    Then_Value => Then_X,
                                    Else_Value => Else_X)));

   ---------------
   -- New_Value --
   ---------------

   function New_Value (V : Values) return Tree is
     (To_Holder (Value_Inner'(Value => Definite_Values.To_Holder (V))));

   ---------------
   -- Condition --
   ---------------

   function Condition (This : Tree) return Requisites.Tree is
     (This.As_Conditional.Condition);

   -----------
   -- Value --
   -----------

   function Value (This : Tree) return Values renames As_Value;

   ----------------
   -- True_Value --
   ----------------

   function True_Value (This : Tree) return Tree is
      (This.As_Conditional.Then_Value);

   -----------------
   -- False_Value --
   -----------------

   function False_Value (This : Tree) return Tree is
      (This.As_Conditional.Else_Value);

   -----------
   -- Empty --
   -----------

   function Empty return Tree is
      (Holders.Empty_Holder with null record);

   --------------
   -- Is_Empty --
   --------------

   overriding function Is_Empty (This : Tree) return Boolean is
     (Holders.Holder (This).Is_Empty);

   ----------
   -- Kind --
   ----------

   function Kind (This : Inner_Node'Class) return Kinds is
     (if This in Value_Inner'Class
      then Value
      else (if This in Vector_Inner'Class
            then Vector
            else Condition));

   function Kind (This : Tree) return Kinds is
     (This.Constant_Reference.Kind);

   --------------------
   -- Image_One_Line --
   --------------------

   function Image_One_Line (This : Tree) return String is
     (if This.Is_Empty
      then "(empty condition)"
      else This.Constant_Reference.Image);

end Alire.Conditional_Trees;