Changeset 363


Ignore:
Timestamp:
Dec 27, 2014, 4:58:32 AM (6 years ago)
Author:
Maxim Reznik
Message:

Express function_call overload resolution rules

New type of interpretation required for this: Tuple.
This interpretation used to gather interpretations of parameter_associations.
Tuples connect sets of interpretations of each param together.
Then we iterate over them and choose matched for function prefix.
Chosen interpretation them get index by call Get_Tuple_Index function.
This function return linked structure of tuples suitable to unwind
during traverse parameter_associations when propagating Down attribute.

Location:
trunk/ada-2012/src
Files:
13 edited
2 copied

Legend:

Unmodified
Added
Removed
  • trunk/ada-2012/src/ag/def_name.ag

    r268 r363  
    2626Rules for operator_symbol.operator_symbol_token :
    2727(.
    28         ${operator_symbol.Defining_Name} := null;
     28      Self.Compilation.Context.Interpretation_Manager.Get_Defining_Name
     29        (${operator_symbol.Down},
     30         ${operator_symbol.Defining_Name});
    2931.)
    3032
  • trunk/ada-2012/src/ag/down.ag

    r360 r363  
    88  anonymous_access_to_object_definition,
    99  anonymous_access_to_procedure_definition,
     10  association,
    1011  attribute_reference,
    1112  box,
     
    7677  subtype_mark_or_access_definition,
    7778  type_definition,
    78   unconstrained_array_definition : Gela.Interpretations.Interpretation_Index : Down;
    79 
     79  unconstrained_array_definition,
     80
     81  Associations,
     82  Record_Component_Associations
     83   : Gela.Interpretations.Interpretation_Index : Down;
     84
     85Rules for Associations.association :
     86(.
     87      ${association.Down} := ${Associations.Down};  --  FIXME
     88.)
     89
     90Rules for Associations.association :
     91(.
     92      ${tail.Down} := ${Associations.Down};  --  FIXME
     93.)
     94
     95Rules for Record_Component_Associations.association :
     96(.
     97      Self.Compilation.Context.Interpretation_Manager.Get_Down_Interpretation
     98        (${Record_Component_Associations.Down}, 1, ${association.Down});
     99.)
     100
     101Rules for Record_Component_Associations.association :
     102(.
     103      Self.Compilation.Context.Interpretation_Manager.Get_Down_Interpretation
     104        (${Record_Component_Associations.Down}, 2, ${tail.Down});
     105.)
    80106
    81107Rules for accept_statement. :
     
    176202Rules for association. :
    177203(.
    178       ${Component_Expression.Down} := 0;  --  FIXME
     204      ${Component_Expression.Down} := ${association.Down};  --  FIXME
    179205.)
    180206
     
    202228(.
    203229      ${Initialization_Expression.Down} := 0;  --  FIXME
     230.)
     231
     232Rules for composite_constraint. :
     233(.
     234      ${Associations.Down} := 0;  --  FIXME
    204235.)
    205236
     
    894925Rules for auxiliary_apply. :
    895926(.
    896       ${Function_Call_Parameters.Down} := 0;  --  FIXME
     927      Self.Compilation.Context.Interpretation_Manager.Get_Down_Interpretation
     928        (${auxiliary_apply.Down}, 2, ${Function_Call_Parameters.Down});
     929.)
     930
     931Rules for extension_aggregate. :
     932(.
     933      ${Record_Component_Associations.Down} := ${extension_aggregate.Down};
     934.)
     935
     936Rules for record_aggregate. :
     937(.
     938      ${Record_Component_Associations.Down} := ${record_aggregate.Down};
    897939.)
    898940
  • trunk/ada-2012/src/ag/errors.ag

    r349 r363  
    177177Rules for record_aggregate. :
    178178(.
    179       ${record_aggregate.Errors} := 0;  --  FIXME
     179      ${record_aggregate.Errors} := ${Record_Component_Associations.Errors};
    180180.)
    181181
     
    395395Rules for association. :
    396396(.
    397       ${association.Errors} := 0;  --  FIXME
     397      ${association.Errors} := ${Component_Expression.Errors:0};  --  FIXME
    398398.)
    399399Rules for box.box_token :
  • trunk/ada-2012/src/ag/up.ag

    r356 r363  
    55  anonymous_access_to_function_definition,
    66  anonymous_access_to_procedure_definition,
     7  association,
    78  attribute_reference,
     9  box,
    810  case_expression,
    911  character_literal,
     
    1719  explicit_dereference,
    1820  expression,
     21  expression_or_box,
    1922  extension_aggregate,
    2023  auxiliary_apply,
     
    4548  subtype_mark,
    4649  subtype_mark_or_access_definition,
    47   unconstrained_array_definition
    48 
     50  unconstrained_array_definition,
     51 
     52  Record_Component_Associations
    4953   : Gela.Interpretations.Interpretation_Set_Index : Up;
     54
     55Rules for Record_Component_Associations.association :
     56(.
     57      ${Record_Component_Associations.Up} := 0;
     58.)
     59
     60Rules for Record_Component_Associations.association :
     61(.
     62      ${Record_Component_Associations.Up} := 0;
     63      Self.Compilation.Context.Interpretation_Manager.Add_Tuple
     64        (${association.Up}, ${tail.Up}, ${Record_Component_Associations.Up});
     65.)
    5066
    5167Rules for identifier.identifier_token :
     
    7692         ${Selector.full_name},
    7793         ${selected_component.Up});
     94.)
     95
     96Rules for association. :
     97(.
     98      --  FIXME
     99      ${association.Up} := ${Component_Expression.Up:0};
    78100.)
    79101
     
    187209(.
    188210      --  LARL syntax has only operator_symbol
    189       ${string_literal.Up} := 0;
     211      --  TEMPORARY {string_literal.Up} := 0;
     212      Gela.Pass_Utils.Resolve.Numeric_Literal
     213        (Self.Compilation,
     214         ${string_literal_token.Index}, ${string_literal.Up});
    190215.)
    191216
     
    198223Rules for record_aggregate. :
    199224(.
    200       ${record_aggregate.Up} := 0;  --  FIXME
     225      ${record_aggregate.Up} := ${Record_Component_Associations.Up};
    201226.)
    202227
     
    246271      ${constrained_array_definition.Up} := 0;  --  FIXME
    247272.)
     273
     274Rules for box.box_token :
     275(.
     276      ${box.Up} := 0;  --  FIXME
     277.)
  • trunk/ada-2012/src/api/gela-interpretations.ads

    r357 r363  
    1515   type Interpretation_Index_Array is array (Positive range <>) of
    1616      Interpretation_Index;
     17
     18   type Interpretation_Set_Index_Array is array (Positive range <>) of
     19      Interpretation_Set_Index;
    1720
    1821   type Interpretation_Manager is limited interface;
     
    4649   --  Extend Result with new interpretation of attribute denoting function
    4750
     51   not overriding procedure Add_Tuple
     52     (Self   : in out Interpretation_Manager;
     53      Left   : Gela.Interpretations.Interpretation_Set_Index;
     54      Right  : Gela.Interpretations.Interpretation_Set_Index;
     55      Result : in out Gela.Interpretations.Interpretation_Set_Index)
     56        is abstract;
     57   --  Extend Result with (Left, Right) tuple aka cartesian product.
     58   --  Left = 0 or else index got by another Add_Tuple call
     59
     60   not overriding procedure Get_Tuple_Index
     61     (Self   : in out Interpretation_Manager;
     62      Left   : Gela.Interpretations.Interpretation_Index;
     63      Right  : Gela.Interpretations.Interpretation_Index;
     64      Result : out Gela.Interpretations.Interpretation_Index)
     65        is abstract;
     66   --  Register chosen tuple interpretation
     67
    4868   type Visiter is limited interface;
    4969
     
    6888        is abstract;
    6989   --  Called for each attribute denoting function
     90
     91   not overriding procedure On_Tuple
     92     (Self  : in out Visiter;
     93      Value : Gela.Interpretations.Interpretation_Set_Index_Array;
     94      Down  : Gela.Interpretations.Interpretation_Index_Array) is abstract;
     95   --  Called for each tuple
    7096
    7197   not overriding procedure Visit
  • trunk/ada-2012/src/asis/asis-expressions.adb

    r344 r363  
    252252           (Self : in out Visiter;
    253253            Node : not null Gela.Elements.Identifiers.Identifier_Access);
     254
     255         overriding procedure Operator_Symbol
     256           (Self : in out Visiter;
     257            Node : not null Gela.Elements.Operator_Symbols.
     258              Operator_Symbol_Access);
     259
    254260      end Get;
    255261
    256262      package body Get is
    257 
    258          ----------------
    259          -- Identifier --
    260          ----------------
    261263
    262264         overriding procedure Identifier
     
    267269            Self.Result := Node.Defining_Name;
    268270         end Identifier;
     271
     272         overriding procedure Operator_Symbol
     273           (Self : in out Visiter;
     274            Node : not null Gela.Elements.Operator_Symbols.
     275              Operator_Symbol_Access) is
     276         begin
     277            Self.Result := Node.Defining_Name;
     278         end Operator_Symbol;
     279
    269280      end Get;
    270281
  • trunk/ada-2012/src/asis/asis-text.adb

    r253 r363  
    135135
    136136   function Element_Span (Element : in Asis.Element) return Span is
     137      use type Gela.Lexical_Types.Token_Count;
     138
    137139      Comp      : constant Gela.Compilations.Compilation_Access :=
    138140        Element.Data.Enclosing_Compilation;
    139       From      : constant Gela.Lexical_Types.Token :=
    140         Comp.Get_Token (Element.Data.First_Token);
    141       To        : constant Gela.Lexical_Types.Token :=
    142         Comp.Get_Token (Element.Data.Last_Token);
    143       From_Line : constant Gela.Lexical_Types.Line_Span :=
    144         Comp.Get_Line_Span (From.Line);
    145       To_Line   : constant Gela.Lexical_Types.Line_Span :=
    146         Comp.Get_Line_Span (From.Line);
    147    begin
    148       return
    149         (First_Line   => Line_Number_Positive (From.Line),
    150          First_Column => Character_Position_Positive
    151            (From.First - From_Line.First + 1),
    152          Last_Line    => Line_Number (To.Line),
    153          Last_Column  => Character_Position (To.Last - To_Line.First + 1));
     141   begin
     142      if Element.Data.First_Token = 0 or Element.Data.Last_Token = 0 then
     143         return Nil_Span;
     144      end if;
     145
     146      declare
     147         From      : constant Gela.Lexical_Types.Token :=
     148           Comp.Get_Token (Element.Data.First_Token);
     149         To        : constant Gela.Lexical_Types.Token :=
     150           Comp.Get_Token (Element.Data.Last_Token);
     151         From_Line : constant Gela.Lexical_Types.Line_Span :=
     152           Comp.Get_Line_Span (From.Line);
     153         To_Line   : constant Gela.Lexical_Types.Line_Span :=
     154           Comp.Get_Line_Span (From.Line);
     155      begin
     156         return
     157           (First_Line   => Line_Number_Positive (From.Line),
     158            First_Column => Character_Position_Positive
     159              (From.First - From_Line.First + 1),
     160            Last_Line    => Line_Number (To.Line),
     161            Last_Column  => Character_Position (To.Last - To_Line.First + 1));
     162      end;
    154163   end Element_Span;
    155164
  • trunk/ada-2012/src/semantic/gela-int-tuples.adb

    r359 r363  
    11with Gela.Int.Visiters;
    22
    3 package body Gela.Int.Expressions is
     3package body Gela.Int.Tuples is
    44
    55   ------------
     
    88
    99   function Create
    10      (Down            : Gela.Interpretations.Interpretation_Index_Array;
    11       Expression_Type : Gela.Semantic_Types.Type_Index)
    12       return Expression is
     10     (Value : Gela.Interpretations.Interpretation_Set_Index_Array)
     11      return Tuple is
    1312   begin
    14       return (Index           => 0,
    15               Length          => Down'Length,
    16               Expression_Type => Expression_Type,
    17               Down            => Down);
     13      return (Index  => 0,
     14              Length => 0,
     15              Value  => Value,
     16              Size   => Value'Length,
     17              Down   => (others => 0));
    1818   end Create;
    1919
    20    ---------------------
    21    -- Expression_Type --
    22    ---------------------
     20   -----------
     21   -- Value --
     22   -----------
    2323
    24    function Expression_Type
    25      (Self : Expression)
    26       return Gela.Semantic_Types.Type_Index is
     24   function Value
     25     (Self : Tuple) return Gela.Interpretations.Interpretation_Set_Index_Array
     26   is
    2727   begin
    28       return Self.Expression_Type;
    29    end Expression_Type;
     28      return Self.Value;
     29   end Value;
    3030
    3131   -----------
     
    3434
    3535   overriding procedure Visit
    36      (Self    : Expression;
     36     (Self    : Tuple;
    3737      Visiter : access Gela.Int.Visiters.Visiter'Class) is
    3838   begin
    39       Visiter.Expression (Self);
     39      Visiter.Tuple (Self);
    4040   end Visit;
    4141
    42 end Gela.Int.Expressions;
     42   -----------
     43   -- Visit --
     44   -----------
     45
     46   overriding procedure Visit
     47     (Self    : Chosen_Tuple;
     48      Visiter : access Gela.Int.Visiters.Visiter'Class) is
     49   begin
     50      Visiter.Chosen_Tuple (Self);
     51   end Visit;
     52
     53end Gela.Int.Tuples;
  • trunk/ada-2012/src/semantic/gela-int-tuples.ads

    r358 r363  
    1 with Gela.Semantic_Types;
    2 
    31limited with Gela.Int.Visiters;
    42
    5 package Gela.Int.Expressions is
     3package Gela.Int.Tuples is
    64   pragma Preelaborate;
    75
    8    type Expression is new Interpretation with private;
     6   type Tuple (<>) is new Interpretation with private;
    97
    108   function Create
    11      (Down            : Gela.Interpretations.Interpretation_Index_Array;
    12       Expression_Type : Gela.Semantic_Types.Type_Index)
    13       return Expression;
     9     (Value : Gela.Interpretations.Interpretation_Set_Index_Array)
     10      return Tuple;
    1411
    15    function Expression_Type
    16      (Self : Expression)
    17       return Gela.Semantic_Types.Type_Index;
     12   function Value
     13     (Self : Tuple) return Gela.Interpretations.Interpretation_Set_Index_Array;
     14
     15   type Chosen_Tuple is new Interpretation with null record;
    1816
    1917private
    2018
    21    type Expression is new Interpretation with record
    22       Expression_Type : Gela.Semantic_Types.Type_Index;
     19   type Tuple (Length : Natural; Size : Positive) is
     20     new Interpretation (Length) with
     21   record
     22      Value : Gela.Interpretations.Interpretation_Set_Index_Array (1 .. Size);
    2323   end record;
    2424
    2525   overriding procedure Visit
    26      (Self    : Expression;
     26     (Self    : Tuple;
    2727      Visiter : access Gela.Int.Visiters.Visiter'Class);
    2828
    29 end Gela.Int.Expressions;
     29   overriding procedure Visit
     30     (Self    : Chosen_Tuple;
     31      Visiter : access Gela.Int.Visiters.Visiter'Class);
     32
     33end Gela.Int.Tuples;
  • trunk/ada-2012/src/semantic/gela-int-visiters.ads

    r286 r363  
    22with Gela.Int.Expressions;
    33with Gela.Int.Attr_Functions;
     4with Gela.Int.Tuples;
    45
    56package Gela.Int.Visiters is
     
    2021      Value : Gela.Int.Attr_Functions.Attr_Function) is abstract;
    2122
     23   not overriding procedure Tuple
     24     (Self  : access Visiter;
     25      Value : Gela.Int.Tuples.Tuple) is abstract;
     26
     27   not overriding procedure Chosen_Tuple
     28     (Self  : access Visiter;
     29      Value : Gela.Int.Tuples.Chosen_Tuple) is abstract;
     30
    2231end Gela.Int.Visiters;
  • trunk/ada-2012/src/semantic/gela-plain_interpretations.adb

    r358 r363  
    33with Gela.Int.Expressions;
    44with Gela.Int.Visiters;
     5with Gela.Int.Tuples;
    56
    67package body Gela.Plain_Interpretations is
     
    9798   end Add_Expression;
    9899
     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
    99176   -----------------------
    100177   -- Get_Defining_Name --
     
    125202            Tipe   : Gela.Lexical_Types.Predefined_Symbols.Attribute;
    126203            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;
    127210      end Each;
    128211
     
    193276
    194277   ---------------------
     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   ---------------------
    195297   -- Reserve_Indexes --
    196298   ---------------------
     
    248350            Value : Gela.Int.Attr_Functions.Attr_Function);
    249351
     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
    250360      end Switch;
    251361
     
    300410               Down  => Value.Down);
    301411         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;
    302438
    303439      end Switch;
  • trunk/ada-2012/src/semantic/gela-plain_interpretations.ads

    r357 r363  
    7373      Result : in out Gela.Interpretations.Interpretation_Set_Index);
    7474
     75   overriding procedure Add_Tuple
     76     (Self   : in out Interpretation_Manager;
     77      Left   : Gela.Interpretations.Interpretation_Set_Index;
     78      Right  : Gela.Interpretations.Interpretation_Set_Index;
     79      Result : in out Gela.Interpretations.Interpretation_Set_Index);
     80
     81   overriding procedure Get_Tuple_Index
     82     (Self   : in out Interpretation_Manager;
     83      Left   : Gela.Interpretations.Interpretation_Index;
     84      Right  : Gela.Interpretations.Interpretation_Index;
     85      Result : out Gela.Interpretations.Interpretation_Index);
     86
    7587   overriding function Get_Cursor
    7688     (Self   : in out Interpretation_Manager;
  • trunk/ada-2012/src/semantic/gela-plian_int_sets.adb

    r359 r363  
    33with Gela.Int.Expressions;
    44with Gela.Int.Visiters;
     5with Gela.Int.Tuples;
    56
    67package body Gela.Plian_Int_Sets is
     
    5556   end Add;
    5657
     58   ---------
     59   -- Add --
     60   ---------
     61
     62   not overriding procedure Add
     63     (Self  : access Interpretation_Set;
     64      Index : out Gela.Interpretations.Interpretation_Index;
     65      Item  : Gela.Int.Interpretation_Access)
     66   is
     67      use type Gela.Interpretations.Interpretation_Index;
     68   begin
     69      if Self.Item_From = Self.Item_To then
     70         Self.Ids.Reserve_Indexes
     71              (Gela.Int_Sets.Interpretation_Set_Access (Self),
     72               Self.Item_From,
     73               Self.Item_To);
     74      end if;
     75
     76      Index := Self.Item_From;
     77      Self.Item_From := Self.Item_From + 1;
     78      Self.Int_Map.Insert (Index, Item);
     79      Item.Index := Index;
     80   end Add;
     81
    5782   -------------
    5883   -- Element --
     
    127152      end if;
    128153
    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;
     154      Self.Set.Add (Result, Item);
    140155
    141156      return Result;
     
    206221            Value : Gela.Int.Attr_Functions.Attr_Function);
    207222
     223         overriding procedure Tuple
     224           (Self  : access Visiter;
     225            Value : Gela.Int.Tuples.Tuple);
     226
     227         overriding procedure Chosen_Tuple
     228           (Self  : access Visiter;
     229            Value : Gela.Int.Tuples.Chosen_Tuple);
    208230      end Each;
    209231
     
    243265         end Attr_Function;
    244266
     267         overriding procedure Tuple
     268           (Self  : access Visiter;
     269            Value : Gela.Int.Tuples.Tuple)
     270         is
     271            pragma Unreferenced (Self);
     272         begin
     273            Target.On_Tuple
     274              (Value => Value.Value,
     275               Down  => (1 .. 0 => 0));
     276         end Tuple;
     277
     278         overriding procedure Chosen_Tuple
     279           (Self  : access Visiter;
     280            Value : Gela.Int.Tuples.Chosen_Tuple)
     281         is
     282            pragma Unreferenced (Self);
     283         begin
     284            Target.On_Tuple
     285              (Value => (1 .. 0 => 0),
     286               Down  => Value.Down);
     287         end Chosen_Tuple;
     288
    245289      end Each;
    246290
  • trunk/ada-2012/src/semantic/gela-plian_int_sets.ads

    r357 r363  
    1717     (Self  : access Interpretation_Set;
    1818      Index : in out Gela.Interpretations.Interpretation_Set_Index;
     19      Item  : Gela.Int.Interpretation_Access);
     20
     21   not overriding procedure Add
     22     (Self  : access Interpretation_Set;
     23      Index : out Gela.Interpretations.Interpretation_Index;
    1924      Item  : Gela.Int.Interpretation_Access);
    2025
  • trunk/ada-2012/src/semantic/gela-resolve.adb

    r358 r363  
    172172            Down   : Gela.Interpretations.Interpretation_Index_Array) is null;
    173173
     174         overriding procedure On_Tuple
     175           (Self  : in out Visiter;
     176            Value : Gela.Interpretations.Interpretation_Set_Index_Array;
     177      Down  : Gela.Interpretations.Interpretation_Index_Array)
     178         is null;
     179
    174180      end Each;
    175181
     
    228234   is
    229235      pragma Unreferenced (Env);
    230       pragma Unreferenced (Args);
     236
     237      use type Gela.Interpretations.Interpretation_Index_Array;
     238
     239      No_Args_Allowed : constant Boolean := True;
     240      --  FIXME Replace with actual check
     241
     242      package Each_Arg is
     243         type Visiter is new Gela.Interpretations.Visiter with record
     244            Index  : Gela.Interpretations.Interpretation_Index := 0;
     245         end record;
     246
     247         overriding procedure On_Defining_Name
     248           (Self   : in out Visiter;
     249            Name   : Gela.Elements.Defining_Names.Defining_Name_Access;
     250            Down   : Gela.Interpretations.Interpretation_Index_Array) is null;
     251
     252         overriding procedure On_Expression
     253           (Self   : in out Visiter;
     254            Tipe   : Gela.Semantic_Types.Type_Index;
     255            Down   : Gela.Interpretations.Interpretation_Index_Array) is null;
     256
     257         overriding procedure On_Attr_Function
     258           (Self   : in out Visiter;
     259            Kind   : Gela.Lexical_Types.Predefined_Symbols.Attribute;
     260            Down   : Gela.Interpretations.Interpretation_Index_Array) is null;
     261
     262         overriding procedure On_Tuple
     263           (Self  : in out Visiter;
     264            Value : Gela.Interpretations.Interpretation_Set_Index_Array;
     265            Down  : Gela.Interpretations.Interpretation_Index_Array);
     266
     267      end Each_Arg;
    231268
    232269      IM : constant Gela.Interpretations.Interpretation_Manager_Access :=
    233270        Comp.Context.Interpretation_Manager;
    234271
    235       Cursor : Gela.Interpretations.Cursor'Class := IM.Get_Cursor (Prefix);
     272      package body Each_Arg is
     273         overriding procedure On_Tuple
     274           (Self  : in out Visiter;
     275            Value : Gela.Interpretations.Interpretation_Set_Index_Array;
     276            Down  : Gela.Interpretations.Interpretation_Index_Array)
     277         is
     278            pragma Unreferenced (Down);
     279
     280            Chosen : Gela.Interpretations.Interpretation_Index;
     281            List   : Gela.Interpretations.Interpretation_Index_Array
     282              (Value'Range);
     283         begin
     284            for J in Value'Range loop
     285               declare
     286                  Cursor : constant Gela.Interpretations.Cursor'Class :=
     287                    IM.Get_Cursor (Value (J));
     288               begin
     289                  List (J) := Cursor.Get_Index;
     290               end;
     291            end loop;
     292
     293            Chosen := 0;
     294
     295            for J in reverse List'Range loop
     296               IM.Get_Tuple_Index (List (J), Chosen, Chosen);
     297            end loop;
     298
     299            Comp.Context.Interpretation_Manager.Add_Expression
     300              (Tipe   => Comp.Context.Types.Universal_Integer,
     301               Down   => Self.Index & Chosen,
     302               Result => Set);
     303         end On_Tuple;
     304      end Each_Arg;
     305
     306      Cursor  : Gela.Interpretations.Cursor'Class := IM.Get_Cursor (Prefix);
    236307   begin
    237308      Set := 0;
    238309
    239310      while Cursor.Has_Element loop
    240          Comp.Context.Interpretation_Manager.Add_Expression
    241            (Tipe   => Comp.Context.Types.Universal_Integer,
    242             Down   => (1 .. 1 => Cursor.Get_Index),
    243             Result => Set);
    244 
    245          Cursor.Next;
     311         declare
     312            Visiter : aliased Each_Arg.Visiter := (Index => Cursor.Get_Index);
     313            Arg     : Gela.Interpretations.Cursor'Class :=
     314              IM.Get_Cursor (Args);
     315         begin
     316            if Arg.Has_Element then
     317               while Arg.Has_Element loop
     318                  Arg.Visit (Visiter'Access);
     319                  Arg.Next;
     320               end loop;
     321            elsif No_Args_Allowed then
     322               Comp.Context.Interpretation_Manager.Add_Expression
     323                 (Tipe   => Comp.Context.Types.Universal_Integer,
     324                  Down   => Visiter.Index & 0,
     325                  Result => Set);
     326            end if;
     327
     328            Cursor.Next;
     329         end;
    246330      end loop;
    247331   end Function_Call;
     
    280364            Kind   : Gela.Lexical_Types.Predefined_Symbols.Attribute;
    281365            Down   : Gela.Interpretations.Interpretation_Index_Array) is null;
     366
     367         overriding procedure On_Tuple
     368           (Self  : in out Visiter;
     369            Value : Gela.Interpretations.Interpretation_Set_Index_Array;
     370            Down  : Gela.Interpretations.Interpretation_Index_Array)
     371         is null;
    282372
    283373      end Each;
     
    398488            Kind   : Gela.Lexical_Types.Predefined_Symbols.Attribute;
    399489            Down   : Gela.Interpretations.Interpretation_Index_Array) is null;
     490
     491         overriding procedure On_Tuple
     492           (Self  : in out Visiter;
     493            Value : Gela.Interpretations.Interpretation_Set_Index_Array;
     494            Down  : Gela.Interpretations.Interpretation_Index_Array)
     495         is null;
    400496
    401497      end Each;
     
    537633            Down   : Gela.Interpretations.Interpretation_Index_Array) is null;
    538634
     635         overriding procedure On_Tuple
     636           (Self  : in out Visiter;
     637            Value : Gela.Interpretations.Interpretation_Set_Index_Array;
     638            Down  : Gela.Interpretations.Interpretation_Index_Array)
     639         is null;
     640
    539641      end Each;
    540642
     
    630732            Kind   : Gela.Lexical_Types.Predefined_Symbols.Attribute;
    631733            Down   : Gela.Interpretations.Interpretation_Index_Array) is null;
     734
     735         overriding procedure On_Tuple
     736           (Self  : in out Visiter;
     737            Value : Gela.Interpretations.Interpretation_Set_Index_Array;
     738            Down  : Gela.Interpretations.Interpretation_Index_Array)
     739         is null;
    632740
    633741      end Each;
Note: See TracChangeset for help on using the changeset viewer.