hyung-hwan/hcl
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

more parser code

Browse Source
This commit is contained in:
hyung-hwan 2021-12-01 17:06:30 +00:00
parent 689346a843
commit 390d642ed5
2 changed files with 88 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

107
lib2/h3-compilers.adb
View File

@ -7,7 +7,18 @@ package body H3.Compilers is
LB_EOF: constant S.Rune_Array := (R.V.Left_Arrow,R.V.UC_E,R.V.UC_O,R.V.UC_F,R.V.Right_Arrow); -- <EOF> LB_EOF: constant S.Rune_Array := (R.V.Left_Arrow,R.V.UC_E,R.V.UC_O,R.V.UC_F,R.V.Right_Arrow); -- <EOF>
LB_EOL: constant S.Rune_Array := (R.V.Left_Arrow,R.V.UC_E,R.V.UC_O,R.V.UC_L,R.V.Right_Arrow); -- <EOL> LB_EOL: constant S.Rune_Array := (R.V.Left_Arrow,R.V.UC_E,R.V.UC_O,R.V.UC_L,R.V.Right_Arrow); -- <EOL>
LB_XINCLUDE: constant S.Rune_Array := (R.V.Number_Sign,R.V.LC_I,R.V.LC_N,R.V.LC_C,R.V.LC_L,R.V.LC_U,R.V.LC_D,R.V.LC_E); -- #include LB_XINCLUDE: constant S.Rune_Array := (R.V.Number_Sign,R.V.LC_I,R.V.LC_N,R.V.LC_C,R.V.LC_L,R.V.LC_U,R.V.LC_D,R.V.LC_E); -- #include
LB_CLASS: constant S.Rune_Array := (R.V.LC_C,R.V.LC_L,R.V.LC_A,R.V.LC_S,R.V.LC_S); -- class
LB_FUN: constant S.Rune_Array := (R.V.LC_F,R.V.LC_U,R.V.LC_N); -- fun
LB_END: constant S.Rune_Array := (R.V.LC_E,R.V.LC_N,R.V.LC_D); -- end
LB_IF: constant S.Rune_Array := (R.V.LC_I,R.V.LC_F); -- if
LB_ELIF: constant S.Rune_Array := (R.V.LC_E,R.V.LC_L,R.V.LC_I,R.V.LC_F); -- elif
LB_ELSE: constant S.Rune_Array := (R.V.LC_E,R.V.LC_L,R.V.LC_S,R.V.LC_E); -- else
LB_WHILE: constant S.Rune_Array := (R.V.LC_W,R.V.LC_H,R.V.LC_I,R.V.LC_L,R.V.LC_E); -- while
LB_BREAK: constant S.Rune_Array := (R.V.LC_B,R.V.LC_R,R.V.LC_E,R.V.LC_A,R.V.LC_K); -- break
LB_CONTINUE: constant S.Rune_Array := (R.V.LC_C,R.V.LC_O,R.V.LC_N,R.V.LC_T,R.V.LC_I,R.V.LC_N,R.V.LC_U,R.V.LC_E); -- continue
LB_TRY: constant S.Rune_Array := (R.V.LC_T,R.V.LC_R,R.V.LC_Y); -- try
LB_CATCH: constant S.Rune_Array := (R.V.LC_C,R.V.LC_A,R.V.LC_T,R.V.LC_T,R.V.LC_H); -- catch
LB_RAISE: constant S.Rune_Array := (R.V.LC_R,R.V.LC_A,R.V.LC_I,R.V.LC_S,R.V.LC_E); -- raise
procedure Dump_Token (Tk: in Token) is procedure Dump_Token (Tk: in Token) is
begin begin
@ -173,6 +184,30 @@ package body H3.Compilers is
Pop_Parse_State (C); Pop_Parse_State (C);
end Pop_Inclusion; end Pop_Inclusion;
-- -------------------------------------------------------------------
procedure Parse_Ident (C: in out Compiler) is
begin
if C.Tk.Buf.Equals(LB_CLASS) then
null;
Push_Parse_State (C, PS_CLASS_1);
elsif C.Tk.Buf.Equals(LB_FUN) then
null;
else
-- probably a command name or a variable name?
null;
end if;
end Parse_Ident;
procedure Parse_Class_1 (C: in out Compiler) is
begin
null;
end Parse_Class_1;
procedure Parse_Class_2 (C: in out Compiler) is
begin
null;
end Parse_Class_2;
-- ------------------------------------------------------------------- -- -------------------------------------------------------------------
procedure Parse_Start (C: in out Compiler) is procedure Parse_Start (C: in out Compiler) is
@ -207,20 +242,23 @@ package body H3.Compilers is
null; null;
when TK_IDENT => when TK_IDENT =>
null; Parse_Ident (C);
--when TK_NUMBER => --when TK_NUMBER =>
-- null; -- null;
--when TK_CLASS =>
--when TK_FUNC =>
-- plus or minus signed may be allowed here too. -- plus or minus signed may be allowed here too.
-- plusplus or miniusminus may be allowed here too. -- plusplus or miniusminus may be allowed here too.
when TK_SEMICOLON => when TK_SEMICOLON =>
null; null;
when TK_HASHED_LBRACE =>
null;
when TK_HASHED_LBRACK =>
null;
when TK_HASHED_LPAREN =>
null;
when others => when others =>
raise Syntax_Error with "unexpected token"; raise Syntax_Error with "unexpected token";
@ -266,12 +304,14 @@ package body H3.Compilers is
function Is_Ident_Starter(Code: in R.Code) return Boolean is function Is_Ident_Starter(Code: in R.Code) return Boolean is
begin begin
return R.Is_Alnum(Code) or else R.Is_Rune(Code, R.V.Minus_Sign); return R.Is_Alnum(Code) or else
R.Is_Rune(Code, R.V.Underline) or else
R.Is_Rune(Code, R.V.Minus_Sign);
end Is_Ident_Starter; end Is_Ident_Starter;
function Is_Ident_Char(Code: in R.Code) return Boolean is function Is_Ident_Char(Code: in R.Code) return Boolean is
begin begin
return Is_Ident_Starter(Code) or else R.Is_Rune(Code, R.V.Underline); -- or else R.Is_Rune(C, ...); return Is_Ident_Starter(Code); -- or else R.Is_Rune(Code, R.V.Underline); -- or else R.Is_Rune(C, ...);
end Is_Ident_Char; end Is_Ident_Char;
procedure Feed_Char_Code (C: in out Compiler; Code: in R.Code) is procedure Feed_Char_Code (C: in out Compiler; Code: in R.Code) is
@ -319,34 +359,39 @@ package body H3.Compilers is
elsif R.Is_Rune(Code, R.V.Semicolon) then -- ; elsif R.Is_Rune(Code, R.V.Semicolon) then -- ;
Start_Token (C, Code); Start_Token (C, Code);
End_Token (C, TK_SEMICOLON); End_Token (C, TK_SEMICOLON);
elsif R.Is_Rune(Code, R.V.Colon) then -- :
Set_Lexer_State (C, LX_COLON, Code);
elsif R.Is_Rune(Code, R.V.Quotation) then -- "
Set_Lexer_State (C, LX_CSTR);
elsif Is_Ident_Starter(Code) then elsif Is_Ident_Starter(Code) then
Set_Lexer_State (C, LX_IDENT, Code); Set_Lexer_State (C, LX_IDENT, Code);
elsif R.Is_Digit(Code) then elsif R.Is_Digit(Code) then
Set_Lexer_State (C, LX_NUMBER, Code); Set_Lexer_State (C, LX_NUMBER, Code);
elsif R.Is_Rune(Code, R.V.Plus_Sign) then -- +
Set_Lexer_State (C, LX_OP_PLUS, Code); --elsif R.Is_Rune(Code, R.V.Plus_Sign) then -- +
elsif R.Is_Rune(Code, R.V.Minus_Sign) then -- - -- Set_Lexer_State (C, LX_OP_PLUS, Code);
Set_Lexer_State (C, LX_OP_MINUS, Code); --elsif R.Is_Rune(Code, R.V.Minus_Sign) then -- -
elsif R.Is_Rune(Code, R.V.Asterisk) then -- * -- Set_Lexer_State (C, LX_OP_MINUS, Code);
Set_Lexer_State (C, LX_OP_MUL, Code); --elsif R.Is_Rune(Code, R.V.Asterisk) then -- *
elsif R.Is_Rune(Code, R.V.Slash) then -- / -- Set_Lexer_State (C, LX_OP_MUL, Code);
Set_Lexer_State (C, LX_OP_DIV, Code); --elsif R.Is_Rune(Code, R.V.Slash) then -- /
elsif R.Is_Rune(Code, R.V.Left_Arrow) then -- < -- Set_Lexer_State (C, LX_OP_DIV, Code);
Set_Lexer_State (C, LX_OP_LESS, Code); --elsif R.Is_Rune(Code, R.V.Left_Arrow) then -- <
elsif R.Is_Rune(Code, R.V.Right_Arrow) then -- > -- Set_Lexer_State (C, LX_OP_LESS, Code);
Set_Lexer_State (C, LX_OP_GREATER, Code); --elsif R.Is_Rune(Code, R.V.Right_Arrow) then -- >
elsif R.Is_Rune(Code, R.V.Quotation) then -- " -- Set_Lexer_State (C, LX_OP_GREATER, Code);
Set_Lexer_State (C, LX_CSTR);
else else
raise Syntax_Error; raise Syntax_Error;
end if; end if;
when LX_DIRECTIVE => when LX_COLON =>
if R.Is_Alnum(Code) or else R.Is_Rune(Code, R.V.Underline) then if R.Is_Rune(Code, R.V.Equal_Sign) then -- :=
Feed_Token (C, Code); End_Token (C, TK_ASSIGN, Code);
else else
End_Token (C, TK_DIRECTIVE); End_Token (C, TK_COLON);
goto Start_Over; goto Start_Over;
end if; end if;
@ -367,6 +412,14 @@ package body H3.Compilers is
Feed_Token (C, Code); Feed_Token (C, Code);
end if; end if;
when LX_DIRECTIVE =>
if R.Is_Alnum(Code) or else R.Is_Rune(Code, R.V.Underline) then
Feed_Token (C, Code);
else
End_Token (C, TK_DIRECTIVE);
goto Start_Over;
end if;
when LX_DOLLARED => when LX_DOLLARED =>
if R.Is_Rune(Code, R.V.Left_Curly_Bracket) then if R.Is_Rune(Code, R.V.Left_Curly_Bracket) then
End_Token (C, TK_DOLLARED_LBRACE, Code); End_Token (C, TK_DOLLARED_LBRACE, Code);
@ -382,7 +435,7 @@ package body H3.Compilers is
if R.Is_Alnum(Code) or else R.Is_Rune(Code, R.V.Underline) then if R.Is_Alnum(Code) or else R.Is_Rune(Code, R.V.Underline) then
Feed_Token (C, Code); Feed_Token (C, Code);
Switch_Lexer_State (C, LX_DIRECTIVE); Switch_Lexer_State (C, LX_DIRECTIVE);
elsif R.Is_Rune(Code, R.V.Number_Sign) then -- ## elsif R.Is_Rune(Code, R.V.Number_Sign) or else R.Is_Rune(Code, R.V.Exclamation) then -- ## or #!
Set_Lexer_State (C, LX_COMMENT); Set_Lexer_State (C, LX_COMMENT);
elsif R.Is_Rune(Code, R.V.Left_Curly_Bracket) then elsif R.Is_Rune(Code, R.V.Left_Curly_Bracket) then
End_Token (C, TK_HASHED_LBRACE, Code); End_Token (C, TK_HASHED_LBRACE, Code);

9
lib2/h3-compilers.ads
View File

@ -24,6 +24,7 @@ private
type Lexer_State is ( type Lexer_State is (
LX_START, LX_START,
LX_COLON,
LX_COMMENT, LX_COMMENT,
LX_CSTR, LX_CSTR,
LX_DIRECTIVE, LX_DIRECTIVE,
@ -43,9 +44,11 @@ private
end record; end record;
type Token_Id is ( type Token_Id is (
TK_ASSIGN,
TK_BSTR, TK_BSTR,
TK_BYTE, TK_BYTE,
TK_CHAR, TK_CHAR,
TK_COLON,
TK_CSTR, TK_CSTR,
TK_DIRECTIVE, TK_DIRECTIVE,
TK_DIV, TK_DIV,
@ -86,8 +89,12 @@ private
type Parse_State_Code is ( type Parse_State_Code is (
PS_START, PS_START,
PS_INCLUDE_TARGET, PS_INCLUDE_TARGET,
PS_INCLUDE_TERMINATOR PS_INCLUDE_TERMINATOR,
PS_CLASS_1,
PS_CLASS_2
); );
type Parse_State is record type Parse_State is record