paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-02 23:30:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

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).

Browse Source 
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 -
This commit is contained in:
svenbarth 2013-05-29 08:19:02 +00:00
parent cc5a108cca
commit 956b26bc97
6 changed files with 242 additions and 192 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
compiler/defcmp.pas
View File

@ -245,8 +245,13 @@ implementation
{ if only one def is a undefined def then they are not considered as
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
doconv:=tc_not_possible;
compare_defs_ext:=te_incompatible;
@ -255,9 +260,15 @@ implementation
end
else
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
doconv:=tc_equal;
compare_defs_ext:=te_exact;

159
compiler/pgenutil.pas
View File

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

8
compiler/symconst.pas
View File

@ -206,6 +206,14 @@ type
);
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 }
tsltype = (sl_none,
sl_load,

93
compiler/symdef.pas
View File

@ -51,6 +51,18 @@ interface
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 = class(tdef)
@ -69,6 +81,9 @@ interface
generic parameters; the symbols are not owned by this list
Note: this list is allocated on demand! }
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 ppuload(dt:tdeftyp;ppufile:tcompilerppufile);
destructor destroy;override;
@ -1376,6 +1391,72 @@ implementation
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);
var
sym : tsym;
@ -1444,6 +1525,7 @@ implementation
generictokenbuf:=nil;
end;
genericparas.free;
genconstraintdata.free;
inherited destroy;
end;
@ -1463,6 +1545,11 @@ implementation
ppufile.getderef(typesymderef);
ppufile.getsmallset(defoptions);
ppufile.getsmallset(defstates);
if df_genconstraint in defoptions then
begin
genconstraintdata:=tgenericconstraintdata.create;
genconstraintdata.ppuload(ppufile);
end;
if df_generic in defoptions then
begin
sizeleft:=ppufile.getlongint;
@ -1558,6 +1645,8 @@ implementation
oldintfcrc:=ppufile.do_crc;
ppufile.do_crc:=false;
ppufile.putsmallset(defstates);
if df_genconstraint in defoptions then
genconstraintdata.ppuwrite(ppufile);
if df_generic in defoptions then
begin
if assigned(generictokenbuf) then
@ -1589,6 +1678,8 @@ implementation
begin
typesymderef.build(typesym);
genericdefderef.build(genericdef);
if assigned(genconstraintdata) then
genconstraintdata.buildderef;
end;
@ -1602,6 +1693,8 @@ implementation
typesym:=ttypesym(typesymderef.resolve);
if df_specialization in defoptions then
genericdef:=tstoreddef(genericdefderef.resolve);
if assigned(genconstraintdata) then
genconstraintdata.deref;
end;

109
compiler/symsym.pas
View File

@ -121,30 +121,8 @@ interface
property ProcdefList:TFPObjectList read FProcdefList;
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)
public
genconstraintdata : tgenericconstraintdata;
typedef : tdef;
typedefderef : tderef;
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);
begin
@ -2472,7 +2380,6 @@ implementation
destructor ttypesym.destroy;
begin
genconstraintdata.free;
inherited destroy;
end;
@ -2482,27 +2389,18 @@ implementation
inherited ppuload(typesym,ppufile);
ppufile.getderef(typedefderef);
fprettyname:=ppufile.getansistring;
if ppufile.getbyte<>0 then
begin
genconstraintdata:=tgenericconstraintdata.create;
genconstraintdata.ppuload(ppufile);
end;
end;
procedure ttypesym.buildderef;
begin
typedefderef.build(typedef);
if assigned(genconstraintdata) then
genconstraintdata.buildderef;
end;
procedure ttypesym.deref;
begin
typedef:=tdef(typedefderef.resolve);
if assigned(genconstraintdata) then
genconstraintdata.deref;
end;
@ -2511,13 +2409,6 @@ implementation
inherited ppuwrite(ppufile);
ppufile.putderef(typedefderef);
ppufile.putansistring(fprettyname);
if assigned(genconstraintdata) then
begin
ppufile.putbyte(1);
genconstraintdata.ppuwrite(ppufile);
end
else
ppufile.putbyte(0);
ppufile.writeentry(ibtypesym);
end;

44
compiler/utils/ppuutils/ppudump.pp
View File

@ -1311,6 +1311,10 @@ type
mask : tdefstate;
str : string[30];
end;
tgenconstrflag=record
mask : tgenericconstraintflag;
str : string[30];
end;
ptoken=^ttoken;
pmsgstate =^tmsgstate;
const
@ -1330,6 +1334,11 @@ const
(mask:ds_dwarf_dbg_info_used; str:'Dwarf DbgInfo Used'),
(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
defstates : tdefstates;
i, nb{, msgvalue}, mesgnb : longint;
@ -1343,6 +1352,7 @@ var
len : sizeint;
wstring : widestring;
astring : ansistring;
genconstr : tgenericconstraintflags;
function readtoken: ttoken;
var
@ -1466,6 +1476,40 @@ begin
end;
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
begin
tokenbufsize:=ppufile.getlongint;