Better expression requisites

This commit is contained in:
Alejandro R Mosteo
2018-03-09 10:32:30 +01:00
parent a2188c5971
commit 8ddac31165
12 changed files with 79 additions and 126 deletions
+3 -3
View File
@@ -21,11 +21,11 @@ package body Alire.GPR is
begin
case V.Kind is
when Free_String =>
return V.Name & " = <string>";
return V.Name & " := <string>";
when Enumeration =>
return V.Name & " = " & Listify (V.Values);
return V.Name & " := " & Listify (V.Values);
when External =>
return V.Name & " = " & V.Value.First_Element;
return V.Name & " := " & V.Value.First_Element;
end case;
end Image;
+11 -13
View File
@@ -231,25 +231,23 @@ package Alire.Index is
-- REQUISITES --
------------------
use all type Requisites.Tree;
package Plat_Reqs renames Requisites.Platform;
function Compiler_Is_Native return Release_Requisites renames Plat_Reqs.Compiler_Is_Native;
function Compiler_Is (V : Platforms.Compilers) return Release_Requisites renames Plat_Reqs.Compiler_Is;
function Compiler_Less_Than (V : Platforms.Compilers) return Release_Requisites renames Plat_Reqs.Compiler_Less_Than;
function Compiler_At_Least (V : Platforms.Compilers) return Release_Requisites is (not Compiler_Less_Than (V));
function Compiler is new Requisites.Platform.Compilers.Factory;
function Compiler_Is_Native return Release_Requisites renames Plat_Reqs.Compiler_Is_Native;
use all type Requisites.Platform.Compilers.Comparable;
function Distribution_Is (V : Platforms.Distributions) return Release_Requisites renames Plat_Reqs.Distribution_Is;
function Distribution is new Requisites.Platform.Distributions.Factory;
use all type Requisites.Platform.Distributions.Comparable;
function OS return Requisites.Platform.Systs.Comparable renames Requisites.Platform.Systs.New_Comparable;
use all type Requisites.Platform.Systs.Comparable;
function Operating_System is new Requisites.Platform.Op_Systems.Factory;
use all type Requisites.Platform.Op_Systems.Comparable;
function System_Is (V : Platforms.Operating_Systems) return Release_Requisites renames Plat_Reqs.System_Is;
function Distro_Release is new Requisites.Platform.Versions.Factory;
use all type Requisites.Platform.Versions.Comparable;
function Version_is (V : Platforms.Versions) return Release_Requisites renames Plat_Reqs.Version_Is;
function Word_Size_Is (V : Platforms.Word_Sizes) return Release_Requisites renames Plat_Reqs.Word_Size_Is;
function Word_Size is new Requisites.Platform.Word_Sizes.Factory;
use all type Requisites.Platform.Word_Sizes.Comparable;
----------------------
-- Set_Root_Project --
+11 -3
View File
@@ -1,3 +1,5 @@
with Alire.Utils;
generic
-- Encapsulated basic type
type Value is private;
@@ -21,6 +23,10 @@ package Alire.Requisites.Comparables with Preelaborate is
not overriding function New_Comparable return Comparable;
-- This is the root function that can be renamed to a sensible name to appear in expressions
generic
function Factory return Comparable;
-- Alternatively this makes for a simpler instantiation since no profile is needed
function "=" (L : Comparable; R : Value) return Tree;
function "=" (L : Value; R : Comparable) return Tree;
@@ -53,13 +59,15 @@ private
(case R.Kind is
when Base => raise Constraint_Error with "Is_Satisfied: Requisite without operation",
when Equality => R.Value = Element (P),
when Ordering => R.Value < Element (P));
when Ordering => Element (P) < R.Value);
overriding function Image (R : Comparable) return String is
(case R.Kind is
when Base => raise Constraint_Error with "Image: Requisite without operation",
when Equality => Name & " = " & Image (R.Value),
when Ordering => Name & " < " & Image (R.Value));
when Equality => Name & " = " & Utils.To_Mixed_Case (Image (R.Value)),
when Ordering => Name & " < " & Utils.To_Mixed_Case (Image (R.Value)));
function Factory return Comparable is (New_Comparable);
use all type Tree;
+30 -21
View File
@@ -5,36 +5,45 @@ with Alire.Requisites.Comparables;
package Alire.Requisites.Platform with Preelaborate is
package Plat renames Properties.Platform;
package Ps renames Platforms;
package PrPl renames Properties.Platform;
use all type Platforms.Compilers;
use all type Ps.Compilers;
use all type Tree;
package Systs is new Comparables
(Platforms.Operating_Systems, Platforms."<", Platforms.Operating_Systems'Image,
Properties.Platform.Operating_Systems.Property,
Properties.Platform.Operating_Systems.Element,
package Op_Systems is new Comparables
(Ps.Operating_Systems, Ps."<", Ps.Operating_Systems'Image,
PrPl.Operating_Systems.Property,
PrPl.Operating_Systems.Element,
"OS");
package Compilers is new Requisites.For_Value_Property (Plat.Compilers, "Compiler");
function Compiler_Is (V : Platforms.Compilers) return Tree renames Compilers.New_Equality;
package Compilers_Less is new Compilers.Comparators (Platforms."<", "<");
function Compiler_Less_Than (V : Platforms.Compilers) return Tree renames Compilers_Less.New_Comparator;
package Compilers is new Comparables
(Ps.Compilers, Ps."<", Ps.Compilers'Image,
PrPl.Compilers.Property,
PrPl.Compilers.Element,
"Compiler");
use all type Compilers.Comparable;
function Compiler is new Compilers.Factory;
function Compiler_Is_Native return Tree is
(Compiler_Less_Than (GNAT_GPL_2017) and not Compiler_Is (GNAT_Unknown));
(Compiler < GNAT_GPL_2017 and Compiler /= GNAT_Unknown);
package Distributions is new Requisites.For_Value_Property (Plat.Distributions, "Distribution");
function Distribution_Is (V : Platforms.Distributions) return Tree renames Distributions.New_Equality;
package Distributions is new Comparables
(Ps.Distributions, Ps."<", Ps.Distributions'Image,
PrPl.Distributions.Property,
PrPl.Distributions.Element,
"Distribution");
package Systems is new Requisites.For_Value_Property (Plat.Operating_Systems, "OS");
function System_Is (V : Platforms.Operating_Systems) return Tree renames Systems.New_Equality;
package Versions is new Comparables
(Ps.Versions, Ps."<", Ps.Versions'Image,
PrPl.Versions.Property,
PrPl.Versions.Element,
"Version");
package Versions is new Requisites.For_Value_Property (Plat.Versions, "Version");
function Version_Is (V : Platforms.Versions) return Tree renames Versions.New_Equality;
package Word_Sizes is new Requisites.For_Value_Property (Plat.Word_Sizes, "Arquitecture width");
function Word_Size_Is (V : Platforms.Word_Sizes) return Tree renames Word_Sizes.New_Equality;
package Word_Sizes is new Comparables
(Ps.Word_Sizes, Ps."<", Ps.Word_Sizes'Image,
PrPl.Word_Sizes.Property,
PrPl.Word_Sizes.Element,
"Word_Size");
end Alire.Requisites.Platform;
-61
View File
@@ -1,6 +1,5 @@
with Alire.Boolean_Trees;
with Alire.Properties;
with Alire.Utils;
package Alire.Requisites with Preelaborate is
@@ -72,64 +71,4 @@ package Alire.Requisites with Preelaborate is
end For_Property;
--------------
-- EXTRAS --
--------------
-- This following requisite is a matching requisite for value properties
-- Concevably, this could be expanded to offer >=, <, <=...
generic
with package Values is new Properties.Values (<>);
-- The property that encapsulates the requisite value
Name : String; -- used for image "Name is Mixed_Case (Image (Value))"
package For_Value_Property is
package Value_Requisites is new For_Property (Values.Property);
type Equality is new Value_Requisites.Requisite with record
Value : Values.Value;
end record;
function New_Equality (V : Values.Value) return Tree is
(Trees.Leaf (Equality'(Value => V)));
function Mix (S : String) return String renames Utils.To_Mixed_Case;
use all type Values.Value;
overriding function Is_Satisfied (R : Equality; P : Values.Property) return Boolean is
(R.Value = P.Element);
overriding function Image (R : Equality) return String is
(Name & " is " & Mix (Values.Image (R.Value)));
-----------------
-- Comparators --
-----------------
generic
with function Compare (L, R : Values.Value) return Boolean;
Image_Of_Compare : String; -- e.g., "<"
package Comparators is
type Comparator is new Value_Requisites.Requisite with record
Value : Values.Value;
end record;
function New_Comparator (V : Values.Value) return Tree is (Trees.Leaf (Comparator'(Value => V)));
overriding function Is_Satisfied (R : Comparator;
P : Values.Property)
return Boolean is
(Compare (P.Element, R.Value));
overriding function Image (R : Comparator)
return String is
(Name & " " & Image_Of_Compare & " " & Mix (Values.Image (R.Value)));
end Comparators;
end For_Value_Property;
end Alire.Requisites;