vhdl: add wildcard_psl_boolean. For #1387

6 files changed, 171 insertions, 126 deletions

diff --git a/src/vhdl/vhdl-sem_expr.adb b/src/vhdl/vhdl-sem_expr.adb
index 753a64429..8f1514eef 100644
--- a/src/vhdl/vhdl-sem_expr.adb
+++ b/src/vhdl/vhdl-sem_expr.adb
@@ -4952,7 +4952,8 @@ package body Vhdl.Sem_Expr is
                      return Wildcard_Psl_Bitvector_Type;
                   when Wildcard_Any_Access_Type
                      | Wildcard_Any_Integer_Type
-                     | Wildcard_Psl_Bit_Type =>
+                     | Wildcard_Psl_Bit_Type
+                     | Wildcard_Psl_Boolean_Type =>
                      return Null_Iir;
                end case;
             when Wildcard_Any_String_Type =>
@@ -4965,7 +4966,8 @@ package body Vhdl.Sem_Expr is
                      return Wildcard_Psl_Bitvector_Type;
                   when Wildcard_Any_Access_Type
                      | Wildcard_Any_Integer_Type
-                     | Wildcard_Psl_Bit_Type =>
+                     | Wildcard_Psl_Bit_Type
+                     | Wildcard_Psl_Boolean_Type =>
                      return Null_Iir;
                end case;
             when Wildcard_Any_Access_Type =>
@@ -4977,7 +4979,8 @@ package body Vhdl.Sem_Expr is
                      | Wildcard_Any_String_Type
                      | Wildcard_Any_Integer_Type
                      | Wildcard_Psl_Bit_Type
-                     | Wildcard_Psl_Bitvector_Type =>
+                     | Wildcard_Psl_Bitvector_Type
+                     | Wildcard_Psl_Boolean_Type =>
                      return Null_Iir;
                end case;
             when Wildcard_Any_Integer_Type =>
@@ -4989,6 +4992,7 @@ package body Vhdl.Sem_Expr is
                      | Wildcard_Any_Aggregate_Type
                      | Wildcard_Any_String_Type
                      | Wildcard_Psl_Bit_Type
+                     | Wildcard_Psl_Boolean_Type
                      | Wildcard_Psl_Bitvector_Type =>
                      return Null_Iir;
                end case;
@@ -5001,7 +5005,8 @@ package body Vhdl.Sem_Expr is
                      | Wildcard_Any_Aggregate_Type
                      | Wildcard_Any_String_Type
                      | Wildcard_Any_Integer_Type
-                     | Wildcard_Psl_Bitvector_Type =>
+                     | Wildcard_Psl_Bitvector_Type
+                     | Wildcard_Psl_Boolean_Type =>
                      return Null_Iir;
                end case;
             when Wildcard_Psl_Bitvector_Type =>
@@ -5013,7 +5018,22 @@ package body Vhdl.Sem_Expr is
                      return Wildcard_Psl_Bitvector_Type;
                   when Wildcard_Any_Access_Type
                      | Wildcard_Any_Integer_Type
-                     | Wildcard_Psl_Bit_Type =>
+                     | Wildcard_Psl_Bit_Type
+                     | Wildcard_Psl_Boolean_Type =>
+                     return Null_Iir;
+               end case;
+            when Wildcard_Psl_Boolean_Type =>
+               case Iir_Wildcard_Types (Atype) is
+                  when Wildcard_Any_Type
+                     | Wildcard_Psl_Boolean_Type =>
+                     return Wildcard_Psl_Boolean_Type;
+                  when Wildcard_Psl_Bit_Type =>
+                     return Wildcard_Psl_Bit_Type;
+                  when Wildcard_Any_Access_Type
+                     | Wildcard_Any_Aggregate_Type
+                     | Wildcard_Any_String_Type
+                     | Wildcard_Any_Integer_Type
+                     | Wildcard_Psl_Bitvector_Type =>
                      return Null_Iir;
                end case;
          end case;
@@ -5050,6 +5070,10 @@ package body Vhdl.Sem_Expr is
                if Sem_Psl.Is_Psl_Bitvector_Type (Atype) then
                   return Atype;
                end if;
+            when Wildcard_Psl_Boolean_Type =>
+               if Sem_Psl.Is_Psl_Boolean_Type (Atype) then
+                  return Atype;
+               end if;
          end case;
          return Null_Iir;
       end if;
@@ -5605,6 +5629,67 @@ package body Vhdl.Sem_Expr is
       return Res;
    end Insert_Condition_Operator;
 
+   function Sem_Condition_Pass2 (Cond : Iir) return Iir
+   is
+      Cond_Type : Iir;
+   begin
+      Cond_Type := Get_Type (Cond);
+      if Cond_Type = Null_Iir then
+         --  Error.
+         return Cond;
+      end if;
+
+      if not Is_Overload_List (Cond_Type) then
+         --  Only one result.  Operator "??" is not applied if the result
+         --  is of type boolean.
+         if Are_Types_Compatible (Cond_Type, Boolean_Type_Definition)
+           /= Not_Compatible
+         then
+            Check_Read (Cond);
+            return Cond;
+         end if;
+      else
+         --  Many interpretations.
+         declare
+            Res_List : constant Iir_List := Get_Overload_List (Cond_Type);
+            It : List_Iterator;
+            El : Iir;
+            Nbr_Booleans : Natural;
+            Res : Iir;
+         begin
+            Nbr_Booleans := 0;
+
+            --  Extract boolean interpretations.
+            It := List_Iterate (Res_List);
+            while Is_Valid (It) loop
+               El := Get_Element (It);
+               if Are_Types_Compatible (El, Boolean_Type_Definition)
+                 /= Not_Compatible
+               then
+                  Nbr_Booleans := Nbr_Booleans + 1;
+               end if;
+               Next (It);
+            end loop;
+
+            if Nbr_Booleans >= 1 then
+               --  There is one or more boolean interpretations: keep them.
+               --  In case of multiple boolean interpretations, an error
+               --  message will be generated.
+               Res := Sem_Expression_Ov (Cond, Boolean_Type_Definition);
+               Check_Read (Res);
+               return Res;
+            end if;
+         end;
+      end if;
+
+      --  LRM08 9.2.9
+      --  Otherwise, the condition operator is implicitely applied, and the
+      --  type of the expresion with the implicit application shall be
+      --  BOOLEAN defined in package STANDARD.
+
+      return Insert_Condition_Operator (Cond);
+   end Sem_Condition_Pass2;
+
    function Sem_Condition (Cond : Iir) return Iir
    is
       Res : Iir;
@@ -5632,58 +5717,10 @@ package body Vhdl.Sem_Expr is
 
          if Res = Null_Iir then
             --  Error occurred.
-            return Res;
-         end if;
-
-         if not Is_Overloaded (Res) then
-            --  Only one result.  Operator "??" is not applied if the result
-            --  is of type boolean.
-            if Are_Types_Compatible (Get_Type (Res), Boolean_Type_Definition)
-              /= Not_Compatible
-            then
-               Check_Read (Res);
-               return Res;
-            end if;
-         elsif Get_Type (Res) /= Null_Iir then
-            --  Many interpretations.
-            declare
-               Res_List : constant Iir_List :=
-                 Get_Overload_List (Get_Type (Res));
-               It : List_Iterator;
-               El : Iir;
-               Nbr_Booleans : Natural;
-            begin
-               Nbr_Booleans := 0;
-
-               --  Extract boolean interpretations.
-               It := List_Iterate (Res_List);
-               while Is_Valid (It) loop
-                  El := Get_Element (It);
-                  if Are_Types_Compatible (El, Boolean_Type_Definition)
-                    /= Not_Compatible
-                  then
-                     Nbr_Booleans := Nbr_Booleans + 1;
-                  end if;
-                  Next (It);
-               end loop;
-
-               if Nbr_Booleans >= 1 then
-                  --  There is one or more boolean interpretations: keep them.
-                  --  In case of multiple boolean interpretations, an error
-                  --  message will be generated.
-                  Res := Sem_Expression_Ov (Cond, Boolean_Type_Definition);
-                  Check_Read (Res);
-                  return Res;
-               end if;
-            end;
+            return Null_Iir;
          end if;
 
-         --  LRM08 9.2.9
-         --  Otherwise, the condition operator is implicitely applied, and the
-         --  type of the expresion with the implicit application shall be
-         --  BOOLEAN defined in package STANDARD.
-
-         return Insert_Condition_Operator (Res);
+         return Sem_Condition_Pass2 (Res);
       end if;
    end Sem_Condition;
 
diff --git a/src/vhdl/vhdl-sem_expr.ads b/src/vhdl/vhdl-sem_expr.ads
index 62fb6036a..f24ec159a 100644
--- a/src/vhdl/vhdl-sem_expr.ads
+++ b/src/vhdl/vhdl-sem_expr.ads
@@ -70,6 +70,7 @@ package Vhdl.Sem_Expr is
    --  In VHDL87 and 93, type of COND must be a boolean.
    --  A check is made that COND can be read.
    function Sem_Condition (Cond : Iir) return Iir;
+   function Sem_Condition_Pass2 (Cond : Iir) return Iir;
 
    --  Insert a call to condition operator.
    function Insert_Condition_Operator (Cond : Iir) return Iir;
diff --git a/src/vhdl/vhdl-sem_psl.adb b/src/vhdl/vhdl-sem_psl.adb
index da5eaa2a2..bcdce2239 100644
--- a/src/vhdl/vhdl-sem_psl.adb
+++ b/src/vhdl/vhdl-sem_psl.adb
@@ -17,7 +17,6 @@
 --  02111-1307, USA.
 
 with Types; use Types;
-with Std_Names;
 with Errorout; use Errorout;
 
 with PSL.Types; use PSL.Types;
@@ -45,7 +44,7 @@ package body Vhdl.Sem_Psl is
 
    --  Return TRUE iff Atype is a PSL boolean type.
    --  See PSL1.1 5.1.2  Boolean expressions
-   function Is_Psl_Bool_Type (Atype : Iir) return Boolean
+   function Is_Psl_Boolean_Type (Atype : Iir) return Boolean
    is
       Btype : Iir;
    begin
@@ -56,13 +55,13 @@ package body Vhdl.Sem_Psl is
       return Btype = Vhdl.Std_Package.Boolean_Type_Definition
         or else Btype = Vhdl.Std_Package.Bit_Type_Definition
         or else Btype = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Type;
-   end Is_Psl_Bool_Type;
+   end Is_Psl_Boolean_Type;
 
    --  Return TRUE if EXPR type is a PSL boolean type.
-   function Is_Psl_Bool_Expr (Expr : Iir) return Boolean is
+   function Is_Psl_Boolean_Expr (Expr : Iir) return Boolean is
    begin
-      return Is_Psl_Bool_Type (Get_Type (Expr));
-   end Is_Psl_Bool_Expr;
+      return Is_Psl_Boolean_Type (Get_Type (Expr));
+   end Is_Psl_Boolean_Expr;
 
    function Is_Psl_Bit_Type (Atype : Iir) return Boolean
    is
@@ -230,68 +229,67 @@ package body Vhdl.Sem_Psl is
    end Sem_Fell_Builtin;
 
    --  Convert VHDL and/or/not nodes to PSL nodes.
-   function Convert_Bool (Expr : Iir) return PSL_Node
+   function Convert_Bool (Expr : Iir) return PSL_Node;
+
+   function Convert_Bool_Dyadic_Operator (Expr : Iir; Kind : PSL.Nodes.Nkind)
+                                         return PSL_Node
    is
-      use Std_Names;
-      Impl : Iir;
+      Left  : constant Iir := Get_Left (Expr);
+      Right : constant Iir := Get_Right (Expr);
+      N : PSL_Node;
    begin
-      case Get_Kind (Expr) is
-         when Iir_Kinds_Dyadic_Operator =>
-            declare
-               Left : Iir;
-               Right : Iir;
+      if Is_Psl_Boolean_Expr (Left)
+        and then Is_Psl_Boolean_Expr (Right)
+      then
+         N := Create_Node (Kind);
+         Set_Location (N, Get_Location (Expr));
+         Set_Left (N, Convert_Bool (Left));
+         Set_Right (N, Convert_Bool (Right));
+         Free_Iir (Expr);
+         return N;
+      else
+         return Null_PSL_Node;
+      end if;
+   end Convert_Bool_Dyadic_Operator;
 
-               function Build_Op (Kind : Nkind) return PSL_Node
-               is
-                  N : PSL_Node;
-               begin
-                  N := Create_Node (Kind);
-                  Set_Location (N, Get_Location (Expr));
-                  Set_Left (N, Convert_Bool (Left));
-                  Set_Right (N, Convert_Bool (Right));
-                  Free_Iir (Expr);
-                  return N;
-               end Build_Op;
-            begin
-               Impl := Get_Implementation (Expr);
-               Left := Get_Left (Expr);
-               Right := Get_Right (Expr);
-               if Impl /= Null_Iir
-                 and then Is_Psl_Bool_Expr (Left)
-                 and then Is_Psl_Bool_Expr (Right)
-               then
-                  if Get_Identifier (Impl) = Name_And then
-                     return Build_Op (N_And_Bool);
-                  elsif Get_Identifier (Impl) = Name_Or then
-                     return Build_Op (N_Or_Bool);
-                  end if;
-               end if;
-            end;
-         when Iir_Kinds_Monadic_Operator =>
-            declare
-               Operand : Iir;
+   function Convert_Bool_Monadic_Operator (Expr : Iir; Kind : PSL.Nodes.Nkind)
+                                          return PSL_Node
+   is
+      Operand : constant Iir := Get_Operand (Expr);
+      N : PSL_Node;
+   begin
+      if Is_Psl_Boolean_Expr (Operand) then
+         N := Create_Node (Kind);
+         Set_Location (N, Get_Location (Expr));
+         Set_Boolean (N, Convert_Bool (Operand));
+         Free_Iir (Expr);
+         return N;
+      else
+         return Null_PSL_Node;
+      end if;
+   end Convert_Bool_Monadic_Operator;
 
-               function Build_Op (Kind : Nkind) return PSL_Node
-               is
-                  N : PSL_Node;
-               begin
-                  N := Create_Node (Kind);
-                  Set_Location (N, Get_Location (Expr));
-                  Set_Boolean (N, Convert_Bool (Operand));
-                  Free_Iir (Expr);
-                  return N;
-               end Build_Op;
-            begin
-               Impl := Get_Implementation (Expr);
-               Operand := Get_Operand (Expr);
-               if Impl /= Null_Iir
-                 and then Is_Psl_Bool_Expr (Operand)
-               then
-                  if Get_Identifier (Impl) = Name_Not then
-                     return Build_Op (N_Not_Bool);
-                  end if;
-               end if;
-            end;
+   --  Convert VHDL and/or/not nodes to PSL nodes.
+   function Convert_Bool (Expr : Iir) return PSL_Node
+   is
+      Res : PSL_Node;
+   begin
+      case Get_Kind (Expr) is
+         when Iir_Kind_And_Operator =>
+            Res := Convert_Bool_Dyadic_Operator (Expr, N_And_Bool);
+            if Res /= Null_PSL_Node then
+               return Res;
+            end if;
+         when Iir_Kind_Or_Operator =>
+            Res := Convert_Bool_Dyadic_Operator (Expr, N_Or_Bool);
+            if Res /= Null_PSL_Node then
+               return Res;
+            end if;
+         when Iir_Kind_Not_Operator =>
+            Res := Convert_Bool_Monadic_Operator (Expr, N_Not_Bool);
+            if Res /= Null_PSL_Node then
+               return Res;
+            end if;
          when Iir_Kinds_Name =>
             --  Get the named entity for names in order to hash it.
             declare
@@ -325,6 +323,7 @@ package body Vhdl.Sem_Psl is
       use Sem_Names;
 
       Expr : Iir;
+      Expr_Type : Iir;
       Name : Iir;
       Decl : PSL_Node;
       Res : PSL_Node;
@@ -388,14 +387,18 @@ package body Vhdl.Sem_Psl is
                Expr := Name_To_Expression (Expr, Null_Iir);
          end case;
       else
-         Expr := Sem_Expr.Sem_Expression (Expr, Null_Iir);
+         Expr := Sem_Expr.Sem_Expression_Wildcard
+           (Expr, Std_Package.Wildcard_Psl_Boolean_Type);
       end if;
 
       if Expr = Null_Iir then
          return N;
       end if;
       Free_Node (N);
-      if not Is_Psl_Bool_Expr (Expr) then
+      Expr_Type := Get_Type (Expr);
+      if not Is_Overload_List (Expr_Type)
+        and then not  Is_Psl_Boolean_Type (Expr_Type)
+      then
          Error_Msg_Sem (+Expr, "type of expression must be boolean");
          return PSL.Hash.Get_PSL_Node (HDL_Node (Expr), Get_Location (Expr));
       else
@@ -842,15 +845,15 @@ package body Vhdl.Sem_Psl is
    begin
       Res := Create_Iir (Iir_Kind_Concurrent_Assertion_Statement);
       Set_Location (Res, Get_Location (Stmt));
+
       Cond := Rewrite_As_Boolean_Expression (Get_Psl_Property (Stmt));
       if Get_Type (Cond) = Null_Iir then
          Cond := Sem_Expr.Sem_Condition (Cond);
-      elsif Get_Base_Type (Get_Type (Cond))
-        /= Vhdl.Std_Package.Boolean_Type_Definition
-      then
-         Cond := Sem_Expr.Insert_Condition_Operator (Cond);
+      else
+         Cond := Sem_Expr.Sem_Condition_Pass2 (Cond);
       end if;
       Cond := Eval_Expr_If_Static (Cond);
+
       Set_Assertion_Condition (Res, Cond);
       Set_Label (Res, Get_Label (Stmt));
       Set_Severity_Expression (Res, Get_Severity_Expression (Stmt));
diff --git a/src/vhdl/vhdl-sem_psl.ads b/src/vhdl/vhdl-sem_psl.ads
index 76088be99..47585980c 100644
--- a/src/vhdl/vhdl-sem_psl.ads
+++ b/src/vhdl/vhdl-sem_psl.ads
@@ -19,6 +19,7 @@
 with Vhdl.Nodes; use Vhdl.Nodes;
 
 package Vhdl.Sem_Psl is
+   function Is_Psl_Boolean_Type (Atype : Iir) return Boolean;
    function Is_Psl_Bit_Type (Atype : Iir) return Boolean;
    function Is_Psl_Bitvector_Type (Atype : Iir) return Boolean;
 
diff --git a/src/vhdl/vhdl-std_package.adb b/src/vhdl/vhdl-std_package.adb
index 1fc5fcd8a..c9d1ce938 100644
--- a/src/vhdl/vhdl-std_package.adb
+++ b/src/vhdl/vhdl-std_package.adb
@@ -114,6 +114,8 @@ package body Vhdl.Std_Package is
                         Wildcard_Psl_Bit_Type);
       Create_Known_Iir (Iir_Kind_Wildcard_Type_Definition,
                         Wildcard_Psl_Bitvector_Type);
+      Create_Known_Iir (Iir_Kind_Wildcard_Type_Definition,
+                        Wildcard_Psl_Boolean_Type);
    end Create_First_Nodes;
 
    procedure Create_Std_Standard_Package (Parent : Iir_Library_Declaration)
diff --git a/src/vhdl/vhdl-std_package.ads b/src/vhdl/vhdl-std_package.ads
index c066e919f..144dff066 100644
--- a/src/vhdl/vhdl-std_package.ads
+++ b/src/vhdl/vhdl-std_package.ads
@@ -181,10 +181,11 @@ package Vhdl.Std_Package is
    Wildcard_Any_Integer_Type   : constant Iir := 11;
    Wildcard_Psl_Bit_Type       : constant Iir := 12;
    Wildcard_Psl_Bitvector_Type : constant Iir := 13;
+   Wildcard_Psl_Boolean_Type   : constant Iir := 14;
 
    --  Subtype for all wildcard types, so that missing choice can be detected
    --  at compilation time.
-   subtype Iir_Wildcard_Types is Iir range 7 .. 13;
+   subtype Iir_Wildcard_Types is Iir range 7 .. 14;
 
    --  Chain of wildcard declarations, to own the nodes.
    Wildcard_Type_Declaration_Chain : Iir;