Eliminating alr dependency

alire.gpr

@@ -1,4 +1,3 @@
-with "condtrees";
 with "semantic_versioning";
 with "simple_logging";
 

index/alire-index-rxada.ads

@@ -0,0 +1,15 @@
+package Alire.Index.RxAda is
+
+   Name : constant Project_Name := "rxada";
+   Repo : constant URL          := "https://bitbucket.org/amosteo/rxada.git";
+
+   Desc : constant Project_Description := "RxAda port of the Rx framework";
+
+   V_0_1_0  : constant Release :=
+                Register_Git (Name,
+                              V ("0.1.0"),
+                              Desc,
+                              Repo,
+                              "361d4e2ab20a7dcca007e31bf7094d57b13fee6b");
+
+end Alire.Index.RxAda;

src/alire-boolean_trees.adb

@@ -0,0 +1,132 @@
+with Ada.Containers; use Ada.Containers;
+
+with GNAT.IO;
+
+package body Alire.Boolean_Trees is
+
+   ----------
+   -- Leaf --
+   ----------
+
+   function Leaf (C : Condition) return Tree is
+   begin
+      return T : Tree do
+         T.Append_Child (T.Root, Node'(Leaf, Conditions.To_Holder (C)));
+      end return;
+   end Leaf;
+
+   -----------------
+   -- Merge_Under --
+   -----------------
+
+   function Merge_Under (N : Node; L, R : Tree := Empty_Tree) return Tree is
+      use Trees;
+   begin
+      return T : Tree do
+         T.Append_Child (Parent => T.Root, New_Item => N);
+
+         declare
+            Op : constant Cursor := First_Child (T.Root);
+         begin
+            pragma Assert (Element (Op) = N);
+
+            if L /= Empty_Tree then
+               T.Copy_Subtree (Parent => Op,
+                               Before => No_Element,
+                               Source => First_Child (L.Root));
+            end if;
+
+            if R /= Empty_Tree then
+               T.Copy_Subtree (Parent => Op,
+                               Before => No_Element,
+                               Source => First_Child (R.Root));
+            end if;
+         end;
+      end return;
+   end Merge_Under;
+
+   -----------
+   -- "and" --
+   -----------
+
+   function "and" (L, R : Tree) return Tree is
+   begin
+      return Merge_Under (Node'(Kind => And_Node), L, R);
+   end "and";
+
+   ----------
+   -- "or" --
+   ----------
+
+   function "or" (L, R : Tree) return Tree is
+   begin
+      return Merge_Under (Node'(Kind => Or_Node), L, R);
+   end "or";
+
+   -----------
+   -- "not" --
+   -----------
+
+   function "not" (T : Tree) return Tree is
+      use Trees;
+   begin
+      return Merge_Under (Node'(Kind => Not_Node), T);
+   end "not";
+
+   -----------
+   -- Check --
+   -----------
+
+   function Check (T : Tree; V : Value) return Boolean is
+
+      function Check (C : Trees.Cursor) return Boolean is
+         N : constant Node := Trees.Element (C);
+      begin
+         case N.Kind is
+            when Leaf =>
+               return Check (N.Condition.Element, V);
+            when And_Node =>
+               return Check (Trees.First_Child (C)) and then Check (Trees.Last_Child (C));
+            when Or_Node =>
+               return Check (Trees.First_Child (C)) or else Check (Trees.Last_Child (C));
+            when Not_Node =>
+               return not Check (Trees.First_Child (C));
+         end case;
+      end Check;
+
+   begin
+      return Check (Trees.First_Child (T.Root));
+   end Check;
+
+   --------------------
+   -- Print_Skeleton --
+   --------------------
+
+   procedure Print_Skeleton (T : Tree) is
+      use GNAT.IO;
+      use Trees;
+
+      function Image (C : Trees.Cursor) return String is
+         N : constant Node := Trees.Element (C);
+      begin
+         case N.Kind is
+            when Leaf =>
+               return "Leaf";
+            when And_Node =>
+               return "(" & Image (Trees.First_Child (C)) & " and " & Image (Trees.Last_Child (C)) & ")";
+            when Or_Node =>
+               return "(" & Image (Trees.First_Child (C)) & " or " & Image (Trees.Last_Child (C)) & ")";
+            when Not_Node =>
+               return "(not " & Image (Trees.First_Child (C)) & ")";
+         end case;
+      end Image;
+
+   begin
+      if T.Is_Empty then
+         Put_Line ("(null tree)");
+      else
+         Put_Line (Image (Trees.First_Child (T.Root)));
+      end if;
+   end Print_Skeleton;
+
+end Alire.Boolean_Trees;

src/alire-boolean_trees.ads

@@ -0,0 +1,73 @@
+private with Ada.Containers.Indefinite_Holders;
+private with Ada.Containers.Indefinite_Multiway_Trees;
+
+generic
+   type Value     (<>) is private;
+   type Condition (<>) is private;
+   with function Check (C : Condition; V : Value) return Boolean;
+package Alire.Boolean_Trees with Preelaborate is
+
+   --  A package to represent trees of logical expressions
+
+   type Tree is tagged private;
+
+   Empty_Tree : constant Tree;
+
+   --  Tree building
+
+   function Leaf (C : Condition) return Tree;
+   function "+"  (C : Condition) return Tree renames Leaf;
+
+   function "and" (L, R : Tree) return Tree
+     with Pre => L /= Empty_Tree and then R /= Empty_Tree;
+   function "and" (L : Tree; R : Condition) return Tree is (L and Leaf (R));
+   function "and" (L : Condition; R : Tree) return Tree is (Leaf (L) and R);
+   function "and" (L : Condition; R : Condition) return Tree is (Leaf (L) and Leaf (R));
+
+   function "or"  (L, R : Tree) return Tree
+     with Pre => L /= Empty_Tree and then R /= Empty_Tree;
+   function "or"  (L : Tree; R : Condition) return Tree is (L or  Leaf (R));
+   function "or"  (L : Condition; R : Tree) return Tree is (Leaf (L) or R);
+   function "or"  (L : Condition; R : Condition) return Tree is (Leaf (L) or  Leaf (R));
+
+   function "not" (T : Tree) return Tree
+     with Pre => T /= Empty_Tree;
+   function "not" (C : Condition) return Tree is (not Leaf (C));
+
+   --  Tree evaluation
+
+   function Check (T : Tree; V : Value) return Boolean;
+
+   --  Access
+
+   function Is_Empty (T : Tree) return Boolean;
+
+   --  Debugging
+
+   procedure Print_Skeleton (T : Tree);
+
+private
+
+   type Node_Kinds is (Leaf, And_Node, Or_Node, Not_Node);
+
+   package Values is new Ada.Containers.Indefinite_Holders (Value);
+   package Conditions is new Ada.Containers.Indefinite_Holders (Condition);
+
+   type Node (Kind : Node_Kinds) is record
+      case Kind is
+         when Leaf =>
+            Condition : Conditions.Holder;
+         when others =>
+            null;
+      end case;
+   end record;
+
+   package Trees is new Ada.Containers.Indefinite_Multiway_Trees (Node);
+
+   type Tree is new Trees.Tree with null record;
+
+   Empty_Tree : constant Tree := (Trees.Empty_Tree with null record);
+
+   function Is_Empty (T : Tree) return Boolean is (Trees.Is_Empty (Trees.Tree (T)));
+
+end Alire.Boolean_Trees;

src/alire-index.ads

@@ -9,6 +9,7 @@ with Alire.Releases;
 with Alire.Repositories.Git;
 with Alire.Requisites;
 with Alire.Requisites.Platform;
+with Alire.Root_Project;
 
 with Semantic_Versioning;
 
@@ -77,6 +78,7 @@ package Alire.Index is
    function Except    (P : Project_Name; V : Version) return Dependencies;
 
    --  Shortcuts for properties/requisites:
+
    use all type Compilers.Compilers;
    use all type Operating_Systems.Operating_Systems;
 
@@ -100,6 +102,18 @@ package Alire.Index is
    function System_is (V : Operating_Systems.Operating_Systems) return Requisites.Requisite'Class
                        renames Requisites.Platform.System_Is;
 
+   ----------------------
+   -- Set_Root_Project --
+   ----------------------
+
+   function Set_Root_Project (Project    : Alire.Project_Name;
+                              Version    : Semantic_Versioning.Version;
+                              Depends_On : Alire.Index.Dependencies := Alire.Index.No_Dependencies)
+                              return Release renames Root_Project.Set;
+   --  This function must be called in the working project alire file.
+   --  Otherwise alr does not know what's the current project, and its version and dependencies
+   --  The returned Release is the same; this is just a trick to be able to use it in an spec file.
+   
 private
 
    function Register_Git (Project     : Project_Name;

src/alire-project.ads

@@ -0,0 +1,7 @@
+with Alire.Index;
+
+package Alire.Project renames Alire.Index;
+
+--  Since the facilities used to register projects in the index are the same used
+--  by a working project to state dependencies, instead of duplicating them or
+--  forcing clients to with everything around, everything is done inside Index

src/alire-requisites.ads

@@ -1,7 +1,6 @@
+with Alire.Boolean_Trees;
 with Alire.Properties;
 
-with Condtrees;
-
 package Alire.Requisites with Preelaborate is
 
    use Properties;
@@ -51,9 +50,9 @@ package Alire.Requisites with Preelaborate is
    function Satisfies (R : Requisite'Class; P : Properties.Vector) return Boolean;
    --  True if any of the properties in the vector satisfies the requisite
 
-   package Trees is new Condtrees (Properties.Vector,
-                                   Requisite'Class,
-                                   Satisfies);
+   package Trees is new Boolean_Trees (Properties.Vector,
+                                       Requisite'Class,
+                                       Satisfies);
 
    subtype Tree is Trees.Tree;
 

src/alire-root_project.ads

@@ -0,0 +1,47 @@
+with Alire.Containers;
+with Alire.Dependencies.Vectors;
+with Alire.Os_Lib;
+with Alire.Releases;
+
+with Semantic_Versioning;
+
+package Alire.Root_Project is
+
+   --  Only file needed from the project alr file (project_alr.ads).
+   --  Besides the important Set_Root_Project, unfortunately it renames most of Alire.Index to
+   --  make it directly visible in project_alr.ads
+
+   Current : Alire.Containers.Release_H;
+   --  Root dependency (the working project). If Is_Empty we know we must recompile,
+   --  unless the hash already matches. In this case, we know the project file is
+   --  missing the Set_Root_Project call
+
+   procedure Ensure_Valid
+     with Post => (not Current.Is_Empty or else raise Program_Error with "No root project when expected to exist");
+   --  Graceful check that Current contains what it should.
+
+   function Name return String
+     with Pre => (not Current.Is_Empty);
+
+   function GPR_File (Prj : Alire.Project_Name := Current.Element.Project) return String
+     with Pre => (not Current.Is_Empty);
+   --  The actual project root file (not the _alrbuild one!)
+
+   function GPR_Alr_File (Prj : Alire.Project_Name := Current.Element.Project) return String
+     with Pre => (not Current.Is_Empty);
+   --  The alr environment project file (project_alr.gpr)
+
+   function Enter_Root (Prj : Alire.Project_Name := Current.Element.Project) return Alire.OS_Lib.Folder_Guard
+     with Pre => (not Current.Is_Empty);
+   --  Enters the root folder if not already there
+
+   function Set (Project    : Project_Name;
+                 Version    : Semantic_Versioning.Version;
+                 Depends_On : Dependencies.Vectors.Vector := Dependencies.Vectors.No_Dependencies)
+                 return Releases.Release;
+   --  This function must be called in the working project alire file.
+   --  Otherwise alr does not know what's the current project, and its version and dependencies
+   --  It could be manually parsed from the file, but that's precisely what we want to avoid
+   --  The returned Release is the same; this is just a trick to be able to use it in an spec file.
+
+end Alire.Root_Project;