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