ada-libraries
/
AdaYaml
mirror of https://github.com/yaml/AdaYaml
1
0
Fork 0
Code Issues Releases Wiki Activity

Lexing Sources

This commit is contained in:
Felix Krause 2017-05-27 01:35:25 +02:00
parent b196443808
commit 6a588f18ef
16 changed files with 256 additions and 76 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
.gitignore vendored Normal file
View File

@ -0,0 +1,8 @@
lib
obj
bin
gnatinspect.db
*~
*.ali
*.cswi
*-loc.xml

114
src/implementation/yada-lexing.adb
View File

@ -2,22 +2,64 @@ with Ada.Strings.Maps;
with Ada.Unchecked_Deallocation;
package body Yada.Lexing is
End_Of_Input : constant := Character'Val (4);
Line_Feed : constant := Character'Val (10);
Carriage_Return : constant := Character'Val (13);
End_Of_Input : constant Character := Character'Val (4);
Line_Feed : constant Character := Character'Val (10);
Carriage_Return : constant Character := Character'Val (13);
Line_Ends : constant Ada.Strings.Maps.Character_Set :=
Ada.Strings.Maps.To_Set (Line_Feed & Carriage_Return);
procedure Free is new Ada.Unchecked_Deallocation (String, not null access String);
procedure Free is new Ada.Unchecked_Deallocation (String, Buffer_Type);
function Next (Object: in out Lexer) return Character is
function Next (Object : in out Lexer) return Character with Inline is
begin
return Object.Buffer (Object.Pos) do
return C : constant Character := Object.Buffer (Object.Pos) do
Object.Pos := Object.Pos + 1;
end return;
end Next;
procedure Refill_Buffer (L : in out Lexer) is
Bytes_To_Copy : constant Natural := L.Buffer'Last - L.Sentinel;
Fill_At : Positive := Bytes_To_Copy + 1;
Bytes_Read : Positive;
function Search_Sentinel return Boolean with Inline is
Peek : Positive := L.Buffer'Last;
begin
while not Ada.Strings.Maps.Is_In (L.Buffer.all (Peek), Line_Ends) loop
if Peek = Fill_At then
return False;
else
Peek := Peek - 1;
end if;
end loop;
return True;
end Search_Sentinel;
begin
if Bytes_To_Copy > 0 then
L.Buffer (1 .. Bytes_To_Copy) := L.Buffer (L.Sentinel + 1 .. L.Buffer'Last);
end if;
loop
L.Input.Read_Data (L.Buffer (Fill_At .. L.Buffer'Last), Bytes_Read);
if Bytes_Read < L.Buffer'Last - Fill_At then
L.Sentinel := Fill_At + Bytes_Read + 1;
L.Buffer (L.Sentinel) := End_Of_Input;
exit;
else
exit when Search_Sentinel;
Fill_At := L.Buffer'Last + 1;
declare
New_Buffer : constant Buffer_Type :=
new String (1 .. 2 * L.Buffer'Last);
begin
New_Buffer.all (L.Buffer'Range) := L.Buffer.all;
Free (L.Buffer);
L.Buffer := New_Buffer;
end;
end if;
end loop;
end Refill_Buffer;
procedure Handle_CR (L : in out Lexer) is
begin
L.Pos := L.Pos + 1;
@ -26,7 +68,7 @@ package body Yada.Lexing is
end if;
if L.Pos = L.Sentinel then
Refill_Buffer (L);
L.Pos := 0;
L.Pos := 1;
end if;
end Handle_CR;
@ -35,59 +77,19 @@ package body Yada.Lexing is
L.Pos := L.Pos + 1;
if L.Pos = L.Sentinel then
Refill_Buffer (L);
L.Pos = 0;
L.Pos := 1;
end if;
end Handle_LF;
procedure Refill_Buffer (L : in out Lexer) is
Bytes_To_Copy : constant Integer := L.Buffer'Last - L.Sentinel;
Num_Chars : Integer;
begin
L.Buffer (1..Bytes_To_Copy) :=
L.Buffer (L.Buffer'Last - Bytes_To_Copy + 1 .. L.Buffer'Last);
-- TODO: read in new chunk of input, fill Num_Chars
declare
Minimum : Natural := 0;
Peek : Natural := Bytes_To_Copy + Num_Chars;
begin
while not Ada.Strings.Maps.Is_In (L.Buffer (Peek), Line_Ends) loop
if Peek = Minimum then
Minimum := L.Buffer'Last + 1;
declare
New_Buffer : not null access String :=
new String (1..2 * L.Buffer'Last);
begin
New_Buffer.all (L.Buffer'Range) := L.Buffer.all;
Free (L.Buffer);
L.Buffer := New_Buffer;
end;
Peek := L.Buffer'Last;
else
Peek := Peek - 1;
end if;
end loop;
end;
end Refill_Buffer;
function From_String (S : String) return Lexer is
begin
return L : Lexer := Lexer'(Pos => 0, Sentinel => S'Last + 1,
Buffer => new String (S'First..S'Last + 1)) do
L.Buffer.all := S & End_Of_Input;
end return;
end From_String;
function From_File (File_Name : String) return Lexer is
use Ada.Text_IO;
function From_Source
(Input : Sources.Source_Access;
Initial_Buffer_Size : Positive := Default_Initial_Buffer_Size)
return Lexer is
begin
return L : Lexer :=
Lexer'(Pos => 0, Sentinel => 8096, Buffer => new String (1..8096),
Input_At => 0,
Input_Length => Ada.Directories.Size (File_Name)) do
Open (L.Input, In_File, File_Name);
Lexer'(Input => Input, Sentinel => Initial_Buffer_Size, Pos => 1,
Buffer => new String (1 .. Initial_Buffer_Size)) do
Refill_Buffer (L);
end return;
end From_File;
end Yada.Lexing;
end From_Source;
end Yada.Lexing;

28
src/implementation/yada-lexing.ads
View File

@ -1,20 +1,22 @@
private with Ada.Text_IO;
private with Ada.Directories;
with Yada.Sources;
private package Yada.Lexing is
pragma Preelaborate;
Default_Initial_Buffer_Size : constant := 8096;
type Lexer is private;
type Lexer is limited private;
function From_File (File_Name : String) return Lexer;
function From_String (S: String) return Lexer;
function From_Source
(Input : Sources.Source_Access;
Initial_Buffer_Size : Positive := Default_Initial_Buffer_Size)
return Lexer;
private
type Lexer is record
Input : Ada.Text_IO.File_Type;
Input_Length, Input_At : Ada.Directories.File_Size;
Sentinel : Integer;
Pos : Integer;
Buffer : not null access String;
type Buffer_Type is access String;
type Lexer is limited record
Input : Sources.Source_Access;
Sentinel : Positive;
Pos : Positive;
Buffer : Buffer_Type;
end record;
end Yada.Lexing;
end Yada.Lexing;

31
src/implementation/yada-sources-files.adb Executable file
View File

@ -0,0 +1,31 @@
package body Yada.Sources.Files is
overriding procedure Read_Data (S : in out File_Source; Buffer : out String;
Length : out Natural) is
use type Ada.Directories.File_Size;
begin
Length := Natural'Min (Buffer'Length, Natural (S.Input_Length - S.Input_At));
declare
subtype Read_Blob is String (1 .. Length);
begin
Read_Blob'Read (S.Stream, Buffer (Buffer'First .. Length - 1));
end;
end Read_Data;
overriding procedure Finalize (Object : in out File_Source) is
begin
Ada.Streams.Stream_IO.Close (Object.File);
end Finalize;
function As_Source (File_Path : String) return Source_Access is
Ret : constant access File_Source :=
new File_Source'(Source with Input_At => 0,
Input_Length => Ada.Directories.Size (File_Path),
others => <>);
begin
Ada.Streams.Stream_IO.Open (Ret.File, Ada.Streams.Stream_IO.In_File,
File_Path);
Ret.Stream := Ada.Streams.Stream_IO.Stream (Ret.File);
return Source_Access (Ret);
end As_Source;
end Yada.Sources.Files;

20
src/interface/yada-sources-files.ads Executable file
View File

@ -0,0 +1,20 @@
private with Ada.Streams.Stream_IO;
private with Ada.Directories;
package Yada.Sources.Files is
type File_Source is new Source with private;
overriding procedure Read_Data (S : in out File_Source; Buffer : out String;
Length : out Natural);
overriding procedure Finalize (Object : in out File_Source);
function As_Source (File_Path : String) return Source_Access;
private
type File_Source is new Source with record
File : Ada.Streams.Stream_IO.File_Type;
Stream : Ada.Streams.Stream_IO.Stream_Access;
Input_At, Input_Length : Ada.Directories.File_Size;
end record;
end Yada.Sources.Files;

12
src/interface/yada-sources.ads Executable file
View File

@ -0,0 +1,12 @@
with Ada.Finalization;
package Yada.Sources is
pragma Preelaborate;
type Source is abstract new Ada.Finalization.Limited_Controlled with
null record;
type Source_Access is not null access all Source'Class;
procedure Read_Data (S : in out Source; Buffer : out String;
Length : out Natural) is abstract;
end Yada.Sources;

2
src/interface/yada.ads
View File

@ -1,4 +1,4 @@
package Yada is
pragma Pure;
end Yada;
end Yada;

2
test/data/64char.yaml Executable file
View File

@ -0,0 +1,2 @@
Lorem ipsum dolor sit amet, consectetur adipiscing elit.
Duis in

2
test/data/98char.yaml Executable file
View File

@ -0,0 +1,2 @@
Lorem ipsum dolor sit amet, consectetur adipiscing elit.
Duis in sapien ut massa ultrices blandit.

42
test/src/yada-lexing-buffering_test.adb Executable file
View File

@ -0,0 +1,42 @@
with AUnit.Assertions; use AUnit.Assertions;
with Ada.Text_IO;
with Yada.Sources.Files;
package body Yada.Lexing.Buffering_Test is
procedure Register_Tests (T : in out TC) is
use AUnit.Test_Cases.Registration;
begin
Register_Routine
(T, Test_File_Without_Refill'Access, "Read file without refill");
Register_Routine
(T, Test_File_With_Single_Refill'Access, "Read file with single refill");
end Register_Tests;
function Name (T : TC) return Message_String is
pragma Unreferenced (T);
begin
return AUnit.Format ("Buffering tests for Lexer");
end Name;
procedure Test_File_Without_Refill (T : in out Test_Cases.Test_Case'Class) is
pragma Unreferenced (T);
S : constant Sources.Source_Access := Sources.Files.As_Source ("test/data/64char.yaml");
L : Lexer := From_Source (S, 64);
C : Character;
begin
Ada.Text_IO.Put_Line ("Buffer = """ & L.Buffer.all & """");
Assert (L.Buffer.all'Length = 64, "Buffer length does not match! Val:" & L.Buffer.all'Length'Img);
Assert (L.Buffer (1 .. 5) = "Lorem", "Buffer contains wrong data!");
end Test_File_Without_Refill;
procedure Test_File_With_Single_Refill (T : in out Test_Cases.Test_Case'Class) is
pragma Unreferenced (T);
S : constant Sources.Source_Access := Sources.Files.As_Source ("test/data/98char.yaml");
L : Lexer := From_Source (S, 64);
C : Character;
begin
Assert (L.Buffer.all'Length = 64, "Buffer length does not match! Val: " & L.Buffer.all'Length'Img);
Assert (L.Buffer (1 .. 5) = "Lorem", "Buffer contains wrong data!");
end Test_File_With_Single_Refill;
end Yada.Lexing.Buffering_Test;

13
test/src/yada-lexing-buffering_test.ads Executable file
View File

@ -0,0 +1,13 @@
with AUnit; use AUnit;
with AUnit.Test_Cases; use AUnit.Test_Cases;
package Yada.Lexing.Buffering_Test is
type TC is new Test_Cases.Test_Case with null record;
overriding procedure Register_Tests (T : in out TC);
function Name (T : TC) return Message_String;
procedure Test_File_Without_Refill (T : in out Test_Cases.Test_Case'Class);
procedure Test_File_With_Single_Refill (T : in out Test_Cases.Test_Case'Class);
end Yada.Lexing.Buffering_Test;

10
test/src/yada-lexing-harness.adb Executable file
View File

@ -0,0 +1,10 @@
with Yada.Lexing.Suite;
with AUnit.Run;
with AUnit.Reporter.Text;
procedure Yada.Lexing.Harness is
procedure Run is new AUnit.Run.Test_Runner (Suite.Suite);
Reporter : AUnit.Reporter.Text.Text_Reporter;
begin
Run (Reporter);
end Yada.Lexing.Harness;

12
test/src/yada-lexing-suite.adb Executable file
View File

@ -0,0 +1,12 @@
with Yada.Lexing.Buffering_Test;
package body Yada.Lexing.Suite is
Result : aliased AUnit.Test_Suites.Test_Suite;
Buffering_TC : aliased Buffering_Test.TC;
function Suite return AUnit.Test_Suites.Access_Test_Suite is
begin
AUnit.Test_Suites.Add_Test (Result'Access, Buffering_TC'Access);
return Result'Access;
end Suite;
end Yada.Lexing.Suite;

4
test/src/yada-lexing-suite.ads Executable file
View File

@ -0,0 +1,4 @@
with AUnit.Test_Suites;
package Yada.Lexing.Suite is
function Suite return AUnit.Test_Suites.Access_Test_Suite;
end Yada.Lexing.Suite;

14
yada.gpr
View File

@ -3,13 +3,15 @@ library project Yada is
for Library_Name use "Yada";
Yada_Source := ("src/interface",
"src/implementation");
Yada_Sources := ("src/interface",
"src/implementation");
for Source_Dirs use Yada_Sources;
for Object_Dir use "obj";
for Library_Dir use "lib";
for Library_Kind use OpenGL_Shared'Library_Kind;
type Mode_Type is ("debug", "release");
Mode : Mode_Type := external ("Mode", "debug");
package Ide is
for Vcs_Kind use "Git";
@ -17,7 +19,7 @@ library project Yada is
package Builder is
case Mode is
when "debug" =>
when "debug" =>
for Default_Switches ("ada") use ("-s", "-gnatE", "-g");
when "release" =>
for Default_Switches ("ada") use ("-s");
@ -28,10 +30,10 @@ library project Yada is
case Mode is
when "debug" =>
for Default_Switches ("ada") use
("-gnat12", "-gnatwa", "-g", "-fstack-check");
("-gnat12", "-gnatwa", "-gnatwl", "-gnaty3abcefhiklmNprt", "-g", "-fstack-check");
when "release" =>
for Default_Switches ("ada") use
("-gnat12", "-gnatwa", "-O2", "-gnatn2", "-fstack-check");
("-gnat12", "-gnatwa", "-gnatwl", "-O3", "-gnaty3abcefhiklmNprt", "-fstack-check");
end case;
end Compiler;
end Yada;

18
yada_unittests.gpr Executable file
View File

@ -0,0 +1,18 @@
with "yada";
with "aunit";
project Yada_Unittests is
for Languages use ("ada");
for Object_Dir use "test/obj";
for Library_Dir use "test/lib";
for Exec_Dir use "test/bin";
for Main use ("yada-lexing-harness.adb");
package Builder renames Yada.Builder;
package Compiler renames Yada.Compiler;
package Ide renames Yada.Ide;
for Source_Dirs use ("test/src");
end Yada_Unittests;