matreshka_league_21.0.0_0c8f4d47/tools/aflex/src/sym.adb

-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- 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.

-- TITLE symbol table routines
-- AUTHOR: John Self (UCI)
-- DESCRIPTION implements only a simple symbol table using open hashing
-- NOTES could be faster, but it isn't used much
-- $Header: /co/ua/self/arcadia/aflex/ada/src/RCS/symB.a,v 1.6 90/01/12 15:20:39 self Exp Locker: self $
with Ada.Integer_Wide_Wide_Text_IO;
with Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Text_IO;
with Ada.Wide_Wide_Text_IO;

with MISC, NFA;

package body SYM is

   use Ada.Integer_Wide_Wide_Text_IO;
   use Ada.Strings.Wide_Wide_Unbounded;
   use Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Text_IO;
   use Ada.Wide_Wide_Text_IO;

   ------------
   -- ADDSYM --
   ------------

   -- addsym - add symbol and definitions to symbol table
   --
   -- true is returned if the symbol already exists, and the change not made.

   procedure ADDSYM
     (SYM        : Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String;
      STR_DEF    : Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String;
      INT_DEF    : INTEGER;
      TABLE      : in out HASH_TABLE;
      TABLE_SIZE : INTEGER;
      RESULT     : out BOOLEAN)
   is
      HASH_VAL             : constant INTEGER := HASHFUNCT (SYM, TABLE_SIZE);
      SYM_ENTRY            : HASH_LINK := TABLE(HASH_VAL);
      NEW_ENTRY, SUCCESSOR : HASH_LINK;
   begin
      while (SYM_ENTRY /= null) loop
         if (SYM = SYM_ENTRY.NAME) then

            -- entry already exists
            RESULT := TRUE;

            return;
         end if;

         SYM_ENTRY := SYM_ENTRY.NEXT;
      end loop;

      -- create new entry
      NEW_ENTRY := new HASH_ENTRY;

      SUCCESSOR := TABLE(HASH_VAL);
      if ((SUCCESSOR /= null)) then
         NEW_ENTRY.NEXT := SUCCESSOR;
         SUCCESSOR.PREV := NEW_ENTRY;
      else
         NEW_ENTRY.NEXT := null;
      end if;

      NEW_ENTRY.PREV := null;
      NEW_ENTRY.NAME := SYM;
      NEW_ENTRY.STR_VAL := STR_DEF;
      NEW_ENTRY.INT_VAL := INT_DEF;

      TABLE(HASH_VAL) := NEW_ENTRY;

      RESULT := FALSE;

      return;

   exception
      when STORAGE_ERROR =>
         Misc.Aflex_Fatal ("symbol table memory allocation failed");
   end ADDSYM;


   ---------------
   -- CCLINSTAL --
   ---------------

   -- cclinstal - save the text of a character class

   procedure CCLINSTAL
     (CCLTXT : Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String;
      CCLNUM : in INTEGER)
   is
      -- we don't bother checking the return status because we are not called
      -- unless the symbol is new
      DUMMY : BOOLEAN;

   begin
      ADDSYM
        (CCLTXT,
         Null_Unbounded_Wide_Wide_String,
         CCLNUM,
         CCLTAB,
         CCL_HASH_SIZE,
         DUMMY);
   end CCLINSTAL;

   ---------------
   -- CCLLOOKUP --
   ---------------

   -- ccllookup - lookup the number associated with character class text

   function CCLLOOKUP
     (CCLTXT : Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String)
      return INTEGER is
   begin
      return FINDSYM (CCLTXT, CCLTAB, CCL_HASH_SIZE).INT_VAL;
   end CCLLOOKUP;

   -------------
   -- FINDSYM --
   -------------

   -- findsym - find symbol in symbol table

   function FINDSYM
     (SYMBOL     : Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String;
      TABLE      : in HASH_TABLE;
      TABLE_SIZE : in INTEGER) return HASH_LINK
   is
      SYM_ENTRY   : HASH_LINK := TABLE (HASHFUNCT (SYMBOL, TABLE_SIZE));
      EMPTY_ENTRY : HASH_LINK;

   begin
      while (SYM_ENTRY /= null) loop
         if (SYMBOL = SYM_ENTRY.NAME) then
            return SYM_ENTRY;
         end if;
         SYM_ENTRY := SYM_ENTRY.NEXT;
      end loop;
      EMPTY_ENTRY := new HASH_ENTRY;
      EMPTY_ENTRY.all :=
        (null,
         null,
         Null_Unbounded_Wide_Wide_String,
         Null_Unbounded_Wide_Wide_String,
         0);

      return EMPTY_ENTRY;

   exception
      when STORAGE_ERROR =>
         Misc.Aflex_Fatal ("dynamic memory failure in findsym()");

         return EMPTY_ENTRY;
   end FINDSYM;

   ---------------
   -- HASHFUNCT --
   ---------------

   -- hashfunct - compute the hash value for "str" and hash size "hash_size"

   function HASHFUNCT
     (STR       : Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String;
      HASH_SIZE : INTEGER) return INTEGER
   is
      HASHVAL, LOCSTR : INTEGER;
   begin
      HASHVAL := 0;
      LOCSTR := 1;

      while LOCSTR <= Length (STR) loop
         HASHVAL :=
           ((HASHVAL*2) + Wide_Wide_Character'Pos(Element (STR, LOCSTR)))
              mod HASH_SIZE;
         LOCSTR := LOCSTR + 1;
      end loop;

      return HASHVAL;
   end HASHFUNCT;

   --------------
   -- NDINSTAL --
   --------------

   --  ndinstal - install a name definition

   procedure NDINSTAL
     (ND, DEF : Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String)
   is
      RESULT : BOOLEAN;
   begin
      ADDSYM (ND, DEF, 0, NDTBL, NAME_TABLE_HASH_SIZE, RESULT);

      if RESULT then
         MISC.SYNERR("name defined twice");
      end if;
   end NDINSTAL;

   --------------
   -- NDLOOKUP --
   --------------

   -- ndlookup - lookup a name definition

   function NDLOOKUP
     (ND : Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String)
      return Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String is
   begin
      return FINDSYM (ND, NDTBL, NAME_TABLE_HASH_SIZE).STR_VAL;
   end NDLOOKUP;

   --------------
   -- SCINSTAL --
   --------------

   -- scinstal - make a start condition
   --
   -- NOTE
   --    the start condition is Exclusive if xcluflg is true

   procedure SCINSTAL
     (STR     : in Unbounded_Wide_Wide_String;
      XCLUFLG : in BOOLEAN)
   is
      -- bit of a hack.  We know how the default start-condition is
      -- declared, and don't put out a define for it, because it
      -- would come out as "#define 0 1"

      -- actually, this is no longer the case.  The default start-condition
      -- is now called "INITIAL".  But we keep the following for the sake
      -- of future robustness.

      RESULT : BOOLEAN;

   begin
      if STR /= "0" then
         PUT (DEF_FILE, "   ");
         PUT (DEF_FILE, STR);
         PUT (DEF_FILE, " : constant YY_State_Type := ");
         PUT (DEF_FILE, LASTSC, 1);
         PUT_LINE (DEF_FILE, ";");
    end if;

    LASTSC := LASTSC + 1;
    if (LASTSC >= CURRENT_MAX_SCS) then
      CURRENT_MAX_SCS := CURRENT_MAX_SCS + MAX_SCS_INCREMENT;

      NUM_REALLOCS := NUM_REALLOCS + 1;

      REALLOCATE_INTEGER_ARRAY(SCSET, CURRENT_MAX_SCS);
      REALLOCATE_INTEGER_ARRAY(SCBOL, CURRENT_MAX_SCS);
      REALLOCATE_BOOLEAN_ARRAY(SCXCLU, CURRENT_MAX_SCS);
      REALLOCATE_BOOLEAN_ARRAY(SCEOF, CURRENT_MAX_SCS);
      REALLOCATE_VSTRING_ARRAY(SCNAME, CURRENT_MAX_SCS);
      REALLOCATE_INTEGER_ARRAY(ACTVSC, CURRENT_MAX_SCS);
    end if;

      SCNAME (LASTSC) := STR;

      ADDSYM
        (SCNAME(LASTSC),
         Null_Unbounded_Wide_Wide_String,
         LASTSC,
         SCTBL,
         START_COND_HASH_SIZE,
         RESULT);
    if (RESULT) then
      Misc.Aflex_Error ("start condition " & STR & " declared twice");
    end if;

    SCSET(LASTSC) := NFA.MKSTATE(SYM_EPSILON);
    SCBOL(LASTSC) := NFA.MKSTATE(SYM_EPSILON);
    SCXCLU(LASTSC) := XCLUFLG;
    SCEOF(LASTSC) := FALSE;
  end SCINSTAL;


  -- sclookup - lookup the number associated with a start condition

   function SCLOOKUP
     (STR : Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String)
      return Integer is
   begin
      return FINDSYM (STR, SCTBL, START_COND_HASH_SIZE).INT_VAL;
   end SCLOOKUP;

end SYM;