--
--  Copyright (C) 2014-2022, AdaCore
--  SPDX-License-Identifier: Apache-2.0
--

with Ada.Unchecked_Deallocation;
with System;                  use System;
with System.Storage_Elements; use System.Storage_Elements;

package body Gpr_Parser_Support.Symbols is

   procedure Deallocate is new Ada.Unchecked_Deallocation
     (Symbol_Table_Record'Class, Symbol_Table);

   -----------
   -- Image --
   -----------

   function Image (S : Symbol_Type) return Text_Type is
   begin
      return (if S = null then "<no symbol>" else S.all);
   end Image;

   -----------
   -- Image --
   -----------

   function Image
     (S : Symbol_Type; With_Quotes : Boolean := False) return String is
   begin
      if S = null then
         return "<no symbol>";
      else
         return Image (S.all, With_Quotes);
      end if;
   end Image;

   -------------------------
   -- Create_Symbol_Table --
   -------------------------

   function Create_Symbol_Table return Symbol_Table is
   begin
      return new Symbol_Table_Record;
   end Create_Symbol_Table;

   ----------
   -- Find --
   ----------

   function Find
     (ST     : Symbol_Table;
      T      : Text_Type;
      Create : Boolean := True)
      return Thin_Symbol
   is
      use Maps;

      T_Acc  : Symbol_Type := T'Unrestricted_Access;
      Result : constant Cursor := ST.Symbols_Map.Find (T_Acc);
   begin
      --  If we already have such a symbol, return the access we already
      --  internalized. Otherwise, give up if asked to.

      if Has_Element (Result) then
         return Element (Result);
      elsif not Create then
         return No_Thin_Symbol;
      end if;

      --  At this point, we know we have to internalize a new symbol

      T_Acc := new Text_Type'(T);
      ST.Symbols.Append (T_Acc);

      ST.Symbols_Map.Insert (T_Acc, Thin_Symbol (ST.Symbols.Last_Index));
      return Thin_Symbol (ST.Symbols.Last_Index);
   end Find;

   -------------
   -- Destroy --
   -------------

   procedure Destroy (ST : in out Symbol_Table) is
      use Maps;
      To_Free : Text_Access;
   begin
      ST.Symbols_Map.Clear;

      for El of ST.Symbols loop
         To_Free := Text_Access'(El.all'Unrestricted_Access);
         Free (To_Free);
      end loop;

      ST.Symbols.Destroy;
      Deallocate (ST);
   end Destroy;

   ----------
   -- Hash --
   ----------

   function Hash (ST : Symbol_Type) return Hash_Type is
   begin
      if ST = null then
         return Hash_Type (0);
      else
         return Hash_Type'Mod (To_Integer (ST.all'Address));
      end if;
   end Hash;

   ----------------
   -- Get_Symbol --
   ----------------

   function Get_Symbol
     (Self : Symbol_Table; TS : Thin_Symbol) return Symbol_Type is
   begin
      if TS = No_Thin_Symbol then
         return null;
      else
         return Self.Symbols.Get (Positive (TS));
      end if;
   end Get_Symbol;

   ---------------
   -- Fold_Case --
   ---------------

   function Fold_Case (Name : Text_Type) return Symbolization_Result is
   begin
      return Result : Symbolization_Result
        (Success => True, Size => Name'Length)
      do
         for I in 1 .. Result.Size loop
            Result.Symbol (I) := To_Lower (Name (Name'First + I - 1));
         end loop;
      end return;
   end Fold_Case;

end Gpr_Parser_Support.Symbols;
