diff --git a/deps/semver b/deps/semver index 3480c761..dc462f11 160000 --- a/deps/semver +++ b/deps/semver @@ -1 +1 @@ -Subproject commit 3480c76110b1a40b3dbb189f6ac5020bf22d644a +Subproject commit dc462f11adb34bbb3d9163e44c287add5b3421c6 diff --git a/index/alire-index-adacurses.ads b/index/alire-index-adacurses.ads index 258180d0..c41c12e9 100644 --- a/index/alire-index-adacurses.ads +++ b/index/alire-index-adacurses.ads @@ -12,34 +12,25 @@ package Alire.Index.Adacurses is Comment ("However, some distros (e.g., Debian family) use ncursesada.gpr") and Comment ("This package wraps these differences so clients can always safely use adacurses"); - V_6 : constant Release := - Project.Register - (V ("6"), - Git (Repo, "4ccb20409becb50c0b5fd29effb676b650608326"), + Base : constant Release := Project.Unreleased + (Properties => Comments); - Dependencies => - On_Condition - (Distribution = Debian or Distribution = Ubuntu, - When_True => When_Available (NcursesAda.V_6.Within_Major), - When_False => Unavailable), + package V_6 is new Released + (Base + .Replacing + (Git (Repo, "4ccb20409becb50c0b5fd29effb676b650608326")) + .Extending + (Case_Distribution_Is + ((Debian | Ubuntu => NcursesAda.V_6.Within_Major, + others => Unavailable)))); - Properties => - Comments - ); - - V_5 : constant Release := - Project.Register - (V ("5"), - Git (Repo, "4ccb20409becb50c0b5fd29effb676b650608326"), - - Dependencies => - On_Condition - (Distribution = Debian or Distribution = Ubuntu, - When_True => When_Available (NcursesAda.V_5.Within_Major), - When_False => Unavailable), - - Properties => - Comments - ); + package V_5 is new Released + (Base + .Replacing + (Git (Repo, "4ccb20409becb50c0b5fd29effb676b650608326")) + .Extending + (Case_Distribution_Is + ((Debian | Ubuntu => NcursesAda.V_5.Within_Major, + others => Unavailable)))); end Alire.Index.Adacurses; diff --git a/index/alire-index-alire.ads b/index/alire-index-alire.ads index 02839b2c..0c3a85a8 100644 --- a/index/alire-index-alire.ads +++ b/index/alire-index-alire.ads @@ -78,14 +78,8 @@ package Alire.Index.Alire is (Operating_System = GNU_Linux, When_True => Elite_Dangerous >= "2.0" and Star_Citizen >= V ("3.0"), -- Wish... When_False => Windows_3000 > V ("1.0")) and - When_Available -- Chained preferences - (Preferred => Within_Major (Alire.Project, V ("1.0"))) and -- or dot notation - When_Available -- Chained preferences - (Preferred => Alire.Project.Within_Major ("2.0"), - Otherwise => When_Available -- Chained preferences multi-level - (Preferred => Within_Major (Alire.Project, V ("1.0")), - Otherwise => Alire.Project.Within_Major ("0.5"))) and -- V () is optional - (Star_Citizen >= "4.0" or Half_Life >= "3.0"), -- Chained preferences, takes first + (Star_Citizen >= "4.0" or Half_Life >= "3.0"), + -- Chained preferences, takes first available Private_Properties => -- These are only interesting to alr, not users GPR_External ("Profile", "False"), diff --git a/index/alire-index-xstrings.ads b/index/alire-index-xstrings.ads index 1f7b826f..979bab23 100644 --- a/index/alire-index-xstrings.ads +++ b/index/alire-index-xstrings.ads @@ -21,4 +21,13 @@ package Alire.Index.XStrings is (Base .Replacing (Git (Repo, "40d3871dd644473aabac104666b4c83285b65ba6"))); + Experiment : constant Release := + Project.Register + (V ("99"), + Git (Repo, "40d3871dd644473aabac104666b4c83285b65ba6"), + Dependencies => + GNATCOLL.Strings.Project /= GNATCOLL.Strings.V_20180425.Version and + (GNATCOLL.Strings.V_20180425.Within_Major or + GNATCOLL.Slim.V_20180425.Within_Major)); + end Alire.Index.XStrings; diff --git a/src/alire-conditional.ads b/src/alire-conditional.ads index 33bfce92..41e7cb7a 100644 --- a/src/alire-conditional.ads +++ b/src/alire-conditional.ads @@ -1,5 +1,5 @@ with Alire.Conditional_Values; -with Alire.Dependencies.Vectors; +with Alire.Dependencies; with Alire.Properties; with Alire.Requisites; @@ -7,9 +7,8 @@ with Semantic_Versioning; package Alire.Conditional with Preelaborate is - package For_Dependencies is new Conditional_Values (Dependencies.Vectors.Vector, - Dependencies.Vectors."and", - Dependencies.Vectors.Image_One_Line); + package For_Dependencies is new Conditional_Values (Dependencies.Dependency, + Dependencies.Image); subtype Dependencies is For_Dependencies.Conditional_Value; function New_Dependency (Name : Alire.Project; @@ -17,9 +16,8 @@ package Alire.Conditional with Preelaborate is return Dependencies; - package For_Properties is new Conditional_Values (Properties.Vector, - Properties."and", - Properties.Image_One_Line); + package For_Properties is new Conditional_Values (Properties.Property'Class, + Properties.Image_Classwide); subtype Properties is For_Properties.Conditional_Value; function New_Property (Property : Alire.Properties.Property'Class) @@ -31,11 +29,10 @@ private Versions : Semantic_Versioning.Version_Set) return Dependencies is (For_Dependencies.New_Value - (Alire.Dependencies.Vectors.New_Dependency (Name, Versions))); + (Alire.Dependencies.New_Dependency (Name, Versions))); function New_Property (Property : Alire.Properties.Property'Class) return Properties is - (For_Properties.New_Value - (Alire.Properties.To_Vector (Property, 1))); + (For_Properties.New_Value (Property)); end Alire.Conditional; diff --git a/src/alire-conditional_values.adb b/src/alire-conditional_values.adb index fc984bf2..95676910 100644 --- a/src/alire-conditional_values.adb +++ b/src/alire-conditional_values.adb @@ -1,35 +1,44 @@ +with GNAT.IO; + package body Alire.Conditional_Values is + ------------- + -- Flatten -- + ------------- + + procedure Flatten (Inner : in out Vector_Inner; -- The resulting vector + This : Inner_Node'Class; -- The next node to flatten + Conj : Conjunctions) is -- To prevent mixing + begin + case This.Kind is + when Value | Condition => + Inner.Values.Append (This); + when Vector => + -- Flatten ofly if conjunction matches, otherwise just append subtree + if Vector_Inner (This).Conjunction = Conj then + for Child of Vector_Inner (This).Values loop + Flatten (Inner, Child, Conj); + end loop; + else + Inner.Values.Append (This); + end if; + end case; + end Flatten; + ----------- -- "and" -- ----------- function "and" (L, R : Conditional_Value) return Conditional_Value is - 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; + Inner : Vector_Inner := (Conjunction => Anded, Values => <>); begin if not L.Is_Empty then - Flatten (L.Constant_Reference); + Flatten (Inner, L.Constant_Reference, Anded); end if; if not R.Is_Empty then - Flatten (R.Constant_Reference); + Flatten (Inner, R.Constant_Reference, Anded); end if; if Inner.Values.Is_Empty then @@ -39,39 +48,126 @@ package body Alire.Conditional_Values is end if; end "and"; + ---------- + -- "or" -- + ---------- + + function "or" (L, R : Conditional_Value) return Conditional_Value is + Inner : Vector_Inner := (Conjunction => Ored, Values => <>); + + begin + if not L.Is_Empty then + Flatten (Inner, L.Constant_Reference, Ored); + end if; + + if not R.Is_Empty then + Flatten (Inner, R.Constant_Reference, Ored); + end if; + + if Inner.Values.Is_Empty then + return Empty; + else + return (To_Holder (Inner)); + end if; + end "or"; + ---------------- - -- All_Values -- + -- Leaf_Count -- ---------------- - function All_Values (This : Conditional_Value) return Values is - - Result : Values; - - procedure Visit (V : Conditional_Value) is - begin - case V.Kind is + function Leaf_Count (This : Conditional_Value) return Natural is + Count : Natural := 0; + begin + if This.Is_Empty then + return 0; + else + case This.Kind is when Value => - Result := Result & V.Value; + return 1; when Condition => - V.True_Value.Iterate_Children (Visit'Access); - V.False_Value.Iterate_Children (Visit'Access); + return This.True_Value.Leaf_Count + This.False_Value.Leaf_Count; when Vector => - raise Program_Error with "shouldn't happen"; + for Child of This loop + Count := Count + Child.Leaf_Count; + end loop; + return Count; + end case; + end if; + end Leaf_Count; + + ----------------- + -- Materialize -- + ----------------- + + function Materialize (This : Conditional_Value; Against : Properties.Vector) return Collection is + Col : Collection with Warnings => Off; + Pre : constant Conditional_Value := This.Evaluate (Against); + + procedure Visit (Inner : Inner_Node'Class) is + begin + case Inner.Kind is + when Value => + Append (Col, Value_Inner (Inner).Value.Constant_Reference); + when Condition => + raise Program_Error with "Should not appear in evaluated CV"; + when Vector => + if Vector_Inner (Inner).Conjunction = Anded then + for Child of Vector_Inner (Inner).Values loop + Visit (Child); + end loop; + else + raise Constraint_Error with "OR trees cannot be materialized as list"; + end if; end case; end Visit; begin - This.Iterate_Children (Visit'Access); - return Result; - end All_Values; + if not This.Is_Empty then + Visit (Pre.Constant_Reference); + end if; + return Col; + end Materialize; + + --------------- + -- Enumerate -- + --------------- + + function Enumerate (This : Conditional_Value) return Collection is + Col : Collection with Warnings => Off; + + procedure Visit (Inner : Inner_Node'Class) is + begin + case Inner.Kind is + when Value => + Append (Col, Value_Inner (Inner).Value.Constant_Reference); + when Condition => + Visit (Conditional_Inner (Inner).Then_Value.Constant_Reference); + Visit (Conditional_Inner (Inner).Else_Value.Constant_Reference); + when Vector => + if Vector_Inner (Inner).Conjunction = Anded then + for Child of Vector_Inner (Inner).Values loop + Visit (Child); + end loop; + else + raise Constraint_Error with "OR trees cannot be materialized as list"; + end if; + end case; + end Visit; + + begin + if not This.Is_Empty then + Visit (This.Constant_Reference); + end if; + return Col; + end Enumerate; -------------- -- Evaluate -- -------------- - function Evaluate (This : Conditional_Value; Against : Properties.Vector) return Values is + function Evaluate (This : Conditional_Value; Against : Properties.Vector) return Conditional_Value is - function Evaluate (This : Inner_Node'Class) return Values is + function Evaluate (This : Inner_Node'Class) return Conditional_Value is begin case This.Kind is when Condition => @@ -79,42 +175,99 @@ package body Alire.Conditional_Values is Cond : Conditional_Inner renames Conditional_Inner (This); begin if Cond.Condition.Check (Against) then - return Cond.Then_Value.Evaluate (Against); + return Evaluate (Cond.Then_Value.Element); else - return Cond.Else_Value.Evaluate (Against); + return Evaluate (Cond.Else_Value.Element); end if; end; when Value => - return Value_Inner (This).Value; + return Conditional_Value'(To_Holder (This)); when Vector => - return Result : Values do + return Result : Conditional_Value := Empty do for Cond of Vector_Inner (This).Values loop - Result := Result & Evaluate (Cond); + if Vector_Inner (This).Conjunction = Anded then + Result := Result and Evaluate (Cond); + else + Result := Result or Evaluate (Cond); + end if; end loop; end return; end case; end Evaluate; - Empty_Value : Values with Warnings => Off; - -- Default value should made sense; in our case it will be an empty vector... begin if This.Is_Empty then - return Empty_Value; + return This; else - return Evaluate (This.Constant_Reference); + return Evaluate (This.Element); end if; end Evaluate; - -------------- - -- Evaluate -- - -------------- + ------------------ + -- Contains_ORs -- + ------------------ - function Evaluate (This : Conditional_Value; Against : Properties.Vector) return Conditional_Value is - (New_Value (This.Evaluate (Against))); + function Contains_ORs (This : Conditional_Value) return Boolean is - ------------- - -- Iterate -- - ------------- + function Verify (This : Conditional_Value) return Boolean is + Contains : Boolean := False; + begin + case This.Kind is + when Value => + return False; + when Condition => + Return + This.True_Value.Contains_ORs or Else + This.False_Value.Contains_ORs; + when Vector => + if This.Conjunction = Ored then + return True; + else + for Child of This loop + Contains := Contains or else Verify (Child); + end loop; + return Contains; + end if; + end case; + end Verify; + + begin + if This.Is_Empty then + return False; + else + return Verify (This); + end if; + end Contains_ORs; + + ---------------------- + -- Is_Unconditional -- + ---------------------- + + function Is_Unconditional (This : Conditional_Value) return Boolean is + + function Verify (This : Conditional_Value) return Boolean is + Pass : Boolean := True; + begin + case This.Kind is + when Value => + return True; + when Condition => + return False; + when Vector => + for Child of This loop + Pass := Pass and then Verify (Child); + end loop; + return Pass; + end case; + end Verify; + + begin + return This.Is_Empty or else Verify (This); + end Is_Unconditional; + + ---------------------- + -- Iterate_Children -- + ---------------------- procedure Iterate_Children (This : Conditional_Value; Visitor : access procedure (CV : Conditional_Value)) @@ -124,21 +277,10 @@ package body Alire.Conditional_Values is begin case This.Kind is when Value | Condition => - Visitor (To_Holder (This)); + raise Constraint_Error with "Conditional value is not a vector"; 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; + Visitor (Conditional_Value'(To_Holder (Inner))); end loop; end case; end Iterate; @@ -171,4 +313,113 @@ package body Alire.Conditional_Values is end Case_Statements; + ----------- + -- Print -- + ----------- + + procedure Print (This : Conditional_Value; + Prefix : String := ""; + And_Or : Boolean := True) is + use GNAT.IO; + Tab : constant String := " "; + +-- function Image (C : Conjunctions) return String is +-- (case C is +-- when Anded => "and", +-- when Ored => "or"); + + begin + if This.Is_Empty then + Put_Line (Prefix & "(empty)"); + return; + end if; + + case This.Kind is + when Value => + Put_Line (Prefix & Image (This.Value)); + when Condition => + Put_Line (Prefix & "when " & This.Condition.Image & ":"); + Print (This.True_Value, Prefix & Tab); + if not This.False_Value.Is_Empty then + Put_Line (Prefix & "else:"); + Print (This.False_Value, Prefix & Tab); + end if; + when Vector => + if And_Or then + case This.Conjunction is + when Anded => Put_Line (Prefix & "All of:"); + when Ored => Put_Line (Prefix & "First available of:"); + end case; + end if; + + for I in This.Iterate loop + Print (This (I), + (if And_Or then Prefix else "") & " "); + end loop; + end case; + end Print; + + ----------------- + -- ITERATORS -- + ----------------- + + type Forward_Iterator is new Iterators.Forward_Iterator with record + Children : Vectors.Vector; + end record; + + ----------- + -- First -- + ----------- + + overriding function First (Object : Forward_Iterator) return Cursor is + (Cursor (Object.Children.First)); + + ---------- + -- Next -- + ---------- + + function Next (This : Cursor) return Cursor is + (Cursor (Vectors.Next (Vectors.Cursor (This)))); + + ---------- + -- Next -- + ---------- + + overriding function Next (Object : Forward_Iterator; + Position : Cursor) return Cursor is + (Next (Position)); + + ----------------- + -- Has_Element -- + ----------------- + + function Has_Element (This : Cursor) return Boolean is + (Vectors.Has_Element (Vectors.Cursor (This))); + + ------------- + -- Iterate -- + ------------- + + function Iterate (Container : Conditional_Value) + return Iterators.Forward_Iterator'Class is + begin + if Container.Kind /= Vector then + raise Constraint_Error + with "Cannot iterate over non-vector conditional value"; + end if; + + return Forward_Iterator' + (Children => + Vector_Inner (Container.Constant_Reference.Element.all).Values); + end Iterate; + + --------------------- + -- Indexed_Element -- + --------------------- + + function Indexed_Element (Container : Conditional_Value; + Pos : Cursor) + return Conditional_Value is + (Conditional_Value'(To_Holder (Element (Pos)))); + end Alire.Conditional_Values; diff --git a/src/alire-conditional_values.ads b/src/alire-conditional_values.ads index cf4d9b25..c0f34640 100644 --- a/src/alire-conditional_values.ads +++ b/src/alire-conditional_values.ads @@ -1,3 +1,6 @@ +with Ada.Containers; use Ada.Containers; +with Ada.Iterator_Interfaces; + with Alire.Properties; with Alire.Requisites; with Alire.Utils; @@ -6,21 +9,39 @@ private with Ada.Containers.Indefinite_Holders; private with Ada.Containers.Indefinite_Vectors; generic - type Values is private; - with function "&" (L, R : Values) return Values; + type Values (<>) is private; with function Image (V : Values) return String; package Alire.Conditional_Values with Preelaborate is type Kinds is (Condition, Value, Vector); - type Conditional_Value is tagged private; + type Conditional_Value is tagged private with + Default_Iterator => Iterate, + Iterator_Element => Conditional_Value, + Constant_Indexing => Indexed_Element; -- Recursive type that stores conditions (requisites) and values/further conditions if they are met or not - function Evaluate (This : Conditional_Value; Against : Properties.Vector) return Values; - -- Materialize against the given properties + function Leaf_Count (This : Conditional_Value) return Natural; + + generic + type Collection is private; + with procedure Append (C : in out Collection; V : Values; Count : Count_Type := 1); + function Materialize (This : Conditional_Value; 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 : Conditional_Value) return Collection; + -- Return all value nodes, regardless of dependencies/conjunctions + -- This is used for textual search and has no semantic trascendence function Evaluate (This : Conditional_Value; Against : Properties.Vector) return Conditional_Value; - -- Materialize against the given properties, returning values as an unconditional vector + -- 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 : Conditional_Value) return Kinds; @@ -28,16 +49,13 @@ 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 (value or condition) - -- Vector children will be iterated too, so a flat hierarchy will be mimicked for those - - function All_Values (This : Conditional_Value) return Values; - -- Returns all values herein, both true and false, at any depth - function Image_One_Line (This : Conditional_Value) return String; + function Is_Unconditional (This : Conditional_Value) return Boolean; + -- Recursively! + + function Contains_ORs (This : Conditional_Value) return Boolean; + --------------- -- SINGLES -- --------------- @@ -54,6 +72,17 @@ package Alire.Conditional_Values with Preelaborate is function "and" (L, R : Conditional_Value) return Conditional_Value; -- Concatenation + function "or" (L, R : Conditional_Value) return Conditional_Value; + + type Conjunctions is (Anded, Ored); + + function Conjunction (This : Conditional_Value) return Conjunctions + with Pre => This.Kind = Vector; + + procedure Iterate_Children (This : Conditional_Value; + Visitor : access procedure (CV : Conditional_Value)); + -- There is "of" notation too, but that bugs out when using this package as generic formal + -------------------- -- CONDITIONALS -- -------------------- @@ -83,6 +112,35 @@ package Alire.Conditional_Values with Preelaborate is end Case_Statements; + ----------- + -- Print -- + ----------- + + procedure Print (This : Conditional_Value; + 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 : Conditional_Value) + 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 : Conditional_Value; Pos : Cursor) + return Conditional_Value; + private type Inner_Node is abstract tagged null record; @@ -96,31 +154,48 @@ private 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 Conditional_Value 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 : Values; + Value : Definite_Values.Holder; end record; overriding function Image (V : Value_Inner) return String is - (Image (V.Value)); + (Image (V.Value.Constant_Reference)); type Vector_Inner is new Inner_Node with record - Values : Vectors.Vector; + Conjunction : Conjunctions; + Values : Vectors.Vector; end record; + function Conjunction (This : Vector_Inner) return Conjunctions is + (This.Conjunction); + package Non_Primitive is - function One_Liner is new Utils.Image_One_Line + 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 - (Non_Primitive.One_Liner (V.Values)); + (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; @@ -129,7 +204,7 @@ private end record; overriding function Image (V : Conditional_Inner) return String is - ("when " & V.Condition.Image & + ("if " & V.Condition.Image & " then " & V.Then_Value.Image_One_Line & " else " & V.Else_Value.Image_One_Line); @@ -139,7 +214,7 @@ private function As_Value (This : Conditional_Value) return Values is - (Value_Inner (This.Constant_Reference.Element.all).Value) + (Value_Inner (This.Element).Value.Element) with Pre => This.Kind = Value; -------------------- @@ -156,7 +231,14 @@ private function As_Vector (This : Conditional_Value) return Vectors.Vector is (Vector_Inner'Class (This.Element).Values) - with Pre => This.Kind = Vector; + with Pre => This.Kind = Vector; + + ----------------- + -- Conjunction -- + ----------------- + + function Conjunction (This : Conditional_Value) return Conjunctions is + (Vector_Inner'Class (This.Element).Conjunction); --------------------- -- New_Conditional -- @@ -174,7 +256,7 @@ private --------------- function New_Value (V : Values) return Conditional_Value is - (To_Holder (Value_Inner'(Value => V))); + (To_Holder (Value_Inner'(Value => Definite_Values.To_Holder (V)))); --------------- -- Condition -- @@ -231,6 +313,10 @@ private function Kind (This : Conditional_Value) return Kinds is (This.Constant_Reference.Kind); + -------------------- + -- Image_One_Line -- + -------------------- + function Image_One_Line (This : Conditional_Value) return String is (if This.Is_Empty then "(empty condition)" diff --git a/src/alire-containers.adb b/src/alire-containers.adb index 112d6290..98226989 100644 --- a/src/alire-containers.adb +++ b/src/alire-containers.adb @@ -26,13 +26,16 @@ package body Alire.Containers is -- To_Dependencies -- --------------------- - function To_Dependencies (Map : Release_Map) return Dependencies.Vectors.Vector is + function To_Dependencies (Map : Release_Map) return Conditional.Dependencies is + use Conditional.For_Dependencies; begin - return Deps : Dependencies.Vectors.Vector do + return Deps : Conditional.Dependencies do for R of Map loop - Deps.Append (Dependencies.New_Dependency - (R.Project, - Semantic_Versioning.Exactly (R.Version))); + Deps := + Deps and + Conditional.New_Dependency + (R.Project, + Semantic_Versioning.Exactly (R.Version)); end loop; end return; end To_Dependencies; diff --git a/src/alire-containers.ads b/src/alire-containers.ads index 3c0c1b02..fd1299bd 100644 --- a/src/alire-containers.ads +++ b/src/alire-containers.ads @@ -2,7 +2,7 @@ with Ada.Containers.Indefinite_Holders; with Ada.Containers.Indefinite_Ordered_Maps; with Ada.Containers.Indefinite_Ordered_Sets; -with Alire.Dependencies.Vectors; +with Alire.Conditional; with Alire.Milestones; with Alire.Releases; @@ -43,7 +43,8 @@ package Alire.Containers with Preelaborate is function Including (Map : Release_Map; Release : Releases.Release) return Release_Map; -- Finds the current release (if existing) and replaces/adds the new Release - function To_Dependencies (Map : Release_Map) return Dependencies.Vectors.Vector; + function To_Dependencies (Map : Release_Map) + return Conditional.Dependencies; function To_Map (R : Releases.Release) return Release_Map; diff --git a/src/alire-index.ads b/src/alire-index.ads index 54655274..f37f684f 100644 --- a/src/alire-index.ads +++ b/src/alire-index.ads @@ -14,7 +14,7 @@ with Alire.Properties.Licenses; with Alire.Properties.Scenarios; with Alire.Releases; with Alire.Requisites; -with Alire.Requisites.Dependencies; +-- with Alire.Requisites.Dependencies; with Alire.Requisites.Platform; with Alire.Root; with Alire.Roots; @@ -218,16 +218,13 @@ package Alire.Index is return Release_Dependencies renames Conditional.For_Dependencies.New_Conditional; -- Explicitly conditional + + function Case_Distribution_Is (Arr : Requisites.Platform.Distribution_Cases_Deps.Arrays) + return Release_Dependencies + renames Requisites.Platform.Distribution_Cases_Deps.Case_Is; - function When_Available (Preferred : Release_Dependencies; - Otherwise : Release_Dependencies := Unavailable) - return Release_Dependencies is - (On_Condition (Requisites.Dependencies.New_Requisite (Preferred), - Preferred, - Otherwise)); - -- Chained conditional dependencies (use first available) - - function "or" (L, R : Release_Dependencies) return Release_Dependencies is (When_Available (L, R)); + function "or" (L, R : Release_Dependencies) return Release_Dependencies + renames Conditional.For_Dependencies."or"; -- In the sense of "or else": the first one that is available will be taken function "and" (L, R : Release_Dependencies) return Release_Dependencies @@ -260,8 +257,10 @@ package Alire.Index is function Case_Compiler_Is (Arr : Requisites.Platform.Compiler_Cases.Arrays) return Release_Properties renames Requisites.Platform.Compiler_Cases.Case_Is; - -- Case on compile values - -- TODO: Cases on other enum properties (platform, etc) + + function Case_Distribution_Is (Arr : Requisites.Platform.Distribution_Cases_Props.Arrays) + return Release_Properties + renames Requisites.Platform.Distribution_Cases_Props.Case_Is; function Case_Operating_System_Is (Arr : Requisites.Platform.Op_System_Cases.Arrays) return Release_Properties @@ -278,19 +277,21 @@ package Alire.Index is function Maintainer is new PL.Cond_New_Label (Properties.Labeled.Maintainer); function Website is new PL.Cond_New_Label (Properties.Labeled.Website); - function U (Prop : Properties.Vector) return Conditional.Properties renames Conditional.For_Properties.New_Value; - function U (Prop : Properties.Property'Class) return Conditional.Properties is (U (+Prop)); +-- function U (Prop : Properties.Vector) return Conditional.Properties renames Conditional.For_Properties.New_Value; + function U (Prop : Properties.Property'Class) return Conditional.Properties + renames Conditional.For_Properties.New_Value; +-- (U (+Prop)); -- Non-label attributes or processed data require a custom builder function - function GPR_Free_Scenario (Name : String) return Properties.Vector is (+Properties.Scenarios.New_Property (GPR.Free_Variable (Name))); - function GPR_Free_Scenario (Name : String) return Conditional.Properties is (U (GPR_Free_Scenario (Name))); + function GPR_Free_Scenario (Name : String) return Conditional.Properties is + (U (Properties.Scenarios.New_Property (GPR.Free_Variable (Name)))); - function GPR_Scenario (Name : String; Values : GPR.Value_Vector) return Properties.Vector is (+Properties.Scenarios.New_Property (GPR.Enum_Variable (Name, Values))); - function GPR_Scenario (Name : String; Values : GPR.Value_Vector) return Conditional.Properties is (U (GPR_Scenario (Name, Values))); + function GPR_Scenario (Name : String; Values : GPR.Value_Vector) return Conditional.Properties is + (U (Properties.Scenarios.New_Property (GPR.Enum_Variable (Name, Values)))); - function License (L : Licensing.Licenses) return Properties.Vector is (+Properties.Licenses.Values.New_Property (L)); - function License (L : Licensing.Licenses) return Conditional.Properties is (U (License (L))); + function License (L : Licensing.Licenses) return Conditional.Properties is + (U (Properties.Licenses.Values.New_Property (L))); function Project_File (File : Platform_Independent_Path) return Release_Properties; @@ -309,7 +310,7 @@ package Alire.Index is (U (Actions.New_Run (Moment, Relative_Command, Working_Folder))); function GPR_External (Name : String; Value : String) return Conditional.Properties is - (U (+Properties.Scenarios.New_Property (GPR.External_Value (Name, Value)))); + (U (Properties.Scenarios.New_Property (GPR.External_Value (Name, Value)))); ------------------ -- REQUISITES -- @@ -363,7 +364,7 @@ private function New_Dependency (L : Catalog_Entry; VS : Semantic_Versioning.Version_Set) return Conditional.Dependencies is (Conditional.For_Dependencies.New_Value -- A conditional (without condition) dependency vector - (Dependencies.Vectors.New_Dependency (L.Project, VS))); + (Dependencies.New_Dependency (L.Project, VS))); function Ada_Identifier (C : Catalog_Entry) return String is ((if Utils.To_Lower_Case (C.Package_Name) = "alire" @@ -401,6 +402,6 @@ private function Unavailable return Conditional.Dependencies is (Conditional.For_Dependencies.New_Value -- A conditional (without condition) dependency vector - (Dependencies.Vectors.To_Vector (Dependencies.Unavailable, 1))); + (Dependencies.Unavailable)); end Alire.Index; diff --git a/src/alire-platform.ads b/src/alire-platform.ads index ed0e96e5..668b6abb 100644 --- a/src/alire-platform.ads +++ b/src/alire-platform.ads @@ -7,7 +7,9 @@ package Alire.Platform with Preelaborate is type Supported_Platform is interface; - function Package_Version (P : Supported_Platform; Origin : Origins.Origin) return String is abstract; + function Package_Version (P : Supported_Platform; + Origin : Origins.Origin) + return String is abstract; procedure Set (P : Supported_Platform'Class); diff --git a/src/alire-properties-labeled.ads b/src/alire-properties-labeled.ads index 9aeffce7..3c569c58 100644 --- a/src/alire-properties-labeled.ads +++ b/src/alire-properties-labeled.ads @@ -53,7 +53,7 @@ private -- (To_Vector (New_Label (Name, Value), 1)); function Cond_New_Label (Value : String) return Conditional.Properties is - (Conditional.For_Properties.New_Value (+New_Label (Name, Value))); + (Conditional.For_Properties.New_Value (New_Label (Name, Value))); overriding function Image (L : Label) return String is (Utils.To_Mixed_Case (L.Name'Img) & ": " & L.Value); diff --git a/src/alire-properties.adb b/src/alire-properties.adb deleted file mode 100644 index 383da304..00000000 --- a/src/alire-properties.adb +++ /dev/null @@ -1,16 +0,0 @@ -with GNAT.IO; - -package body Alire.Properties is - - ----------- - -- Print -- - ----------- - - procedure Print (V : Vector; Prefix : String := "") is - begin - for Prop of V loop - GNAT.IO.Put_Line (Prefix & Prop.Image); - end loop; - end Print; - -end Alire.Properties; diff --git a/src/alire-properties.ads b/src/alire-properties.ads index 866e5938..9243fac9 100644 --- a/src/alire-properties.ads +++ b/src/alire-properties.ads @@ -24,8 +24,6 @@ package Alire.Properties with Preelaborate is No_Properties : constant Vector; - procedure Print (V : Vector; Prefix : String := ""); - function Empty_Properties return Vector; -- function "and" (L, R : Property'Class) return Vector; diff --git a/src/alire-releases.adb b/src/alire-releases.adb index dea2a30b..a4232e72 100644 --- a/src/alire-releases.adb +++ b/src/alire-releases.adb @@ -1,4 +1,3 @@ -with Alire.Conditional_Values; with Alire.Platform; with Alire.Platforms; with Alire.Projects; @@ -16,8 +15,9 @@ package body Alire.Releases is -- All_Properties -- -------------------- - function All_Properties (R : Release) return Conditional.Properties is - (R.Properties and R.Priv_Props); + function All_Properties (R : Release; + P : Properties.Vector) return Properties.Vector is + (Materialize (R.Properties and R.Priv_Props, P)); --------------- @@ -138,12 +138,13 @@ package body Alire.Releases is function On_Platform_Properties (R : Release; P : Properties.Vector; - Descendant_Of : Ada.Tags.Tag := Ada.Tags.No_Tag) return Properties.Vector + Descendant_Of : Ada.Tags.Tag := Ada.Tags.No_Tag) + return Properties.Vector is use Ada.Tags; begin if Descendant_Of = No_Tag then - return R.Properties.Evaluate (P) and R.Priv_Props.Evaluate (P); + return Materialize (R.Properties, P) and Materialize (R.Priv_Props, P); else declare Props : constant Properties.Vector := R.On_Platform_Properties (P); @@ -190,7 +191,9 @@ package body Alire.Releases is return Utils.String_Vector is begin - return Exes : Utils.String_Vector := Values (R.All_Properties.Evaluate (P), Executable) do + return Exes : Utils.String_Vector := + Values (R.All_Properties (P), Executable) + do if OS_Lib.Exe_Suffix /= "" then for I in Exes.Iterate loop Exes (I) := Exes (I) & OS_Lib.Exe_Suffix; @@ -210,7 +213,7 @@ package body Alire.Releases is is use Utils; - With_Paths : Utils.String_Vector := Values (R.All_Properties.Evaluate (P), Project_File); + With_Paths : Utils.String_Vector := Values (R.All_Properties (P), Project_File); Without : Utils.String_Vector; begin if With_Paths.Is_Empty then @@ -262,68 +265,15 @@ package body Alire.Releases is return Utils.String_Vector is begin - return Values (R.All_Properties.Evaluate (P), Label); + return Values (R.All_Properties (P), Label); end Labeled_Properties; - ----------------------- - -- Print_Conditional -- - ----------------------- - - 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 - This.Iterate_Children (Visit'Access); - end Print_Conditional; - ----------- -- Print -- ----------- procedure Print (R : Release; Private_Too : Boolean := False) 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 & ": " & Projects.Descriptions (R.Project)); @@ -360,19 +310,19 @@ package body Alire.Releases is -- PROPERTIES if not R.Properties.Is_Empty then Put_Line ("Properties:"); - Print_Properties (" ", R.Properties); + R.Properties.Print (" ", False); end if; -- PRIVATE PROPERTIES if Private_Too and then not R.Properties.Is_Empty then Put_Line ("Private properties:"); - Print_Properties (" ", R.Priv_Props); + R.Priv_Props.Print (" ", False); end if; -- DEPENDENCIES if not R.Dependencies.Is_Empty then Put_Line ("Dependencies (direct):"); - Print_Dependencies (" ", R.Dependencies); + R.Dependencies.Print (" ", R.Dependencies.Contains_ORs); end if; end Print; @@ -385,7 +335,7 @@ package body Alire.Releases is Search : constant String := To_Lower_Case (Str); begin - for P of R.All_Properties.All_Values loop + for P of Enumerate (R.Properties and R.Priv_Props) loop declare Text : constant String := To_Lower_Case diff --git a/src/alire-releases.ads b/src/alire-releases.ads index 2f112173..5c4ba910 100644 --- a/src/alire-releases.ads +++ b/src/alire-releases.ads @@ -2,8 +2,8 @@ with Ada.Tags; with Alire.Actions; with Alire.Conditional; -with Alire.Dependencies; -with Alire.Dependencies.Vectors; +-- with Alire.Dependencies; +-- with Alire.Dependencies.Vectors; with Alire.Milestones; with Alire.Origins; with Alire.Properties; @@ -18,7 +18,7 @@ private with Alire.OS_Lib; package Alire.Releases with Preelaborate is - subtype Dependency_Vector is Dependencies.Vectors.Vector; +-- subtype Dependency_Vector is Dependencies.Vectors.Vector; type Release (<>) is new Versions.Versioned with private; @@ -79,7 +79,8 @@ package Alire.Releases with Preelaborate is function Depends (R : Release; P : Properties.Vector) - return Dependency_Vector; + return Conditional.Dependencies; + -- Not really conditional anymore, but still a potential tree function Origin (R : Release) return Origins.Origin; function Available (R : Release) return Requisites.Tree; @@ -113,11 +114,14 @@ package Alire.Releases with Preelaborate is function On_Platform_Properties (R : Release; P : Properties.Vector; - Descendant_Of : Ada.Tags.Tag := Ada.Tags.No_Tag) return Properties.Vector; + Descendant_Of : Ada.Tags.Tag := Ada.Tags.No_Tag) + return Properties.Vector; -- Return properties that apply to R under platform properties P - function Labeled_Properties (R : Release; P : Properties.Vector; Label : Properties.Labeled.Labels) - return Utils.String_Vector; + function Labeled_Properties (R : Release; + P : Properties.Vector; + Label : Properties.Labeled.Labels) + return Utils.String_Vector; -- Get all values for a given property for a given platform properties function Milestone (R : Release) return Milestones.Milestone; @@ -130,22 +134,19 @@ package Alire.Releases with Preelaborate is function Property_Contains (R : Release; Str : String) return Boolean; -- True if some property contains the given string - -- Dependency generation helpers for all semantic versioning functions: - -- These are here to avoid a 'body not seen' Program_Error if they were in Index - --- function On (Name : Alire.Project; --- Versions : Semantic_Versioning.Version_Set) --- return Conditional.Dependencies; --- --- generic --- with function Condition (V : Semantic_Versioning.Version) return Semantic_Versioning.Version_Set; --- function From_Release (R : Release) return Conditional.Dependencies; - private use Semantic_Versioning; - function All_Properties (R : Release) return Conditional.Properties; + function Materialize is new Conditional.For_Properties.Materialize + (Properties.Vector, Properties.Append); + + function Enumerate is new Conditional.For_Properties.Enumerate + (Properties.Vector, Properties.Append); + + function All_Properties (R : Release; + P : Properties.Vector) return Properties.vector; + -- Properties that R has un der platform properties P use Alire.Properties; function Comment is new Alire.Properties.Labeled.Cond_New_Label (Alire.Properties.Labeled.Comment); @@ -188,7 +189,8 @@ private function Depends (R : Release; P : Properties.Vector) - return Dependency_Vector is (R.Dependencies.Evaluate (P)); + return Conditional.Dependencies is + (R.Dependencies.Evaluate (P)); function Origin (R : Release) return Origins.Origin is (R.Origin); function Available (R : Release) return Requisites.Tree is (R.Available); diff --git a/src/alire-requisites-dependencies.ads b/src/alire-requisites-dependencies.ads deleted file mode 100644 index 276a52c6..00000000 --- a/src/alire-requisites-dependencies.ads +++ /dev/null @@ -1,39 +0,0 @@ -with Alire.Conditional; -with Alire.Properties.Dependencies; - -package Alire.Requisites.Dependencies with Preelaborate is - - -- Special requisite that is fulfilled when a dependency is available on a platform - -- This is checked against a special property that encapsulates the check of - -- actual packages available once the platform is known - - package Matched is new For_Property (Properties.Dependencies.Availability_Checker); - - type Requisite is new Matched.Requisite with private; - - function New_Requisite (On : Conditional.Dependencies) return Tree; - - overriding function Is_Satisfied (R : Requisite; - P : Properties.Dependencies.Availability_Checker) - return Boolean; - - overriding function Image (R : Requisite) return String; - -private - - type Requisite is new Matched.Requisite with record - Deps : Conditional.Dependencies; - end record; - - function New_Requisite (On : Conditional.Dependencies) return Tree is - (Trees.Leaf (Requisite'(Deps => On))); - - overriding function Is_Satisfied (R : Requisite; - P : Properties.Dependencies.Availability_Checker) - return Boolean is - (P.Checker.all (R.Deps.Evaluate (P.Properties))); - - overriding function Image (R : Requisite) return String is - (R.Deps.Image_One_Line & " resolvable"); - -end Alire.Requisites.Dependencies; diff --git a/src/alire-requisites-platform.ads b/src/alire-requisites-platform.ads index e6dd0335..a29457f5 100644 --- a/src/alire-requisites-platform.ads +++ b/src/alire-requisites-platform.ads @@ -42,6 +42,12 @@ package Alire.Requisites.Platform with Preelaborate is PrPl.Distributions.Element, "Distribution"); + package Distribution_Cases_Deps is new Conditional.For_Dependencies.Case_Statements + (Ps.Distributions, Distributions.Is_Equal_To); + + package Distribution_Cases_Props is new Conditional.For_Properties.Case_Statements + (Ps.Distributions, Distributions.Is_Equal_To); + package Versions is new Comparables (Ps.Versions, Ps."<", Ps.Versions'Image, PrPl.Versions.Property, diff --git a/src/alire-types.ads b/src/alire-types.ads index 25280c9a..1d078044 100644 --- a/src/alire-types.ads +++ b/src/alire-types.ads @@ -1,6 +1,6 @@ with Alire.Conditional; with Alire.Dependencies; -with Alire.Dependencies.Vectors; +-- with Alire.Dependencies.Vectors; with Alire.Releases; package Alire.Types with Preelaborate is @@ -10,12 +10,16 @@ package Alire.Types with Preelaborate is subtype Dependency is Dependencies.Dependency; -- A single dependency on a single project+versions - subtype Platform_Dependencies is Dependencies.Vectors.Vector; - -- A plain vector, all dependencies must be met + subtype Platform_Dependencies is Conditional.Dependencies + with Dynamic_Predicate => Platform_Dependencies.Is_Unconditional; + -- A plain tree without conditions (but might have OR nodes) subtype Abstract_Dependencies is Conditional.Dependencies; -- Conditional dependencies as yet unmaterialized for a precise platform + function No_Dependencies return Conditional.Dependencies + renames Conditional.For_Dependencies.Empty; + subtype Release is Releases.Release; -- A catalogued release