lexer.adb (8036B)
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Characters.Handling; use Ada.Characters.Handling;
package body Lexer is
function Init (File_Name : File_Name_Ref; File_Contents : Source_Ref) return Lexer is
L : constant Lexer :=
(Source => File_Contents,
File_Name => File_Name,
Tokens => Token_Vector.Empty_Vector,
Pos => 1,
Line => 1,
Col => 1);
begin
return L;
end Init;
---------------
-- add token --
---------------
procedure Add_Token (L : in out Lexer; T : Token) is
begin
L.Tokens.Append (T);
end Add_Token;
function Peek (L : in Lexer) return Character is
begin
if L.Pos > L.Source'Length then
return ASCII.NUL;
end if;
return L.Source (L.Pos);
end;
function Peek2 (L : in Lexer) return Character is
C : Character;
begin
C := Peek (L);
if L.Pos < L.Source'Length then
C := L.Source (L.Pos + 1);
end if;
return C;
end;
-----------
-- nudge --
-----------
procedure Nudge (L : in out Lexer) is
C : Character;
begin
C := Peek (L);
if Is_Line_Terminator (C) then
L.Line := L.Line + 1;
L.Col := 1;
else
L.Col := L.Col + 1;
end if;
L.Pos := L.Pos + 1;
end;
----------------------------
-- handle space comments --
----------------------------
procedure Handle_Space_Comments (L : in out Lexer) is
C : Character;
T : Token;
begin
loop
loop
C := Peek (L);
if Is_Line_Terminator (C) then
-- we care about line return in this impl
T := (Kind => Separator, Lexeme => To_Unbounded_String (""), Line => L.Line, Col => L.Col);
Add_Token (L, T);
end if;
if Is_Space (C) or Is_Line_Terminator (C) or C = Character'Val (9) -- \t
then
Nudge (L);
else
exit;
end if;
end loop;
if Peek (L) = '/' and Peek2 (L) = '/' then
loop
exit when Is_Line_Terminator (Peek (L));
Nudge (L);
end loop;
goto Continue;
end if;
exit;
<<Continue>>
null;
end loop;
end Handle_Space_Comments;
----------------
-- make ident --
----------------
function Make_Ident (L : in out Lexer) return Token is
T : Token;
TK : Token_Kind;
Start : Natural;
Word : Unbounded_String;
Line : Positive;
Col : Positive;
begin
Start := L.Pos;
Line := L.Line;
Col := L.Col;
loop
if Is_Alphanumeric (Peek (L)) or Peek (L) = '_' then
Nudge (L);
else
exit;
end if;
end loop;
TK := Ident;
Word := To_Unbounded_String (L.Source (Start .. L.Pos - 1));
declare
W : constant String := To_String (Word);
begin
if W = "use"
or W = "ns"
or W = "from"
or W = "ffi"
or W = "as"
or W = "and"
or W = "or"
or W = "struct"
or W = "enum"
or W = "if"
or W = "else"
or W = "end"
or W = "pub"
or W = "pub"
or W = "fx"
or W = "fn"
or W = "do"
or W = "return"
or W = "continue"
or W = "break"
or W = "is"
or W = "for"
or W = "while"
then
TK := Keyword;
end if;
end;
T := (Kind => TK, Lexeme => Word, Line => Line, Col => Col);
return T;
end Make_Ident;
-----------------
-- make number --
-----------------
function Make_Number (L : in out Lexer) return Token is
T : Token;
Kind : Token_Kind;
Start : Natural;
Line : Positive;
Col : Positive;
begin
Start := L.Pos;
Line := L.Line;
Col := L.Col;
Kind := Int_Literal;
if Peek (L) = '-' then
Nudge (L);
end if;
while Is_Digit (Peek (L)) loop
Nudge (L);
end loop;
if Peek (L) = '.' and Is_Digit (Peek2 (L)) then
Kind := Float_Literal;
Nudge (L);
while Is_Digit (Peek (L)) loop
Nudge (L);
end loop;
end if;
T :=
(Kind => Kind,
Lexeme => To_Unbounded_String (L.Source (Start .. L.Pos - 1)),
Line => Line,
Col => Col);
return T;
end Make_Number;
-----------------
-- make string --
-----------------
function Make_String (L : in out Lexer) return Token is
C : Character;
T : Token;
Start : Natural;
Line : Positive;
Col : Positive;
begin
Start := L.Pos;
Line := L.Line;
Col := L.Col;
Nudge (L); -- advance `"`
loop
C := Peek (L);
if C = '"' then
exit;
end if;
Nudge (L);
end loop;
T :=
(Kind => Str_Literal,
Lexeme => To_Unbounded_String (L.Source (Start .. L.Pos)),
Line => Line,
Col => Col);
Nudge (L); -- advance `"`
return T;
end Make_String;
----------------
-- next token --
----------------
function Next_Token (L : in out Lexer) return Token is
T : Token;
TK : Token_Kind;
C : Character;
C2 : Character;
Line : Positive;
Col : Positive;
begin
Handle_Space_Comments (L);
Line := L.Line;
Col := L.Col;
if L.Pos < L.Source'Length then
TK := Unknown;
else
TK := EOF;
end if;
C := Peek (L);
C2 := Peek2 (L);
if Is_Letter (C) or C = '_' then
T := Make_Ident (L);
return T;
end if;
if C = '-' and Is_Digit (C2) then
T := Make_Number (L);
return T;
end if;
if Is_Digit (C) then
T := Make_Number (L);
return T;
end if;
if C = '"' then
T := Make_String (L);
return T;
end if;
if C = '(' then
TK := L_Paren;
elsif C = ')' then
TK := R_Paren;
elsif C = '[' then
TK := L_Bracket;
elsif C = ']' then
TK := R_Bracket;
elsif C = '{' then
TK := L_Brace;
elsif C = '}' then
TK := R_Brace;
elsif C = ',' then
TK := Comma;
elsif C = ':' then
if C2 = ':' then
TK := ColonColon;
Nudge (L);
else
TK := Colon;
end if;
-- else
-- Put_Line
-- (Integer'Image (Line)
-- & " :"
-- & Integer'Image (Col)
-- & ": "
-- & "Unhandled: "
-- & Integer'Image (Character'Pos (C)));
end if;
T := (Kind => TK, Lexeme => To_Unbounded_String (""), Line => Line, Col => Col);
Nudge (L);
return T;
end Next_Token;
procedure Lex (L : in out Lexer) is
Tok : Token;
begin
loop
Tok := Next_Token (L);
Add_Token (L, Tok);
exit when Tok.Kind = EOF;
end loop;
end Lex;
------------------
-- print tokens --
------------------
procedure Print_Tokens (L : in out Lexer) is
I : Natural := 0;
Total : constant Natural := Natural (L.Tokens.Length);
begin
Put_Line ("total: " & (L.Tokens.Length'Image) & " tokens");
while I < Total loop
Put_Line
(Integer'Image (L.Tokens (I).Line)
& " :"
& Integer'Image (L.Tokens (I).Col)
& ": "
& Token_Kind'Image (L.Tokens (I).Kind)
& ": "
& To_String (L.Tokens (I).Lexeme)
& " at line");
I := I + 1;
end loop;
end;
end Lexer;