diff options
| -rw-r--r-- | packrat_parser_lib_notes.txt | 46 | ||||
| -rw-r--r-- | src/packrat-tokens.adb | 116 | ||||
| -rw-r--r-- | src/packrat.adb | 1 | ||||
| -rw-r--r-- | src/packrat.ads | 79 | ||||
| -rw-r--r-- | test/ratnest-tests.adb | 42 | ||||
| -rw-r--r-- | test/ratnest-tests.ads | 10 | ||||
| -rw-r--r-- | test/test_main.adb | 4 |
7 files changed, 297 insertions, 1 deletions
diff --git a/packrat_parser_lib_notes.txt b/packrat_parser_lib_notes.txt index 8bcac69..8e98d56 100644 --- a/packrat_parser_lib_notes.txt +++ b/packrat_parser_lib_notes.txt @@ -214,6 +214,10 @@ Pretty_Print To_String Pretty_Print +(for tokens) +To_String +Pretty_Print + @@ -244,6 +248,36 @@ Decode +Packrat.Tokens + - nested package, defines a datatype important throughout lexing/parsing + - generic over the array type of whatever is being lexed/parsed and the enum of valid token labels + - contains an enum identifier, the start position, the finish position plus one, and the token value + +List of datatypes: +Token (tagged, controlled, but not limited) + +List of funcs: +Create +Initialized + +Label +Value +Start +Finish + + + + +Packrat.Graphs + +List_of_datatypes: +Parse_Graph + +List of funcs: + + + + Ratnest @@ -257,6 +291,18 @@ Run_Tests Ratnest.Tests List of funcs: +Valid_Message_Check +Valid_Identifier_Check +Join_Check +Encode_1_Check +Encode_2_Check +Encode_3_Check +Encode_4_Check +Decode_Check + +Token_Adjust_Check +Token_Store_Check + In_Set_Check Not_In_Set_Check diff --git a/src/packrat-tokens.adb b/src/packrat-tokens.adb new file mode 100644 index 0000000..4cb10bf --- /dev/null +++ b/src/packrat-tokens.adb @@ -0,0 +1,116 @@ + + +with + + Ada.Unchecked_Deallocation; + + +separate (Packrat) +package body Tokens is + + + procedure Free_Array is new Ada.Unchecked_Deallocation + (Object => Element_Array, Name => Element_Array_Access); + + + + + + procedure Initialize + (This : in out Token) is + begin + This.Start_At := 1; + This.Finish_At := 0; + end Initialize; + + + procedure Adjust + (This : in out Token) + is + New_Array : Element_Array_Access := + new Element_Array (This.Token_Value'Range); + begin + New_Array.all := This.Token_Value.all; + This.Token_Value := New_Array; + end Adjust; + + + procedure Finalize + (This : in out Token) is + begin + if This.Token_Value /= null then + Free_Array (This.Token_Value); + end if; + end Finalize; + + + + + + function Create + (Ident : in Label_Enum; + Start : in Positive; + Finish : in Natural; + Value : in Element_Array) + return Token + is + This : Token; + begin + This.Identifier := Ident; + This.Start_At := Start; + This.Finish_At := Finish; + This.Token_Value := new Element_Array (Value'Range); + This.Token_Value.all := Value; + return This; + end Create; + + + + + + function Initialized + (This : in Token) + return Boolean is + begin + return This.Token_Value /= null; + end Initialized; + + + + + + function Label + (This : in Token) + return Label_Enum is + begin + return This.Identifier; + end Label; + + + function Start + (This : in Token) + return Positive is + begin + return This.Start_At; + end Start; + + + function Finish + (This : in Token) + return Natural is + begin + return This.Finish_At; + end Finish; + + + function Value + (This : in Token) + return Element_Array is + begin + return This.Token_Value.all; + end Value; + + +end Tokens; + + diff --git a/src/packrat.adb b/src/packrat.adb index e78d0ae..de623e2 100644 --- a/src/packrat.adb +++ b/src/packrat.adb @@ -4,6 +4,7 @@ package body Packrat is package body Errors is separate; + package body Tokens is separate; end Packrat; diff --git a/src/packrat.ads b/src/packrat.ads index 1c81958..c60b798 100644 --- a/src/packrat.ads +++ b/src/packrat.ads @@ -2,7 +2,8 @@ with - Ada.Strings.Unbounded; + Ada.Strings.Unbounded, + Ada.Finalization; package Packrat is @@ -88,6 +89,82 @@ package Packrat is end Errors; + + + generic + type Label_Enum is (<>); + type Element is private; + type Element_Array is array (Positive range <>) of Element; + package Tokens is + + + type Token is new Ada.Finalization.Controlled with private; + + + function Create + (Ident : in Label_Enum; + Start : in Positive; + Finish : in Natural; + Value : in Element_Array) + return Token; + + + -- Note: The Start and Finish indices indicate where the token was found + -- in whatever array it was lexed from. The Value does *not* have + -- to correspond with whatever is found in the Start .. Finish range. + + + function Initialized + (This : in Token) + return Boolean; + + + function Label + (This : in Token) + return Label_Enum + with Pre => Initialized (This); + + function Start + (This : in Token) + return Positive; + + function Finish + (This : in Token) + return Natural; + + function Value + (This : in Token) + return Element_Array + with Pre => Initialized (This); + + + private + + + type Element_Array_Access is access Element_Array; + + + type Token is new Ada.Finalization.Controlled with record + Identifier : Label_Enum; + Start_At : Positive; + Finish_At : Natural; + Token_Value : Element_Array_Access; + end record; + + + overriding procedure Initialize + (This : in out Token); + + overriding procedure Adjust + (This : in out Token); + + overriding procedure Finalize + (This : in out Token); + + + end Tokens; + + private diff --git a/test/ratnest-tests.adb b/test/ratnest-tests.adb index df17775..1f0950d 100644 --- a/test/ratnest-tests.adb +++ b/test/ratnest-tests.adb @@ -162,6 +162,48 @@ package body Ratnest.Tests is + function Token_Adjust_Check + return Test_Result + is + type My_Labels is (One, Two, Three); + package My_Tokens is new Packrat.Tokens (My_Labels, Character, String); + + A : My_Tokens.Token; + begin + declare + B : My_Tokens.Token := My_Tokens.Create (One, 1, 3, "abc"); + begin + A := B; + end; + if not A.Initialized or else A.Value /= "abc" then + return Failure; + end if; + return Success; + end Token_Adjust_Check; + + + function Token_Store_Check + return Test_Result + is + type My_Labels is (One, Two, Three); + package My_Tokens is new Packrat.Tokens (My_Labels, Character, String); + + T : My_Tokens.Token := My_Tokens.Create (One, 1, 3, "abc"); + begin + if not T.Initialized or else + T.Label /= One or else + T.Start /= 1 or else T.Finish /= 3 or else + T.Value /= "abc" + then + return Failure; + end if; + return Success; + end Token_Store_Check; + + + + + function In_Set_Check return Test_Result is diff --git a/test/ratnest-tests.ads b/test/ratnest-tests.ads index db20313..3c83a23 100644 --- a/test/ratnest-tests.ads +++ b/test/ratnest-tests.ads @@ -25,6 +25,16 @@ package Ratnest.Tests is + function Token_Adjust_Check return Test_Result; + function Token_Store_Check return Test_Result; + + Token_Tests : Test_Array := + ((+"Token Adjust", Token_Adjust_Check'Access), + (+"Token Storage", Token_Store_Check'Access)); + + + + function In_Set_Check return Test_Result; function Not_In_Set_Check return Test_Result; diff --git a/test/test_main.adb b/test/test_main.adb index 0ce72b1..404e690 100644 --- a/test/test_main.adb +++ b/test/test_main.adb @@ -18,6 +18,10 @@ begin Run_Tests (Error_Tests); New_Line; + Put_Line ("Running tests for Packrat.Tokens..."); + Run_Tests (Token_Tests); + New_Line; + Put_Line ("Running tests for Packrat.Util..."); Put_Line ("Testing set predicates..."); Run_Tests (Set_Predicate_Tests); |