paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-04 07:43:04 +01:00
Code Issues Packages Projects Releases Wiki Activity

Moved "generate_specialization" from "ptype.pas" to "pgenutil.pas"

Browse Source 
git-svn-id: branches/svenbarth/generics@17403 -
This commit is contained in:
svenbarth 2011-05-04 10:35:23 +00:00
parent 1e37c5d717
commit 05e5bc031b
3 changed files with 332 additions and 313 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
compiler/pexpr.pas
View File

@ -66,7 +66,7 @@ implementation
nmat,nadd,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,nutils,
{ parser }
scanner,
pbase,pinline,ptype,
pbase,pinline,ptype,pgenutil,
{ codegen }
cgbase,procinfo,cpuinfo
;

331
compiler/pgenutil.pas
View File

@ -26,6 +26,335 @@ unit pgenutil;
interface
uses
symtype;
procedure generate_specialization(var tt:tdef;parse_class_parent:boolean);
implementation
end.
uses
{ common }
cclasses,cutils,
{ global }
globals,tokens,verbose,
{ symtable }
symconst,symbase,symdef,symsym,symtable,
{ modules }
fmodule,
{ pass 1 }
node,nobj,
{ parser }
scanner,
pbase,pexpr,pdecsub,ptype;
procedure generate_specialization(var tt:tdef;parse_class_parent:boolean);
var
st : TSymtable;
srsym : tsym;
pt2 : tnode;
found,
first,
err : boolean;
i,
j,
gencount : longint;
sym : tsym;
genericdef : tstoreddef;
genericsym,
generictype : ttypesym;
genericdeflist : TFPObjectList;
generictypelist : TFPObjectList;
oldsymtablestack : tsymtablestack;
oldextendeddefs : TFPHashObjectList;
hmodule : tmodule;
pu : tused_unit;
uspecializename,
specializename : string;
vmtbuilder : TVMTBuilder;
onlyparsepara : boolean;
specializest : tsymtable;
item: psymtablestackitem;
def : tdef;
begin
{ retrieve generic def that we are going to replace }
genericdef:=tstoreddef(tt);
tt:=nil;
onlyparsepara:=false;
if not assigned(genericdef.typesym) or
(genericdef.typesym.typ<>typesym) then
internalerror(2011042701);
genericsym:=ttypesym(genericdef.typesym);
if genericsym.gendeflist.Count=0 then
begin
{ TODO : search for other generics with the same name }
Message(parser_e_special_onlygenerics);
tt:=generrordef;
onlyparsepara:=true;
end;
{ only need to record the tokens, then we don't know the type yet ... }
if parse_generic then
begin
{ ... but we have to insert a def into the symtable else the deflist
of generic and specialization might not be equally sized which
is later assumed }
tt:=tundefineddef.create;
if parse_class_parent then
tt:=genericdef;
onlyparsepara:=true;
end;
{ Only parse the parameters for recovery or
for recording in genericbuf }
if onlyparsepara then
begin
consume(_LSHARPBRACKET);
repeat
pt2:=factor(false,true);
pt2.free;
until not try_to_consume(_COMMA);
consume(_RSHARPBRACKET);
exit;
end;
if not try_to_consume(_LT) then
consume(_LSHARPBRACKET);
generictypelist:=TFPObjectList.create(false);
genericdeflist:=TFPObjectList.Create(false);
{ Parse type parameters }
if not assigned(genericdef.typesym) then
internalerror(200710173);
err:=false;
first:=true;
specializename:='';
while not (token in [_GT,_RSHARPBRACKET]) do
begin
if not first then
consume(_COMMA)
else
first:=false;
pt2:=factor(false,true);
if pt2.nodetype=typen then
begin
if df_generic in pt2.resultdef.defoptions then
Message(parser_e_no_generics_as_params);
genericdeflist.Add(pt2.resultdef);
if not assigned(pt2.resultdef.typesym) then
message(type_e_generics_cannot_reference_itself)
else
specializename:=specializename+'$'+pt2.resultdef.typesym.realname;
end
else
begin
Message(type_e_type_id_expected);
err:=true;
end;
pt2.free;
end;
if err then
begin
try_to_consume(_RSHARPBRACKET);
exit;
end;
{ check whether we have a generic with the correct amount of params }
found:=false;
for i:=0 to genericsym.gendeflist.Count-1 do begin
def:=tdef(genericsym.gendeflist[i]);
{ select the symtable containing the params }
case def.typ of
procdef:
st:=def.GetSymtable(gs_para);
objectdef,
recorddef:
st:=def.GetSymtable(gs_record);
arraydef:
st:=tarraydef(def).symtable;
procvardef:
st:=def.GetSymtable(gs_para);
else
internalerror(200511182);
end;
gencount:=0;
for j:=0 to st.SymList.Count-1 do
begin
if sp_generic_para in tsym(st.SymList[j]).symoptions then
inc(gencount);
end;
if gencount=genericdeflist.count then
begin
found:=true;
break;
end;
end;
if not found then
begin
identifier_not_found(genericdef.typename);
tt:=generrordef;
exit;
end;
{ we've found the correct def, so use it }
genericdef:=tstoreddef(def);
{ build the new type's name }
specializename:=genericdef.typesym.realname+specializename;
uspecializename:=upper(specializename);
{ build the list containing the types for the generic params }
gencount:=0;
for i:=0 to st.SymList.Count-1 do
begin
sym:=tsym(st.SymList[i]);
if sp_generic_para in sym.symoptions then
begin
if gencount=genericdeflist.Count then
internalerror(2011042702);
generictype:=ttypesym.create(sym.realname,tdef(genericdeflist[gencount]));
generictypelist.add(generictype);
inc(gencount);
end;
end;
{ Special case if we are referencing the current defined object }
if assigned(current_structdef) and
(current_structdef.objname^=uspecializename) then
tt:=current_structdef;
{ for units specializations can already be needed in the interface, therefor we
will use the global symtable. Programs don't have a globalsymtable and there we
use the localsymtable }
if current_module.is_unit then
specializest:=current_module.globalsymtable
else
specializest:=current_module.localsymtable;
{ Can we reuse an already specialized type? }
if not assigned(tt) then
begin
srsym:=tsym(specializest.find(uspecializename));
if assigned(srsym) then
begin
if srsym.typ<>typesym then
internalerror(200710171);
tt:=ttypesym(srsym).typedef;
end;
end;
if not assigned(tt) then
begin
{ Setup symtablestack at definition time
to get types right, however this is not perfect, we should probably record
the resolved symbols }
oldsymtablestack:=symtablestack;
oldextendeddefs:=current_module.extendeddefs;
current_module.extendeddefs:=TFPHashObjectList.create(true);
symtablestack:=tdefawaresymtablestack.create;
if not assigned(genericdef) then
internalerror(200705151);
hmodule:=find_module_from_symtable(genericdef.owner);
if hmodule=nil then
internalerror(200705152);
pu:=tused_unit(hmodule.used_units.first);
while assigned(pu) do
begin
if not assigned(pu.u.globalsymtable) then
internalerror(200705153);
symtablestack.push(pu.u.globalsymtable);
pu:=tused_unit(pu.next);
end;
if assigned(hmodule.globalsymtable) then
symtablestack.push(hmodule.globalsymtable);
{ hacky, but necessary to insert the newly generated class properly }
item:=oldsymtablestack.stack;
while assigned(item) and (item^.symtable.symtablelevel>main_program_level) do
item:=item^.next;
if assigned(item) and (item^.symtable<>symtablestack.top) then
symtablestack.push(item^.symtable);
{ Reparse the original type definition }
if not err then
begin
{ First a new typesym so we can reuse this specialization and
references to this specialization can be handled }
srsym:=ttypesym.create(specializename,generrordef);
specializest.insert(srsym);
if not assigned(genericdef.generictokenbuf) then
internalerror(200511171);
current_scanner.startreplaytokens(genericdef.generictokenbuf);
read_named_type(tt,specializename,genericdef,generictypelist,false);
ttypesym(srsym).typedef:=tt;
tt.typesym:=srsym;
case tt.typ of
{ Build VMT indexes for classes }
objectdef:
begin
vmtbuilder:=TVMTBuilder.Create(tobjectdef(tt));
vmtbuilder.generate_vmt;
vmtbuilder.free;
end;
{ handle params, calling convention, etc }
procvardef:
begin
if not check_proc_directive(true) then
begin
try_consume_hintdirective(ttypesym(srsym).symoptions,ttypesym(srsym).deprecatedmsg);
consume(_SEMICOLON);
end;
parse_var_proc_directives(ttypesym(srsym));
handle_calling_convention(tprocvardef(tt));
if try_consume_hintdirective(ttypesym(srsym).symoptions,ttypesym(srsym).deprecatedmsg) then
consume(_SEMICOLON);
end;
end;
{ Consume the semicolon if it is also recorded }
try_to_consume(_SEMICOLON);
end;
{ Restore symtablestack }
current_module.extendeddefs.free;
current_module.extendeddefs:=oldextendeddefs;
symtablestack.free;
symtablestack:=oldsymtablestack;
end
else
begin
{ There is comment few lines before ie 200512115
saying "We are parsing the same objectdef, the def index numbers
are the same". This is wrong (index numbers are not same)
in case there is specialization (S2 in this case) inside
specialized generic (G2 in this case) which is equal to
some previous specialization (S1 in this case). In that case,
new symbol is not added to currently specialized type
(S in this case) for that specializations (S2 in this case),
and this results in that specialization and generic definition
don't have same number of elements in their object symbol tables.
This patch adds undefined def to ensure that those
two symbol tables will have same number of elements.
}
tundefineddef.create;
end;
genericdeflist.free;
generictypelist.free;
if not try_to_consume(_GT) then
consume(_RSHARPBRACKET);
end;
end.

312
compiler/ptype.pas
View File

@ -52,8 +52,6 @@ interface
{ generate persistent type information like VMT, RTTI and inittables }
procedure write_persistent_type_info(st:tsymtable);
procedure generate_specialization(var tt:tdef;parse_class_parent:boolean);
implementation
uses
@ -74,7 +72,7 @@ implementation
nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,
{ parser }
scanner,
pbase,pexpr,pdecsub,pdecvar,pdecobj,pdecl;
pbase,pexpr,pdecsub,pdecvar,pdecobj,pdecl,pgenutil;
procedure resolve_forward_types;
@ -143,314 +141,6 @@ implementation
end;
procedure generate_specialization(var tt:tdef;parse_class_parent:boolean);
var
st : TSymtable;
srsym : tsym;
pt2 : tnode;
found,
first,
err : boolean;
i,
j,
gencount : longint;
sym : tsym;
genericdef : tstoreddef;
genericsym,
generictype : ttypesym;
genericdeflist : TFPObjectList;
generictypelist : TFPObjectList;
oldsymtablestack : tsymtablestack;
oldextendeddefs : TFPHashObjectList;
hmodule : tmodule;
pu : tused_unit;
uspecializename,
specializename : string;
vmtbuilder : TVMTBuilder;
onlyparsepara : boolean;
specializest : tsymtable;
item: psymtablestackitem;
def : tdef;
begin
{ retrieve generic def that we are going to replace }
genericdef:=tstoreddef(tt);
tt:=nil;
onlyparsepara:=false;
if not assigned(genericdef.typesym) or
(genericdef.typesym.typ<>typesym) then
internalerror(2011042701);
genericsym:=ttypesym(genericdef.typesym);
if genericsym.gendeflist.Count=0 then
begin
{ TODO : search for other generics with the same name }
Message(parser_e_special_onlygenerics);
tt:=generrordef;
onlyparsepara:=true;
end;
{ only need to record the tokens, then we don't know the type yet ... }
if parse_generic then
begin
{ ... but we have to insert a def into the symtable else the deflist
of generic and specialization might not be equally sized which
is later assumed }
tt:=tundefineddef.create;
if parse_class_parent then
tt:=genericdef;
onlyparsepara:=true;
end;
{ Only parse the parameters for recovery or
for recording in genericbuf }
if onlyparsepara then
begin
consume(_LSHARPBRACKET);
repeat
pt2:=factor(false,true);
pt2.free;
until not try_to_consume(_COMMA);
consume(_RSHARPBRACKET);
exit;
end;
if not try_to_consume(_LT) then
consume(_LSHARPBRACKET);
generictypelist:=TFPObjectList.create(false);
genericdeflist:=TFPObjectList.Create(false);
{ Parse type parameters }
if not assigned(genericdef.typesym) then
internalerror(200710173);
err:=false;
first:=true;
specializename:='';
while not (token in [_GT,_RSHARPBRACKET]) do
begin
if not first then
consume(_COMMA)
else
first:=false;
pt2:=factor(false,true);
if pt2.nodetype=typen then
begin
if df_generic in pt2.resultdef.defoptions then
Message(parser_e_no_generics_as_params);
genericdeflist.Add(pt2.resultdef);
if not assigned(pt2.resultdef.typesym) then
message(type_e_generics_cannot_reference_itself)
else
specializename:=specializename+'$'+pt2.resultdef.typesym.realname;
end
else
begin
Message(type_e_type_id_expected);
err:=true;
end;
pt2.free;
end;
if err then
begin
try_to_consume(_RSHARPBRACKET);
exit;
end;
{ check whether we have a generic with the correct amount of params }
found:=false;
for i:=0 to genericsym.gendeflist.Count-1 do begin
def:=tdef(genericsym.gendeflist[i]);
{ select the symtable containing the params }
case def.typ of
procdef:
st:=def.GetSymtable(gs_para);
objectdef,
recorddef:
st:=def.GetSymtable(gs_record);
arraydef:
st:=tarraydef(def).symtable;
procvardef:
st:=def.GetSymtable(gs_para);
else
internalerror(200511182);
end;
gencount:=0;
for j:=0 to st.SymList.Count-1 do
begin
if sp_generic_para in tsym(st.SymList[j]).symoptions then
inc(gencount);
end;
if gencount=genericdeflist.count then
begin
found:=true;
break;
end;
end;
if not found then
begin
identifier_not_found(genericdef.typename);
tt:=generrordef;
exit;
end;
{ we've found the correct def, so use it }
genericdef:=tstoreddef(def);
{ build the new type's name }
specializename:=genericdef.typesym.realname+specializename;
uspecializename:=upper(specializename);
{ build the list containing the types for the generic params }
gencount:=0;
for i:=0 to st.SymList.Count-1 do
begin
sym:=tsym(st.SymList[i]);
if sp_generic_para in sym.symoptions then
begin
if gencount=genericdeflist.Count then
internalerror(2011042702);
generictype:=ttypesym.create(sym.realname,tdef(genericdeflist[gencount]));
generictypelist.add(generictype);
inc(gencount);
end;
end;
{ Special case if we are referencing the current defined object }
if assigned(current_structdef) and
(current_structdef.objname^=uspecializename) then
tt:=current_structdef;
{ for units specializations can already be needed in the interface, therefor we
will use the global symtable. Programs don't have a globalsymtable and there we
use the localsymtable }
if current_module.is_unit then
specializest:=current_module.globalsymtable
else
specializest:=current_module.localsymtable;
{ Can we reuse an already specialized type? }
if not assigned(tt) then
begin
srsym:=tsym(specializest.find(uspecializename));
if assigned(srsym) then
begin
if srsym.typ<>typesym then
internalerror(200710171);
tt:=ttypesym(srsym).typedef;
end;
end;
if not assigned(tt) then
begin
{ Setup symtablestack at definition time
to get types right, however this is not perfect, we should probably record
the resolved symbols }
oldsymtablestack:=symtablestack;
oldextendeddefs:=current_module.extendeddefs;
current_module.extendeddefs:=TFPHashObjectList.create(true);
symtablestack:=tdefawaresymtablestack.create;
if not assigned(genericdef) then
internalerror(200705151);
hmodule:=find_module_from_symtable(genericdef.owner);
if hmodule=nil then
internalerror(200705152);
pu:=tused_unit(hmodule.used_units.first);
while assigned(pu) do
begin
if not assigned(pu.u.globalsymtable) then
internalerror(200705153);
symtablestack.push(pu.u.globalsymtable);
pu:=tused_unit(pu.next);
end;
if assigned(hmodule.globalsymtable) then
symtablestack.push(hmodule.globalsymtable);
{ hacky, but necessary to insert the newly generated class properly }
item:=oldsymtablestack.stack;
while assigned(item) and (item^.symtable.symtablelevel>main_program_level) do
item:=item^.next;
if assigned(item) and (item^.symtable<>symtablestack.top) then
symtablestack.push(item^.symtable);
{ Reparse the original type definition }
if not err then
begin
{ First a new typesym so we can reuse this specialization and
references to this specialization can be handled }
srsym:=ttypesym.create(specializename,generrordef);
specializest.insert(srsym);
if not assigned(genericdef.generictokenbuf) then
internalerror(200511171);
current_scanner.startreplaytokens(genericdef.generictokenbuf);
read_named_type(tt,specializename,genericdef,generictypelist,false);
ttypesym(srsym).typedef:=tt;
tt.typesym:=srsym;
case tt.typ of
{ Build VMT indexes for classes }
objectdef:
begin
vmtbuilder:=TVMTBuilder.Create(tobjectdef(tt));
vmtbuilder.generate_vmt;
vmtbuilder.free;
end;
{ handle params, calling convention, etc }
procvardef:
begin
if not check_proc_directive(true) then
begin
try_consume_hintdirective(ttypesym(srsym).symoptions,ttypesym(srsym).deprecatedmsg);
consume(_SEMICOLON);
end;
parse_var_proc_directives(ttypesym(srsym));
handle_calling_convention(tprocvardef(tt));
if try_consume_hintdirective(ttypesym(srsym).symoptions,ttypesym(srsym).deprecatedmsg) then
consume(_SEMICOLON);
end;
end;
{ Consume the semicolon if it is also recorded }
try_to_consume(_SEMICOLON);
end;
{ Restore symtablestack }
current_module.extendeddefs.free;
current_module.extendeddefs:=oldextendeddefs;
symtablestack.free;
symtablestack:=oldsymtablestack;
end
else
begin
{ There is comment few lines before ie 200512115
saying "We are parsing the same objectdef, the def index numbers
are the same". This is wrong (index numbers are not same)
in case there is specialization (S2 in this case) inside
specialized generic (G2 in this case) which is equal to
some previous specialization (S1 in this case). In that case,
new symbol is not added to currently specialized type
(S in this case) for that specializations (S2 in this case),
and this results in that specialization and generic definition
don't have same number of elements in their object symbol tables.
This patch adds undefined def to ensure that those
two symbol tables will have same number of elements.
}
tundefineddef.create;
end;
genericdeflist.free;
generictypelist.free;
if not try_to_consume(_GT) then
consume(_RSHARPBRACKET);
end;
procedure id_type(var def : tdef;isforwarddef,checkcurrentrecdef,allowgenericsyms:boolean); forward;
{ def is the outermost type in which other types have to be searched