diff --git a/index/alire-index-alire.ads b/index/alire-index-alire.ads index ebbf870b..bd8a0830 100644 --- a/index/alire-index-alire.ads +++ b/index/alire-index-alire.ads @@ -83,7 +83,8 @@ package Alire.Index.Alire is Website ("http://www.www.www"), -- Unconditional properties - Available_When => -- Impossible mix + Available_When => -- Impossible mix + OS = GNU_Linux or OS /= GNU_Linux or (System_Is (Windows) and System_Is (GNU_Linux)) or (Compiler_Is (GNAT_Unknown) and not Compiler_Is (GNAT_Unknown))); diff --git a/src/alire-index.ads b/src/alire-index.ads index 52c9d466..44a540bb 100644 --- a/src/alire-index.ads +++ b/src/alire-index.ads @@ -231,6 +231,8 @@ 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; @@ -240,6 +242,9 @@ package Alire.Index is function Distribution_Is (V : Platforms.Distributions) return Release_Requisites renames Plat_Reqs.Distribution_Is; + function OS return Requisites.Platform.Systs.Comparable renames Requisites.Platform.Systs.New_Comparable; + use all type Requisites.Platform.Systs.Comparable; + function System_Is (V : Platforms.Operating_Systems) return Release_Requisites renames Plat_Reqs.System_Is; function Version_is (V : Platforms.Versions) return Release_Requisites renames Plat_Reqs.Version_Is; diff --git a/src/alire-properties.ads b/src/alire-properties.ads index 503cdb04..866e5938 100644 --- a/src/alire-properties.ads +++ b/src/alire-properties.ads @@ -41,7 +41,7 @@ package Alire.Properties with Preelaborate is with function Image (V : Value) return String is <>; package Values is - type Property (<>) is new Properties.Property with private; + type Property is new Properties.Property with private; function New_Property (V : Value) return Property; diff --git a/src/alire-requisites-comparables.ads b/src/alire-requisites-comparables.ads new file mode 100644 index 00000000..b19e2a69 --- /dev/null +++ b/src/alire-requisites-comparables.ads @@ -0,0 +1,88 @@ +generic + -- Encapsulated basic type + type Value is private; + with function "<" (L, R : Value) return Boolean; + with function Image (V : Value) return String is <>; + + -- Encapsulating property + type Property is new Properties.Property with private; + with function Element (P : Property) return Value; + + Name : String; -- used for image "Name (operation) Mixed_Case (Image (Value))" +package Alire.Requisites.Comparables with Preelaborate is + + package Value_Requisites is new For_Property (Property); + + type Comparable (<>) is new Value_Requisites.Requisite with private; + + overriding function Is_Satisfied (R : Comparable; P : Property) return Boolean; + overriding function Image (R : Comparable) return String; + + not overriding function New_Comparable return Comparable; + -- This is the root function that can be renamed to a sensible name to appear in expressions + + function "=" (L : Comparable; R : Value) return Tree; + function "=" (L : Value; R : Comparable) return Tree; + + function "/=" (L : Comparable; R : Value) return Tree; + function "/=" (L : Value; R : Comparable) return Tree; + + function "<" (L : Comparable; R : Value) return Tree; + function "<" (L : Value; R : Comparable) return Tree; + + function "<=" (L : Comparable; R : Value) return Tree; + function "<=" (L : Value; R : Comparable) return Tree; + + function ">" (L : Comparable; R : Value) return Tree; + function ">" (L : Value; R : Comparable) return Tree; + + function ">=" (L : Comparable; R : Value) return Tree; + function ">=" (L : Value; R : Comparable) return Tree; + +private + + type Kinds is (Base, Equality, Ordering); + + type Comparable (Kind : Kinds) is new Value_Requisites.Requisite with record + Value : Comparables.Value; + end record; + + not overriding function New_Comparable return Comparable is (Kind => Base, Value => <>); + + overriding function Is_Satisfied (R : Comparable; P : Property) return Boolean is + (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)); + + 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)); + + use all type Tree; + + function "/=" (L : Comparable; R : Value) return Tree is (not (L = R)); + function "/=" (L : Value; R : Comparable) return Tree is (not (L = R)); + + function "<=" (L : Comparable; R : Value) return Tree is (L < R or L = R); + function "<=" (L : Value; R : Comparable) return Tree is (L < R or L = R); + + function ">" (L : Comparable; R : Value) return Tree is (not (L <= R)); + function ">" (L : Value; R : Comparable) return Tree is (not (L <= R)); + + function ">=" (L : Comparable; R : Value) return Tree is (not (L < R)); + function ">=" (L : Value; R : Comparable) return Tree is (not (L < R)); + + function "=" (L : Comparable; R : Value) return Tree is + (Trees.Leaf (Comparable'(Kind => Equality, Value => R))); + + function "=" (L : Value; R : Comparable) return Tree is (R = L); + + function "<" (L : Comparable; R : Value) return Tree is + (Trees.Leaf (Comparable'(Kind => Ordering, Value => R))); + + function "<" (L : Value; R : Comparable) return Tree is (R >= L); + +end Alire.Requisites.Comparables; diff --git a/src/alire-requisites-platform.ads b/src/alire-requisites-platform.ads index 76b04543..7ffaf7e0 100644 --- a/src/alire-requisites-platform.ads +++ b/src/alire-requisites-platform.ads @@ -1,6 +1,8 @@ with Alire.Platforms; with Alire.Properties.Platform; +with Alire.Requisites.Comparables; + package Alire.Requisites.Platform with Preelaborate is package Plat renames Properties.Platform; @@ -8,6 +10,12 @@ package Alire.Requisites.Platform with Preelaborate is use all type Platforms.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, + "OS"); + package Compilers is new Requisites.For_Value_Property (Plat.Compilers, "Compiler"); function Compiler_Is (V : Platforms.Compilers) return Tree renames Compilers.New_Equality;