------------------------------------------------------------------------------ -- -- -- OCARINA COMPONENTS -- -- -- -- O C A R I N A . C H E C K E R . Q U E R I E S -- -- -- -- B o d y -- -- -- -- Copyright (C) 2007, GET-Telecom Paris. -- -- -- -- Ocarina is free software; you can redistribute it and/or modify -- -- it under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. Ocarina 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 distributed with Ocarina; see file COPYING. -- -- If not, write to the Free Software Foundation, 51 Franklin Street, Fifth -- -- Floor, Boston, MA 02111-1301, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- -- Ocarina is maintained by the Ocarina team -- -- (ocarina-users@listes.enst.fr) -- -- -- ------------------------------------------------------------------------------ with Ocarina.Nodes; with Ocarina.Entities.Properties; with Ocarina.Entities.Components; with Ocarina.Expander.Queries; -- Only for debugging purposes with Ocarina.Debug; use Ocarina.Debug; with Ocarina.Nutils; use Ocarina.Nutils; with Namet; use Namet; package body Ocarina.Checker.Queries is use Ocarina.Nodes; use Ocarina.Entities.Properties; use Ocarina.Expander.Queries; use Types; function Is_Component (E : Node_Id; Component_T : Instance_Type) return Boolean; ------------------ -- Is_Component -- ------------------ function Is_Component (E : Node_Id; Component_T : Instance_Type) return Boolean is use Ocarina.Entities.Components; begin case Kind (E) is when K_Call_Sequence_Instance => return (Component_T = C_Sequence_Call); when K_Call_Instance => return (Component_T = C_Subprogram_Call); when K_Connection_Instance => return (Component_T = C_Connection); when K_Component_Instance => case Get_Category_Of_Component (E) is when CC_Data => return (Component_T = C_Data); when CC_Subprogram => return (Component_T = C_Subprogram); when CC_Thread => return (Component_T = C_Thread); when CC_Threadgroup => return (Component_T = C_Threadgroup); when CC_Process => return (Component_T = C_Process); when CC_Memory => return (Component_T = C_Memory); when CC_Processor => return (Component_T = C_Processor); when CC_Bus => return (Component_T = C_Bus); when CC_Device => return (Component_T = C_Device); when CC_System => return (Component_T = C_System); when others => return (Component_T = C_Unknown); end case; when others => return False; end case; end Is_Component; ------------------------------------- -- Get_Instances_Of_Component_Type -- ------------------------------------- function Get_Instances_Of_Component_Type (Component_T : Instance_Type) return Result_Set is Cpt : Natural := 0; Results : Result_Set; begin for N in 1 .. Entries.Last loop if Is_Component (N, Component_T) then Cpt := Cpt + 1; Results.Elements (Cardinal_Size (Cpt)) := N; end if; end loop; Results.Cardinal := Cardinal_Size (Cpt); return Results; end Get_Instances_Of_Component_Type; ------------------------------------- -- Get_Instances_Of_Component_Type -- ------------------------------------- function Get_Instances_Of_Component_Type (E : Node_Id) return Result_Set is pragma Assert (Kind (E) = K_Component_Type or else Kind (E) = K_Component_Implementation or else Kind (E) = K_Port_Group_Type); Cpt : Natural := 0; Results : Result_Set; begin for N in 1 .. Entries.Last loop if Kind (N) = K_Component_Instance then if Corresponding_Declaration (N) = E then Cpt := Cpt + 1; Results.Elements (Cardinal_Size (Cpt)) := N; end if; end if; end loop; Results.Cardinal := Cardinal_Size (Cpt); return Results; end Get_Instances_Of_Component_Type; --------------------------------- -- Get_Instances_With_Property -- --------------------------------- function Get_Instances_With_Property (Set : Result_Set; Property_Name : String) return Result_Set is Result : Result_Set; begin for N in 1 .. Set.Cardinal loop if Find_Property_Association_From_Name (Properties (Set.Elements (N)), Property_Name) /= No_Node then Result.Cardinal := Result.Cardinal + 1; Result.Elements (Result.Cardinal) := Set.Elements (N); end if; end loop; return Result; end Get_Instances_With_Property; -- Set manipulation ----------- -- Is_In -- ----------- function Is_In (E : Node_Id; Set : Result_Set) return Boolean is begin for N in 1 .. Set.Cardinal loop if Set.Elements (N) = E then return True; end if; end loop; return False; end Is_In; --------- -- Add -- --------- procedure Add (Set : in out Result_Set; E : Node_Id; Distinct : Boolean := False) is begin if Distinct then if not Is_In (E, Set) then Set.Cardinal := Set.Cardinal + 1; Set.Elements (Set.Cardinal) := E; end if; else Set.Cardinal := Set.Cardinal + 1; Set.Elements (Set.Cardinal) := E; end if; end Add; ----------- -- Union -- ----------- function Union (Set_1 : Result_Set; Set_2 : Result_Set; Distinct : Boolean := False) return Result_Set is Result : Result_Set; begin -- Add Set_1 for N in 1 .. Set_1.Cardinal loop Result.Elements (N) := Set_1.Elements (N); end loop; Result.Cardinal := Set_1.Cardinal; if Distinct then -- Add elements of Set_2 which are not already in the result_set for N in 1 .. Set_2.Cardinal loop if not (Is_In (Set_2.Elements (N), Result)) then Result.Cardinal := Result.Cardinal + 1; Result.Elements (Result.Cardinal) := Set_2.Elements (N); end if; end loop; else -- Add all elements of Set_2 in the result_set for N in 1 .. Set_2.Cardinal loop Result.Elements (Result.Cardinal + N) := Set_2.Elements (N); end loop; Result.Cardinal := Result.Cardinal + Set_2.Cardinal; end if; return Result; end Union; ------------------ -- Intersection -- ------------------ function Intersection (Set_1 : Result_Set; Set_2 : Result_Set) return Result_Set is Result : Result_Set; begin -- Add elements of Set_1 which are in the Set_2 for N in 1 .. Set_1.Cardinal loop if Is_In (Set_1.Elements (N), Set_2) then Result.Cardinal := Result.Cardinal + 1; Result.Elements (Result.Cardinal) := Set_1.Elements (N); end if; end loop; return Result; end Intersection; --------------- -- Exclusion -- --------------- function Exclusion (Set_1 : Result_Set; Set_2 : Result_Set) return Result_Set is Result : Result_Set; begin -- Add elements of Set_1 which are *not* in the Set_2 for N in 1 .. Set_1.Cardinal loop if not Is_In (Set_1.Elements (N), Set_2) then Result.Cardinal := Result.Cardinal + 1; Result.Elements (Result.Cardinal) := Set_1.Elements (N); end if; end loop; return Result; end Exclusion; -------------- -- Includes -- -------------- function Includes (Set_1 : Result_Set; Set_2 : Result_Set) return Boolean is begin for N in 1 .. Set_2.Cardinal loop if not Is_In (Set_2.Elements (N), Set_1) then return False; end if; end loop; return True; end Includes; ---------------------- -- Mutual_Inclusion -- ---------------------- function Mutual_Inclusion (Set_1 : Result_Set; Set_2 : Result_Set) return Boolean is begin return (Includes (Set_1, Set_2) and then Set_1.Cardinal = Set_2.Cardinal); end Mutual_Inclusion; -------------- -- Is_Empty -- -------------- function Is_Empty (Set : Result_Set) return Boolean is begin return (Set.Cardinal = 0); end Is_Empty; -------------- -- Cardinal -- -------------- function Cardinal (Set : Result_Set) return Natural is begin return Natural (Set.Cardinal); end Cardinal; --------------- -- Empty_Set -- --------------- function Empty_Set return Result_Set is R : Result_Set; begin R.Cardinal := 0; return R; end Empty_Set; ------------------------ -- Get_Property_Value -- ------------------------ function Get_Property_Value (E : Types.Node_Id; Name : String) return Types.Node_Id is N : Types.Node_Id; begin case Kind (E) is when K_Call_Instance | K_Call_Sequence_Instance => N := Get_Value_Of_Property_Association (Corresponding_Instance (E), Name); when others => N := Get_Value_Of_Property_Association (E, Name); end case; return N; end Get_Property_Value; --------- -- Get -- --------- function Get (Set : Result_Set; Index : Natural) return Node_Id is begin return Set.Elements (Cardinal_Size (Index)); end Get; ---------------- -- Test_Dummy -- ---------------- function Test_Dummy (C : Instance_Type) return Result_Set is Results : Result_Set; begin Results := Get_Instances_Of_Component_Type (C); return Results; end Test_Dummy; --------------------- -- Test_Dummy_Sets -- --------------------- function Test_Dummy_Sets return Result_Set is C1 : constant Instance_Type := C_Subprogram_Call; C2 : constant Instance_Type := C_Thread; R1 : Result_Set; R2 : Result_Set; R3 : Result_Set; begin R1 := Test_Dummy (C1); Display_Set (R1); W_Line ("------"); R2 := Test_Dummy (C2); R3 := Union (R1, R2); return R3; end Test_Dummy_Sets; ----------------- -- Display_Set -- ----------------- procedure Display_Set (Set : Result_Set) is begin for N in 1 .. Set.Cardinal loop Write_Name (Compute_Full_Name_Of_Instance (Set.Elements (N))); W_Str (": "); W_Node_Header (Set.Elements (N)); end loop; end Display_Set; end Ocarina.Checker.Queries;