vhdl: parse subprogram instantiations. For #1470

1 files changed, 174 insertions, 86 deletions

diff --git a/src/vhdl/vhdl-parse.adb b/src/vhdl/vhdl-parse.adb
index 7ac389a13..885604414 100644
--- a/src/vhdl/vhdl-parse.adb
+++ b/src/vhdl/vhdl-parse.adb
@@ -79,6 +79,7 @@ package body Vhdl.Parse is
                                              First_Cond : Iir) return Iir;
    function Parse_Simultaneous_Case_Statement
      (Label : Name_Id; Loc : Location_Type; Expr : Iir) return Iir;
+   function Parse_Generic_Map_Aspect return Iir;
 
    --  Maximum number of nested parenthesis, before generating an error.
    Max_Parenthesis_Depth : constant Natural := 1000;
@@ -1997,10 +1998,20 @@ package body Vhdl.Parse is
       end if;
    end Parse_Subprogram_Designator;
 
+   --  Emit an error message is function declaration SUBPRG has no return
+   --  type mark.
+   procedure Check_Function_Specification (Subprg : Iir) is
+   begin
+      if Get_Return_Type_Mark (Subprg) = Null_Iir then
+         Error_Msg_Parse ("'return' expected");
+         Set_Return_Type_Mark (Subprg, Create_Error_Node);
+      end if;
+   end Check_Function_Specification;
+
    --  Precond: '(' or return or any
    --  Postcond: next token
    procedure Parse_Subprogram_Parameters_And_Return
-     (Subprg : Iir; Is_Func : Boolean)
+     (Subprg : Iir; Is_Func : Boolean; Required : Boolean)
    is
       Old : Iir;
       pragma Unreferenced (Old);
@@ -2049,9 +2060,8 @@ package body Vhdl.Parse is
               (Subprg, Parse_Type_Mark (Check_Paren => True));
          end if;
       else
-         if Is_Func then
-            Error_Msg_Parse ("'return' expected");
-            Set_Return_Type_Mark (Subprg, Create_Error_Node);
+         if Is_Func and Required then
+            Check_Function_Specification (Subprg);
          end if;
       end if;
    end Parse_Subprogram_Parameters_And_Return;
@@ -2128,7 +2138,7 @@ package body Vhdl.Parse is
       Parse_Subprogram_Designator (Subprg);
 
       Parse_Subprogram_Parameters_And_Return
-        (Subprg, Kind = Iir_Kind_Interface_Function_Declaration);
+        (Subprg, Kind = Iir_Kind_Interface_Function_Declaration, True);
 
       --  TODO: interface_subprogram_default
 
@@ -5326,6 +5336,7 @@ package body Vhdl.Parse is
            | Tok_Impure =>
             Decl := Parse_Subprogram_Declaration;
             if Decl /= Null_Iir
+              and then Get_Kind (Decl) in Iir_Kinds_Subprogram_Declaration
               and then Get_Subprogram_Body (Decl) /= Null_Iir
             then
                if Get_Kind (Parent) = Iir_Kind_Package_Declaration then
@@ -8022,6 +8033,141 @@ package body Vhdl.Parse is
       end loop;
    end Parse_Sequential_Statements;
 
+   procedure Parse_Subprogram_Body (Subprg : Iir; Is_Loc : Location_Type)
+   is
+      Kind : constant Iir_Kind := Get_Kind (Subprg);
+      Subprg_Body : Iir;
+      Begin_Loc, End_Loc : Location_Type;
+   begin
+      --  The body.
+      Set_Has_Body (Subprg, True);
+      if Kind = Iir_Kind_Function_Declaration then
+         Subprg_Body := Create_Iir (Iir_Kind_Function_Body);
+      else
+         Subprg_Body := Create_Iir (Iir_Kind_Procedure_Body);
+      end if;
+      Location_Copy (Subprg_Body, Subprg);
+
+      Set_Subprogram_Body (Subprg, Subprg_Body);
+      Set_Subprogram_Specification (Subprg_Body, Subprg);
+      Set_Chain (Subprg, Subprg_Body);
+
+      Parse_Declarative_Part (Subprg_Body, Subprg_Body);
+
+      --  Skip 'begin'.
+      Begin_Loc := Get_Token_Location;
+      Expect_Scan (Tok_Begin);
+
+      Set_Sequential_Statement_Chain
+        (Subprg_Body, Parse_Sequential_Statements (Subprg_Body));
+
+      --  Skip 'end'.
+      End_Loc := Get_Token_Location;
+      Expect_Scan (Tok_End);
+
+      if Flag_Elocations then
+         Create_Elocations (Subprg_Body);
+         Set_Is_Location (Subprg_Body, Is_Loc);
+         Set_Begin_Location (Subprg_Body, Begin_Loc);
+         Set_End_Location (Subprg_Body, End_Loc);
+      end if;
+
+      case Current_Token is
+         when Tok_Function =>
+            if Flags.Vhdl_Std = Vhdl_87 then
+               Error_Msg_Parse ("'function' not allowed here by vhdl 87");
+            end if;
+            if Kind = Iir_Kind_Procedure_Declaration then
+               Error_Msg_Parse ("'procedure' expected instead of 'function'");
+            end if;
+            Set_End_Has_Reserved_Id (Subprg_Body, True);
+
+            --  Skip 'function'.
+            Scan;
+
+         when Tok_Procedure =>
+            if Flags.Vhdl_Std = Vhdl_87 then
+               Error_Msg_Parse ("'procedure' not allowed here by vhdl 87");
+            end if;
+            if Kind = Iir_Kind_Function_Declaration then
+               Error_Msg_Parse ("'function' expected instead of 'procedure'");
+            end if;
+            Set_End_Has_Reserved_Id (Subprg_Body, True);
+
+            --  Skip 'procedure'
+            Scan;
+
+         when others =>
+            null;
+      end case;
+      case Current_Token is
+         when Tok_Identifier =>
+            Check_End_Name (Get_Identifier (Subprg), Subprg_Body);
+         when Tok_String =>
+            if Scan_To_Operator_Name (Get_Token_Location)
+              /= Get_Identifier (Subprg)
+            then
+               Error_Msg_Parse ("misspelling, %i expected", +Subprg);
+            end if;
+            Set_End_Has_Identifier (Subprg_Body, True);
+
+            --  Skip string.
+            Scan;
+
+         when others =>
+            null;
+      end case;
+      Scan_Semi_Colon_Declaration ("subprogram body");
+   end Parse_Subprogram_Body;
+
+   --  precond : NEW
+   --
+   --  LRM08 4.4 Subprogram instantiation declarations
+   --  subprogram_instantiation_declaration ::=
+   --    subprogram_kind designator IS
+   --      NEW uninstantiated_subprogram_name [ signature ]
+   --      [ generic_map_aspect ];
+   function Parse_Subprogram_Instantiation (Subprg : Iir) return Iir
+   is
+      Res : Iir;
+   begin
+      case Iir_Kinds_Subprogram_Declaration (Get_Kind (Subprg)) is
+         when Iir_Kind_Function_Declaration =>
+            Res := Create_Iir (Iir_Kind_Function_Instantiation_Declaration);
+            if Get_Has_Pure (Subprg) then
+               Error_Msg_Parse
+                 (+Subprg, "pure/impure not allowed for instantiations");
+            end if;
+            if Get_Return_Type_Mark (Subprg) /= Null_Iir then
+               Error_Msg_Parse
+                 (+Subprg, "return type not allowed for instantiations");
+            end if;
+         when Iir_Kind_Procedure_Declaration =>
+            Res := Create_Iir (Iir_Kind_Procedure_Instantiation_Declaration);
+      end case;
+      Location_Copy (Res, Subprg);
+      Set_Identifier (Res, Get_Identifier (Subprg));
+
+      if Get_Interface_Declaration_Chain (Subprg) /= Null_Iir then
+         Error_Msg_Parse
+           (+Subprg, "interfaces not allowed for instantiations");
+      end if;
+
+      --  Skip 'new'.
+      Scan;
+
+      Set_Uninstantiated_Subprogram_Name (Res, Parse_Signature_Name);
+
+      if Current_Token = Tok_Generic then
+         Set_Generic_Map_Aspect_Chain (Res, Parse_Generic_Map_Aspect);
+      end if;
+
+      --  Skip ';'.
+      Expect_Scan (Tok_Semi_Colon);
+
+      return Res;
+   end Parse_Subprogram_Instantiation;
+
    --  precond : PROCEDURE, FUNCTION, PURE or IMPURE.
    --  postcond: next token.
    --
@@ -8050,9 +8196,9 @@ package body Vhdl.Parse is
    function Parse_Subprogram_Declaration return Iir
    is
       Kind : Iir_Kind;
-      Subprg: Iir;
-      Subprg_Body : Iir;
-      Start_Loc, Is_Loc, Begin_Loc, End_Loc : Location_Type;
+      Subprg : Iir;
+      Gen : Iir;
+      Start_Loc, Is_Loc : Location_Type;
    begin
       --  Create the node.
       Start_Loc := Get_Token_Location;
@@ -8102,8 +8248,16 @@ package body Vhdl.Parse is
       --  Designator.
       Parse_Subprogram_Designator (Subprg);
 
+      if Current_Token = Tok_Generic then
+         --  Eat 'generic'
+         Scan;
+
+         Gen := Parse_Interface_List (Generic_Interface_List, Subprg);
+         Set_Generic_Chain (Subprg, Gen);
+      end if;
+
       Parse_Subprogram_Parameters_And_Return
-        (Subprg, Kind = Iir_Kind_Function_Declaration);
+        (Subprg, Kind = Iir_Kind_Function_Declaration, False);
 
       if Flag_Elocations then
          Create_Elocations (Subprg);
@@ -8115,96 +8269,30 @@ package body Vhdl.Parse is
             --  Skip 'is'.
             Is_Loc := Get_Token_Location;
             Scan;
+
+            if Current_Token = Tok_New then
+               return Parse_Subprogram_Instantiation (Subprg);
+            end if;
          when Tok_Begin =>
             Error_Msg_Parse ("missing 'is' before 'begin'");
             Is_Loc := Get_Token_Location;
          when others =>
+            if Kind = Iir_Kind_Function_Declaration then
+               Check_Function_Specification (Subprg);
+            end if;
+
             --  Skip ';'.
             Expect_Scan (Tok_Semi_Colon);
 
             return Subprg;
       end case;
 
-      --  The body.
-      Set_Has_Body (Subprg, True);
       if Kind = Iir_Kind_Function_Declaration then
-         Subprg_Body := Create_Iir (Iir_Kind_Function_Body);
-      else
-         Subprg_Body := Create_Iir (Iir_Kind_Procedure_Body);
-      end if;
-      Location_Copy (Subprg_Body, Subprg);
-
-      Set_Subprogram_Body (Subprg, Subprg_Body);
-      Set_Subprogram_Specification (Subprg_Body, Subprg);
-      Set_Chain (Subprg, Subprg_Body);
-
-      Parse_Declarative_Part (Subprg_Body, Subprg_Body);
-
-      --  Skip 'begin'.
-      Begin_Loc := Get_Token_Location;
-      Expect_Scan (Tok_Begin);
-
-      Set_Sequential_Statement_Chain
-        (Subprg_Body, Parse_Sequential_Statements (Subprg_Body));
-
-      --  Skip 'end'.
-      End_Loc := Get_Token_Location;
-      Expect_Scan (Tok_End);
-
-      if Flag_Elocations then
-         Create_Elocations (Subprg_Body);
-         Set_Is_Location (Subprg_Body, Is_Loc);
-         Set_Begin_Location (Subprg_Body, Begin_Loc);
-         Set_End_Location (Subprg_Body, End_Loc);
+         Check_Function_Specification (Subprg);
       end if;
 
-      case Current_Token is
-         when Tok_Function =>
-            if Flags.Vhdl_Std = Vhdl_87 then
-               Error_Msg_Parse ("'function' not allowed here by vhdl 87");
-            end if;
-            if Kind = Iir_Kind_Procedure_Declaration then
-               Error_Msg_Parse ("'procedure' expected instead of 'function'");
-            end if;
-            Set_End_Has_Reserved_Id (Subprg_Body, True);
-
-            --  Skip 'function'.
-            Scan;
-
-         when Tok_Procedure =>
-            if Flags.Vhdl_Std = Vhdl_87 then
-               Error_Msg_Parse ("'procedure' not allowed here by vhdl 87");
-            end if;
-            if Kind = Iir_Kind_Function_Declaration then
-               Error_Msg_Parse ("'function' expected instead of 'procedure'");
-            end if;
-            Set_End_Has_Reserved_Id (Subprg_Body, True);
-
-            --  Skip 'procedure'
-            Scan;
-
-         when others =>
-            null;
-      end case;
-      case Current_Token is
-         when Tok_Identifier =>
-            Check_End_Name (Get_Identifier (Subprg), Subprg_Body);
-         when Tok_String =>
-            if Scan_To_Operator_Name (Get_Token_Location)
-              /= Get_Identifier (Subprg)
-            then
-               Error_Msg_Parse ("misspelling, %i expected", +Subprg);
-            end if;
-            Set_End_Has_Identifier (Subprg_Body, True);
-
-            --  Skip string.
-            Scan;
-
-         when others =>
-            null;
-      end case;
-      Scan_Semi_Colon_Declaration ("subprogram body");
-
+      --  The body.
+      Parse_Subprogram_Body (Subprg, Is_Loc);
       return Subprg;
    end Parse_Subprogram_Declaration;