parse_psl: Add property_to_sequence.

2 files changed, 102 insertions, 3 deletions

diff --git a/src/vhdl/parse_psl.adb b/src/vhdl/parse_psl.adb
index 9b66b444e..c9d5f38f1 100644
--- a/src/vhdl/parse_psl.adb
+++ b/src/vhdl/parse_psl.adb
@@ -536,6 +536,96 @@ package body Parse_Psl is
       return Res;
    end Parse_Binary_FL_Property;
 
+   --  During LR parsing, phrases before |-> and |=> are parsed as properties,
+   --  but they are in fact sequences.  Convert them (in particular the
+   --  boolean operators need to be rewritten).
+   function Property_To_Sequence (N : Node) return Node
+   is
+      procedure Rewrite_Binary (Res : Node; N : Node) is
+      begin
+         Set_Location (Res, Get_Location (N));
+         Set_Left (Res, Property_To_Sequence (Get_Left (N)));
+         Set_Right (Res, Property_To_Sequence (Get_Right (N)));
+         Free_Node (N);
+      end Rewrite_Binary;
+      Res : Node;
+   begin
+      case Get_Kind (N) is
+         when N_And_Prop =>
+            Res := Create_Node (N_And_Seq);
+            Rewrite_Binary (Res, N);
+            return Res;
+         when N_Or_Prop =>
+            Res := Create_Node (N_Or_Seq);
+            Rewrite_Binary (Res, N);
+            return Res;
+         when N_Before =>
+            Set_Left (N, Property_To_Sequence (Get_Left (N)));
+            Set_Right (N, Property_To_Sequence (Get_Right (N)));
+            return N;
+         when N_Clock_Event
+           | N_Always
+           | N_Never
+           | N_Eventually
+           | N_Until
+           | N_Property_Parameter
+           | N_Property_Instance
+           | N_Endpoint_Instance
+           | N_Strong
+           | N_Abort
+           | N_Next_Event_E
+           | N_Next_Event_A
+           | N_Next_Event
+           | N_Next_E
+           | N_Next_A
+           | N_Next
+           | N_Log_Imp_Prop =>
+            Error_Msg_Parse (+N, "construct not allowed in sequences");
+            return N;
+         when N_Const_Parameter
+           | N_Boolean_Parameter
+           | N_Sequence_Parameter
+           | N_Sequence_Instance
+           | N_Actual
+           | N_And_Seq
+           | N_Or_Seq
+           | N_Imp_Seq
+           | N_Overlap_Imp_Seq
+           | N_Match_And_Seq
+           | N_Star_Repeat_Seq
+           | N_Goto_Repeat_Seq
+           | N_Equal_Repeat_Seq
+           | N_Plus_Repeat_Seq
+           | N_Imp_Bool
+           | N_Or_Bool
+           | N_And_Bool
+           | N_Not_Bool
+           | N_Fusion_SERE
+           | N_HDL_Expr
+           | N_Hdl_Mod_Name
+           | N_Braced_SERE
+           | N_Concat_SERE
+           | N_Within_SERE
+           | N_Clocked_SERE
+           | N_False
+           | N_True
+           | N_Number
+           | N_Name_Decl
+           | N_Name
+           | N_EOS
+           | N_Error =>
+            return N;
+         when N_Vmode
+           | N_Vunit
+           | N_Vprop
+           | N_Assert_Directive
+           | N_Property_Declaration
+           | N_Sequence_Declaration
+           | N_Endpoint_Declaration =>
+            raise Internal_Error;
+      end case;
+   end Property_To_Sequence;
+
    function Parse_FL_Property (Prio : Priority) return Node
    is
       Res : Node;
@@ -558,7 +648,7 @@ package body Parse_Psl is
                   return Res;
                end if;
                N := Create_Node_Loc (N_Overlap_Imp_Seq);
-               Set_Sequence (N, Res);
+               Set_Sequence (N, Property_To_Sequence (Res));
                Scan;
                Set_Property (N, Parse_FL_Property (Prio_Seq_Imp));
                Res := N;
@@ -567,7 +657,7 @@ package body Parse_Psl is
                   return Res;
                end if;
                N := Create_Node_Loc (N_Imp_Seq);
-               Set_Sequence (N, Res);
+               Set_Sequence (N, Property_To_Sequence (Res));
                Scan;
                Set_Property (N, Parse_FL_Property (Prio_Seq_Imp));
                Res := N;
diff --git a/src/vhdl/psl-errors.ads b/src/vhdl/psl-errors.ads
index 88239a844..16aae7772 100644
--- a/src/vhdl/psl-errors.ads
+++ b/src/vhdl/psl-errors.ads
@@ -1,5 +1,6 @@
+with PSL.Nodes;
 with Types; use Types;
-with Errorout;
+with Errorout; use Errorout;
 with Files_Map;
 
 package PSL.Errors is
@@ -11,6 +12,14 @@ package PSL.Errors is
 
    procedure Error_Msg_Parse (Msg: String)
      renames Errorout.Error_Msg_Parse_1;
+
+   procedure Error_Msg_Parse
+     (Loc : Location_Type; Msg: String; Args : Earg_Arr := No_Eargs)
+     renames Errorout.Error_Msg_Parse;
+
    procedure Error_Msg_Sem (Msg: String; Loc: PSL_Node)
      renames Errorout.Error_Msg_Sem_1;
+
+   function "+" (N : PSL_Node) return Location_Type
+     renames PSL.Nodes.Get_Location;
 end PSL.Errors;