From 11f3f26e877210b88f1cadfe2c26d67b4530039c Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Wed, 9 Jan 2019 14:43:25 +1100 Subject: Packrat.Errors functionality complete and tested --- src/packrat-errors-parts.adb | 95 +++++++++++++++++++++ src/packrat-errors.adb | 196 ++++++++++++++++++++++++++++++++++++++++--- src/packrat.ads | 11 +++ 3 files changed, 292 insertions(+), 10 deletions(-) create mode 100644 src/packrat-errors-parts.adb (limited to 'src') diff --git a/src/packrat-errors-parts.adb b/src/packrat-errors-parts.adb new file mode 100644 index 0000000..5ad3482 --- /dev/null +++ b/src/packrat-errors-parts.adb @@ -0,0 +1,95 @@ + + +with + + Ada.Strings.Fixed, + Ada.Strings.Maps; + +use type + + Ada.Strings.Maps.Character_Set; + + +separate (Packrat.Errors) +package body Parts is + + + package Str renames Ada.Strings; + package Fix renames Ada.Strings.Fixed; + package Map renames Ada.Strings.Maps; + + + ID_Start, ID_Finish : Positive := 1; + Pos_Start, Pos_Finish : Positive := 1; + Error_Count : Natural := Fix.Count (Message, Map.To_Set ('s')); + + + Letter_Range : Map.Character_Range := ('A', 'Z'); + Digit_Range : Map.Character_Range := ('0', '9'); + ID_Set : Map.Character_Set := Map.To_Set (Letter_Range) or Map.To_Set ('_'); + Pos_Set : Map.Character_Set := Map.To_Set (Digit_Range); + + + function Length + return Natural is + begin + return Error_Count; + end Length; + + + procedure Reset_Position is + begin + ID_Start := 1; + ID_Finish := 1; + Pos_Start := 1; + Pos_Finish := 1; + end Reset_Position; + + + procedure Set_Position + (To : in Positive) is + begin + ID_Start := To; + ID_Finish := To; + Pos_Start := To; + Pos_Finish := To; + end Set_Position; + + + procedure Next_ID_Token + (Start : out Positive; + Finish : out Natural) is + begin + Fix.Find_Token (Message, ID_Set, Pos_Finish, Str.Inside, ID_Start, ID_Finish); + Start := ID_Start; + Finish := ID_Finish; + Pos_Finish := ID_Finish; + end Next_ID_Token; + + + procedure Next_Pos_Token + (Start : out Positive; + Finish : out Natural) is + begin + Fix.Find_Token (Message, Pos_Set, ID_Finish, Str.Inside, Pos_Start, Pos_Finish); + Start := Pos_Start; + Finish := Pos_Finish; + ID_Finish := Pos_Finish; + end Next_Pos_Token; + + + procedure Next_Full_Token + (Start : out Positive; + Finish : out Natural) + is + Dummy : Natural; + begin + Next_ID_Token (Start, Dummy); + Next_Pos_Token (Dummy, Finish); + Start := Start - 1; + end Next_Full_Token; + + +end Parts; + + diff --git a/src/packrat-errors.adb b/src/packrat-errors.adb index 44b9202..cb54e97 100644 --- a/src/packrat-errors.adb +++ b/src/packrat-errors.adb @@ -1,10 +1,94 @@ +with + + Ada.Strings.Fixed, + Ada.Characters.Handling; + + separate (Packrat) package body Errors is package SU renames Ada.Strings.Unbounded; + package SF renames Ada.Strings.Fixed; + package CH renames Ada.Characters.Handling; + + + + + + function Image + (Num : in Natural) + return String + is + Raw : String := Integer'Image (Num); + begin + return Raw (1 + 1 .. Raw'Length); + end Image; + + + function Is_Upper + (Char : in Character) + return Boolean is + begin + return Char >= 'A' and Char <= 'Z'; + end Is_Upper; + + + function Is_Lower + (Char : in Character) + return Boolean is + begin + return Char >= 'a' and Char <= 'z'; + end Is_Lower; + + + function Is_Letter + (Char : in Character) + return Boolean is + begin + return Is_Upper (Char) or Is_Lower (Char); + end Is_Letter; + + + function Is_Digit + (Char : in Character) + return Boolean is + begin + return Char >= '0' and Char <= '9'; + end Is_Digit; + + + + + + generic + Message : in String; + package Parts is + + function Length + return Natural; + + procedure Reset_Position; + + procedure Set_Position + (To : in Positive); + + procedure Next_ID_Token + (Start : out Positive; + Finish : out Natural); + + procedure Next_Pos_Token + (Start : out Positive; + Finish : out Natural); + + procedure Next_Full_Token + (Start : out Positive; + Finish : out Natural); + + end Parts; + package body Parts is separate; @@ -14,6 +98,29 @@ package body Errors is (Check : in String) return Boolean is begin + if Check'Length < 1 then + return False; + end if; + if not Is_Letter (Check (Check'First)) then + return False; + end if; + for N in Integer range Check'First + 1 .. Check'Last - 1 loop + if not Is_Letter (Check (N)) and + not Is_Digit (Check (N)) and + Check (N) /= '_' + then + return False; + end if; + if Check (N) = '_' and + ((not Is_Letter (Check (N - 1)) and not Is_Digit (Check (N - 1))) or + (not Is_Letter (Check (N + 1)) and not Is_Digit (Check (N + 1)))) + then + return False; + end if; + end loop; + if not Is_Letter (Check (Check'Last)) and not Is_Digit (Check (Check'Last)) then + return False; + end if; return True; end Valid_Identifier; @@ -22,7 +129,7 @@ package body Errors is (Check : in SU.Unbounded_String) return Boolean is begin - return True; + return Valid_Identifier (-Check); end Valid_Identifier; @@ -30,14 +137,46 @@ package body Errors is (Check : in Error_Info_Array) return Boolean is begin + for EI of Check loop + if not Valid_Identifier (-EI.Symbol) then + return False; + end if; + end loop; return True; end Valid_Identifier_Array; function Valid_Message (Check : in String) - return Boolean is + return Boolean + is + S_Place, P_Place : Natural := 1; begin + while S_Place <= Check'Length loop + if Check (S_Place) /= 's' then + return False; + end if; + P_Place := SF.Index (Check, "p", S_Place); + if (P_Place < S_Place) then + return False; + end if; + declare + ID : String := Check (S_Place + 1 .. P_Place - 1); + begin + if not Valid_Identifier (ID) or ID /= CH.To_Upper (ID) then + return False; + end if; + end; + P_Place := P_Place + 1; + if P_Place > Check'Length or else not Is_Digit (Check (P_Place)) then + return False; + end if; + loop + P_Place := P_Place + 1; + exit when P_Place > Check'Length or else not Is_Digit (Check (P_Place)); + end loop; + S_Place := P_Place; + end loop; return True; end Valid_Message; @@ -47,9 +186,32 @@ package body Errors is function Join (Left, Right : in Error_Message) - return Error_Message is + return Error_Message + is + package Left_Parts is new Parts (Left); + package Right_Parts is new Parts (Right); + + LS, LF, RS, RF : Natural; + Add : Boolean; + + Result : SU.Unbounded_String := +Left; begin - return ""; + for R in Integer range 1 .. Right_Parts.Length loop + Add := True; + Right_Parts.Next_Full_Token (RS, RF); + for L in Integer range 1 .. Left_Parts.Length loop + Left_Parts.Next_Full_Token (LS, LF); + if Left (LS .. LF) = Right (RS .. RF) then + Add := False; + exit; + end if; + end loop; + if Add then + SU.Append (Result, +Right (RS .. RF)); + end if; + Left_Parts.Reset_Position; + end loop; + return -Result; end Join; @@ -61,7 +223,7 @@ package body Errors is Pos : in Natural) return Error_Message is begin - return ""; + return "s" & CH.To_Upper (Name) & "p" & Image (Pos); end Encode; @@ -70,7 +232,7 @@ package body Errors is Pos : in Natural) return Error_Message is begin - return ""; + return Encode (-Name, Pos); end Encode; @@ -78,15 +240,20 @@ package body Errors is (Info : in Error_Info) return Error_Message is begin - return ""; + return Encode (-Info.Symbol, Info.Position); end Encode; function Encode_Array (Info : in Error_Info_Array) - return Error_Message is + return Error_Message + is + Result : SU.Unbounded_String := SU.To_Unbounded_String (0); begin - return ""; + for EI of Info loop + SU.Append (Result, (Encode (-EI.Symbol, EI.Position))); + end loop; + return -Result; end Encode_Array; @@ -94,8 +261,17 @@ package body Errors is (Msg : in Error_Message) return Error_Info_Array is - Result : Error_Info_Array (1 .. 0); + package Msg_Parts is new Parts (Msg); + + Result : Error_Info_Array (1 .. Msg_Parts.Length); + Start, Finish : Natural; begin + for EI of Result loop + Msg_Parts.Next_ID_Token (Start, Finish); + EI.Symbol := +Msg (Start .. Finish); + Msg_Parts.Next_Pos_Token (Start, Finish); + EI.Position := Integer'Value (Msg (Start .. Finish)); + end loop; return Result; end Decode; diff --git a/src/packrat.ads b/src/packrat.ads index 628923f..1c81958 100644 --- a/src/packrat.ads +++ b/src/packrat.ads @@ -91,6 +91,17 @@ package Packrat is private + function "+" + (S : in String) + return Ada.Strings.Unbounded.Unbounded_String + renames Ada.Strings.Unbounded.To_Unbounded_String; + + function "-" + (US : in Ada.Strings.Unbounded.Unbounded_String) + return String + renames Ada.Strings.Unbounded.To_String; + + end Packrat; -- cgit