From 05e5bc031b591cc0b36c6a37c2b979a70d0974c6 Mon Sep 17 00:00:00 2001 From: svenbarth Date: Wed, 4 May 2011 10:35:23 +0000 Subject: [PATCH] Moved "generate_specialization" from "ptype.pas" to "pgenutil.pas" git-svn-id: branches/svenbarth/generics@17403 - --- compiler/pexpr.pas | 2 +- compiler/pgenutil.pas | 331 +++++++++++++++++++++++++++++++++++++++++- compiler/ptype.pas | 312 +-------------------------------------- 3 files changed, 332 insertions(+), 313 deletions(-) diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas index c0d2ab4bc5..6da6e03742 100644 --- a/compiler/pexpr.pas +++ b/compiler/pexpr.pas @@ -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 ; diff --git a/compiler/pgenutil.pas b/compiler/pgenutil.pas index 5773f20630..5451036d99 100644 --- a/compiler/pgenutil.pas +++ b/compiler/pgenutil.pas @@ -26,6 +26,335 @@ unit pgenutil; interface +uses + symtype; + + procedure generate_specialization(var tt:tdef;parse_class_parent:boolean); + implementation -end. \ No newline at end of file +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. diff --git a/compiler/ptype.pas b/compiler/ptype.pas index 76174bb715..b655226ac7 100644 --- a/compiler/ptype.pas +++ b/compiler/ptype.pas @@ -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