1  with Gela.Int.Attr_Functions;


2  with Gela.Int.Defining_Names;


3  with Gela.Int.Expressions;


4  with Gela.Int.Visiters;


5 


6  package body Gela.Plian_Int_Sets is


7 


8  


9   Add 


10  


11 


12  not overriding procedure Add


13  (Self : access Interpretation_Set;


14  Index : in out Gela.Interpretations.Interpretation_Set_Index;


15  Item : Gela.Int.Interpretation_Access)


16  is


17  use type Gela.Interpretations.Interpretation_Set_Index;


18 


19  procedure Update


20  (Key : Gela.Interpretations.Interpretation_Set_Index;


21  Element : in out Int_Lists.List);


22 


23  


24   Update 


25  


26 


27  procedure Update


28  (Key : Gela.Interpretations.Interpretation_Set_Index;


29  Element : in out Int_Lists.List)


30  is


31  pragma Unreferenced (Key);


32  begin


33  Element.Append (Item);


34  end Update;


35 


36  Pos : Int_List_Maps.Cursor;


37  Ok : Boolean;


38  begin


39  if Index = 0 then


40  if Self.Set_From = Self.Set_To then


41  Self.Ids.Reserve_Indexes


42  (Gela.Int_Sets.Interpretation_Set_Access (Self),


43  Self.Set_From,


44  Self.Set_To);


45  end if;


46 


47  Index := Self.Set_From;


48  Self.Set_From := Self.Set_From + 1;


49  Self.Map.Insert (Index, Int_Lists.Empty_List, Pos, Ok);


50  else


51  Pos := Self.Map.Find (Index);


52  end if;


53 


54  Self.Map.Update_Element (Pos, Update'Access);


55  end Add;


56 


57  


58   Element 


59  


60 


61  overriding function Element


62  (Self : Interpretation_Set;


63  Index : Gela.Interpretations.Interpretation_Index)


64  return Gela.Int.Interpretation_Access is


65  begin


66  return Self.Int_Map.Element (Index);


67  end Element;


68 


69  


70   Get_Cursor 


71  


72 


73  overriding function Get_Cursor


74  (Self : access Interpretation_Set;


75  Index : Gela.Interpretations.Interpretation_Set_Index)


76  return Gela.Interpretations.Cursor'Class


77  is


78  begin


79  return Result : Cursor do


80 


81  declare


82  procedure Get


83  (Key : Gela.Interpretations.Interpretation_Set_Index;


84  Element : Int_Lists.List);


85 


86  


87   Get 


88  


89 


90  procedure Get


91  (Key : Gela.Interpretations.Interpretation_Set_Index;


92  Element : Int_Lists.List)


93  is


94  pragma Unreferenced (Key);


95  begin


96  Result.Pos := Element.First;


97  end Get;


98 


99  use type Gela.Interpretations.Interpretation_Set_Index;


100  begin


101  if Index /= 0 then


102  Int_List_Maps.Query_Element (Self.Map.Find (Index), Get'Access);


103  end if;


104 


105  Result.Set := Self;


106  end;


107 


108  end return;


109  end Get_Cursor;


110 


111  


112   Get_Index 


113  


114 


115  overriding function Get_Index


116  (Self : Cursor)


117  return Gela.Interpretations.Interpretation_Index


118  is


119  use type Gela.Interpretations.Interpretation_Index;


120 


121  Item : constant Gela.Int.Interpretation_Access :=


122  Int_Lists.Element (Self.Pos);


123  Result : Gela.Interpretations.Interpretation_Index;


124  begin


125  if Item.Index /= 0 then


126  return Item.Index;


127  end if;


128 


129  if Self.Set.Item_From = Self.Set.Item_To then


130  Self.Set.Ids.Reserve_Indexes


131  (Gela.Int_Sets.Interpretation_Set_Access (Self.Set),


132  Self.Set.Item_From,


133  Self.Set.Item_To);


134  end if;


135 


136  Result := Self.Set.Item_From;


137  Self.Set.Item_From := Self.Set.Item_From + 1;


138  Self.Set.Int_Map.Insert (Result, Item);


139  Item.Index := Result;


140 


141  return Result;


142  end Get_Index;


143 


144  


145   Has_Element 


146  


147 


148  overriding function Has_Element (Self : Cursor) return Boolean is


149  begin


150  return Int_Lists.Has_Element (Self.Pos);


151  end Has_Element;


152 


153  


154   Hash 


155  


156 


157  function Hash


158  (Value : Gela.Interpretations.Interpretation_Index)


159  return Ada.Containers.Hash_Type is


160  begin


161  return Ada.Containers.Hash_Type (Value);


162  end Hash;


163 


164  


165   Hash 


166  


167 


168  function Hash


169  (Value : Gela.Interpretations.Interpretation_Set_Index)


170  return Ada.Containers.Hash_Type is


171  begin


172  return Ada.Containers.Hash_Type (Value);


173  end Hash;


174 


175 


176  


177   Next 


178  


179 


180  overriding procedure Next (Self : in out Cursor) is


181  begin


182  Int_Lists.Next (Self.Pos);


183  end Next;


184 


185  


186   Visit 


187  


188 


189  overriding procedure Visit


190  (Self : Cursor;


191  Target : access Gela.Interpretations.Visiter'Class)


192  is


193  package Each is


194  type Visiter is new Gela.Int.Visiters.Visiter with null record;


195 


196  overriding procedure Defining_Name


197  (Self : access Visiter;


198  Value : Gela.Int.Defining_Names.Defining_Name);


199 


200  overriding procedure Expression


201  (Self : access Visiter;


202  Value : Gela.Int.Expressions.Expression);


203 


204  overriding procedure Attr_Function


205  (Self : access Visiter;


206  Value : Gela.Int.Attr_Functions.Attr_Function);


207 


208  end Each;


209 


210  package body Each is


211 


212  overriding procedure Defining_Name


213  (Self : access Visiter;


214  Value : Gela.Int.Defining_Names.Defining_Name)


215  is


216  pragma Unreferenced (Self);


217  begin


218  Target.On_Defining_Name


219  (Name => Value.Name,


220  Down => Value.Down);


221  end Defining_Name;


222 


223  overriding procedure Expression


224  (Self : access Visiter;


225  Value : Gela.Int.Expressions.Expression)


226  is


227  pragma Unreferenced (Self);


228  begin


229  Target.On_Expression


230  (Tipe => Value.Expression_Type,


231  Down => Value.Down);


232  end Expression;


233 


234  overriding procedure Attr_Function


235  (Self : access Visiter;


236  Value : Gela.Int.Attr_Functions.Attr_Function)


237  is


238  pragma Unreferenced (Self);


239  begin


240  Target.On_Attr_Function


241  (Kind => Value.Kind,


242  Down => Value.Down);


243  end Attr_Function;


244 


245  end Each;


246 


247  V : aliased Each.Visiter;


248  begin


249  Int_Lists.Element (Self.Pos).Visit (V'Access);


250  end Visit;


251 


252  end Gela.Plian_Int_Sets;

