Changeset 393


Ignore:
Timestamp:
Jan 14, 2015, 5:44:22 AM (5 years ago)
Author:
Maxim Reznik
Message:

Resolve discrete_choices in case_statement

Location:
trunk/ada-2012/src
Files:
7 edited

Legend:

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

    r389 r393  
    1212  box,
    1313  case_expression,
     14  case_path,
    1415  character_literal,
    1516  clause_name,
     
    8283  Array_Component_Choices,
    8384  Associations,
     85  Case_Statement_Paths,
    8486  Record_Component_Associations,
    8587  Variant_Choices,
     
    296298
    297299Rules for Case_Path_Alternative_Choices.discrete_choice :
    298 (.
    299       ${discrete_choice.Down} := 0;  --  FIXME
    300 .)
    301 
    302 Rules for Case_Statement_Alternative_Choices.discrete_choice :
    303300(.
    304301      ${discrete_choice.Down} := 0;  --  FIXME
     
    10851082.)
    10861083
     1084Rules for Case_Statement_Paths.case_path :
     1085(.
     1086      Self.Compilation.Context.Interpretation_Manager.Get_Down_Interpretation
     1087        (${Case_Statement_Paths.Down}, 1, ${case_path.Down});
     1088.)
     1089
     1090Rules for Case_Statement_Paths.case_path :
     1091(.
     1092      Self.Compilation.Context.Interpretation_Manager.Get_Down_Interpretation
     1093        (${Case_Statement_Paths.Down}, 2, ${tail.Down});
     1094.)
     1095
    10871096Rules for variant. :
    10881097(.
     
    10991108         ${Variants.Down});
    11001109.)
     1110
     1111Rules for case_path. :
     1112(.
     1113      ${Variant_Choices.Down} := ${case_path.Down};
     1114.)
     1115
     1116Rules for case_statement. :
     1117(.
     1118      Gela.Pass_Utils.Resolve.Case_Statement
     1119        (Self.Compilation,
     1120         ${Case_Expression.Up},
     1121         ${Case_Statement_Paths.Up},
     1122         ${Case_Statement_Paths.Down});
     1123.)
  • trunk/ada-2012/src/ag/env_in.ag

    r387 r393  
    2323  Case_Expression_Paths,
    2424  Case_Path_Alternative_Choices,
    25   Case_Statement_Alternative_Choices,
    2625  Case_Statement_Paths,
    2726  Clause_Names,
     
    376375      ${discrete_choice.env_in} := ${Case_Path_Alternative_Choices.env_in};
    377376.)
    378 Rules for Case_Statement_Alternative_Choices.discrete_choice :
    379 (.
    380       ${discrete_choice.env_in} := ${Case_Statement_Alternative_Choices.env_in};
    381 .)
    382377Rules for Case_Statement_Paths.case_path :
    383378(.
     
    622617.)
    623618
    624 Rules for Case_Statement_Alternative_Choices.discrete_choice :
    625 (.
    626       ${tail.env_in} := ${Case_Statement_Alternative_Choices.env_in};
    627 .)
    628 
    629619Rules for Case_Statement_Paths.case_path :
    630620(.
     
    1009999Rules for case_path. :
    10101000(.
    1011       ${Case_Statement_Alternative_Choices.env_in} := ${case_path.env_in};
     1001      ${Variant_Choices.env_in} := ${case_path.env_in};
    10121002.)
    10131003
  • trunk/ada-2012/src/ag/errors.ag

    r389 r393  
    1414  box,
    1515  case_expression,
     16  case_path,
    1617  case_statement,
    1718  character_literal,
     
    9596  Array_Component_Choices,
    9697  Associations,
     98  Case_Statement_Paths,
    9799  Discrete_Subtype_Definitions,
    98100  Index_Subtype_Definitions,
     
    277279      ${Body_Statements.Errors} := ${statement.Errors};
    278280.)
     281Rules for Case_Statement_Paths.case_path :
     282(.
     283      ${Case_Statement_Paths.Errors} := 0;
     284.)
     285Rules for Case_Statement_Paths.case_path :
     286(.
     287      ${Case_Statement_Paths.Errors} := ${case_path.Errors}; --  FIXME
     288.)
     289
    279290Rules for Record_Component_Associations.association :
    280291(.
     
    378389Rules for case_statement. :
    379390(.
    380       ${case_statement.Errors} := 0;  --  FIXME
     391      ${case_statement.Errors} := ${Case_Statement_Paths.Errors};  --  FIXME
    381392.)
    382393Rules for delay_statement. :
     
    469480      ${variant_part.Errors} := ${Variants.Errors};  --  FIXME
    470481.)
     482Rules for case_path. :
     483(.
     484      ${case_path.Errors} := ${Variant_Choices.Errors};  --  FIXME
     485.)
  • trunk/ada-2012/src/ag/syntax.ag

    r349 r393  
    239239case_path ::=
    240240    token             <when_token>
    241     {discrete_choice} <Case_Statement_Alternative_Choices>
     241    {discrete_choice} <Variant_Choices>
    242242    token             <arrow_token>
    243243    {statement}       <Sequence_Of_Statements>
  • trunk/ada-2012/src/ag/up.ag

    r389 r393  
    99  box,
    1010  case_expression,
     11  case_path,
    1112  character_literal,
    1213  clause_name,
     
    6162  Array_Component_Choices,
    6263  Associations,
     64  Case_Statement_Paths,
    6365  Record_Component_Associations,
    6466  Variant_Choices,
     
    130132         ${tail.Up},
    131133         ${Variants.Up});
     134.)
     135
     136Rules for Case_Statement_Paths.case_path :
     137(.
     138      ${Case_Statement_Paths.Up} := 0;
     139.)
     140
     141Rules for Case_Statement_Paths.case_path :
     142(.
     143      ${Case_Statement_Paths.Up} := 0;
     144      Self.Compilation.Context.Interpretation_Manager.Add_Tuple
     145        (${case_path.Up},
     146         ${tail.Up},
     147         ${Case_Statement_Paths.Up});
    132148.)
    133149
     
    269285.)
    270286
     287Rules for case_path. :
     288(.
     289      ${case_path.Up} := ${Variant_Choices.Up};
     290.)
     291
    271292Rules for extension_aggregate. :
    272293(.
  • trunk/ada-2012/src/semantic/gela-resolve.adb

    r391 r393  
    2828      Set    : Gela.Interpretations.Interpretation_Set_Index;
    2929      Target : in out Gela.Interpretations.Visiter'Class);
     30
     31   Use_This_Interretation : constant Gela.Interpretations.Interpretation_Index
     32     := Gela.Interpretations.Interpretation_Index'Last;
     33
     34   procedure Wrap_Tuple
     35     (Self   : access Gela.Interpretations.Visiter'Class;
     36      IM     : Gela.Interpretations.Interpretation_Manager_Access;
     37      Value  : Gela.Interpretations.Interpretation_Set_Index_Array;
     38      Found  : access Gela.Interpretations.Interpretation_Index;
     39      Chosen : out Gela.Interpretations.Interpretation_Index);
     40   --  For each Value (J), iterate over its interpretation set and call Self to
     41   --  resolve. Read resolved value from Found. Wrap each resolved value in
     42   --  down interpretation, then return its index as Chosen
     43   --  When Found = Use_This_Interretation use index of current interpretation.
    3044
    3145   -------------------------
     
    103117   end Attribute_Reference;
    104118
     119   --------------------
     120   -- Case_Statement --
     121   --------------------
     122
     123   procedure Case_Statement
     124     (Comp    : Gela.Compilations.Compilation_Access;
     125      Type_Up : Gela.Interpretations.Interpretation_Set_Index;
     126      Tuple   : Gela.Interpretations.Interpretation_Set_Index;
     127      Result  : out Gela.Interpretations.Interpretation_Index)
     128   is
     129      package Each_Tuple is
     130         type Visiter is new Gela.Interpretations.Visiter with null record;
     131
     132         overriding procedure On_Tuple
     133           (Self  : in out Visiter;
     134            Value : Gela.Interpretations.Interpretation_Set_Index_Array;
     135            Down  : Gela.Interpretations.Interpretation_Index_Array);
     136
     137      end Each_Tuple;
     138
     139      package Each_Choice is
     140         type Visiter is new Gela.Interpretations.Visiter with record
     141            Index : aliased Gela.Interpretations.Interpretation_Index;
     142         end record;
     143
     144         overriding procedure On_Tuple
     145           (Self  : in out Visiter;
     146            Value : Gela.Interpretations.Interpretation_Set_Index_Array;
     147            Down  : Gela.Interpretations.Interpretation_Index_Array);
     148
     149      end Each_Choice;
     150
     151      IM   : constant Gela.Interpretations.Interpretation_Manager_Access
     152        := Comp.Context.Interpretation_Manager;
     153
     154      Type_Index : Gela.Semantic_Types.Type_Index;
     155
     156      package body Each_Choice is
     157
     158         overriding procedure On_Tuple
     159           (Self  : in out Visiter;
     160            Value : Gela.Interpretations.Interpretation_Set_Index_Array;
     161            Down  : Gela.Interpretations.Interpretation_Index_Array)
     162         is
     163            pragma Unreferenced (Down);
     164
     165            Chosen : Gela.Interpretations.Interpretation_Index;
     166            List   : Gela.Interpretations.Interpretation_Index_Array
     167              (Value'Range);
     168         begin
     169            for J in Value'Range loop
     170               To_Type
     171                 (Comp    => Comp,
     172                  Type_Up => Type_Index,
     173                  Expr_Up => Value (J),
     174                  Result  => List (J));
     175            end loop;
     176
     177            Chosen := 0;
     178
     179            for J in reverse List'Range loop
     180               IM.Get_Tuple_Index (List (J), Chosen, Chosen);
     181            end loop;
     182
     183            Self.Index := Chosen;
     184         end On_Tuple;
     185
     186      end Each_Choice;
     187
     188      package body Each_Tuple is
     189
     190         overriding procedure On_Tuple
     191           (Self  : in out Visiter;
     192            Value : Gela.Interpretations.Interpretation_Set_Index_Array;
     193            Down  : Gela.Interpretations.Interpretation_Index_Array)
     194         is
     195            pragma Unreferenced (Down, Self);
     196            V      : aliased Each_Choice.Visiter;
     197            Chosen : Gela.Interpretations.Interpretation_Index;
     198         begin
     199            Wrap_Tuple
     200              (Self   => V'Access,
     201               IM     => IM,
     202               Value  => Value,
     203               Found  => V.Index'Access,
     204               Chosen => Chosen);
     205
     206            Result := Chosen;
     207         end On_Tuple;
     208
     209      end Each_Tuple;
     210
     211      Index      : Gela.Interpretations.Interpretation_Index;
     212      Tuple_Visiter : aliased Each_Tuple.Visiter;
     213      Cursor        : Gela.Interpretations.Cursor'Class :=
     214        IM.Get_Cursor (Tuple);
     215   begin
     216      Get_Subtype
     217        (Comp,
     218         Env    => 0,
     219         Set    => Type_Up,
     220         Index  => Index,
     221         Result => Type_Index);
     222
     223      while Cursor.Has_Element loop
     224         Cursor.Visit (Tuple_Visiter'Access);
     225         Cursor.Next;
     226      end loop;
     227   end Case_Statement;
     228
     229   ----------------
     230   -- Constraint --
     231   ----------------
     232
    105233   procedure Constraint
    106234     (Constraint : Gela.Elements.Constraints.Constraint_Access;
     
    111239   is
    112240      package Each_Constraint is
    113          type Visiter is new Gela.Element_Visiters.Visiter with record
    114             Comp : Gela.Compilations.Compilation_Access;
    115          end record;
     241         type Visiter is new Gela.Element_Visiters.Visiter with null record;
    116242
    117243         overriding procedure Composite_Constraint
     
    132258      end Each_Constraint;
    133259
    134       package Each_Tuple is
     260      package Each_Choice is
    135261         type Visiter is new Gela.Interpretations.Visiter with record
    136             Comp       : Gela.Compilations.Compilation_Access;
    137             IM         : Gela.Interpretations.Interpretation_Manager_Access;
    138             Level      : Positive;
    139             Type_Index : Gela.Semantic_Types.Type_Index;
    140             Index      : Gela.Interpretations.Interpretation_Index;
    141             Success    : Boolean;
     262            Index : aliased Gela.Interpretations.Interpretation_Index := 0;
    142263         end record;
     264
     265         overriding procedure On_Expression
     266           (Self   : in out Visiter;
     267            Tipe   : Gela.Semantic_Types.Type_Index;
     268            Down   : Gela.Interpretations.Interpretation_Index_Array);
    143269
    144270         overriding procedure On_Tuple
     
    152278            Down   : Gela.Interpretations.Interpretation_Index_Array);
    153279
     280      end Each_Choice;
     281
     282      package Each_Tuple is
     283         type Visiter is new Gela.Interpretations.Visiter with null record;
     284
     285         overriding procedure On_Tuple
     286           (Self  : in out Visiter;
     287            Value : Gela.Interpretations.Interpretation_Set_Index_Array;
     288            Down  : Gela.Interpretations.Interpretation_Index_Array);
     289
    154290      end Each_Tuple;
     291
     292      Comp       : Gela.Compilations.Compilation_Access;
     293      IM         : Gela.Interpretations.Interpretation_Manager_Access;
     294      Type_Index : Gela.Semantic_Types.Type_Index;
     295
     296      package body Each_Choice is
     297
     298         overriding procedure On_Expression
     299           (Self   : in out Visiter;
     300            Tipe   : Gela.Semantic_Types.Type_Index;
     301            Down   : Gela.Interpretations.Interpretation_Index_Array)
     302         is
     303            pragma Unreferenced (Tipe, Down);
     304         begin
     305            Self.Index := Use_This_Interretation;
     306         end On_Expression;
     307
     308         overriding procedure On_Symbol
     309           (Self   : in out Visiter;
     310            Symbol : Gela.Lexical_Types.Symbol;
     311            Down   : Gela.Interpretations.Interpretation_Index_Array)
     312         is
     313            pragma Unreferenced (Down);
     314            TM : constant Gela.Type_Managers.Type_Manager_Access :=
     315              Comp.Context.Types;
     316            Type_View : constant Gela.Type_Views.Type_View_Access :=
     317              TM.Get (Type_Index);
     318            Name : constant Gela.Elements.Defining_Names.Defining_Name_Access
     319              := Type_View.Get_Discriminant (Symbol);
     320         begin
     321            if Name.Assigned then
     322               IM.Get_Defining_Name_Index (Name, Self.Index);
     323            else
     324               Self.Index := 0;
     325            end if;
     326         end On_Symbol;
     327
     328         overriding procedure On_Tuple
     329           (Self  : in out Visiter;
     330            Value : Gela.Interpretations.Interpretation_Set_Index_Array;
     331            Down  : Gela.Interpretations.Interpretation_Index_Array)
     332         is
     333            pragma Unreferenced (Down);
     334            use type Gela.Semantic_Types.Type_Index;
     335
     336            Chosen : Gela.Interpretations.Interpretation_Index := 0;
     337            List   : Gela.Interpretations.Interpretation_Index_Array
     338              (Value'Range);
     339         begin
     340            --  Resolve expression of association
     341            Interpretation
     342              (Comp   => Comp,
     343               Env    => Env,
     344               Set    => Value (Value'First),
     345               Result => List (Value'First));
     346
     347--            if Type_Index /= 0 then
     348            Wrap_Tuple
     349              (Self   => Self'Access,
     350               IM     => IM,
     351               Value  => Value (Value'First + 1 .. Value'Last),
     352               Found  => Self.Index'Access,
     353               Chosen => Chosen);
     354
     355            IM.Get_Tuple_Index (List (Value'First), Chosen, Chosen);
     356
     357            Self.Index := Chosen;
     358         end On_Tuple;
     359
     360      end Each_Choice;
    155361
    156362      package body Each_Constraint is
     
    161367              Composite_Constraint_Access)
    162368         is
    163             pragma Unreferenced (Node);
    164 
    165             IM   : constant Gela.Interpretations.Interpretation_Manager_Access
    166               := Self.Comp.Context.Interpretation_Manager;
     369            pragma Unreferenced (Node, Self);
     370
    167371            Index         : Gela.Interpretations.Interpretation_Index;
    168             Tuple_Visiter : aliased Each_Tuple.Visiter :=
    169               (Comp => Self.Comp, IM => IM, Level => 1, others => <>);
     372            Tuple_Visiter : aliased Each_Tuple.Visiter;
    170373            Cursor        : Gela.Interpretations.Cursor'Class :=
    171374              IM.Get_Cursor (Constr);
    172375         begin
    173376            Get_Subtype
    174               (Self.Comp,
     377              (Comp,
    175378               Env    => Env,
    176379               Set    => Type_Up,
    177380               Index  => Index,
    178                Result => Tuple_Visiter.Type_Index);
     381               Result => Type_Index);
    179382
    180383            while Cursor.Has_Element loop
    181                Tuple_Visiter.Success := False;
    182384               Cursor.Visit (Tuple_Visiter'Access);
    183 
    184                if Tuple_Visiter.Success then
    185                   Result := Tuple_Visiter.Index;
    186                end if;
    187 
    188385               Cursor.Next;
    189386            end loop;
     
    195392              Range_Attribute_Reference_Access)
    196393         is
    197             pragma Unreferenced (Node);
     394            pragma Unreferenced (Node, Self);
    198395         begin
    199396            --  3.5 (5)
    200397            Gela.Resolve.To_Type
    201               (Comp    => Self.Comp,
     398              (Comp    => Comp,
    202399               Env     => Env,
    203400               Type_Up => Type_Up,
     
    211408              Simple_Expression_Range_Access)
    212409         is
    213             pragma Unreferenced (Node);
     410            pragma Unreferenced (Node, Self);
    214411         begin
    215412            --  3.5 (5)
    216413            Gela.Resolve.To_Type
    217               (Comp    => Self.Comp,
     414              (Comp    => Comp,
    218415               Env     => Env,
    219416               Type_Up => Type_Up,
     
    226423      package body Each_Tuple is
    227424
    228          --  Example:                   Level = 2 --+
    229          --           My_Record                     v
    230          --             (Discriminant_1 | Discriminant_2 => 5,  <-- Level = 1
    231          --              Discriminant_3 | Discriminant_4 => 6); <-- Level = 1
    232          --               ^
    233          --               +---- Level = 2
    234 
    235          overriding procedure On_Symbol
    236            (Self   : in out Visiter;
    237             Symbol : Gela.Lexical_Types.Symbol;
    238             Down   : Gela.Interpretations.Interpretation_Index_Array)
    239          is
    240             pragma Unreferenced (Down);
    241             TM : constant Gela.Type_Managers.Type_Manager_Access :=
    242               Self.Comp.Context.Types;
    243             Type_View : constant Gela.Type_Views.Type_View_Access :=
    244               TM.Get (Self.Type_Index);
    245             Name : constant Gela.Elements.Defining_Names.Defining_Name_Access
    246               := Type_View.Get_Discriminant (Symbol);
    247          begin
    248             if Name.Assigned then
    249                Self.IM.Get_Defining_Name_Index (Name, Self.Index);
    250             else
    251                Self.Index := 0;
    252             end if;
    253          end On_Symbol;
    254 
    255425         overriding procedure On_Tuple
    256426           (Self  : in out Visiter;
     
    258428            Down  : Gela.Interpretations.Interpretation_Index_Array)
    259429         is
    260             pragma Unreferenced (Down);
    261             IM   : constant Gela.Interpretations.Interpretation_Manager_Access
    262               := Self.Comp.Context.Interpretation_Manager;
    263          begin
    264             if Self.Level = 1 then
    265                declare
    266                   Chosen : Gela.Interpretations.Interpretation_Index;
    267                   List   : Gela.Interpretations.Interpretation_Index_Array
    268                     (Value'Range);
    269                begin
    270                   for J in Value'Range loop
    271                      declare
    272                         Cursor : Gela.Interpretations.Cursor'Class :=
    273                           IM.Get_Cursor (Value (J));
    274                      begin
    275                         Self.Level := 2;
    276                         Self.Index := 0;
    277 
    278                         while Cursor.Has_Element loop
    279                            Cursor.Visit (Self'Unchecked_Access);
    280                            Cursor.Next;
    281                         end loop;
    282 
    283                         List (J) := Self.Index;
    284                      end;
    285                   end loop;
    286 
    287                   Chosen := 0;
    288 
    289                   for J in reverse List'Range loop
    290                      IM.Get_Tuple_Index (List (J), Chosen, Chosen);
    291                   end loop;
    292 
    293                   Self.Index := Chosen;
    294                end;
    295             else
    296                declare
    297                   use type Gela.Semantic_Types.Type_Index;
    298 
    299                   Chosen : Gela.Interpretations.Interpretation_Index;
    300                   List   : Gela.Interpretations.Interpretation_Index_Array
    301                     (Value'Range);
    302                begin
    303                   for J in Value'Range loop
    304                      declare
    305                         Cursor : Gela.Interpretations.Cursor'Class :=
    306                           IM.Get_Cursor (Value (J));
    307                      begin
    308                         List (J) := 0;
    309                         while Cursor.Has_Element loop
    310                            if J = Value'First or Self.Type_Index = 0 then
    311                               --  expression of association or
    312                               --  something went wrong
    313                               List (J) := Cursor.Get_Index;
    314                            else
    315                               Cursor.Visit (Self'Access);
    316                               List (J) := Self.Index;
    317                            end if;
    318 
    319                            Cursor.Next;
    320                         end loop;
    321 
    322                      end;
    323                   end loop;
    324 
    325                   Chosen := 0;
    326 
    327                   for J in reverse List'Range loop
    328                      IM.Get_Tuple_Index (List (J), Chosen, Chosen);
    329                   end loop;
    330 
    331                   Self.Index := Chosen;
    332                   Self.Success := True;
    333                end;
    334             end if;
     430            pragma Unreferenced (Down, Self);
     431            Chosen : Gela.Interpretations.Interpretation_Index;
     432            V      : aliased Each_Choice.Visiter;
     433         begin
     434            Wrap_Tuple
     435              (Self   => V'Access,
     436               IM     => IM,
     437               Value  => Value,
     438               Found  => V.Index'Access,
     439               Chosen => Chosen);
     440
     441            Result := Chosen;
    335442         end On_Tuple;
    336443
     
    345452         return;
    346453      end if;
    347       V.Comp := Constraint.Enclosing_Compilation;
     454
     455      Comp := Constraint.Enclosing_Compilation;
     456      pragma Warnings (Off);
     457      --  GNAT GPL 2013 gets warnings here about useless assignment
     458      IM := Comp.Context.Interpretation_Manager;
     459      pragma Warnings (On);
    348460
    349461      Constraint.Visit (V);
    350 
    351462   end Constraint;
    352463
     
    491602      package Each_Association is
    492603         type Visiter is new Gela.Interpretations.Visiter with record
    493             Index  : Gela.Interpretations.Interpretation_Index := 0;
     604            Index  : aliased Gela.Interpretations.Interpretation_Index := 0;
    494605         end record;
    495606
     
    512623            pragma Unreferenced (Down);
    513624
     625            V      : aliased Each_Association.Visiter;
    514626            Chosen : Gela.Interpretations.Interpretation_Index;
    515             List   : Gela.Interpretations.Interpretation_Index_Array
    516               (Value'Range);
    517          begin
    518             for J in Value'Range loop
    519                declare
    520                   V      : aliased Each_Association.Visiter;
    521                   Cursor : constant Gela.Interpretations.Cursor'Class :=
    522                     IM.Get_Cursor (Value (J));
    523                begin
    524                   Cursor.Visit (V'Access);
    525                   List (J) := V.Index;
    526                end;
    527             end loop;
    528 
    529             Chosen := 0;
    530 
    531             for J in reverse List'Range loop
    532                IM.Get_Tuple_Index (List (J), Chosen, Chosen);
    533             end loop;
     627         begin
     628            Wrap_Tuple
     629              (Self   => V'Access,
     630               IM     => IM,
     631               Value  => Value,
     632               Found  => V.Index'Access,
     633               Chosen => Chosen);
    534634
    535635            Comp.Context.Interpretation_Manager.Add_Expression
     
    11221222      package Each_Choice is
    11231223         type Visiter is new Gela.Interpretations.Visiter with record
    1124             Index  : Gela.Interpretations.Interpretation_Index := 0;
     1224            Index  : aliased Gela.Interpretations.Interpretation_Index := 0;
    11251225         end record;
    11261226
     
    11441244            pragma Unreferenced (Down, Self);
    11451245
     1246            V      : aliased Each_Choice.Visiter;
    11461247            Chosen : Gela.Interpretations.Interpretation_Index;
    1147             List   : Gela.Interpretations.Interpretation_Index_Array
    1148               (Value'Range);
    1149          begin
    1150             for J in Value'Range loop
    1151                declare
    1152                   V      : aliased Each_Choice.Visiter;
    1153                   Cursor : constant Gela.Interpretations.Cursor'Class :=
    1154                     IM.Get_Cursor (Value (J));
    1155                begin
    1156                   Cursor.Visit (V'Access);
    1157                   List (J) := V.Index;
    1158                end;
    1159             end loop;
    1160 
    1161             Chosen := 0;
    1162 
    1163             for J in reverse List'Range loop
    1164                IM.Get_Tuple_Index (List (J), Chosen, Chosen);
    1165             end loop;
     1248         begin
     1249            Wrap_Tuple
     1250              (Self   => V'Access,
     1251               IM     => IM,
     1252               Value  => Value,
     1253               Found  => V.Index'Access,
     1254               Chosen => Chosen);
    11661255
    11671256            Result := Chosen;
     
    12181307   end Variant_Part;
    12191308
     1309   ----------------
     1310   -- Wrap_Tuple --
     1311   ----------------
     1312
     1313   procedure Wrap_Tuple
     1314     (Self   : access Gela.Interpretations.Visiter'Class;
     1315      IM     : Gela.Interpretations.Interpretation_Manager_Access;
     1316      Value  : Gela.Interpretations.Interpretation_Set_Index_Array;
     1317      Found  : access Gela.Interpretations.Interpretation_Index;
     1318      Chosen : out Gela.Interpretations.Interpretation_Index)
     1319   is
     1320      List   : Gela.Interpretations.Interpretation_Index_Array (Value'Range) :=
     1321        (others => 0);
     1322   begin
     1323      for J in Value'Range loop
     1324         declare
     1325            use type Gela.Interpretations.Interpretation_Index;
     1326
     1327            Cursor : Gela.Interpretations.Cursor'Class :=
     1328              IM.Get_Cursor (Value (J));
     1329         begin
     1330            while Cursor.Has_Element loop
     1331               Cursor.Visit (Self);
     1332
     1333               if Found.all = Use_This_Interretation then
     1334                  List (J) := Cursor.Get_Index;
     1335                  Found.all := 0;
     1336               elsif Found.all /= 0 then
     1337                  List (J) := Found.all;
     1338                  Found.all := 0;
     1339               end if;
     1340
     1341               Cursor.Next;
     1342            end loop;
     1343
     1344         end;
     1345      end loop;
     1346
     1347      Chosen := 0;
     1348
     1349      for J in reverse List'Range loop
     1350         IM.Get_Tuple_Index (List (J), Chosen, Chosen);
     1351      end loop;
     1352   end Wrap_Tuple;
     1353
    12201354end Gela.Resolve;
  • trunk/ada-2012/src/semantic/gela-resolve.ads

    r389 r393  
    7373   --  to have this type.
    7474
     75   procedure Case_Statement
     76     (Comp    : Gela.Compilations.Compilation_Access;
     77      Type_Up : Gela.Interpretations.Interpretation_Set_Index;
     78      Tuple   : Gela.Interpretations.Interpretation_Set_Index;
     79      Result  : out Gela.Interpretations.Interpretation_Index);
     80   --  Resolve Type_Up to be an expression of some type, then resolve each item
     81   --  of Tuple to have this type.
     82
    7583   procedure To_Type_Or_The_Same_Type
    7684     (Comp    : Gela.Compilations.Compilation_Access;
Note: See TracChangeset for help on using the changeset viewer.