--  Create declarations for synthesis.
--  Copyright (C) 2017 Tristan Gingold
--
--  This file is part of GHDL.
--
--  This program is free software: you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation, either version 2 of the License, or
--  (at your option) any later version.
--
--  This program is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
--  You should have received a copy of the GNU General Public License
--  along with this program.  If not, see <gnu.org/licenses>.

with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Utils; use Vhdl.Utils;

with Elab.Vhdl_Values; use Elab.Vhdl_Values;
with Elab.Vhdl_Types; use Elab.Vhdl_Types;
with Elab.Vhdl_Files;
with Elab.Vhdl_Expr; use Elab.Vhdl_Expr;
with Elab.Vhdl_Insts;

with Synth.Vhdl_Expr; use Synth.Vhdl_Expr;
with Synth.Vhdl_Stmts; use Synth.Vhdl_Stmts;
with Synth.Vhdl_Decls;

package body Elab.Vhdl_Decls is
   procedure Elab_Subprogram_Declaration
     (Syn_Inst : Synth_Instance_Acc; Subprg : Node)
   is
      Inter : Node;
      Typ : Type_Acc;
   begin
      if Is_Second_Subprogram_Specification (Subprg) then
         --  Already handled.
         return;
      end if;

      Inter := Get_Interface_Declaration_Chain (Subprg);
      while Inter /= Null_Node loop
         Typ := Elab_Declaration_Type (Syn_Inst, Inter);
         Inter := Get_Chain (Inter);
      end loop;
      pragma Unreferenced (Typ);
   end Elab_Subprogram_Declaration;

   procedure Create_Signal (Syn_Inst : Synth_Instance_Acc;
                            Decl : Node;
                            Typ : Type_Acc)
   is
      Def : constant Iir := Get_Default_Value (Decl);
      Expr_Mark : Mark_Type;
      Init : Valtyp;
   begin
      pragma Assert (Typ.Is_Global);

      if Is_Valid (Def) then
         Mark_Expr_Pool (Expr_Mark);
         Init := Synth_Expression_With_Type (Syn_Inst, Def, Typ);
         Init := Exec_Subtype_Conversion (Init, Typ, False, Decl);
         Init := Unshare (Init, Instance_Pool);
         Release_Expr_Pool (Expr_Mark);
      else
         Init := No_Valtyp;
      end if;
      Create_Signal (Syn_Inst, Decl, Typ, Init.Val);
   end Create_Signal;

   procedure Elab_Signal_Declaration (Syn_Inst : Synth_Instance_Acc;
                                      Decl : Node)
   is
      Obj_Typ : Type_Acc;
   begin
      Obj_Typ := Elab_Declaration_Type (Syn_Inst, Decl);

      Create_Signal (Syn_Inst, Decl, Obj_Typ);
   end Elab_Signal_Declaration;

   procedure Elab_Variable_Declaration (Syn_Inst : Synth_Instance_Acc;
                                        Decl : Node;
                                        Force_Init : Boolean)
   is
      Def : constant Node := Get_Default_Value (Decl);
      Marker : Mark_Type;
      Init : Valtyp;
      Obj_Typ : Type_Acc;
   begin
      Obj_Typ := Elab_Declaration_Type (Syn_Inst, Decl);

      Mark_Expr_Pool (Marker);
      if Is_Valid (Def) then
         Init := Synth_Expression_With_Type (Syn_Inst, Def, Obj_Typ);
         Init := Exec_Subtype_Conversion (Init, Obj_Typ, False, Decl);
         Init := Unshare (Init, Instance_Pool);
         --  Note: Obj_Typ is bounded.
         Init.Typ := Obj_Typ;
      else
         --  Always create shared variables, as they might be referenced
         --  during elaboration.
         if (Force_Init or else Get_Shared_Flag (Decl)) then
            if Obj_Typ.Kind /= Type_Protected then
               Current_Pool := Instance_Pool;
               Init := Create_Value_Default (Obj_Typ);
               Current_Pool := Expr_Pool'Access;
            else
               Init := Synth.Vhdl_Decls.Create_Protected_Object
                 (Syn_Inst, Decl, Obj_Typ);
               Init := Unshare (Init, Instance_Pool);
            end if;
         else
            Init := (Typ => Obj_Typ, Val => null);
         end if;
      end if;
      Release_Expr_Pool (Marker);

      Create_Object (Syn_Inst, Decl, Init);
   end Elab_Variable_Declaration;

   procedure Elab_File_Declaration (Syn_Inst : Synth_Instance_Acc;
                                    Decl : Node)
   is
      F : File_Index;
      Res : Valtyp;
      Obj_Typ : Type_Acc;
   begin
      F := Elab.Vhdl_Files.Elaborate_File_Declaration (Syn_Inst, Decl);
      Obj_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Decl));
      Res := Create_Value_File (Obj_Typ, F, Instance_Pool);
      Create_Object (Syn_Inst, Decl, Res);
   end Elab_File_Declaration;

   procedure Elab_Free_Quantity_Declaration (Syn_Inst : Synth_Instance_Acc;
                                             Decl : Node)
   is
      Obj_Typ : Type_Acc;
      Res : Valtyp;
   begin
      Obj_Typ := Elab_Declaration_Type (Syn_Inst, Decl);
      Res := Create_Value_Quantity (Obj_Typ, No_Quantity_Index);
      Create_Object (Syn_Inst, Decl, Res);
   end Elab_Free_Quantity_Declaration;

   procedure Elab_Implicit_Signal_Declaration (Syn_Inst : Synth_Instance_Acc;
                                               Decl : Node)
   is
      Obj_Typ : Type_Acc;
   begin
      Obj_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Decl));
      Create_Signal (Syn_Inst, Decl, Obj_Typ, null);
   end Elab_Implicit_Signal_Declaration;

   procedure Elab_Implicit_Quantity_Declaration (Syn_Inst : Synth_Instance_Acc;
                                                 Decl : Node)
   is
      Obj_Typ : Type_Acc;
      Res : Valtyp;
   begin
      Obj_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Decl));
      Res := Create_Value_Quantity (Obj_Typ, No_Quantity_Index);
      Create_Object (Syn_Inst, Decl, Res);
   end Elab_Implicit_Quantity_Declaration;

   procedure Elab_Terminal_Declaration
     (Syn_Inst : Synth_Instance_Acc; Decl : Node)
   is
      Res : Valtyp;
   begin
      Res := Create_Value_Terminal (null, No_Terminal_Index);
      Create_Object (Syn_Inst, Decl, Res);
   end Elab_Terminal_Declaration;

   procedure Elab_Nature_Definition
     (Syn_Inst : Synth_Instance_Acc; Def : Node)
   is
      pragma Unreferenced (Syn_Inst);
   begin
      case Get_Kind (Def) is
         when Iir_Kind_Scalar_Nature_Definition =>
            null;
         when others =>
            Error_Kind ("elab_nature_definition", Def);
      end case;
   end Elab_Nature_Definition;

   procedure Elab_Attribute_Specification
     (Syn_Inst : Synth_Instance_Acc; Spec : Node)
   is
      Attr_Decl : constant Node :=
        Get_Named_Entity (Get_Attribute_Designator (Spec));
      Marker : Mark_Type;
      Value : Node;
      Val : Valtyp;
      Val_Type : Type_Acc;
   begin
      Mark_Expr_Pool (Marker);

      Val_Type := Get_Subtype_Object (Syn_Inst, Get_Type (Attr_Decl));
      Value := Get_Attribute_Value_Spec_Chain (Spec);
      while Value /= Null_Iir loop
         --  2. The expression is evaluated to determine the value
         --     of the attribute.
         --     It is an error if the value of the expression does not
         --     belong to the subtype of the attribute; if the
         --     attribute is of an array type, then an implicit
         --     subtype conversion is first performed on the value,
         --     unless the attribute's subtype indication denotes an
         --     unconstrained array type.
         Val := Synth_Expression_With_Type
           (Syn_Inst, Get_Expression (Spec), Val_Type);
         --  Check_Constraints (Instance, Val, Attr_Type, Decl);

         --  3. A new instance of the designated attribute is created
         --     and associated with each of the affected items.
         --
         --  4. Each new attribute instance is assigned the value of
         --     the expression.
         Val := Unshare (Val, Instance_Pool);
         Val.Typ := Unshare (Val.Typ, Instance_Pool);
         Create_Object (Syn_Inst, Value, Val);
         Release_Expr_Pool (Marker);

         Value := Get_Spec_Chain (Value);
      end loop;
   end Elab_Attribute_Specification;

   procedure Elab_Object_Alias_Declaration
     (Syn_Inst : Synth_Instance_Acc; Decl : Node)
   is
      Marker : Mark_Type;
      Off : Value_Offsets;
      Res : Valtyp;
      Obj_Typ : Type_Acc;
      Base : Valtyp;
      Typ : Type_Acc;
   begin
      Mark_Expr_Pool (Marker);

      if Get_Subtype_Indication (Decl) /= Null_Node then
         Obj_Typ := Elab_Declaration_Type (Syn_Inst, Decl);
      else
         Obj_Typ := null;
      end if;

      Synth_Assignment_Prefix (Syn_Inst, Get_Name (Decl), Base, Typ, Off);
      Typ := Unshare (Typ, Instance_Pool);
      Res := Create_Value_Alias (Base, Off, Typ, Expr_Pool'Access);
      if Obj_Typ /= null and then Obj_Typ.Kind not in Type_Scalars then
         --  Reshape bounds.
         Res := Exec_Subtype_Conversion (Res, Obj_Typ, True, Decl);
      end if;
      Res := Unshare (Res, Instance_Pool);
      Create_Object (Syn_Inst, Decl, Res);
      Release_Expr_Pool (Marker);
   end Elab_Object_Alias_Declaration;

   procedure Elab_Declaration (Syn_Inst : Synth_Instance_Acc;
                               Decl : Node;
                               Force_Init : Boolean;
                               Last_Type : in out Node)
   is
      use Synth.Vhdl_Decls;
   begin
      case Get_Kind (Decl) is
         when Iir_Kind_Variable_Declaration =>
            Elab_Variable_Declaration (Syn_Inst, Decl, Force_Init);
         --  when Iir_Kind_Interface_Variable_Declaration =>
         --     --  Ignore default value.
         --     Create_Wire_Object (Syn_Inst, Wire_Variable, Decl);
         --     Create_Var_Wire (Syn_Inst, Decl, No_Valtyp);
         when Iir_Kind_Constant_Declaration =>
            Synth_Constant_Declaration (Syn_Inst, Decl, False, Last_Type);
         when Iir_Kind_Signal_Declaration =>
            Elab_Signal_Declaration (Syn_Inst, Decl);
         when Iir_Kind_Object_Alias_Declaration =>
            Elab_Object_Alias_Declaration (Syn_Inst, Decl);
         when Iir_Kind_Procedure_Declaration
            | Iir_Kind_Function_Declaration =>
            Elab_Subprogram_Declaration (Syn_Inst, Decl);
         when Iir_Kind_Procedure_Body
            | Iir_Kind_Function_Body =>
            null;
         when Iir_Kind_Non_Object_Alias_Declaration =>
            null;
         when Iir_Kind_Attribute_Declaration =>
            --  Nothing to do: the type is a type_mark, not a subtype
            --  indication.
            null;
         when Iir_Kind_Attribute_Specification =>
            Elab_Attribute_Specification (Syn_Inst, Decl);
         when Iir_Kind_Type_Declaration =>
            declare
               Incomp : constant Node :=
                 Get_Incomplete_Type_Declaration (Decl);
               Def : constant Node := Get_Type_Definition (Decl);
            begin
               Elab_Type_Definition (Syn_Inst, Def);
               if Incomp /= Null_Node then
                  Elab_Incomplete_Type_Finish
                    (Syn_Inst, Get_Type_Definition (Incomp), Def);
               end if;
            end;
         when Iir_Kind_Anonymous_Type_Declaration =>
            Elab_Anonymous_Type_Definition
              (Syn_Inst, Get_Type_Definition (Decl),
               Get_Subtype_Definition (Decl));
         when Iir_Kind_Subtype_Declaration =>
            declare
               T : Type_Acc;
            begin
               T := Elab_Declaration_Type (Syn_Inst, Decl);
               pragma Unreferenced (T);
            end;
         when Iir_Kind_Component_Declaration =>
            null;
         when Iir_Kind_File_Declaration =>
            Elab_File_Declaration (Syn_Inst, Decl);

         when Iir_Kind_Package_Instantiation_Declaration =>
            Vhdl_Insts.Elab_Package_Instantiation (Syn_Inst, Decl);
         when Iir_Kind_Package_Instantiation_Body =>
            Vhdl_Insts.Elab_Package_Instantiation_Body (Syn_Inst, Decl);
         when Iir_Kind_Package_Declaration =>
            Vhdl_Insts.Elab_Package_Declaration (Syn_Inst, Decl);
         when Iir_Kind_Package_Body =>
            declare
               Spec : constant Node := Get_Package (Decl);
            begin
               Vhdl_Insts.Elab_Package_Body (Syn_Inst, Spec, Decl);
            end;

         when Iir_Kind_Protected_Type_Body =>
            null;
         when Iir_Kind_Psl_Default_Clock =>
            --  Ignored; directly used by PSL directives.
            null;
         when Iir_Kind_Use_Clause =>
            null;
         when Iir_Kind_Configuration_Specification =>
            null;
         when Iir_Kind_Attribute_Implicit_Declaration =>
            declare
               El : Node;
            begin
               El := Get_Attribute_Implicit_Chain (Decl);
               while El /= Null_Node loop
                  Elab_Declaration (Syn_Inst, El, Force_Init, Last_Type);
                  El := Get_Attr_Chain (El);
               end loop;
            end;
         when Iir_Kind_Nature_Declaration =>
            Elab_Nature_Definition (Syn_Inst, Get_Nature (Decl));
         when Iir_Kind_Free_Quantity_Declaration =>
            Elab_Free_Quantity_Declaration (Syn_Inst, Decl);
         when Iir_Kinds_Branch_Quantity_Declaration =>
            Elab_Implicit_Quantity_Declaration (Syn_Inst, Decl);
         when Iir_Kind_Above_Attribute =>
            Elab_Implicit_Signal_Declaration (Syn_Inst, Decl);
         when Iir_Kind_Dot_Attribute =>
            Elab_Implicit_Quantity_Declaration (Syn_Inst, Decl);
         when Iir_Kind_Terminal_Declaration =>
            Elab_Terminal_Declaration (Syn_Inst, Decl);
         when Iir_Kinds_Signal_Attribute =>
            Elab_Implicit_Signal_Declaration (Syn_Inst, Decl);
         when Iir_Kind_Disconnection_Specification =>
            null;

         when Iir_Kind_Group_Template_Declaration
           | Iir_Kind_Group_Declaration =>
            null;

         when others =>
            Vhdl.Errors.Error_Kind ("elab_declaration", Decl);
      end case;

      pragma Assert (Is_Expr_Pool_Empty);
   end Elab_Declaration;

   procedure Elab_Declarations (Syn_Inst : Synth_Instance_Acc;
                                Decls : Iir;
                                Force_Init : Boolean := False)
   is
      Decl : Node;
      Last_Type : Node;
   begin
      Last_Type := Null_Node;
      Decl := Decls;
      while Is_Valid (Decl) loop
         Elab_Declaration (Syn_Inst, Decl, Force_Init, Last_Type);

         exit when Is_Error (Syn_Inst);

         Decl := Get_Chain (Decl);
      end loop;
   end Elab_Declarations;

   procedure Finalize_Declaration
     (Syn_Inst : Synth_Instance_Acc; Decl : Node; Is_Subprg : Boolean)
   is
      pragma Unreferenced (Syn_Inst);
   begin
      case Get_Kind (Decl) is
         when Iir_Kind_Variable_Declaration
           | Iir_Kind_Interface_Variable_Declaration =>
            null;
         when Iir_Kind_Constant_Declaration =>
            null;
         when Iir_Kind_Signal_Declaration
            | Iir_Kind_Interface_Signal_Declaration =>
            pragma Assert (not Is_Subprg);
            null;
         when Iir_Kind_Object_Alias_Declaration =>
            null;
         when Iir_Kind_Procedure_Declaration
           | Iir_Kind_Function_Declaration =>
            null;
         when Iir_Kind_Procedure_Body
           | Iir_Kind_Function_Body =>
            null;
         when Iir_Kind_Non_Object_Alias_Declaration =>
            null;
         when Iir_Kind_Attribute_Declaration =>
            null;
         when Iir_Kind_Attribute_Specification =>
            null;
         when Iir_Kind_Type_Declaration =>
            null;
         when Iir_Kind_Anonymous_Type_Declaration =>
            null;
         when  Iir_Kind_Subtype_Declaration =>
            null;
         when Iir_Kind_Component_Declaration =>
            null;
         when Iir_Kind_File_Declaration =>
            null;
         when Iir_Kind_Configuration_Specification =>
            null;
         when Iir_Kind_Psl_Default_Clock =>
            --  Ignored; directly used by PSL directives.
            null;
         when Iir_Kind_Attribute_Implicit_Declaration =>
            --  Not supported by synthesis.
            null;
         when others =>
            Vhdl.Errors.Error_Kind ("finalize_declaration", Decl);
      end case;
   end Finalize_Declaration;

   procedure Finalize_Declarations (Syn_Inst : Synth_Instance_Acc;
                                    Decls : Iir;
                                    Is_Subprg : Boolean := False)
   is
      Decl : Iir;
   begin
      Decl := Decls;
      while Is_Valid (Decl) loop
         Finalize_Declaration (Syn_Inst, Decl, Is_Subprg);

         Decl := Get_Chain (Decl);
      end loop;
   end Finalize_Declarations;
end Elab.Vhdl_Decls;