Changeset 389


Ignore:
Timestamp:
Jan 11, 2015, 5:18:59 PM (5 years ago)
Author:
Maxim Reznik
Message:

Implement Asis.Element.Pragma_Kind.

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

Legend:

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

    r378 r389  
    7878  type_definition,
    7979  unconstrained_array_definition,
     80  variant,
    8081
    8182  Array_Component_Choices,
    8283  Associations,
    83   Record_Component_Associations
     84  Record_Component_Associations,
     85  Variant_Choices,
     86  Variants
    8487   : Gela.Interpretations.Interpretation_Index : Down;
    8588
     
    244247Rules for case_statement. :
    245248(.
    246       ${Case_Expression.Down} := 0;  --  FIXME
     249      --  8.6 (9)
     250      Gela.Pass_Utils.Resolve.Interpretation
     251        (Self.Compilation,
     252         ${case_statement.env_in},
     253         ${Case_Expression.Up},
     254         ${Case_Expression.Down});
    247255.)
    248256
     
    299307Rules for Variant_Choices.discrete_choice :
    300308(.
    301       ${discrete_choice.Down} := 0;  --  FIXME
     309      Self.Compilation.Context.Interpretation_Manager.Get_Down_Interpretation
     310        (${Variant_Choices.Down}, 1, ${discrete_choice.Down});
     311.)
     312
     313Rules for Variant_Choices.discrete_choice :
     314(.
     315      Self.Compilation.Context.Interpretation_Manager.Get_Down_Interpretation
     316        (${Variant_Choices.Down}, 2, ${tail.Down});
    302317.)
    303318
     
    314329Rules for discriminant_specification. :
    315330(.
    316       ${Initialization_Expression.Down} := 0;  --  FIXME
     331      -- 3.7 (7)
     332      Gela.Pass_Utils.Resolve.To_Type
     333        (Self.Compilation,
     334         ${discriminant_specification.env_in},
     335         ${Object_Declaration_Subtype.Up},
     336         ${Initialization_Expression.Up:0},
     337         ${Initialization_Expression.Down});
    317338.)
    318339
     
    571592Rules for Exception_Choices.exception_choice :
    572593(.
    573       ${exception_choice.Down} := 0;  --  FIXME
     594      Gela.Pass_Utils.Resolve.Interpretation
     595        (Self.Compilation,
     596         ${Exception_Choices.env_in}, ${exception_choice.Up}, ${exception_choice.Down});
    574597.)
    575598
     
    747770Rules for variant_part. :
    748771(.
    749       ${Discriminant_Direct_Name.Down} := 0;  --  FIXME
     772      Gela.Pass_Utils.Resolve.Interpretation
     773        (Self.Compilation,
     774         ${variant_part.env_in},
     775         ${Discriminant_Direct_Name.Up},
     776         ${Discriminant_Direct_Name.Down});
    750777.)
    751778
     
    824851Rules for discriminant_specification. :
    825852(.
    826       ${Object_Declaration_Subtype.Down} := 0;  --  FIXME
     853      Gela.Pass_Utils.Resolve.Shall_Be_Subtype
     854        (Self.Compilation,
     855         ${discriminant_specification.env_in},
     856         ${Object_Declaration_Subtype.Up},
     857         ${Object_Declaration_Subtype.Down});
    827858.)
    828859
     
    10411072      ${Type_Declaration_View.Down} := 0;  --  FIXME
    10421073.)
     1074
     1075Rules for Variants.variant :
     1076(.
     1077      Self.Compilation.Context.Interpretation_Manager.Get_Down_Interpretation
     1078        (${Variants.Down}, 1, ${variant.Down});
     1079.)
     1080
     1081Rules for Variants.variant :
     1082(.
     1083      Self.Compilation.Context.Interpretation_Manager.Get_Down_Interpretation
     1084        (${Variants.Down}, 2, ${tail.Down});
     1085.)
     1086
     1087Rules for variant. :
     1088(.
     1089      ${Variant_Choices.Down} := ${variant.Down};
     1090.)
     1091
     1092Rules for variant_part. :
     1093(.
     1094      --  Depends on ${Variants.env_out}
     1095      Gela.Pass_Utils.Resolve.Variant_Part
     1096        (Self.Compilation,
     1097         ${Discriminant_Direct_Name.Up},
     1098         ${Variants.Up},
     1099         ${Variants.Down});
     1100.)
  • trunk/ada-2012/src/ag/env_out.ag

    r387 r389  
    433433Rules for discriminant_specification. :
    434434(.
    435       ${discriminant_specification.env_out} := ${discriminant_specification.env_in};
     435      ${discriminant_specification.env_out} :=
     436        Gela.Pass_Utils.Add_Names
     437          (Self.Compilation,
     438           ${discriminant_specification.env_in},
     439           ${Names.name_list},
     440           Names);
    436441.)
    437442
     
    662667Rules for known_discriminant_part. :
    663668(.
    664       ${known_discriminant_part.env_out} := ${known_discriminant_part.env_in};
     669      ${known_discriminant_part.env_out} := ${Discriminants.env_out};
    665670.)
    666671
     
    906911Rules for variant. :
    907912(.
    908       ${variant.env_out} := ${variant.env_in};
     913      ${variant.env_out} := ${Record_Components.env_out};
    909914.)
    910915
    911916Rules for variant_part. :
    912917(.
    913       ${variant_part.env_out} := ${variant_part.env_in};
     918      ${variant_part.env_out} := ${Variants.env_out};
    914919.)
    915920
  • trunk/ada-2012/src/ag/errors.ag

    r381 r389  
    9191  unconstrained_array_definition,
    9292  while_loop_statement,
     93  variant,
     94  variant_part,
    9395  Array_Component_Choices,
    9496  Associations,
     
    9698  Index_Subtype_Definitions,
    9799  Body_Statements,
    98   Record_Component_Associations
     100  Record_Component_Associations,
     101  Variant_Choices,
     102  Variants
    99103
    100104   : Gela.Semantic_Types.Error_Set_Index : Errors;
     
    281285      ${Record_Component_Associations.Errors} := ${association.Errors};
    282286.)
     287Rules for Variant_Choices.discrete_choice :
     288(.
     289      ${Variant_Choices.Errors} := 0;
     290.)
     291Rules for Variant_Choices.discrete_choice :
     292(.
     293      ${Variant_Choices.Errors} := ${discrete_choice.Errors}; --  FIXME
     294.)
     295Rules for Variants.variant :
     296(.
     297      ${Variants.Errors} := 0;
     298.)
     299Rules for Variants.variant :
     300(.
     301      ${Variants.Errors} := ${variant.Errors}; --  FIXME
     302.)
    283303
    284304
     
    440460      ${others_choice.Errors} := 0;  --  FIXME
    441461.)
     462
     463Rules for variant. :
     464(.
     465      ${variant.Errors} := ${Variant_Choices.Errors};  --  FIXME
     466.)
     467Rules for variant_part. :
     468(.
     469      ${variant_part.Errors} := ${Variants.Errors};  --  FIXME
     470.)
  • trunk/ada-2012/src/ag/up.ag

    r367 r389  
    2020  discrete_range,
    2121  discrete_subtype_indication_dr,
     22  exception_choice,
    2223  explicit_dereference,
    2324  expression,
     
    5657  subtype_mark_or_access_definition,
    5758  unconstrained_array_definition,
     59  variant,
    5860 
    5961  Array_Component_Choices,
    6062  Associations,
    61   Record_Component_Associations
     63  Record_Component_Associations,
     64  Variant_Choices,
     65  Variants
    6266   : Gela.Interpretations.Interpretation_Set_Index : Up;
    6367
     
    98102      Self.Compilation.Context.Interpretation_Manager.Add_Tuple
    99103        (${association.Up}, ${tail.Up}, ${Record_Component_Associations.Up});
     104.)
     105
     106Rules for Variant_Choices.discrete_choice :
     107(.
     108      ${Variant_Choices.Up} := 0;
     109.)
     110
     111Rules for Variant_Choices.discrete_choice :
     112(.
     113      ${Variant_Choices.Up} := 0;
     114      Self.Compilation.Context.Interpretation_Manager.Add_Tuple
     115        (${discrete_choice.Up},
     116         ${tail.Up},
     117         ${Variant_Choices.Up});
     118.)
     119
     120Rules for Variants.variant :
     121(.
     122      ${Variants.Up} := 0;
     123.)
     124
     125Rules for Variants.variant :
     126(.
     127      ${Variants.Up} := 0;
     128      Self.Compilation.Context.Interpretation_Manager.Add_Tuple
     129        (${variant.Up},
     130         ${tail.Up},
     131         ${Variants.Up});
    100132.)
    101133
     
    338370Rules for others_choice.others_token :
    339371(.
    340       ${others_choice.Up} := 0;  --  FIXME
    341 .)
     372      ${others_choice.Up} := Gela.Pass_Utils.Resolve.Placeholder (Self.Compilation);
     373.)
     374
     375Rules for variant. :
     376(.
     377      ${variant.Up} := ${Variant_Choices.Up};
     378.)
  • trunk/ada-2012/src/asis/asis-extensions-flat_kinds.adb

    r388 r389  
    952952   overriding procedure Pragma_Node
    953953     (Self : in out Visiter;
    954       Node : not null Gela.Elements.Pragma_Nodes.Pragma_Node_Access)
    955    is null;
     954      Node : not null Gela.Elements.Pragma_Nodes.Pragma_Node_Access);
    956955
    957956   overriding procedure Private_Extension_Declaration
     
    14921491   end Operator_Symbol;
    14931492
     1493   overriding procedure Pragma_Node
     1494     (Self : in out Visiter;
     1495      Node : not null Gela.Elements.Pragma_Nodes.Pragma_Node_Access)
     1496   is
     1497      package X renames Gela.Lexical_Types.Predefined_Symbols;
     1498
     1499      Comp    : constant Gela.Compilations.Compilation_Access :=
     1500        Node.Enclosing_Compilation;
     1501      Token : constant Gela.Lexical_Types.Token :=
     1502        Comp.Get_Token (Node.Pragma_Token);
     1503      Map : constant array
     1504        (Gela.Lexical_Types.Symbol range
     1505           X.All_Calls_Remote .. X.Storage_Size) of Element_Flat_Kind :=
     1506          (X.All_Calls_Remote => An_All_Calls_Remote_Pragma,
     1507           X.Assert => An_Assert_Pragma,
     1508           X.Assertion_Policy => An_Assertion_Policy_Pragma,
     1509           X.Asynchronous => An_Asynchronous_Pragma,
     1510           X.Atomic => An_Atomic_Pragma,
     1511           X.Atomic_Components => An_Atomic_Components_Pragma,
     1512           X.Attach_Handler => An_Attach_Handler_Pragma,
     1513           X.Controlled => A_Controlled_Pragma,
     1514           X.Convention => A_Convention_Pragma,
     1515           X.Detect_Blocking => A_Detect_Blocking_Pragma,
     1516           X.Discard_Names => A_Discard_Names_Pragma,
     1517           X.Elaborate => An_Elaborate_Pragma,
     1518           X.Elaborate_All => An_Elaborate_All_Pragma,
     1519           X.Elaborate_Body => An_Elaborate_Body_Pragma,
     1520           X.Export => An_Export_Pragma,
     1521           X.Import => An_Import_Pragma,
     1522           X.Inline => An_Inline_Pragma,
     1523           X.Inspection_Point => An_Inspection_Point_Pragma,
     1524           X.Interrupt_Handler => An_Interrupt_Handler_Pragma,
     1525           X.Interrupt_Priority => An_Interrupt_Priority_Pragma,
     1526           X.Linker_Options => A_Linker_Options_Pragma,
     1527           X.List => A_List_Pragma,
     1528           X.Locking_Policy => A_Locking_Policy_Pragma,
     1529           X.No_Return => A_No_Return_Pragma,
     1530           X.Normalize_Scalars => A_Normalize_Scalars_Pragma,
     1531           X.Optimize => An_Optimize_Pragma,
     1532           X.Pack => A_Pack_Pragma,
     1533           X.Page => A_Page_Pragma,
     1534           X.Partition_Elaboration_Policy =>
     1535             A_Partition_Elaboration_Policy_Pragma,
     1536           X.Preelaborable_Initialization =>
     1537             A_Preelaborable_Initialization_Pragma,
     1538           X.Preelaborate => A_Preelaborate_Pragma,
     1539           X.Priority => A_Priority_Pragma,
     1540           X.Priority_Specific_Dispatching =>
     1541             A_Priority_Specific_Dispatching_Pragma,
     1542           X.Profile => A_Profile_Pragma,
     1543           X.Pure => A_Pure_Pragma,
     1544           X.Queuing_Policy => A_Queuing_Policy_Pragma,
     1545           X.Relative_Deadline => A_Relative_Deadline_Pragma,
     1546           X.Remote_Call_Interface => A_Remote_Call_Interface_Pragma,
     1547           X.Remote_Types => A_Remote_Types_Pragma,
     1548           X.Restrictions => A_Restrictions_Pragma,
     1549           X.Reviewable => A_Reviewable_Pragma,
     1550           X.Shared_Passive => A_Shared_Passive_Pragma,
     1551           X.Storage_Size => A_Storage_Size_Pragma,
     1552           X.Suppress => A_Suppress_Pragma,
     1553           X.Task_Dispatching_Policy => A_Task_Dispatching_Policy_Pragma,
     1554           X.Unchecked_Union => An_Unchecked_Union_Pragma,
     1555           X.Unsuppress => An_Unsuppress_Pragma,
     1556           X.Volatile => A_Volatile_Pragma,
     1557           X.Volatile_Components => A_Volatile_Components_Pragma,
     1558           others => An_Unknown_Pragma);
     1559
     1560   begin
     1561      if Token.Symbol in Map'Range then
     1562         Self.Result := Map (Token.Symbol);
     1563      else
     1564         Self.Result := An_Unknown_Pragma;
     1565      end if;
     1566   end Pragma_Node;
     1567
    14941568   --------------------
    14951569   -- Procedure_Body --
  • trunk/ada-2012/src/semantic/gela-resolve.adb

    r382 r389  
    998998   end To_Type_Or_The_Same_Type;
    999999
     1000   procedure Variant_Part
     1001     (Comp     : Gela.Compilations.Compilation_Access;
     1002      Name_Up  : Gela.Interpretations.Interpretation_Set_Index;
     1003      Variants : Gela.Interpretations.Interpretation_Set_Index;
     1004      Result   : out Gela.Interpretations.Interpretation_Index)
     1005   is
     1006      pragma Unreferenced (Name_Up);
     1007
     1008      package Each_Variant is
     1009         type Visiter is new Gela.Interpretations.Visiter with record
     1010            null;
     1011         end record;
     1012
     1013         overriding procedure On_Tuple
     1014           (Self  : in out Visiter;
     1015            Value : Gela.Interpretations.Interpretation_Set_Index_Array;
     1016            Down  : Gela.Interpretations.Interpretation_Index_Array);
     1017
     1018      end Each_Variant;
     1019
     1020      package Each_Choice is
     1021         type Visiter is new Gela.Interpretations.Visiter with record
     1022            Index  : Gela.Interpretations.Interpretation_Index := 0;
     1023         end record;
     1024
     1025         overriding procedure On_Tuple
     1026           (Self  : in out Visiter;
     1027            Value : Gela.Interpretations.Interpretation_Set_Index_Array;
     1028            Down  : Gela.Interpretations.Interpretation_Index_Array);
     1029
     1030      end Each_Choice;
     1031
     1032      IM : constant Gela.Interpretations.Interpretation_Manager_Access :=
     1033        Comp.Context.Interpretation_Manager;
     1034
     1035      package body Each_Variant is
     1036
     1037         overriding procedure On_Tuple
     1038           (Self  : in out Visiter;
     1039            Value : Gela.Interpretations.Interpretation_Set_Index_Array;
     1040            Down  : Gela.Interpretations.Interpretation_Index_Array)
     1041         is
     1042            pragma Unreferenced (Down, Self);
     1043
     1044            Chosen : Gela.Interpretations.Interpretation_Index;
     1045            List   : Gela.Interpretations.Interpretation_Index_Array
     1046              (Value'Range);
     1047         begin
     1048            for J in Value'Range loop
     1049               declare
     1050                  V      : aliased Each_Choice.Visiter;
     1051                  Cursor : constant Gela.Interpretations.Cursor'Class :=
     1052                    IM.Get_Cursor (Value (J));
     1053               begin
     1054                  Cursor.Visit (V'Access);
     1055                  List (J) := V.Index;
     1056               end;
     1057            end loop;
     1058
     1059            Chosen := 0;
     1060
     1061            for J in reverse List'Range loop
     1062               IM.Get_Tuple_Index (List (J), Chosen, Chosen);
     1063            end loop;
     1064
     1065            Result := Chosen;
     1066         end On_Tuple;
     1067
     1068      end Each_Variant;
     1069
     1070      package body Each_Choice is
     1071
     1072         overriding procedure On_Tuple
     1073           (Self  : in out Visiter;
     1074            Value : Gela.Interpretations.Interpretation_Set_Index_Array;
     1075            Down  : Gela.Interpretations.Interpretation_Index_Array)
     1076         is
     1077            pragma Unreferenced (Down);
     1078
     1079            Chosen : Gela.Interpretations.Interpretation_Index;
     1080            List   : Gela.Interpretations.Interpretation_Index_Array
     1081              (Value'Range);
     1082         begin
     1083            for J in Value'Range loop
     1084               declare
     1085                  Cursor : Gela.Interpretations.Cursor'Class :=
     1086                    IM.Get_Cursor (Value (J));
     1087               begin
     1088                  List (J) := 0;
     1089                  while Cursor.Has_Element loop
     1090                     List (J) := Cursor.Get_Index;
     1091                     Cursor.Next;
     1092                  end loop;
     1093               end;
     1094            end loop;
     1095
     1096            Chosen := 0;
     1097
     1098            for J in reverse List'Range loop
     1099               IM.Get_Tuple_Index (List (J), Chosen, Chosen);
     1100            end loop;
     1101
     1102            Self.Index := Chosen;
     1103         end On_Tuple;
     1104
     1105      end Each_Choice;
     1106
     1107      Visiter : aliased Each_Variant.Visiter;
     1108      Cursor  : Gela.Interpretations.Cursor'Class := IM.Get_Cursor (Variants);
     1109   begin
     1110      Result := 0;
     1111
     1112      while Cursor.Has_Element loop
     1113         Cursor.Visit (Visiter'Access);
     1114         Cursor.Next;
     1115      end loop;
     1116   end Variant_Part;
     1117
    10001118end Gela.Resolve;
  • trunk/ada-2012/src/semantic/gela-resolve.ads

    r367 r389  
    104104      Result     : out Gela.Interpretations.Interpretation_Index);
    105105
     106   procedure Variant_Part
     107     (Comp     : Gela.Compilations.Compilation_Access;
     108      Name_Up  : Gela.Interpretations.Interpretation_Set_Index;
     109      Variants : Gela.Interpretations.Interpretation_Set_Index;
     110      Result   : out Gela.Interpretations.Interpretation_Index);
     111   --  Resolve variant_part using Name_Up as interpretations of discriminant,
     112   --  Variants is putle of tuples of discrete_choice interpretations
     113
    106114end Gela.Resolve;
Note: See TracChangeset for help on using the changeset viewer.