aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/psl/psl-nodes.adb.in388
-rw-r--r--src/psl/psl-nodes_meta.adb1305
-rw-r--r--src/psl/psl-nodes_meta.adb.in76
-rw-r--r--src/psl/psl-nodes_meta.ads174
-rw-r--r--src/psl/psl-nodes_meta.ads.in65
5 files changed, 2008 insertions, 0 deletions
diff --git a/src/psl/psl-nodes.adb.in b/src/psl/psl-nodes.adb.in
new file mode 100644
index 000000000..775e1d911
--- /dev/null
+++ b/src/psl/psl-nodes.adb.in
@@ -0,0 +1,388 @@
+-- This is in fact -*- Ada -*-
+with Ada.Unchecked_Conversion;
+with GNAT.Table;
+with PSL.Errors;
+with PSL.Hash;
+with PSL.Nodes_Meta; use PSL.Nodes_Meta;
+
+package body PSL.Nodes is
+ -- Suppress the access check of the table base. This is really safe to
+ -- suppress this check because the table base cannot be null.
+ pragma Suppress (Access_Check);
+
+ -- Suppress the index check on the table.
+ -- Could be done during non-debug, since this may catch errors (reading
+ -- Null_Node.
+ --pragma Suppress (Index_Check);
+
+ type Format_Type is
+ (
+ Format_Short
+ );
+
+ -- Common fields are:
+ -- Flag1 : Boolean
+ -- Flag2 : Boolean
+ -- Flag3 : Boolean
+ -- Flag4 : Boolean
+ -- Flag5 : Boolean
+ -- Flag6 : Boolean
+ -- Nkind : Kind_Type
+ -- State1 : Bit2_Type
+ -- State2 : Bit2_Type
+ -- Location : Int32
+ -- Field1 : Node
+ -- Field2 : Node
+ -- Field3 : Node
+ -- Field4 : Node
+
+ -- Fields of Format_Short:
+ -- Field5 : Node
+ -- Field6 : Node
+
+ type State_Type is range 0 .. 3;
+ type Bit3_Type is range 0 .. 7;
+
+ type Node_Record is record
+ Kind : Nkind;
+ Flag1 : Boolean;
+ Flag2 : Boolean;
+ Flag3 : Boolean;
+ Flag4 : Boolean;
+ Flag5 : Boolean;
+ Flag6 : Boolean;
+ Flag7 : Boolean;
+ Flag8 : Boolean;
+ Flag9 : Boolean;
+ Flag10 : Boolean;
+ Flag11 : Boolean;
+ Flag12 : Boolean;
+ Flag13 : Boolean;
+ Flag14 : Boolean;
+ Flag15 : Boolean;
+ Flag16 : Boolean;
+ State1 : State_Type;
+ B3_1 : Bit3_Type;
+ Flag17 : Boolean;
+ Flag18 : Boolean;
+ Flag19 : Boolean;
+
+ Location : Int32;
+ Field1 : Node;
+ Field2 : Node;
+ Field3 : Node;
+ Field4 : Node;
+ Field5 : Node;
+ Field6 : Node;
+ end record;
+ pragma Pack (Node_Record);
+ for Node_Record'Size use 8 * 32;
+
+ package Nodet is new GNAT.Table
+ (Table_Component_Type => Node_Record,
+ Table_Index_Type => Node,
+ Table_Low_Bound => 1,
+ Table_Initial => 1024,
+ Table_Increment => 100);
+
+ Init_Node : constant Node_Record := (Kind => N_Error,
+ Flag1 => False,
+ Flag2 => False,
+ State1 => 0,
+ B3_1 => 0,
+ Location => 0,
+ Field1 => 0,
+ Field2 => 0,
+ Field3 => 0,
+ Field4 => 0,
+ Field5 => 0,
+ Field6 => 0,
+ others => False);
+
+ Free_Nodes : Node := Null_Node;
+
+
+ function Get_Last_Node return Node is
+ begin
+ return Nodet.Last;
+ end Get_Last_Node;
+
+ function Node_To_Uns32 is new Ada.Unchecked_Conversion
+ (Source => Node, Target => Uns32);
+
+ function Uns32_To_Node is new Ada.Unchecked_Conversion
+ (Source => Uns32, Target => Node);
+
+ function Node_To_Int32 is new Ada.Unchecked_Conversion
+ (Source => Node, Target => Int32);
+
+ function Int32_To_Node is new Ada.Unchecked_Conversion
+ (Source => Int32, Target => Node);
+
+ function Node_To_NFA is new Ada.Unchecked_Conversion
+ (Source => Node, Target => NFA);
+
+ function NFA_To_Node is new Ada.Unchecked_Conversion
+ (Source => NFA, Target => Node);
+
+ function Node_To_HDL_Node is new Ada.Unchecked_Conversion
+ (Source => Node, Target => HDL_Node);
+
+ function HDL_Node_To_Node is new Ada.Unchecked_Conversion
+ (Source => HDL_Node, Target => Node);
+
+ procedure Set_Kind (N : Node; K : Nkind) is
+ begin
+ Nodet.Table (N).Kind := K;
+ end Set_Kind;
+
+ function Get_Kind (N : Node) return Nkind is
+ begin
+ return Nodet.Table (N).Kind;
+ end Get_Kind;
+
+
+ procedure Set_Flag1 (N : Node; Flag : Boolean) is
+ begin
+ Nodet.Table (N).Flag1 := Flag;
+ end Set_Flag1;
+
+ function Get_Flag1 (N : Node) return Boolean is
+ begin
+ return Nodet.Table (N).Flag1;
+ end Get_Flag1;
+
+ procedure Set_Flag2 (N : Node; Flag : Boolean) is
+ begin
+ Nodet.Table (N).Flag2 := Flag;
+ end Set_Flag2;
+
+ function Get_Flag2 (N : Node) return Boolean is
+ begin
+ return Nodet.Table (N).Flag2;
+ end Get_Flag2;
+
+
+ procedure Set_State1 (N : Node; S : State_Type) is
+ begin
+ Nodet.Table (N).State1 := S;
+ end Set_State1;
+
+ function Get_State1 (N : Node) return State_Type is
+ begin
+ return Nodet.Table (N).State1;
+ end Get_State1;
+
+
+ function Get_Location (N : Node) return Location_Type is
+ begin
+ return Location_Type (Nodet.Table (N).Location);
+ end Get_Location;
+
+ procedure Set_Location (N : Node; Loc : Location_Type) is
+ begin
+ Nodet.Table (N).Location := Int32 (Loc);
+ end Set_Location;
+
+
+ procedure Set_Field1 (N : Node; V : Node) is
+ begin
+ Nodet.Table (N).Field1 := V;
+ end Set_Field1;
+
+ function Get_Field1 (N : Node) return Node is
+ begin
+ return Nodet.Table (N).Field1;
+ end Get_Field1;
+
+
+ procedure Set_Field2 (N : Node; V : Node) is
+ begin
+ Nodet.Table (N).Field2 := V;
+ end Set_Field2;
+
+ function Get_Field2 (N : Node) return Node is
+ begin
+ return Nodet.Table (N).Field2;
+ end Get_Field2;
+
+
+ function Get_Field3 (N : Node) return Node is
+ begin
+ return Nodet.Table (N).Field3;
+ end Get_Field3;
+
+ procedure Set_Field3 (N : Node; V : Node) is
+ begin
+ Nodet.Table (N).Field3 := V;
+ end Set_Field3;
+
+
+ function Get_Field4 (N : Node) return Node is
+ begin
+ return Nodet.Table (N).Field4;
+ end Get_Field4;
+
+ procedure Set_Field4 (N : Node; V : Node) is
+ begin
+ Nodet.Table (N).Field4 := V;
+ end Set_Field4;
+
+
+ function Get_Field5 (N : Node) return Node is
+ begin
+ return Nodet.Table (N).Field5;
+ end Get_Field5;
+
+ procedure Set_Field5 (N : Node; V : Node) is
+ begin
+ Nodet.Table (N).Field5 := V;
+ end Set_Field5;
+
+
+ function Get_Field6 (N : Node) return Node is
+ begin
+ return Nodet.Table (N).Field6;
+ end Get_Field6;
+
+ procedure Set_Field6 (N : Node; V : Node) is
+ begin
+ Nodet.Table (N).Field6 := V;
+ end Set_Field6;
+
+
+ function Get_Format (Kind : Nkind) return Format_Type;
+ pragma Unreferenced (Get_Format);
+
+ function Create_Node (Kind : Nkind) return Node
+ is
+ Res : Node;
+ begin
+ if Free_Nodes /= Null_Node then
+ Res := Free_Nodes;
+ Free_Nodes := Get_Field1 (Res);
+ else
+ Nodet.Increment_Last;
+ Res := Nodet.Last;
+ end if;
+ Nodet.Table (Res) := Init_Node;
+ Set_Kind (Res, Kind);
+ return Res;
+ end Create_Node;
+
+ procedure Free_Node (N : Node)
+ is
+ begin
+ Set_Kind (N, N_Error);
+ Set_Field1 (N, Free_Nodes);
+ Free_Nodes := N;
+ end Free_Node;
+
+ procedure Failed (Msg : String; N : Node)
+ is
+ begin
+ Errors.Error_Kind (Msg, N);
+ end Failed;
+
+ procedure Init is
+ begin
+ Nodet.Init;
+ if Create_Node (N_False) /= False_Node then
+ raise Internal_Error;
+ end if;
+ if Create_Node (N_True) /= True_Node then
+ raise Internal_Error;
+ end if;
+ if Create_Node (N_Number) /= One_Node then
+ raise Internal_Error;
+ end if;
+ Set_Value (One_Node, 1);
+ if Create_Node (N_EOS) /= EOS_Node then
+ raise Internal_Error;
+ end if;
+ Set_Hash (EOS_Node, 0);
+ PSL.Hash.Init;
+ end Init;
+
+ function Get_Psl_Type (N : Node) return PSL_Types is
+ begin
+ case Get_Kind (N) is
+ when N_And_Prop
+ | N_Or_Prop
+ | N_Log_Imp_Prop
+ | N_Always
+ | N_Never
+ | N_Eventually
+ | N_Next
+ | N_Next_E
+ | N_Next_A
+ | N_Next_Event
+ | N_Next_Event_A
+ | N_Next_Event_E
+ | N_Before
+ | N_Until
+ | N_Abort
+ | N_Strong
+ | N_Property_Parameter
+ | N_Property_Instance =>
+ return Type_Property;
+ when N_Braced_SERE
+ | N_Concat_SERE
+ | N_Fusion_SERE
+ | N_Within_SERE
+ | N_Overlap_Imp_Seq
+ | N_Imp_Seq
+ | N_And_Seq
+ | N_Or_Seq
+ | N_Match_And_Seq
+ | N_Star_Repeat_Seq
+ | N_Goto_Repeat_Seq
+ | N_Equal_Repeat_Seq
+ | N_Plus_Repeat_Seq
+ | N_Clock_Event
+ | N_Sequence_Instance
+ | N_Endpoint_Instance
+ | N_Sequence_Parameter =>
+ return Type_Sequence;
+ when N_Name =>
+ return Get_Psl_Type (Get_Decl (N));
+ when N_HDL_Expr =>
+ -- FIXME.
+ return Type_Boolean;
+ when N_Or_Bool
+ | N_And_Bool
+ | N_Not_Bool
+ | N_Imp_Bool
+ | N_False
+ | N_True
+ | N_Boolean_Parameter =>
+ return Type_Boolean;
+ when N_Number
+ | N_Const_Parameter =>
+ return Type_Numeric;
+ when N_Vmode
+ | N_Vunit
+ | N_Vprop
+ | N_Hdl_Mod_Name
+ | N_Assert_Directive
+ | N_Sequence_Declaration
+ | N_Endpoint_Declaration
+ | N_Property_Declaration
+ | N_Actual
+ | N_Name_Decl
+ | N_Error
+ | N_EOS =>
+ PSL.Errors.Error_Kind ("get_psl_type", N);
+ end case;
+ end Get_Psl_Type;
+
+ procedure Reference_Failed (Msg : String; N : Node) is
+ begin
+ Failed (Msg, N);
+ end Reference_Failed;
+ pragma Unreferenced (Reference_Failed);
+
+ -- Subprograms
+
+end PSL.Nodes;
+
diff --git a/src/psl/psl-nodes_meta.adb b/src/psl/psl-nodes_meta.adb
new file mode 100644
index 000000000..2ef5db9b0
--- /dev/null
+++ b/src/psl/psl-nodes_meta.adb
@@ -0,0 +1,1305 @@
+-- Meta description of nodes.
+-- Copyright (C) 2015 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.
+
+package body PSL.Nodes_Meta is
+ Fields_Type : constant array (Fields_Enum) of Types_Enum :=
+ (
+ Field_Identifier => Type_Name_Id,
+ Field_Label => Type_Name_Id,
+ Field_Chain => Type_Node,
+ Field_Instance => Type_Node,
+ Field_Prefix => Type_Node,
+ Field_Item_Chain => Type_Node,
+ Field_Property => Type_Node,
+ Field_String => Type_Node,
+ Field_SERE => Type_Node,
+ Field_Left => Type_Node,
+ Field_Right => Type_Node,
+ Field_Sequence => Type_Node,
+ Field_Strong_Flag => Type_Boolean,
+ Field_Inclusive_Flag => Type_Boolean,
+ Field_Low_Bound => Type_Node,
+ Field_High_Bound => Type_Node,
+ Field_Number => Type_Node,
+ Field_Value => Type_Uns32,
+ Field_Boolean => Type_Node,
+ Field_Decl => Type_Node,
+ Field_HDL_Node => Type_HDL_Node,
+ Field_Hash => Type_Uns32,
+ Field_Hash_Link => Type_Node,
+ Field_HDL_Index => Type_Int32,
+ Field_Presence => Type_PSL_Presence_Kind,
+ Field_NFA => Type_NFA,
+ Field_Parameter_List => Type_Node,
+ Field_Actual => Type_Node,
+ Field_Formal => Type_Node,
+ Field_Declaration => Type_Node,
+ Field_Association_Chain => Type_Node,
+ Field_Global_Clock => Type_Node
+ );
+
+ function Get_Field_Type (F : Fields_Enum) return Types_Enum is
+ begin
+ return Fields_Type (F);
+ end Get_Field_Type;
+
+ function Get_Field_Image (F : Fields_Enum) return String is
+ begin
+ case F is
+ when Field_Identifier =>
+ return "identifier";
+ when Field_Label =>
+ return "label";
+ when Field_Chain =>
+ return "chain";
+ when Field_Instance =>
+ return "instance";
+ when Field_Prefix =>
+ return "prefix";
+ when Field_Item_Chain =>
+ return "item_chain";
+ when Field_Property =>
+ return "property";
+ when Field_String =>
+ return "string";
+ when Field_SERE =>
+ return "sere";
+ when Field_Left =>
+ return "left";
+ when Field_Right =>
+ return "right";
+ when Field_Sequence =>
+ return "sequence";
+ when Field_Strong_Flag =>
+ return "strong_flag";
+ when Field_Inclusive_Flag =>
+ return "inclusive_flag";
+ when Field_Low_Bound =>
+ return "low_bound";
+ when Field_High_Bound =>
+ return "high_bound";
+ when Field_Number =>
+ return "number";
+ when Field_Value =>
+ return "value";
+ when Field_Boolean =>
+ return "boolean";
+ when Field_Decl =>
+ return "decl";
+ when Field_HDL_Node =>
+ return "hdl_node";
+ when Field_Hash =>
+ return "hash";
+ when Field_Hash_Link =>
+ return "hash_link";
+ when Field_HDL_Index =>
+ return "hdl_index";
+ when Field_Presence =>
+ return "presence";
+ when Field_NFA =>
+ return "nfa";
+ when Field_Parameter_List =>
+ return "parameter_list";
+ when Field_Actual =>
+ return "actual";
+ when Field_Formal =>
+ return "formal";
+ when Field_Declaration =>
+ return "declaration";
+ when Field_Association_Chain =>
+ return "association_chain";
+ when Field_Global_Clock =>
+ return "global_clock";
+ end case;
+ end Get_Field_Image;
+
+ function Get_Nkind_Image (K : Nkind) return String is
+ begin
+ case K is
+ when N_Error =>
+ return "error";
+ when N_Vmode =>
+ return "vmode";
+ when N_Vunit =>
+ return "vunit";
+ when N_Vprop =>
+ return "vprop";
+ when N_Hdl_Mod_Name =>
+ return "hdl_mod_name";
+ when N_Assert_Directive =>
+ return "assert_directive";
+ when N_Property_Declaration =>
+ return "property_declaration";
+ when N_Sequence_Declaration =>
+ return "sequence_declaration";
+ when N_Endpoint_Declaration =>
+ return "endpoint_declaration";
+ when N_Const_Parameter =>
+ return "const_parameter";
+ when N_Boolean_Parameter =>
+ return "boolean_parameter";
+ when N_Property_Parameter =>
+ return "property_parameter";
+ when N_Sequence_Parameter =>
+ return "sequence_parameter";
+ when N_Sequence_Instance =>
+ return "sequence_instance";
+ when N_Endpoint_Instance =>
+ return "endpoint_instance";
+ when N_Property_Instance =>
+ return "property_instance";
+ when N_Actual =>
+ return "actual";
+ when N_Clock_Event =>
+ return "clock_event";
+ when N_Always =>
+ return "always";
+ when N_Never =>
+ return "never";
+ when N_Eventually =>
+ return "eventually";
+ when N_Strong =>
+ return "strong";
+ when N_Imp_Seq =>
+ return "imp_seq";
+ when N_Overlap_Imp_Seq =>
+ return "overlap_imp_seq";
+ when N_Log_Imp_Prop =>
+ return "log_imp_prop";
+ when N_Next =>
+ return "next";
+ when N_Next_A =>
+ return "next_a";
+ when N_Next_E =>
+ return "next_e";
+ when N_Next_Event =>
+ return "next_event";
+ when N_Next_Event_A =>
+ return "next_event_a";
+ when N_Next_Event_E =>
+ return "next_event_e";
+ when N_Abort =>
+ return "abort";
+ when N_Until =>
+ return "until";
+ when N_Before =>
+ return "before";
+ when N_Or_Prop =>
+ return "or_prop";
+ when N_And_Prop =>
+ return "and_prop";
+ when N_Braced_SERE =>
+ return "braced_sere";
+ when N_Concat_SERE =>
+ return "concat_sere";
+ when N_Fusion_SERE =>
+ return "fusion_sere";
+ when N_Within_SERE =>
+ return "within_sere";
+ when N_Match_And_Seq =>
+ return "match_and_seq";
+ when N_And_Seq =>
+ return "and_seq";
+ when N_Or_Seq =>
+ return "or_seq";
+ when N_Star_Repeat_Seq =>
+ return "star_repeat_seq";
+ when N_Goto_Repeat_Seq =>
+ return "goto_repeat_seq";
+ when N_Plus_Repeat_Seq =>
+ return "plus_repeat_seq";
+ when N_Equal_Repeat_Seq =>
+ return "equal_repeat_seq";
+ when N_Not_Bool =>
+ return "not_bool";
+ when N_And_Bool =>
+ return "and_bool";
+ when N_Or_Bool =>
+ return "or_bool";
+ when N_Imp_Bool =>
+ return "imp_bool";
+ when N_HDL_Expr =>
+ return "hdl_expr";
+ when N_False =>
+ return "false";
+ when N_True =>
+ return "true";
+ when N_EOS =>
+ return "eos";
+ when N_Name =>
+ return "name";
+ when N_Name_Decl =>
+ return "name_decl";
+ when N_Number =>
+ return "number";
+ end case;
+ end Get_Nkind_Image;
+
+ function Get_Field_Attribute (F : Fields_Enum) return Field_Attribute is
+ begin
+ case F is
+ when Field_Identifier =>
+ return Attr_None;
+ when Field_Label =>
+ return Attr_None;
+ when Field_Chain =>
+ return Attr_Chain;
+ when Field_Instance =>
+ return Attr_None;
+ when Field_Prefix =>
+ return Attr_None;
+ when Field_Item_Chain =>
+ return Attr_None;
+ when Field_Property =>
+ return Attr_None;
+ when Field_String =>
+ return Attr_None;
+ when Field_SERE =>
+ return Attr_None;
+ when Field_Left =>
+ return Attr_None;
+ when Field_Right =>
+ return Attr_None;
+ when Field_Sequence =>
+ return Attr_None;
+ when Field_Strong_Flag =>
+ return Attr_None;
+ when Field_Inclusive_Flag =>
+ return Attr_None;
+ when Field_Low_Bound =>
+ return Attr_None;
+ when Field_High_Bound =>
+ return Attr_None;
+ when Field_Number =>
+ return Attr_None;
+ when Field_Value =>
+ return Attr_None;
+ when Field_Boolean =>
+ return Attr_None;
+ when Field_Decl =>
+ return Attr_None;
+ when Field_HDL_Node =>
+ return Attr_None;
+ when Field_Hash =>
+ return Attr_None;
+ when Field_Hash_Link =>
+ return Attr_None;
+ when Field_HDL_Index =>
+ return Attr_None;
+ when Field_Presence =>
+ return Attr_None;
+ when Field_NFA =>
+ return Attr_None;
+ when Field_Parameter_List =>
+ return Attr_None;
+ when Field_Actual =>
+ return Attr_None;
+ when Field_Formal =>
+ return Attr_None;
+ when Field_Declaration =>
+ return Attr_Ref;
+ when Field_Association_Chain =>
+ return Attr_None;
+ when Field_Global_Clock =>
+ return Attr_None;
+ end case;
+ end Get_Field_Attribute;
+
+ Fields_Of_Nodes : constant Fields_Array :=
+ (
+ -- N_Error
+ -- N_Vmode
+ Field_Identifier,
+ Field_Chain,
+ Field_Instance,
+ Field_Item_Chain,
+ -- N_Vunit
+ Field_Identifier,
+ Field_Chain,
+ Field_Instance,
+ Field_Item_Chain,
+ -- N_Vprop
+ Field_Identifier,
+ Field_Chain,
+ Field_Instance,
+ Field_Item_Chain,
+ -- N_Hdl_Mod_Name
+ Field_Identifier,
+ Field_Prefix,
+ -- N_Assert_Directive
+ Field_Label,
+ Field_Chain,
+ Field_String,
+ Field_Property,
+ Field_NFA,
+ -- N_Property_Declaration
+ Field_Identifier,
+ Field_Chain,
+ Field_Global_Clock,
+ Field_Property,
+ Field_Parameter_List,
+ -- N_Sequence_Declaration
+ Field_Identifier,
+ Field_Chain,
+ Field_Sequence,
+ Field_Parameter_List,
+ -- N_Endpoint_Declaration
+ Field_Identifier,
+ Field_Chain,
+ Field_Sequence,
+ Field_Parameter_List,
+ -- N_Const_Parameter
+ Field_Identifier,
+ Field_Chain,
+ Field_Actual,
+ -- N_Boolean_Parameter
+ Field_Identifier,
+ Field_Chain,
+ Field_Actual,
+ -- N_Property_Parameter
+ Field_Identifier,
+ Field_Chain,
+ Field_Actual,
+ -- N_Sequence_Parameter
+ Field_Identifier,
+ Field_Chain,
+ Field_Actual,
+ -- N_Sequence_Instance
+ Field_Declaration,
+ Field_Association_Chain,
+ -- N_Endpoint_Instance
+ Field_Declaration,
+ Field_Association_Chain,
+ -- N_Property_Instance
+ Field_Declaration,
+ Field_Association_Chain,
+ -- N_Actual
+ Field_Chain,
+ Field_Actual,
+ Field_Formal,
+ -- N_Clock_Event
+ Field_Property,
+ Field_Boolean,
+ -- N_Always
+ Field_Property,
+ -- N_Never
+ Field_Property,
+ -- N_Eventually
+ Field_Property,
+ -- N_Strong
+ Field_Property,
+ -- N_Imp_Seq
+ Field_Sequence,
+ Field_Property,
+ -- N_Overlap_Imp_Seq
+ Field_Sequence,
+ Field_Property,
+ -- N_Log_Imp_Prop
+ Field_Left,
+ Field_Right,
+ -- N_Next
+ Field_Strong_Flag,
+ Field_Number,
+ Field_Property,
+ -- N_Next_A
+ Field_Strong_Flag,
+ Field_Low_Bound,
+ Field_High_Bound,
+ Field_Property,
+ -- N_Next_E
+ Field_Strong_Flag,
+ Field_Low_Bound,
+ Field_High_Bound,
+ Field_Property,
+ -- N_Next_Event
+ Field_Strong_Flag,
+ Field_Number,
+ Field_Property,
+ Field_Boolean,
+ -- N_Next_Event_A
+ Field_Strong_Flag,
+ Field_Low_Bound,
+ Field_High_Bound,
+ Field_Property,
+ Field_Boolean,
+ -- N_Next_Event_E
+ Field_Strong_Flag,
+ Field_Low_Bound,
+ Field_High_Bound,
+ Field_Property,
+ Field_Boolean,
+ -- N_Abort
+ Field_Property,
+ Field_Boolean,
+ -- N_Until
+ Field_Strong_Flag,
+ Field_Inclusive_Flag,
+ Field_Left,
+ Field_Right,
+ -- N_Before
+ Field_Strong_Flag,
+ Field_Inclusive_Flag,
+ Field_Left,
+ Field_Right,
+ -- N_Or_Prop
+ Field_Left,
+ Field_Right,
+ -- N_And_Prop
+ Field_Left,
+ Field_Right,
+ -- N_Braced_SERE
+ Field_SERE,
+ -- N_Concat_SERE
+ Field_Left,
+ Field_Right,
+ -- N_Fusion_SERE
+ Field_Left,
+ Field_Right,
+ -- N_Within_SERE
+ Field_Left,
+ Field_Right,
+ -- N_Match_And_Seq
+ Field_Left,
+ Field_Right,
+ -- N_And_Seq
+ Field_Left,
+ Field_Right,
+ -- N_Or_Seq
+ Field_Left,
+ Field_Right,
+ -- N_Star_Repeat_Seq
+ Field_Sequence,
+ Field_Low_Bound,
+ Field_High_Bound,
+ -- N_Goto_Repeat_Seq
+ Field_Sequence,
+ Field_Low_Bound,
+ Field_High_Bound,
+ -- N_Plus_Repeat_Seq
+ Field_Sequence,
+ -- N_Equal_Repeat_Seq
+ Field_Sequence,
+ Field_Low_Bound,
+ Field_High_Bound,
+ -- N_Not_Bool
+ Field_Presence,
+ Field_Boolean,
+ Field_Hash,
+ Field_Hash_Link,
+ -- N_And_Bool
+ Field_Presence,
+ Field_Left,
+ Field_Right,
+ Field_Hash,
+ Field_Hash_Link,
+ -- N_Or_Bool
+ Field_Presence,
+ Field_Left,
+ Field_Right,
+ Field_Hash,
+ Field_Hash_Link,
+ -- N_Imp_Bool
+ Field_Presence,
+ Field_Left,
+ Field_Right,
+ Field_Hash,
+ Field_Hash_Link,
+ -- N_HDL_Expr
+ Field_Presence,
+ Field_HDL_Node,
+ Field_HDL_Index,
+ Field_Hash,
+ Field_Hash_Link,
+ -- N_False
+ -- N_True
+ -- N_EOS
+ Field_HDL_Index,
+ Field_Hash,
+ Field_Hash_Link,
+ -- N_Name
+ Field_Identifier,
+ Field_Decl,
+ -- N_Name_Decl
+ Field_Identifier,
+ Field_Chain,
+ -- N_Number
+ Field_Value
+ );
+
+ Fields_Of_Nodes_Last : constant array (Nkind) of Integer :=
+ (
+ N_Error => -1,
+ N_Vmode => 3,
+ N_Vunit => 7,
+ N_Vprop => 11,
+ N_Hdl_Mod_Name => 13,
+ N_Assert_Directive => 18,
+ N_Property_Declaration => 23,
+ N_Sequence_Declaration => 27,
+ N_Endpoint_Declaration => 31,
+ N_Const_Parameter => 34,
+ N_Boolean_Parameter => 37,
+ N_Property_Parameter => 40,
+ N_Sequence_Parameter => 43,
+ N_Sequence_Instance => 45,
+ N_Endpoint_Instance => 47,
+ N_Property_Instance => 49,
+ N_Actual => 52,
+ N_Clock_Event => 54,
+ N_Always => 55,
+ N_Never => 56,
+ N_Eventually => 57,
+ N_Strong => 58,
+ N_Imp_Seq => 60,
+ N_Overlap_Imp_Seq => 62,
+ N_Log_Imp_Prop => 64,
+ N_Next => 67,
+ N_Next_A => 71,
+ N_Next_E => 75,
+ N_Next_Event => 79,
+ N_Next_Event_A => 84,
+ N_Next_Event_E => 89,
+ N_Abort => 91,
+ N_Until => 95,
+ N_Before => 99,
+ N_Or_Prop => 101,
+ N_And_Prop => 103,
+ N_Braced_SERE => 104,
+ N_Concat_SERE => 106,
+ N_Fusion_SERE => 108,
+ N_Within_SERE => 110,
+ N_Match_And_Seq => 112,
+ N_And_Seq => 114,
+ N_Or_Seq => 116,
+ N_Star_Repeat_Seq => 119,
+ N_Goto_Repeat_Seq => 122,
+ N_Plus_Repeat_Seq => 123,
+ N_Equal_Repeat_Seq => 126,
+ N_Not_Bool => 130,
+ N_And_Bool => 135,
+ N_Or_Bool => 140,
+ N_Imp_Bool => 145,
+ N_HDL_Expr => 150,
+ N_False => 150,
+ N_True => 150,
+ N_EOS => 153,
+ N_Name => 155,
+ N_Name_Decl => 157,
+ N_Number => 158
+ );
+
+ function Get_Fields (K : Nkind) return Fields_Array
+ is
+ First : Natural;
+ Last : Integer;
+ begin
+ if K = Nkind'First then
+ First := Fields_Of_Nodes'First;
+ else
+ First := Fields_Of_Nodes_Last (Nkind'Pred (K)) + 1;
+ end if;
+ Last := Fields_Of_Nodes_Last (K);
+ return Fields_Of_Nodes (First .. Last);
+ end Get_Fields;
+
+ function Get_Boolean
+ (N : Node; F : Fields_Enum) return Boolean is
+ begin
+ pragma Assert (Fields_Type (F) = Type_Boolean);
+ case F is
+ when Field_Strong_Flag =>
+ return Get_Strong_Flag (N);
+ when Field_Inclusive_Flag =>
+ return Get_Inclusive_Flag (N);
+ when others =>
+ raise Internal_Error;
+ end case;
+ end Get_Boolean;
+
+ procedure Set_Boolean
+ (N : Node; F : Fields_Enum; V: Boolean) is
+ begin
+ pragma Assert (Fields_Type (F) = Type_Boolean);
+ case F is
+ when Field_Strong_Flag =>
+ Set_Strong_Flag (N, V);
+ when Field_Inclusive_Flag =>
+ Set_Inclusive_Flag (N, V);
+ when others =>
+ raise Internal_Error;
+ end case;
+ end Set_Boolean;
+
+ function Get_HDL_Node
+ (N : Node; F : Fields_Enum) return HDL_Node is
+ begin
+ pragma Assert (Fields_Type (F) = Type_HDL_Node);
+ case F is
+ when Field_HDL_Node =>
+ return Get_HDL_Node (N);
+ when others =>
+ raise Internal_Error;
+ end case;
+ end Get_HDL_Node;
+
+ procedure Set_HDL_Node
+ (N : Node; F : Fields_Enum; V: HDL_Node) is
+ begin
+ pragma Assert (Fields_Type (F) = Type_HDL_Node);
+ case F is
+ when Field_HDL_Node =>
+ Set_HDL_Node (N, V);
+ when others =>
+ raise Internal_Error;
+ end case;
+ end Set_HDL_Node;
+
+ function Get_Int32
+ (N : Node; F : Fields_Enum) return Int32 is
+ begin
+ pragma Assert (Fields_Type (F) = Type_Int32);
+ case F is
+ when Field_HDL_Index =>
+ return Get_HDL_Index (N);
+ when others =>
+ raise Internal_Error;
+ end case;
+ end Get_Int32;
+
+ procedure Set_Int32
+ (N : Node; F : Fields_Enum; V: Int32) is
+ begin
+ pragma Assert (Fields_Type (F) = Type_Int32);
+ case F is
+ when Field_HDL_Index =>
+ Set_HDL_Index (N, V);
+ when others =>
+ raise Internal_Error;
+ end case;
+ end Set_Int32;
+
+ function Get_NFA
+ (N : Node; F : Fields_Enum) return NFA is
+ begin
+ pragma Assert (Fields_Type (F) = Type_NFA);
+ case F is
+ when Field_NFA =>
+ return Get_NFA (N);
+ when others =>
+ raise Internal_Error;
+ end case;
+ end Get_NFA;
+
+ procedure Set_NFA
+ (N : Node; F : Fields_Enum; V: NFA) is
+ begin
+ pragma Assert (Fields_Type (F) = Type_NFA);
+ case F is
+ when Field_NFA =>
+ Set_NFA (N, V);
+ when others =>
+ raise Internal_Error;
+ end case;
+ end Set_NFA;
+
+ function Get_Name_Id
+ (N : Node; F : Fields_Enum) return Name_Id is
+ begin
+ pragma Assert (Fields_Type (F) = Type_Name_Id);
+ case F is
+ when Field_Identifier =>
+ return Get_Identifier (N);
+ when Field_Label =>
+ return Get_Label (N);
+ when others =>
+ raise Internal_Error;
+ end case;
+ end Get_Name_Id;
+
+ procedure Set_Name_Id
+ (N : Node; F : Fields_Enum; V: Name_Id) is
+ begin
+ pragma Assert (Fields_Type (F) = Type_Name_Id);
+ case F is
+ when Field_Identifier =>
+ Set_Identifier (N, V);
+ when Field_Label =>
+ Set_Label (N, V);
+ when others =>
+ raise Internal_Error;
+ end case;
+ end Set_Name_Id;
+
+ function Get_Node
+ (N : Node; F : Fields_Enum) return Node is
+ begin
+ pragma Assert (Fields_Type (F) = Type_Node);
+ case F is
+ when Field_Chain =>
+ return Get_Chain (N);
+ when Field_Instance =>
+ return Get_Instance (N);
+ when Field_Prefix =>
+ return Get_Prefix (N);
+ when Field_Item_Chain =>
+ return Get_Item_Chain (N);
+ when Field_Property =>
+ return Get_Property (N);
+ when Field_String =>
+ return Get_String (N);
+ when Field_SERE =>
+ return Get_SERE (N);
+ when Field_Left =>
+ return Get_Left (N);
+ when Field_Right =>
+ return Get_Right (N);
+ when Field_Sequence =>
+ return Get_Sequence (N);
+ when Field_Low_Bound =>
+ return Get_Low_Bound (N);
+ when Field_High_Bound =>
+ return Get_High_Bound (N);
+ when Field_Number =>
+ return Get_Number (N);
+ when Field_Boolean =>
+ return Get_Boolean (N);
+ when Field_Decl =>
+ return Get_Decl (N);
+ when Field_Hash_Link =>
+ return Get_Hash_Link (N);
+ when Field_Parameter_List =>
+ return Get_Parameter_List (N);
+ when Field_Actual =>
+ return Get_Actual (N);
+ when Field_Formal =>
+ return Get_Formal (N);
+ when Field_Declaration =>
+ return Get_Declaration (N);
+ when Field_Association_Chain =>
+ return Get_Association_Chain (N);
+ when Field_Global_Clock =>
+ return Get_Global_Clock (N);
+ when others =>
+ raise Internal_Error;
+ end case;
+ end Get_Node;
+
+ procedure Set_Node
+ (N : Node; F : Fields_Enum; V: Node) is
+ begin
+ pragma Assert (Fields_Type (F) = Type_Node);
+ case F is
+ when Field_Chain =>
+ Set_Chain (N, V);
+ when Field_Instance =>
+ Set_Instance (N, V);
+ when Field_Prefix =>
+ Set_Prefix (N, V);
+ when Field_Item_Chain =>
+ Set_Item_Chain (N, V);
+ when Field_Property =>
+ Set_Property (N, V);
+ when Field_String =>
+ Set_String (N, V);
+ when Field_SERE =>
+ Set_SERE (N, V);
+ when Field_Left =>
+ Set_Left (N, V);
+ when Field_Right =>
+ Set_Right (N, V);
+ when Field_Sequence =>
+ Set_Sequence (N, V);
+ when Field_Low_Bound =>
+ Set_Low_Bound (N, V);
+ when Field_High_Bound =>
+ Set_High_Bound (N, V);
+ when Field_Number =>
+ Set_Number (N, V);
+ when Field_Boolean =>
+ Set_Boolean (N, V);
+ when Field_Decl =>
+ Set_Decl (N, V);
+ when Field_Hash_Link =>
+ Set_Hash_Link (N, V);
+ when Field_Parameter_List =>
+ Set_Parameter_List (N, V);
+ when Field_Actual =>
+ Set_Actual (N, V);
+ when Field_Formal =>
+ Set_Formal (N, V);
+ when Field_Declaration =>
+ Set_Declaration (N, V);
+ when Field_Association_Chain =>
+ Set_Association_Chain (N, V);
+ when Field_Global_Clock =>
+ Set_Global_Clock (N, V);
+ when others =>
+ raise Internal_Error;
+ end case;
+ end Set_Node;
+
+ function Get_PSL_Presence_Kind
+ (N : Node; F : Fields_Enum) return PSL_Presence_Kind is
+ begin
+ pragma Assert (Fields_Type (F) = Type_PSL_Presence_Kind);
+ case F is
+ when Field_Presence =>
+ return Get_Presence (N);
+ when others =>
+ raise Internal_Error;
+ end case;
+ end Get_PSL_Presence_Kind;
+
+ procedure Set_PSL_Presence_Kind
+ (N : Node; F : Fields_Enum; V: PSL_Presence_Kind) is
+ begin
+ pragma Assert (Fields_Type (F) = Type_PSL_Presence_Kind);
+ case F is
+ when Field_Presence =>
+ Set_Presence (N, V);
+ when others =>
+ raise Internal_Error;
+ end case;
+ end Set_PSL_Presence_Kind;
+
+ function Get_Uns32
+ (N : Node; F : Fields_Enum) return Uns32 is
+ begin
+ pragma Assert (Fields_Type (F) = Type_Uns32);
+ case F is
+ when Field_Value =>
+ return Get_Value (N);
+ when Field_Hash =>
+ return Get_Hash (N);
+ when others =>
+ raise Internal_Error;
+ end case;
+ end Get_Uns32;
+
+ procedure Set_Uns32
+ (N : Node; F : Fields_Enum; V: Uns32) is
+ begin
+ pragma Assert (Fields_Type (F) = Type_Uns32);
+ case F is
+ when Field_Value =>
+ Set_Value (N, V);
+ when Field_Hash =>
+ Set_Hash (N, V);
+ when others =>
+ raise Internal_Error;
+ end case;
+ end Set_Uns32;
+
+ function Has_Identifier (K : Nkind) return Boolean is
+ begin
+ case K is
+ when N_Vmode
+ | N_Vunit
+ | N_Vprop
+ | N_Hdl_Mod_Name
+ | N_Property_Declaration
+ | N_Sequence_Declaration
+ | N_Endpoint_Declaration
+ | N_Const_Parameter
+ | N_Boolean_Parameter
+ | N_Property_Parameter
+ | N_Sequence_Parameter
+ | N_Name
+ | N_Name_Decl =>
+ return True;
+ when others =>
+ return False;
+ end case;
+ end Has_Identifier;
+
+ function Has_Label (K : Nkind) return Boolean is
+ begin
+ return K = N_Assert_Directive;
+ end Has_Label;
+
+ function Has_Chain (K : Nkind) return Boolean is
+ begin
+ case K is
+ when N_Vmode
+ | N_Vunit
+ | N_Vprop
+ | N_Assert_Directive
+ | N_Property_Declaration
+ | N_Sequence_Declaration
+ | N_Endpoint_Declaration
+ | N_Const_Parameter
+ | N_Boolean_Parameter
+ | N_Property_Parameter
+ | N_Sequence_Parameter
+ | N_Actual
+ | N_Name_Decl =>
+ return True;
+ when others =>
+ return False;
+ end case;
+ end Has_Chain;
+
+ function Has_Instance (K : Nkind) return Boolean is
+ begin
+ case K is
+ when N_Vmode
+ | N_Vunit
+ | N_Vprop =>
+ return True;
+ when others =>
+ return False;
+ end case;
+ end Has_Instance;
+
+ function Has_Prefix (K : Nkind) return Boolean is
+ begin
+ return K = N_Hdl_Mod_Name;
+ end Has_Prefix;
+
+ function Has_Item_Chain (K : Nkind) return Boolean is
+ begin
+ case K is
+ when N_Vmode
+ | N_Vunit
+ | N_Vprop =>
+ return True;
+ when others =>
+ return False;
+ end case;
+ end Has_Item_Chain;
+
+ function Has_Property (K : Nkind) return Boolean is
+ begin
+ case K is
+ when N_Assert_Directive
+ | N_Property_Declaration
+ | N_Clock_Event
+ | N_Always
+ | N_Never
+ | N_Eventually
+ | N_Strong
+ | N_Imp_Seq
+ | N_Overlap_Imp_Seq
+ | N_Next
+ | N_Next_A
+ | N_Next_E
+ | N_Next_Event
+ | N_Next_Event_A
+ | N_Next_Event_E
+ | N_Abort =>
+ return True;
+ when others =>
+ return False;
+ end case;
+ end Has_Property;
+
+ function Has_String (K : Nkind) return Boolean is
+ begin
+ return K = N_Assert_Directive;
+ end Has_String;
+
+ function Has_SERE (K : Nkind) return Boolean is
+ begin
+ return K = N_Braced_SERE;
+ end Has_SERE;
+
+ function Has_Left (K : Nkind) return Boolean is
+ begin
+ case K is
+ when N_Log_Imp_Prop
+ | N_Until
+ | N_Before
+ | N_Or_Prop
+ | N_And_Prop
+ | N_Concat_SERE
+ | N_Fusion_SERE
+ | N_Within_SERE
+ | N_Match_And_Seq
+ | N_And_Seq
+ | N_Or_Seq
+ | N_And_Bool
+ | N_Or_Bool
+ | N_Imp_Bool =>
+ return True;
+ when others =>
+ return False;
+ end case;
+ end Has_Left;
+
+ function Has_Right (K : Nkind) return Boolean is
+ begin
+ case K is
+ when N_Log_Imp_Prop
+ | N_Until
+ | N_Before
+ | N_Or_Prop
+ | N_And_Prop
+ | N_Concat_SERE
+ | N_Fusion_SERE
+ | N_Within_SERE
+ | N_Match_And_Seq
+ | N_And_Seq
+ | N_Or_Seq
+ | N_And_Bool
+ | N_Or_Bool
+ | N_Imp_Bool =>
+ return True;
+ when others =>
+ return False;
+ end case;
+ end Has_Right;
+
+ function Has_Sequence (K : Nkind) return Boolean is
+ begin
+ case K is
+ when N_Sequence_Declaration
+ | N_Endpoint_Declaration
+ | N_Imp_Seq
+ | N_Overlap_Imp_Seq
+ | N_Star_Repeat_Seq
+ | N_Goto_Repeat_Seq
+ | N_Plus_Repeat_Seq
+ | N_Equal_Repeat_Seq =>
+ return True;
+ when others =>
+ return False;
+ end case;
+ end Has_Sequence;
+
+ function Has_Strong_Flag (K : Nkind) return Boolean is
+ begin
+ case K is
+ when N_Next
+ | N_Next_A
+ | N_Next_E
+ | N_Next_Event
+ | N_Next_Event_A
+ | N_Next_Event_E
+ | N_Until
+ | N_Before =>
+ return True;
+ when others =>
+ return False;
+ end case;
+ end Has_Strong_Flag;
+
+ function Has_Inclusive_Flag (K : Nkind) return Boolean is
+ begin
+ case K is
+ when N_Until
+ | N_Before =>
+ return True;
+ when others =>
+ return False;
+ end case;
+ end Has_Inclusive_Flag;
+
+ function Has_Low_Bound (K : Nkind) return Boolean is
+ begin
+ case K is
+ when N_Next_A
+ | N_Next_E
+ | N_Next_Event_A
+ | N_Next_Event_E
+ | N_Star_Repeat_Seq
+ | N_Goto_Repeat_Seq
+ | N_Equal_Repeat_Seq =>
+ return True;
+ when others =>
+ return False;
+ end case;
+ end Has_Low_Bound;
+
+ function Has_High_Bound (K : Nkind) return Boolean is
+ begin
+ case K is
+ when N_Next_A
+ | N_Next_E
+ | N_Next_Event_A
+ | N_Next_Event_E
+ | N_Star_Repeat_Seq
+ | N_Goto_Repeat_Seq
+ | N_Equal_Repeat_Seq =>
+ return True;
+ when others =>
+ return False;
+ end case;
+ end Has_High_Bound;
+
+ function Has_Number (K : Nkind) return Boolean is
+ begin
+ case K is
+ when N_Next
+ | N_Next_Event =>
+ return True;
+ when others =>
+ return False;
+ end case;
+ end Has_Number;
+
+ function Has_Value (K : Nkind) return Boolean is
+ begin
+ return K = N_Number;
+ end Has_Value;
+
+ function Has_Boolean (K : Nkind) return Boolean is
+ begin
+ case K is
+ when N_Clock_Event
+ | N_Next_Event
+ | N_Next_Event_A
+ | N_Next_Event_E
+ | N_Abort
+ | N_Not_Bool =>
+ return True;
+ when others =>
+ return False;
+ end case;
+ end Has_Boolean;
+
+ function Has_Decl (K : Nkind) return Boolean is
+ begin
+ return K = N_Name;
+ end Has_Decl;
+
+ function Has_HDL_Node (K : Nkind) return Boolean is
+ begin
+ return K = N_HDL_Expr;
+ end Has_HDL_Node;
+
+ function Has_Hash (K : Nkind) return Boolean is
+ begin
+ case K is
+ when N_Not_Bool
+ | N_And_Bool
+ | N_Or_Bool
+ | N_Imp_Bool
+ | N_HDL_Expr
+ | N_EOS =>
+ return True;
+ when others =>
+ return False;
+ end case;
+ end Has_Hash;
+
+ function Has_Hash_Link (K : Nkind) return Boolean is
+ begin
+ case K is
+ when N_Not_Bool
+ | N_And_Bool
+ | N_Or_Bool
+ | N_Imp_Bool
+ | N_HDL_Expr
+ | N_EOS =>
+ return True;
+ when others =>
+ return False;
+ end case;
+ end Has_Hash_Link;
+
+ function Has_HDL_Index (K : Nkind) return Boolean is
+ begin
+ case K is
+ when N_HDL_Expr
+ | N_EOS =>
+ return True;
+ when others =>
+ return False;
+ end case;
+ end Has_HDL_Index;
+
+ function Has_Presence (K : Nkind) return Boolean is
+ begin
+ case K is
+ when N_Not_Bool
+ | N_And_Bool
+ | N_Or_Bool
+ | N_Imp_Bool
+ | N_HDL_Expr =>
+ return True;
+ when others =>
+ return False;
+ end case;
+ end Has_Presence;
+
+ function Has_NFA (K : Nkind) return Boolean is
+ begin
+ return K = N_Assert_Directive;
+ end Has_NFA;
+
+ function Has_Parameter_List (K : Nkind) return Boolean is
+ begin
+ case K is
+ when N_Property_Declaration
+ | N_Sequence_Declaration
+ | N_Endpoint_Declaration =>
+ return True;
+ when others =>
+ return False;
+ end case;
+ end Has_Parameter_List;
+
+ function Has_Actual (K : Nkind) return Boolean is
+ begin
+ case K is
+ when N_Const_Parameter
+ | N_Boolean_Parameter
+ | N_Property_Parameter
+ | N_Sequence_Parameter
+ | N_Actual =>
+ return True;
+ when others =>
+ return False;
+ end case;
+ end Has_Actual;
+
+ function Has_Formal (K : Nkind) return Boolean is
+ begin
+ return K = N_Actual;
+ end Has_Formal;
+
+ function Has_Declaration (K : Nkind) return Boolean is
+ begin
+ case K is
+ when N_Sequence_Instance
+ | N_Endpoint_Instance
+ | N_Property_Instance =>
+ return True;
+ when others =>
+ return False;
+ end case;
+ end Has_Declaration;
+
+ function Has_Association_Chain (K : Nkind) return Boolean is
+ begin
+ case K is
+ when N_Sequence_Instance
+ | N_Endpoint_Instance
+ | N_Property_Instance =>
+ return True;
+ when others =>
+ return False;
+ end case;
+ end Has_Association_Chain;
+
+ function Has_Global_Clock (K : Nkind) return Boolean is
+ begin
+ return K = N_Property_Declaration;
+ end Has_Global_Clock;
+
+end PSL.Nodes_Meta;
diff --git a/src/psl/psl-nodes_meta.adb.in b/src/psl/psl-nodes_meta.adb.in
new file mode 100644
index 000000000..efabbaf55
--- /dev/null
+++ b/src/psl/psl-nodes_meta.adb.in
@@ -0,0 +1,76 @@
+-- Meta description of nodes.
+-- Copyright (C) 2015 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.
+
+package body PSL.Nodes_Meta is
+ Fields_Type : constant array (Fields_Enum) of Types_Enum :=
+ (
+ -- FIELDS_TYPE
+ );
+
+ function Get_Field_Type (F : Fields_Enum) return Types_Enum is
+ begin
+ return Fields_Type (F);
+ end Get_Field_Type;
+
+ function Get_Field_Image (F : Fields_Enum) return String is
+ begin
+ case F is
+ -- FIELD_IMAGE
+ end case;
+ end Get_Field_Image;
+
+ function Get_Nkind_Image (K : Nkind) return String is
+ begin
+ case K is
+ -- IIR_IMAGE
+ end case;
+ end Get_Nkind_Image;
+
+ function Get_Field_Attribute (F : Fields_Enum) return Field_Attribute is
+ begin
+ case F is
+ -- FIELD_ATTRIBUTE
+ end case;
+ end Get_Field_Attribute;
+
+ Fields_Of_Nodes : constant Fields_Array :=
+ (
+ -- FIELDS_ARRAY
+ );
+
+ Fields_Of_Nodes_Last : constant array (Nkind) of Integer :=
+ (
+ -- FIELDS_ARRAY_POS
+ );
+
+ function Get_Fields (K : Nkind) return Fields_Array
+ is
+ First : Natural;
+ Last : Integer;
+ begin
+ if K = Nkind'First then
+ First := Fields_Of_Nodes'First;
+ else
+ First := Fields_Of_Nodes_Last (Nkind'Pred (K)) + 1;
+ end if;
+ Last := Fields_Of_Nodes_Last (K);
+ return Fields_Of_Nodes (First .. Last);
+ end Get_Fields;
+
+ -- FUNCS_BODY
+end PSL.Nodes_Meta;
diff --git a/src/psl/psl-nodes_meta.ads b/src/psl/psl-nodes_meta.ads
new file mode 100644
index 000000000..e8df654b6
--- /dev/null
+++ b/src/psl/psl-nodes_meta.ads
@@ -0,0 +1,174 @@
+-- Meta description of nodes.
+-- Copyright (C) 2015 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 Types; use Types;
+with PSL.Nodes; use PSL.Nodes;
+
+package PSL.Nodes_Meta is
+ -- The enumeration of all possible types in the nodes.
+ type Types_Enum is
+ (
+ Type_Boolean,
+ Type_HDL_Node,
+ Type_Int32,
+ Type_NFA,
+ Type_Name_Id,
+ Type_Node,
+ Type_PSL_Presence_Kind,
+ Type_Uns32
+ );
+
+ -- The enumeration of all fields defined in iirs.
+ type Fields_Enum is
+ (
+ Field_Identifier,
+ Field_Label,
+ Field_Chain,
+ Field_Instance,
+ Field_Prefix,
+ Field_Item_Chain,
+ Field_Property,
+ Field_String,
+ Field_SERE,
+ Field_Left,
+ Field_Right,
+ Field_Sequence,
+ Field_Strong_Flag,
+ Field_Inclusive_Flag,
+ Field_Low_Bound,
+ Field_High_Bound,
+ Field_Number,
+ Field_Value,
+ Field_Boolean,
+ Field_Decl,
+ Field_HDL_Node,
+ Field_Hash,
+ Field_Hash_Link,
+ Field_HDL_Index,
+ Field_Presence,
+ Field_NFA,
+ Field_Parameter_List,
+ Field_Actual,
+ Field_Formal,
+ Field_Declaration,
+ Field_Association_Chain,
+ Field_Global_Clock
+ );
+ pragma Discard_Names (Fields_Enum);
+
+ -- Return the type of field F.
+ function Get_Field_Type (F : Fields_Enum) return Types_Enum;
+
+ -- Get the name of a field.
+ function Get_Field_Image (F : Fields_Enum) return String;
+
+ -- Get the name of a kind.
+ function Get_Nkind_Image (K : Nkind) return String;
+
+ -- Possible attributes of a field.
+ type Field_Attribute is
+ (
+ Attr_None,
+ Attr_Ref, Attr_Maybe_Ref, Attr_Of_Ref,
+ Attr_Chain, Attr_Chain_Next
+ );
+
+ -- Get the attribute of a field.
+ function Get_Field_Attribute (F : Fields_Enum) return Field_Attribute;
+
+ type Fields_Array is array (Natural range <>) of Fields_Enum;
+
+ -- Return the list of fields for node K. The fields are sorted: first
+ -- the non nodes/list of nodes, then the nodes/lists that aren't reference,
+ -- and then the reference.
+ function Get_Fields (K : Nkind) return Fields_Array;
+
+ -- Get/Set a field.
+ function Get_Boolean
+ (N : Node; F : Fields_Enum) return Boolean;
+ procedure Set_Boolean
+ (N : Node; F : Fields_Enum; V: Boolean);
+
+ function Get_HDL_Node
+ (N : Node; F : Fields_Enum) return HDL_Node;
+ procedure Set_HDL_Node
+ (N : Node; F : Fields_Enum; V: HDL_Node);
+
+ function Get_Int32
+ (N : Node; F : Fields_Enum) return Int32;
+ procedure Set_Int32
+ (N : Node; F : Fields_Enum; V: Int32);
+
+ function Get_NFA
+ (N : Node; F : Fields_Enum) return NFA;
+ procedure Set_NFA
+ (N : Node; F : Fields_Enum; V: NFA);
+
+ function Get_Name_Id
+ (N : Node; F : Fields_Enum) return Name_Id;
+ procedure Set_Name_Id
+ (N : Node; F : Fields_Enum; V: Name_Id);
+
+ function Get_Node
+ (N : Node; F : Fields_Enum) return Node;
+ procedure Set_Node
+ (N : Node; F : Fields_Enum; V: Node);
+
+ function Get_PSL_Presence_Kind
+ (N : Node; F : Fields_Enum) return PSL_Presence_Kind;
+ procedure Set_PSL_Presence_Kind
+ (N : Node; F : Fields_Enum; V: PSL_Presence_Kind);
+
+ function Get_Uns32
+ (N : Node; F : Fields_Enum) return Uns32;
+ procedure Set_Uns32
+ (N : Node; F : Fields_Enum; V: Uns32);
+
+ function Has_Identifier (K : Nkind) return Boolean;
+ function Has_Label (K : Nkind) return Boolean;
+ function Has_Chain (K : Nkind) return Boolean;
+ function Has_Instance (K : Nkind) return Boolean;
+ function Has_Prefix (K : Nkind) return Boolean;
+ function Has_Item_Chain (K : Nkind) return Boolean;
+ function Has_Property (K : Nkind) return Boolean;
+ function Has_String (K : Nkind) return Boolean;
+ function Has_SERE (K : Nkind) return Boolean;
+ function Has_Left (K : Nkind) return Boolean;
+ function Has_Right (K : Nkind) return Boolean;
+ function Has_Sequence (K : Nkind) return Boolean;
+ function Has_Strong_Flag (K : Nkind) return Boolean;
+ function Has_Inclusive_Flag (K : Nkind) return Boolean;
+ function Has_Low_Bound (K : Nkind) return Boolean;
+ function Has_High_Bound (K : Nkind) return Boolean;
+ function Has_Number (K : Nkind) return Boolean;
+ function Has_Value (K : Nkind) return Boolean;
+ function Has_Boolean (K : Nkind) return Boolean;
+ function Has_Decl (K : Nkind) return Boolean;
+ function Has_HDL_Node (K : Nkind) return Boolean;
+ function Has_Hash (K : Nkind) return Boolean;
+ function Has_Hash_Link (K : Nkind) return Boolean;
+ function Has_HDL_Index (K : Nkind) return Boolean;
+ function Has_Presence (K : Nkind) return Boolean;
+ function Has_NFA (K : Nkind) return Boolean;
+ function Has_Parameter_List (K : Nkind) return Boolean;
+ function Has_Actual (K : Nkind) return Boolean;
+ function Has_Formal (K : Nkind) return Boolean;
+ function Has_Declaration (K : Nkind) return Boolean;
+ function Has_Association_Chain (K : Nkind) return Boolean;
+ function Has_Global_Clock (K : Nkind) return Boolean;
+end PSL.Nodes_Meta;
diff --git a/src/psl/psl-nodes_meta.ads.in b/src/psl/psl-nodes_meta.ads.in
new file mode 100644
index 000000000..aff379f9d
--- /dev/null
+++ b/src/psl/psl-nodes_meta.ads.in
@@ -0,0 +1,65 @@
+-- Meta description of nodes.
+-- Copyright (C) 2015 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 Types; use Types;
+with PSL.Nodes; use PSL.Nodes;
+
+package PSL.Nodes_Meta is
+ -- The enumeration of all possible types in the nodes.
+ type Types_Enum is
+ (
+ -- TYPES
+ );
+
+ -- The enumeration of all fields defined in iirs.
+ type Fields_Enum is
+ (
+ -- FIELDS
+ );
+ pragma Discard_Names (Fields_Enum);
+
+ -- Return the type of field F.
+ function Get_Field_Type (F : Fields_Enum) return Types_Enum;
+
+ -- Get the name of a field.
+ function Get_Field_Image (F : Fields_Enum) return String;
+
+ -- Get the name of a kind.
+ function Get_Nkind_Image (K : Nkind) return String;
+
+ -- Possible attributes of a field.
+ type Field_Attribute is
+ (
+ Attr_None,
+ Attr_Ref, Attr_Maybe_Ref, Attr_Of_Ref,
+ Attr_Chain, Attr_Chain_Next
+ );
+
+ -- Get the attribute of a field.
+ function Get_Field_Attribute (F : Fields_Enum) return Field_Attribute;
+
+ type Fields_Array is array (Natural range <>) of Fields_Enum;
+
+ -- Return the list of fields for node K. The fields are sorted: first
+ -- the non nodes/list of nodes, then the nodes/lists that aren't reference,
+ -- and then the reference.
+ function Get_Fields (K : Nkind) return Fields_Array;
+
+ -- Get/Set a field.
+ -- FUNCS
+end PSL.Nodes_Meta;
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-06 06:14:32 +0000