1  with Gela.Int.Attr_Functions;


2  with Gela.Int.Defining_Names;


3  with Gela.Int.Expressions;


4  with Gela.Int.Visiters;


5  with Gela.Int.Tuples;


6 


7  package body Gela.Plain_Interpretations is


8 


9  package Empty_Cursors is


10  type Cursor is new Gela.Interpretations.Cursor with null record;


11 


12  overriding function Has_Element (Self : Cursor) return Boolean;


13 


14  overriding procedure Next (Self : in out Cursor) is null;


15 


16  overriding procedure Visit


17  (Self : Cursor;


18  Target : access Gela.Interpretations.Visiter'Class) is null;


19 


20  overriding function Get_Index


21  (Self : Cursor) return Gela.Interpretations.Interpretation_Index;


22 


23  end Empty_Cursors;


24 


25  package body Empty_Cursors is


26 


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


28  pragma Unreferenced (Self);


29  begin


30  return False;


31  end Has_Element;


32 


33  overriding function Get_Index


34  (Self : Cursor) return Gela.Interpretations.Interpretation_Index


35  is


36  pragma Unreferenced (Self);


37  begin


38  return 0;


39  end Get_Index;


40 


41  end Empty_Cursors;


42 


43  


44   Add_Attr_Function 


45  


46 


47  overriding procedure Add_Attr_Function


48  (Self : in out Interpretation_Manager;


49  Kind : Gela.Lexical_Types.Predefined_Symbols.Attribute;


50  Down : Gela.Interpretations.Interpretation_Index_Array;


51  Result : in out Gela.Interpretations.Interpretation_Set_Index)


52  is


53  Item : constant Gela.Int.Interpretation_Access :=


54  new Gela.Int.Attr_Functions.Attr_Function'


55  (Gela.Int.Attr_Functions.Create


56  (Down => Down,


57  Kind => Kind));


58  begin


59  Self.Plian_Int_Set.Add (Result, Item);


60  end Add_Attr_Function;


61 


62  


63   Add_Defining_Name 


64  


65 


66  overriding procedure Add_Defining_Name


67  (Self : in out Interpretation_Manager;


68  Name : Gela.Elements.Defining_Names.Defining_Name_Access;


69  Down : Gela.Interpretations.Interpretation_Index_Array;


70  Result : in out Gela.Interpretations.Interpretation_Set_Index)


71  is


72  Item : constant Gela.Int.Interpretation_Access :=


73  new Gela.Int.Defining_Names.Defining_Name'


74  (Gela.Int.Defining_Names.Create


75  (Down => Down,


76  Name => Name));


77  begin


78  Self.Plian_Int_Set.Add (Result, Item);


79  end Add_Defining_Name;


80 


81  


82   Add_Expression 


83  


84 


85  overriding procedure Add_Expression


86  (Self : in out Interpretation_Manager;


87  Tipe : Gela.Semantic_Types.Type_Index;


88  Down : Gela.Interpretations.Interpretation_Index_Array;


89  Result : in out Gela.Interpretations.Interpretation_Set_Index)


90  is


91  Item : constant Gela.Int.Interpretation_Access :=


92  new Gela.Int.Expressions.Expression'


93  (Gela.Int.Expressions.Create


94  (Down => Down,


95  Expression_Type => Tipe));


96  begin


97  Self.Plian_Int_Set.Add (Result, Item);


98  end Add_Expression;


99 


100  


101   Add_Tuple 


102  


103 


104  overriding procedure Add_Tuple


105  (Self : in out Interpretation_Manager;


106  Left : Gela.Interpretations.Interpretation_Set_Index;


107  Right : Gela.Interpretations.Interpretation_Set_Index;


108  Result : in out Gela.Interpretations.Interpretation_Set_Index)


109  is


110  package Each is


111  type Visiter is new Gela.Interpretations.Visiter with null record;


112   Only tuples are expected here


113 


114  overriding procedure On_Defining_Name


115  (Self : in out Visiter;


116  Name : Gela.Elements.Defining_Names.Defining_Name_Access;


117  Down : Gela.Interpretations.Interpretation_Index_Array) is null;


118 


119  overriding procedure On_Expression


120  (Self : in out Visiter;


121  Tipe : Gela.Semantic_Types.Type_Index;


122  Down : Gela.Interpretations.Interpretation_Index_Array) is null;


123 


124  overriding procedure On_Attr_Function


125  (Self : in out Visiter;


126  Kind : Gela.Lexical_Types.Predefined_Symbols.Attribute;


127  Down : Gela.Interpretations.Interpretation_Index_Array) is null;


128 


129  overriding procedure On_Tuple


130  (V : in out Visiter;


131  Value : Gela.Interpretations.Interpretation_Set_Index_Array;


132  Down : Gela.Interpretations.Interpretation_Index_Array);


133 


134  end Each;


135 


136  package body Each is


137 


138  overriding procedure On_Tuple


139  (V : in out Visiter;


140  Value : Gela.Interpretations.Interpretation_Set_Index_Array;


141  Down : Gela.Interpretations.Interpretation_Index_Array)


142  is


143  pragma Unreferenced (V, Down);


144  use type Gela.Interpretations.Interpretation_Set_Index_Array;


145 


146  Item : constant Gela.Int.Interpretation_Access :=


147  new Gela.Int.Tuples.Tuple'


148  (Gela.Int.Tuples.Create (Left & Value));


149  begin


150  Self.Plian_Int_Set.Add (Result, Item);


151  end On_Tuple;


152 


153  end Each;


154 


155  Item : Gela.Int.Interpretation_Access;


156  V : aliased Each.Visiter;


157  begin


158  if Right = 0 then


159  Item := new Gela.Int.Tuples.Tuple'


160  (Gela.Int.Tuples.Create (Value => (1 => Left)));


161 


162  Self.Plian_Int_Set.Add (Result, Item);


163  else


164  declare


165  Cursor : Gela.Interpretations.Cursor'Class :=


166  Self.Get_Cursor (Right);


167  begin


168  while Cursor.Has_Element loop


169  Cursor.Visit (V'Access);


170  Cursor.Next;


171  end loop;


172  end;


173  end if;


174  end Add_Tuple;


175 


176  


177   Get_Defining_Name 


178  


179 


180  overriding procedure Get_Defining_Name


181  (Self : in out Interpretation_Manager;


182  Value : Gela.Interpretations.Interpretation_Index;


183  Result : out Gela.Elements.Defining_Names.Defining_Name_Access)


184  is


185  package Each is


186  type Visiter is new Gela.Interpretations.Visiter with record


187  Name : Gela.Elements.Defining_Names.Defining_Name_Access;


188  end record;


189 


190  overriding procedure On_Defining_Name


191  (Self : in out Visiter;


192  Name : Gela.Elements.Defining_Names.Defining_Name_Access;


193  Down : Gela.Interpretations.Interpretation_Index_Array);


194 


195  overriding procedure On_Expression


196  (Self : in out Visiter;


197  Tipe : Gela.Semantic_Types.Type_Index;


198  Down : Gela.Interpretations.Interpretation_Index_Array) is null;


199 


200  overriding procedure On_Attr_Function


201  (Self : in out Visiter;


202  Tipe : Gela.Lexical_Types.Predefined_Symbols.Attribute;


203  Down : Gela.Interpretations.Interpretation_Index_Array) is null;


204 


205  overriding procedure On_Tuple


206  (Self : in out Visiter;


207  Value : Gela.Interpretations.Interpretation_Set_Index_Array;


208  Down : Gela.Interpretations.Interpretation_Index_Array)


209  is null;


210  end Each;


211 


212  


213   Each 


214  


215 


216  package body Each is


217 


218  overriding procedure On_Defining_Name


219  (Self : in out Visiter;


220  Name : Gela.Elements.Defining_Names.Defining_Name_Access;


221  Down : Gela.Interpretations.Interpretation_Index_Array)


222  is


223  pragma Unreferenced (Down);


224  begin


225  Self.Name := Name;


226  end On_Defining_Name;


227 


228  end Each;


229 


230  Visiter : Each.Visiter;


231  begin


232  Self.Visit (Value, Visiter);


233  Result := Visiter.Name;


234  end Get_Defining_Name;


235 


236  


237   Get_Down_Interpretation 


238  


239 


240  overriding procedure Get_Down_Interpretation


241  (Self : in out Interpretation_Manager;


242  Value : Gela.Interpretations.Interpretation_Index;


243  Index : Positive;


244  Result : out Gela.Interpretations.Interpretation_Index)


245  is


246  Item : Gela.Int.Interpretation_Access;


247  begin


248  Result := 0;


249 


250  if Value = 0 then


251  return;


252  end if;


253 


254  Item := Self.Item_Batches.Element (Value / Batch_Size).Element (Value);


255 


256  if Index in Item.Down'Range then


257  Result := Item.Down (Index);


258  end if;


259  end Get_Down_Interpretation;


260 


261  


262   Get_Cursor 


263  


264 


265  overriding function Get_Cursor


266  (Self : in out Interpretation_Manager;


267  Set : Gela.Interpretations.Interpretation_Set_Index)


268  return Gela.Interpretations.Cursor'Class is


269  begin


270  if Set = 0 then


271  return None : Empty_Cursors.Cursor;


272  else


273  return Self.Set_Batches.Element (Set / Batch_Size).Get_Cursor (Set);


274  end if;


275  end Get_Cursor;


276 


277  


278   Get_Tuple_Index 


279  


280 


281  overriding procedure Get_Tuple_Index


282  (Self : in out Interpretation_Manager;


283  Left : Gela.Interpretations.Interpretation_Index;


284  Right : Gela.Interpretations.Interpretation_Index;


285  Result : out Gela.Interpretations.Interpretation_Index)


286  is


287  use type Gela.Interpretations.Interpretation_Index_Array;


288 


289  Item : constant Gela.Int.Interpretation_Access :=


290  new Gela.Int.Tuples.Chosen_Tuple'


291  (Length => 2, Index => 0, Down => Left & Right);


292  begin


293  Self.Plian_Int_Set.Add (Result, Item);


294  end Get_Tuple_Index;


295 


296  


297   Reserve_Indexes 


298  


299 


300  overriding procedure Reserve_Indexes


301  (Self : in out Interpretation_Manager;


302  Set : Gela.Int_Sets.Interpretation_Set_Access;


303  From : out Gela.Interpretations.Interpretation_Set_Index;


304  To : out Gela.Interpretations.Interpretation_Set_Index) is


305  begin


306  Self.Set_Batches.Append (Set);


307  From := Self.Set_Batches.Last_Index * Batch_Size;


308  To := From + Batch_Size  1;


309  From := Gela.Interpretations.Interpretation_Set_Index'Max (1, From);


310  end Reserve_Indexes;


311 


312  


313   Reserve_Indexes 


314  


315 


316  overriding procedure Reserve_Indexes


317  (Self : in out Interpretation_Manager;


318  Set : Gela.Int_Sets.Interpretation_Set_Access;


319  From : out Gela.Interpretations.Interpretation_Index;


320  To : out Gela.Interpretations.Interpretation_Index) is


321  begin


322  Self.Item_Batches.Append (Set);


323  From := Self.Item_Batches.Last_Index * Batch_Size;


324  To := From + Batch_Size  1;


325  From := Gela.Interpretations.Interpretation_Index'Max (1, From);


326  end Reserve_Indexes;


327 


328  


329   Visit 


330  


331 


332  overriding procedure Visit


333  (Self : in out Interpretation_Manager;


334  Index : Gela.Interpretations.Interpretation_Index;


335  Target : in out Gela.Interpretations.Visiter'Class)


336  is


337  package Switch is


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


339 


340  overriding procedure Defining_Name


341  (Self : access Visiter;


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


343 


344  overriding procedure Expression


345  (Self : access Visiter;


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


347 


348  overriding procedure Attr_Function


349  (Self : access Visiter;


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


351 


352  overriding procedure Tuple


353  (Self : access Visiter;


354  Value : Gela.Int.Tuples.Tuple);


355 


356  overriding procedure Chosen_Tuple


357  (Self : access Visiter;


358  Value : Gela.Int.Tuples.Chosen_Tuple);


359 


360  end Switch;


361 


362  


363   Switch 


364  


365 


366  package body Switch is


367 


368  


369   Attr_Function 


370  


371 


372  overriding procedure Attr_Function


373  (Self : access Visiter;


374  Value : Gela.Int.Attr_Functions.Attr_Function)


375  is


376  pragma Unreferenced (Self);


377  begin


378  Target.On_Attr_Function


379  (Kind => Value.Kind,


380  Down => Value.Down);


381  end Attr_Function;


382 


383  


384   Defining_Name 


385  


386 


387  overriding procedure Defining_Name


388  (Self : access Visiter;


389  Value : Gela.Int.Defining_Names.Defining_Name)


390  is


391  pragma Unreferenced (Self);


392  begin


393  Target.On_Defining_Name


394  (Name => Value.Name,


395  Down => Value.Down);


396  end Defining_Name;


397 


398  


399   Expression 


400  


401 


402  overriding procedure Expression


403  (Self : access Visiter;


404  Value : Gela.Int.Expressions.Expression)


405  is


406  pragma Unreferenced (Self);


407  begin


408  Target.On_Expression


409  (Tipe => Value.Expression_Type,


410  Down => Value.Down);


411  end Expression;


412 


413  


414   Tuple 


415  


416 


417  overriding procedure Tuple


418  (Self : access Visiter;


419  Value : Gela.Int.Tuples.Tuple)


420  is


421  pragma Unreferenced (Self);


422  begin


423  Target.On_Tuple (Value.Value, (1 .. 0 => 0));


424  end Tuple;


425 


426  


427   Chosen_Tuple 


428  


429 


430  overriding procedure Chosen_Tuple


431  (Self : access Visiter;


432  Value : Gela.Int.Tuples.Chosen_Tuple)


433  is


434  pragma Unreferenced (Self);


435  begin


436  Target.On_Tuple ((1 .. 0 => 0), Value.Down);


437  end Chosen_Tuple;


438 


439  end Switch;


440 


441  V : aliased Switch.Visiter;


442  begin


443  if Index /= 0 then


444  Self.Item_Batches.Element (Index / Batch_Size).Element (Index).Visit


445  (V'Access);


446  end if;


447  end Visit;


448 


449  end Gela.Plain_Interpretations;

