1. with Ada.Strings.Unbounded;             use Ada.Strings.Unbounded; 
  2. with GNAT.Regpat;                       use GNAT.Regpat; 
  3. with Objects;                           use Objects; 
  4.  
  5. package Tokens is 
  6.  
  7.     -- Each Token_Type value represents a token in a grammar. 
  8.     type Token_Type is ( 
  9.         TK_AND, 
  10.         TK_BANG, 
  11.         TK_COMMA, 
  12.         TK_EQUALS, 
  13.         TK_GREATER, 
  14.         TK_GREATER_EQUALS, 
  15.         TK_LEFT_PARENTHESIS, 
  16.         TK_LESS, 
  17.         TK_LESS_EQUALS, 
  18.         TK_MINUS, 
  19.         TK_NOT_EQUALS, 
  20.         TK_OR, 
  21.         TK_PERCENT, 
  22.         TK_PLUS, 
  23.         TK_RIGHT_PARENTHESIS, 
  24.         TK_SLASH, 
  25.         TK_STAR, 
  26.  
  27.         TK_IDENTIFIER, 
  28.         TK_NUMBER, 
  29.         TK_STRING, 
  30.         TK_EOF 
  31.     ); 
  32.  
  33.     -- Encapsulates a token's position in an input stream. A token's location is 
  34.     -- determined by the location of it's first character. 
  35.     type Token_Location is 
  36.         record 
  37.             line : Natural := 0; 
  38.             col  : Natural := 0; 
  39.         end record; 
  40.  
  41.     -- Returns a string representation in the format 'line:column'. 
  42.     function To_String( loc : Token_Location ) return String; 
  43.  
  44.     ---------------------------------------------------------------------------- 
  45.  
  46.     -- A Token represents a recognized element of syntax. It is a terminal 
  47.     -- element in a script's context free grammar. 
  48.     type Token is new Limited_Object with private; 
  49.     type A_Token is access all Token'Class; 
  50.  
  51.     -- Creates a new Token of the type matching 'text'. If 'text' is not 
  52.     -- recognized as a valid token, null will be returned. 
  53.     function Create_Token( text : String; loc : Token_Location ) return A_Token; 
  54.  
  55.     -- Returns the location of the token in the input stream. 
  56.     function Get_Location( this : not null access Token'Class ) return Token_Location; 
  57.  
  58.     -- Returns the token's type. 
  59.     function Get_Type( this : not null access Token'Class ) return Token_Type; 
  60.  
  61.     -- Deletes the Token. 
  62.     procedure Delete( this : in out A_Token ); 
  63.     pragma Postcondition( this = null ); 
  64.  
  65.     ---------------------------------------------------------------------------- 
  66.  
  67.     -- An Identifier_Token represents an identifier or variable name. 
  68.     type Identifier_Token is new Token with private; 
  69.     type A_Identifier_Token is access all Identifier_Token'Class; 
  70.  
  71.     -- Returns the name of the identifier specified by the token. 
  72.     function Get_Name( this : not null access Identifier_Token'Class ) return String; 
  73.  
  74.     ---------------------------------------------------------------------------- 
  75.  
  76.     -- A Number_Token represents a literal number, either decimal or integer. 
  77.     type Number_Token is new Token with private; 
  78.     type A_Number_Token is access all Number_Token'Class; 
  79.  
  80.     -- Returns the numeric value of the token. 
  81.     function Get_Value( this : not null access Number_Token'Class ) return Long_Float; 
  82.  
  83.     ---------------------------------------------------------------------------- 
  84.  
  85.     -- A String_Token represents a literal string. 
  86.     type String_Token is new Token with private; 
  87.     type A_String_Token is access all String_Token'Class; 
  88.  
  89.     -- Returns the string value of the token. 
  90.     function Get_Value( this : not null access String_Token'Class ) return String; 
  91.  
  92. private 
  93.  
  94.     type TokenStringArray is array (Token_Type) of access String; 
  95.  
  96.     -- An array of text images of all token types. Entries with a null value are 
  97.     -- pattern tokens that don't have a single static image. 
  98.     tokenImage : constant TokenStringArray := ( 
  99.         TK_AND               => new String'("&&"), 
  100.         TK_BANG              => new String'("!"), 
  101.         TK_COMMA             => new String'(","), 
  102.         TK_EQUALS            => new String'("="), 
  103.         TK_GREATER           => new String'(">"), 
  104.         TK_GREATER_EQUALS    => new String'(">="), 
  105.         TK_LEFT_PARENTHESIS  => new String'("("), 
  106.         TK_LESS              => new String'("<"), 
  107.         TK_LESS_EQUALS       => new String'("<="), 
  108.         TK_MINUS             => new String'("-"), 
  109.         TK_NOT_EQUALS        => new String'("!="), 
  110.         TK_OR                => new String'("||"), 
  111.         TK_PERCENT           => new String'("%"), 
  112.         TK_PLUS              => new String'("+"), 
  113.         TK_RIGHT_PARENTHESIS => new String'(")"), 
  114.         TK_SLASH             => new String'("/"), 
  115.         TK_STAR              => new String'("*"), 
  116.  
  117.         TK_IDENTIFIER        => null, 
  118.         TK_NUMBER            => null, 
  119.         TK_STRING            => null, 
  120.         TK_EOF               => new String'("") 
  121.     ); 
  122.  
  123.     ---------------------------------------------------------------------------- 
  124.  
  125.     type Token is new Limited_Object with 
  126.         record 
  127.             tokenType : Token_Type; 
  128.             loc       : Token_Location; 
  129.         end record; 
  130.  
  131.     procedure Construct( this      : access Token; 
  132.                          tokenType : Token_Type; 
  133.                          loc       : Token_Location ); 
  134.  
  135.     -- Creates a new Token of type 'tokenType'. The type must be one of the 
  136.     -- token types that has a static representation. 
  137.     function Create_Token( tokenType : Token_Type; 
  138.                            loc       : Token_Location ) return A_Token; 
  139.  
  140.     ---------------------------------------------------------------------------- 
  141.  
  142.     -- Regular expression for recognizing an identifier token. An identifier 
  143.     -- must start with a letter and optionally be followed by any number of 
  144.     -- letters, numbers, underscores and dots. 
  145.     identPattern : constant Pattern_Matcher := Compile("^[a-zA-Z]+[a-zA-Z0-9_.]*$"); 
  146.  
  147.     type Identifier_Token is new Token with 
  148.         record 
  149.             name : Unbounded_String; 
  150.         end record; 
  151.  
  152.     procedure Construct( this : access Identifier_Token; 
  153.                          name : String; 
  154.                          loc  : Token_Location ); 
  155.  
  156.     -- Creates a new Identifier_Token from 'text'. Returns null if 'text' is 
  157.     -- not an identifier string. An identifier is a letter followed by any 
  158.     -- number of letters, digits or underscores. 
  159.     function Create_Identifier_Token( text : String; 
  160.                                       loc  : Token_Location ) return A_Token; 
  161.  
  162.     ---------------------------------------------------------------------------- 
  163.  
  164.     -- Regular expression for recognizing a number token. A number must start 
  165.     -- with any number of digits and may optionally by followed by a dot and 
  166.     -- another series of digits. 
  167.     numPattern : constant Pattern_Matcher := Compile("^([0-9]+)|([0-9]*\.[0-9]+)$"); 
  168.  
  169.     type Number_Token is new Token with 
  170.         record 
  171.             val : Long_Float; 
  172.         end record; 
  173.  
  174.     procedure Construct( this : access Number_Token; 
  175.                          val  : Long_Float; 
  176.                          loc  : Token_Location ); 
  177.  
  178.     -- Creates a new Number_Token from 'text'. Returns null if 'text' is not a 
  179.     -- valid number. A valid number is a digit sequence, optionally followed 
  180.     -- by a dot and another digit sequence. 
  181.     function Create_Number_Token( text : String; 
  182.                                   loc  : Token_Location ) return A_Token; 
  183.  
  184.     ---------------------------------------------------------------------------- 
  185.  
  186.     type String_Token is new Token with 
  187.         record 
  188.             val : Unbounded_String; 
  189.         end record; 
  190.  
  191.     procedure Construct( this : access String_Token; 
  192.                          val  : String; 
  193.                          loc  : Token_Location ); 
  194.  
  195.     -- Creates a new String_Token from 'text'. Returns null if 'text' is not a 
  196.     -- valid string literal. A string is any sequence of characters within 
  197.     -- matching double-quote or single-quote characters. 
  198.     function Create_String_Token( text : String; 
  199.                                   loc  : Token_Location ) return A_Token; 
  200.  
  201. end Tokens;