Changeset 552


Ignore:
Timestamp:
Jun 30, 2018, 9:31:03 AM (3 years ago)
Author:
Maxim Reznik
Message:

Add Is_The_Same_Type function

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

Legend:

Unmodified
Added
Removed
  • trunk/ada-2012/src/api/gela-types.ads

    r543 r552  
    2222       is abstract;
    2323   --  Defining name of the type for non-anonymous types
     24
     25   not overriding function Is_The_Same_Type
     26     (Left  : Type_View;
     27      Right : Gela.Types.Type_View'Class) return Boolean is abstract;
    2428
    2529   not overriding function Is_Expected_Type
  • trunk/ada-2012/src/semantic/gela-array_type_views.adb

    r543 r552  
    133133     (Self     : Type_View;
    134134      Expected : not null Gela.Types.Type_View_Access)
    135       return Boolean
     135      return Boolean is
     136   begin
     137      return Self.Is_The_Same_Type (Expected.all);
     138   end Is_Expected_Type;
     139
     140   -----------------------
     141   -- Is_Floating_Point --
     142   -----------------------
     143
     144   overriding function Is_Floating_Point (Self : Type_View) return Boolean is
     145      pragma Unreferenced (Self);
     146   begin
     147      return False;
     148   end Is_Floating_Point;
     149
     150   ------------------------
     151   -- Is_Modular_Integer --
     152   ------------------------
     153
     154   overriding function Is_Modular_Integer (Self : Type_View) return Boolean is
     155      pragma Unreferenced (Self);
     156   begin
     157      return False;
     158   end Is_Modular_Integer;
     159
     160   ----------------------
     161   -- Is_Object_Access --
     162   ----------------------
     163
     164   overriding function Is_Object_Access (Self : Type_View) return Boolean is
     165      pragma Unreferenced (Self);
     166   begin
     167      return False;
     168   end Is_Object_Access;
     169
     170   ---------------
     171   -- Is_Record --
     172   ---------------
     173
     174   overriding function Is_Record (Self : Type_View) return Boolean is
     175      pragma Unreferenced (Self);
     176   begin
     177      return False;
     178   end Is_Record;
     179
     180   -------------
     181   -- Is_Root --
     182   -------------
     183
     184   overriding function Is_Root (Self : Type_View) return Boolean is
     185      pragma Unreferenced (Self);
     186   begin
     187      return False;
     188   end Is_Root;
     189
     190   -----------------------
     191   -- Is_Signed_Integer --
     192   -----------------------
     193
     194   overriding function Is_Signed_Integer (Self : Type_View) return Boolean is
     195      pragma Unreferenced (Self);
     196   begin
     197      return False;
     198   end Is_Signed_Integer;
     199
     200   ----------------------
     201   -- Is_The_Same_Type --
     202   ----------------------
     203
     204   overriding function Is_The_Same_Type
     205     (Left  : Type_View;
     206      Right : Gela.Types.Type_View'Class) return Boolean
    136207   is
    137208      use type Gela.Elements.Full_Type_Declarations
    138209        .Full_Type_Declaration_Access;
    139210   begin
    140       if Expected.all in Type_View and then
    141         Self.Decl = Type_View (Expected.all).Decl
     211      if Right in Type_View'Class and then
     212        Left.Decl = Type_View'Class (Right).Decl
    142213      then
    143214         return True;
    144       else
    145          return False;
    146215      end if;
    147    end Is_Expected_Type;
    148 
    149    -----------------------
    150    -- Is_Floating_Point --
    151    -----------------------
    152 
    153    overriding function Is_Floating_Point (Self : Type_View) return Boolean is
    154       pragma Unreferenced (Self);
    155    begin
    156       return False;
    157    end Is_Floating_Point;
    158 
    159    ------------------------
    160    -- Is_Modular_Integer --
    161    ------------------------
    162 
    163    overriding function Is_Modular_Integer (Self : Type_View) return Boolean is
    164       pragma Unreferenced (Self);
    165    begin
    166       return False;
    167    end Is_Modular_Integer;
    168 
    169    ----------------------
    170    -- Is_Object_Access --
    171    ----------------------
    172 
    173    overriding function Is_Object_Access (Self : Type_View) return Boolean is
    174       pragma Unreferenced (Self);
    175    begin
    176       return False;
    177    end Is_Object_Access;
    178 
    179    ---------------
    180    -- Is_Record --
    181    ---------------
    182 
    183    overriding function Is_Record (Self : Type_View) return Boolean is
    184       pragma Unreferenced (Self);
    185    begin
    186       return False;
    187    end Is_Record;
    188 
    189    -------------
    190    -- Is_Root --
    191    -------------
    192 
    193    overriding function Is_Root (Self : Type_View) return Boolean is
    194       pragma Unreferenced (Self);
    195    begin
    196       return False;
    197    end Is_Root;
    198 
    199    -----------------------
    200    -- Is_Signed_Integer --
    201    -----------------------
    202 
    203    overriding function Is_Signed_Integer (Self : Type_View) return Boolean is
    204       pragma Unreferenced (Self);
    205    begin
    206       return False;
    207    end Is_Signed_Integer;
     216
     217      return False;
     218   end Is_The_Same_Type;
    208219
    209220   ------------------
  • trunk/ada-2012/src/semantic/gela-array_type_views.ads

    r543 r552  
    3737   overriding function Category
    3838     (Self : Type_View) return Gela.Type_Categories.Category_Kinds;
     39
     40   overriding function Is_The_Same_Type
     41     (Left  : Type_View;
     42      Right : Gela.Types.Type_View'Class) return Boolean;
    3943
    4044   overriding function Is_Expected_Type
  • trunk/ada-2012/src/semantic/gela-derived_type_views.adb

    r547 r552  
    151151     (Self     : Type_View;
    152152      Expected : not null Gela.Types.Type_View_Access)
    153       return Boolean
    154    is
    155       use type Gela.Elements.Full_Type_Declarations
    156         .Full_Type_Declaration_Access;
    157 
    158    begin
    159       if Expected.all in Type_View and then
    160         Self.Decl = Type_View (Expected.all).Decl
    161       then
     153      return Boolean is
     154   begin
     155      if Self.Is_The_Same_Type (Expected.all) then
    162156         return True;
    163157      end if;
     
    229223   end Is_Signed_Integer;
    230224
     225   ----------------------
     226   -- Is_The_Same_Type --
     227   ----------------------
     228
     229   overriding function Is_The_Same_Type
     230     (Left  : Type_View;
     231      Right : Gela.Types.Type_View'Class) return Boolean
     232    is
     233      use type Gela.Elements.Full_Type_Declarations
     234        .Full_Type_Declaration_Access;
     235   begin
     236      if Right in Type_View'Class and then
     237        Left.Decl = Type_View (Right).Decl
     238      then
     239         return True;
     240      end if;
     241
     242      return False;
     243   end Is_The_Same_Type;
     244
    231245   ------------------
    232246   -- Is_Universal --
  • trunk/ada-2012/src/semantic/gela-derived_type_views.ads

    r547 r552  
    7474     (Self : Type_View) return Gela.Semantic_Types.Type_Index;
    7575
     76   overriding function Is_The_Same_Type
     77     (Left  : Type_View;
     78      Right : Gela.Types.Type_View'Class) return Boolean;
     79
    7680   overriding function Is_Expected_Type
    7781     (Self     : Type_View;
  • trunk/ada-2012/src/semantic/gela-plain_type_views.adb

    r547 r552  
    444444      Matcher : Visitors.Type_Visitor;
    445445   begin
    446       if Expected.all in Type_View'Class and then
    447         Self.Def = Type_View'Class (Expected.all).Def
    448       then
     446      if Self.Is_The_Same_Type (Expected.all) then
    449447         return True;
    450448      end if;
     
    543541        | Gela.Type_Categories.An_Universal_Integer;
    544542   end Is_Signed_Integer;
     543
     544   ----------------------
     545   -- Is_The_Same_Type --
     546   ----------------------
     547
     548   overriding function Is_The_Same_Type
     549     (Left  : Type_View;
     550      Right : Gela.Types.Type_View'Class) return Boolean
     551   is
     552      use type Gela.Elements.Defining_Names.Defining_Name_Access;
     553   begin
     554      if Right in Type_View'Class then
     555         return Left.Name = Type_View'Class (Right).Name;
     556      end if;
     557
     558      return False;
     559   end Is_The_Same_Type;
    545560
    546561   ------------------
  • trunk/ada-2012/src/semantic/gela-plain_type_views.ads

    r547 r552  
    7676      return Gela.Elements.Subtype_Marks.Subtype_Mark_Access;
    7777
     78   overriding function Is_The_Same_Type
     79     (Left  : Type_View;
     80      Right : Gela.Types.Type_View'Class) return Boolean;
     81
    7882   overriding function Is_Expected_Type
    7983     (Self     : Type_View;
Note: See TracChangeset for help on using the changeset viewer.