From 1c414968352c1db9b4ccada0eee628a4caa91b50 Mon Sep 17 00:00:00 2001 From: "Alejandro R. Mosteo" Date: Sun, 16 Feb 2025 16:22:29 +0100 Subject: [PATCH 01/14] Generalized Scalars --- yeison_12/src/yeison_12.ads | 12 +- yeison_12/src/yeison_generic.adb | 192 ++++++++++++++++++++----------- yeison_12/src/yeison_generic.ads | 78 +++++++++++-- yeison_12/src/yeison_utils.ads | 73 ++++++++++++ 4 files changed, 283 insertions(+), 72 deletions(-) diff --git a/yeison_12/src/yeison_12.ads b/yeison_12/src/yeison_12.ads index 2dad6a9..e48047e 100644 --- a/yeison_12/src/yeison_12.ads +++ b/yeison_12/src/yeison_12.ads @@ -1,6 +1,7 @@ pragma Ada_2012; with Yeison_Generic; +with Yeison_Utils; package Yeison_12 with Preelaborate is @@ -10,9 +11,14 @@ package Yeison_12 with Preelaborate is subtype Big_Real is Long_Long_Float; + package Reals is new Yeison_Utils.General_Reals (Big_Real, + "<", + Big_Real'Wide_Wide_Image); + package Impl is new Yeison_Generic (Big_Int, Identity, Big_Int'Wide_Wide_Image, - Big_Real, Big_Real'Wide_Wide_Image); + Reals.General_Real, Reals.Image, + "<", Reals."<"); type Any is new Impl.Any with null record with -- Constant_Indexing => Const_Ref, @@ -20,6 +26,10 @@ package Yeison_12 with Preelaborate is -- Enabling constant indexing limits how we can use indexing in transient -- expressions. Not sure this is entirely a good idea... + subtype Scalar is Impl.Scalar; + + package Scalars renames Impl.Scalars; + subtype Bool is Any with Dynamic_Predicate => Bool.Kind = Bool_Kind; subtype Int is Any with Dynamic_Predicate => Int.Kind = Int_Kind; subtype Map is Any with Dynamic_Predicate => Map.Kind = Map_Kind; diff --git a/yeison_12/src/yeison_generic.adb b/yeison_12/src/yeison_generic.adb index 4576f30..8598d7e 100644 --- a/yeison_12/src/yeison_generic.adb +++ b/yeison_12/src/yeison_generic.adb @@ -28,18 +28,12 @@ package body Yeison_Generic is type Any_Impl (Kind : Kinds := Bool_Kind) is record case Kind is - when Bool_Kind => - Bool : Boolean; - when Int_Kind => - Int : Int_Type; - when Real_Kind => - Real : Real_Type; - when Str_Kind => - Str : WWUString; + when Scalar_Kinds => + Val : Scalar_Data (Kind); when Map_Kind => - Map : Any_Maps.Map; + Map : Any_Maps.Map; when Vec_Kind => - Vec : Any_Vectors.Vector; + Vec : Any_Vectors.Vector; end case; end record -- with Dynamic_Predicate => @@ -48,6 +42,54 @@ package body Yeison_Generic is -- External_Tag (E'Tag) /= "YEISON_12.IMPL.ANY")); ; + function Kind (This : Scalar) return Scalar_Kinds is (This.Data.Kind); + + function As_Boolean (This : Scalar) return Boolean is (This.Data.Bool); + function As_Integer (This : Scalar) return Int_Type is (This.Data.Int); + function As_Real (This : Scalar) return Real_Type is (This.Data.Real); + function As_Text (This : Scalar) return Text + is (WWUStrings.To_Wide_Wide_String (This.Data.Str)); + + ------------- + -- Scalars -- + ------------- + + package body Scalars is + + ----------------- + -- New_Boolean -- + ----------------- + + function New_Bool (Val : Boolean) return Scalar + is (Data => (Kind => Bool_Kind, + Bool => Val)); + + ------------- + -- New_Int -- + ------------- + + function New_Int (Val : Int_Type) return Scalar + is (Data => (Kind => Int_Kind, + Int => Val)); + + -------------- + -- New_Real -- + -------------- + + function New_Real (Val : Real_Type) return Scalar + is (Data => (Kind => Real_Kind, + Real => Val)); + + -------------- + -- New_Text -- + -------------- + + function New_Text (Val : Text) return Scalar + is (Data => (Kind => Str_Kind, + Str => +Val)); + + end Scalars; + --------------- -- Operators -- --------------- @@ -82,35 +124,60 @@ package body Yeison_Generic is package body Make is + ------------ + -- Scalar -- + ------------ + + function Scalar (This : Yeison_Generic.Scalar) return Client_Any + is (To_Any ((Any_Parent with Impl => new Any_Impl' + (case This.Data.Kind is + when Bool_Kind => (Bool_Kind, This.Data), + when Int_Kind => (Int_Kind, This.Data), + when Real_Kind => (Real_Kind, This.Data), + when Str_Kind => (Str_Kind, This.Data) + )))); + + ----------- + -- False -- + ----------- + + function False return Client_Any + is (Make.Scalar (Scalars.New_Bool (False))); + + ---------- + -- True -- + ---------- + + function True return Client_Any + is (Make.Scalar (Scalars.New_Bool (True))); + + ---------- + -- Bool -- + ---------- + + function Bool (This : Boolean) return Client_Any + is (Make.Scalar (Scalars.New_Bool (This))); + --------- -- Int -- --------- function Int (This : Int_Type) return Client_Any - is (To_Any - ((Any_Parent with Impl => new Any_Impl' - (Kind => Int_Kind, - Int => This)))); + is (Make.Scalar (Scalars.New_Int (This))); ---------- -- Real -- ---------- function Real (This : Real_Type) return Client_Any - is (To_Any - ((Any_Parent with Impl => new Any_Impl' - (Kind => Real_Kind, - Real => This)))); + is (Make.Scalar (Scalars.New_Real (This))); --------- -- Str -- --------- function Str (This : Wide_Wide_String) return Client_Any - is (To_Any - ((Any_Parent with Impl => new Any_Impl' - (Kind => Str_Kind, - Str => +This)))); + is (Make.Scalar (Scalars.New_Text (This))); end Make; @@ -145,35 +212,50 @@ package body Yeison_Generic is -- Both the same case L.Kind is - when Bool_Kind => return L.Bool < R.Bool; - when Int_Kind => return L.Int < R.Int; - when Real_Kind => return L.Real < R.Real; - when Str_Kind => return L.Str < R.Str; + when Bool_Kind => return L.Val.Bool < R.Val.Bool; + when Int_Kind => return L.Val.Int < R.Val.Int; + when Real_Kind => return L.Val.Real < R.Val.Real; + when Str_Kind => return L.Val.Str < R.Val.Str; when Map_Kind => raise Unimplemented; when Vec_Kind => raise Unimplemented; end case; end "<"; + --------------- + -- As_Scalar -- + --------------- + + function As_Scalar (This : Any'Class) return Scalar + is (Scalar'(Data => This.Impl.Val)); + ------------- -- As_Bool -- ------------- function As_Bool (This : Any) return Boolean - is (raise Unimplemented); + is (This.Impl.Val.Bool); ------------ -- As_Int -- ------------ - function As_Int (This : Any) return Long_Long_Integer - is (To_Integer (This.Impl.Int)); + function As_Int (This : Any) return Int_Type + is (This.Impl.Val.Int); + + ------------- + -- As_Real -- + ------------- + + function As_Real (This : Any) return Real_Type + is (This.Impl.Val.Real); ------------- -- As_Text -- ------------- function As_Text (This : Any) return Text - is (Ada.Strings.Wide_Wide_Unbounded.To_Wide_Wide_String (This.Impl.Str)); + is (Ada.Strings.Wide_Wide_Unbounded.To_Wide_Wide_String + (This.Impl.Val.Str)); --------------- -- Empty_Map -- @@ -191,16 +273,6 @@ package body Yeison_Generic is is (Ada.Finalization.Controlled with Impl => new Any_Impl'(Kind => Vec_Kind, others => <>)); - ----------- - -- False -- - ----------- - - function False return Any - is (Any_Parent with - Impl => new Any_Impl' - (Kind => Bool_Kind, - Bool => True)); - ---------------- -- JSON_Quote -- ---------------- @@ -230,15 +302,17 @@ package body Yeison_Generic is function Scalar_Image (This : Any'Class) return Text is (case This.Kind is when Bool_Kind => - (if This.Impl.Bool then "true" else "false"), + (if This.Impl.Val.Bool then "true" else "false"), when Int_Kind => - Fixed.Trim (Image (This.Impl.Int), Side => Both), + Fixed.Trim (Image (This.Impl.Val.Int), Side => Both), when Real_Kind => - Fixed.Trim (Image (This.Impl.Real), Side => Both), + Fixed.Trim (Image (This.Impl.Val.Real), Side => Both), when Str_Kind => (case Format is - when Ada_Like => To_Wide_Wide_String (This.Impl.Str), - when JSON => JSON_Quote (To_Wide_Wide_String (This.Impl.Str))), + when Ada_Like => + To_Wide_Wide_String (This.Impl.Val.Str), + when JSON => + JSON_Quote (To_Wide_Wide_String (This.Impl.Val.Str))), when Composite_Kinds => raise Program_Error with "not a scalar: " & This.Kind'Image ); @@ -656,7 +730,9 @@ package body Yeison_Generic is function Ref_By_Scalar (This : Any; Pos : Any) - return Ref is + return Ref + is + subtype Univ is Universal_Integer; begin -- Initialize empty vec/map if needed @@ -676,11 +752,9 @@ package body Yeison_Generic is case This.Kind is when Scalar_Kinds => - if Pos.Kind /= Int_Kind or else Pos.As_Int /= 1 then - Constraint_Error ("scalar value with any /= 1", Pos); - end if; - - return Self (This); + -- Do not allow indexing an scalar at all + Constraint_Error ("non-composite value", Pos); + return null; when Map_Kind => -- TODO: use cursors to avoid double lookup @@ -699,19 +773,19 @@ package body Yeison_Generic is (This.Impl.Map.Constant_Reference (Pos).Element.all); when others => - if Long_Long_Integer (This.Impl.Vec.Length) + 1 < Pos.As_Int + if Univ (This.Impl.Vec.Length) + 1 < To_Integer (Pos.As_Int) then Constraint_Error ("vector beyond 'length + 1 when 'length =" & This.Impl.Vec.Length'Image, Pos); end if; - if Long_Long_Integer (This.Impl.Vec.Length) < Pos.As_Int then + if Univ (This.Impl.Vec.Length) < To_Integer (Pos.As_Int) then This.Impl.Vec.Append (To_Any (Invalid)); end if; return Self (This.Impl.Vec.Constant_Reference - (Pos.As_Int).Element.all); + (To_Integer (Pos.As_Int)).Element.all); end case; end Ref_By_Scalar; @@ -741,14 +815,4 @@ package body Yeison_Generic is end References; - ---------- - -- True -- - ---------- - - function True return Any - is (Any_Parent with - Impl => new Any_Impl' - (Kind => Bool_Kind, - Bool => True)); - end Yeison_Generic; diff --git a/yeison_12/src/yeison_generic.ads b/yeison_12/src/yeison_generic.ads index bd37407..1e7c806 100644 --- a/yeison_12/src/yeison_generic.ads +++ b/yeison_12/src/yeison_generic.ads @@ -14,8 +14,10 @@ generic type Int_Type is private; -- not range <> to allow Big_Integer with function To_Integer (I : Int_Type) return Long_Long_Integer; with function Image (I : Int_Type) return Wide_Wide_String is <>; + type Real_Type is private; -- same about digits <> with function Image (R : Real_Type) return Wide_Wide_String is <>; + with function "<" (L, R : Int_Type) return Boolean is <>; with function "<" (L, R : Real_Type) return Boolean is <>; package Yeison_Generic with Preelaborate is @@ -70,15 +72,37 @@ package Yeison_Generic with Preelaborate is -- Scalars -- --------------- - function True return Any; + -- Separate type to ease initializations elsewhere + + type Scalar (<>) is tagged private; + + function Kind (This : Scalar) return Scalar_Kinds; + + function As_Boolean (This : Scalar) return Boolean; + function As_Integer (This : Scalar) return Int_Type; + function As_Real (This : Scalar) return Real_Type; + function As_Text (This : Scalar) return Text; + + -- See package Scalars below for initializations - function False return Any; + -- Retrieval - function As_Bool (This : Any) return Boolean; + function As_Scalar (This : Any'Class) return Scalar + with Pre => This.Kind in Scalar_Kinds; - function As_Int (This : Any) return Long_Long_Integer; + function As_Bool (This : Any) return Boolean + with Pre => This.Kind = Bool_Kind; - function As_Text (This : Any) return Text; + function As_Int (This : Any) return Int_Type + with Pre => This.Kind = Int_Kind; + + function As_Real (This : Any) return Real_Type + with Pre => This.Kind = Real_Kind; + + function As_Text (This : Any) return Text + with Pre => This.Kind = Str_Kind; + + -- See package Make below for initializations ------------------- -- Collections -- @@ -135,6 +159,19 @@ package Yeison_Generic with Preelaborate is function Empty_Vec return Any; + ------------- + -- Scalars -- + ------------- + + package Scalars is + + function New_Bool (Val : Boolean) return Scalar; + function New_Int (Val : Int_Type) return Scalar; + function New_Real (Val : Real_Type) return Scalar; + function New_Text (Val : Text) return Scalar; + + end Scalars; + --------------- -- Operators -- --------------- @@ -166,9 +203,15 @@ package Yeison_Generic with Preelaborate is ---------- package Make is - function Int (This : Int_Type) return Client_Any; + function True return Client_Any; + function False return Client_Any; + + function Bool (This : Boolean) return Client_Any; + function Int (This : Int_Type) return Client_Any; function Real (This : Real_Type) return Client_Any; - function Str (This : Text) return Client_Any; + function Str (This : Text) return Client_Any; + + function Scalar (This : Yeison_Generic.Scalar) return Client_Any; end Make; end Operators; @@ -282,4 +325,25 @@ private package Any_Vectors is new Ada.Containers.Indefinite_Vectors (Universal_Positive, Any'Class); + --------------- + -- Scalars -- + --------------- + + type Scalar_Data (Kind : Scalar_Kinds := Bool_Kind) is record + case Kind is + when Bool_Kind => + Bool : Boolean; + when Int_Kind => + Int : Int_Type; + when Real_Kind => + Real : Real_Type; + when Str_Kind => + Str : WWUString; + end case; + end record; + + type Scalar is tagged record + Data : Scalar_Data; + end record; + end Yeison_Generic; diff --git a/yeison_12/src/yeison_utils.ads b/yeison_12/src/yeison_utils.ads index e1e34a4..b18c3ec 100644 --- a/yeison_12/src/yeison_utils.ads +++ b/yeison_12/src/yeison_utils.ads @@ -8,4 +8,77 @@ package Yeison_Utils with Preelaborate is -- Prepare a string for storage in JSON format. Does not add enclosing -- quotes! + -- JSON doesn't support directly representing non-finite reals, but TOML + -- and YAML do. + + generic + type Real is private; + with function "<" (L, R : Real) return Boolean is <>; + with function Image (R : Real) return Text is <>; + package General_Reals is + + type Classes is (Finite, Infinite, NaN); + + type General_Real (Class : Classes := Finite) + is record + case Class is + when Finite => Value : Real; + when Infinite => Positive : Boolean; + when NaN => null; + end case; + end record; + + -------------- + -- New_Real -- + -------------- + + function New_Real (Value : Real) return General_Real + is (Class => Finite, Value => Value); + + ------------------ + -- New_Infinite -- + ------------------ + + function New_Infinite (Positive : Boolean) return General_Real + is (Class => Infinite, Positive => Positive); + + ------------- + -- New_NaN -- + ------------- + + function New_NaN return General_Real is (Class => NaN); + + --------- + -- "<" -- + --------- + + function "<" (L, R : General_Real) return Boolean + is (if L.Class = R.Class and then L.Class = Finite then + L < R + elsif R.Class = Infinite and then L.Class = Finite then + True + elsif L.Class = Infinite and then R.Class = Infinite and then + R.Positive and then not L.Positive + then + True + else + False); + + ----------- + -- Image -- + ----------- + -- NOTE: specific formats have different NAN/Inf representations, this + -- is only valid for general non-strict output. + function Image (Value : General_Real) return Text + is (if Value.Class = NaN then + "nan" + elsif Value.Class = Finite then + Image (Value.Value) + elsif Value.Positive then + "+inf" + else + "-inf"); + + end General_Reals; + end Yeison_Utils; From 516159d53101b96eab6bcd5037e809ea4fa44566 Mon Sep 17 00:00:00 2001 From: "Alejandro R. Mosteo" Date: Sun, 16 Feb 2025 19:13:55 +0100 Subject: [PATCH 02/14] fix: JSON output missing commas, excess whitespace --- yeison_12/src/yeison_generic.adb | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/yeison_12/src/yeison_generic.adb b/yeison_12/src/yeison_generic.adb index 8598d7e..d4f3108 100644 --- a/yeison_12/src/yeison_generic.adb +++ b/yeison_12/src/yeison_generic.adb @@ -294,6 +294,7 @@ package body Yeison_Generic is use Ada.Strings.Wide_Wide_Unbounded; function "+" (S : Wide_Wide_String) return WWUString renames To_Unbounded_Wide_Wide_String; + pragma Unreferenced ("+"); ------------------ -- Scalar_Image -- @@ -395,8 +396,8 @@ package body Yeison_Generic is (case Format is when Ada_Like => " ", when JSON => " "); - function WS (Str : Text) return Text - is (1 .. Str'Length => ' '); + -- function WS (Str : Text) return Text -- Whitespace of same length + -- is (1 .. Str'Length => ' '); begin case This.Kind is when Scalar_Kinds => @@ -431,10 +432,13 @@ package body Yeison_Generic is -- we are using an object for indexing. Traverse (This.Impl.Map.Constant_Reference (C), - WS (Prefix & Tab - & Key (C).Image (Format, Compact) - & Map_Arrow), + Prefix & Tab, Contd => True); + + if Has_Element (Next (C)) then + Append (Result, ","); + end if; + if not Abbr then Append (Result, NL); end if; @@ -475,7 +479,7 @@ package body Yeison_Generic is & (if Abbr then " " else NL)); end loop; Append (Result, - (if Abbr then " " else Prefix) + (if Abbr then "" else Prefix) & Vec_Close); end; end case; @@ -483,7 +487,7 @@ package body Yeison_Generic is begin if not This.Is_Valid then - Result := +"(invalid)"; + raise Constraint_Error with "Cannot generate image of invalid value"; else Traverse (This, ""); end if; From 23631c0f796e155146e5eabfe4407d82b338687e Mon Sep 17 00:00:00 2001 From: "Alejandro R. Mosteo" Date: Sun, 16 Feb 2025 19:54:35 +0100 Subject: [PATCH 03/14] feat: preserve maps ordering --- yeison_12/src/yeison_generic.adb | 78 ++++++++++++++++++++------------ yeison_12/src/yeison_generic.ads | 12 +++-- 2 files changed, 59 insertions(+), 31 deletions(-) diff --git a/yeison_12/src/yeison_generic.adb b/yeison_12/src/yeison_generic.adb index d4f3108..3afbf23 100644 --- a/yeison_12/src/yeison_generic.adb +++ b/yeison_12/src/yeison_generic.adb @@ -14,6 +14,7 @@ package body Yeison_Generic is package Fixed renames Ada.Strings.Wide_Wide_Fixed; + use type Ada.Containers.Count_Type; use all type Ada.Strings.Trim_End; pragma Warnings (Off); @@ -31,16 +32,15 @@ package body Yeison_Generic is when Scalar_Kinds => Val : Scalar_Data (Kind); when Map_Kind => - Map : Any_Maps.Map; + Map : Any_Maps.Map; + Keys : Any_Vecs.Vector; + -- Keys, in the order in which they were added when Vec_Kind => - Vec : Any_Vectors.Vector; + Vec : Any_Vecs.Vector; end case; end record - -- with Dynamic_Predicate => - -- (if Any_Impl.Kind = Map_Kind then - -- (for all E of Any_Impl.Map => - -- External_Tag (E'Tag) /= "YEISON_12.IMPL.ANY")); - ; + with Dynamic_Predicate => + (if Any_Impl.Kind = Map_Kind then Map.Length = Keys.Length); function Kind (This : Scalar) return Scalar_Kinds is (This.Data.Kind); @@ -288,7 +288,7 @@ package body Yeison_Generic is function Image (This : Any'Class; Format : Image_Formats := Ada_Like; - Compact : Boolean := False) + Options : Image_Options := (others => <>)) return Text is use Ada.Strings.Wide_Wide_Unbounded; @@ -407,10 +407,12 @@ package body Yeison_Generic is when Map_Kind => declare - C : Any_Maps.Cursor := This.Impl.Map.First; + C_Map : Any_Maps.Cursor := This.Impl.Map.First; + C_Vec : Any_Vecs.Cursor := This.Impl.Keys.First; use Any_Maps; + use Any_Vecs; Abbr : constant Boolean := - Compact and then This.Impl.Map.Length in 1; + Options.Compact and then This.Impl.Map.Length in 1; begin if This.Impl.Map.Is_Empty then Append (Result, @@ -423,26 +425,45 @@ package body Yeison_Generic is & Map_Open & (if Abbr then " " else NL)); - while Has_Element (C) loop + while (if Options.Ordered_Keys + then Any_Maps.Has_Element (C_Map) + else Any_Vecs.Has_Element (C_Vec)) + loop Append (Result, (if Abbr then " " else Prefix & Tab) - & Key (C).Image (Format, Compact) + & (if Options.Ordered_Keys + then Any_Maps.Key (C_Map) + .Image (Format, Options) + else Any_Vecs.Element (C_Vec) + .Image (Format, Options)) & Map_Arrow); -- TODO: the above key image should be prefixed in case -- we are using an object for indexing. - Traverse (This.Impl.Map.Constant_Reference (C), + Traverse ((if Options.Ordered_Keys + then This.Impl.Map.Constant_Reference (C_Map) + else This.Impl.Map.Constant_Reference + (This.Impl.Map.Find + (Any_Vecs.Element (C_Vec)))), Prefix & Tab, Contd => True); - if Has_Element (Next (C)) then + if (if Options.Ordered_Keys + then Any_Maps.Has_Element (Next (C_Map)) + else Any_Vecs.Has_Element (Next (C_Vec))) + then Append (Result, ","); end if; if not Abbr then Append (Result, NL); end if; - C := Next (C); + + if Options.Ordered_Keys then + Next (C_Map); + else + Next (C_Vec); + end if; end loop; Append (Result, @@ -452,7 +473,7 @@ package body Yeison_Generic is when Vec_Kind => declare Abbr : constant Boolean := - Compact and then This.Impl.Vec.Length in 1; + Options.Compact and then This.Impl.Vec.Length in 1; I : Natural := 0; begin if This.Impl.Vec.Is_Empty then @@ -492,10 +513,7 @@ package body Yeison_Generic is Traverse (This, ""); end if; - return To_Wide_Wide_String - ( - -- Wide_Wide_Expanded_Name (This'Tag) & ": " & - Result); + return To_Wide_Wide_String (Result); end Image; ------------- @@ -528,18 +546,21 @@ package body Yeison_Generic is -- Keys -- ---------- - function Keys (This : Any) return Any_Array is + function Keys (This : Any; Ordered : Boolean := False) return Any_Array is Result : Any_Array (1 .. Integer (This.Impl.Map.Length)); Pos : Positive := 1; begin - for I in This.Impl.Map.Iterate loop - declare - Key : constant Any'Class := Any_Maps.Key (I); - begin + if Ordered then + for I in This.Impl.Map.Iterate loop + Result (Pos) := Any (Any_Maps.Key (I)); + Pos := Pos + 1; + end loop; + else + for Key of This.Impl.Keys loop Result (Pos) := Any (Key); - end; - Pos := Pos + 1; - end loop; + Pos := Pos + 1; + end loop; + end if; return Result; end Keys; @@ -628,6 +649,7 @@ package body Yeison_Generic is is begin This.Impl.Map.Insert (Key, Value); + This.Impl.Keys.Append (Key); end Insert; ------------ diff --git a/yeison_12/src/yeison_generic.ads b/yeison_12/src/yeison_generic.ads index 1e7c806..448656e 100644 --- a/yeison_12/src/yeison_generic.ads +++ b/yeison_12/src/yeison_generic.ads @@ -53,9 +53,14 @@ package Yeison_Generic with Preelaborate is type Image_Formats is (Ada_Like, JSON); + type Image_Options is record + Compact : Boolean := False; + Ordered_Keys : Boolean := False; + end record; + function Image (This : Any'Class; Format : Image_Formats := Ada_Like; - Compact : Boolean := False) + Options : Image_Options := (others => <>)) return Text; function Invalid return Any; @@ -144,8 +149,9 @@ package Yeison_Generic with Preelaborate is Replace : Boolean := False) return Any; - function Keys (This : Any) return Any_Array with + function Keys (This : Any; Ordered : Boolean := False) return Any_Array with Pre => This.Kind = Map_Kind; + -- Keys, in either the original addition order, or in alphabetical order. -- This is a chapuza until we have proper iteration over Any values. Note -- that in the versioned clients, Any is of a different derived type! -- That's why this doesn't have much future... @@ -322,7 +328,7 @@ private subtype Universal_Positive is Universal_Integer range 1 .. Universal_Integer'Last; - package Any_Vectors is + package Any_Vecs is new Ada.Containers.Indefinite_Vectors (Universal_Positive, Any'Class); --------------- From 9724e6e682f87888a9b8fbe14935d111f85c2358 Mon Sep 17 00:00:00 2001 From: "Alejandro R. Mosteo" Date: Mon, 17 Feb 2025 22:34:37 +0100 Subject: [PATCH 04/14] feat: YAML escaping --- yeison_12/src/yeison_utils.adb | 107 +++++++++++++++++++++++++++++++++ yeison_12/src/yeison_utils.ads | 9 +++ 2 files changed, 116 insertions(+) diff --git a/yeison_12/src/yeison_utils.adb b/yeison_12/src/yeison_utils.adb index 22fd818..3fc46e2 100644 --- a/yeison_12/src/yeison_utils.adb +++ b/yeison_12/src/yeison_utils.adb @@ -93,4 +93,111 @@ package body Yeison_Utils is return To_Wide_Wide_String (Result); end JSON_Escape; + ------------------------------ + -- YAML_Double_Quote_Escape -- + ------------------------------ + + function YAML_Double_Quote_Escape (Str : Text) return Text is + subtype WWChar is Wide_Wide_Character; + use Ada.Characters.Wide_Wide_Latin_1; + use Ada.Strings.Wide_Wide_Unbounded; + Result : Unbounded_Wide_Wide_String; + + Hex : constant array (Interfaces.Unsigned_32 range 0 .. 15) + of Wide_Wide_Character := "0123456789ABCDEF"; + + ------------ + -- To_Hex -- + ------------ + -- Returns the shortest 1-byte, 2-byte or 4-byte sequence + function To_Hex (Char : WWChar) return Text is + use Interfaces; + Code : constant Unsigned_32 := WWChar'Pos (Char); + B : constant := 16#10#; + begin + if Code <= 16#FF# then + return + Hex ((Code / B) mod B) & + Hex (Code mod B); + elsif Code <= 16#FFFF# then + return + Hex ((Code / B / B / B) mod B) & + Hex ((Code / B / B) mod B) & + Hex ((Code / B) mod B) & + Hex (Code mod B); + else + return + Hex ((Code / B / B / B / B / B / B / B) mod B) & + Hex ((Code / B / B / B / B / B / B) mod B) & + Hex ((Code / B / B / B / B / B) mod B) & + Hex ((Code / B / B / B / B) mod B) & + Hex ((Code / B / B / B) mod B) & + Hex ((Code / B / B) mod B) & + Hex ((Code / B) mod B) & + Hex (Code mod B); + end if; + end To_Hex; + + begin + Append (Result, '"'); + + for Char of Str loop + case Char is + -- Non-printable + when NUL => + Append (Result, "\x00"); + when BEL => + Append (Result, "\a"); + when BS => + Append (Result, "\b"); + when HT => + Append (Result, "\t"); + when LF => + Append (Result, "\n"); + when VT => + Append (Result, "\v"); + when FF => + Append (Result, "\f"); + when CR => + Append (Result, "\r"); + when ESC => + Append (Result, "\e"); + when NEL => -- Unicode next line + Append (Result, "\N"); + when WWChar'Val (16#2028#) => -- Unicode line separator + Append (Result, "\L"); + when WWChar'Val (16#2029#) => -- Unicode paragraph separator + Append (Result, "\L"); + + -- Printable but forbidden as-is + when '"' => + Append (Result, "\"""); + when '\' => + Append (Result, "\\"); + + when others => + case Char is + -- Printable as-is (ASCII x20-x7E) + when WWChar'Val (16#20#) .. WWChar'Val (16#7E#) => + Append (Result, Char); + + -- \uXXXX + when WWChar'Val (16#100#) .. WWChar'Val (16#FFFF#) => + Append (Result, "\u" & To_Hex (Char)); + + -- \UXXXXXXXX + when WWChar'Val (16#10000#) .. WWChar'Last => + Append (Result, "\U" & To_Hex (Char)); + + -- \xXX + when others => + Append (Result, "\x" & To_Hex (Char)); + end case; + end case; + end loop; + + Append (Result, '"'); + return To_Wide_Wide_String (Result); + end YAML_Double_Quote_Escape; + end Yeison_Utils; diff --git a/yeison_12/src/yeison_utils.ads b/yeison_12/src/yeison_utils.ads index b18c3ec..09bee5e 100644 --- a/yeison_12/src/yeison_utils.ads +++ b/yeison_12/src/yeison_utils.ads @@ -8,6 +8,15 @@ package Yeison_Utils with Preelaborate is -- Prepare a string for storage in JSON format. Does not add enclosing -- quotes! + function YAML_Double_Quote_Escape (Str : Text) return Text; + -- Escapes for YAML output in a doubly-quoted string: "example". The string + -- is quoted even when no escaping is necessary, to avoid confusing cases + -- like printable strings starting/ending on YAML control characters. + + ------------------- + -- General_Reals -- + ------------------- + -- JSON doesn't support directly representing non-finite reals, but TOML -- and YAML do. From d443204288fe67145f8a352073253db227065a69 Mon Sep 17 00:00:00 2001 From: "Alejandro R. Mosteo" Date: Thu, 20 Feb 2025 17:29:40 +0100 Subject: [PATCH 05/14] feat: nicer real image for simple numbers --- yeison_12/src/yeison_12.ads | 12 +++++++++++- yeison_12/src/yeison_utils.adb | 18 ++++++++++++++++++ yeison_12/src/yeison_utils.ads | 4 ++++ 3 files changed, 33 insertions(+), 1 deletion(-) diff --git a/yeison_12/src/yeison_12.ads b/yeison_12/src/yeison_12.ads index e48047e..b61e714 100644 --- a/yeison_12/src/yeison_12.ads +++ b/yeison_12/src/yeison_12.ads @@ -11,9 +11,12 @@ package Yeison_12 with Preelaborate is subtype Big_Real is Long_Long_Float; + function Nicer_Image (R : Big_Real) return Wide_Wide_String; + -- Avoid scientific notation when easy to do so + package Reals is new Yeison_Utils.General_Reals (Big_Real, "<", - Big_Real'Wide_Wide_Image); + Nicer_Image); package Impl is new Yeison_Generic (Big_Int, Identity, Big_Int'Wide_Wide_Image, @@ -103,4 +106,11 @@ private Unimplemented : exception; + ----------------- + -- Nicer_Image -- + ----------------- + + function Nicer_Image (R : Big_Real) return Wide_Wide_String + is (Yeison_Utils.Nicer_Real_Image (R'Wide_Wide_Image)); + end Yeison_12; diff --git a/yeison_12/src/yeison_utils.adb b/yeison_12/src/yeison_utils.adb index 3fc46e2..f45bae8 100644 --- a/yeison_12/src/yeison_utils.adb +++ b/yeison_12/src/yeison_utils.adb @@ -5,6 +5,24 @@ with Interfaces; package body Yeison_Utils is + function Nicer_Real_Image (Img : Text) return Text is + Last : Natural := Img'Last; + begin + if Img'Length > 4 and then Img (Last - 3 .. Last) = "E+00" then + Last := Last - 4; + + -- Remove zeroes at the end, but keep one after the '.' + + while Img (Last) = '0' and then + Last - 1 in Img'Range and then Img (Last - 1) /= '.' + loop + Last := Last - 1; + end loop; + end if; + + return Img (Img'First .. Last); + end Nicer_Real_Image; + ------------------------ -- Escape_Unprintable -- ------------------------ diff --git a/yeison_12/src/yeison_utils.ads b/yeison_12/src/yeison_utils.ads index 09bee5e..8a7a63c 100644 --- a/yeison_12/src/yeison_utils.ads +++ b/yeison_12/src/yeison_utils.ads @@ -13,6 +13,10 @@ package Yeison_Utils with Preelaborate is -- is quoted even when no escaping is necessary, to avoid confusing cases -- like printable strings starting/ending on YAML control characters. + function Nicer_Real_Image (Img : Text) return Text; + -- Remove exponential notation when trivially feasible, e.g.: + -- 2.00000000000000E+00 --> 2.0 + ------------------- -- General_Reals -- ------------------- From 7500446223da7e2e2548c59e81957808cffee03e Mon Sep 17 00:00:00 2001 From: "Alejandro R. Mosteo" Date: Thu, 20 Feb 2025 21:53:31 +0100 Subject: [PATCH 06/14] dev crate & extra tests --- .github/workflows/build.yml | 7 +++-- .github/workflows/build_extra.yml | 37 +++++++++++++++++++++++++++ dev/.gitignore | 4 +++ dev/alire.toml | 23 +++++++++++++++++ dev/dev.gpr | 22 ++++++++++++++++ dev/src/dev.adb | 4 +++ yeison_12/config/yeison_12_config.ads | 2 +- yeison_12/config/yeison_12_config.gpr | 8 ++---- yeison_12/config/yeison_12_config.h | 2 +- yeison_12/src/yeison_12.ads | 3 ++- yeison_12/src/yeison_generic.adb | 19 +++++++++----- 11 files changed, 113 insertions(+), 18 deletions(-) create mode 100644 .github/workflows/build_extra.yml create mode 100644 dev/.gitignore create mode 100644 dev/alire.toml create mode 100644 dev/dev.gpr create mode 100644 dev/src/dev.adb diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index c58c4ea..5e3fb4f 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -33,8 +33,11 @@ jobs: with: toolchain: gnat_native^${{ matrix.gnat_version }} gprbuild + - name: Show GNAT version + run: cd ${{inputs.crate}} && alr exec -- gnat --version + - name: Build - run: cd ${{inputs.crate}} && alr -q build + run: cd ${{inputs.crate}} && alr build - name: Run tests - run: cd ${{inputs.crate}}/test && alr -q run + run: cd ${{inputs.crate}}/test && alr run diff --git a/.github/workflows/build_extra.yml b/.github/workflows/build_extra.yml new file mode 100644 index 0000000..d1427cd --- /dev/null +++ b/.github/workflows/build_extra.yml @@ -0,0 +1,37 @@ +name: Build (GNAT 10, 11) + +on: + pull_request: + workflow_dispatch: + +jobs: + crate: + strategy: + fail-fast: false + matrix: + os: [windows-latest, ubuntu-latest] + gnat_version: [10, 11] + # Pre -12 don't support Ada 2022, so we only test Yeison_12 + + runs-on: ${{ matrix.os }} + + steps: + - name: Checkout + uses: actions/checkout@v2 + + - name: Set up Alire and toolchain + uses: alire-project/setup-alire@v4 + with: + toolchain: gnat_native^${{ matrix.gnat_version }} gprbuild + + - name: Show GNAT version + run: cd yeison_12 && alr exec -- gnat --version + + - name: Setup tmate session + uses: mxschmitt/action-tmate@v3 + + - name: Build + run: cd yeison_12 && alr build + + - name: Run tests + run: cd yeison_12/test && alr run diff --git a/dev/.gitignore b/dev/.gitignore new file mode 100644 index 0000000..5866d7b --- /dev/null +++ b/dev/.gitignore @@ -0,0 +1,4 @@ +/obj/ +/bin/ +/alire/ +/config/ diff --git a/dev/alire.toml b/dev/alire.toml new file mode 100644 index 0000000..f853148 --- /dev/null +++ b/dev/alire.toml @@ -0,0 +1,23 @@ +name = "dev" +description = "" +version = "0.1.0-dev" + +authors = ["Alejandro R. Mosteo"] +maintainers = ["Alejandro R. Mosteo "] +maintainers-logins = ["mosteo"] +licenses = "MIT OR Apache-2.0 WITH LLVM-exception" +website = "" +tags = [] + +executables = ["dev"] + +[build-profiles] +"*" = "validation" + +[[depends-on]] +yeison_12 = "~0.2.0-dev" +yeison = "~0.2.0-dev" + +[[pins]] +yeison_12 = { path='../yeison_12' } +yeison = { path='../yeison_22' } diff --git a/dev/dev.gpr b/dev/dev.gpr new file mode 100644 index 0000000..719f9ac --- /dev/null +++ b/dev/dev.gpr @@ -0,0 +1,22 @@ +with "config/dev_config.gpr"; +project Dev is + + for Source_Dirs use ("src/", "config/"); + for Object_Dir use "obj/" & Dev_Config.Build_Profile; + for Create_Missing_Dirs use "True"; + for Exec_Dir use "bin"; + for Main use ("dev.adb"); + + package Compiler is + for Default_Switches ("Ada") use Dev_Config.Ada_Compiler_Switches; + end Compiler; + + package Binder is + for Switches ("Ada") use ("-Es"); -- Symbolic traceback + end Binder; + + package Install is + for Artifacts (".") use ("share"); + end Install; + +end Dev; diff --git a/dev/src/dev.adb b/dev/src/dev.adb new file mode 100644 index 0000000..0f7f63a --- /dev/null +++ b/dev/src/dev.adb @@ -0,0 +1,4 @@ +procedure Dev is +begin + null; +end Dev; diff --git a/yeison_12/config/yeison_12_config.ads b/yeison_12/config/yeison_12_config.ads index c0017e7..2de5354 100644 --- a/yeison_12/config/yeison_12_config.ads +++ b/yeison_12/config/yeison_12_config.ads @@ -15,6 +15,6 @@ package Yeison_12_Config is Alire_Host_Distro : constant String := "ubuntu"; type Build_Profile_Kind is (release, validation, development); - Build_Profile : constant Build_Profile_Kind := validation; + Build_Profile : constant Build_Profile_Kind := development; end Yeison_12_Config; diff --git a/yeison_12/config/yeison_12_config.gpr b/yeison_12/config/yeison_12_config.gpr index 2890700..a4c7a87 100644 --- a/yeison_12/config/yeison_12_config.gpr +++ b/yeison_12/config/yeison_12_config.gpr @@ -11,17 +11,13 @@ abstract project Yeison_12_Config is Ada_Compiler_Switches := External_As_List ("ADAFLAGS", " "); Ada_Compiler_Switches := Ada_Compiler_Switches & ( - "-O3" -- Optimize for performance - ,"-gnatn" -- Enable inlining + "-Og" -- Optimize for debug ,"-ffunction-sections" -- Separate ELF section for each function ,"-fdata-sections" -- Separate ELF section for each variable ,"-g" -- Generate debug info - ,"-gnato" -- Enable numeric overflow checking ,"-gnatwa" -- Enable all warnings ,"-gnatw.X" -- Disable warnings for No_Exception_Propagation ,"-gnatVa" -- All validity checks - ,"-gnatwe" -- Warnings as errors - ,"-gnata" -- Enable assertions and contracts ,"-gnaty3" -- Specify indentation level of 3 ,"-gnatya" -- Check attribute casing ,"-gnatyA" -- Use of array index numbers in array attributes @@ -50,6 +46,6 @@ abstract project Yeison_12_Config is ); type Build_Profile_Kind is ("release", "validation", "development"); - Build_Profile : Build_Profile_Kind := "validation"; + Build_Profile : Build_Profile_Kind := "development"; end Yeison_12_Config; diff --git a/yeison_12/config/yeison_12_config.h b/yeison_12/config/yeison_12_config.h index 836f505..1761a8a 100644 --- a/yeison_12/config/yeison_12_config.h +++ b/yeison_12/config/yeison_12_config.h @@ -15,6 +15,6 @@ #define BUILD_PROFILE_VALIDATION 2 #define BUILD_PROFILE_DEVELOPMENT 3 -#define BUILD_PROFILE 2 +#define BUILD_PROFILE 3 #endif diff --git a/yeison_12/src/yeison_12.ads b/yeison_12/src/yeison_12.ads index b61e714..0e93310 100644 --- a/yeison_12/src/yeison_12.ads +++ b/yeison_12/src/yeison_12.ads @@ -35,7 +35,8 @@ package Yeison_12 with Preelaborate is subtype Bool is Any with Dynamic_Predicate => Bool.Kind = Bool_Kind; subtype Int is Any with Dynamic_Predicate => Int.Kind = Int_Kind; - subtype Map is Any with Dynamic_Predicate => Map.Kind = Map_Kind; + -- subtype Map is Any with Dynamic_Predicate => Map.Kind = Map_Kind; + -- Triggers bug in GNAT 10 subtype Real is Any with Dynamic_Predicate => Real.Kind = Real_Kind; subtype Str is Any with Dynamic_Predicate => Str.Kind = Str_Kind; subtype Vec is Any with Dynamic_Predicate => Vec.Kind = Vec_Kind; diff --git a/yeison_12/src/yeison_generic.adb b/yeison_12/src/yeison_generic.adb index 3afbf23..1a3af71 100644 --- a/yeison_12/src/yeison_generic.adb +++ b/yeison_12/src/yeison_generic.adb @@ -129,13 +129,18 @@ package body Yeison_Generic is ------------ function Scalar (This : Yeison_Generic.Scalar) return Client_Any - is (To_Any ((Any_Parent with Impl => new Any_Impl' - (case This.Data.Kind is - when Bool_Kind => (Bool_Kind, This.Data), - when Int_Kind => (Int_Kind, This.Data), - when Real_Kind => (Real_Kind, This.Data), - when Str_Kind => (Str_Kind, This.Data) - )))); + is + -- Workaround for bugbox in GNAT 11 + Pre : constant Any := + (Any_Parent with Impl => new Any_Impl' + (case This.Data.Kind is + when Bool_Kind => (Bool_Kind, This.Data), + when Int_Kind => (Int_Kind, This.Data), + when Real_Kind => (Real_Kind, This.Data), + when Str_Kind => (Str_Kind, This.Data))); + begin + return To_Any (Pre); + end Scalar; ----------- -- False -- From c062a009740a9e774643834d103f7ed1e5fd0c97 Mon Sep 17 00:00:00 2001 From: "Alejandro R. Mosteo" Date: Fri, 21 Feb 2025 12:25:39 +0100 Subject: [PATCH 07/14] S/U subprograms --- yeison_12/config/yeison_12_config.ads | 2 +- yeison_12/config/yeison_12_config.gpr | 8 ++++++-- yeison_12/config/yeison_12_config.h | 2 +- yeison_12/src/yeison_generic.adb | 2 +- yeison_12/src/yeison_generic.ads | 5 ++++- 5 files changed, 13 insertions(+), 6 deletions(-) diff --git a/yeison_12/config/yeison_12_config.ads b/yeison_12/config/yeison_12_config.ads index 2de5354..c0017e7 100644 --- a/yeison_12/config/yeison_12_config.ads +++ b/yeison_12/config/yeison_12_config.ads @@ -15,6 +15,6 @@ package Yeison_12_Config is Alire_Host_Distro : constant String := "ubuntu"; type Build_Profile_Kind is (release, validation, development); - Build_Profile : constant Build_Profile_Kind := development; + Build_Profile : constant Build_Profile_Kind := validation; end Yeison_12_Config; diff --git a/yeison_12/config/yeison_12_config.gpr b/yeison_12/config/yeison_12_config.gpr index a4c7a87..2890700 100644 --- a/yeison_12/config/yeison_12_config.gpr +++ b/yeison_12/config/yeison_12_config.gpr @@ -11,13 +11,17 @@ abstract project Yeison_12_Config is Ada_Compiler_Switches := External_As_List ("ADAFLAGS", " "); Ada_Compiler_Switches := Ada_Compiler_Switches & ( - "-Og" -- Optimize for debug + "-O3" -- Optimize for performance + ,"-gnatn" -- Enable inlining ,"-ffunction-sections" -- Separate ELF section for each function ,"-fdata-sections" -- Separate ELF section for each variable ,"-g" -- Generate debug info + ,"-gnato" -- Enable numeric overflow checking ,"-gnatwa" -- Enable all warnings ,"-gnatw.X" -- Disable warnings for No_Exception_Propagation ,"-gnatVa" -- All validity checks + ,"-gnatwe" -- Warnings as errors + ,"-gnata" -- Enable assertions and contracts ,"-gnaty3" -- Specify indentation level of 3 ,"-gnatya" -- Check attribute casing ,"-gnatyA" -- Use of array index numbers in array attributes @@ -46,6 +50,6 @@ abstract project Yeison_12_Config is ); type Build_Profile_Kind is ("release", "validation", "development"); - Build_Profile : Build_Profile_Kind := "development"; + Build_Profile : Build_Profile_Kind := "validation"; end Yeison_12_Config; diff --git a/yeison_12/config/yeison_12_config.h b/yeison_12/config/yeison_12_config.h index 1761a8a..836f505 100644 --- a/yeison_12/config/yeison_12_config.h +++ b/yeison_12/config/yeison_12_config.h @@ -15,6 +15,6 @@ #define BUILD_PROFILE_VALIDATION 2 #define BUILD_PROFILE_DEVELOPMENT 3 -#define BUILD_PROFILE 3 +#define BUILD_PROFILE 2 #endif diff --git a/yeison_12/src/yeison_generic.adb b/yeison_12/src/yeison_generic.adb index 1a3af71..3dbcbf1 100644 --- a/yeison_12/src/yeison_generic.adb +++ b/yeison_12/src/yeison_generic.adb @@ -86,7 +86,7 @@ package body Yeison_Generic is function New_Text (Val : Text) return Scalar is (Data => (Kind => Str_Kind, - Str => +Val)); + Str => U (Val))); end Scalars; diff --git a/yeison_12/src/yeison_generic.ads b/yeison_12/src/yeison_generic.ads index 448656e..91e668c 100644 --- a/yeison_12/src/yeison_generic.ads +++ b/yeison_12/src/yeison_generic.ads @@ -285,9 +285,12 @@ private package WWUStrings renames Ada.Strings.Wide_Wide_Unbounded; subtype WWUString is WWUStrings.Unbounded_Wide_Wide_String; - function "+" (S : Wide_Wide_String) return WWUString renames + function U (S : Wide_Wide_String) return WWUString renames Ada.Strings.Wide_Wide_Unbounded.To_Unbounded_Wide_Wide_String; + function S (U : WWUString) return Text renames + Ada.Strings.Wide_Wide_Unbounded.To_Wide_Wide_String; + type Any_Impl; type Any_Impl_Ptr is access Any_Impl; From f01f49e08b0f996bed5fecf3ceb4c7f9889f6e80 Mon Sep 17 00:00:00 2001 From: "Alejandro R. Mosteo" Date: Fri, 21 Feb 2025 12:50:54 +0100 Subject: [PATCH 08/14] Workarounds for GNAT 10/11 bugs --- yeison_12/src/yeison_12.ads | 8 +- yeison_12/src/yeison_generic-operators.adb | 107 +++++++++++++++++ yeison_12/src/yeison_generic-operators.ads | 43 +++++++ yeison_12/src/yeison_generic.adb | 127 +++------------------ yeison_12/src/yeison_generic.ads | 51 ++------- yeison_12/test/alire.toml | 2 +- yeison_12/test/src/test_12.adb | 2 +- 7 files changed, 182 insertions(+), 158 deletions(-) create mode 100644 yeison_12/src/yeison_generic-operators.adb create mode 100644 yeison_12/src/yeison_generic-operators.ads diff --git a/yeison_12/src/yeison_12.ads b/yeison_12/src/yeison_12.ads index 0e93310..ac398c6 100644 --- a/yeison_12/src/yeison_12.ads +++ b/yeison_12/src/yeison_12.ads @@ -1,6 +1,6 @@ pragma Ada_2012; -with Yeison_Generic; +with Yeison_Generic.Operators; with Yeison_Utils; package Yeison_12 with Preelaborate is @@ -53,6 +53,9 @@ package Yeison_12 with Preelaborate is subtype Text is Impl.Text; + function True return Any; + function False return Any; + ---------------- -- Indexing -- ---------------- @@ -107,6 +110,9 @@ private Unimplemented : exception; + function True return Any renames Make.True; + function False return Any renames Make.False; + ----------------- -- Nicer_Image -- ----------------- diff --git a/yeison_12/src/yeison_generic-operators.adb b/yeison_12/src/yeison_generic-operators.adb new file mode 100644 index 0000000..5a1b10f --- /dev/null +++ b/yeison_12/src/yeison_generic-operators.adb @@ -0,0 +1,107 @@ +package body Yeison_Generic.Operators is + + -- This whole package is an attempt at working around a bug in GNAT 10/11 + -- related to case records in nested generic packages. Or something. + + --------- + -- "/" -- + --------- + + function "/" (L, R : Client_Any) return Client_Any is + begin + if L.Kind in Scalar_Kinds then + return Result : Client_Any := Empty_Vec do + Result.Append (L); + Result.Append (R); + end return; + elsif L.Kind in Vec_Kind then + return Result : Client_Any := L do + Result.Append (R); + end return; + else + raise Constraint_Error with + "Cannot append using ""/"" when left operator is: " + & L.Kind'Image; + end if; + end "/"; + + ---------- + -- Make -- + ---------- + + package body Make is + + ------------ + -- Scalar -- + ------------ + + function Scalar (This : Yeison_Generic.Scalar) return Client_Any + is + Pre : constant Any'Class := + (case This.Data.Kind is + when Bool_Kind => New_Bool (This.Data.Bool), + when Int_Kind => New_Int (This.Data.Int), + when Real_Kind => New_Real (This.Data.Real), + when Str_Kind => New_Text (S (This.Data.Str))); + begin + return To_Any (Any (Pre)); + end Scalar; + + ----------- + -- False -- + ----------- + + function False return Client_Any + is (Make.Scalar (Scalars.New_Bool (False))); + + ---------- + -- True -- + ---------- + + function True return Client_Any + is (Make.Scalar (Scalars.New_Bool (True))); + + ---------- + -- Bool -- + ---------- + + function Bool (This : Boolean) return Client_Any + is (Make.Scalar (Scalars.New_Bool (This))); + + --------- + -- Int -- + --------- + + function Int (This : Int_Type) return Client_Any + is (Make.Scalar (Scalars.New_Int (This))); + + ---------- + -- Real -- + ---------- + + function Real (This : Real_Type) return Client_Any + is (Make.Scalar (Scalars.New_Real (This))); + + --------- + -- Str -- + --------- + + function Str (This : Wide_Wide_String) return Client_Any + is (Make.Scalar (Scalars.New_Text (This))); + + end Make; + + --------- + -- Vec -- + --------- + + function Vec (This : Any_Array) return Client_Any is + begin + return Result : Client_Any := Empty_Vec do + for Elem of This loop + Result.Append (Elem); + end loop; + end return; + end Vec; + +end Yeison_Generic.Operators; diff --git a/yeison_12/src/yeison_generic-operators.ads b/yeison_12/src/yeison_generic-operators.ads new file mode 100644 index 0000000..62f1378 --- /dev/null +++ b/yeison_12/src/yeison_generic-operators.ads @@ -0,0 +1,43 @@ +--------------- +-- Operators -- +--------------- + +generic + type Client_Any is new Yeison_Generic.Any with private; + with function To_Any (This : Yeison_Generic.Any) return Client_Any is <>; +package Yeison_Generic.Operators with Preelaborate is + + --------- + -- "/" -- + --------- + + function "/" (L, R : Client_Any) return Client_Any with + Pre => L.Kind in Scalar_Kinds | Vec_Kind, + Post => "/"'Result.Kind = Vec_Kind; + + -- Temporary workaround until both Add_Named and Add_Unnamed can be used + -- simultaneously on the same type. It's convenient having it here so + -- "+" becomes visible with the rest. + + type Any_Array is array (Positive range <>) of Client_Any; + + function Vec (This : Any_Array) return Client_Any with + Post => Vec'Result.Kind = Vec_Kind; + + ---------- + -- Make -- + ---------- + + package Make is + function True return Client_Any; + function False return Client_Any; + + function Bool (This : Boolean) return Client_Any; + function Int (This : Int_Type) return Client_Any; + function Real (This : Real_Type) return Client_Any; + function Str (This : Text) return Client_Any; + + function Scalar (This : Yeison_Generic.Scalar) return Client_Any; + end Make; + +end Yeison_Generic.Operators; diff --git a/yeison_12/src/yeison_generic.adb b/yeison_12/src/yeison_generic.adb index 3dbcbf1..2b9fe39 100644 --- a/yeison_12/src/yeison_generic.adb +++ b/yeison_12/src/yeison_generic.adb @@ -50,6 +50,22 @@ package body Yeison_Generic is function As_Text (This : Scalar) return Text is (WWUStrings.To_Wide_Wide_String (This.Data.Str)); + function New_Bool (Val : Boolean) return Any'Class + is (Any'(Any_Parent with Impl => + new Any_Impl'(Bool_Kind, (Bool_Kind, Val)))); + + function New_Int (Val : Int_Type) return Any'Class + is (Any'(Any_Parent with Impl => + new Any_Impl'(Int_Kind, (Int_Kind, Val)))); + + function New_Real (Val : Real_Type) return Any'Class + is (Any'(Any_Parent with Impl => + new Any_Impl'(Real_Kind, (Real_Kind, Val)))); + + function New_Text (Val : Text) return Any'Class + is (Any'(Any_Parent with Impl => + new Any_Impl'(Str_Kind, (Str_Kind, U (Val))))); + ------------- -- Scalars -- ------------- @@ -90,117 +106,6 @@ package body Yeison_Generic is end Scalars; - --------------- - -- Operators -- - --------------- - - package body Operators is - - --------- - -- "/" -- - --------- - - function "/" (L, R : Client_Any) return Client_Any is - begin - if L.Kind in Scalar_Kinds then - return Result : Client_Any := Empty_Vec do - Result.Append (L); - Result.Append (R); - end return; - elsif L.Kind in Vec_Kind then - return Result : Client_Any := L do - Result.Append (R); - end return; - else - raise Constraint_Error with - "Cannot append using ""/"" when left operator is: " - & L.Kind'Image; - end if; - end "/"; - - ---------- - -- Make -- - ---------- - - package body Make is - - ------------ - -- Scalar -- - ------------ - - function Scalar (This : Yeison_Generic.Scalar) return Client_Any - is - -- Workaround for bugbox in GNAT 11 - Pre : constant Any := - (Any_Parent with Impl => new Any_Impl' - (case This.Data.Kind is - when Bool_Kind => (Bool_Kind, This.Data), - when Int_Kind => (Int_Kind, This.Data), - when Real_Kind => (Real_Kind, This.Data), - when Str_Kind => (Str_Kind, This.Data))); - begin - return To_Any (Pre); - end Scalar; - - ----------- - -- False -- - ----------- - - function False return Client_Any - is (Make.Scalar (Scalars.New_Bool (False))); - - ---------- - -- True -- - ---------- - - function True return Client_Any - is (Make.Scalar (Scalars.New_Bool (True))); - - ---------- - -- Bool -- - ---------- - - function Bool (This : Boolean) return Client_Any - is (Make.Scalar (Scalars.New_Bool (This))); - - --------- - -- Int -- - --------- - - function Int (This : Int_Type) return Client_Any - is (Make.Scalar (Scalars.New_Int (This))); - - ---------- - -- Real -- - ---------- - - function Real (This : Real_Type) return Client_Any - is (Make.Scalar (Scalars.New_Real (This))); - - --------- - -- Str -- - --------- - - function Str (This : Wide_Wide_String) return Client_Any - is (Make.Scalar (Scalars.New_Text (This))); - - end Make; - - --------- - -- Vec -- - --------- - - function Vec (This : Any_Array) return Client_Any is - begin - return Result : Client_Any := Empty_Vec do - for Elem of This loop - Result.Append (Elem); - end loop; - end return; - end Vec; - - end Operators; - --------- -- "<" -- --------- diff --git a/yeison_12/src/yeison_generic.ads b/yeison_12/src/yeison_generic.ads index 91e668c..4f54eda 100644 --- a/yeison_12/src/yeison_generic.ads +++ b/yeison_12/src/yeison_generic.ads @@ -178,50 +178,6 @@ package Yeison_Generic with Preelaborate is end Scalars; - --------------- - -- Operators -- - --------------- - - generic - type Client_Any is new Yeison_Generic.Any with private; - with function To_Any (This : Yeison_Generic.Any) return Client_Any is <>; - package Operators is - - --------- - -- "/" -- - --------- - - function "/" (L, R : Client_Any) return Client_Any with - Pre => L.Kind in Scalar_Kinds | Vec_Kind, - Post => "/"'Result.Kind = Vec_Kind; - - -- Temporary workaround until both Add_Named and Add_Unnamed can be used - -- simultaneously on the same type. It's convenient having it here so - -- "+" becomes visible with the rest. - - type Any_Array is array (Positive range <>) of Client_Any; - - function Vec (This : Any_Array) return Client_Any with - Post => Vec'Result.Kind = Vec_Kind; - - ---------- - -- Make -- - ---------- - - package Make is - function True return Client_Any; - function False return Client_Any; - - function Bool (This : Boolean) return Client_Any; - function Int (This : Int_Type) return Client_Any; - function Real (This : Real_Type) return Client_Any; - function Str (This : Text) return Client_Any; - - function Scalar (This : Yeison_Generic.Scalar) return Client_Any; - end Make; - - end Operators; - ---------------- -- References -- ---------------- @@ -355,4 +311,11 @@ private Data : Scalar_Data; end record; + -- For the benefit of the child Operators + + function New_Bool (Val : Boolean) return Any'Class; + function New_Int (Val : Int_Type) return Any'Class; + function New_Real (Val : Real_Type) return Any'Class; + function New_Text (Val : Text) return Any'Class; + end Yeison_Generic; diff --git a/yeison_12/test/alire.toml b/yeison_12/test/alire.toml index 403bdb1..f5d676c 100644 --- a/yeison_12/test/alire.toml +++ b/yeison_12/test/alire.toml @@ -15,7 +15,7 @@ executables = ["test_12"] "*" = "validation" [build-switches] -"*".ada_version = "Ada2022" +"*".ada_version = "Ada12" [[depends-on]] yeison_12 = "*" diff --git a/yeison_12/test/src/test_12.adb b/yeison_12/test/src/test_12.adb index 18afcfd..83e21cd 100644 --- a/yeison_12/test/src/test_12.adb +++ b/yeison_12/test/src/test_12.adb @@ -40,7 +40,7 @@ begin -- Bool scalars - Report ("literal bool", True); + Report ("literal bool", Make.True); -- Int scalars From 2a49334ed25144565204c9435492457f75ccc1e9 Mon Sep 17 00:00:00 2001 From: "Alejandro R. Mosteo" Date: Fri, 21 Feb 2025 13:15:02 +0100 Subject: [PATCH 09/14] Explicit Nil kind (required by JSON/YAML) --- yeison_12/src/yeison_generic-operators.adb | 7 +++ yeison_12/src/yeison_generic-operators.ads | 2 + yeison_12/src/yeison_generic.adb | 67 +++++++++++----------- yeison_12/src/yeison_generic.ads | 44 ++++++++------ yeison_12/test/src/test_12.adb | 8 +-- 5 files changed, 69 insertions(+), 59 deletions(-) diff --git a/yeison_12/src/yeison_generic-operators.adb b/yeison_12/src/yeison_generic-operators.adb index 5a1b10f..a2f1f6f 100644 --- a/yeison_12/src/yeison_generic-operators.adb +++ b/yeison_12/src/yeison_generic-operators.adb @@ -31,6 +31,13 @@ package body Yeison_Generic.Operators is package body Make is + --------- + -- Nil -- + --------- + + function Nil return Client_Any + is (To_Any (Any (New_Nil))); + ------------ -- Scalar -- ------------ diff --git a/yeison_12/src/yeison_generic-operators.ads b/yeison_12/src/yeison_generic-operators.ads index 62f1378..5f71fbc 100644 --- a/yeison_12/src/yeison_generic-operators.ads +++ b/yeison_12/src/yeison_generic-operators.ads @@ -29,6 +29,8 @@ package Yeison_Generic.Operators with Preelaborate is ---------- package Make is + function Nil return Client_Any; + function True return Client_Any; function False return Client_Any; diff --git a/yeison_12/src/yeison_generic.adb b/yeison_12/src/yeison_generic.adb index 2b9fe39..3b65c24 100644 --- a/yeison_12/src/yeison_generic.adb +++ b/yeison_12/src/yeison_generic.adb @@ -29,12 +29,16 @@ package body Yeison_Generic is type Any_Impl (Kind : Kinds := Bool_Kind) is record case Kind is + when Nil_Kind => null; + when Scalar_Kinds => Val : Scalar_Data (Kind); + when Map_Kind => Map : Any_Maps.Map; Keys : Any_Vecs.Vector; -- Keys, in the order in which they were added + when Vec_Kind => Vec : Any_Vecs.Vector; end case; @@ -42,6 +46,13 @@ package body Yeison_Generic is with Dynamic_Predicate => (if Any_Impl.Kind = Map_Kind then Map.Length = Keys.Length); + -------------- + -- Nil_Impl -- + -------------- + + function Nil_Impl return Any_Impl_Ptr + is (new Any_Impl'(Kind => Nil_Kind)); + function Kind (This : Scalar) return Scalar_Kinds is (This.Data.Kind); function As_Boolean (This : Scalar) return Boolean is (This.Data.Bool); @@ -50,6 +61,9 @@ package body Yeison_Generic is function As_Text (This : Scalar) return Text is (WWUStrings.To_Wide_Wide_String (This.Data.Str)); + function New_Nil return Any'Class + is (Any'(Any_Parent with Impl => Nil_Impl)); + function New_Bool (Val : Boolean) return Any'Class is (Any'(Any_Parent with Impl => new Any_Impl'(Bool_Kind, (Bool_Kind, Val)))); @@ -122,6 +136,7 @@ package body Yeison_Generic is -- Both the same case L.Kind is + when Nil_Kind => return False; when Bool_Kind => return L.Val.Bool < R.Val.Bool; when Int_Kind => return L.Val.Int < R.Val.Int; when Real_Kind => return L.Val.Real < R.Val.Real; @@ -224,7 +239,7 @@ package body Yeison_Generic is To_Wide_Wide_String (This.Impl.Val.Str), when JSON => JSON_Quote (To_Wide_Wide_String (This.Impl.Val.Str))), - when Composite_Kinds => + when Nonscalar_Kinds => raise Program_Error with "not a scalar: " & This.Kind'Image ); @@ -310,6 +325,9 @@ package body Yeison_Generic is -- is (1 .. Str'Length => ' '); begin case This.Kind is + when Nil_Kind => + Append (Result, (if Contd then Text'("") else Prefix) & "null"); + when Scalar_Kinds => Append (Result, (if Contd then Text'("") else Prefix) @@ -417,11 +435,7 @@ package body Yeison_Generic is end Traverse; begin - if not This.Is_Valid then - raise Constraint_Error with "Cannot generate image of invalid value"; - else - Traverse (This, ""); - end if; + Traverse (This, ""); return To_Wide_Wide_String (Result); end Image; @@ -443,13 +457,13 @@ package body Yeison_Generic is when Vec_Kind => This.Impl.Vec.Is_Empty, when others => raise Constraint_Error - with "not a collection: " & This.Kind_If_Valid); + with "not a collection: " & This.Kind'Image); - -------------- - -- Is_Valid -- - -------------- + --------------- + -- Has_Value -- + --------------- - function Is_Valid (This : Any) return Boolean + function Has_Value (This : Any) return Boolean is (This.Impl /= null); ---------- @@ -482,15 +496,6 @@ package body Yeison_Generic is function Kind (This : Any) return Kinds is (This.Impl.Kind); - ------------------- - -- Kind_If_Valid -- - ------------------- - - function Kind_If_Valid (This : Any) return String - is (if This.Is_Valid - then This.Kind'Image - else "(invalid)"); - ------------ -- Length -- ------------ @@ -501,7 +506,7 @@ package body Yeison_Generic is when Vec_Kind => Universal_Integer (This.Impl.Vec.Length), when others => raise Constraint_Error - with "not a collection: " & This.Kind_If_Valid); + with "not a collection: " & This.Kind'Image); --------- -- "<" -- @@ -509,16 +514,6 @@ package body Yeison_Generic is function "<" (L, R : Any) return Boolean is begin - if not L.Is_Valid and then R.Is_Valid then - return True; - elsif not R.Is_Valid and then L.Is_Valid then - return False; - elsif not L.Is_Valid and then not R.Is_Valid then - return False; - end if; - - -- Both valid - if L.Kind < R.Kind then return True; elsif R.Kind < L.Kind then @@ -534,9 +529,7 @@ package body Yeison_Generic is overriding procedure Adjust (This : in out Any) is begin - if This.Is_Valid then - This.Impl := new Any_Impl'(This.Impl.all); - end if; + This.Impl := new Any_Impl'(This.Impl.all); end Adjust; ------------ @@ -673,7 +666,7 @@ package body Yeison_Generic is -- Initialize empty vec/map if needed - if not This.Is_Valid then + if This.Is_Nil then case Pos.Kind is when Int_Kind => Self (This).all := To_Any (Empty_Vec); @@ -727,6 +720,10 @@ package body Yeison_Generic is begin case Pos.Kind is + when Nil_Kind => + Constraint_Error ("with null index", Pos); + return null; + when Map_Kind => Constraint_Error ("with a map", Pos); return null; diff --git a/yeison_12/src/yeison_generic.ads b/yeison_12/src/yeison_generic.ads index 4f54eda..539fd2e 100644 --- a/yeison_12/src/yeison_generic.ads +++ b/yeison_12/src/yeison_generic.ads @@ -24,20 +24,28 @@ package Yeison_Generic with Preelaborate is subtype Universal_Integer is Long_Long_Integer; - -- This should be Preelaborate but a suspicious errors in the body - -- precludes it for now. TODO: To be investigated. + type Kinds is (Nil_Kind, + -- Uninitialized or explicitly null value - type Kinds is (Bool_Kind, + Bool_Kind, Int_Kind, Real_Kind, Str_Kind, + -- Scalar kinds; a single value + Map_Kind, - Vec_Kind); + Vec_Kind + -- Composite kinds; a collection of elements + ); - subtype Scalar_Kinds is Kinds range Kinds'First .. Kinds'Pred (Map_Kind); + subtype Scalar_Kinds + is Kinds range Kinds'Succ (Nil_Kind) .. Kinds'Pred (Map_Kind); subtype Composite_Kinds is Kinds range Map_Kind .. Kinds'Last; + subtype Nonscalar_Kinds is Kinds with + Static_Predicate => Nonscalar_Kinds in Nil_Kind | Composite_Kinds; + subtype Text is Wide_Wide_String; type Any is new Ada.Finalization.Controlled with private; @@ -63,16 +71,19 @@ package Yeison_Generic with Preelaborate is Options : Image_Options := (others => <>)) return Text; - function Invalid return Any; - -- An uninitialized Any; using it as the RHS of assignments will fail + function Has_Value (This : Any) return Boolean with + Post => Has_Value'Result = (This.Kind /= Nil_Kind); - function Is_Valid (This : Any) return Boolean; - - function Kind (This : Any) return Kinds with - Pre => This.Is_Valid; + function Kind (This : Any) return Kinds; type Any_Array is array (Positive range <>) of Any; + ----------- + -- Nil -- + ----------- + + function Is_Nil (This : Any) return Boolean is (This.Kind = Nil_Kind); + --------------- -- Scalars -- --------------- @@ -254,8 +265,10 @@ private -- also to control assignments via Controlled (when assigning through -- indexing). + function Nil_Impl return Any_Impl_Ptr; + type Any is new Ada.Finalization.Controlled with record - Impl : Any_Impl_Ptr; + Impl : Any_Impl_Ptr := Nil_Impl; end record; function "<" (L, R : Any) return Boolean; @@ -270,12 +283,6 @@ private Vec : Any; end record; - function Kind_If_Valid (This : Any) return String with - Post => Kind_If_Valid'Result = "(invalid)" or else - (for some Kind in Kinds => - Kind'Image = Kind_If_Valid'Result); - -- Used for exception info - -- These could go in the body if not because of -- https://forum.ada-lang.io/t/bug-or-legit-instantiation-in-body-of- -- preelaborable-generic-complains-about-non-static-constant/1742 @@ -313,6 +320,7 @@ private -- For the benefit of the child Operators + function New_Nil return Any'Class; function New_Bool (Val : Boolean) return Any'Class; function New_Int (Val : Int_Type) return Any'Class; function New_Real (Val : Real_Type) return Any'Class; diff --git a/yeison_12/test/src/test_12.adb b/yeison_12/test/src/test_12.adb index 83e21cd..9c2cc9a 100644 --- a/yeison_12/test/src/test_12.adb +++ b/yeison_12/test/src/test_12.adb @@ -17,11 +17,7 @@ procedure Test_12 is procedure Report (Label : String; Value : Yeison.Any) is begin - if Value.Is_Valid then - Put_Line (Label & " (" & Value.Kind'Image & "):"); - else - Put_Line (Label & " (INVALID):"); - end if; + Put_Line (Label & " (" & Value.Kind'Image & "):"); Put_Line (Encode (Value.Image)); New_Line; end Report; @@ -36,7 +32,7 @@ procedure Test_12 is end Report_RW; begin - Report ("empty", Invalid); + Report ("empty", Make.Nil); -- Bool scalars From 5c0b34b82cdd8201d6725326ab873193189f5123 Mon Sep 17 00:00:00 2001 From: "Alejandro R. Mosteo" Date: Fri, 21 Feb 2025 13:17:24 +0100 Subject: [PATCH 10/14] Remove ssh debugging --- .github/workflows/{build_extra.yml => build_old.yml} | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) rename .github/workflows/{build_extra.yml => build_old.yml} (76%) diff --git a/.github/workflows/build_extra.yml b/.github/workflows/build_old.yml similarity index 76% rename from .github/workflows/build_extra.yml rename to .github/workflows/build_old.yml index d1427cd..fe8139f 100644 --- a/.github/workflows/build_extra.yml +++ b/.github/workflows/build_old.yml @@ -1,4 +1,4 @@ -name: Build (GNAT 10, 11) +name: Build (old GNATs) on: pull_request: @@ -9,7 +9,9 @@ jobs: strategy: fail-fast: false matrix: - os: [windows-latest, ubuntu-latest] + os: + - windows-latest + - ubuntu-22.04 # Later Ubuntu no longer work with GNAT<=11 gnat_version: [10, 11] # Pre -12 don't support Ada 2022, so we only test Yeison_12 @@ -27,8 +29,8 @@ jobs: - name: Show GNAT version run: cd yeison_12 && alr exec -- gnat --version - - name: Setup tmate session - uses: mxschmitt/action-tmate@v3 + # - name: Setup tmate session + # uses: mxschmitt/action-tmate@v3 - name: Build run: cd yeison_12 && alr build From ac39b1349436eec31157e410f8bfe8d1b2255fee Mon Sep 17 00:00:00 2001 From: "Alejandro R. Mosteo" Date: Fri, 21 Feb 2025 13:22:06 +0100 Subject: [PATCH 11/14] Type invariant + Invalid removal --- yeison_12/src/yeison_generic-operators.adb | 10 ++--- yeison_12/src/yeison_generic.adb | 47 +++++++++++----------- yeison_12/src/yeison_generic.ads | 19 +++++---- 3 files changed, 41 insertions(+), 35 deletions(-) diff --git a/yeison_12/src/yeison_generic-operators.adb b/yeison_12/src/yeison_generic-operators.adb index a2f1f6f..26b69a6 100644 --- a/yeison_12/src/yeison_generic-operators.adb +++ b/yeison_12/src/yeison_generic-operators.adb @@ -36,7 +36,7 @@ package body Yeison_Generic.Operators is --------- function Nil return Client_Any - is (To_Any (Any (New_Nil))); + is (To_Any (Base.New_Nil)); ------------ -- Scalar -- @@ -46,10 +46,10 @@ package body Yeison_Generic.Operators is is Pre : constant Any'Class := (case This.Data.Kind is - when Bool_Kind => New_Bool (This.Data.Bool), - when Int_Kind => New_Int (This.Data.Int), - when Real_Kind => New_Real (This.Data.Real), - when Str_Kind => New_Text (S (This.Data.Str))); + when Bool_Kind => Base.New_Bool (This.Data.Bool), + when Int_Kind => Base.New_Int (This.Data.Int), + when Real_Kind => Base.New_Real (This.Data.Real), + when Str_Kind => Base.New_Text (S (This.Data.Str))); begin return To_Any (Any (Pre)); end Scalar; diff --git a/yeison_12/src/yeison_generic.adb b/yeison_12/src/yeison_generic.adb index 3b65c24..10ffd2e 100644 --- a/yeison_12/src/yeison_generic.adb +++ b/yeison_12/src/yeison_generic.adb @@ -61,24 +61,32 @@ package body Yeison_Generic is function As_Text (This : Scalar) return Text is (WWUStrings.To_Wide_Wide_String (This.Data.Str)); - function New_Nil return Any'Class - is (Any'(Any_Parent with Impl => Nil_Impl)); + ---------- + -- Base -- + ---------- + + package body Base is + + function New_Nil return Any + is (Any'(Any_Parent with Impl => Nil_Impl)); + + function New_Bool (Val : Boolean) return Any + is (Any'(Any_Parent with Impl => + new Any_Impl'(Bool_Kind, (Bool_Kind, Val)))); - function New_Bool (Val : Boolean) return Any'Class - is (Any'(Any_Parent with Impl => - new Any_Impl'(Bool_Kind, (Bool_Kind, Val)))); + function New_Int (Val : Int_Type) return Any + is (Any'(Any_Parent with Impl => + new Any_Impl'(Int_Kind, (Int_Kind, Val)))); - function New_Int (Val : Int_Type) return Any'Class - is (Any'(Any_Parent with Impl => - new Any_Impl'(Int_Kind, (Int_Kind, Val)))); + function New_Real (Val : Real_Type) return Any + is (Any'(Any_Parent with Impl => + new Any_Impl'(Real_Kind, (Real_Kind, Val)))); - function New_Real (Val : Real_Type) return Any'Class - is (Any'(Any_Parent with Impl => - new Any_Impl'(Real_Kind, (Real_Kind, Val)))); + function New_Text (Val : Text) return Any + is (Any'(Any_Parent with Impl => + new Any_Impl'(Str_Kind, (Str_Kind, U (Val))))); - function New_Text (Val : Text) return Any'Class - is (Any'(Any_Parent with Impl => - new Any_Impl'(Str_Kind, (Str_Kind, U (Val))))); + end Base; ------------- -- Scalars -- @@ -440,13 +448,6 @@ package body Yeison_Generic is return To_Wide_Wide_String (Result); end Image; - ------------- - -- Invalid -- - ------------- - - function Invalid return Any - is (Ada.Finalization.Controlled with Impl => null); - -------------- -- Is_Empty -- -------------- @@ -695,7 +696,7 @@ package body Yeison_Generic is -- end if; if not This.Impl.Map.Contains (Pos) then - This.Impl.Map.Insert (Pos, To_Any (Invalid)); + This.Impl.Map.Insert (Pos, To_Any (Base.New_Nil)); end if; return Self @@ -710,7 +711,7 @@ package body Yeison_Generic is end if; if Univ (This.Impl.Vec.Length) < To_Integer (Pos.As_Int) then - This.Impl.Vec.Append (To_Any (Invalid)); + This.Impl.Vec.Append (To_Any (Base.New_Nil)); end if; return Self (This.Impl.Vec.Constant_Reference diff --git a/yeison_12/src/yeison_generic.ads b/yeison_12/src/yeison_generic.ads index 539fd2e..9ef9f25 100644 --- a/yeison_12/src/yeison_generic.ads +++ b/yeison_12/src/yeison_generic.ads @@ -211,7 +211,7 @@ package Yeison_Generic with Preelaborate is -- complex types, which is discouraged, and this is explicitly not -- supported. -- - -- If This is invalid, the appropriate holder value will be created (vec + -- If This is nil, the appropriate holder value will be created (vec -- or map) depending on Any.Kind being Int or something else. If you -- want to force either one, assign first an empty value. @@ -269,7 +269,8 @@ private type Any is new Ada.Finalization.Controlled with record Impl : Any_Impl_Ptr := Nil_Impl; - end record; + end record with + Type_Invariant => Impl /= null; function "<" (L, R : Any) return Boolean; @@ -320,10 +321,14 @@ private -- For the benefit of the child Operators - function New_Nil return Any'Class; - function New_Bool (Val : Boolean) return Any'Class; - function New_Int (Val : Int_Type) return Any'Class; - function New_Real (Val : Real_Type) return Any'Class; - function New_Text (Val : Text) return Any'Class; + package Base is + -- Avoid primitiveness + + function New_Nil return Any; + function New_Bool (Val : Boolean) return Any; + function New_Int (Val : Int_Type) return Any; + function New_Real (Val : Real_Type) return Any; + function New_Text (Val : Text) return Any; + end Base; end Yeison_Generic; From 08aab8cecc5010a44152c6d95788aa5887c6445a Mon Sep 17 00:00:00 2001 From: "Alejandro R. Mosteo" Date: Fri, 21 Feb 2025 13:46:32 +0100 Subject: [PATCH 12/14] Catch-up the 22 version --- dev/alire.toml | 8 ++++---- yeison_22/src/yeison-operators.ads | 4 ++++ yeison_22/src/yeison.adb | 8 ++++++++ yeison_22/src/yeison.ads | 12 +++++++++--- yeison_22/test/src/test.adb | 8 ++------ 5 files changed, 27 insertions(+), 13 deletions(-) diff --git a/dev/alire.toml b/dev/alire.toml index f853148..f4dafbd 100644 --- a/dev/alire.toml +++ b/dev/alire.toml @@ -15,9 +15,9 @@ executables = ["dev"] "*" = "validation" [[depends-on]] -yeison_12 = "~0.2.0-dev" -yeison = "~0.2.0-dev" +test_12 = "~0.1.0-dev" +test = "~0.1.0-dev" [[pins]] -yeison_12 = { path='../yeison_12' } -yeison = { path='../yeison_22' } +test_12 = { path='../yeison_12/test' } +test = { path='../yeison_22/test' } diff --git a/yeison_22/src/yeison-operators.ads b/yeison_22/src/yeison-operators.ads index c3b0a10..d64fea3 100644 --- a/yeison_22/src/yeison-operators.ads +++ b/yeison_22/src/yeison-operators.ads @@ -1,3 +1,5 @@ +with Yeison_Generic.Operators; + package Yeison.Operators with Preelaborate is package Impl is new Yeison.Impl.Operators (Any); @@ -7,4 +9,6 @@ package Yeison.Operators with Preelaborate is function "/" (L, R : Any) return Any renames Impl."/"; -- Vector concatenation a-la dir hierarchy + package Make renames Impl.Make; + end Yeison.Operators; diff --git a/yeison_22/src/yeison.adb b/yeison_22/src/yeison.adb index 1d8470e..cfad59e 100644 --- a/yeison_22/src/yeison.adb +++ b/yeison_22/src/yeison.adb @@ -1,3 +1,5 @@ +with Yeison_Generic.Operators; + package body Yeison is ------------ @@ -11,6 +13,12 @@ package body Yeison is package References is new Impl.References (Any); + package Make renames Operators.Make; + + function Nil return Any renames Make.Nil; + function False return Any renames Make.False; + function True return Any renames Make.True; + ------------ -- As_Ref -- ------------ diff --git a/yeison_22/src/yeison.ads b/yeison_22/src/yeison.ads index 7722d78..bfc9dfb 100644 --- a/yeison_22/src/yeison.ads +++ b/yeison_22/src/yeison.ads @@ -69,13 +69,15 @@ package Yeison with Preelaborate is subtype Bool is Any with Dynamic_Predicate => Bool.Kind = Bool_Kind; subtype Int is Any with Dynamic_Predicate => Int.Kind = Int_Kind; subtype Map is Any with - Dynamic_Predicate => not Map.Is_Valid or else Map.Kind = Map_Kind; + Dynamic_Predicate => Map.Kind in Nil_Kind | Map_Kind; subtype Real is Any with Dynamic_Predicate => Real.Kind = Real_Kind; subtype Str is Any with Dynamic_Predicate => Str.Kind = Str_Kind; subtype Vec is Any with - Dynamic_Predicate => not Vec.Is_Valid or else Vec.Kind = Vec_Kind; + Dynamic_Predicate => Vec.Kind in Nil_Kind | Vec_Kind; - function To_Any (This : Impl.Any) return Any; + function Nil return Any; + function False return Any; + function True return Any; --------------- -- Scalars -- @@ -140,6 +142,10 @@ package Yeison with Preelaborate is -- Cannot be instantiated here as Any must be private. Simply with and use -- Yeison.Operators. + function To_Any (This : Impl.Any) return Any; + -- This should be private but it must be publicly visible by the nested + -- Operators. Another spill-over of trying to reuse for 12/22 versions. + private Unimplemented : exception; diff --git a/yeison_22/test/src/test.adb b/yeison_22/test/src/test.adb index 0e0c4bf..3f9b794 100644 --- a/yeison_22/test/src/test.adb +++ b/yeison_22/test/src/test.adb @@ -18,11 +18,7 @@ procedure Test is procedure Report (Label : String; Value : Yeison.Any) is begin - if Value.Is_Valid then - Put_Line (Label & " (" & Value.Kind'Image & "):"); - else - Put_Line (Label & " (INVALID):"); - end if; + Put_Line (Label & " (" & Value.Kind'Image & "):"); Put_Line (Encode (Value.Image)); New_Line; end Report; @@ -37,7 +33,7 @@ procedure Test is end Report_RW; begin - Report ("empty", Yeison.Invalid); + Report ("empty", Make.Nil); -- Bool scalars From 88b66242f8826fd4847e0ea06c7901b753e03c74 Mon Sep 17 00:00:00 2001 From: "Alejandro R. Mosteo" Date: Fri, 21 Feb 2025 14:00:59 +0100 Subject: [PATCH 13/14] Fix Has_Value implementation --- yeison_12/src/yeison_generic.adb | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/yeison_12/src/yeison_generic.adb b/yeison_12/src/yeison_generic.adb index 10ffd2e..cd208b9 100644 --- a/yeison_12/src/yeison_generic.adb +++ b/yeison_12/src/yeison_generic.adb @@ -465,7 +465,7 @@ package body Yeison_Generic is --------------- function Has_Value (This : Any) return Boolean - is (This.Impl /= null); + is (This.Kind /= Nil_Kind); ---------- -- Keys -- From 3601ac022e668e3c59d7a24540da581c546731f1 Mon Sep 17 00:00:00 2001 From: "Alejandro R. Mosteo" Date: Thu, 6 Mar 2025 22:06:17 +0100 Subject: [PATCH 14/14] dev: preparations for 0.2.0 --- yeison_12/alire.toml | 2 +- yeison_12/config/yeison_12_config.ads | 2 +- yeison_12/config/yeison_12_config.gpr | 2 +- yeison_12/config/yeison_12_config.h | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/yeison_12/alire.toml b/yeison_12/alire.toml index 4919fec..ffc1de5 100644 --- a/yeison_12/alire.toml +++ b/yeison_12/alire.toml @@ -1,6 +1,6 @@ name = "yeison_12" description = "A JSON-like data structure (Ada 2012 version)" -version = "0.2.0-dev" +version = "0.2.0" licenses = "MIT" authors = ["Alejandro R. Mosteo"] diff --git a/yeison_12/config/yeison_12_config.ads b/yeison_12/config/yeison_12_config.ads index c0017e7..e4e758b 100644 --- a/yeison_12/config/yeison_12_config.ads +++ b/yeison_12/config/yeison_12_config.ads @@ -5,7 +5,7 @@ pragma Style_Checks (Off); package Yeison_12_Config is pragma Pure; - Crate_Version : constant String := "0.2.0-dev"; + Crate_Version : constant String := "0.2.0"; Crate_Name : constant String := "yeison_12"; Alire_Host_OS : constant String := "linux"; diff --git a/yeison_12/config/yeison_12_config.gpr b/yeison_12/config/yeison_12_config.gpr index 2890700..d0e0d33 100644 --- a/yeison_12/config/yeison_12_config.gpr +++ b/yeison_12/config/yeison_12_config.gpr @@ -1,6 +1,6 @@ -- Configuration for yeison_12 generated by Alire abstract project Yeison_12_Config is - Crate_Version := "0.2.0-dev"; + Crate_Version := "0.2.0"; Crate_Name := "yeison_12"; Alire_Host_OS := "linux"; diff --git a/yeison_12/config/yeison_12_config.h b/yeison_12/config/yeison_12_config.h index 836f505..b74d0a6 100644 --- a/yeison_12/config/yeison_12_config.h +++ b/yeison_12/config/yeison_12_config.h @@ -2,7 +2,7 @@ #ifndef YEISON_12_CONFIG_H #define YEISON_12_CONFIG_H -#define CRATE_VERSION "0.2.0-dev" +#define CRATE_VERSION "0.2.0" #define CRATE_NAME "yeison_12" #define ALIRE_HOST_OS "linux"