diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/packrat-lexer-combinators.adb | 316 | ||||
| -rw-r--r-- | src/packrat-lexer-combinators.ads | 143 | ||||
| -rw-r--r-- | src/packrat-lexer.adb | 387 | ||||
| -rw-r--r-- | src/packrat-lexer.ads | 166 |
4 files changed, 479 insertions, 533 deletions
diff --git a/src/packrat-lexer-combinators.adb b/src/packrat-lexer-combinators.adb deleted file mode 100644 index 1090398..0000000 --- a/src/packrat-lexer-combinators.adb +++ /dev/null @@ -1,316 +0,0 @@ - - -package body Packrat.Lexer.Combinators is - - - function Sequence - (Input : in Element_Array; - Start : in Positive) - return Combinator_Result - is - Result : Combinator_Result := Create_Result (0, Success, Empty_Array); - Position : Positive := Start; - begin - if Start > Input'Last then - return Empty_Fail; - end if; - for C of Params loop - if Position > Input'Last then - Result.Status := Needs_More; - exit; - end if; - Result := Result.Join (C (Input, Position)); - exit when Result.Status = Failure; - Position := Start + Result.Length; - end loop; - return Result; - end Sequence; - - - function Count - (Input : in Element_Array; - Start : in Positive) - return Combinator_Result - is - Result : Combinator_Result := Create_Result (0, Success, Empty_Array); - Position : Positive := Start; - begin - if Start > Input'Last then - return Empty_Fail; - end if; - for I in Integer range 1 .. Number loop - if Position > Input'Last then - Result.Status := Needs_More; - exit; - end if; - Result := Result.Join (Param (Input, Position)); - exit when Result.Status = Failure; - Position := Start + Result.Length; - end loop; - return Result; - end Count; - - - function Many - (Input : in Element_Array; - Start : in Positive) - return Combinator_Result - is - Result : Combinator_Result := Create_Result (0, Success, Empty_Array); - Temp : Combinator_Result; - Position : Positive := Start; - Counter : Natural := 0; - begin - if Start > Input'Last then - return Empty_Fail; - end if; - loop - exit when Position > Input'Last; - Temp := Param (Input, Position); - exit when Temp.Status = Failure or Temp.Status = Needs_More; - Result := Result.Join (Temp); - Counter := Counter + 1; - Position := Start + Result.Length; - end loop; - if Counter < Minimum then - if Position > Input'Last or Temp.Status = Needs_More then - Result.Status := Needs_More; - else - Result.Status := Failure; - end if; - elsif Position > Input'Last or Temp.Status = Needs_More then - Result.Status := Optional_More; - else - Result.Status := Success; - end if; - return Result; - end Many; - - - function Many_Until - (Input : in Element_Array; - Start : in Positive) - return Combinator_Result - is - Result : Combinator_Result := Create_Result (0, Success, Empty_Array); - Temp : Combinator_Result; - Position : Positive := Start; - Counter : Natural := 0; - begin - if Start > Input'Last then - return Empty_Fail; - end if; - loop - exit when Position > Input'Last; - Temp := Param (Input, Position); - exit when Temp.Status = Failure or Temp.Status = Needs_More or Test (Input (Position)); - Result := Result.Join (Temp); - Counter := Counter + 1; - Position := Start + Result.Length; - end loop; - if Counter < Minimum then - if Position > Input'Last or Temp.Status = Needs_More then - Result.Status := Needs_More; - else - Result.Status := Failure; - end if; - elsif Position > Input'Last then - Result.Status := Needs_More; - elsif Temp.Status = Needs_More and Test (Input (Position)) then - Result.Status := Optional_More; - elsif Test (Input (Position)) then - Result.Status := Success; - else - Result.Status := Failure; - end if; - return Result; - end Many_Until; - - - - - - function Satisfy - (Input : in Element_Array; - Start : in Positive) - return Combinator_Result is - begin - if Start > Input'Last then - return Empty_Fail; - elsif Test (Input (Start)) then - return Create_Result (1, Success, (1 => Input (Start))); - else - return Empty_Fail; - end if; - end Satisfy; - - - function Satisfy_With - (Input : in Element_Array; - Start : in Positive) - return Combinator_Result is - begin - if Start > Input'Last then - return Empty_Fail; - elsif Test (Change (Input (Start))) then - return Create_Result (1, Success, (1 => Input (Start))); - else - return Empty_Fail; - end if; - end Satisfy_With; - - - function Match - (Input : in Element_Array; - Start : in Positive) - return Combinator_Result is - begin - if Start > Input'Last then - return Empty_Fail; - elsif Input (Start) = Item then - return Create_Result (1, Success, (1 => Item)); - else - return Empty_Fail; - end if; - end Match; - - - function Match_With - (Input : in Element_Array; - Start : in Positive) - return Combinator_Result is - begin - if Start > Input'Last then - return Empty_Fail; - elsif Change (Input (Start)) = Item then - return Create_Result (1, Success, (1 => Input (Start))); - else - return Empty_Fail; - end if; - end Match_With; - - - function Multimatch - (Input : in Element_Array; - Start : in Positive) - return Combinator_Result - is - Current_Offset : Natural := 0; - begin - if Items'Length = 0 then - return Create_Result (0, Success, Empty_Array); - end if; - - if Input'Last - Start + 1 <= 0 then - return Empty_Fail; - end if; - - while Input (Start + Current_Offset) = Items (Items'First + Current_Offset) loop - if Items'First + Current_Offset = Items'Last then - return Create_Result (Current_Offset + 1, Success, Items); - elsif Start + Current_Offset = Input'Last then - return Create_Result (Current_Offset + 1, Needs_More, Input (Start .. Input'Last)); - end if; - Current_Offset := Current_Offset + 1; - end loop; - return Create_Result (Current_Offset, Failure, Input (Start .. Start + Current_Offset - 1)); - end Multimatch; - - - function Take - (Input : in Element_Array; - Start : in Positive) - return Combinator_Result is - begin - if Start > Input'Last then - return Empty_Fail; - elsif Start + Number - 1 > Input'Last then - return Create_Result (Input'Last - Start + 1, Needs_More, Input (Start .. Input'Last)); - else - return Create_Result (Number, Success, Input (Start .. Start + Number - 1)); - end if; - end Take; - - - function Take_While - (Input : in Element_Array; - Start : in Positive) - return Combinator_Result - is - Finish : Positive := Start; - Status : Result_Status; - begin - if Start > Input'Last or else not Test (Input (Start)) then - return Empty_Fail; - end if; - while Finish <= Input'Last and then Test (Input (Finish)) loop - Finish := Finish + 1; - end loop; - if Finish > Input'Last then - Status := Optional_More; - else - Status := Success; - end if; - return Create_Result (Finish - Start, Status, Input (Start .. Finish - 1)); - end Take_While; - - - function Take_Until - (Input : in Element_Array; - Start : in Positive) - return Combinator_Result - is - Finish : Positive := Start; - Status : Result_Status; - begin - if Start > Input'Last or else Test (Input (Start)) then - return Empty_Fail; - end if; - while Finish <= Input'Last and then not Test (Input (Finish)) loop - Finish := Finish + 1; - end loop; - if Finish > Input'Last then - Status := Optional_More; - else - Status := Success; - end if; - return Create_Result (Finish - Start, Status, Input (Start .. Finish - 1)); - end Take_Until; - - - - - - function Line_End - (Input : in Element_Array; - Start : in Positive) - return Combinator_Result is - begin - if Start > Input'Last then - return Empty_Fail; - elsif Input (Start) = EOL_Item then - return Create_Result (1, Success, (1 => EOL_Item)); - else - return Empty_Fail; - end if; - end Line_End; - - - function Input_End - (Input : in Element_Array; - Start : in Positive) - return Combinator_Result is - begin - if Start > Input'Last then - return Empty_Fail; - elsif Input (Start) = EOF_Item then - return Create_Result (1, Success, (1 => EOF_Item)); - else - return Empty_Fail; - end if; - end Input_End; - - -end Packrat.Lexer.Combinators; - - diff --git a/src/packrat-lexer-combinators.ads b/src/packrat-lexer-combinators.ads deleted file mode 100644 index 98df3d5..0000000 --- a/src/packrat-lexer-combinators.ads +++ /dev/null @@ -1,143 +0,0 @@ - - -generic -package Packrat.Lexer.Combinators is - - - generic - Params : in Combinator_Array; - function Sequence - (Input : in Element_Array; - Start : in Positive) - return Combinator_Result; - - generic - with function Param - (Input : in Element_Array; - Start : in Positive) - return Combinator_Result; - Number : in Positive; - function Count - (Input : in Element_Array; - Start : in Positive) - return Combinator_Result; - - generic - with function Param - (Input : in Element_Array; - Start : in Positive) - return Combinator_Result; - Minimum : in Natural := 0; - function Many - (Input : in Element_Array; - Start : in Positive) - return Combinator_Result; - - generic - with function Param - (Input : in Element_Array; - Start : in Positive) - return Combinator_Result; - with function Test - (Item : in Element) - return Boolean; - Minimum : in Natural := 0; - function Many_Until - (Input : in Element_Array; - Start : in Positive) - return Combinator_Result; - - - - - generic - with function Test - (Item : in Element) - return Boolean; - function Satisfy - (Input : in Element_Array; - Start : in Positive) - return Combinator_Result; - - generic - with function Test - (Item : in Element) - return Boolean; - with function Change - (From : in Element) - return Element; - function Satisfy_With - (Input : in Element_Array; - Start : in Positive) - return Combinator_Result; - - generic - Item : in Element; - function Match - (Input : in Element_Array; - Start : in Positive) - return Combinator_Result; - - generic - Item : in Element; - with function Change - (From : in Element) - return Element; - function Match_With - (Input : in Element_Array; - Start : in Positive) - return Combinator_Result; - - generic - Items : in Element_Array; - function Multimatch - (Input : in Element_Array; - Start : in Positive) - return Combinator_Result; - - generic - Number : in Positive := 1; - function Take - (Input : in Element_Array; - Start : in Positive) - return Combinator_Result; - - generic - with function Test - (Item : in Element) - return Boolean; - function Take_While - (Input : in Element_Array; - Start : in Positive) - return Combinator_Result; - - generic - with function Test - (Item : in Element) - return Boolean; - function Take_Until - (Input : in Element_Array; - Start : in Positive) - return Combinator_Result; - - - - - generic - EOL_Item : in Element; - function Line_End - (Input : in Element_Array; - Start : in Positive) - return Combinator_Result; - - generic - EOF_Item : in Element; - function Input_End - (Input : in Element_Array; - Start : in Positive) - return Combinator_Result; - - -end Packrat.Lexer.Combinators; - - diff --git a/src/packrat-lexer.adb b/src/packrat-lexer.adb index 614452b..e1765d9 100644 --- a/src/packrat-lexer.adb +++ b/src/packrat-lexer.adb @@ -46,6 +46,33 @@ package body Packrat.Lexer is + function "=" + (Left, Right : in Combinator_Result) + return Boolean + is + Left_Valsize, Right_Valsize : Natural; + begin + if Left.Value = null then + Left_Valsize := 0; + else + Left_Valsize := Left.Value.all'Length; + end if; + if Right.Value = null then + Right_Valsize := 0; + else + Right_Valsize := Right.Value.all'Length; + end if; + + return Left.Length = Right.Length and + Left.Status = Right.Status and + Left_Valsize = Right_Valsize and + (Left_Valsize = 0 or else Left.Value.all = Right.Value.all); + end "="; + + + + + function Create_Result (Length : in Natural; Status : in Result_Status; @@ -104,55 +131,6 @@ package body Packrat.Lexer is end Join; - function "=" - (Left, Right : in Combinator_Result) - return Boolean - is - Left_Valsize, Right_Valsize : Natural; - begin - if Left.Value = null then - Left_Valsize := 0; - else - Left_Valsize := Left.Value.all'Length; - end if; - if Right.Value = null then - Right_Valsize := 0; - else - Right_Valsize := Right.Value.all'Length; - end if; - - return Left.Length = Right.Length and - Left.Status = Right.Status and - Left_Valsize = Right_Valsize and - (Left_Valsize = 0 or else Left.Value.all = Right.Value.all); - end "="; - - - function Status - (This : in Combinator_Result) - return Result_Status is - begin - return This.Status; - end Status; - - - function Debug_String - (This : in Combinator_Result) - return String - is - Value_Length : Natural; - begin - if This.Value = null then - Value_Length := 0; - else - Value_Length := This.Value.all'Length; - end if; - return Integer'Image (This.Length) - & " " & Result_Status'Image (This.Status) - & " " & Integer'Image (Value_Length); - end Debug_String; - - @@ -233,6 +211,317 @@ package body Packrat.Lexer is end Scan_Set_With; + + + + function Sequence + (Input : in Element_Array; + Start : in Positive) + return Combinator_Result + is + Result : Combinator_Result := Create_Result (0, Success, Empty_Array); + Position : Positive := Start; + begin + if Start > Input'Last then + return Empty_Fail; + end if; + for C of Params loop + if Position > Input'Last then + Result.Status := Needs_More; + exit; + end if; + Result := Join (Result, C (Input, Position)); + exit when Result.Status = Failure; + Position := Start + Result.Length; + end loop; + return Result; + end Sequence; + + + function Count + (Input : in Element_Array; + Start : in Positive) + return Combinator_Result + is + Result : Combinator_Result := Create_Result (0, Success, Empty_Array); + Position : Positive := Start; + begin + if Start > Input'Last then + return Empty_Fail; + end if; + for I in Integer range 1 .. Number loop + if Position > Input'Last then + Result.Status := Needs_More; + exit; + end if; + Result := Join (Result, Param (Input, Position)); + exit when Result.Status = Failure; + Position := Start + Result.Length; + end loop; + return Result; + end Count; + + + function Many + (Input : in Element_Array; + Start : in Positive) + return Combinator_Result + is + Result : Combinator_Result := Create_Result (0, Success, Empty_Array); + Temp : Combinator_Result; + Position : Positive := Start; + Counter : Natural := 0; + begin + if Start > Input'Last then + return Empty_Fail; + end if; + loop + exit when Position > Input'Last; + Temp := Param (Input, Position); + exit when Temp.Status = Failure or Temp.Status = Needs_More; + Result := Join (Result, Temp); + Counter := Counter + 1; + Position := Start + Result.Length; + end loop; + if Counter < Minimum then + if Position > Input'Last or Temp.Status = Needs_More then + Result.Status := Needs_More; + else + Result.Status := Failure; + end if; + elsif Position > Input'Last or Temp.Status = Needs_More then + Result.Status := Optional_More; + else + Result.Status := Success; + end if; + return Result; + end Many; + + + function Many_Until + (Input : in Element_Array; + Start : in Positive) + return Combinator_Result + is + Result : Combinator_Result := Create_Result (0, Success, Empty_Array); + Temp : Combinator_Result; + Position : Positive := Start; + Counter : Natural := 0; + begin + if Start > Input'Last then + return Empty_Fail; + end if; + loop + exit when Position > Input'Last; + Temp := Param (Input, Position); + exit when Temp.Status = Failure or Temp.Status = Needs_More or Test (Input (Position)); + Result := Join (Result, Temp); + Counter := Counter + 1; + Position := Start + Result.Length; + end loop; + if Counter < Minimum then + if Position > Input'Last or Temp.Status = Needs_More then + Result.Status := Needs_More; + else + Result.Status := Failure; + end if; + elsif Position > Input'Last then + Result.Status := Needs_More; + elsif Temp.Status = Needs_More and Test (Input (Position)) then + Result.Status := Optional_More; + elsif Test (Input (Position)) then + Result.Status := Success; + else + Result.Status := Failure; + end if; + return Result; + end Many_Until; + + + + + + function Satisfy + (Input : in Element_Array; + Start : in Positive) + return Combinator_Result is + begin + if Start > Input'Last then + return Empty_Fail; + elsif Test (Input (Start)) then + return Create_Result (1, Success, (1 => Input (Start))); + else + return Empty_Fail; + end if; + end Satisfy; + + + function Satisfy_With + (Input : in Element_Array; + Start : in Positive) + return Combinator_Result is + begin + if Start > Input'Last then + return Empty_Fail; + elsif Test (Change (Input (Start))) then + return Create_Result (1, Success, (1 => Input (Start))); + else + return Empty_Fail; + end if; + end Satisfy_With; + + + function Match + (Input : in Element_Array; + Start : in Positive) + return Combinator_Result is + begin + if Start > Input'Last then + return Empty_Fail; + elsif Input (Start) = Item then + return Create_Result (1, Success, (1 => Item)); + else + return Empty_Fail; + end if; + end Match; + + + function Match_With + (Input : in Element_Array; + Start : in Positive) + return Combinator_Result is + begin + if Start > Input'Last then + return Empty_Fail; + elsif Change (Input (Start)) = Item then + return Create_Result (1, Success, (1 => Input (Start))); + else + return Empty_Fail; + end if; + end Match_With; + + + function Multimatch + (Input : in Element_Array; + Start : in Positive) + return Combinator_Result + is + Current_Offset : Natural := 0; + begin + if Items'Length = 0 then + return Create_Result (0, Success, Empty_Array); + end if; + + if Input'Last - Start + 1 <= 0 then + return Empty_Fail; + end if; + + while Input (Start + Current_Offset) = Items (Items'First + Current_Offset) loop + if Items'First + Current_Offset = Items'Last then + return Create_Result (Current_Offset + 1, Success, Items); + elsif Start + Current_Offset = Input'Last then + return Create_Result (Current_Offset + 1, Needs_More, Input (Start .. Input'Last)); + end if; + Current_Offset := Current_Offset + 1; + end loop; + return Create_Result (Current_Offset, Failure, Input (Start .. Start + Current_Offset - 1)); + end Multimatch; + + + function Take + (Input : in Element_Array; + Start : in Positive) + return Combinator_Result is + begin + if Start > Input'Last then + return Empty_Fail; + elsif Start + Number - 1 > Input'Last then + return Create_Result (Input'Last - Start + 1, Needs_More, Input (Start .. Input'Last)); + else + return Create_Result (Number, Success, Input (Start .. Start + Number - 1)); + end if; + end Take; + + + function Take_While + (Input : in Element_Array; + Start : in Positive) + return Combinator_Result + is + Finish : Positive := Start; + Status : Result_Status; + begin + if Start > Input'Last or else not Test (Input (Start)) then + return Empty_Fail; + end if; + while Finish <= Input'Last and then Test (Input (Finish)) loop + Finish := Finish + 1; + end loop; + if Finish > Input'Last then + Status := Optional_More; + else + Status := Success; + end if; + return Create_Result (Finish - Start, Status, Input (Start .. Finish - 1)); + end Take_While; + + + function Take_Until + (Input : in Element_Array; + Start : in Positive) + return Combinator_Result + is + Finish : Positive := Start; + Status : Result_Status; + begin + if Start > Input'Last or else Test (Input (Start)) then + return Empty_Fail; + end if; + while Finish <= Input'Last and then not Test (Input (Finish)) loop + Finish := Finish + 1; + end loop; + if Finish > Input'Last then + Status := Optional_More; + else + Status := Success; + end if; + return Create_Result (Finish - Start, Status, Input (Start .. Finish - 1)); + end Take_Until; + + + + + + function Line_End + (Input : in Element_Array; + Start : in Positive) + return Combinator_Result is + begin + if Start > Input'Last then + return Empty_Fail; + elsif Input (Start) = EOL_Item then + return Create_Result (1, Success, (1 => EOL_Item)); + else + return Empty_Fail; + end if; + end Line_End; + + + function Input_End + (Input : in Element_Array; + Start : in Positive) + return Combinator_Result is + begin + if Start > Input'Last then + return Empty_Fail; + elsif Input (Start) = EOF_Item then + return Create_Result (1, Success, (1 => EOF_Item)); + else + return Empty_Fail; + end if; + end Input_End; + + end Packrat.Lexer; diff --git a/src/packrat-lexer.ads b/src/packrat-lexer.ads index d331645..382b7ff 100644 --- a/src/packrat-lexer.ads +++ b/src/packrat-lexer.ads @@ -20,31 +20,10 @@ package Packrat.Lexer is type Combinator_Array is array (Positive range <>) of Combinator; - Empty_Fail : constant Combinator_Result; - - - function Create_Result - (Length : in Natural; - Status : in Result_Status; - Value : in Element_Array) - return Combinator_Result; - - function Join - (Left, Right : in Combinator_Result) - return Combinator_Result; - function "=" (Left, Right : in Combinator_Result) return Boolean; - function Status - (This : in Combinator_Result) - return Result_Status; - - function Debug_String - (This : in Combinator_Result) - return String; - @@ -60,6 +39,9 @@ package Packrat.Lexer is type Component_Array is array (Positive range <>) of Lexer_Component; + + + generic Label : in Label_Enum; Combo : in Combinator; @@ -124,22 +106,158 @@ package Packrat.Lexer is Output : out Gen_Tokens.Token_Array); + + + generic + Params : in Combinator_Array; + function Sequence + (Input : in Element_Array; + Start : in Positive) + return Combinator_Result; + + generic + with function Param + (Input : in Element_Array; + Start : in Positive) + return Combinator_Result; + Number : in Positive; + function Count + (Input : in Element_Array; + Start : in Positive) + return Combinator_Result; + + generic + with function Param + (Input : in Element_Array; + Start : in Positive) + return Combinator_Result; + Minimum : in Natural := 0; + function Many + (Input : in Element_Array; + Start : in Positive) + return Combinator_Result; + + generic + with function Param + (Input : in Element_Array; + Start : in Positive) + return Combinator_Result; + with function Test + (Item : in Element) + return Boolean; + Minimum : in Natural := 0; + function Many_Until + (Input : in Element_Array; + Start : in Positive) + return Combinator_Result; + + + + + generic + with function Test + (Item : in Element) + return Boolean; + function Satisfy + (Input : in Element_Array; + Start : in Positive) + return Combinator_Result; + + generic + with function Test + (Item : in Element) + return Boolean; + with function Change + (From : in Element) + return Element; + function Satisfy_With + (Input : in Element_Array; + Start : in Positive) + return Combinator_Result; + + generic + Item : in Element; + function Match + (Input : in Element_Array; + Start : in Positive) + return Combinator_Result; + + generic + Item : in Element; + with function Change + (From : in Element) + return Element; + function Match_With + (Input : in Element_Array; + Start : in Positive) + return Combinator_Result; + + generic + Items : in Element_Array; + function Multimatch + (Input : in Element_Array; + Start : in Positive) + return Combinator_Result; + + generic + Number : in Positive := 1; + function Take + (Input : in Element_Array; + Start : in Positive) + return Combinator_Result; + + generic + with function Test + (Item : in Element) + return Boolean; + function Take_While + (Input : in Element_Array; + Start : in Positive) + return Combinator_Result; + + generic + with function Test + (Item : in Element) + return Boolean; + function Take_Until + (Input : in Element_Array; + Start : in Positive) + return Combinator_Result; + + + + + generic + EOL_Item : in Element; + function Line_End + (Input : in Element_Array; + Start : in Positive) + return Combinator_Result; + + generic + EOF_Item : in Element; + function Input_End + (Input : in Element_Array; + Start : in Positive) + return Combinator_Result; + + private type Element_Array_Access is access Element_Array; - Empty_Array : Element_Array (1 .. 0); + + type Combinator_Result is new Ada.Finalization.Controlled with record Length : Natural; Status : Result_Status; Value : Element_Array_Access; end record; - overriding procedure Initialize (This : in out Combinator_Result); @@ -149,7 +267,6 @@ private overriding procedure Finalize (This : in out Combinator_Result); - Empty_Fail : constant Combinator_Result := (Ada.Finalization.Controlled with Length => 0, @@ -161,7 +278,6 @@ private type Lexer_Context is new Ada.Finalization.Controlled with null record; - Empty_Context : constant Lexer_Context := (Ada.Finalization.Controlled with null record); |