vhdl08: parse parameter reserved word.

6 files changed, 234 insertions, 104 deletions

diff --git a/src/ghdldrv/ghdlprint.adb b/src/ghdldrv/ghdlprint.adb
index 9df87930b..00fc9c25a 100644
--- a/src/ghdldrv/ghdlprint.adb
+++ b/src/ghdldrv/ghdlprint.adb
@@ -386,7 +386,8 @@ package body Ghdlprint is
                Disp_Reserved;
             when Tok_Protected =>
                Disp_Reserved;
-            when Tok_Context =>
+            when Tok_Context
+              | Tok_Parameter =>
                Disp_Reserved;
             when Tok_Across .. Tok_Tolerance =>
                Disp_Reserved;
diff --git a/src/std_names.adb b/src/std_names.adb
index 971effb08..253f844ad 100644
--- a/src/std_names.adb
+++ b/src/std_names.adb
@@ -155,6 +155,7 @@ package body Std_Names is
       Def ("protected", Name_Protected);
 
       Def ("context", Name_Context);
+      Def ("parameter", Name_Parameter);
 
       Def ("across", Name_Across);
       Def ("break", Name_Break);
@@ -451,7 +452,6 @@ package body Std_Names is
       Def ("notif0",       Name_Notif0);
       Def ("notif1",       Name_Notif1);
       Def ("output",       Name_Output);
-      Def ("parameter",    Name_Parameter);
       Def ("pmos",         Name_Pmos);
       Def ("posedge",      Name_Posedge);
       Def ("primitive",    Name_Primitive);
diff --git a/src/std_names.ads b/src/std_names.ads
index 431a8c7dd..70badeb34 100644
--- a/src/std_names.ads
+++ b/src/std_names.ads
@@ -170,13 +170,14 @@ package Std_Names is
 
    Name_Last_Vhdl00 :    constant Name_Id := Name_Protected;
    subtype Name_Id_Vhdl00_Reserved_Words is
-     Name_Id range Name_Protected .. Name_Protected;
+     Name_Id range Name_Protected .. Name_Last_Vhdl00;
 
    Name_Context :      constant Name_Id := Name_First_Keyword + 098;
+   Name_Parameter :    constant Name_Id := Name_First_Keyword + 099;
 
-   Name_Last_Vhdl08 :    constant Name_Id := Name_Context;
+   Name_Last_Vhdl08 :    constant Name_Id := Name_Parameter;
    subtype Name_Id_Vhdl08_Reserved_Words is
-     Name_Id range Name_Context .. Name_Context;
+     Name_Id range Name_Context .. Name_Last_Vhdl08;
 
    Name_First_Ams_Keyword : constant Name_Id := Name_Last_Vhdl08 + 1;
    Name_Across :         constant Name_Id := Name_First_Ams_Keyword + 000;
@@ -523,43 +524,42 @@ package Std_Names is
    Name_Notif0 :         constant Name_Id := Name_First_Verilog + 31;
    Name_Notif1 :         constant Name_Id := Name_First_Verilog + 32;
    Name_Output :         constant Name_Id := Name_First_Verilog + 33;
-   Name_Parameter :      constant Name_Id := Name_First_Verilog + 34;
-   Name_Pmos :           constant Name_Id := Name_First_Verilog + 35;
-   Name_Posedge :        constant Name_Id := Name_First_Verilog + 36;
-   Name_Primitive :      constant Name_Id := Name_First_Verilog + 37;
-   Name_Pull0 :          constant Name_Id := Name_First_Verilog + 38;
-   Name_Pull1 :          constant Name_Id := Name_First_Verilog + 39;
-   Name_Pulldown :       constant Name_Id := Name_First_Verilog + 40;
-   Name_Pullup :         constant Name_Id := Name_First_Verilog + 41;
-   Name_Reg :            constant Name_Id := Name_First_Verilog + 42;
-   Name_Repeat :         constant Name_Id := Name_First_Verilog + 43;
-   Name_Rcmos :          constant Name_Id := Name_First_Verilog + 44;
-   Name_Rnmos :          constant Name_Id := Name_First_Verilog + 45;
-   Name_Rpmos :          constant Name_Id := Name_First_Verilog + 46;
-   Name_Rtran :          constant Name_Id := Name_First_Verilog + 47;
-   Name_Rtranif0 :       constant Name_Id := Name_First_Verilog + 48;
-   Name_Rtranif1 :       constant Name_Id := Name_First_Verilog + 49;
-   Name_Small :          constant Name_Id := Name_First_Verilog + 50;
-   Name_Specify :        constant Name_Id := Name_First_Verilog + 51;
-   Name_Specparam :      constant Name_Id := Name_First_Verilog + 52;
-   Name_Strong0 :        constant Name_Id := Name_First_Verilog + 53;
-   Name_Strong1 :        constant Name_Id := Name_First_Verilog + 54;
-   Name_Supply0 :        constant Name_Id := Name_First_Verilog + 55;
-   Name_Supply1 :        constant Name_Id := Name_First_Verilog + 56;
-   Name_Tablex :         constant Name_Id := Name_First_Verilog + 57;
-   Name_Task :           constant Name_Id := Name_First_Verilog + 58;
-   Name_Tran :           constant Name_Id := Name_First_Verilog + 59;
-   Name_Tranif0 :        constant Name_Id := Name_First_Verilog + 60;
-   Name_Tranif1 :        constant Name_Id := Name_First_Verilog + 61;
-   Name_Tri :            constant Name_Id := Name_First_Verilog + 62;
-   Name_Tri0 :           constant Name_Id := Name_First_Verilog + 63;
-   Name_Tri1 :           constant Name_Id := Name_First_Verilog + 64;
-   Name_Trireg :         constant Name_Id := Name_First_Verilog + 65;
-   Name_Wand :           constant Name_Id := Name_First_Verilog + 66;
-   Name_Weak0 :          constant Name_Id := Name_First_Verilog + 67;
-   Name_Weak1 :          constant Name_Id := Name_First_Verilog + 68;
-   Name_Wire :           constant Name_Id := Name_First_Verilog + 69;
-   Name_Wor :            constant Name_Id := Name_First_Verilog + 70;
+   Name_Pmos :           constant Name_Id := Name_First_Verilog + 34;
+   Name_Posedge :        constant Name_Id := Name_First_Verilog + 35;
+   Name_Primitive :      constant Name_Id := Name_First_Verilog + 36;
+   Name_Pull0 :          constant Name_Id := Name_First_Verilog + 37;
+   Name_Pull1 :          constant Name_Id := Name_First_Verilog + 38;
+   Name_Pulldown :       constant Name_Id := Name_First_Verilog + 39;
+   Name_Pullup :         constant Name_Id := Name_First_Verilog + 40;
+   Name_Reg :            constant Name_Id := Name_First_Verilog + 41;
+   Name_Repeat :         constant Name_Id := Name_First_Verilog + 42;
+   Name_Rcmos :          constant Name_Id := Name_First_Verilog + 43;
+   Name_Rnmos :          constant Name_Id := Name_First_Verilog + 44;
+   Name_Rpmos :          constant Name_Id := Name_First_Verilog + 45;
+   Name_Rtran :          constant Name_Id := Name_First_Verilog + 46;
+   Name_Rtranif0 :       constant Name_Id := Name_First_Verilog + 47;
+   Name_Rtranif1 :       constant Name_Id := Name_First_Verilog + 48;
+   Name_Small :          constant Name_Id := Name_First_Verilog + 49;
+   Name_Specify :        constant Name_Id := Name_First_Verilog + 50;
+   Name_Specparam :      constant Name_Id := Name_First_Verilog + 51;
+   Name_Strong0 :        constant Name_Id := Name_First_Verilog + 52;
+   Name_Strong1 :        constant Name_Id := Name_First_Verilog + 53;
+   Name_Supply0 :        constant Name_Id := Name_First_Verilog + 54;
+   Name_Supply1 :        constant Name_Id := Name_First_Verilog + 55;
+   Name_Tablex :         constant Name_Id := Name_First_Verilog + 56;
+   Name_Task :           constant Name_Id := Name_First_Verilog + 57;
+   Name_Tran :           constant Name_Id := Name_First_Verilog + 58;
+   Name_Tranif0 :        constant Name_Id := Name_First_Verilog + 59;
+   Name_Tranif1 :        constant Name_Id := Name_First_Verilog + 60;
+   Name_Tri :            constant Name_Id := Name_First_Verilog + 61;
+   Name_Tri0 :           constant Name_Id := Name_First_Verilog + 62;
+   Name_Tri1 :           constant Name_Id := Name_First_Verilog + 63;
+   Name_Trireg :         constant Name_Id := Name_First_Verilog + 64;
+   Name_Wand :           constant Name_Id := Name_First_Verilog + 65;
+   Name_Weak0 :          constant Name_Id := Name_First_Verilog + 66;
+   Name_Weak1 :          constant Name_Id := Name_First_Verilog + 67;
+   Name_Wire :           constant Name_Id := Name_First_Verilog + 68;
+   Name_Wor :            constant Name_Id := Name_First_Verilog + 69;
    Name_Last_Verilog :   constant Name_Id := Name_Wor;
 
    --  Verilog Directives.
diff --git a/src/vhdl/parse.adb b/src/vhdl/parse.adb
index 4f3dcd658..115b603a0 100644
--- a/src/vhdl/parse.adb
+++ b/src/vhdl/parse.adb
@@ -63,6 +63,8 @@ package body Parse is
    procedure Parse_Concurrent_Statements (Parent : Iir);
    function Parse_Subprogram_Declaration return Iir;
    function Parse_Subtype_Indication (Name : Iir := Null_Iir) return Iir;
+   function Parse_Interface_List (Ctxt : Interface_Kind_Type; Parent : Iir)
+                                 return Iir;
    procedure Parse_Component_Specification (Res : Iir);
    function Parse_Binding_Indication return Iir_Binding_Indication;
    function Parse_Aggregate return Iir;
@@ -1458,6 +1460,172 @@ package body Parse is
       return Inter;
    end Parse_Interface_Package_Declaration;
 
+   --  Precond:  identifier or string
+   --  Postcond: next token
+   --
+   --  [ 2.1 ]
+   --  designator ::= identifier | operator_symbol
+   procedure Parse_Subprogram_Designator (Subprg : Iir) is
+   begin
+      if Current_Token = Tok_Identifier then
+         Set_Identifier (Subprg, Current_Identifier);
+         Set_Location (Subprg);
+      elsif Current_Token = Tok_String then
+         if Kind_In (Subprg, Iir_Kind_Procedure_Declaration,
+                     Iir_Kind_Interface_Procedure_Declaration)
+         then
+            --  LRM93 2.1
+            --  A procedure designator is always an identifier.
+            Error_Msg_Parse ("a procedure name must be an identifier");
+         end if;
+         --  LRM93 2.1
+         --  A function designator is either an identifier or an operator
+         --  symbol.
+         Set_Identifier (Subprg, Scan_To_Operator_Name (Get_Token_Location));
+         Set_Location (Subprg);
+      else
+         --  Just to display a parse error.
+         Expect (Tok_Identifier);
+      end if;
+
+      --  Eat designator (identifier or string).
+      Scan;
+   end Parse_Subprogram_Designator;
+
+   --  Precond: '(' or return or any
+   --  Postcond: next token
+   procedure Parse_Subprogram_Parameters_And_Return
+     (Subprg : Iir; Is_Func : Boolean)
+   is
+      Old : Iir;
+      pragma Unreferenced (Old);
+      Inters : Iir;
+   begin
+      if Current_Token = Tok_Parameter then
+         --  Eat 'parameter'
+         Scan;
+
+         if Current_Token /= Tok_Left_Paren then
+            Error_Msg_Parse
+              ("'parameter' must be followed by a list of parameters");
+         end if;
+      end if;
+
+      if Current_Token = Tok_Left_Paren then
+         --  Parse the interface declaration.
+         if Is_Func then
+            Inters := Parse_Interface_List
+              (Function_Parameter_Interface_List, Subprg);
+         else
+            Inters := Parse_Interface_List
+              (Procedure_Parameter_Interface_List, Subprg);
+         end if;
+         Set_Interface_Declaration_Chain (Subprg, Inters);
+      end if;
+
+      if Current_Token = Tok_Return then
+         if not Is_Func then
+            Error_Msg_Parse
+              ("'return' not allowed for a procedure", Cont => True);
+            Error_Msg_Parse
+              ("(remove return part or declare a function)");
+
+            --  Skip 'return'
+            Scan;
+
+            Old := Parse_Type_Mark;
+         else
+            --  Skip 'return'
+            Scan;
+
+            Set_Return_Type_Mark
+              (Subprg, Parse_Type_Mark (Check_Paren => True));
+         end if;
+      else
+         if Is_Func then
+            Error_Msg_Parse ("'return' expected");
+         end if;
+      end if;
+   end Parse_Subprogram_Parameters_And_Return;
+
+   --  Precond:  PROCEDURE, FUNCTION, PURE, IMPURE
+   --  Postcond: next token
+   --
+   --  LRM08 6.5.4 Interface subrpogram declarations
+   --  interface_subprogram_declaration ::=
+   --     interface_subprogram_specification
+   --        [ IS interface_subprogram_default ]
+   --
+   --  interface_subrpogram_specification ::=
+   --     interface_procedure_specification | interface_function_specification
+   --
+   --  interface_procedure_specification ::=
+   --     PROCEDURE designator
+   --     [ [ PARAMETER ] ( formal_parameter_list ) ]
+   --
+   --  interface_function_specification ::=
+   --     [ PURE | IMPURE ] FUNCTION designator
+   --       [ [ PARAMETER ] ( formal_parameter_list ) ] RETURN type_mark
+   --
+   --  interface_subprogram_default ::=
+   --     /subprogram/_name | <>
+   function Parse_Interface_Subprogram_Declaration return Iir
+   is
+      Kind : Iir_Kind;
+      Subprg: Iir;
+      Old : Iir;
+      pragma Unreferenced (Old);
+   begin
+      --  Create the node.
+      case Current_Token is
+         when Tok_Procedure =>
+            Kind := Iir_Kind_Interface_Procedure_Declaration;
+         when Tok_Function
+           | Tok_Pure
+           | Tok_Impure =>
+            Kind := Iir_Kind_Interface_Function_Declaration;
+         when others =>
+            raise Internal_Error;
+      end case;
+      Subprg := Create_Iir (Kind);
+      Set_Location (Subprg);
+
+      case Current_Token is
+         when Tok_Procedure =>
+            null;
+         when Tok_Function =>
+            --  LRM93 2.1
+            --  A function is impure if its specification contains the
+            --  reserved word IMPURE; otherwise it is said to be pure.
+            Set_Pure_Flag (Subprg, True);
+         when Tok_Pure
+           | Tok_Impure =>
+            Set_Pure_Flag (Subprg, Current_Token = Tok_Pure);
+            Set_Has_Pure (Subprg, True);
+            --  FIXME: what to do in case of error ??
+
+            --  Eat 'pure' or 'impure'.
+            Scan;
+
+            Expect (Tok_Function, "'function' must follow 'pure' or 'impure'");
+         when others =>
+            raise Internal_Error;
+      end case;
+
+      --  Eat 'procedure' or 'function'.
+      Scan;
+
+      --  Designator.
+      Parse_Subprogram_Designator (Subprg);
+
+      Parse_Subprogram_Parameters_And_Return
+        (Subprg, Kind = Iir_Kind_Interface_Function_Declaration);
+
+      --  TODO: interface_subprogram_default
+
+      return Subprg;
+   end Parse_Interface_Subprogram_Declaration;
+
    --  Precond : '('
    --  Postcond: next token
    --
@@ -1510,12 +1678,24 @@ package body Parse is
                end if;
                Inters := Create_Iir (Iir_Kind_Interface_Type_Declaration);
                Scan_Expect (Tok_Identifier,
-                            "am identifier is expected after 'type'");
+                            "an identifier is expected after 'type'");
                Set_Identifier (Inters, Current_Identifier);
                Set_Location (Inters);
 
                --  Skip identifier
                Scan;
+            when Tok_Procedure
+              | Tok_Pure
+              | Tok_Impure
+              | Tok_Function =>
+               if Ctxt /= Generic_Interface_List then
+                  Error_Msg_Parse
+                    ("subprogram interface only allowed in generic interface");
+               elsif Flags.Vhdl_Std < Vhdl_08 then
+                  Error_Msg_Parse
+                    ("subprogram interface not allowed before vhdl 08");
+               end if;
+               Inters := Parse_Interface_Subprogram_Declaration;
             when Tok_Right_Paren =>
                if Res = Null_Iir then
                   Error_Msg_Parse
@@ -1526,9 +1706,7 @@ package body Parse is
                end if;
                exit;
             when others =>
-               Error_Msg_Parse
-                 ("'signal', 'constant', 'variable', 'file' "
-                  & "or identifier expected");
+               Error_Msg_Parse ("interface declaration expected");
                --  Use a variable interface as a fall-back.
                Inters := Parse_Interface_Object_Declaration (Ctxt);
          end case;
@@ -1551,7 +1729,8 @@ package body Parse is
 
          case Current_Token is
             when Tok_Comma =>
-               Error_Msg_Parse ("';' expected instead of ','");
+               Error_Msg_Parse
+                 ("interfaces must be separated by ';' (found ',')");
             when Tok_Semi_Colon =>
                null;
             when others =>
@@ -6230,7 +6409,6 @@ package body Parse is
    function Parse_Subprogram_Declaration return Iir
    is
       Kind : Iir_Kind;
-      Inters : Iir;
       Subprg: Iir;
       Subprg_Body : Iir;
       Old : Iir;
@@ -6280,63 +6458,11 @@ package body Parse is
       --  Eat 'procedure' or 'function'.
       Scan;
 
-      if Current_Token = Tok_Identifier then
-         Set_Identifier (Subprg, Current_Identifier);
-         Set_Location (Subprg);
-      elsif Current_Token = Tok_String then
-         if Kind = Iir_Kind_Procedure_Declaration then
-            --  LRM93 2.1
-            --  A procedure designator is always an identifier.
-            Error_Msg_Parse ("a procedure name must be an identifier");
-         end if;
-         --  LRM93 2.1
-         --  A function designator is either an identifier or an operator
-         --  symbol.
-         Set_Identifier (Subprg, Scan_To_Operator_Name (Get_Token_Location));
-         Set_Location (Subprg);
-      else
-         --  Just to display a parse error.
-         Expect (Tok_Identifier);
-      end if;
-
-      --  Eat designator (identifier or string).
-      Scan;
-
-      if Current_Token = Tok_Left_Paren then
-         --  Parse the interface declaration.
-         if Kind = Iir_Kind_Function_Declaration then
-            Inters := Parse_Interface_List
-              (Function_Parameter_Interface_List, Subprg);
-         else
-            Inters := Parse_Interface_List
-              (Procedure_Parameter_Interface_List, Subprg);
-         end if;
-         Set_Interface_Declaration_Chain (Subprg, Inters);
-      end if;
-
-      if Current_Token = Tok_Return then
-         if Kind = Iir_Kind_Procedure_Declaration then
-            Error_Msg_Parse
-              ("'return' not allowed for a procedure", Cont => True);
-            Error_Msg_Parse
-              ("(remove return part or declare a function)");
-
-            --  Skip 'return'
-            Scan;
+      --  Designator.
+      Parse_Subprogram_Designator (Subprg);
 
-            Old := Parse_Type_Mark;
-         else
-            --  Skip 'return'
-            Scan;
-
-            Set_Return_Type_Mark
-              (Subprg, Parse_Type_Mark (Check_Paren => True));
-         end if;
-      else
-         if Kind = Iir_Kind_Function_Declaration then
-            Error_Msg_Parse ("'return' expected");
-         end if;
-      end if;
+      Parse_Subprogram_Parameters_And_Return
+        (Subprg, Kind = Iir_Kind_Function_Declaration);
 
       if Current_Token = Tok_Semi_Colon then
          return Subprg;
diff --git a/src/vhdl/tokens.adb b/src/vhdl/tokens.adb
index 97062b72b..a46edf017 100644
--- a/src/vhdl/tokens.adb
+++ b/src/vhdl/tokens.adb
@@ -351,6 +351,8 @@ package body Tokens is
          --  VHDL 08
          when Tok_Context =>
             return "context";
+         when Tok_Parameter =>
+            return "parameter";
 
          --  AMS-VHDL
          when Tok_Across =>
diff --git a/src/vhdl/tokens.ads b/src/vhdl/tokens.ads
index aaabaa650..ada8c899a 100644
--- a/src/vhdl/tokens.ads
+++ b/src/vhdl/tokens.ads
@@ -234,6 +234,7 @@ package Tokens is
 
    --  Added by vhdl 2008:
        Tok_Context,
+       Tok_Parameter,
 
    --  AMS reserved words
        Tok_Across,