alire/alire-index-community
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

checkpoint 1

Browse Source
This commit is contained in:
Alejandro R Mosteo
2018-05-06 17:05:20 +02:00
parent 3a05672ddf
commit cf1da607e8
19 changed files with 552 additions and 312 deletions
Download Patch File Download Diff File Expand all files Collapse all files
deps/semver
Vendored
+1 -1
Submodule deps/semver updated: 3480c76110...dc462f11ad
index/alire-index-adacurses.ads
+18 -27
View File
@@ -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;
index/alire-index-alire.ads
+2 -8
View File
@@ -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"),
index/alire-index-xstrings.ads
+9
View File
@@ -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;
src/alire-conditional.ads
+7 -10
View File
@@ -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;
src/alire-conditional_values.adb
+317 -66
View File
@@ -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;
src/alire-conditional_values.ads
+109 -23
View File
@@ -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)"
src/alire-containers.adb
+8 -5
View File
@@ -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;
src/alire-containers.ads
+3 -2
View File
@@ -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;
src/alire-index.ads
+24 -23
View File
@@ -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;
src/alire-platform.ads
+3 -1
View File
@@ -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);
src/alire-properties-labeled.ads
+1 -1
View File
@@ -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);
src/alire-properties.adb
-16
View File
@@ -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;
src/alire-properties.ads
-2
View File
@@ -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;
src/alire-releases.adb
+15 -65
View File
@@ -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
src/alire-releases.ads
+22 -20
View File
@@ -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);
src/alire-requisites-dependencies.ads
-39
View File
@@ -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;
src/alire-requisites-platform.ads
+6
View File
@@ -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,
src/alire-types.ads
+7 -3
View File
@@ -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