diff options
author | Tristan Gingold <tgingold@free.fr> | 2015-05-10 18:07:23 +0200 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2015-05-10 18:07:23 +0200 |
commit | 75473f775914a623d2a84f46a68344e4ed21a441 (patch) | |
tree | 6aaf3badbb7c932a75b0efabc94135e79de7aae2 | |
parent | 7a998f26f619adec0527ebd7e09b63eb058fdf95 (diff) | |
download | ghdl-75473f775914a623d2a84f46a68344e4ed21a441.tar.gz ghdl-75473f775914a623d2a84f46a68344e4ed21a441.tar.bz2 ghdl-75473f775914a623d2a84f46a68344e4ed21a441.zip |
Add missing psl files.
-rw-r--r-- | src/psl/psl-nodes.adb.in | 388 | ||||
-rw-r--r-- | src/psl/psl-nodes_meta.adb | 1305 | ||||
-rw-r--r-- | src/psl/psl-nodes_meta.adb.in | 76 | ||||
-rw-r--r-- | src/psl/psl-nodes_meta.ads | 174 | ||||
-rw-r--r-- | src/psl/psl-nodes_meta.ads.in | 65 |
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; |