1  with Gela.Int.Attr_Functions;


2  with Gela.Int.Categories;


3  with Gela.Int.Defining_Names;


4  with Gela.Int.Expressions;


5  with Gela.Int.Placeholders;


6  with Gela.Int.Symbols;


7  with Gela.Int.Tuples;


8  with Gela.Int.Visiters;


9 


10  package body Gela.Plain_Interpretations is


11 


12  


13   Add_Attr_Function 


14  


15 


16  overriding procedure Add_Attr_Function


17  (Self : in out Interpretation_Manager;


18  Tipe : Gela.Semantic_Types.Type_Index;


19  Kind : Gela.Lexical_Types.Predefined_Symbols.Attribute;


20  Down : Gela.Interpretations.Interpretation_Index_Array;


21  Result : in out Gela.Interpretations.Interpretation_Set_Index)


22  is


23  Item : constant Gela.Int.Interpretation_Access :=


24  new Gela.Int.Attr_Functions.Attr_Function'


25  (Gela.Int.Attr_Functions.Create


26  (Down => Down,


27  Tipe => Tipe,


28  Kind => Kind));


29  begin


30  Self.Plain_Int_Set.Add (Result, Item);


31  end Add_Attr_Function;


32 


33  


34   Add_Defining_Name 


35  


36 


37  overriding procedure Add_Defining_Name


38  (Self : in out Interpretation_Manager;


39  Name : Gela.Elements.Defining_Names.Defining_Name_Access;


40  Down : Gela.Interpretations.Interpretation_Index_Array;


41  Result : in out Gela.Interpretations.Interpretation_Set_Index)


42  is


43  Item : constant Gela.Int.Interpretation_Access :=


44  new Gela.Int.Defining_Names.Defining_Name'


45  (Gela.Int.Defining_Names.Create


46  (Down => Down,


47  Name => Name));


48  begin


49  Self.Plain_Int_Set.Add (Result, Item);


50  end Add_Defining_Name;


51 


52  


53   Add_Expression 


54  


55 


56  overriding procedure Add_Expression


57  (Self : in out Interpretation_Manager;


58  Tipe : Gela.Semantic_Types.Type_Index;


59  Kind : Gela.Interpretations.Unknown_Auxiliary_Apply_Kinds :=


60  Gela.Interpretations.Unknown;


61  Down : Gela.Interpretations.Interpretation_Index_Array;


62  Result : in out Gela.Interpretations.Interpretation_Set_Index)


63  is


64  Item : constant Gela.Int.Interpretation_Access :=


65  new Gela.Int.Expressions.Expression'


66  (Gela.Int.Expressions.Create


67  (Down => Down,


68  Expression_Type => Tipe,


69  Expression_Kind => Kind));


70  begin


71  Self.Plain_Int_Set.Add (Result, Item);


72  end Add_Expression;


73 


74  


75   Add_Expression_Category 


76  


77 


78  overriding procedure Add_Expression_Category


79  (Self : in out Interpretation_Manager;


80  Match : not null Gela.Interpretations.Type_Matcher_Access;


81  Down : Gela.Interpretations.Interpretation_Index_Array;


82  Result : in out Gela.Interpretations.Interpretation_Set_Index)


83  is


84  Item : constant Gela.Int.Interpretation_Access :=


85  new Gela.Int.Categories.Category'


86  (Gela.Int.Categories.Create


87  (Down => Down,


88  Match => Match));


89  begin


90  Self.Plain_Int_Set.Add (Result, Item);


91  end Add_Expression_Category;


92 


93  


94   Add_Placeholder 


95  


96 


97  overriding procedure Add_Placeholder


98  (Self : in out Interpretation_Manager;


99  Kind : Gela.Interpretations.Placeholder_Kind;


100  Result : in out Gela.Interpretations.Interpretation_Set_Index)


101  is


102  Item : constant Gela.Int.Interpretation_Access :=


103  new Gela.Int.Placeholders.Placeholder'


104  (Gela.Int.Placeholders.Create


105  (Down => (1 .. 0 => 0),


106  Kind => Kind));


107  begin


108  Self.Plain_Int_Set.Add (Result, Item);


109  end Add_Placeholder;


110 


111  


112   Add_Symbol 


113  


114 


115  overriding procedure Add_Symbol


116  (Self : in out Interpretation_Manager;


117  Symbol : Gela.Lexical_Types.Symbol;


118  Result : in out Gela.Interpretations.Interpretation_Set_Index)


119  is


120  Item : constant Gela.Int.Interpretation_Access :=


121  new Gela.Int.Symbols.Symbol'


122  (Gela.Int.Symbols.Create


123  (Down => (1 .. 0 => 0),


124  Value => Symbol));


125  begin


126  Self.Plain_Int_Set.Add (Result, Item);


127  end Add_Symbol;


128 


129  


130   Add_Tuple 


131  


132 


133  overriding procedure Add_Tuple


134  (Self : in out Interpretation_Manager;


135  Left : Gela.Interpretations.Interpretation_Set_Index;


136  Right : Gela.Interpretations.Interpretation_Tuple_Index;


137  Result : out Gela.Interpretations.Interpretation_Tuple_Index)


138  is


139  use type Gela.Interpretations.Interpretation_Tuple_Index;


140  use type Gela.Interpretations.Interpretation_Set_Index_Array;


141 


142  Value : Gela.Interpretations.Interpretation_Index;


143  Item : Gela.Int.Interpretation_Access;


144  begin


145  if Right = 0 then


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


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


148 


149  else


150  declare


151  List : constant Gela.Interpretations.Interpretation_Set_Index_Array


152  := Left & Self.Get_Tuple (Right);


153  begin


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


155  (Gela.Int.Tuples.Create (Value => List));


156  end;


157  end if;


158 


159  Self.Plain_Int_Set.Add (Value, Item);


160 


161  Result := Gela.Interpretations.Interpretation_Tuple_Index (Value);


162  end Add_Tuple;


163 


164  


165   Add_Tuple_List 


166  


167 


168  overriding procedure Add_Tuple_List


169  (Self : in out Interpretation_Manager;


170  Left : Gela.Interpretations.Interpretation_Tuple_Index;


171  Right : Gela.Interpretations.Interpretation_Tuple_List_Index;


172  Result : out Gela.Interpretations.Interpretation_Tuple_List_Index)


173  is


174  begin


175  Self.Add_Tuple


176  (Left => Gela.Interpretations.Interpretation_Set_Index (Left),


177  Right => Gela.Interpretations.Interpretation_Tuple_Index (Right),


178  Result => Gela.Interpretations.Interpretation_Tuple_Index (Result));


179  end Add_Tuple_List;


180 


181  


182   Get_Defining_Name 


183  


184 


185  overriding procedure Get_Defining_Name


186  (Self : in out Interpretation_Manager;


187  Value : Gela.Interpretations.Interpretation_Index;


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


189  is


190  package Each is


191  type Visiter is new Gela.Interpretations.Down_Visiter with record


192  Name : Gela.Elements.Defining_Names.Defining_Name_Access;


193  end record;


194 


195  overriding procedure On_Defining_Name


196  (Self : in out Visiter;


197  Name : Gela.Elements.Defining_Names.Defining_Name_Access;


198  Down : Gela.Interpretations.Interpretation_Index_Array);


199 


200  end Each;


201 


202  


203   Each 


204  


205 


206  package body Each is


207 


208  overriding procedure On_Defining_Name


209  (Self : in out Visiter;


210  Name : Gela.Elements.Defining_Names.Defining_Name_Access;


211  Down : Gela.Interpretations.Interpretation_Index_Array)


212  is


213  pragma Unreferenced (Down);


214  begin


215  Self.Name := Name;


216  end On_Defining_Name;


217 


218  end Each;


219 


220  Visiter : Each.Visiter;


221  begin


222  Self.Visit (Value, Visiter);


223  Result := Visiter.Name;


224  end Get_Defining_Name;


225 


226  


227   Get_Down_Interpretation 


228  


229 


230  overriding procedure Get_Down_Interpretation


231  (Self : in out Interpretation_Manager;


232  Value : Gela.Interpretations.Interpretation_Index;


233  Index : Positive;


234  Result : out Gela.Interpretations.Interpretation_Index)


235  is


236  Item : Gela.Int.Interpretation_Access;


237  begin


238  Result := 0;


239 


240  if Value = 0 then


241  return;


242  end if;


243 


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


245 


246  if Index in Item.Down'Range then


247  Result := Item.Down (Index);


248  end if;


249  end Get_Down_Interpretation;


250 


251  


252   Categories 


253  


254 


255  overriding function Categories


256  (Self : in out Interpretation_Manager;


257  Set : Gela.Interpretations.Interpretation_Set_Index)


258  return Gela.Interpretations.Category_Iterators


259  .Forward_Iterator'Class is


260  begin


261  return Self.Set_Batches.Element (Set / Batch_Size).Categories (Set);


262  end Categories;


263 


264  


265   Defining_Names 


266  


267 


268  overriding function Defining_Names


269  (Self : in out Interpretation_Manager;


270  Set : Gela.Interpretations.Interpretation_Set_Index)


271  return Gela.Interpretations.Defining_Name_Iterators


272  .Forward_Iterator'Class is


273  begin


274  return Self.Set_Batches.Element (Set / Batch_Size).Defining_Names (Set);


275  end Defining_Names;


276 


277  


278   Each 


279  


280 


281  overriding function Each


282  (Self : in out Interpretation_Manager;


283  Set : Gela.Interpretations.Interpretation_Set_Index)


284  return Gela.Interpretations.Any_Iterators


285  .Forward_Iterator'Class is


286  begin


287  return Self.Set_Batches.Element (Set / Batch_Size).Each (Set);


288  end Each;


289 


290  


291   Expressions 


292  


293 


294  overriding function Expressions


295  (Self : in out Interpretation_Manager;


296  Set : Gela.Interpretations.Interpretation_Set_Index)


297  return Gela.Interpretations.Expression_Iterators


298  .Forward_Iterator'Class is


299  begin


300  return Self.Set_Batches.Element (Set / Batch_Size).Expressions (Set);


301  end Expressions;


302 


303  


304   Get_Defining_Name_Index 


305  


306 


307  overriding procedure Get_Defining_Name_Index


308  (Self : in out Interpretation_Manager;


309  Name : Gela.Elements.Defining_Names.Defining_Name_Access;


310  Result : out Gela.Interpretations.Interpretation_Index)


311  is


312  Item : constant Gela.Int.Interpretation_Access :=


313  new Gela.Int.Defining_Names.Defining_Name'


314  (Gela.Int.Defining_Names.Create


315  (Down => (1 .. 0 => 0), Name => Name));


316  begin


317  Self.Plain_Int_Set.Add (Result, Item);


318  end Get_Defining_Name_Index;


319 


320  


321   Get_Expression_Index 


322  


323 


324  overriding procedure Get_Expression_Index


325  (Self : in out Interpretation_Manager;


326  Tipe : Gela.Semantic_Types.Type_Index;


327  Result : out Gela.Interpretations.Interpretation_Index)


328  is


329  Item : constant Gela.Int.Interpretation_Access :=


330  new Gela.Int.Expressions.Expression'


331  (Gela.Int.Expressions.Create


332  (Down => (1 .. 0 => 0),


333  Expression_Type => Tipe,


334  Expression_Kind => Gela.Interpretations.Unknown));


335  begin


336  Self.Plain_Int_Set.Add (Result, Item);


337  end Get_Expression_Index;


338 


339  


340   Get_Tuple 


341  


342 


343  overriding function Get_Tuple


344  (Self : in out Interpretation_Manager;


345  Index : Gela.Interpretations.Interpretation_Tuple_Index)


346  return Gela.Interpretations.Interpretation_Set_Index_Array


347  is


348  Value : constant Gela.Interpretations.Interpretation_Index :=


349  Gela.Interpretations.Interpretation_Index (Index);


350  Item : Gela.Int.Interpretation_Access;


351  begin


352  if Value = 0 then


353  return (1 .. 0 => 0);


354  else


355  Item :=


356  Self.Item_Batches.Element (Value / Batch_Size).Element (Value);


357 


358  return Gela.Int.Tuples.Tuple (Item.all).Value;


359  end if;


360  end Get_Tuple;


361 


362  


363   Get_Tuple_Index 


364  


365 


366  overriding procedure Get_Tuple_Index


367  (Self : in out Interpretation_Manager;


368  Left : Gela.Interpretations.Interpretation_Index;


369  Right : Gela.Interpretations.Interpretation_Index;


370  Result : out Gela.Interpretations.Interpretation_Index)


371  is


372  use type Gela.Interpretations.Interpretation_Index_Array;


373 


374  Item : constant Gela.Int.Interpretation_Access :=


375  new Gela.Int.Tuples.Chosen_Tuple'


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


377  begin


378  Self.Plain_Int_Set.Add (Result, Item);


379  end Get_Tuple_Index;


380 


381  


382   Get_Tuple_List 


383  


384 


385  overriding function Get_Tuple_List


386  (Self : in out Interpretation_Manager;


387  Index : Gela.Interpretations.Interpretation_Tuple_List_Index)


388  return Gela.Interpretations.Interpretation_Tuple_Index_Array


389  is


390  Temp : constant Gela.Interpretations.Interpretation_Set_Index_Array :=


391  Self.Get_Tuple


392  (Gela.Interpretations.Interpretation_Tuple_Index (Index));


393  Result : Gela.Interpretations.Interpretation_Tuple_Index_Array


394  (Temp'Range);


395  begin


396  for J in Temp'Range loop


397  Result (J) :=


398  Gela.Interpretations.Interpretation_Tuple_Index (Temp (J));


399  end loop;


400 


401  return Result;


402  end Get_Tuple_List;


403 


404  


405   Profiles 


406  


407 


408  overriding function Profiles


409  (Self : in out Interpretation_Manager;


410  Set : Gela.Interpretations.Interpretation_Set_Index)


411  return Gela.Interpretations.Profile_Iterators


412  .Forward_Iterator'Class is


413  begin


414  return Self.Set_Batches.Element (Set / Batch_Size).Profiles (Set);


415  end Profiles;


416 


417  


418   Reserve_Indexes 


419  


420 


421  overriding procedure Reserve_Indexes


422  (Self : in out Interpretation_Manager;


423  Set : Gela.Int_Sets.Interpretation_Set_Access;


424  From : out Gela.Interpretations.Interpretation_Set_Index;


425  To : out Gela.Interpretations.Interpretation_Set_Index) is


426  begin


427  Self.Set_Batches.Append (Set);


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


429  To := From + Batch_Size  1;


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


431  end Reserve_Indexes;


432 


433  


434   Reserve_Indexes 


435  


436 


437  overriding procedure Reserve_Indexes


438  (Self : in out Interpretation_Manager;


439  Set : Gela.Int_Sets.Interpretation_Set_Access;


440  From : out Gela.Interpretations.Interpretation_Index;


441  To : out Gela.Interpretations.Interpretation_Index) is


442  begin


443  Self.Item_Batches.Append (Set);


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


445  To := From + Batch_Size  1;


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


447  end Reserve_Indexes;


448 


449  


450   Symbols 


451  


452 


453  overriding function Symbols


454  (Self : in out Interpretation_Manager;


455  Set : Gela.Interpretations.Interpretation_Set_Index)


456  return Gela.Interpretations.Symbol_Iterators


457  .Forward_Iterator'Class is


458  begin


459  return Self.Set_Batches.Element (Set / Batch_Size).Symbols (Set);


460  end Symbols;


461 


462  


463   Visit 


464  


465 


466  overriding procedure Visit


467  (Self : in out Interpretation_Manager;


468  Index : Gela.Interpretations.Interpretation_Index;


469  Target : in out Gela.Interpretations.Down_Visiter'Class)


470  is


471  package Switch is


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


473 


474  overriding procedure Attr_Function


475  (Self : access Visiter;


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


477 


478  overriding procedure Chosen_Tuple


479  (Self : access Visiter;


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


481 


482  overriding procedure Defining_Name


483  (Self : access Visiter;


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


485 


486  overriding procedure Expression


487  (Self : access Visiter;


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


489 


490  overriding procedure Expression_Category


491  (Self : access Visiter;


492  Value : Gela.Int.Categories.Category);


493 


494  overriding procedure Placeholder


495  (Self : access Visiter;


496  Value : Gela.Int.Placeholders.Placeholder);


497 


498  overriding procedure Symbol


499  (Self : access Visiter;


500  Value : Gela.Int.Symbols.Symbol);


501 


502  overriding procedure Tuple


503  (Self : access Visiter;


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


505 


506  end Switch;


507 


508  


509   Switch 


510  


511 


512  package body Switch is


513 


514  


515   Attr_Function 


516  


517 


518  overriding procedure Attr_Function


519  (Self : access Visiter;


520  Value : Gela.Int.Attr_Functions.Attr_Function)


521  is


522  pragma Unreferenced (Self);


523  begin


524  Target.On_Attr_Function


525  (Kind => Value.Kind,


526  Tipe => Value.Tipe,


527  Down => Value.Down);


528  end Attr_Function;


529 


530  


531   Defining_Name 


532  


533 


534  overriding procedure Defining_Name


535  (Self : access Visiter;


536  Value : Gela.Int.Defining_Names.Defining_Name)


537  is


538  pragma Unreferenced (Self);


539  begin


540  Target.On_Defining_Name


541  (Name => Value.Name,


542  Down => Value.Down);


543  end Defining_Name;


544 


545  


546   Expression 


547  


548 


549  overriding procedure Expression


550  (Self : access Visiter;


551  Value : Gela.Int.Expressions.Expression)


552  is


553  pragma Unreferenced (Self);


554  begin


555  Target.On_Expression


556  (Tipe => Value.Expression_Type,


557  Kind => Value.Expression_Kind,


558  Down => Value.Down);


559  end Expression;


560 


561  


562   Expression_Category 


563  


564 


565  overriding procedure Expression_Category


566  (Self : access Visiter;


567  Value : Gela.Int.Categories.Category)


568  is


569  pragma Unreferenced (Self);


570  begin


571  Target.On_Expression_Category


572  (Match => Value.Match,


573  Down => Value.Down);


574  end Expression_Category;


575 


576  


577   Placeholder 


578  


579 


580  overriding procedure Placeholder


581  (Self : access Visiter;


582  Value : Gela.Int.Placeholders.Placeholder)


583  is


584  pragma Unreferenced (Self);


585  begin


586  Target.On_Placeholder


587  (Kind => Value.Placeholder_Kind,


588  Down => Value.Down);


589  end Placeholder;


590 


591  


592   Symbol 


593  


594 


595  overriding procedure Symbol


596  (Self : access Visiter;


597  Value : Gela.Int.Symbols.Symbol)


598  is


599  pragma Unreferenced (Self);


600  begin


601  null;


602   raise Program_Er with "Unexpected up interpretation in down";


603  end Symbol;


604 


605  


606   Tuple 


607  


608 


609  overriding procedure Tuple


610  (Self : access Visiter;


611  Value : Gela.Int.Tuples.Tuple)


612  is


613  pragma Unreferenced (Self);


614  begin


615  raise Program_Error with "Unexpected up interpretation in down";


616  end Tuple;


617 


618  


619   Chosen_Tuple 


620  


621 


622  overriding procedure Chosen_Tuple


623  (Self : access Visiter;


624  Value : Gela.Int.Tuples.Chosen_Tuple)


625  is


626  pragma Unreferenced (Self);


627  begin


628  Target.On_Tuple (Value.Down);


629  end Chosen_Tuple;


630 


631  end Switch;


632 


633  V : aliased Switch.Visiter;


634  begin


635  if Index /= 0 then


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


637  (V'Access);


638  end if;


639  end Visit;


640 


641  end Gela.Plain_Interpretations;

