managed to change h2-scheme to a generic package
This commit is contained in:
parent
de2e462814
commit
d502f1ab4c
@ -6,7 +6,9 @@ with Ada.Text_IO;
|
|||||||
with Ada.Unchecked_Deallocation;
|
with Ada.Unchecked_Deallocation;
|
||||||
|
|
||||||
procedure scheme is
|
procedure scheme is
|
||||||
package S renames H2.Scheme;
|
--package S renames H2.Scheme;
|
||||||
|
--package S is new H2.Scheme (Wide_Character, Wide_String);
|
||||||
|
package S renames Stream.S;
|
||||||
|
|
||||||
Pool: aliased Storage.Global_Pool;
|
Pool: aliased Storage.Global_Pool;
|
||||||
SI: S.Interpreter_Record;
|
SI: S.Interpreter_Record;
|
||||||
@ -43,14 +45,6 @@ begin
|
|||||||
--S.Set_Input_Stream (SI, String_Stream);
|
--S.Set_Input_Stream (SI, String_Stream);
|
||||||
--S.Set_Output_Stream (SI, Stream); -- specify main output stream.
|
--S.Set_Output_Stream (SI, Stream); -- specify main output stream.
|
||||||
|
|
||||||
--S.Read (SI, I);
|
|
||||||
S.Make_Test_Object (SI, I);
|
|
||||||
|
|
||||||
S.Evaluate (SI, I, O);
|
|
||||||
S.Print (SI, I);
|
|
||||||
Ada.Text_IO.Put_Line ("-------------------------------------------");
|
|
||||||
S.Print (SI, O);
|
|
||||||
|
|
||||||
Ada.Text_IO.Put_Line ("-------------------------------------------");
|
Ada.Text_IO.Put_Line ("-------------------------------------------");
|
||||||
S.Run_Loop (SI, I);
|
S.Run_Loop (SI, I);
|
||||||
S.Print (SI, I);
|
S.Print (SI, I);
|
||||||
|
|||||||
@ -3,7 +3,8 @@ with Ada.Wide_Text_IO;
|
|||||||
|
|
||||||
package Stream is
|
package Stream is
|
||||||
|
|
||||||
package S renames H2.Scheme;
|
--package S renames H2.Scheme;
|
||||||
|
package S is new H2.Scheme (Standard.Wide_Character, Standard.Wide_String);
|
||||||
|
|
||||||
------------------------------------------------------------
|
------------------------------------------------------------
|
||||||
--type Object_String_Pointer is access all S.Object_String;
|
--type Object_String_Pointer is access all S.Object_String;
|
||||||
|
|||||||
17
lib/ascii.awk
Normal file
17
lib/ascii.awk
Normal file
@ -0,0 +1,17 @@
|
|||||||
|
BEGIN {
|
||||||
|
printf ("-- Generated with ascii.txt and ascii.awk\n");
|
||||||
|
printf ("-- Run qseawk -f ascii.awk ascii.txt > h2-ascii.ads for regeneration\n\n");
|
||||||
|
printf ("generic\n\ttype Character_Type is (<>);\npackage H2.Ascii is\n\n");
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
{
|
||||||
|
t = sprintf ("%c", NR - 1);
|
||||||
|
if (str::isprint(t)) t = " -- " t;
|
||||||
|
else t="";
|
||||||
|
printf ("\t%-20s: constant Character_Type := Character_Type'Val(%d);%s\n", $1, NR - 1, t);
|
||||||
|
}
|
||||||
|
|
||||||
|
END {
|
||||||
|
printf ("\nend H2.Ascii;\n");
|
||||||
|
}
|
||||||
128
lib/ascii.txt
Normal file
128
lib/ascii.txt
Normal file
@ -0,0 +1,128 @@
|
|||||||
|
NUL
|
||||||
|
SOH
|
||||||
|
STX
|
||||||
|
ETX
|
||||||
|
EOT
|
||||||
|
ENQ
|
||||||
|
ACK
|
||||||
|
BEL
|
||||||
|
BS
|
||||||
|
HT
|
||||||
|
LF
|
||||||
|
VT
|
||||||
|
FF
|
||||||
|
CR
|
||||||
|
SO
|
||||||
|
SI
|
||||||
|
DLE
|
||||||
|
DC1
|
||||||
|
DC2
|
||||||
|
DC3
|
||||||
|
DC4
|
||||||
|
NAK
|
||||||
|
SYN
|
||||||
|
ETB
|
||||||
|
CAN
|
||||||
|
EM
|
||||||
|
SUB
|
||||||
|
ESC
|
||||||
|
FS
|
||||||
|
GS
|
||||||
|
RS
|
||||||
|
US
|
||||||
|
Space
|
||||||
|
Exclamation
|
||||||
|
Quotation
|
||||||
|
Number_Sign
|
||||||
|
Dollar_Sign
|
||||||
|
Percent_Sign
|
||||||
|
Ampersand
|
||||||
|
Apostrophe
|
||||||
|
Left_Parenthesis
|
||||||
|
Right_Parenthesis
|
||||||
|
Asterisk
|
||||||
|
Plus_Sign
|
||||||
|
Comma
|
||||||
|
Minus_Sign
|
||||||
|
Period
|
||||||
|
Slash
|
||||||
|
Zero
|
||||||
|
One
|
||||||
|
Two
|
||||||
|
Three
|
||||||
|
Four
|
||||||
|
Five
|
||||||
|
Six
|
||||||
|
Seven
|
||||||
|
Eight
|
||||||
|
Nine
|
||||||
|
Colon
|
||||||
|
Semicolon
|
||||||
|
Less_Than_Sign
|
||||||
|
Equals_Sign
|
||||||
|
Greater_Than_Sign
|
||||||
|
Question
|
||||||
|
Commercial_At
|
||||||
|
UC_A
|
||||||
|
UC_B
|
||||||
|
UC_C
|
||||||
|
UC_D
|
||||||
|
UC_E
|
||||||
|
UC_F
|
||||||
|
UC_G
|
||||||
|
UC_H
|
||||||
|
UC_I
|
||||||
|
UC_J
|
||||||
|
UC_K
|
||||||
|
UC_L
|
||||||
|
UC_M
|
||||||
|
UC_N
|
||||||
|
UC_O
|
||||||
|
UC_P
|
||||||
|
UC_Q
|
||||||
|
UC_R
|
||||||
|
UC_S
|
||||||
|
UC_T
|
||||||
|
UC_U
|
||||||
|
UC_V
|
||||||
|
UC_W
|
||||||
|
UC_X
|
||||||
|
UC_Y
|
||||||
|
UC_Z
|
||||||
|
Left_Square_Bracket
|
||||||
|
Backslash
|
||||||
|
Right_Square_Bracket
|
||||||
|
Circumflex
|
||||||
|
Low_Line
|
||||||
|
Grave
|
||||||
|
LC_A
|
||||||
|
LC_B
|
||||||
|
LC_C
|
||||||
|
LC_D
|
||||||
|
LC_E
|
||||||
|
LC_F
|
||||||
|
LC_G
|
||||||
|
LC_H
|
||||||
|
LC_I
|
||||||
|
LC_J
|
||||||
|
LC_K
|
||||||
|
LC_L
|
||||||
|
LC_M
|
||||||
|
LC_N
|
||||||
|
LC_O
|
||||||
|
LC_P
|
||||||
|
LC_Q
|
||||||
|
LC_R
|
||||||
|
LC_S
|
||||||
|
LC_T
|
||||||
|
LC_U
|
||||||
|
LC_V
|
||||||
|
LC_W
|
||||||
|
LC_X
|
||||||
|
LC_Y
|
||||||
|
LC_Z
|
||||||
|
Left_Curly_Bracket
|
||||||
|
Vertical_Line
|
||||||
|
Right_Curly_Bracket
|
||||||
|
Tilde
|
||||||
|
DEL
|
||||||
137
lib/h2-ascii.ads
Normal file
137
lib/h2-ascii.ads
Normal file
@ -0,0 +1,137 @@
|
|||||||
|
-- Generated with ascii.txt and ascii.awk
|
||||||
|
-- Run qseawk -f ascii.awk ascii.txt > h2-ascii.ads for regeneration
|
||||||
|
|
||||||
|
generic
|
||||||
|
type Character_Type is (<>);
|
||||||
|
package H2.Ascii is
|
||||||
|
|
||||||
|
NUL : constant Character_Type := Character_Type'Val(0);
|
||||||
|
SOH : constant Character_Type := Character_Type'Val(1);
|
||||||
|
STX : constant Character_Type := Character_Type'Val(2);
|
||||||
|
ETX : constant Character_Type := Character_Type'Val(3);
|
||||||
|
EOT : constant Character_Type := Character_Type'Val(4);
|
||||||
|
ENQ : constant Character_Type := Character_Type'Val(5);
|
||||||
|
ACK : constant Character_Type := Character_Type'Val(6);
|
||||||
|
BEL : constant Character_Type := Character_Type'Val(7);
|
||||||
|
BS : constant Character_Type := Character_Type'Val(8);
|
||||||
|
HT : constant Character_Type := Character_Type'Val(9);
|
||||||
|
LF : constant Character_Type := Character_Type'Val(10);
|
||||||
|
VT : constant Character_Type := Character_Type'Val(11);
|
||||||
|
FF : constant Character_Type := Character_Type'Val(12);
|
||||||
|
CR : constant Character_Type := Character_Type'Val(13);
|
||||||
|
SO : constant Character_Type := Character_Type'Val(14);
|
||||||
|
SI : constant Character_Type := Character_Type'Val(15);
|
||||||
|
DLE : constant Character_Type := Character_Type'Val(16);
|
||||||
|
DC1 : constant Character_Type := Character_Type'Val(17);
|
||||||
|
DC2 : constant Character_Type := Character_Type'Val(18);
|
||||||
|
DC3 : constant Character_Type := Character_Type'Val(19);
|
||||||
|
DC4 : constant Character_Type := Character_Type'Val(20);
|
||||||
|
NAK : constant Character_Type := Character_Type'Val(21);
|
||||||
|
SYN : constant Character_Type := Character_Type'Val(22);
|
||||||
|
ETB : constant Character_Type := Character_Type'Val(23);
|
||||||
|
CAN : constant Character_Type := Character_Type'Val(24);
|
||||||
|
EM : constant Character_Type := Character_Type'Val(25);
|
||||||
|
SUB : constant Character_Type := Character_Type'Val(26);
|
||||||
|
ESC : constant Character_Type := Character_Type'Val(27);
|
||||||
|
FS : constant Character_Type := Character_Type'Val(28);
|
||||||
|
GS : constant Character_Type := Character_Type'Val(29);
|
||||||
|
RS : constant Character_Type := Character_Type'Val(30);
|
||||||
|
US : constant Character_Type := Character_Type'Val(31);
|
||||||
|
Space : constant Character_Type := Character_Type'Val(32); --
|
||||||
|
Exclamation : constant Character_Type := Character_Type'Val(33); -- !
|
||||||
|
Quotation : constant Character_Type := Character_Type'Val(34); -- "
|
||||||
|
Number_Sign : constant Character_Type := Character_Type'Val(35); -- #
|
||||||
|
Dollar_Sign : constant Character_Type := Character_Type'Val(36); -- $
|
||||||
|
Percent_Sign : constant Character_Type := Character_Type'Val(37); -- %
|
||||||
|
Ampersand : constant Character_Type := Character_Type'Val(38); -- &
|
||||||
|
Apostrophe : constant Character_Type := Character_Type'Val(39); -- '
|
||||||
|
Left_Parenthesis : constant Character_Type := Character_Type'Val(40); -- (
|
||||||
|
Right_Parenthesis : constant Character_Type := Character_Type'Val(41); -- )
|
||||||
|
Asterisk : constant Character_Type := Character_Type'Val(42); -- *
|
||||||
|
Plus_Sign : constant Character_Type := Character_Type'Val(43); -- +
|
||||||
|
Comma : constant Character_Type := Character_Type'Val(44); -- ,
|
||||||
|
Minus_Sign : constant Character_Type := Character_Type'Val(45); -- -
|
||||||
|
Period : constant Character_Type := Character_Type'Val(46); -- .
|
||||||
|
Slash : constant Character_Type := Character_Type'Val(47); -- /
|
||||||
|
Zero : constant Character_Type := Character_Type'Val(48); -- 0
|
||||||
|
One : constant Character_Type := Character_Type'Val(49); -- 1
|
||||||
|
Two : constant Character_Type := Character_Type'Val(50); -- 2
|
||||||
|
Three : constant Character_Type := Character_Type'Val(51); -- 3
|
||||||
|
Four : constant Character_Type := Character_Type'Val(52); -- 4
|
||||||
|
Five : constant Character_Type := Character_Type'Val(53); -- 5
|
||||||
|
Six : constant Character_Type := Character_Type'Val(54); -- 6
|
||||||
|
Seven : constant Character_Type := Character_Type'Val(55); -- 7
|
||||||
|
Eight : constant Character_Type := Character_Type'Val(56); -- 8
|
||||||
|
Nine : constant Character_Type := Character_Type'Val(57); -- 9
|
||||||
|
Colon : constant Character_Type := Character_Type'Val(58); -- :
|
||||||
|
Semicolon : constant Character_Type := Character_Type'Val(59); -- ;
|
||||||
|
Less_Than_Sign : constant Character_Type := Character_Type'Val(60); -- <
|
||||||
|
Equals_Sign : constant Character_Type := Character_Type'Val(61); -- =
|
||||||
|
Greater_Than_Sign : constant Character_Type := Character_Type'Val(62); -- >
|
||||||
|
Question : constant Character_Type := Character_Type'Val(63); -- ?
|
||||||
|
Commercial_At : constant Character_Type := Character_Type'Val(64); -- @
|
||||||
|
UC_A : constant Character_Type := Character_Type'Val(65); -- A
|
||||||
|
UC_B : constant Character_Type := Character_Type'Val(66); -- B
|
||||||
|
UC_C : constant Character_Type := Character_Type'Val(67); -- C
|
||||||
|
UC_D : constant Character_Type := Character_Type'Val(68); -- D
|
||||||
|
UC_E : constant Character_Type := Character_Type'Val(69); -- E
|
||||||
|
UC_F : constant Character_Type := Character_Type'Val(70); -- F
|
||||||
|
UC_G : constant Character_Type := Character_Type'Val(71); -- G
|
||||||
|
UC_H : constant Character_Type := Character_Type'Val(72); -- H
|
||||||
|
UC_I : constant Character_Type := Character_Type'Val(73); -- I
|
||||||
|
UC_J : constant Character_Type := Character_Type'Val(74); -- J
|
||||||
|
UC_K : constant Character_Type := Character_Type'Val(75); -- K
|
||||||
|
UC_L : constant Character_Type := Character_Type'Val(76); -- L
|
||||||
|
UC_M : constant Character_Type := Character_Type'Val(77); -- M
|
||||||
|
UC_N : constant Character_Type := Character_Type'Val(78); -- N
|
||||||
|
UC_O : constant Character_Type := Character_Type'Val(79); -- O
|
||||||
|
UC_P : constant Character_Type := Character_Type'Val(80); -- P
|
||||||
|
UC_Q : constant Character_Type := Character_Type'Val(81); -- Q
|
||||||
|
UC_R : constant Character_Type := Character_Type'Val(82); -- R
|
||||||
|
UC_S : constant Character_Type := Character_Type'Val(83); -- S
|
||||||
|
UC_T : constant Character_Type := Character_Type'Val(84); -- T
|
||||||
|
UC_U : constant Character_Type := Character_Type'Val(85); -- U
|
||||||
|
UC_V : constant Character_Type := Character_Type'Val(86); -- V
|
||||||
|
UC_W : constant Character_Type := Character_Type'Val(87); -- W
|
||||||
|
UC_X : constant Character_Type := Character_Type'Val(88); -- X
|
||||||
|
UC_Y : constant Character_Type := Character_Type'Val(89); -- Y
|
||||||
|
UC_Z : constant Character_Type := Character_Type'Val(90); -- Z
|
||||||
|
Left_Square_Bracket : constant Character_Type := Character_Type'Val(91); -- [
|
||||||
|
Backslash : constant Character_Type := Character_Type'Val(92); -- \
|
||||||
|
Right_Square_Bracket: constant Character_Type := Character_Type'Val(93); -- ]
|
||||||
|
Circumflex : constant Character_Type := Character_Type'Val(94); -- ^
|
||||||
|
Low_Line : constant Character_Type := Character_Type'Val(95); -- _
|
||||||
|
Grave : constant Character_Type := Character_Type'Val(96); -- `
|
||||||
|
LC_A : constant Character_Type := Character_Type'Val(97); -- a
|
||||||
|
LC_B : constant Character_Type := Character_Type'Val(98); -- b
|
||||||
|
LC_C : constant Character_Type := Character_Type'Val(99); -- c
|
||||||
|
LC_D : constant Character_Type := Character_Type'Val(100); -- d
|
||||||
|
LC_E : constant Character_Type := Character_Type'Val(101); -- e
|
||||||
|
LC_F : constant Character_Type := Character_Type'Val(102); -- f
|
||||||
|
LC_G : constant Character_Type := Character_Type'Val(103); -- g
|
||||||
|
LC_H : constant Character_Type := Character_Type'Val(104); -- h
|
||||||
|
LC_I : constant Character_Type := Character_Type'Val(105); -- i
|
||||||
|
LC_J : constant Character_Type := Character_Type'Val(106); -- j
|
||||||
|
LC_K : constant Character_Type := Character_Type'Val(107); -- k
|
||||||
|
LC_L : constant Character_Type := Character_Type'Val(108); -- l
|
||||||
|
LC_M : constant Character_Type := Character_Type'Val(109); -- m
|
||||||
|
LC_N : constant Character_Type := Character_Type'Val(110); -- n
|
||||||
|
LC_O : constant Character_Type := Character_Type'Val(111); -- o
|
||||||
|
LC_P : constant Character_Type := Character_Type'Val(112); -- p
|
||||||
|
LC_Q : constant Character_Type := Character_Type'Val(113); -- q
|
||||||
|
LC_R : constant Character_Type := Character_Type'Val(114); -- r
|
||||||
|
LC_S : constant Character_Type := Character_Type'Val(115); -- s
|
||||||
|
LC_T : constant Character_Type := Character_Type'Val(116); -- t
|
||||||
|
LC_U : constant Character_Type := Character_Type'Val(117); -- u
|
||||||
|
LC_V : constant Character_Type := Character_Type'Val(118); -- v
|
||||||
|
LC_W : constant Character_Type := Character_Type'Val(119); -- w
|
||||||
|
LC_X : constant Character_Type := Character_Type'Val(120); -- x
|
||||||
|
LC_Y : constant Character_Type := Character_Type'Val(121); -- y
|
||||||
|
LC_Z : constant Character_Type := Character_Type'Val(122); -- z
|
||||||
|
Left_Curly_Bracket : constant Character_Type := Character_Type'Val(123); -- {
|
||||||
|
Vertical_Line : constant Character_Type := Character_Type'Val(124); -- |
|
||||||
|
Right_Curly_Bracket : constant Character_Type := Character_Type'Val(125); -- }
|
||||||
|
Tilde : constant Character_Type := Character_Type'Val(126); -- ~
|
||||||
|
DEL : constant Character_Type := Character_Type'Val(127);
|
||||||
|
|
||||||
|
end H2.Ascii;
|
||||||
@ -1,6 +1,8 @@
|
|||||||
with H2.Pool;
|
with H2.Pool;
|
||||||
|
|
||||||
package body H2.Scheme.Token is
|
separate (H2.Scheme)
|
||||||
|
|
||||||
|
package body Token is
|
||||||
|
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- BUFFER MANAGEMENT
|
-- BUFFER MANAGEMENT
|
||||||
@ -85,8 +87,26 @@ package body H2.Scheme.Token is
|
|||||||
end Purge;
|
end Purge;
|
||||||
|
|
||||||
procedure Set (Interp: in out Interpreter_Record;
|
procedure Set (Interp: in out Interpreter_Record;
|
||||||
Kind: in Token_Kind;
|
Kind: in Token_Kind) is
|
||||||
Value: in Object_String) is
|
begin
|
||||||
|
Interp.Token.Kind := Kind;
|
||||||
|
Clear_Buffer (Interp.Token.Value);
|
||||||
|
end Set;
|
||||||
|
|
||||||
|
procedure Set (Interp: in out Interpreter_Record;
|
||||||
|
Kind: in Token_Kind;
|
||||||
|
Value: in Object_Character) is
|
||||||
|
Tmp: Object_String(1..1);
|
||||||
|
begin
|
||||||
|
Interp.Token.Kind := Kind;
|
||||||
|
Clear_Buffer (Interp.Token.Value);
|
||||||
|
Tmp(1) := Value;
|
||||||
|
Append_Buffer (Interp, Interp.Token.Value, Tmp);
|
||||||
|
end Set;
|
||||||
|
|
||||||
|
procedure Set (Interp: in out Interpreter_Record;
|
||||||
|
Kind: in Token_Kind;
|
||||||
|
Value: in Object_String) is
|
||||||
begin
|
begin
|
||||||
Interp.Token.Kind := Kind;
|
Interp.Token.Kind := Kind;
|
||||||
Clear_Buffer (Interp.Token.Value);
|
Clear_Buffer (Interp.Token.Value);
|
||||||
@ -111,4 +131,4 @@ package body H2.Scheme.Token is
|
|||||||
end Append_Character;
|
end Append_Character;
|
||||||
|
|
||||||
|
|
||||||
end H2.Scheme.Token;
|
end Token;
|
||||||
|
|||||||
@ -1,21 +0,0 @@
|
|||||||
|
|
||||||
private package H2.Scheme.Token is
|
|
||||||
|
|
||||||
procedure Purge (Interp: in out Interpreter_Record);
|
|
||||||
pragma Inline (Purge);
|
|
||||||
|
|
||||||
procedure Set (Interp: in out Interpreter_Record;
|
|
||||||
Kind: in Token_Kind;
|
|
||||||
Value: in Object_String);
|
|
||||||
|
|
||||||
procedure Append_String (Interp: in out Interpreter_Record;
|
|
||||||
Value: in Object_String);
|
|
||||||
pragma Inline (Append_String);
|
|
||||||
|
|
||||||
procedure Append_Character (Interp: in out Interpreter_Record;
|
|
||||||
Value: in Object_Character);
|
|
||||||
pragma Inline (Append_Character);
|
|
||||||
|
|
||||||
|
|
||||||
end H2.Scheme.Token;
|
|
||||||
|
|
||||||
File diff suppressed because it is too large
Load Diff
@ -39,6 +39,9 @@ with System;
|
|||||||
with System.Storage_Pools;
|
with System.Storage_Pools;
|
||||||
with Ada.Unchecked_Conversion;
|
with Ada.Unchecked_Conversion;
|
||||||
|
|
||||||
|
generic
|
||||||
|
type Character_Type is (<>);
|
||||||
|
type String_Type is array (Standard.Positive range<>) of Character_Type;
|
||||||
package H2.Scheme is
|
package H2.Scheme is
|
||||||
|
|
||||||
type Interpreter_Record is limited private;
|
type Interpreter_Record is limited private;
|
||||||
@ -122,8 +125,10 @@ package H2.Scheme is
|
|||||||
type Object_Byte is mod 2 ** System.Storage_Unit;
|
type Object_Byte is mod 2 ** System.Storage_Unit;
|
||||||
for Object_Byte'Size use System.Storage_Unit;
|
for Object_Byte'Size use System.Storage_Unit;
|
||||||
|
|
||||||
subtype Object_Character is Standard.Wide_Character;
|
--subtype Object_Character is Standard.Wide_Character;
|
||||||
subtype Object_String is Standard.Wide_String;
|
--subtype Object_String is Standard.Wide_String;
|
||||||
|
subtype Object_Character is Character_Type;
|
||||||
|
subtype Object_String is String_Type;
|
||||||
|
|
||||||
type Object_String_Pointer is access all Object_String;
|
type Object_String_Pointer is access all Object_String;
|
||||||
type Constant_Object_String_Pointer is access constant Object_String;
|
type Constant_Object_String_Pointer is access constant Object_String;
|
||||||
@ -381,8 +386,6 @@ package H2.Scheme is
|
|||||||
|
|
||||||
-- -----------------------------------------------------------------------------
|
-- -----------------------------------------------------------------------------
|
||||||
|
|
||||||
procedure Make_Test_Object (Interp: in out Interpreter_Record; Result: out Object_Pointer);
|
|
||||||
|
|
||||||
procedure Open (Interp: in out Interpreter_Record;
|
procedure Open (Interp: in out Interpreter_Record;
|
||||||
Initial_Heap_Size:in Heap_Size;
|
Initial_Heap_Size:in Heap_Size;
|
||||||
Storage_Pool: in Storage_Pool_Pointer := null);
|
Storage_Pool: in Storage_Pool_Pointer := null);
|
||||||
@ -437,8 +440,6 @@ private
|
|||||||
type Heap_Number is mod 2 ** 1;
|
type Heap_Number is mod 2 ** 1;
|
||||||
type Heap_Pointer_Array is Array (Heap_Number'First .. Heap_Number'Last) of Heap_Pointer;
|
type Heap_Pointer_Array is Array (Heap_Number'First .. Heap_Number'Last) of Heap_Pointer;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
type Token_Kind is (End_Token,
|
type Token_Kind is (End_Token,
|
||||||
Identifier_Token,
|
Identifier_Token,
|
||||||
Left_Parenthesis_Token,
|
Left_Parenthesis_Token,
|
||||||
@ -479,4 +480,30 @@ private
|
|||||||
LC_Unfetched: Standard.Boolean := Standard.False;
|
LC_Unfetched: Standard.Boolean := Standard.False;
|
||||||
end record;
|
end record;
|
||||||
|
|
||||||
|
package Token is
|
||||||
|
|
||||||
|
procedure Purge (Interp: in out Interpreter_Record);
|
||||||
|
pragma Inline (Purge);
|
||||||
|
|
||||||
|
procedure Set (Interp: in out Interpreter_Record;
|
||||||
|
Kind: in Token_Kind);
|
||||||
|
|
||||||
|
procedure Set (Interp: in out Interpreter_Record;
|
||||||
|
Kind: in Token_Kind;
|
||||||
|
Value: in Object_Character);
|
||||||
|
|
||||||
|
procedure Set (Interp: in out Interpreter_Record;
|
||||||
|
Kind: in Token_Kind;
|
||||||
|
Value: in Object_String);
|
||||||
|
|
||||||
|
procedure Append_String (Interp: in out Interpreter_Record;
|
||||||
|
Value: in Object_String);
|
||||||
|
pragma Inline (Append_String);
|
||||||
|
|
||||||
|
procedure Append_Character (Interp: in out Interpreter_Record;
|
||||||
|
Value: in Object_Character);
|
||||||
|
pragma Inline (Append_Character);
|
||||||
|
end Token;
|
||||||
|
|
||||||
|
|
||||||
end H2.Scheme;
|
end H2.Scheme;
|
||||||
|
|||||||
@ -9,15 +9,16 @@ project Lib is
|
|||||||
|
|
||||||
for Source_Files use (
|
for Source_Files use (
|
||||||
"h2.ads",
|
"h2.ads",
|
||||||
|
"h2-ascii.ads",
|
||||||
"h2-pool.adb",
|
"h2-pool.adb",
|
||||||
"h2-pool.ads",
|
"h2-pool.ads",
|
||||||
"h2-scheme.adb",
|
"h2-scheme.adb",
|
||||||
"h2-scheme.ads",
|
"h2-scheme.ads",
|
||||||
"h2-scheme-token.adb",
|
"h2-scheme-token.adb"
|
||||||
"h2-scheme-token.ads"
|
|
||||||
);
|
);
|
||||||
for Library_Interface use (
|
for Library_Interface use (
|
||||||
"h2",
|
"h2",
|
||||||
|
"h2.ascii",
|
||||||
"h2.pool",
|
"h2.pool",
|
||||||
"h2.scheme"
|
"h2.scheme"
|
||||||
);
|
);
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user