-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
--    The primary authors of ayacc were David Taback and Deepak Tolani.
--    Enhancements were made by Ronald J. Schmalz.
--
--    Send requests for ayacc information to ayacc-info@ics.uci.edu
--    Send bug reports for ayacc to ayacc-bugs@ics.uci.edu
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- Module       : symbol_table_body.ada
-- Component of : ayacc
-- Version      : 1.2
-- Date         : 11/21/86  12:37:53
-- SCCS File    : disk21~/rschm/hasee/sccs/ayacc/sccs/sxsymbol_table_body.ada

-- $Header: symbol_table_body.a,v 0.1 86/04/01 15:13:55 ada Exp $
-- $Log:        symbol_table_body.a,v $
-- Revision 0.1  86/04/01  15:13:55  ada
--  This version fixes some minor bugs with empty grammars
--  and $$ expansion. It also uses vads5.1b enhancements
--  such as pragma inline.
--
--
-- Revision 0.0  86/02/19  18:54:02  ada
--
-- These files comprise the initial version of Ayacc
-- designed and implemented by David Taback and Deepak Tolani.
-- Ayacc has been compiled and tested under the Verdix Ada compiler
-- version 4.06 on a vax 11/750 running Unix 4.2BSD.
--

package body Symbol_Table is

   -- SCCS_ID : constant String := "@(#) symbol_table_body.ada, Version 1.2";

   Next_Free_Terminal    : Grammar_Symbol := 0;
   Next_Free_Nonterminal : Grammar_Symbol := -1;

   Start_Symbol_Pos, End_Symbol_Pos : Grammar_Symbol;

   type String_Pointer is access String;

   type Table_Entry (Id : Grammar_Symbol);
   type Entry_Pointer is access Table_Entry;

   type Table_Entry (Id : Grammar_Symbol) is record
      Name : String_Pointer;
      Next : Entry_Pointer;
      case Id is
         when 0 .. Grammar_Symbol'Last =>   -- Terminal
            Prec  : Precedence;
            Assoc : Associativity;
         when others =>                   -- Nonterminal
            null;
      end case;
   end record;

   Hash_Table_Size : constant := 613;    -- A large prime number

   type Hash_Index is range 0 .. Hash_Table_Size - 1;

   Hash_Table : array (Hash_Index) of Entry_Pointer;

   --
   --    Create a 'dynamic' array for looking up an entry
   --    for a given grammar_symbol.
   --

   Block_Size : constant Grammar_Symbol := 100;
   type Lookup_Array is
     array (Grammar_Symbol range 0 .. Block_Size - 1) of Entry_Pointer;
   type Block;
   type Block_Pointer is access Block;
   type Block is record
      Lookup : Lookup_Array;
      Next   : Block_Pointer := null;
   end record;

   -- have separate blocks for terminals and nonterminals.

   Terminal_Blocks, Nonterminal_Blocks : constant Block_Pointer := new Block;

   procedure Make_Lookup_Table_Entry
     (Id : in Grammar_Symbol; Entry_Ptr : in Entry_Pointer)
   is

      Id_Block     : Block_Pointer;
      Block_Number : Integer;

   begin
      if Id >= 0 then
         Id_Block := Terminal_Blocks;
      else
         Id_Block := Nonterminal_Blocks;
      end if;
      Block_Number := Integer (abs Id / Block_Size);

      for I in 1 .. Block_Number loop
         if Id_Block.Next = null then
            Id_Block.Next := new Block;
         end if;
         Id_Block := Id_Block.Next;
      end loop;
      Id_Block.Lookup ((abs Id) mod Block_Size) := Entry_Ptr;
   end Make_Lookup_Table_Entry;

   function Get_Lookup_Table_Entry (Id : Grammar_Symbol) return Entry_Pointer
   is
      Id_Block : Block_Pointer;
   begin
      if Id >= 0 then
         Id_Block := Terminal_Blocks;
      else
         Id_Block := Nonterminal_Blocks;
      end if;
      for I in 1 .. abs Id / Block_Size loop
         Id_Block := Id_Block.Next;
      end loop;
      return Id_Block.Lookup ((abs Id) mod Block_Size);
   end Get_Lookup_Table_Entry;

   -- some day someone should put in a good hash function.
   function Hash_Value (S : String) return Hash_Index is
      H   : Integer;
      Mid : Integer;
   begin
      Mid := (S'First + S'Last) / 2;
      H   :=
        ((Character'Pos (S (S'First)) + Character'Pos (S (Mid)) +
          Character'Pos (S (S'Last))) *
         S'Length * 16) mod
        Hash_Table_Size;
      return Hash_Index (H);
   end Hash_Value;

   function Insert_Identifier (Name : in String) return Grammar_Symbol is

      Index     : Hash_Index;
      Entry_Ptr : Entry_Pointer;

   begin

      Index := Hash_Value (Name);

      Entry_Ptr := Hash_Table (Index);

      if Entry_Ptr = null then

         Entry_Ptr          := new Table_Entry (Next_Free_Nonterminal);
         Entry_Ptr.Name     := new String (1 .. Name'Length);
         Entry_Ptr.Name.all := Name;
         Hash_Table (Index) := Entry_Ptr;

         Make_Lookup_Table_Entry (Next_Free_Nonterminal, Entry_Ptr);
         Next_Free_Nonterminal := Next_Free_Nonterminal - 1;

      else

         loop
            if Entry_Ptr.Name.all = Name then
               return Entry_Ptr.Id;
            end if;
            if Entry_Ptr.Next = null then
               exit;
            end if;
            Entry_Ptr := Entry_Ptr.Next;
         end loop;

         Entry_Ptr.Next     := new Table_Entry (Next_Free_Nonterminal);
         Entry_Ptr          := Entry_Ptr.Next;
         Entry_Ptr.Name     := new String (1 .. Name'Length);
         Entry_Ptr.Name.all := Name;

         Make_Lookup_Table_Entry (Next_Free_Nonterminal, Entry_Ptr);
         Next_Free_Nonterminal := Next_Free_Nonterminal - 1;

      end if;

      return Next_Free_Nonterminal + 1;

   end Insert_Identifier;

   function Insert_Terminal
     (Name  : String; Prec : Precedence := 0;
      Assoc : Associativity := Undefined) return Grammar_Symbol
   is

      Index     : Hash_Index;
      Entry_Ptr : Entry_Pointer;

   begin

      Index := Hash_Value (Name);

      Entry_Ptr := Hash_Table (Index);

      if Entry_Ptr = null then

         Entry_Ptr          := new Table_Entry (Next_Free_Terminal);
         Entry_Ptr.Name     := new String (1 .. Name'Length);
         Entry_Ptr.Name.all := Name;
         Entry_Ptr.Assoc    := Assoc;
         Entry_Ptr.Prec     := Prec;
         Hash_Table (Index) := Entry_Ptr;

         Make_Lookup_Table_Entry (Next_Free_Terminal, Entry_Ptr);
         Next_Free_Terminal := Next_Free_Terminal + 1;

      else

         loop
            if Entry_Ptr.Name.all = Name then
               if Entry_Ptr.Id < 0 then    -- Look out for nonterminals
                  raise Illegal_Entry;
               end if;
               if Prec /= 0 then
                  if Entry_Ptr.Prec /= 0 then
                     raise Redefined_Precedence_Error;
                  end if;
                  Entry_Ptr.Prec  := Prec;
                  Entry_Ptr.Assoc := Assoc;
               end if;
               return Entry_Ptr.Id;
            end if;
            if Entry_Ptr.Next = null then
               exit;
            end if;
            Entry_Ptr := Entry_Ptr.Next;
         end loop;

         Entry_Ptr.Next     := new Table_Entry (Next_Free_Terminal);
         Entry_Ptr          := Entry_Ptr.Next;
         Entry_Ptr.Name     := new String (1 .. Name'Length);
         Entry_Ptr.Name.all := Name;
         Entry_Ptr.Assoc    := Assoc;
         Entry_Ptr.Prec     := Prec;

         Make_Lookup_Table_Entry (Next_Free_Terminal, Entry_Ptr);
         Next_Free_Terminal := Next_Free_Terminal + 1;

      end if;

      return Next_Free_Terminal - 1;

   end Insert_Terminal;

   function Get_Associativity (Id : Grammar_Symbol) return Associativity is
   begin
      return Get_Lookup_Table_Entry (Id).Assoc;
   end Get_Associativity;

   function Get_Precedence (Id : Grammar_Symbol) return Precedence is
   begin
      return Get_Lookup_Table_Entry (Id).Prec;
   end Get_Precedence;

   function Get_Symbol_Name (Id : Grammar_Symbol) return String is
   begin
      return Get_Lookup_Table_Entry (Id).Name.all;
   end Get_Symbol_Name;

   function First_Symbol (Kind : Symbol_Type) return Grammar_Symbol is
   begin
      if Kind = Terminal then
         return 0;
      else
         return Next_Free_Nonterminal + 1;
      end if;
   end First_Symbol;

   function Last_Symbol (Kind : Symbol_Type) return Grammar_Symbol is
   begin
      if Kind = Terminal then
         return Next_Free_Terminal - 1;
      else
         return -1;
      end if;
   end Last_Symbol;

   --  function First_Terminal  return Grammar_Symbol is
   --  begin
   --  return 0;
   --  end;

   --  function Last_Terminal   return Grammar_Symbol is
   --  begin
   --  return Next_Free_Terminal - 1;
   --  end;

   function Start_Symbol return Grammar_Symbol is
   begin
      return Start_Symbol_Pos;
   end Start_Symbol;

   function End_Symbol return Grammar_Symbol is
   begin
      return End_Symbol_Pos;
   end End_Symbol;

   function Is_Terminal (Id : Grammar_Symbol) return Boolean is
   begin
      return Id >= 0;
   end Is_Terminal;

   function Is_Nonterminal (Id : Grammar_Symbol) return Boolean is
   begin
      return Id < 0;
   end Is_Nonterminal;

begin
   End_Symbol_Pos   := Insert_Terminal ("END_OF_INPUT");
   Start_Symbol_Pos := Insert_Identifier ("$accept");
   -- declare a dummy symbol to insert the "error" token.
   declare
      Dummy_Sym : Grammar_Symbol;
   begin
      Dummy_Sym := Insert_Terminal ("ERROR");
   end;
end Symbol_Table;
