From 3a05672ddf14a5dc125c9cfaf502937ac58ae65e Mon Sep 17 00:00:00 2001 From: Alejandro R Mosteo Date: Fri, 4 May 2018 17:40:48 +0200 Subject: [PATCH] Case statements for conditionals --- index/alire-index-alire.ads | 8 +++++++- index/alire-index-gnatcoll.ads | 24 +++++++++++++++--------- src/alire-conditional_values.adb | 22 ++++++++++++++++++++++ src/alire-conditional_values.ads | 12 ++++++++++++ src/alire-index.ads | 10 ++++++++++ src/alire-requisites-comparables.ads | 6 ++++++ src/alire-requisites-platform.ads | 7 +++++++ 7 files changed, 79 insertions(+), 10 deletions(-) diff --git a/index/alire-index-alire.ads b/index/alire-index-alire.ads index 3e5dcfa3..02839b2c 100644 --- a/index/alire-index-alire.ads +++ b/index/alire-index-alire.ads @@ -112,7 +112,13 @@ package Alire.Index.Alire is On_Condition (Operating_System = GNU_Linux, Comment ("Long life the penguin")) and - -- Conditions on operating system + -- Conditions on operating system + + Case_Operating_System_Is + ((GNU_Linux => Comment ("Longerer life to the penguin"), + OSX => Comment ("Oh shiny!"), + others => Comment ("Pick your poison"))) and + -- Also as Case-like statements On_Condition (Compiler = GNAT_Unknown, -- /= also works diff --git a/index/alire-index-gnatcoll.ads b/index/alire-index-gnatcoll.ads index e9b3655d..98dcc558 100644 --- a/index/alire-index-gnatcoll.ads +++ b/index/alire-index-gnatcoll.ads @@ -29,15 +29,21 @@ package Alire.Index.GNATCOLL is Private_Properties => GPR_External ("BUILD", "PROD") and GPR_External ("LIBRARY_TYPE", "static-pic") and - On_Condition - (Operating_System = GNU_Linux, - GPR_External ("GNATCOLL_OS", "unix")) and - On_Condition - (Operating_System = Windows, - GPR_External ("GNATCOLL_OS", "windows")) and - On_Condition - (Operating_System = OSX, - GPR_External ("GNATCOLL_OS", "osx"))); + Case_Operating_System_Is + ((GNU_Linux => GPR_External ("GNATCOLL_OS", "unix"), + OSX => GPR_External ("GNATCOLL_OS", "osx"), + Windows => GPR_External ("GNATCOLL_OS", "windows"), + OS_Unknown => GPR_External ("GNATCOLL_OS", "ERROR"))) +-- On_Condition +-- (Operating_System = GNU_Linux, +-- GPR_External ("GNATCOLL_OS", "unix")) and +-- On_Condition +-- (Operating_System = Windows, +-- GPR_External ("GNATCOLL_OS", "windows")) and +-- On_Condition +-- (Operating_System = OSX, + -- GPR_External ("GNATCOLL_OS", "osx")) + ); package Slim is diff --git a/src/alire-conditional_values.adb b/src/alire-conditional_values.adb index 7cc60a91..fc984bf2 100644 --- a/src/alire-conditional_values.adb +++ b/src/alire-conditional_values.adb @@ -149,4 +149,26 @@ package body Alire.Conditional_Values is end if; end Iterate_Children; + --------------------- + -- Case_Statements -- + --------------------- + + package body Case_Statements is + + function Case_Is (Arr : Arrays) return Conditional_Value is + Case_Is : Conditional_Value := Arr (Arr'Last); + -- Since we get the whole array, + -- by exhaustion at worst the last must be true + begin + for I in reverse Arr'First .. Enum'Pred (Arr'Last) loop + Case_Is := New_Conditional (If_X => Requisite_Equal (I), + Then_X => Arr (I), + Else_X => Case_Is); + end loop; + + return Case_Is; + end Case_Is; + + end Case_Statements; + end Alire.Conditional_Values; diff --git a/src/alire-conditional_values.ads b/src/alire-conditional_values.ads index 193089e3..cf4d9b25 100644 --- a/src/alire-conditional_values.ads +++ b/src/alire-conditional_values.ads @@ -71,6 +71,18 @@ package Alire.Conditional_Values with Preelaborate is function False_Value (This : Conditional_Value) return Conditional_Value with Pre => This.Kind = Condition; + generic + type Enum is (<>); + with function Requisite_Equal (V : Enum) return Requisites.Tree; + -- Function which creates an equality requisite on V + package Case_Statements is + + type Arrays is array (Enum) of Conditional_Value; + + function Case_Is (Arr : Arrays) return Conditional_Value; + + end Case_Statements; + private type Inner_Node is abstract tagged null record; diff --git a/src/alire-index.ads b/src/alire-index.ads index c10f7ed8..54655274 100644 --- a/src/alire-index.ads +++ b/src/alire-index.ads @@ -256,6 +256,16 @@ package Alire.Index is When_False : Release_Properties := No_Properties) return Release_Properties renames Conditional.For_Properties.New_Conditional; -- Conditional properties + + 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_Operating_System_Is (Arr : Requisites.Platform.Op_System_Cases.Arrays) + return Release_Properties + renames Requisites.Platform.Op_System_Cases.Case_Is; -- Attributes (named pairs of label-value) -- We need them as Properties.Vector (inside conditionals) but also as diff --git a/src/alire-requisites-comparables.ads b/src/alire-requisites-comparables.ads index 730dffd5..491fd7c2 100644 --- a/src/alire-requisites-comparables.ads +++ b/src/alire-requisites-comparables.ads @@ -45,6 +45,9 @@ package Alire.Requisites.Comparables with Preelaborate is function ">=" (L : Comparable; R : Value) return Tree; function ">=" (L : Value; R : Comparable) return Tree; + function Is_Equal_To (V : Value) return Tree; + -- Non-operator function useful elsewhere for case statements + private type Kinds is (Base, Equality, Ordering); @@ -93,4 +96,7 @@ private function "<" (L : Value; R : Comparable) return Tree is (R >= L); + function Is_Equal_To (V : Value) return Tree is + (Trees.Leaf (Comparable'(Kind => Equality, Value => V))); + end Alire.Requisites.Comparables; diff --git a/src/alire-requisites-platform.ads b/src/alire-requisites-platform.ads index 75093d1b..e6dd0335 100644 --- a/src/alire-requisites-platform.ads +++ b/src/alire-requisites-platform.ads @@ -1,3 +1,4 @@ +with Alire.Conditional; with Alire.Platforms; with Alire.Properties.Platform; @@ -17,6 +18,9 @@ package Alire.Requisites.Platform with Preelaborate is PrPl.Operating_Systems.Element, "OS"); + package Op_System_Cases is new Conditional.For_Properties.Case_Statements + (Ps.Operating_Systems, Op_Systems.Is_Equal_To); + package Compilers is new Comparables (Ps.Compilers, Ps."<", Ps.Compilers'Image, PrPl.Compilers.Property, @@ -29,6 +33,9 @@ package Alire.Requisites.Platform with Preelaborate is function Compiler_Is_Native return Tree is (Compiler >= GNAT_FSF_Old and Compiler < GNAT_GPL_Old); + package Compiler_Cases is new Conditional.For_Properties.Case_Statements + (Ps.Compilers, Compilers.Is_Equal_To); + package Distributions is new Comparables (Ps.Distributions, Ps."<", Ps.Distributions'Image, PrPl.Distributions.Property,