Browse Source

Completely reworked implementation of generic constraints, by moving the generic constraint data from the symbols to the definitions (I originally thought that this would simplyfy things, but the more correct approach is to add it to the defs).

symsym.pas:
    - remove "tgenericconstraintdata" and any using/loading/writing of it in "ttypesym"
    - remove "tgenericconstraintflag"
symdef.pas:
    + add "tgenericconstraintdata"
    + load and write "genconstraintdata" in "tstoreddef"
symconst.pas:
    + add "tgenericconstraintflag" so it can be used in "ppudump" as well
defcmp.pas, compare_defs_ext:
    * as we allow global operator overloads we can't really determine whether two defs are compatible, because a valid operator for the specialization types might just happen to be in scope of the generic; so for now constraints are only strictly checked when declaring a specialization
pgenutil.pas:
    * adjust "parse_generic_parameters" and "check_generic_constraints" to the new location of the constraint data
ppudump.pp:
    * corrrectly parse defs which contain generic constraints

git-svn-id: trunk@24628 -
svenbarth 12 years ago
parent
commit
956b26bc97
6 changed files with 238 additions and 188 deletions
  1. 16 5
      compiler/defcmp.pas
  2. 77 74
      compiler/pgenutil.pas
  3. 8 0
      compiler/symconst.pas
  4. 93 0
      compiler/symdef.pas
  5. 0 109
      compiler/symsym.pas
  6. 44 0
      compiler/utils/ppuutils/ppudump.pp

+ 16 - 5
compiler/defcmp.pas

@@ -245,8 +245,13 @@ implementation
 
 
              { if only one def is a undefined def then they are not considered as
              { if only one def is a undefined def then they are not considered as
                equal}
                equal}
-             if (def_from.typ=undefineddef) or
-                (def_to.typ=undefineddef) then
+             if (
+                   (def_from.typ=undefineddef) or
+                   assigned(tstoreddef(def_from).genconstraintdata)
+                 ) or (
+                   (def_to.typ=undefineddef) or
+                   assigned(tstoreddef(def_to).genconstraintdata)
+                 ) then
               begin
               begin
                 doconv:=tc_not_possible;
                 doconv:=tc_not_possible;
                 compare_defs_ext:=te_incompatible;
                 compare_defs_ext:=te_incompatible;
@@ -255,9 +260,15 @@ implementation
            end
            end
          else
          else
            begin
            begin
-             { undefined defs are considered equal }
-             if (def_from.typ=undefineddef) or
-                (def_to.typ=undefineddef) then
+             { undefined defs or defs with generic constraints are
+               considered equal to everything }
+             if (
+                   (def_from.typ=undefineddef) or
+                   assigned(tstoreddef(def_from).genconstraintdata)
+                 ) or (
+                   (def_to.typ=undefineddef) or
+                   assigned(tstoreddef(def_to).genconstraintdata)
+                 ) then
               begin
               begin
                 doconv:=tc_equal;
                 doconv:=tc_equal;
                 compare_defs_ext:=te_exact;
                 compare_defs_ext:=te_exact;

+ 77 - 74
compiler/pgenutil.pas

@@ -102,11 +102,11 @@ uses
       var
       var
         i,j,
         i,j,
         intfcount : longint;
         intfcount : longint;
+        formaldef,
         paradef : tstoreddef;
         paradef : tstoreddef;
         objdef,
         objdef,
         paraobjdef,
         paraobjdef,
         formalobjdef : tobjectdef;
         formalobjdef : tobjectdef;
-        generictype : ttypesym;
         intffound : boolean;
         intffound : boolean;
         filepos : tfileposinfo;
         filepos : tfileposinfo;
       begin
       begin
@@ -121,22 +121,25 @@ uses
         result:=true;
         result:=true;
         for i:=0 to genericdef.genericparas.count-1 do
         for i:=0 to genericdef.genericparas.count-1 do
           begin
           begin
-            generictype:=ttypesym(genericdef.genericparas[i]);
             filepos:=pfileposinfo(poslist[i])^;
             filepos:=pfileposinfo(poslist[i])^;
-            if not assigned(generictype.genconstraintdata) then
+            formaldef:=tstoreddef(ttypesym(genericdef.genericparas[i]).typedef);
+            if formaldef.typ=undefineddef then
               { the parameter is of unspecified type, so no need to check }
               { the parameter is of unspecified type, so no need to check }
               continue;
               continue;
+            if not (df_genconstraint in formaldef.defoptions) or
+                not assigned(formaldef.genconstraintdata) then
+              internalerror(2013021602);
             paradef:=tstoreddef(paradeflist[i]);
             paradef:=tstoreddef(paradeflist[i]);
             { undefineddef is compatible with anything }
             { undefineddef is compatible with anything }
-            if generictype.typedef.typ=undefineddef then
+            if formaldef.typ=undefineddef then
               continue;
               continue;
-            if paradef.typ<>generictype.typedef.typ then
+            if paradef.typ<>formaldef.typ then
               begin
               begin
-                case generictype.typedef.typ of
+                case formaldef.typ of
                   recorddef:
                   recorddef:
                     MessagePos(filepos,type_e_record_type_expected);
                     MessagePos(filepos,type_e_record_type_expected);
                   objectdef:
                   objectdef:
-                    case tobjectdef(generictype.typedef).objecttype of
+                    case tobjectdef(formaldef).objecttype of
                       odt_class,
                       odt_class,
                       odt_javaclass:
                       odt_javaclass:
                         MessagePos1(filepos,type_e_class_type_expected,paradef.typename);
                         MessagePos1(filepos,type_e_class_type_expected,paradef.typename);
@@ -160,10 +163,10 @@ uses
               begin
               begin
                 { the paradef types are the same, so do special checks for the
                 { the paradef types are the same, so do special checks for the
                   cases in which they are needed }
                   cases in which they are needed }
-                if generictype.typedef.typ=objectdef then
+                if formaldef.typ=objectdef then
                   begin
                   begin
                     paraobjdef:=tobjectdef(paradef);
                     paraobjdef:=tobjectdef(paradef);
-                    formalobjdef:=tobjectdef(generictype.typedef);
+                    formalobjdef:=tobjectdef(formaldef);
                     if not (formalobjdef.objecttype in [odt_class,odt_javaclass,odt_interfacecom,odt_interfacecorba,odt_interfacejava,odt_dispinterface]) then
                     if not (formalobjdef.objecttype in [odt_class,odt_javaclass,odt_interfacecom,odt_interfacecorba,odt_interfacejava,odt_dispinterface]) then
                       internalerror(2012101102);
                       internalerror(2012101102);
                     if formalobjdef.objecttype in [odt_interfacecom,odt_interfacecorba,odt_interfacejava,odt_dispinterface] then
                     if formalobjdef.objecttype in [odt_interfacecom,odt_interfacecorba,odt_interfacejava,odt_dispinterface] then
@@ -175,9 +178,9 @@ uses
                           odt_interfacecorba,
                           odt_interfacecorba,
                           odt_interfacejava,
                           odt_interfacejava,
                           odt_dispinterface:
                           odt_dispinterface:
-                            if not paraobjdef.is_related(formalobjdef) then
+                            if not paraobjdef.is_related(formalobjdef.childof) then
                               begin
                               begin
-                                MessagePos2(filepos,type_e_incompatible_types,paraobjdef.typename,formalobjdef.typename);
+                                MessagePos2(filepos,type_e_incompatible_types,paraobjdef.typename,formalobjdef.childof.typename);
                                 result:=false;
                                 result:=false;
                               end;
                               end;
                           odt_class,
                           odt_class,
@@ -188,7 +191,7 @@ uses
                               while assigned(objdef) do
                               while assigned(objdef) do
                                 begin
                                 begin
                                   for j:=0 to objdef.implementedinterfaces.count-1 do
                                   for j:=0 to objdef.implementedinterfaces.count-1 do
-                                    if timplementedinterface(objdef.implementedinterfaces[j]).intfdef=formalobjdef then
+                                    if timplementedinterface(objdef.implementedinterfaces[j]).intfdef=formalobjdef.childof then
                                       begin
                                       begin
                                         intffound:=true;
                                         intffound:=true;
                                         break;
                                         break;
@@ -199,7 +202,7 @@ uses
                                 end;
                                 end;
                               result:=intffound;
                               result:=intffound;
                               if not result then
                               if not result then
-                                MessagePos2(filepos,parser_e_class_doesnt_implement_interface,paraobjdef.typename,formalobjdef.typename);
+                                MessagePos2(filepos,parser_e_class_doesnt_implement_interface,paraobjdef.typename,formalobjdef.childof.typename);
                             end;
                             end;
                           else
                           else
                             begin
                             begin
@@ -209,51 +212,44 @@ uses
                         end;
                         end;
                       end
                       end
                     else
                     else
-                      if df_genconstraint in formalobjdef.defoptions then
-                        begin
-                          { this is either a "class" or a concrete instance
-                            which shall implement interfaces }
-                          if not (paraobjdef.objecttype in [odt_class,odt_javaclass]) then
-                            begin
-                              MessagePos1(filepos,type_e_class_type_expected,paraobjdef.typename);
-                              result:=false;
-                              continue;
-                            end;
-                          if assigned(formalobjdef.childof) and
-                              not paradef.is_related(formalobjdef.childof) then
-                            begin
-                              MessagePos2(filepos,type_e_incompatible_types,paraobjdef.typename,formalobjdef.childof.typename);
-                              result:=false;
-                            end;
-                          intfcount:=0;
-                          for j:=0 to formalobjdef.implementedinterfaces.count-1 do
-                            begin
-                              objdef:=paraobjdef;
-                              while assigned(objdef) do
-                                begin
-                                  intffound:=assigned(
-                                               objdef.find_implemented_interface(
-                                                 timplementedinterface(formalobjdef.implementedinterfaces[j]).intfdef
-                                               )
-                                             );
-                                  if intffound then
-                                    break;
-                                  objdef:=objdef.childof;
-                                end;
-                              if intffound then
-                                inc(intfcount)
-                              else
-                                MessagePos2(filepos,parser_e_class_doesnt_implement_interface,paraobjdef.typename,timplementedinterface(formalobjdef.implementedinterfaces[j]).intfdef.typename);
-                            end;
-                          if intfcount<>formalobjdef.implementedinterfaces.count then
+                      begin
+                        { this is either a "class" or a concrete instance with
+                          or without implemented interfaces }
+                        if not (paraobjdef.objecttype in [odt_class,odt_javaclass]) then
+                          begin
+                            MessagePos1(filepos,type_e_class_type_expected,paraobjdef.typename);
                             result:=false;
                             result:=false;
-                        end
-                      else
-                        if not paraobjdef.is_related(formalobjdef) then
+                            continue;
+                          end;
+                        if assigned(formalobjdef.childof) and
+                            not paradef.is_related(formalobjdef.childof) then
                           begin
                           begin
-                            MessagePos2(filepos,type_e_incompatible_types,paraobjdef.typename,formalobjdef.typename);
+                            MessagePos2(filepos,type_e_incompatible_types,paraobjdef.typename,formalobjdef.childof.typename);
                             result:=false;
                             result:=false;
                           end;
                           end;
+                        intfcount:=0;
+                        for j:=0 to formalobjdef.implementedinterfaces.count-1 do
+                          begin
+                            objdef:=paraobjdef;
+                            while assigned(objdef) do
+                              begin
+                                intffound:=assigned(
+                                             objdef.find_implemented_interface(
+                                               timplementedinterface(formalobjdef.implementedinterfaces[j]).intfdef
+                                             )
+                                           );
+                                if intffound then
+                                  break;
+                                objdef:=objdef.childof;
+                              end;
+                            if intffound then
+                              inc(intfcount)
+                            else
+                              MessagePos2(filepos,parser_e_class_doesnt_implement_interface,paraobjdef.typename,timplementedinterface(formalobjdef.implementedinterfaces[j]).intfdef.typename);
+                          end;
+                        if intfcount<>formalobjdef.implementedinterfaces.count then
+                          result:=false;
+                      end;
                   end;
                   end;
               end;
               end;
           end;
           end;
@@ -868,7 +864,7 @@ uses
         generictype : ttypesym;
         generictype : ttypesym;
         i,firstidx : longint;
         i,firstidx : longint;
         srsymtable : tsymtable;
         srsymtable : tsymtable;
-        def : tdef;
+        basedef,def : tdef;
         defname : tidstring;
         defname : tidstring;
         allowconstructor,
         allowconstructor,
         doconsume : boolean;
         doconsume : boolean;
@@ -900,7 +896,7 @@ uses
 
 
               allowconstructor:=m_delphi in current_settings.modeswitches;
               allowconstructor:=m_delphi in current_settings.modeswitches;
 
 
-              constraintdata.basedef:=generrordef;
+              basedef:=generrordef;
               repeat
               repeat
                 doconsume:=true;
                 doconsume:=true;
 
 
@@ -916,7 +912,7 @@ uses
                     begin
                     begin
                       if gcf_class in constraintdata.flags then
                       if gcf_class in constraintdata.flags then
                         Message(parser_e_illegal_expression);
                         Message(parser_e_illegal_expression);
-                      if constraintdata.basedef=generrordef then
+                      if basedef=generrordef then
                         include(constraintdata.flags,gcf_class)
                         include(constraintdata.flags,gcf_class)
                       else
                       else
                         Message(parser_e_illegal_expression);
                         Message(parser_e_illegal_expression);
@@ -929,7 +925,7 @@ uses
                       else
                       else
                         begin
                         begin
                           srsymtable:=trecordsymtable.create(defname,0);
                           srsymtable:=trecordsymtable.create(defname,0);
-                          constraintdata.basedef:=trecorddef.create(defname,srsymtable);
+                          basedef:=trecorddef.create(defname,srsymtable);
                           include(constraintdata.flags,gcf_record);
                           include(constraintdata.flags,gcf_record);
                           allowconstructor:=false;
                           allowconstructor:=false;
                         end;
                         end;
@@ -957,10 +953,10 @@ uses
                                 Message(parser_e_illegal_expression)
                                 Message(parser_e_illegal_expression)
                               else
                               else
                                 { do we already have a concrete class? }
                                 { do we already have a concrete class? }
-                                if constraintdata.basedef<>generrordef then
+                                if basedef<>generrordef then
                                   Message(parser_e_illegal_expression)
                                   Message(parser_e_illegal_expression)
                                 else
                                 else
-                                  constraintdata.basedef:=def;
+                                  basedef:=def;
                             end;
                             end;
                           odt_interfacecom,
                           odt_interfacecom,
                           odt_interfacecorba,
                           odt_interfacecorba,
@@ -975,37 +971,44 @@ uses
               until not try_to_consume(_COMMA);
               until not try_to_consume(_COMMA);
 
 
               if ([gcf_class,gcf_constructor]*constraintdata.flags<>[]) or
               if ([gcf_class,gcf_constructor]*constraintdata.flags<>[]) or
-                  ((constraintdata.interfaces.count>1) and (constraintdata.basedef=generrordef)) or
-                  ((constraintdata.interfaces.count>0) and (constraintdata.basedef<>generrordef)) then
+                  (constraintdata.interfaces.count>1) or
+                  (
+                    (basedef.typ=objectdef) and
+                    (tobjectdef(basedef).objecttype in [odt_javaclass,odt_class])
+                  ) then
                 begin
                 begin
-                  if constraintdata.basedef.typ=errordef then
+                  if basedef.typ=errordef then
                     { don't pass an errordef as a parent to a tobjectdef }
                     { don't pass an errordef as a parent to a tobjectdef }
-                    constraintdata.basedef:=nil
+                    basedef:=class_tobject
                   else
                   else
-                    if constraintdata.basedef.typ<>objectdef then
+                    if (basedef.typ<>objectdef) or
+                        not (tobjectdef(basedef).objecttype in [odt_javaclass,odt_class]) then
                       internalerror(2012101101);
                       internalerror(2012101101);
-                  constraintdata.basedef:=tobjectdef.create({$ifdef jvm}odt_javaclass{$else}odt_class{$endif},defname,tobjectdef(constraintdata.basedef));
-                  include(constraintdata.basedef.defoptions,df_genconstraint);
+                  basedef:=tobjectdef.create(tobjectdef(basedef).objecttype,defname,tobjectdef(basedef));
                   for i:=0 to constraintdata.interfaces.count-1 do
                   for i:=0 to constraintdata.interfaces.count-1 do
-                    tobjectdef(constraintdata.basedef).implementedinterfaces.add(
+                    tobjectdef(basedef).implementedinterfaces.add(
                       timplementedinterface.create(tobjectdef(constraintdata.interfaces[i])));
                       timplementedinterface.create(tobjectdef(constraintdata.interfaces[i])));
                 end
                 end
               else
               else
                 if constraintdata.interfaces.count=1 then
                 if constraintdata.interfaces.count=1 then
                   begin
                   begin
-                    constraintdata.basedef:=tdef(constraintdata.interfaces[0]);
+                    if basedef.typ<>errordef then
+                      internalerror(2013021601);
+                    def:=tdef(constraintdata.interfaces[0]);
+                    basedef:=tobjectdef.create(tobjectdef(def).objecttype,defname,tobjectdef(def));
                     constraintdata.interfaces.delete(0);
                     constraintdata.interfaces.delete(0);
                   end;
                   end;
-
-              for i:=firstidx to result.count-1 do
-                with ttypesym(result[i]) do
+              if basedef.typ<>errordef then
+                with tstoreddef(basedef) do
                   begin
                   begin
                     genconstraintdata:=tgenericconstraintdata.create;
                     genconstraintdata:=tgenericconstraintdata.create;
-                    genconstraintdata.basedef:=constraintdata.basedef;
                     genconstraintdata.flags:=constraintdata.flags;
                     genconstraintdata.flags:=constraintdata.flags;
                     genconstraintdata.interfaces.assign(constraintdata.interfaces);
                     genconstraintdata.interfaces.assign(constraintdata.interfaces);
-                    typedef:=constraintdata.basedef;
+                    include(defoptions,df_genconstraint);
                   end;
                   end;
+
+              for i:=firstidx to result.count-1 do
+                ttypesym(result[i]).typedef:=basedef;
               firstidx:=result.count;
               firstidx:=result.count;
 
 
               constraintdata.free;
               constraintdata.free;

+ 8 - 0
compiler/symconst.pas

@@ -206,6 +206,14 @@ type
   );
   );
   tdefstates=set of tdefstate;
   tdefstates=set of tdefstate;
 
 
+  { flags for generic type constraints }
+  tgenericconstraintflag=(gcf_none,
+    gcf_constructor,       { specialization type needs to have a constructor }
+    gcf_class,             { specialization type needs to be a class }
+    gcf_record             { specialization type needs to be a record type }
+  );
+  tgenericconstraintflags=set of tgenericconstraintflag;
+
   { tsymlist entry types }
   { tsymlist entry types }
   tsltype = (sl_none,
   tsltype = (sl_none,
     sl_load,
     sl_load,

+ 93 - 0
compiler/symdef.pas

@@ -51,6 +51,18 @@ interface
                     TDef
                     TDef
 ************************************************}
 ************************************************}
 
 
+       tgenericconstraintdata=class
+         interfaces : tfpobjectlist;
+         interfacesderef : tfplist;
+         flags : tgenericconstraintflags;
+         constructor create;
+         destructor destroy;override;
+         procedure ppuload(ppufile:tcompilerppufile);
+         procedure ppuwrite(ppufile:tcompilerppufile);
+         procedure buildderef;
+         procedure deref;
+       end;
+
        { tstoreddef }
        { tstoreddef }
 
 
        tstoreddef = class(tdef)
        tstoreddef = class(tdef)
@@ -69,6 +81,9 @@ interface
             generic parameters; the symbols are not owned by this list
             generic parameters; the symbols are not owned by this list
             Note: this list is allocated on demand! }
             Note: this list is allocated on demand! }
           genericparas    : tfphashobjectlist;
           genericparas    : tfphashobjectlist;
+          { contains additional data if this def is a generic constraint
+            Note: this class is allocated on demand! }
+          genconstraintdata : tgenericconstraintdata;
           constructor create(dt:tdeftyp);
           constructor create(dt:tdeftyp);
           constructor ppuload(dt:tdeftyp;ppufile:tcompilerppufile);
           constructor ppuload(dt:tdeftyp;ppufile:tcompilerppufile);
           destructor  destroy;override;
           destructor  destroy;override;
@@ -1376,6 +1391,72 @@ implementation
                      TDEF (base class for definitions)
                      TDEF (base class for definitions)
 ****************************************************************************}
 ****************************************************************************}
 
 
+    constructor tgenericconstraintdata.create;
+      begin
+        interfaces:=tfpobjectlist.create(false);
+        interfacesderef:=tfplist.create;
+      end;
+
+
+    destructor tgenericconstraintdata.destroy;
+      var
+        i : longint;
+      begin
+        for i:=0 to interfacesderef.count-1 do
+          dispose(pderef(interfacesderef[i]));
+        interfacesderef.free;
+        interfaces.free;
+        inherited destroy;
+      end;
+
+    procedure tgenericconstraintdata.ppuload(ppufile: tcompilerppufile);
+      var
+        cnt,i : longint;
+        intfderef : pderef;
+      begin
+        ppufile.getsmallset(flags);
+        cnt:=ppufile.getlongint;
+        for i:=0 to cnt-1 do
+          begin
+            new(intfderef);
+            ppufile.getderef(intfderef^);
+            interfacesderef.add(intfderef);
+          end;
+      end;
+
+
+    procedure tgenericconstraintdata.ppuwrite(ppufile: tcompilerppufile);
+      var
+        i : longint;
+      begin
+        ppufile.putsmallset(flags);
+        ppufile.putlongint(interfacesderef.count);
+        for i:=0 to interfacesderef.count-1 do
+          ppufile.putderef(pderef(interfacesderef[i])^);
+      end;
+
+    procedure tgenericconstraintdata.buildderef;
+      var
+        intfderef : pderef;
+        i : longint;
+      begin
+        for i:=0 to interfaces.count-1 do
+          begin
+            new(intfderef);
+            intfderef^.build(tobjectdef(interfaces[i]));
+            interfacesderef.add(intfderef);
+          end;
+      end;
+
+    procedure tgenericconstraintdata.deref;
+      var
+        i : longint;
+      begin
+        for i:=0 to interfacesderef.count-1 do
+          interfaces.add(pderef(interfacesderef[i])^.resolve);
+      end;
+
+
     procedure tstoreddef.fillgenericparas(symtable: tsymtable);
     procedure tstoreddef.fillgenericparas(symtable: tsymtable);
       var
       var
         sym : tsym;
         sym : tsym;
@@ -1444,6 +1525,7 @@ implementation
             generictokenbuf:=nil;
             generictokenbuf:=nil;
           end;
           end;
         genericparas.free;
         genericparas.free;
+        genconstraintdata.free;
         inherited destroy;
         inherited destroy;
       end;
       end;
 
 
@@ -1463,6 +1545,11 @@ implementation
          ppufile.getderef(typesymderef);
          ppufile.getderef(typesymderef);
          ppufile.getsmallset(defoptions);
          ppufile.getsmallset(defoptions);
          ppufile.getsmallset(defstates);
          ppufile.getsmallset(defstates);
+         if df_genconstraint in defoptions then
+           begin
+             genconstraintdata:=tgenericconstraintdata.create;
+             genconstraintdata.ppuload(ppufile);
+           end;
          if df_generic in defoptions then
          if df_generic in defoptions then
            begin
            begin
              sizeleft:=ppufile.getlongint;
              sizeleft:=ppufile.getlongint;
@@ -1558,6 +1645,8 @@ implementation
         oldintfcrc:=ppufile.do_crc;
         oldintfcrc:=ppufile.do_crc;
         ppufile.do_crc:=false;
         ppufile.do_crc:=false;
         ppufile.putsmallset(defstates);
         ppufile.putsmallset(defstates);
+        if df_genconstraint in defoptions then
+          genconstraintdata.ppuwrite(ppufile);
         if df_generic in defoptions then
         if df_generic in defoptions then
           begin
           begin
             if assigned(generictokenbuf) then
             if assigned(generictokenbuf) then
@@ -1589,6 +1678,8 @@ implementation
       begin
       begin
         typesymderef.build(typesym);
         typesymderef.build(typesym);
         genericdefderef.build(genericdef);
         genericdefderef.build(genericdef);
+        if assigned(genconstraintdata) then
+          genconstraintdata.buildderef;
       end;
       end;
 
 
 
 
@@ -1602,6 +1693,8 @@ implementation
         typesym:=ttypesym(typesymderef.resolve);
         typesym:=ttypesym(typesymderef.resolve);
         if df_specialization in defoptions then
         if df_specialization in defoptions then
           genericdef:=tstoreddef(genericdefderef.resolve);
           genericdef:=tstoreddef(genericdefderef.resolve);
+        if assigned(genconstraintdata) then
+          genconstraintdata.deref;
       end;
       end;
 
 
 
 

+ 0 - 109
compiler/symsym.pas

@@ -121,30 +121,8 @@ interface
           property ProcdefList:TFPObjectList read FProcdefList;
           property ProcdefList:TFPObjectList read FProcdefList;
        end;
        end;
 
 
-       tgenericconstraintflag=(
-         gcf_constructor,
-         gcf_class,
-         gcf_record
-       );
-       tgenericconstraintflags=set of tgenericconstraintflag;
-
-       tgenericconstraintdata=class
-         basedef : tdef;
-         basedefderef : tderef;
-         interfaces : tfpobjectlist;
-         interfacesderef : tfplist;
-         flags : tgenericconstraintflags;
-         constructor create;
-         destructor destroy;override;
-         procedure ppuload(ppufile:tcompilerppufile);
-         procedure ppuwrite(ppufile:tcompilerppufile);
-         procedure buildderef;
-         procedure deref;
-       end;
-
        ttypesym = class(Tstoredsym)
        ttypesym = class(Tstoredsym)
        public
        public
-          genconstraintdata : tgenericconstraintdata;
           typedef      : tdef;
           typedef      : tdef;
           typedefderef : tderef;
           typedefderef : tderef;
           fprettyname : ansistring;
           fprettyname : ansistring;
@@ -2388,76 +2366,6 @@ implementation
 ****************************************************************************}
 ****************************************************************************}
 
 
 
 
-    constructor tgenericconstraintdata.create;
-      begin
-        interfaces:=tfpobjectlist.create(false);
-        interfacesderef:=tfplist.create;
-      end;
-
-
-    destructor tgenericconstraintdata.destroy;
-      var
-        i : longint;
-      begin
-        for i:=0 to interfacesderef.count-1 do
-          dispose(pderef(interfacesderef[i]));
-        interfacesderef.free;
-        interfaces.free;
-        inherited destroy;
-      end;
-
-    procedure tgenericconstraintdata.ppuload(ppufile: tcompilerppufile);
-      var
-        cnt,i : longint;
-        intfderef : pderef;
-      begin
-        ppufile.getsmallset(flags);
-        ppufile.getderef(basedefderef);
-        cnt:=ppufile.getlongint;
-        for i:=0 to cnt-1 do
-          begin
-            new(intfderef);
-            ppufile.getderef(intfderef^);
-            interfacesderef.add(intfderef);
-          end;
-      end;
-
-
-    procedure tgenericconstraintdata.ppuwrite(ppufile: tcompilerppufile);
-      var
-        i : longint;
-      begin
-        ppufile.putsmallset(flags);
-        ppufile.putderef(basedefderef);
-        ppufile.putlongint(interfacesderef.count);
-        for i:=0 to interfacesderef.count-1 do
-          ppufile.putderef(pderef(interfacesderef[i])^);
-      end;
-
-    procedure tgenericconstraintdata.buildderef;
-      var
-        intfderef : pderef;
-        i : longint;
-      begin
-        basedefderef.build(basedef);
-        for i:=0 to interfaces.count-1 do
-          begin
-            new(intfderef);
-            intfderef^.build(tobjectdef(interfaces[i]));
-            interfacesderef.add(intfderef);
-          end;
-      end;
-
-    procedure tgenericconstraintdata.deref;
-      var
-        i : longint;
-      begin
-        basedef:=tdef(basedefderef.resolve);
-        for i:=0 to interfacesderef.count-1 do
-          interfaces.add(pderef(interfacesderef[i])^.resolve);
-      end;
-
-
     constructor ttypesym.create(const n : string;def:tdef);
     constructor ttypesym.create(const n : string;def:tdef);
 
 
       begin
       begin
@@ -2472,7 +2380,6 @@ implementation
 
 
     destructor ttypesym.destroy;
     destructor ttypesym.destroy;
       begin
       begin
-        genconstraintdata.free;
         inherited destroy;
         inherited destroy;
       end;
       end;
 
 
@@ -2482,27 +2389,18 @@ implementation
          inherited ppuload(typesym,ppufile);
          inherited ppuload(typesym,ppufile);
          ppufile.getderef(typedefderef);
          ppufile.getderef(typedefderef);
          fprettyname:=ppufile.getansistring;
          fprettyname:=ppufile.getansistring;
-         if ppufile.getbyte<>0 then
-           begin
-             genconstraintdata:=tgenericconstraintdata.create;
-             genconstraintdata.ppuload(ppufile);
-           end;
       end;
       end;
 
 
 
 
     procedure ttypesym.buildderef;
     procedure ttypesym.buildderef;
       begin
       begin
         typedefderef.build(typedef);
         typedefderef.build(typedef);
-        if assigned(genconstraintdata) then
-          genconstraintdata.buildderef;
       end;
       end;
 
 
 
 
     procedure ttypesym.deref;
     procedure ttypesym.deref;
       begin
       begin
         typedef:=tdef(typedefderef.resolve);
         typedef:=tdef(typedefderef.resolve);
-        if assigned(genconstraintdata) then
-          genconstraintdata.deref;
       end;
       end;
 
 
 
 
@@ -2511,13 +2409,6 @@ implementation
          inherited ppuwrite(ppufile);
          inherited ppuwrite(ppufile);
          ppufile.putderef(typedefderef);
          ppufile.putderef(typedefderef);
          ppufile.putansistring(fprettyname);
          ppufile.putansistring(fprettyname);
-         if assigned(genconstraintdata) then
-           begin
-             ppufile.putbyte(1);
-             genconstraintdata.ppuwrite(ppufile);
-           end
-         else
-           ppufile.putbyte(0);
          ppufile.writeentry(ibtypesym);
          ppufile.writeentry(ibtypesym);
       end;
       end;
 
 

+ 44 - 0
compiler/utils/ppuutils/ppudump.pp

@@ -1311,6 +1311,10 @@ type
     mask : tdefstate;
     mask : tdefstate;
     str  : string[30];
     str  : string[30];
   end;
   end;
+  tgenconstrflag=record
+    mask : tgenericconstraintflag;
+    str  : string[30];
+  end;
   ptoken=^ttoken;
   ptoken=^ttoken;
   pmsgstate =^tmsgstate;
   pmsgstate =^tmsgstate;
 const
 const
@@ -1330,6 +1334,11 @@ const
      (mask:ds_dwarf_dbg_info_used;   str:'Dwarf DbgInfo Used'),
      (mask:ds_dwarf_dbg_info_used;   str:'Dwarf DbgInfo Used'),
      (mask:ds_dwarf_dbg_info_written;str:'Dwarf DbgInfo Written')
      (mask:ds_dwarf_dbg_info_written;str:'Dwarf DbgInfo Written')
   );
   );
+  genconstrflag : array[1..ord(high(tgenericconstraintflag))] of tgenconstrflag=(
+     (mask:gcf_constructor; str:'Constructor'),
+     (mask:gcf_class;       str:'Class'),
+     (mask:gcf_record;      str:'Record')
+  );
 var
 var
   defstates  : tdefstates;
   defstates  : tdefstates;
   i, nb{, msgvalue}, mesgnb : longint;
   i, nb{, msgvalue}, mesgnb : longint;
@@ -1343,6 +1352,7 @@ var
   len : sizeint;
   len : sizeint;
   wstring : widestring;
   wstring : widestring;
   astring : ansistring;
   astring : ansistring;
+  genconstr : tgenericconstraintflags;
 
 
   function readtoken: ttoken;
   function readtoken: ttoken;
     var
     var
@@ -1466,6 +1476,40 @@ begin
     end;
     end;
   writeln;
   writeln;
 
 
+  if df_genconstraint in defoptions then
+    begin
+      ppufile.getsmallset(genconstr);
+      write  ([space,'   GenConstraints : ']);
+      if genconstr<>[] then
+        begin
+          first:=true;
+          for i:=1 to high(genconstrflag) do
+           if (genconstrflag[i].mask in genconstr) then
+            begin
+              if first then
+                first:=false
+              else
+                write(', ');
+              write(genconstrflag[i].str);
+            end;
+        end;
+      writeln;
+
+      len:=ppufile.getasizeint;
+      if len>0 then
+        begin
+          space:='    '+space;
+          writeln([space,'------ constraint defs begin ------']);
+          for i:=0 to len-1 do
+            begin
+              writeln([space,'------ constraint def ',i,' ------']);
+              readderef(space);
+            end;
+          writeln([space,'------ constraint defs end ------']);
+          delete(space,1,4);
+        end;
+    end;
+
   if df_generic in defoptions then
   if df_generic in defoptions then
     begin
     begin
       tokenbufsize:=ppufile.getlongint;
       tokenbufsize:=ppufile.getlongint;