ghdl 0.29 release.

1 files changed, 669 insertions, 0 deletions

diff --git a/parse_psl.adb b/parse_psl.adb
new file mode 100644
index 0000000..ab5df96
--- /dev/null
+++ b/parse_psl.adb
@@ -0,0 +1,669 @@
+--  VHDL PSL parser.
+--  Copyright (C) 2009 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with PSL.Nodes; use PSL.Nodes;
+with Iirs;
+with Scan; use Scan;
+with PSL.Errors; use PSL.Errors;
+with PSL.Priorities; use PSL.Priorities;
+with Parse;
+
+package body Parse_Psl is
+   procedure Scan renames Scan.Scan;
+
+   function Create_Node_Loc (K : Nkind) return Node is
+      Res : Node;
+   begin
+      Res := PSL.Nodes.Create_Node (K);
+      Set_Location (Res, Get_Token_Location);
+      return Res;
+   end Create_Node_Loc;
+
+   function Parse_Number return Node is
+      Res : Node;
+   begin
+      if Current_Token = Tok_Integer then
+         Res := Create_Node_Loc (N_Number);
+         --  FIXME: handle overflow.
+         Set_Value (Res, Uns32 (Current_Iir_Int64));
+         Scan;
+         return Res;
+      elsif Current_Token = Tok_Inf then
+         --  FIXME: create node
+         Scan;
+         return Null_Node;
+      else
+         Error_Msg_Parse ("number expected");
+         return Null_Node;
+      end if;
+   end Parse_Number;
+
+   procedure Parse_Count (N : Node) is
+   begin
+      Set_Low_Bound (N, Parse_Number);
+      if Current_Token = Tok_To then
+         Scan;
+         Set_High_Bound (N, Parse_Number);
+      end if;
+   end Parse_Count;
+
+   function Psl_To_Vhdl (N : Node) return Iirs.Iir
+   is
+      use Iirs;
+      Res : Iir;
+   begin
+      case Get_Kind (N) is
+         when N_HDL_Expr =>
+            Res := Iirs.Iir (Get_HDL_Node (N));
+            Free_Node (N);
+            return Res;
+         when others =>
+            Error_Kind ("psl_to_vhdl", N);
+      end case;
+   end Psl_To_Vhdl;
+
+   function Vhdl_To_Psl (N : Iirs.Iir) return Node
+   is
+      Res : Node;
+   begin
+      Res := Create_Node_Loc (N_HDL_Expr);
+      Set_Location (Res, Iirs.Get_Location (N));
+      Set_HDL_Node (Res, Int32 (N));
+      return Res;
+   end Vhdl_To_Psl;
+
+   function Parse_FL_Property (Prio : Priority) return Node;
+   function Parse_Sequence return Node;
+
+   function Parse_Parenthesis_Boolean return Node;
+   function Parse_Boolean (Parent_Prio : Priority) return Node;
+
+   function Parse_Unary_Boolean return Node is
+   begin
+      return Vhdl_To_Psl (Parse.Parse_Expression);
+   end Parse_Unary_Boolean;
+
+   function Parse_Boolean_Rhs (Parent_Prio : Priority; Left : Node) return Node
+   is
+      Kind : Nkind;
+      Prio : Priority;
+      Res : Node;
+      Tmp : Node;
+   begin
+      Res := Left;
+      loop
+         case Current_Token is
+            when Tok_And =>
+               Kind := N_And_Bool;
+               Prio := Prio_Seq_And;
+            when Tok_Or =>
+               Kind := N_Or_Bool;
+               Prio := Prio_Seq_Or;
+            when others =>
+               return Res;
+         end case;
+         if Parent_Prio >= Prio then
+            return Res;
+         end if;
+         Tmp := Create_Node_Loc (Kind);
+         Scan;
+         Set_Left (Tmp, Res);
+         Res := Tmp;
+         Tmp := Parse_Boolean (Prio);
+         Set_Right (Res, Tmp);
+      end loop;
+   end Parse_Boolean_Rhs;
+
+   function Parse_Boolean (Parent_Prio : Priority) return Node
+   is
+   begin
+      return Parse_Boolean_Rhs (Parent_Prio, Parse_Unary_Boolean);
+   end Parse_Boolean;
+
+   function Parse_Psl_Boolean return PSL_Node is
+   begin
+      return Parse_Boolean (Prio_Lowest);
+   end Parse_Psl_Boolean;
+
+   function Parse_Parenthesis_Boolean return Node is
+      Res : Node;
+   begin
+      if Current_Token /= Tok_Left_Paren then
+         Error_Msg_Parse ("'(' expected before boolean expression");
+         return Null_Node;
+      else
+         Scan;
+         Res := Parse_Psl_Boolean;
+         if Current_Token = Tok_Right_Paren then
+            Scan;
+         else
+            Error_Msg_Parse ("missing matching ')' for boolean expression");
+         end if;
+         return Res;
+      end if;
+   end Parse_Parenthesis_Boolean;
+
+   function Parse_SERE (Prio : Priority) return Node is
+      Left, Res : Node;
+      Kind : Nkind;
+      Op_Prio : Priority;
+   begin
+      Left := Parse_Sequence; --  FIXME: allow boolean;
+      loop
+         case Current_Token is
+            when Tok_Semi_Colon =>
+               Kind := N_Concat_SERE;
+               Op_Prio := Prio_Seq_Concat;
+            when Tok_Colon =>
+               Kind := N_Fusion_SERE;
+               Op_Prio := Prio_Seq_Fusion;
+            when Tok_Within =>
+               Kind := N_Within_SERE;
+               Op_Prio := Prio_Seq_Within;
+            when Tok_Ampersand =>
+               -- For non-length matching and, the operator is '&'.
+               Kind := N_And_Seq;
+               Op_Prio := Prio_Seq_And;
+            when Tok_And_And =>
+               Kind := N_Match_And_Seq;
+               Op_Prio := Prio_Seq_And;
+            when Tok_Bar =>
+               Kind := N_Or_Seq;
+               Op_Prio := Prio_Seq_Or;
+--              when Tok_Bar_Bar =>
+--                 Res := Create_Node_Loc (N_Or_Bool);
+--                 Scan;
+--                 Set_Left (Res, Left);
+--                 Set_Right (Res, Parse_Boolean (Prio_Seq_Or));
+--                 return Res;
+            when others =>
+               return Left;
+         end case;
+         if Prio >= Op_Prio then
+            return Left;
+         end if;
+         Res := Create_Node_Loc (Kind);
+         Scan;
+         Set_Left (Res, Left);
+         Set_Right (Res, Parse_SERE (Op_Prio));
+         Left := Res;
+      end loop;
+   end Parse_SERE;
+
+   --  precond: '{'
+   function Parse_Braced_SERE return Node is
+      Res : Node;
+   begin
+      if Current_Token /= Tok_Left_Curly then
+         raise Program_Error;
+      end if;
+      Res := Create_Node_Loc (N_Braced_SERE);
+      Scan;
+      Set_SERE (Res, Parse_SERE (Prio_Lowest));
+      if Current_Token /= Tok_Right_Curly then
+         Error_Msg_Parse ("missing '}' after braced SERE");
+      else
+         Scan;
+      end if;
+      return Res;
+   end Parse_Braced_SERE;
+
+   --  Parse [ Count ] ']'
+   function Parse_Maybe_Count (Kind : Nkind; Seq : Node) return Node is
+      N : Node;
+   begin
+      N := Create_Node_Loc (Kind);
+      Set_Sequence (N, Seq);
+      Scan;
+      if Current_Token /= Tok_Right_Bracket then
+         Parse_Count (N);
+      end if;
+      if Current_Token /= Tok_Right_Bracket then
+         Error_Msg_Parse ("missing ']'");
+      else
+         Scan;
+      end if;
+      return N;
+   end Parse_Maybe_Count;
+
+   procedure Parse_Bracket_Range (N : Node) is
+   begin
+      if Current_Token /= Tok_Left_Bracket then
+         Error_Msg_Parse ("'[' expected");
+      else
+         Scan;
+         Set_Low_Bound (N, Parse_Number);
+         if Current_Token /= Tok_To then
+            Error_Msg_Parse ("'to' expected in range after left bound");
+         else
+            Scan;
+            Set_High_Bound (N, Parse_Number);
+         end if;
+         if Current_Token /= Tok_Right_Bracket then
+            Error_Msg_Parse ("']' expected after range");
+         else
+            Scan;
+         end if;
+      end if;
+   end Parse_Bracket_Range;
+
+   function Parse_Bracket_Number return Node is
+      Res : Node;
+   begin
+      if Current_Token /= Tok_Left_Bracket then
+         Error_Msg_Parse ("'[' expected");
+         return Null_Node;
+      else
+         Scan;
+         Res := Parse_Number;
+         if Current_Token /= Tok_Right_Bracket then
+            Error_Msg_Parse ("']' expected after range");
+         else
+            Scan;
+         end if;
+         return Res;
+      end if;
+   end Parse_Bracket_Number;
+
+   function Parse_Sequence return Node is
+      Res, N : Node;
+   begin
+      case Current_Token is
+         when Tok_Left_Curly =>
+            Res := Parse_Braced_SERE;
+         when Tok_Brack_Star =>
+            return Parse_Maybe_Count (N_Star_Repeat_Seq, Null_Node);
+         when Tok_Left_Paren =>
+            Res := Parse_Parenthesis_Boolean;
+            if Current_Token = Tok_Or
+              or else Current_Token = Tok_And
+            then
+               Res := Parse_Boolean_Rhs (Prio_Lowest, Res);
+            end if;
+         when Tok_Brack_Plus_Brack =>
+            Res := Create_Node_Loc (N_Plus_Repeat_Seq);
+            Scan;
+            return Res;
+         when others =>
+            --  Repeated_SERE
+            Res := Parse_Unary_Boolean;
+      end case;
+      loop
+         case Current_Token is
+            when Tok_Brack_Star =>
+               Res := Parse_Maybe_Count (N_Star_Repeat_Seq, Res);
+            when Tok_Brack_Plus_Brack =>
+               N := Create_Node_Loc (N_Plus_Repeat_Seq);
+               Set_Sequence (N, Res);
+               Scan;
+               Res := N;
+            when Tok_Brack_Arrow =>
+               Res := Parse_Maybe_Count (N_Goto_Repeat_Seq, Res);
+            when Tok_Brack_Equal =>
+               N := Create_Node_Loc (N_Equal_Repeat_Seq);
+               Set_Sequence (N, Res);
+               Scan;
+               Parse_Count (N);
+               if Current_Token /= Tok_Right_Bracket then
+                  Error_Msg_Parse ("missing ']'");
+               else
+                  Scan;
+               end if;
+               Res := N;
+            when others =>
+               return Res;
+         end case;
+      end loop;
+   end Parse_Sequence;
+
+   --  precond:  '('
+   --  postcond: next token
+   function Parse_Parenthesis_FL_Property return Node is
+      Res : Node;
+      Loc : Location_Type;
+   begin
+      Loc := Get_Token_Location;
+      if Current_Token /= Tok_Left_Paren then
+         Error_Msg_Parse ("'(' expected around property");
+         return Parse_FL_Property (Prio_Lowest);
+      else
+         Scan;
+         Res := Parse_FL_Property (Prio_Lowest);
+         if Current_Token /= Tok_Right_Paren then
+            Error_Msg_Parse ("missing matching ')' for '(' at line "
+                               & Get_Location_Str (Loc, False));
+         else
+            Scan;
+         end if;
+         return Res;
+      end if;
+   end Parse_Parenthesis_FL_Property;
+
+   --  Parse [ '!' ] '[' finite_Range ']' '(' FL_Property ')'
+   function Parse_Range_Property (K : Nkind) return Node is
+      Res : Node;
+   begin
+      Res := Create_Node_Loc (K);
+      Set_Strong_Flag (Res, Scan_Exclam_Mark);
+      Scan;
+      Parse_Bracket_Range (Res);
+      Set_Property (Res, Parse_Parenthesis_FL_Property);
+      return Res;
+   end Parse_Range_Property;
+
+   --  Parse [ '!' ] '(' Boolean ')' '[' Range ']' '(' FL_Property ')'
+   function Parse_Boolean_Range_Property (K : Nkind) return Node is
+      Res : Node;
+   begin
+      Res := Create_Node_Loc (K);
+      Set_Strong_Flag (Res, Scan_Exclam_Mark);
+      Scan;
+      Set_Boolean (Res, Parse_Parenthesis_Boolean);
+      Parse_Bracket_Range (Res);
+      Set_Property (Res, Parse_Parenthesis_FL_Property);
+      return Res;
+   end Parse_Boolean_Range_Property;
+
+   function Parse_FL_Property_1 return Node
+   is
+      Res : Node;
+      Tmp : Node;
+   begin
+      case Current_Token is
+         when Tok_Always =>
+            Res := Create_Node_Loc (N_Always);
+            Scan;
+            Set_Property (Res, Parse_FL_Property (Prio_FL_Invariance));
+         when Tok_Never =>
+            Res := Create_Node_Loc (N_Never);
+            Scan;
+            Set_Property (Res, Parse_FL_Property (Prio_FL_Invariance));
+         when Tok_Eventually =>
+            Res := Create_Node_Loc (N_Eventually);
+            if not Scan_Exclam_Mark then
+               Error_Msg_Parse ("'eventually' must be followed by '!'");
+            end if;
+            Scan;
+            Set_Property (Res, Parse_FL_Property (Prio_FL_Occurence));
+         when Tok_Next =>
+            Res := Create_Node_Loc (N_Next);
+            Scan;
+            if Current_Token = Tok_Left_Bracket then
+               Set_Number (Res, Parse_Bracket_Number);
+               Set_Property (Res, Parse_Parenthesis_FL_Property);
+            else
+               Set_Property (Res, Parse_FL_Property (Prio_FL_Occurence));
+            end if;
+         when Tok_Next_A =>
+            Res := Parse_Range_Property (N_Next_A);
+         when Tok_Next_E =>
+            Res := Parse_Range_Property (N_Next_E);
+         when Tok_Next_Event =>
+            Res := Create_Node_Loc (N_Next_Event);
+            Scan;
+            Set_Boolean (Res, Parse_Parenthesis_Boolean);
+            if Current_Token = Tok_Left_Bracket then
+               Set_Number (Res, Parse_Bracket_Number);
+            end if;
+            Set_Property (Res, Parse_Parenthesis_FL_Property);
+         when Tok_Next_Event_A =>
+            Res := Parse_Boolean_Range_Property (N_Next_Event_A);
+         when Tok_Next_Event_E =>
+            Res := Parse_Boolean_Range_Property (N_Next_Event_E);
+         when Tok_Left_Paren =>
+            return Parse_Parenthesis_FL_Property;
+         when Tok_Left_Curly =>
+            Res := Parse_Sequence;
+            if Get_Kind (Res) = N_Braced_SERE
+              and then Current_Token = Tok_Left_Paren
+            then
+               --  FIXME: must check that RES is really a sequence
+               --  (and not a SERE).
+               Tmp := Create_Node_Loc (N_Overlap_Imp_Seq);
+               Set_Sequence (Tmp, Res);
+               Set_Property (Tmp, Parse_Parenthesis_FL_Property);
+               Res := Tmp;
+            end if;
+         when others =>
+            Res := Parse_Sequence;
+      end case;
+      return Res;
+   end Parse_FL_Property_1;
+
+   function Parse_St_Binary_FL_Property (K : Nkind; Left : Node) return Node is
+      Res : Node;
+   begin
+      Res := Create_Node_Loc (K);
+      Set_Strong_Flag (Res, Scan_Exclam_Mark);
+      Set_Inclusive_Flag (Res, Scan_Underscore);
+      Scan;
+      Set_Left (Res, Left);
+      Set_Right (Res, Parse_FL_Property (Prio_FL_Bounding));
+      return Res;
+   end Parse_St_Binary_FL_Property;
+
+   function Parse_Binary_FL_Property (K : Nkind; Left : Node; Prio : Priority)
+                                     return Node
+   is
+      Res : Node;
+   begin
+      Res := Create_Node_Loc (K);
+      Scan;
+      Set_Left (Res, Left);
+      Set_Right (Res, Parse_FL_Property (Prio));
+      return Res;
+   end Parse_Binary_FL_Property;
+
+   function Parse_FL_Property (Prio : Priority) return Node
+   is
+      Res : Node;
+      N : Node;
+   begin
+      Res := Parse_FL_Property_1;
+      loop
+         case Current_Token is
+            when Tok_Minus_Greater =>
+               if Prio > Prio_Bool_Imp then
+                  return Res;
+               end if;
+               N := Create_Node_Loc (N_Log_Imp_Prop);
+               Set_Left (N, Res);
+               Scan;
+               Set_Right (N, Parse_FL_Property (Prio_Bool_Imp));
+               Res := N;
+            when Tok_Bar_Arrow =>
+               if Prio > Prio_Seq_Imp then
+                  return Res;
+               end if;
+               N := Create_Node_Loc (N_Overlap_Imp_Seq);
+               Set_Sequence (N, Res);
+               Scan;
+               Set_Property (N, Parse_FL_Property (Prio_Seq_Imp));
+               Res := N;
+            when Tok_Bar_Double_Arrow =>
+               if Prio > Prio_Seq_Imp then
+                  return Res;
+               end if;
+               N := Create_Node_Loc (N_Imp_Seq);
+               Set_Sequence (N, Res);
+               Scan;
+               Set_Property (N, Parse_FL_Property (Prio_Seq_Imp));
+               Res := N;
+            when Tok_Abort =>
+               if Prio > Prio_FL_Abort then
+                  return Res;
+               end if;
+               N := Create_Node_Loc (N_Abort);
+               Set_Property (N, Res);
+               Scan;
+               Set_Boolean (N, Parse_Boolean (Prio_Lowest));
+               --  Left associative.
+               return N;
+            when Tok_Exclam_Mark =>
+               N := Create_Node_Loc (N_Strong);
+               Set_Property (N, Res);
+               Scan;
+               Res := N;
+            when Tok_Until =>
+               if Prio > Prio_FL_Bounding then
+                  return Res;
+               end if;
+               Res := Parse_St_Binary_FL_Property (N_Until, Res);
+            when Tok_Before =>
+               if Prio > Prio_FL_Bounding then
+                  return Res;
+               end if;
+               Res := Parse_St_Binary_FL_Property (N_Before, Res);
+            when Tok_Or =>
+               if Prio > Prio_Seq_Or then
+                  return Res;
+               end if;
+               Res := Parse_Binary_FL_Property (N_Or_Prop, Res, Prio_Seq_Or);
+            when Tok_And =>
+               if Prio > Prio_Seq_And then
+                  return Res;
+               end if;
+               Res := Parse_Binary_FL_Property (N_And_Prop, Res, Prio_Seq_And);
+            when Token_Relational_Operator_Type =>
+               return Vhdl_To_Psl
+                 (Parse.Parse_Relation_Rhs (Psl_To_Vhdl (Res)));
+            when Tok_Colon
+              | Tok_Bar
+              | Tok_Ampersand
+              | Tok_And_And =>
+               Error_Msg_Parse ("SERE operator '" & Image (Current_Token)
+                                  & "' is not allowed in property");
+               Scan;
+               N := Parse_FL_Property (Prio_Lowest);
+               return Res;
+            when Tok_Arobase =>
+               if Prio > Prio_Clock_Event then
+                  return Res;
+               end if;
+               N := Create_Node_Loc (N_Clock_Event);
+               Set_Property (N, Res);
+               Scan;
+               Set_Boolean (N, Parse_Boolean (Prio_Clock_Event));
+               Res := N;
+            when others =>
+               return Res;
+         end case;
+      end loop;
+   end Parse_FL_Property;
+
+   function Parse_Psl_Property return PSL_Node is
+   begin
+      return Parse_FL_Property (Prio_Lowest);
+   end Parse_Psl_Property;
+
+   --  precond:  identifier
+   --  postcond: ';'
+   --
+   --  6.2.4.1  Property declaration
+   --
+   --  Property_Declaration ::=
+   --     PROPERTY psl_identifier [ ( Formal_Parameter_List ) ] DEF_SYM
+   --        property ;
+   function Parse_Psl_Declaration (Tok : Token_Type) return PSL_Node
+   is
+      Res : Node;
+      Param : Node;
+      Last_Param : Node;
+      Pkind : Nkind;
+      Kind : Nkind;
+   begin
+      case Tok is
+         when Tok_Psl_Property =>
+            Kind := N_Property_Declaration;
+         when Tok_Psl_Sequence =>
+            Kind := N_Sequence_Declaration;
+         when Tok_Psl_Endpoint =>
+            Kind := N_Endpoint_Declaration;
+         when others =>
+            raise Internal_Error;
+      end case;
+      Res := Create_Node_Loc (Kind);
+      if Current_Token = Tok_Identifier then
+         Set_Identifier (Res, Current_Identifier);
+         Scan;
+      end if;
+
+      --  Formal parameter list.
+      if Current_Token = Tok_Left_Paren then
+         Last_Param := Null_Node;
+         loop
+            --  precond: '(' or ';'.
+            Scan;
+            case Current_Token is
+               when Tok_Psl_Const =>
+                  Pkind := N_Const_Parameter;
+               when Tok_Psl_Boolean =>
+                  Pkind := N_Boolean_Parameter;
+               when Tok_Psl_Property =>
+                  Pkind := N_Property_Parameter;
+               when Tok_Psl_Sequence =>
+                  Pkind := N_Sequence_Parameter;
+               when others =>
+                  Error_Msg_Parse ("parameter type expected");
+            end case;
+
+            --  Formal parameters.
+            loop
+               --  precond: parameter_type or ','
+               Scan;
+               Param := Create_Node_Loc (Pkind);
+               if Current_Token /= Tok_Identifier then
+                  Error_Msg_Parse ("identifier for parameter expected");
+               else
+                  Set_Identifier (Param, Current_Identifier);
+               end if;
+               if Last_Param = Null_Node then
+                  Set_Parameter_List (Res, Param);
+               else
+                  Set_Chain (Last_Param, Param);
+               end if;
+               Last_Param := Param;
+               Scan;
+               exit when Current_Token /= Tok_Comma;
+            end loop;
+            exit when Current_Token = Tok_Right_Paren;
+            if Current_Token /= Tok_Semi_Colon then
+               Error_Msg_Parse ("';' expected between formal parameter");
+            end if;
+
+         end loop;
+         Scan;
+      end if;
+
+      if Current_Token /= Tok_Is then
+         Error_Msg_Parse ("'is' expected after identifier");
+      else
+         Scan;
+      end if;
+      case Kind is
+         when N_Property_Declaration =>
+            Set_Property (Res, Parse_Psl_Property);
+         when N_Sequence_Declaration
+           | N_Endpoint_Declaration =>
+            Set_Sequence (Res, Parse_Sequence);
+         when others =>
+            raise Internal_Error;
+      end case;
+      return Res;
+   end Parse_Psl_Declaration;
+end Parse_Psl;