psl: can keep parenthesis during parse.

2 files changed, 105 insertions, 31 deletions

diff --git a/src/vhdl/vhdl-parse_psl.adb b/src/vhdl/vhdl-parse_psl.adb
index 13b3a2d02..630339c79 100644
--- a/src/vhdl/vhdl-parse_psl.adb
+++ b/src/vhdl/vhdl-parse_psl.adb
@@ -378,7 +378,19 @@ package body Vhdl.Parse_Psl is
          when Tok_Brack_Star =>
             return Parse_Maybe_Count (N_Star_Repeat_Seq, Null_Node);
          when Tok_Left_Paren =>
-            Res := Parse_Parenthesis_Boolean;
+            if Parse.Flag_Parse_Parenthesis then
+               Res := Create_Node_Loc (N_Paren_Bool);
+               --  Skip '('.
+               Scan;
+               Set_Boolean (Res, Parse_Psl_Boolean);
+               if Current_Token = Tok_Right_Paren then
+                  Scan;
+               else
+                  Error_Msg_Parse ("missing matching ')'");
+               end if;
+            else
+               Res := Parse_Parenthesis_Boolean;
+            end if;
             if Current_Token = Tok_Or
               or else Current_Token = Tok_And
             then
@@ -426,7 +438,9 @@ package body Vhdl.Parse_Psl is
 
    --  precond:  '('
    --  postcond: next token
-   function Parse_Parenthesis_FL_Property return Node is
+   function Parse_Parenthesis_FL_Property return Node
+   is
+      Prop : Node;
       Res : Node;
       Loc : Location_Type;
    begin
@@ -435,10 +449,15 @@ package body Vhdl.Parse_Psl is
          Error_Msg_Parse ("'(' expected around property");
          return Parse_FL_Property (Prio_Lowest);
       else
+         if Parse.Flag_Parse_Parenthesis then
+            Res := Create_Node_Loc (N_Paren_Prop);
+         end if;
+
          --  Skip '('.
          Scan;
 
-         Res := Parse_FL_Property (Prio_Lowest);
+         Prop := Parse_FL_Property (Prio_Lowest);
+
          if Current_Token = Tok_Right_Paren then
             --  Skip ')'.
             Scan;
@@ -447,16 +466,22 @@ package body Vhdl.Parse_Psl is
                                & Image (Loc, False));
          end if;
 
-         if Get_Kind (Res) = N_HDL_Expr then
+         if Get_Kind (Prop) = N_HDL_Expr then
             declare
                N : Vhdl_Node;
             begin
-               N := Psl_To_Vhdl (Res);
+               N := Psl_To_Vhdl (Prop);
                N := Parse.Parse_Binary_Expression (N, Parse.Prio_Expression);
-               Res := Vhdl_To_Psl (N);
+               Prop := Vhdl_To_Psl (N);
             end;
          end if;
-         return Res;
+
+         if Parse.Flag_Parse_Parenthesis then
+            Set_Property (Res, Prop);
+            return Res;
+         else
+            return Prop;
+         end if;
       end if;
    end Parse_Parenthesis_FL_Property;
 
@@ -618,7 +643,8 @@ package body Vhdl.Parse_Psl is
            | N_Next_E
            | N_Next_A
            | N_Next
-           | N_Log_Imp_Prop =>
+           | N_Log_Imp_Prop
+           | N_Paren_Prop =>
             Error_Msg_Parse (+N, "construct not allowed in sequences");
             return N;
          when N_Const_Parameter
@@ -639,6 +665,7 @@ package body Vhdl.Parse_Psl is
            | N_Or_Bool
            | N_And_Bool
            | N_Not_Bool
+           | N_Paren_Bool
            | N_Fusion_SERE
            | N_HDL_Expr
            | N_Hdl_Mod_Name
diff --git a/src/vhdl/vhdl-sem_psl.adb b/src/vhdl/vhdl-sem_psl.adb
index 767cd0c01..28541e7cc 100644
--- a/src/vhdl/vhdl-sem_psl.adb
+++ b/src/vhdl/vhdl-sem_psl.adb
@@ -251,7 +251,8 @@ package body Vhdl.Sem_Psl is
 
    --  Used by Sem_Property to rewrite a property logical operator to a
    --  boolean logical operator.
-   function Reduce_Logic_Node (Prop : Node; Bool_Kind : Nkind) return Node
+   function Reduce_Logic_Binary_Node (Prop : Node; Bool_Kind : Nkind)
+                                     return Node
    is
       Res : Node;
    begin
@@ -261,7 +262,19 @@ package body Vhdl.Sem_Psl is
       Set_Right (Res, Get_Right (Prop));
       Free_Node (Prop);
       return Res;
-   end Reduce_Logic_Node;
+   end Reduce_Logic_Binary_Node;
+
+   function Reduce_Logic_Unary_Node (Prop : Node; Bool_Kind : Nkind)
+                                    return Node
+   is
+      Res : Node;
+   begin
+      Res := Create_Node (Bool_Kind);
+      Set_Location (Res, Get_Location (Prop));
+      Set_Boolean (Res, Get_Property (Prop));
+      Free_Node (Prop);
+      return Res;
+   end Reduce_Logic_Unary_Node;
 
    function Sem_Sequence (Seq : Node) return Node
    is
@@ -352,7 +365,6 @@ package body Vhdl.Sem_Psl is
    function Sem_Property (Prop : Node; Top : Boolean := False) return Node
    is
       Res : Node;
-      L, R : Node;
    begin
       case Get_Kind (Prop) is
          when N_Braced_SERE =>
@@ -387,31 +399,49 @@ package body Vhdl.Sem_Psl is
          when N_Log_Imp_Prop
            | N_And_Prop
            | N_Or_Prop =>
-            L := Sem_Property (Get_Left (Prop));
-            Set_Left (Prop, L);
-            R := Sem_Property (Get_Right (Prop));
-            Set_Right (Prop, R);
-            if Get_Psl_Type (L) = Type_Boolean
-              and then Get_Psl_Type (R) = Type_Boolean
-            then
-               case Get_Kind (Prop) is
-                  when N_And_Prop =>
-                     return Reduce_Logic_Node (Prop, N_And_Bool);
-                  when N_Or_Prop =>
-                     return Reduce_Logic_Node (Prop, N_Or_Bool);
-                  when N_Log_Imp_Prop =>
-                     return Reduce_Logic_Node (Prop, N_Imp_Bool);
-                  when others =>
-                     Error_Kind ("psl.sem_property(log)", Prop);
-               end case;
-            end if;
-            return Prop;
+            declare
+               L, R : Node;
+            begin
+               L := Sem_Property (Get_Left (Prop));
+               Set_Left (Prop, L);
+               R := Sem_Property (Get_Right (Prop));
+               Set_Right (Prop, R);
+               if Get_Psl_Type (L) = Type_Boolean
+                 and then Get_Psl_Type (R) = Type_Boolean
+               then
+                  case Get_Kind (Prop) is
+                     when N_And_Prop =>
+                        return Reduce_Logic_Binary_Node (Prop, N_And_Bool);
+                     when N_Or_Prop =>
+                        return Reduce_Logic_Binary_Node (Prop, N_Or_Bool);
+                     when N_Log_Imp_Prop =>
+                        return Reduce_Logic_Binary_Node (Prop, N_Imp_Bool);
+                     when others =>
+                        Error_Kind ("psl.sem_property(log)", Prop);
+                  end case;
+               else
+                  return Prop;
+               end if;
+            end;
          when N_Overlap_Imp_Seq
            | N_Imp_Seq =>
             Res := Sem_Sequence (Get_Sequence (Prop));
             Set_Sequence (Prop, Res);
             Sem_Property (Prop);
             return Prop;
+         when N_Paren_Prop =>
+            declare
+               Op : Node;
+            begin
+               Op := Get_Property (Prop);
+               Op := Sem_Property (Op);
+               Set_Property (Prop, Op);
+               if Get_Psl_Type (Op) = Type_Boolean then
+                  return Reduce_Logic_Unary_Node (Prop, N_Paren_Bool);
+               else
+                  return Prop;
+               end if;
+            end;
          when N_Next =>
             Sem_Number (Prop);
             Sem_Property (Prop);
@@ -588,6 +618,23 @@ package body Vhdl.Sem_Psl is
             return Rewrite_Dyadic_Operator (Prop, Iir_Kind_Or_Operator);
          when N_Not_Bool =>
             return Rewrite_Monadic_Operator (Prop, Iir_Kind_Not_Operator);
+         when N_Paren_Bool =>
+            declare
+               Expr : constant PSL_Node := Get_Boolean (Prop);
+               Hexpr : Iir;
+               Res : Iir;
+            begin
+               Res := Create_Iir (Iir_Kind_Parenthesis_Expression);
+               Set_Location (Res, Get_Location (Prop));
+               if Get_Kind (Expr) = N_HDL_Expr then
+                  Hexpr := Get_HDL_Node (Expr);
+                  Set_Expression (Res, Hexpr);
+                  Set_Type (Res, Get_Type (Hexpr));
+               else
+                  Set_Expression (Res, Rewrite_As_Boolean_Expression (Expr));
+               end if;
+               return Res;
+            end;
          when others =>
             Error_Kind ("rewrite_as_boolean_expression", Prop);
       end case;
@@ -623,7 +670,7 @@ package body Vhdl.Sem_Psl is
       case Get_Kind (Expr) is
          when N_HDL_Expr =>
             return True;
-         when N_And_Bool | N_Or_Bool | N_Not_Bool =>
+         when N_And_Bool | N_Or_Bool | N_Not_Bool | N_Paren_Bool =>
             return True;
          when others =>
             return False;