From ab74bb30df68a1974fadd79e929b2dca51e009f5 Mon Sep 17 00:00:00 2001 From: A Date: Mon, 19 Feb 2018 15:04:11 +0100 Subject: [PATCH] Eliminating alr dependency --- alire.gpr | 1 - deps/semver | 2 +- index/alire-index-rxada.ads | 15 ++++ src/alire-boolean_trees.adb | 132 ++++++++++++++++++++++++++++++++++++ src/alire-boolean_trees.ads | 73 ++++++++++++++++++++ src/alire-index.ads | 14 ++++ src/alire-project.ads | 7 ++ src/alire-requisites.ads | 9 ++- src/alire-root_project.ads | 47 +++++++++++++ 9 files changed, 293 insertions(+), 7 deletions(-) create mode 100644 index/alire-index-rxada.ads create mode 100644 src/alire-boolean_trees.adb create mode 100644 src/alire-boolean_trees.ads create mode 100644 src/alire-project.ads create mode 100644 src/alire-root_project.ads diff --git a/alire.gpr b/alire.gpr index e782307e..15bb12d4 100644 --- a/alire.gpr +++ b/alire.gpr @@ -1,4 +1,3 @@ -with "condtrees"; with "semantic_versioning"; with "simple_logging"; diff --git a/deps/semver b/deps/semver index f39befcf..9f35b00a 160000 --- a/deps/semver +++ b/deps/semver @@ -1 +1 @@ -Subproject commit f39befcf356dfa1dc285888c91ee0fde2f3f69e8 +Subproject commit 9f35b00a31861ea96085ee553fb6335d74831f5c diff --git a/index/alire-index-rxada.ads b/index/alire-index-rxada.ads new file mode 100644 index 00000000..3617a023 --- /dev/null +++ b/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; diff --git a/src/alire-boolean_trees.adb b/src/alire-boolean_trees.adb new file mode 100644 index 00000000..4a7e8ea7 --- /dev/null +++ b/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; diff --git a/src/alire-boolean_trees.ads b/src/alire-boolean_trees.ads new file mode 100644 index 00000000..43b7d3e9 --- /dev/null +++ b/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; diff --git a/src/alire-index.ads b/src/alire-index.ads index f7b01654..4898ffcd 100644 --- a/src/alire-index.ads +++ b/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; diff --git a/src/alire-project.ads b/src/alire-project.ads new file mode 100644 index 00000000..dc1920cb --- /dev/null +++ b/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 diff --git a/src/alire-requisites.ads b/src/alire-requisites.ads index 4b163a83..d698a77d 100644 --- a/src/alire-requisites.ads +++ b/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; diff --git a/src/alire-root_project.ads b/src/alire-root_project.ads new file mode 100644 index 00000000..939cc557 --- /dev/null +++ b/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;