Changeset 375


Ignore:
Timestamp:
Jan 5, 2015, 10:19:45 AM (6 years ago)
Author:
Maxim Reznik
Message:

Generate Variable_Declaration for String (1 .. Y)

Location:
trunk/compiler
Files:
7 added
10 edited

Legend:

Unmodified
Added
Removed
  • trunk/compiler/source/compiler/gela-engines.adb

    r333 r375  
    3434   end Get;
    3535
     36   ---------
     37   -- Get --
     38   ---------
     39
     40   function Get
     41     (Self     : access Engine;
     42      Element  : Asis.Element;
     43      Property : Gela.Properties.Boolean_Property_Name) return Boolean
     44   is
     45      Key : constant Boolean_Rule_Key :=
     46        (Asis.Extensions.Flat_Kinds.Flat_Kind (Element), Property);
     47      Pos : constant Boolean_Rule_Maps.Cursor :=
     48        Self.Boolean_Rules.Find (Key);
     49      Rule : Boolean_Rule_Callback;
     50   begin
     51      if Boolean_Rule_Maps.Has_Element (Pos) then
     52         Rule := Boolean_Rule_Maps.Element (Pos);
     53
     54         return Rule.all (Self, Element, Property);
     55      else
     56         Ada.Text_IO.Put ("Rule not found for kind ");
     57         Ada.Text_IO.Put
     58           (Asis.Extensions.Flat_Kinds.Element_Flat_Kind'Image (Key.Kind));
     59         Ada.Text_IO.Put (" property ");
     60         Ada.Text_IO.Put_Line
     61           (Gela.Properties.Boolean_Property_Name'Image (Key.Property));
     62         raise Constraint_Error;
     63      end if;
     64   end Get;
     65
    3666   ----------
    3767   -- Hash --
     
    4676      This : constant Ada.Containers.Hash_Type :=
    4777        Gela.Properties.Property_Name'Pos (Item.Property);
     78   begin
     79      return (Last + 1) *
     80        Asis.Extensions.Flat_Kinds.Element_Flat_Kind'Pos (Item.Kind) + This;
     81   end Hash;
     82
     83   ----------
     84   -- Hash --
     85   ----------
     86
     87   function Hash (Item : Boolean_Rule_Key) return Ada.Containers.Hash_Type is
     88      use type Ada.Containers.Hash_Type;
     89
     90      Last : constant Ada.Containers.Hash_Type :=
     91        Gela.Properties.Property_Name'Pos
     92          (Gela.Properties.Property_Name'Last);
     93      This : constant Ada.Containers.Hash_Type :=
     94        Gela.Properties.Boolean_Property_Name'Pos (Item.Property);
    4895   begin
    4996      return (Last + 1) *
     
    122169   end Register_Rule;
    123170
     171   -------------------
     172   -- Register_Rule --
     173   -------------------
     174
     175   procedure Register_Rule
     176     (Self     : in out Engine;
     177      Kind     : Asis.Extensions.Flat_Kinds.Element_Flat_Kind;
     178      Property : Gela.Properties.Boolean_Property_Name;
     179      Action   : Boolean_Rule_Callback;
     180      Redefine : Boolean := False)
     181   is
     182      Key : constant Boolean_Rule_Key := (Kind, Property);
     183   begin
     184      if not Redefine then
     185         Self.Boolean_Rules.Insert (Key, Action);
     186      elsif not Self.Boolean_Rules.Contains (Key) then
     187         raise Constraint_Error with "Not redefined " &
     188           Gela.Properties.Boolean_Property_Name'Image (Property) & " for " &
     189           Asis.Extensions.Flat_Kinds.Element_Flat_Kind'Image (Kind);
     190      else
     191         Self.Boolean_Rules.Include (Key, Action);
     192      end if;
     193   end Register_Rule;
     194
    124195   --------------------
    125196   -- Text_Container --
     
    133204   end Text_Container;
    134205
     206   ------------
     207   -- Unique --
     208   ------------
     209
     210   function Unique (Self : access Engine) return Positive is
     211   begin
     212      Self.Unique := Self.Unique + 1;
     213      return Self.Unique;
     214   end Unique;
     215
    135216end Gela.Engines;
  • trunk/compiler/source/compiler/gela-engines.ads

    r333 r375  
    1717      Property : Gela.Properties.Property_Name)
    1818     return Gela.Properties.Text.Text;
     19
     20   function Get
     21     (Self     : access Engine;
     22      Element  : Asis.Element;
     23      Property : Gela.Properties.Boolean_Property_Name) return Boolean;
    1924
    2025   type Text_Rule_Callback is access function
     
    3843      Action   : Text_Rule_Callback);
    3944
     45   type Boolean_Rule_Callback is access function
     46     (Engine   : access Gela.Engines.Engine;
     47      Element  : Asis.Element;
     48      Property : Gela.Properties.Boolean_Property_Name)
     49     return Boolean;
     50
     51   procedure Register_Rule
     52     (Self     : in out Engine;
     53      Kind     : Asis.Extensions.Flat_Kinds.Element_Flat_Kind;
     54      Property : Gela.Properties.Boolean_Property_Name;
     55      Action   : Boolean_Rule_Callback;
     56      Redefine : Boolean := False);
     57
    4058   function Text_Container
    4159     (Self : access Engine) return Gela.Properties.Text.Text_Container_Access;
     
    4866      Element  : Asis.Element) return Mapped_Element;
    4967   --  Return mapped index or create mapping if absent
     68
     69   function Unique (Self : access Engine) return Positive;
     70   --  Return unique value for each call
    5071
    5172private
     
    6485      Equivalent_Keys => "=");
    6586
     87   type Boolean_Rule_Key is record
     88      Kind     : Asis.Extensions.Flat_Kinds.Element_Flat_Kind;
     89      Property : Gela.Properties.Boolean_Property_Name;
     90   end record;
     91
     92   function Hash (Item : Boolean_Rule_Key) return Ada.Containers.Hash_Type;
     93
     94   package Boolean_Rule_Maps is new Ada.Containers.Hashed_Maps
     95     (Key_Type        => Boolean_Rule_Key,
     96      Element_Type    => Boolean_Rule_Callback,
     97      Hash            => Hash,
     98      Equivalent_Keys => "=");
     99
    66100   function Hash (Item : Asis.Element) return Ada.Containers.Hash_Type;
    67101
     
    75109   type Engine is tagged limited record
    76110      Text_Rules     : Text_Rule_Maps.Map;
     111      Boolean_Rules  : Boolean_Rule_Maps.Map;
    77112      Element_Map    : Element_Maps.Map;
    78113      Next_Mapped    : Mapped_Element := 1;
     114      Unique         : Natural := 0;
    79115      Text_Container : aliased Gela.Properties.Text.Text_Container;
    80116   end record;
  • trunk/compiler/source/compiler/gela-properties.ads

    r333 r375  
    55      Global,   --  Global declaration required for an element
    66      Value,    --  Name (like %123, @id) or value (like 123) of given expr
    7       Non_Static_Value);   --  Like Value, but for non-static expr
     7      Non_Static_Value,   --  Like Value, but for non-static expr
     8      First,    --  Value of T'First
     9      Last,     --  Value of T'Last
     10      Length);  --  Value of T'Last - T'First + 1
     11
     12   type Boolean_Property_Name is
     13     (Is_Local);  --  Check if declaration if local or global
    814
    915end Gela.Properties;
  • trunk/compiler/source/compiler/gela-rule-declarations-defining_identifier.adb

    r325 r375  
    11with Asis.Declarations;
     2with Asis.Elements;
    23
    34package body Gela.Rule.Declarations.Defining_Identifier is
     
    2425      end loop;
    2526
    26       Result := Engine.Text_Container.Literal ("@");
     27      if Engine.Get
     28        (Asis.Elements.Enclosing_Element (Element), Gela.Properties.Is_Local)
     29      then
     30         Result := Engine.Text_Container.Literal ("%");
     31      else
     32         Result := Engine.Text_Container.Literal ("@");
     33      end if;
     34
    2735      Result := Engine.Text_Container.Join (Result, Txt);
    2836
  • trunk/compiler/source/compiler/gela-rule-declarations-subprogram.adb

    r333 r375  
    4545   end Global;
    4646
     47   --------------
     48   -- Is_Local --
     49   --------------
     50
     51   function Is_Local
     52     (Engine   : access Gela.Engines.Engine;
     53      Element  : Asis.Element;
     54      Property : Gela.Properties.Boolean_Property_Name)
     55      return Boolean
     56   is
     57      pragma Unreferenced (Engine, Element, Property);
     58   begin
     59      return False;
     60   end Is_Local;
     61
    4762end Gela.Rule.Declarations.Subprogram;
  • trunk/compiler/source/compiler/gela-rule-declarations-subprogram.ads

    r325 r375  
    1212     return Gela.Properties.Text.Text;
    1313
     14   function Is_Local
     15     (Engine   : access Gela.Engines.Engine;
     16      Element  : Asis.Element;
     17      Property : Gela.Properties.Boolean_Property_Name)
     18     return Boolean;
     19
    1420end Gela.Rule.Declarations.Subprogram;
  • trunk/compiler/source/compiler/gela-rule-declarations-subprogram_body.adb

    r333 r375  
    1313      return Gela.Properties.Text.Text
    1414   is
     15      use type Asis.Element_List;
     16
    1517      Result : Gela.Properties.Text.Text;
    1618      Name   : constant Asis.Defining_Name :=
    1719        Asis.Declarations.Names (Element) (1);
    1820      List   : constant Asis.Statement_List :=
     21        Asis.Declarations.Body_Declarative_Items (Element) &
    1922        Asis.Declarations.Body_Statements (Element);
    2023   begin
    2124      Result := Engine.Text_Container.Literal
    2225        ("%_ada_string = type { i8*, i32, i32 }");
     26
     27      Result := Engine.Text_Container.Join
     28        (Result, Engine.Text_Container.New_Line);
    2329
    2430      Result := Engine.Text_Container.Join
  • trunk/compiler/source/compiler/gela-rule-expressions.adb

    r337 r375  
    9595        Asis.Extensions.Static_Expressions.Static_Value (Element);
    9696   begin
    97       if Asis.Extensions.Static_Expressions.Is_Static (Val) then
     97      if not Val.Is_Static then
     98         return Engine.Get (Element, Gela.Properties.Non_Static_Value);
     99      elsif Val.Is_String then
    98100         declare
    99101            Id     : constant Gela.Engines.Mapped_Element :=
     
    112114         end;
    113115      else
    114          return Engine.Get (Element, Gela.Properties.Non_Static_Value);
     116         declare
     117            Image : constant Wide_String := Val.Value_Image;
     118            Text  : String (Image'Range);
     119         begin
     120            for J in Image'Range loop
     121               Text (J) := Character'Val (Wide_Character'Pos (Image (J)));
     122            end loop;
     123
     124            return Engine.Text_Container.Literal (Text);
     125         end;
    115126      end if;
    116127   end Value;
  • trunk/compiler/source/compiler/gela-rule-register_all.adb

    r333 r375  
    55with Gela.Rule.Declarations.Subprogram;
    66with Gela.Rule.Declarations.Subprogram_Body;
     7with Gela.Rule.Declarations.Variable;
     8with Gela.Rule.Definitions.Simple_Expression_Range;
     9with Gela.Rule.Definitions.Subtype_Definition;
    710with Gela.Rule.Expressions.Identifier;
    811with Gela.Rule.Statements.Procedure_Call;
     
    2124      Property => N.Code,
    2225      Action   => Declarations.Subprogram_Body.Code'Access);
     26   Engine.Register_Rule
     27     (Kind     => F.A_Variable_Declaration,
     28      Property => N.Code,
     29      Action   => Declarations.Variable.Code'Access);
     30   Engine.Register_Rule
     31     (Kind     => F.A_Subtype_Indication,
     32      Property => N.Code,
     33      Action   => Gela.Rule.Empty.Text'Access);
     34   Engine.Register_Rule
     35     (Kind     => F.An_Assignment_Statement,
     36      Property => N.Code,
     37      Action   => Gela.Rule.Empty.Text'Access);
    2338   Engine.Register_Rule
    2439     (Kind     => F.A_Procedure_Call_Statement,
     
    4358      Action   => Gela.Rule.Join_Nested.Text'Access);
    4459   Engine.Register_Rule
     60     (Kind     => F.A_Variable_Declaration,
     61      Property => N.Global,
     62      Action   => Gela.Rule.Join_Nested.Text'Access);
     63   Engine.Register_Rule
     64     (Kind     => F.A_Subtype_Indication,
     65      Property => N.Global,
     66      Action   => Gela.Rule.Empty.Text'Access);
     67   Engine.Register_Rule
     68     (Kind     => F.An_Assignment_Statement,
     69      Property => N.Global,
     70      Action   => Gela.Rule.Join_Nested.Text'Access);
     71   Engine.Register_Rule
    4572     (Kind     => F.A_Procedure_Call_Statement,
    4673      Property => N.Global,
     
    5683      Action   => Gela.Rule.Expressions.Identifier.Global'Access,
    5784      Redefine => True);
     85
     86   Engine.Register_Rule
     87     (Kind     => F.A_Subtype_Indication,
     88      Property => N.Length,
     89      Action   => Gela.Rule.Definitions.Subtype_Definition.Length'Access);
     90   Engine.Register_Rule
     91     (Kind     => F.An_Index_Constraint,
     92      Property => N.Length,
     93      Action   => Gela.Rule.Join_Nested.Text'Access);
     94   Engine.Register_Rule
     95     (Kind     => F.A_Discrete_Simple_Expression_Range_DR,
     96      Property => N.Length,
     97      Action   => Gela.Rule.Definitions.Simple_Expression_Range.Length'Access);
    5898
    5999   Engine.Register_Rule
     
    72112      Action   => Gela.Rule.Expressions.Value'Access);
    73113
     114   Engine.Register_Rule
     115     (Kind     => F.A_Procedure_Declaration,
     116      Property => N.Is_Local,
     117      Action   => Gela.Rule.Declarations.Subprogram.Is_Local'Access);
     118   Engine.Register_Rule
     119     (Kind     => F.A_Procedure_Body_Declaration,
     120      Property => N.Is_Local,
     121      Action   => Gela.Rule.Declarations.Subprogram.Is_Local'Access);
     122   Engine.Register_Rule
     123     (Kind     => F.A_Variable_Declaration,
     124      Property => N.Is_Local,
     125      Action   => Gela.Rule.Declarations.Variable.Is_Local'Access);
     126
    74127end Gela.Rule.Register_All;
    75128
  • trunk/compiler/testsuite/list.txt

    r337 r375  
    22./A/A22006C.ADA 63050
    33./A/A22006D.ADA 00170
     4./A/A26007A.ADT 12594
Note: See TracChangeset for help on using the changeset viewer.