From 81f7e19f212f9d1ac75e04e62933e6c918219cfc Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Wed, 9 Jan 2019 22:58:10 +1100 Subject: Packrat.Tokens added, tested, and functional --- src/packrat-tokens.adb | 116 +++++++++++++++++++++++++++++++++++++++++++++++++ src/packrat.adb | 1 + src/packrat.ads | 79 ++++++++++++++++++++++++++++++++- 3 files changed, 195 insertions(+), 1 deletion(-) create mode 100644 src/packrat-tokens.adb (limited to 'src') 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 -- cgit