Changeset 367


Ignore:
Timestamp:
Jan 1, 2015, 12:31:40 PM (6 years ago)
Author:
Maxim Reznik
Message:

Fix interpretation of composite_constraint

Add Placeholder interpretation to put it (as expression) in association
when it represents composite_constraint. Resolve constraint depending
on it kind.

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

Legend:

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

    r366 r367  
    9898Rules for Associations.association :
    9999(.
    100       ${association.Down} := ${Associations.Down};  --  FIXME
     100      Self.Compilation.Context.Interpretation_Manager.Get_Down_Interpretation
     101        (${Associations.Down}, 1, ${association.Down});
    101102.)
    102103
    103104Rules for Associations.association :
    104105(.
    105       ${tail.Down} := ${Associations.Down};  --  FIXME
     106      Self.Compilation.Context.Interpretation_Manager.Get_Down_Interpretation
     107        (${Associations.Down}, 2, ${tail.Down});
    106108.)
    107109
     
    252254Rules for composite_constraint. :
    253255(.
    254       ${Associations.Down} := 0;  --  FIXME
     256      ${Associations.Down} := ${composite_constraint.Down};
    255257.)
    256258
     
    718720Rules for simple_expression_range_dr. :
    719721(.
    720       ${Lower_Bound.Down} := 0;  --  FIXME
     722      Self.Compilation.Context.Interpretation_Manager.Get_Down_Interpretation
     723        (${simple_expression_range_dr.Down}, 1, ${Lower_Bound.Down});
    721724.)
    722725
    723726Rules for simple_expression_range_dr. :
    724727(.
    725       ${Upper_Bound.Down} := 0;  --  FIXME
     728      Self.Compilation.Context.Interpretation_Manager.Get_Down_Interpretation
     729        (${simple_expression_range_dr.Down}, 2, ${Upper_Bound.Down});
    726730.)
    727731
     
    885889Rules for subtype_indication. :
    886890(.
    887       -- 3.5 (5)
    888       Gela.Pass_Utils.Resolve.To_Type
    889         (Self.Compilation,
     891      Gela.Pass_Utils.Resolve.Constraint
     892        (Subtype_Constraint,
    890893         ${subtype_indication.env_in},
    891894         ${subtype_mark.Up},
  • trunk/ada-2012/src/ag/errors.ag

    r363 r367  
    2828  digits_constraint,
    2929  direct_name,
     30  discrete_choice,
     31  discrete_range,
     32  discrete_subtype_indication_dr,
    3033  discrete_range_attribute_reference,
    3134  discrete_simple_expression_range,
     
    5457  object_definition,
    5558  operator_symbol,
     59  others_choice,
    5660  package_declaration,
    5761  parameter_specification,
     
    6468  raise_statement,
    6569  range_attribute_reference,
     70  range_attribute_reference_dr,
    6671  range_constraint,
     72  range_dr,
    6773  record_aggregate,
    6874  requeue_statement,
     
    7480  simple_expression,
    7581  simple_expression_range,
     82  simple_expression_range_dr,
    7683  simple_return_statement,
    7784  statement,
     
    8491  unconstrained_array_definition,
    8592  while_loop_statement,
     93  Array_Component_Choices,
     94  Associations,
    8695  Discrete_Subtype_Definitions,
    8796  Index_Subtype_Definitions,
     
    118127Rules for subtype_indication. :
    119128(.
    120       ${subtype_indication.Errors} := 0;  --  ${Subtype_Constraint.Errors}
     129      ${subtype_indication.Errors} := ${Subtype_Constraint.Errors};
     130.)
     131
     132Rules for discrete_subtype_indication_dr. :
     133(.
     134      ${discrete_subtype_indication_dr.Errors} := ${Subtype_Constraint.Errors};
    121135.)
    122136
     
    133147(.
    134148      ${range_attribute_reference.Errors} := 0;
     149.)
     150Rules for range_attribute_reference_dr.Range_Attribute :
     151(.
     152      ${range_attribute_reference_dr.Errors} := 0;
    135153.)
    136154Rules for simple_expression_range. :
     
    139157      ${simple_expression_range.Errors} := 0;
    140158.)
     159Rules for simple_expression_range_dr. :
     160(.
     161      --  ${Upper_Bound.Errors}, ${Lower_Bound.Errors}
     162      ${simple_expression_range_dr.Errors} := 0;
     163.)
    141164Rules for composite_constraint. :
    142165(.
    143       ${composite_constraint.Errors} := 0;
     166      ${composite_constraint.Errors} := ${Associations.Errors};
    144167.)
    145168Rules for allocator. :
     
    214237      ${short_circuit.Errors} := 0; --  FIXME
    215238.)
     239Rules for Array_Component_Choices.discrete_choice :
     240(.
     241      ${Array_Component_Choices.Errors} := 0;
     242.)
     243Rules for Array_Component_Choices.discrete_choice :
     244(.
     245      ${Array_Component_Choices.Errors} := ${discrete_choice.Errors}; --  FIXME
     246.)
     247Rules for Associations.association :
     248(.
     249      ${Associations.Errors} := 0; --  FIXME
     250.)
    216251Rules for Index_Subtype_Definitions.subtype_mark :
    217252(.
     
    401436      ${box.Errors} := 0;  --  FIXME
    402437.)
     438Rules for others_choice.others_token :
     439(.
     440      ${others_choice.Errors} := 0;  --  FIXME
     441.)
  • trunk/ada-2012/src/ag/up.ag

    r366 r367  
    1717  digits_constraint,
    1818  direct_name,
     19  discrete_choice,
     20  discrete_range,
     21  discrete_subtype_indication_dr,
    1922  explicit_dereference,
    2023  expression,
     
    3033  object_definition,
    3134  operator_symbol,
     35  others_choice,
    3236  prefix,
    3337  program_unit_name,
     
    3539  quantified_expression,
    3640  range_attribute_reference,
     41  range_attribute_reference_dr,
    3742  range_constraint,
     43  range_dr,
    3844  record_aggregate,
    3945  scalar_constraint,
     
    4349  simple_expression,
    4450  simple_expression_range,
     51  simple_expression_range_dr,
    4552  string_literal,
    4653  subtype_indication,
     
    5158 
    5259  Array_Component_Choices,
     60  Associations,
    5361  Record_Component_Associations
    5462   : Gela.Interpretations.Interpretation_Set_Index : Up;
     
    6371      ${Array_Component_Choices.Up} := 0;
    6472      Self.Compilation.Context.Interpretation_Manager.Add_Tuple
    65         (0,  --  {discrete_choice.Up},
    66          ${tail.Up}, ${Array_Component_Choices.Up});
     73        (${discrete_choice.Up},
     74         ${tail.Up},
     75         ${Array_Component_Choices.Up});
     76.)
     77
     78Rules for Associations.association :
     79(.
     80      ${Associations.Up} := 0;
     81.)
     82
     83Rules for Associations.association :
     84(.
     85      ${Associations.Up} := 0;
     86      Self.Compilation.Context.Interpretation_Manager.Add_Tuple
     87        (${association.Up}, ${tail.Up}, ${Associations.Up});
    6788.)
    6889
     
    112133      ${association.Up} := 0;
    113134      Self.Compilation.Context.Interpretation_Manager.Add_Tuple
    114         (${Component_Expression.Up:0}, ${Array_Component_Choices.Up}, ${association.Up});
     135        (${Component_Expression.Up:Gela.Pass_Utils.Resolve.Placeholder (Self.Compilation)},
     136         ${Array_Component_Choices.Up},
     137         ${association.Up});
    115138.)
    116139
     
    128151Rules for composite_constraint. :
    129152(.
    130       ${composite_constraint.Up} := 0;  --  FIXME
     153      ${composite_constraint.Up} := ${Associations.Up};
    131154.)
    132155
     
    178201.)
    179202
     203Rules for range_attribute_reference_dr.Range_Attribute :
     204(.
     205      --  depends on ${range_attribute_reference_dr.env_in}
     206      ${range_attribute_reference_dr.Up} := ${Range_Attribute.Up};
     207.)
     208
    180209Rules for simple_expression_range. :
    181210(.
     
    188217.)
    189218
     219Rules for simple_expression_range_dr. :
     220(.
     221      Gela.Pass_Utils.Resolve.Simple_Expression_Range
     222        (Self.Compilation,
     223         ${simple_expression_range_dr.env_in},
     224         ${Lower_Bound.Up},
     225         ${Upper_Bound.Up},
     226         ${simple_expression_range_dr.Up});
     227.)
     228
    190229Rules for allocator. :
    191230(.
     
    261300.)
    262301
     302Rules for discrete_subtype_indication_dr. :
     303(.
     304      ${discrete_subtype_indication_dr.Up} := ${Subtype_Mark.Up};
     305.)
     306
    263307Rules for anonymous_access_to_object_definition. :
    264308(.
     
    291335      ${box.Up} := 0;  --  FIXME
    292336.)
     337
     338Rules for others_choice.others_token :
     339(.
     340      ${others_choice.Up} := 0;  --  FIXME
     341.)
  • trunk/ada-2012/src/api/gela-interpretations.ads

    r365 r367  
    6666   --  Register chosen tuple interpretation
    6767
     68   type Placeholder_Kind is (Absent);
     69
     70   not overriding procedure Add_Placeholder
     71     (Self   : in out Interpretation_Manager;
     72      Kind   : Gela.Interpretations.Placeholder_Kind;
     73      Result : in out Gela.Interpretations.Interpretation_Set_Index)
     74        is abstract;
     75   --  Placeholder interpretation represents some syntax construct.
     76   --  This eliminates need to traverse syntax tree in some situation
     77
    6878   type Visiter is limited interface;
    6979
     
    8595      Down   : Gela.Interpretations.Interpretation_Index_Array) is null;
    8696   --  Called for each attribute denoting function
     97
     98   not overriding procedure On_Placeholder
     99     (Self   : in out Visiter;
     100      Kind   : Gela.Interpretations.Placeholder_Kind;
     101      Down   : Gela.Interpretations.Interpretation_Index_Array) is null;
     102   --  Called for each placeholder
    87103
    88104   not overriding procedure On_Tuple
  • trunk/ada-2012/src/semantic/gela-int-attr_functions.ads

    r358 r367  
    11with Gela.Lexical_Types;
    2 
    3 --  limited with Gela.Int.Visiters;
    42
    53package Gela.Int.Attr_Functions is
  • trunk/ada-2012/src/semantic/gela-int-defining_names.ads

    r358 r367  
    11with Gela.Elements.Defining_Names;
    2 
    3 limited with Gela.Int.Visiters;
    42
    53package Gela.Int.Defining_Names is
  • trunk/ada-2012/src/semantic/gela-int-expressions.ads

    r358 r367  
    11with Gela.Semantic_Types;
    2 
    3 limited with Gela.Int.Visiters;
    42
    53package Gela.Int.Expressions is
  • trunk/ada-2012/src/semantic/gela-int-placeholders.adb

    r359 r367  
    11with Gela.Int.Visiters;
    22
    3 package body Gela.Int.Expressions is
     3package body Gela.Int.Placeholders 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     (Down : Gela.Interpretations.Interpretation_Index_Array;
     11      Kind : Gela.Interpretations.Placeholder_Kind)
     12      return Placeholder is
    1313   begin
    14       return (Index           => 0,
    15               Length          => Down'Length,
    16               Expression_Type => Expression_Type,
    17               Down            => Down);
     14      return (Index            => 0,
     15              Length           => Down'Length,
     16              Placeholder_Kind => Kind,
     17              Down             => Down);
    1818   end Create;
    1919
    2020   ---------------------
    21    -- Expression_Type --
     21   -- Placeholder_Kind --
    2222   ---------------------
    2323
    24    function Expression_Type
    25      (Self : Expression)
    26       return Gela.Semantic_Types.Type_Index is
     24   function Placeholder_Kind
     25     (Self : Placeholder)
     26      return Gela.Interpretations.Placeholder_Kind is
    2727   begin
    28       return Self.Expression_Type;
    29    end Expression_Type;
     28      return Self.Placeholder_Kind;
     29   end Placeholder_Kind;
    3030
    3131   -----------
     
    3434
    3535   overriding procedure Visit
    36      (Self    : Expression;
     36     (Self    : Placeholder;
    3737      Visiter : access Gela.Int.Visiters.Visiter'Class) is
    3838   begin
    39       Visiter.Expression (Self);
     39      Visiter.Placeholder (Self);
    4040   end Visit;
    4141
    42 end Gela.Int.Expressions;
     42end Gela.Int.Placeholders;
  • trunk/ada-2012/src/semantic/gela-int-placeholders.ads

    r358 r367  
    1 with Gela.Semantic_Types;
    2 
    3 limited with Gela.Int.Visiters;
    4 
    5 package Gela.Int.Expressions is
     1package Gela.Int.Placeholders is
    62   pragma Preelaborate;
    73
    8    type Expression is new Interpretation with private;
     4   type Placeholder is new Interpretation with private;
    95
    106   function Create
    11      (Down            : Gela.Interpretations.Interpretation_Index_Array;
    12       Expression_Type : Gela.Semantic_Types.Type_Index)
    13       return Expression;
     7     (Down : Gela.Interpretations.Interpretation_Index_Array;
     8      Kind : Gela.Interpretations.Placeholder_Kind)
     9      return Placeholder;
    1410
    15    function Expression_Type
    16      (Self : Expression)
    17       return Gela.Semantic_Types.Type_Index;
     11   function Placeholder_Kind
     12     (Self : Placeholder)
     13      return Gela.Interpretations.Placeholder_Kind;
    1814
    1915private
    2016
    21    type Expression is new Interpretation with record
    22       Expression_Type : Gela.Semantic_Types.Type_Index;
     17   type Placeholder is new Interpretation with record
     18      Placeholder_Kind : Gela.Interpretations.Placeholder_Kind;
    2319   end record;
    2420
    2521   overriding procedure Visit
    26      (Self    : Expression;
     22     (Self    : Placeholder;
    2723      Visiter : access Gela.Int.Visiters.Visiter'Class);
    2824
    29 end Gela.Int.Expressions;
     25end Gela.Int.Placeholders;
  • trunk/ada-2012/src/semantic/gela-int-tuples.ads

    r363 r367  
    1 limited with Gela.Int.Visiters;
    2 
    31package Gela.Int.Tuples is
    42   pragma Preelaborate;
  • trunk/ada-2012/src/semantic/gela-int-visiters.ads

    r363 r367  
     1with Gela.Int.Attr_Functions;
    12with Gela.Int.Defining_Names;
    23with Gela.Int.Expressions;
    3 with Gela.Int.Attr_Functions;
     4with Gela.Int.Placeholders;
    45with Gela.Int.Tuples;
    56
     
    89
    910   type Visiter is limited interface;
     11
     12   not overriding procedure Attr_Function
     13     (Self  : access Visiter;
     14      Value : Gela.Int.Attr_Functions.Attr_Function) is abstract;
     15
     16   not overriding procedure Chosen_Tuple
     17     (Self  : access Visiter;
     18      Value : Gela.Int.Tuples.Chosen_Tuple) is abstract;
    1019
    1120   not overriding procedure Defining_Name
     
    1726      Value : Gela.Int.Expressions.Expression) is abstract;
    1827
    19    not overriding procedure Attr_Function
     28   not overriding procedure Placeholder
    2029     (Self  : access Visiter;
    21       Value : Gela.Int.Attr_Functions.Attr_Function) is abstract;
     30      Value : Gela.Int.Placeholders.Placeholder) is abstract;
    2231
    2332   not overriding procedure Tuple
     
    2534      Value : Gela.Int.Tuples.Tuple) is abstract;
    2635
    27    not overriding procedure Chosen_Tuple
    28      (Self  : access Visiter;
    29       Value : Gela.Int.Tuples.Chosen_Tuple) is abstract;
    30 
    3136end Gela.Int.Visiters;
  • trunk/ada-2012/src/semantic/gela-plain_interpretations.adb

    r365 r367  
    22with Gela.Int.Defining_Names;
    33with Gela.Int.Expressions;
     4with Gela.Int.Placeholders;
     5with Gela.Int.Tuples;
    46with Gela.Int.Visiters;
    5 with Gela.Int.Tuples;
    67
    78package body Gela.Plain_Interpretations is
     
    9899   end Add_Expression;
    99100
     101   ---------------------
     102   -- Add_Placeholder --
     103   ---------------------
     104
     105   overriding procedure Add_Placeholder
     106     (Self   : in out Interpretation_Manager;
     107      Kind   : Gela.Interpretations.Placeholder_Kind;
     108      Result : in out Gela.Interpretations.Interpretation_Set_Index)
     109   is
     110      Item : constant Gela.Int.Interpretation_Access :=
     111        new Gela.Int.Placeholders.Placeholder'
     112          (Gela.Int.Placeholders.Create
     113             (Down => (1 .. 0 => 0),
     114              Kind => Kind));
     115   begin
     116      Self.Plian_Int_Set.Add (Result, Item);
     117   end Add_Placeholder;
     118
    100119   ---------------
    101120   -- Add_Tuple --
     
    308327         type Visiter is new Gela.Int.Visiters.Visiter with null record;
    309328
     329         overriding procedure Attr_Function
     330           (Self  : access Visiter;
     331            Value : Gela.Int.Attr_Functions.Attr_Function);
     332
     333         overriding procedure Chosen_Tuple
     334           (Self  : access Visiter;
     335            Value : Gela.Int.Tuples.Chosen_Tuple);
     336
    310337         overriding procedure Defining_Name
    311338           (Self  : access Visiter;
     
    316343            Value : Gela.Int.Expressions.Expression);
    317344
    318          overriding procedure Attr_Function
    319            (Self  : access Visiter;
    320             Value : Gela.Int.Attr_Functions.Attr_Function);
     345         overriding procedure Placeholder
     346           (Self  : access Visiter;
     347            Value : Gela.Int.Placeholders.Placeholder);
    321348
    322349         overriding procedure Tuple
    323350           (Self  : access Visiter;
    324351            Value : Gela.Int.Tuples.Tuple);
    325 
    326          overriding procedure Chosen_Tuple
    327            (Self  : access Visiter;
    328             Value : Gela.Int.Tuples.Chosen_Tuple);
    329352
    330353      end Switch;
     
    380403               Down  => Value.Down);
    381404         end Expression;
     405
     406         -----------------
     407         -- Placeholder --
     408         -----------------
     409
     410         overriding procedure Placeholder
     411           (Self  : access Visiter;
     412            Value : Gela.Int.Placeholders.Placeholder)
     413         is
     414            pragma Unreferenced (Self);
     415         begin
     416            Target.On_Placeholder
     417              (Kind => Value.Placeholder_Kind,
     418               Down => Value.Down);
     419         end Placeholder;
    382420
    383421         -----------
  • trunk/ada-2012/src/semantic/gela-plain_interpretations.ads

    r363 r367  
    7373      Result : in out Gela.Interpretations.Interpretation_Set_Index);
    7474
     75   overriding procedure Add_Placeholder
     76     (Self   : in out Interpretation_Manager;
     77      Kind   : Gela.Interpretations.Placeholder_Kind;
     78      Result : in out Gela.Interpretations.Interpretation_Set_Index);
     79
    7580   overriding procedure Add_Tuple
    7681     (Self   : in out Interpretation_Manager;
  • trunk/ada-2012/src/semantic/gela-plian_int_sets.adb

    r363 r367  
    22with Gela.Int.Defining_Names;
    33with Gela.Int.Expressions;
     4with Gela.Int.Placeholders;
     5with Gela.Int.Tuples;
    46with Gela.Int.Visiters;
    5 with Gela.Int.Tuples;
    67
    78package body Gela.Plian_Int_Sets is
     
    209210         type Visiter is new Gela.Int.Visiters.Visiter with null record;
    210211
     212         overriding procedure Attr_Function
     213           (Self  : access Visiter;
     214            Value : Gela.Int.Attr_Functions.Attr_Function);
     215
     216         overriding procedure Chosen_Tuple
     217           (Self  : access Visiter;
     218            Value : Gela.Int.Tuples.Chosen_Tuple);
     219
    211220         overriding procedure Defining_Name
    212221           (Self  : access Visiter;
     
    217226            Value : Gela.Int.Expressions.Expression);
    218227
    219          overriding procedure Attr_Function
    220            (Self  : access Visiter;
    221             Value : Gela.Int.Attr_Functions.Attr_Function);
     228         overriding procedure Placeholder
     229           (Self  : access Visiter;
     230            Value : Gela.Int.Placeholders.Placeholder);
    222231
    223232         overriding procedure Tuple
     
    225234            Value : Gela.Int.Tuples.Tuple);
    226235
    227          overriding procedure Chosen_Tuple
    228            (Self  : access Visiter;
    229             Value : Gela.Int.Tuples.Chosen_Tuple);
    230236      end Each;
    231237
     
    265271         end Attr_Function;
    266272
     273         overriding procedure Placeholder
     274           (Self  : access Visiter;
     275            Value : Gela.Int.Placeholders.Placeholder)
     276         is
     277            pragma Unreferenced (Self);
     278         begin
     279            Target.On_Placeholder
     280              (Kind => Value.Placeholder_Kind,
     281               Down => Value.Down);
     282         end Placeholder;
     283
    267284         overriding procedure Tuple
    268285           (Self  : access Visiter;
  • trunk/ada-2012/src/semantic/gela-resolve.adb

    r366 r367  
    11with Gela.Defining_Name_Cursors;
     2with Gela.Element_Visiters;
     3with Gela.Elements.Composite_Constraints;
    24with Gela.Elements.Defining_Names;
     5with Gela.Elements.Range_Attribute_References;
     6with Gela.Elements.Simple_Expression_Ranges;
    37with Gela.Environments;
    48with Gela.Type_Managers;
     
    98102   end Attribute_Reference;
    99103
     104   procedure Constraint
     105     (Constraint : Gela.Elements.Constraints.Constraint_Access;
     106      Env        : Gela.Semantic_Types.Env_Index;
     107      Type_Up    : Gela.Interpretations.Interpretation_Set_Index;
     108      Constr     : Gela.Interpretations.Interpretation_Set_Index;
     109      Result     : out Gela.Interpretations.Interpretation_Index)
     110   is
     111      package Each_Constraint is
     112         type Visiter is new Gela.Element_Visiters.Visiter with record
     113            Comp : Gela.Compilations.Compilation_Access;
     114         end record;
     115
     116         overriding procedure Composite_Constraint
     117           (Self : in out Visiter;
     118            Node : not null Gela.Elements.Composite_Constraints.
     119              Composite_Constraint_Access);
     120
     121         overriding procedure Range_Attribute_Reference
     122           (Self : in out Visiter;
     123            Node : not null Gela.Elements.Range_Attribute_References.
     124              Range_Attribute_Reference_Access);
     125
     126         overriding procedure Simple_Expression_Range
     127           (Self : in out Visiter;
     128            Node : not null Gela.Elements.Simple_Expression_Ranges.
     129              Simple_Expression_Range_Access);
     130
     131      end Each_Constraint;
     132
     133      package Each_Tuple is
     134         type Visiter is new Gela.Interpretations.Visiter with record
     135            Comp       : Gela.Compilations.Compilation_Access;
     136            Level      : Positive;
     137            Type_Index : Gela.Semantic_Types.Type_Index;
     138            Index      : Gela.Interpretations.Interpretation_Index;
     139            Success    : Boolean;
     140         end record;
     141
     142         overriding procedure On_Tuple
     143           (Self  : in out Visiter;
     144            Value : Gela.Interpretations.Interpretation_Set_Index_Array;
     145            Down  : Gela.Interpretations.Interpretation_Index_Array);
     146
     147      end Each_Tuple;
     148
     149      package body Each_Constraint is
     150
     151         overriding procedure Composite_Constraint
     152           (Self : in out Visiter;
     153            Node : not null Gela.Elements.Composite_Constraints.
     154              Composite_Constraint_Access)
     155         is
     156            pragma Unreferenced (Node);
     157
     158            IM   : constant Gela.Interpretations.Interpretation_Manager_Access
     159              := Self.Comp.Context.Interpretation_Manager;
     160            Index         : Gela.Interpretations.Interpretation_Index;
     161            Tuple_Visiter : aliased Each_Tuple.Visiter :=
     162              (Comp => Self.Comp, Level => 1, others => <>);
     163            Cursor        : Gela.Interpretations.Cursor'Class :=
     164              IM.Get_Cursor (Constr);
     165         begin
     166            Get_Subtype
     167              (Self.Comp,
     168               Env    => Env,
     169               Set    => Type_Up,
     170               Index  => Index,
     171               Result => Tuple_Visiter.Type_Index);
     172
     173            while Cursor.Has_Element loop
     174               Tuple_Visiter.Success := False;
     175               Cursor.Visit (Tuple_Visiter'Access);
     176
     177               if Tuple_Visiter.Success then
     178                  Result := Tuple_Visiter.Index;
     179               end if;
     180
     181               Cursor.Next;
     182            end loop;
     183         end Composite_Constraint;
     184
     185         overriding procedure Range_Attribute_Reference
     186           (Self : in out Visiter;
     187            Node : not null Gela.Elements.Range_Attribute_References.
     188              Range_Attribute_Reference_Access)
     189         is
     190            pragma Unreferenced (Node);
     191         begin
     192            --  3.5 (5)
     193            Gela.Resolve.To_Type
     194              (Comp    => Self.Comp,
     195               Env     => Env,
     196               Type_Up => Type_Up,
     197               Expr_Up => Constr,
     198               Result  => Result);
     199         end Range_Attribute_Reference;
     200
     201         overriding procedure Simple_Expression_Range
     202           (Self : in out Visiter;
     203            Node : not null Gela.Elements.Simple_Expression_Ranges.
     204              Simple_Expression_Range_Access)
     205         is
     206            pragma Unreferenced (Node);
     207         begin
     208            --  3.5 (5)
     209            Gela.Resolve.To_Type
     210              (Comp    => Self.Comp,
     211               Env     => Env,
     212               Type_Up => Type_Up,
     213               Expr_Up => Constr,
     214               Result  => Result);
     215         end Simple_Expression_Range;
     216
     217      end Each_Constraint;
     218
     219      package body Each_Tuple is
     220
     221         overriding procedure On_Tuple
     222           (Self  : in out Visiter;
     223            Value : Gela.Interpretations.Interpretation_Set_Index_Array;
     224            Down  : Gela.Interpretations.Interpretation_Index_Array)
     225         is
     226            pragma Unreferenced (Down);
     227            IM   : constant Gela.Interpretations.Interpretation_Manager_Access
     228              := Self.Comp.Context.Interpretation_Manager;
     229         begin
     230            if Self.Level = 1 then
     231               declare
     232                  Chosen : Gela.Interpretations.Interpretation_Index;
     233                  List   : Gela.Interpretations.Interpretation_Index_Array
     234                    (Value'Range);
     235               begin
     236                  for J in Value'Range loop
     237                     declare
     238                        Cursor : Gela.Interpretations.Cursor'Class :=
     239                          IM.Get_Cursor (Value (J));
     240                     begin
     241                        Self.Level := 2;
     242                        Self.Index := 0;
     243
     244                        while Cursor.Has_Element loop
     245                           Cursor.Visit (Self'Unchecked_Access);
     246                           Cursor.Next;
     247                        end loop;
     248
     249                        List (J) := Self.Index;
     250                     end;
     251                  end loop;
     252
     253                  Chosen := 0;
     254
     255                  for J in reverse List'Range loop
     256                     IM.Get_Tuple_Index (List (J), Chosen, Chosen);
     257                  end loop;
     258
     259                  Self.Index := Chosen;
     260               end;
     261            else
     262               declare
     263                  Chosen : Gela.Interpretations.Interpretation_Index;
     264                  List   : Gela.Interpretations.Interpretation_Index_Array
     265                    (Value'Range);
     266               begin
     267                  for J in Value'Range loop
     268                     declare
     269                        Cursor : Gela.Interpretations.Cursor'Class :=
     270                          IM.Get_Cursor (Value (J));
     271                     begin
     272                        while Cursor.Has_Element loop
     273                           List (J) := Cursor.Get_Index;
     274                           Cursor.Next;
     275                        end loop;
     276
     277                     end;
     278                  end loop;
     279
     280                  Chosen := 0;
     281
     282                  for J in reverse List'Range loop
     283                     IM.Get_Tuple_Index (List (J), Chosen, Chosen);
     284                  end loop;
     285
     286                  Self.Index := Chosen;
     287                  Self.Success := True;
     288               end;
     289            end if;
     290         end On_Tuple;
     291
     292      end Each_Tuple;
     293
     294      V : Each_Constraint.Visiter;
     295
     296   begin
     297      if not Constraint.Assigned then
     298         Result := 0;
     299         return;
     300      end if;
     301      V.Comp := Constraint.Enclosing_Compilation;
     302
     303      Constraint.Visit (V);
     304
     305   end Constraint;
     306
    100307   -----------------
    101308   -- Direct_Name --
     
    447654         Result => Result);
    448655   end Numeric_Literal;
     656
     657   -----------------
     658   -- Placeholder --
     659   -----------------
     660
     661   function Placeholder
     662     (Comp : Gela.Compilations.Compilation_Access)
     663      return Gela.Interpretations.Interpretation_Set_Index
     664   is
     665      Result : Gela.Interpretations.Interpretation_Set_Index := 0;
     666   begin
     667      Comp.Context.Interpretation_Manager.Add_Placeholder
     668        (Kind   => Gela.Interpretations.Absent,
     669         Result => Result);
     670
     671      return Result;
     672   end Placeholder;
    449673
    450674   ------------------------
  • trunk/ada-2012/src/semantic/gela-resolve.ads

    r286 r367  
    11with Gela.Compilations;
     2with Gela.Elements.Constraints;
    23with Gela.Interpretations;
    34with Gela.Lexical_Types;
     
    9293      Result : out Gela.Interpretations.Interpretation_Index);
    9394
     95   function Placeholder
     96     (Comp : Gela.Compilations.Compilation_Access)
     97      return Gela.Interpretations.Interpretation_Set_Index;
     98
     99   procedure Constraint
     100     (Constraint : Gela.Elements.Constraints.Constraint_Access;
     101      Env        : Gela.Semantic_Types.Env_Index;
     102      Type_Up    : Gela.Interpretations.Interpretation_Set_Index;
     103      Constr     : Gela.Interpretations.Interpretation_Set_Index;
     104      Result     : out Gela.Interpretations.Interpretation_Index);
     105
    94106end Gela.Resolve;
Note: See TracChangeset for help on using the changeset viewer.