diff options
| -rw-r--r-- | src/vhdl/parse_psl.adb | 94 | ||||
| -rw-r--r-- | src/vhdl/psl-errors.ads | 11 |
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; |