vhdl 2008: handle all-sensitized processes, handle visibility for alias.

9 files changed, 178 insertions, 50 deletions

diff --git a/canon.adb b/canon.adb
index 7848c5a31..c4083456d 100644
--- a/canon.adb
+++ b/canon.adb
@@ -1570,6 +1570,14 @@ package body Canon is
                if Canon_Flag_Sequentials_Stmts then
                   Canon_Sequential_Stmts (Get_Sequential_Statement_Chain (El));
                end if;
+               if Canon_Flag_All_Sensitivity
+                 and then Canon_Flag_Sequentials_Stmts
+                 and then Get_Kind (El) = Iir_Kind_Sensitized_Process_Statement
+                 and then Get_Sensitivity_List (El) = Iir_List_All
+               then
+                  Set_Sensitivity_List
+                    (El, Canon_Extract_Process_Sensitivity (El));
+               end if;
 
             when Iir_Kind_Component_Instantiation_Statement =>
                declare
diff --git a/canon.ads b/canon.ads
index ca11ae723..0678e62ed 100644
--- a/canon.ads
+++ b/canon.ads
@@ -28,6 +28,10 @@ package Canon is
    --  If true, canon expressions.
    Canon_Flag_Expressions : Boolean := False;
 
+   --  If true, replace 'all' sensitivity list by the explicit list
+   --  (If true, Canon_Flag_Sequentials_Stmts must be true)
+   Canon_Flag_All_Sensitivity : Boolean := False;
+
    --  If true, operands of type array element of a concatenation operator
    --  are converted (by an aggregate) into array.
    Canon_Concatenation : Boolean := False;
diff --git a/iirs.adb b/iirs.adb
index c628e4038..a55fd5c00 100644
--- a/iirs.adb
+++ b/iirs.adb
@@ -7064,6 +7064,28 @@ package body Iirs is
       Set_Field2 (Target, Iir_List_To_Iir (List));
    end Set_Type_Marks_List;
 
+   procedure Check_Kind_For_Implicit_Alias_Flag (Target : Iir) is
+   begin
+      case Get_Kind (Target) is
+         when Iir_Kind_Non_Object_Alias_Declaration =>
+            null;
+         when others =>
+            Failed ("Implicit_Alias_Flag", Target);
+      end case;
+   end Check_Kind_For_Implicit_Alias_Flag;
+
+   function Get_Implicit_Alias_Flag (Decl : Iir) return Boolean is
+   begin
+      Check_Kind_For_Implicit_Alias_Flag (Decl);
+      return Get_Flag1 (Decl);
+   end Get_Implicit_Alias_Flag;
+
+   procedure Set_Implicit_Alias_Flag (Decl : Iir; Flag : Boolean) is
+   begin
+      Check_Kind_For_Implicit_Alias_Flag (Decl);
+      Set_Flag1 (Decl, Flag);
+   end Set_Implicit_Alias_Flag;
+
    procedure Check_Kind_For_Signature (Target : Iir) is
    begin
       case Get_Kind (Target) is
diff --git a/iirs.ads b/iirs.ads
index f2ced23cb..778dd200d 100644
--- a/iirs.ads
+++ b/iirs.ads
@@ -788,6 +788,10 @@ package Iirs is
    --
    --   Get/Set_Signature (Field5)
    --
+   -- Set when the alias was implicitely created (by Sem) because of an
+   -- explicit alias of a type.
+   --   Get/Set_Implicit_Alias_Flag (Flag1)
+   --
    --   Get/Set_Visible_Flag (Flag4)
    --
    --   Get/Set_Use_Flag (Flag6)
@@ -5447,6 +5451,10 @@ package Iirs is
    function Get_Type_Marks_List (Target : Iir) return Iir_List;
    procedure Set_Type_Marks_List (Target : Iir; List : Iir_List);
 
+   --  Field: Flag1
+   function Get_Implicit_Alias_Flag (Decl : Iir) return Boolean;
+   procedure Set_Implicit_Alias_Flag (Decl : Iir; Flag : Boolean);
+
    --  Field: Field5
    function Get_Signature (Target : Iir) return Iir;
    procedure Set_Signature (Target : Iir; Value : Iir);
diff --git a/sem_decls.adb b/sem_decls.adb
index 4ad015c2e..899a851e3 100644
--- a/sem_decls.adb
+++ b/sem_decls.adb
@@ -1237,9 +1237,15 @@ package body Sem_Decls is
       if not Valid_Interpretation (Interp) then
          return Null_Iir;
       end if;
-      if not Is_In_Current_Declarative_Region (Interp) then
+
+      if not Is_In_Current_Declarative_Region (Interp)
+        or else Is_Potentially_Visible (Interp)
+      then
+         --  Deferred and full declarations must be declared in the same
+         --  declarative region.
          return Null_Iir;
       end if;
+
       Deferred_Const := Get_Declaration (Interp);
       if Get_Kind (Deferred_Const) /= Iir_Kind_Constant_Declaration then
          return Null_Iir;
@@ -1920,6 +1926,7 @@ package body Sem_Decls is
          Set_Identifier (N_Alias, Get_Identifier (Decl));
          Set_Name (N_Alias, Decl);
          Set_Parent (N_Alias, Get_Parent (Alias));
+         Set_Implicit_Alias_Flag (N_Alias, True);
 
          Sem_Scopes.Add_Name (N_Alias);
          Set_Visible_Flag (N_Alias, True);
diff --git a/sem_expr.adb b/sem_expr.adb
index e29ce8796..26ad5af1a 100644
--- a/sem_expr.adb
+++ b/sem_expr.adb
@@ -1800,7 +1800,13 @@ package body Sem_Expr is
 
                --  The return type is known.
                --  Search for explicit subprogram.
-               if Flags.Flag_Explicit then
+
+               --  LRM08 12.4 Use clause
+               --  b) If two potentially visible declarations are homograph
+               --     and one is explicitly declared and the other is
+               --     implicitly declared, then the implicit declaration is not
+               --     made directly visible.
+               if Flags.Flag_Explicit or else Flags.Vhdl_Std >= Vhdl_08 then
                   Decl := Get_Explicit_Subprogram (Overload_List);
                   if Decl /= Null_Iir then
                      return Set_Uniq_Interpretation (Decl);
@@ -1811,7 +1817,10 @@ package body Sem_Expr is
                Error_Operator_Overload (Overload_List);
 
                --  Give an advice.
-               if not Flags.Flag_Explicit and not Explicit_Advice_Given then
+               if not Flags.Flag_Explicit
+                 and then not Explicit_Advice_Given
+                 and then Flags.Vhdl_Std < Vhdl_08
+               then
                   Decl := Get_Explicit_Subprogram (Overload_List);
                   if Decl /= Null_Iir then
                      Error_Msg_Sem
@@ -3716,7 +3725,7 @@ package body Sem_Expr is
                if not Valid_Interpretation
                  (Get_Next_Interpretation (Interpretation))
                then
-                  Decl := Get_Declaration (Interpretation);
+                  Decl := Get_Non_Alias_Declaration (Interpretation);
                   if A_Type /= Null_Iir and then A_Type = Get_Type (Decl) then
                      --  Free overload list of expr (if any), and expr.
                      Replace_Type (Expr, Null_Iir);
@@ -3744,7 +3753,7 @@ package body Sem_Expr is
                -- Store overloaded interpretation.
                List := Create_Iir_List;
                while Valid_Interpretation (Interpretation) loop
-                  Decl := Get_Declaration (Interpretation);
+                  Decl := Get_Non_Alias_Declaration (Interpretation);
                   Append_Element (List, Get_Type (Decl));
                   Interpretation := Get_Next_Interpretation (Interpretation);
                end loop;
diff --git a/sem_scopes.adb b/sem_scopes.adb
index b50d4c2c5..b81197de5 100644
--- a/sem_scopes.adb
+++ b/sem_scopes.adb
@@ -252,16 +252,21 @@ package body Sem_Scopes is
       return Interpretations.Table (Ni).Decl;
    end Get_Declaration;
 
-   function Get_Non_Alias_Declaration (Ni: Name_Interpretation_Type)
-                                      return Iir
+   function Strip_Non_Object_Alias (Decl : Iir) return Iir
    is
       Res : Iir;
    begin
-      Res := Get_Declaration (Ni);
+      Res := Decl;
       if Get_Kind (Res) = Iir_Kind_Non_Object_Alias_Declaration then
          Res := Get_Name (Res);
       end if;
       return Res;
+   end Strip_Non_Object_Alias;
+
+   function Get_Non_Alias_Declaration (Ni: Name_Interpretation_Type)
+                                      return Iir is
+   begin
+      return Strip_Non_Object_Alias (Get_Declaration (Ni));
    end Get_Non_Alias_Declaration;
 
    -- Pointer just past the last barrier_end in the scopes stack.
@@ -462,7 +467,8 @@ package body Sem_Scopes is
             return;
          end if;
 
-         -- Do not re-add a potential decl
+         --  Do not re-add a potential decl.  This handles cases like:
+         --  'use p.all; use p.all;'
          declare
             Inter: Name_Interpretation_Type := Current_Inter;
          begin
@@ -500,7 +506,6 @@ package body Sem_Scopes is
          declare
             Homograph : Name_Interpretation_Type;
             Prev_Homograph : Name_Interpretation_Type;
-            Current_Decl_Non_Alias : Iir;
 
             procedure Maybe_Save_And_Add_New_Interpretation is
             begin
@@ -548,10 +553,16 @@ package body Sem_Scopes is
             function Is_Implicit_Alias (D : Iir) return Boolean is
             begin
                return Get_Kind (D) = Iir_Kind_Non_Object_Alias_Declaration
-                 and then Get_Kind (Get_Name (D))
-                 in Iir_Kinds_Implicit_Subprogram_Declaration;
+                 and then Get_Implicit_Alias_Flag (D)
+                 and then (Get_Kind (Get_Name (D))
+                             in Iir_Kinds_Implicit_Subprogram_Declaration);
             end Is_Implicit_Alias;
 
+            procedure Replace_Current_Interpretation is
+            begin
+               Interpretations.Table (Current_Inter).Decl := Decl;
+            end Replace_Current_Interpretation;
+
             Decl_Hash : Iir_Int32;
             Hash : Iir_Int32;
          begin
@@ -624,19 +635,28 @@ package body Sem_Scopes is
                return;
 
             else
-               --  Added declaration DECL is made directly visible.
+               --  Added DECL was declared in the current declarative region.
 
                if not Is_Potentially_Visible (Homograph) then
-                  --  The homograph was also directly visible
+                  --  The homograph was also declared in that declarative
+                  --  region or in an inner one.
                   if Is_In_Current_Declarative_Region (Homograph) then
                      --  ... and was declared in the same region
 
+                     --  To sum up: at this point both DECL and CURRENT_DECL
+                     --  are overloadable, have the same profile (but may be
+                     --  aliases) and are declared in the same declarative
+                     --  region.
+
                      --  LRM08 12.3 Visibility
+                     --  LRM93 10.3 Visibility
                      --  Two declarations that occur immediately within
                      --  the same declarative regions [...] shall not be
                      --  homograph, unless exactely one of them is the
-                     --  implicit declaration of a predefined operation, or
-                     --  is an implicit alias of such implicit declaration.
+                     --  implicit declaration of a predefined operation,
+
+                     --  LRM08 12.3 Visibility
+                     --  or is an implicit alias of such implicit declaration.
                      --
                      --  GHDL: FIXME: 'implicit alias'
 
@@ -647,34 +667,67 @@ package body Sem_Scopes is
                      --  declarations have the same designator, [...]
                      --
                      --  LRM08 12.3 Visibility
-                     --  [...] and they denote differrent named entities,
+                     --  [...] and they denote different named entities,
                      --  and [...]
-                     if Flags.Vhdl_Std >= Vhdl_08 then
-                        if Is_Implicit_Alias (Decl) then
-                           --  Re-declaration of an implicit subprogram via
-                           --  an implicit alias is simply discarded.
-                           --  FIXME: implicit alias.
-                           return;
+                     declare
+                        Is_Decl_Implicit : Boolean;
+                        Is_Current_Decl_Implicit : Boolean;
+                     begin
+                        if Flags.Vhdl_Std >= Vhdl_08 then
+                           Is_Current_Decl_Implicit :=
+                             (Get_Kind (Current_Decl) in
+                                Iir_Kinds_Implicit_Subprogram_Declaration)
+                             or else Is_Implicit_Alias (Current_Decl);
+                           Is_Decl_Implicit :=
+                             (Get_Kind (Decl) in
+                                Iir_Kinds_Implicit_Subprogram_Declaration)
+                             or else Is_Implicit_Alias (Decl);
+
+                           --  If they denote the same entity, they aren't
+                           --  homograph.
+                           if Strip_Non_Object_Alias (Decl)
+                             = Strip_Non_Object_Alias (Current_Decl)
+                           then
+                              if Is_Current_Decl_Implicit
+                                and then not Is_Decl_Implicit
+                              then
+                                 --  They aren't homograph but DECL is stronger
+                                 --  (at it is not an implicit declaration)
+                                 --  than CURRENT_DECL
+                                 Replace_Current_Interpretation;
+                              end if;
+
+                              return;
+                           end if;
+
+                           if Is_Decl_Implicit
+                             and then not Is_Current_Decl_Implicit
+                           then
+                              --  Re-declaration of an implicit subprogram via
+                              --  an implicit alias is simply discarded.
+                              return;
+                           end if;
+                        else
+                           --  Can an implicit subprogram declaration appears
+                           --  after an explicit one in vhdl 93?  I don't
+                           --  think so.
+                           Is_Decl_Implicit :=
+                             (Get_Kind (Decl)
+                                in Iir_Kinds_Implicit_Subprogram_Declaration);
+                           Is_Current_Decl_Implicit :=
+                             (Get_Kind (Current_Decl)
+                                in Iir_Kinds_Implicit_Subprogram_Declaration);
                         end if;
 
-                        Current_Decl_Non_Alias :=
-                          Get_Non_Alias_Declaration (Homograph);
-                     else
-                        Current_Decl_Non_Alias := Current_Decl;
-                     end if;
-
-                     if Get_Kind (Current_Decl_Non_Alias)
-                       not in Iir_Kinds_Implicit_Subprogram_Declaration
-                     then
-                        Error_Msg_Sem
-                          ("redeclaration of " & Disp_Node (Current_Decl)
-                             & " defined at " & Disp_Location (Current_Decl),
-                           Decl);
-                        return;
-                     end if;
-
-                     --  FIXME: simply discard DECL if an *implicit* alias
-                     --  of the current declaration?
+                        if not (Is_Decl_Implicit xor Is_Current_Decl_Implicit)
+                        then
+                           Error_Msg_Sem
+                             ("redeclaration of " & Disp_Node (Current_Decl) &
+                                " defined at " & Disp_Location (Current_Decl),
+                              Decl);
+                           return;
+                        end if;
+                     end;
                   else
                      --  GHDL: hide directly visible declaration declared in
                      --  an outer region.
@@ -697,16 +750,18 @@ package body Sem_Scopes is
          end;
       end if;
 
-      -- The current interpretation and the new one are homograph.
+      --  The current interpretation and the new one aren't overloadable, ie
+      --  they are homograph (well almost).
+
       if Is_In_Current_Declarative_Region (Current_Inter) then
-         -- They are perhaps visible in the same declarative region.
+         --  They are perhaps visible in the same declarative region.
          if Is_Potentially_Visible (Current_Inter) then
             if Potentially then
-               -- LRM93 §10.4, item #2
-               -- Potentially visible declarations that have the same
-               -- designator are not made directly visible unless each of
-               -- them is either an enumeration literal specification or
-               -- the declaration of a subprogram.
+               --  LRM93 §10.4, item #2
+               --  Potentially visible declarations that have the same
+               --  designator are not made directly visible unless each of
+               --  them is either an enumeration literal specification or
+               --  the declaration of a subprogram.
                if Decl = Get_Declaration (Current_Inter) then
                   -- The rule applies only for distinct declaration.
                   -- This handles 'use p.all; use P.all;'.
@@ -715,6 +770,19 @@ package body Sem_Scopes is
                   raise Internal_Error;
                   return;
                end if;
+
+               --  LRM08 12.3 Visibility
+               --  Each of two declarations is said to be a homograph of the
+               --  other if and only if both declarations have the same
+               --  designator; and they denote different named entities, [...]
+               if Flags.Vhdl_Std >= Vhdl_08 then
+                  if Strip_Non_Object_Alias (Decl)
+                    = Strip_Non_Object_Alias (Current_Decl)
+                  then
+                     return;
+                  end if;
+               end if;
+
                Save_Current_Interpretation;
                Set_Interpretation (Ident, Conflict_Interpretation);
                return;
diff --git a/sem_scopes.ads b/sem_scopes.ads
index 161d99b6b..bf495b353 100644
--- a/sem_scopes.ads
+++ b/sem_scopes.ads
@@ -114,8 +114,9 @@ package Sem_Scopes is
      return Boolean;
    pragma Inline (Is_Potentially_Visible);
 
-   -- Return TRUE if INTER was made direclty visible in the current
-   -- declarative region.
+   --  Return TRUE if INTER was made direclty visible in the current
+   --  declarative region.  Note this is different from being declared in the
+   --  current declarative region because of use clauses.
    function Is_In_Current_Declarative_Region (Inter: Name_Interpretation_Type)
      return Boolean;
    pragma Inline (Is_In_Current_Declarative_Region);
diff --git a/translate/ghdldrv/ghdlsimul.adb b/translate/ghdldrv/ghdlsimul.adb
index a3f20ae69..27b1ce62c 100644
--- a/translate/ghdldrv/ghdlsimul.adb
+++ b/translate/ghdldrv/ghdlsimul.adb
@@ -70,6 +70,7 @@ package body Ghdlsimul is
       Canon.Canon_Flag_Add_Labels := True;
       Canon.Canon_Flag_Sequentials_Stmts := True;
       Canon.Canon_Flag_Expressions := True;
+      Canon.Canon_Flag_All_Sensitivity := True;
    end Compile_Init;
 
    procedure Compile_Elab