2
0

pgenutil.pas 125 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056
  1. {
  2. Copyright (c) 2011
  3. Contains different functions that are used in the context of
  4. parsing generics.
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit pgenutil;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. { common }
  23. cclasses,
  24. { global }
  25. globtype,
  26. { parser }
  27. pgentype,
  28. { node }
  29. node,
  30. { symtable }
  31. symtype,symdef,symbase;
  32. procedure generate_specialization(var tt:tdef;enforce_unit:boolean;parse_class_parent:boolean;const _prettyname:string;parsedtype:tdef;const symname:string;parsedpos:tfileposinfo);inline;
  33. procedure generate_specialization(var tt:tdef;enforce_unit:boolean;parse_class_parent:boolean;const _prettyname:string);inline;
  34. function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;enforce_unit:boolean):tdef;inline;
  35. function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;enforce_unit:boolean;const symname:string;symtable:tsymtable):tdef;inline;
  36. function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;enforce_unit:boolean;parsedtype:tdef;const symname:string;symtable:tsymtable;parsedpos:tfileposinfo):tdef;
  37. function generate_specialization_phase2(context:tspecializationcontext;genericdef:tstoreddef;parse_class_parent:boolean;const _prettyname:ansistring):tdef;
  38. function check_generic_constraints(genericdef:tstoreddef;paramlist:tfpobjectlist;poslist:tfplist):boolean;
  39. function parse_generic_parameters(allowconstraints:boolean):tfphashobjectlist;
  40. function parse_generic_specialization_types(paramlist:tfpobjectlist;poslist:tfplist;out prettyname,specializename:ansistring):boolean;
  41. procedure insert_generic_parameter_types(def:tstoreddef;genericdef:tstoreddef;genericlist:tfphashobjectlist;isfwd:boolean);
  42. procedure maybe_insert_generic_rename_symbol(const name:tidstring;genericlist:tfphashobjectlist);
  43. function generate_generic_name(const name:tidstring;const specializename:ansistring;const owner_hierarchy:ansistring):tidstring;
  44. procedure split_generic_name(const name:tidstring;out nongeneric:string;out count:longint);
  45. procedure add_generic_dummysym(sym:tsym);
  46. function resolve_generic_dummysym(const name:tidstring):tsym;
  47. function could_be_generic(const name:tidstring):boolean;inline;
  48. function try_implicit_specialization(sym:tsym;para:tnode;pdoverloadlist:tfpobjectlist;var unnamed_syms:tfplist;var first_procsym:tsym;var hasoverload:boolean):boolean;
  49. function finalize_specialization(var pd:tprocdef;spezcontext:tspecializationcontext):boolean;
  50. procedure generate_specialization_procs;
  51. procedure generate_specializations_for_forwarddef(def:tdef);
  52. procedure maybe_add_pending_specialization(def:tdef;unnamed_syms:tfplist);
  53. function determine_generic_def(const name:tidstring):tstoreddef;
  54. procedure specialization_init(genericdef:tdef;var state:tspecializationstate);
  55. procedure specialization_done(var state:tspecializationstate);
  56. implementation
  57. uses
  58. { common }
  59. cutils,fpchash,
  60. { global }
  61. globals,tokens,verbose,finput,constexp,
  62. { symtable }
  63. symconst,symsym,symtable,defcmp,defutil,procinfo,
  64. { modules }
  65. fmodule,
  66. { node }
  67. nobj,ncon,ncal,
  68. { parser }
  69. scanner,
  70. pbase,pexpr,pdecsub,ptype,psub,pparautl,pdecl,procdefutil;
  71. type
  72. tdeftypeset = set of tdeftyp;
  73. const
  74. tgeneric_param_const_types : tdeftypeset = [orddef,stringdef,floatdef,setdef,pointerdef,enumdef];
  75. tgeneric_param_nodes : tnodetypeset = [typen,ordconstn,stringconstn,realconstn,setconstn,niln];
  76. procedure make_prettystring(paramtype:tdef;first:boolean;constprettyname:ansistring;var prettyname,specializename:ansistring);
  77. var
  78. namepart : string;
  79. prettynamepart : ansistring;
  80. module : tmodule;
  81. begin
  82. if assigned(paramtype.owner) then
  83. module:=find_module_from_symtable(paramtype.owner)
  84. else
  85. module:=current_module;
  86. if not assigned(module) then
  87. internalerror(2016112802);
  88. namepart:='_$'+hexstr(module.moduleid,8)+'$$'+paramtype.unique_id_str;
  89. if constprettyname<>'' then
  90. namepart:=namepart+'$$'+constprettyname;
  91. { we use the full name of the type to uniquely identify it }
  92. if (symtablestack.top.symtabletype=parasymtable) and
  93. (symtablestack.top.defowner.typ=procdef) and
  94. (paramtype.owner=symtablestack.top) then
  95. begin
  96. { special handling for specializations inside generic function declarations }
  97. prettynamepart:=tdef(symtablestack.top.defowner).fullownerhierarchyname(true)+tprocdef(symtablestack.top.defowner).procsym.prettyname;
  98. end
  99. else
  100. begin
  101. prettynamepart:=paramtype.fullownerhierarchyname(true);
  102. end;
  103. specializename:=specializename+namepart;
  104. if not first then
  105. prettyname:=prettyname+',';
  106. if constprettyname<>'' then
  107. prettyname:=prettyname+constprettyname
  108. else
  109. prettyname:=prettyname+prettynamepart+paramtype.typesym.prettyname;
  110. end;
  111. function get_generic_param_def(sym:tsym):tdef;
  112. begin
  113. if sym.typ=constsym then
  114. result:=tconstsym(sym).constdef
  115. else
  116. result:=ttypesym(sym).typedef;
  117. end;
  118. function compare_orddef_by_range(param1,param2:torddef;value:tconstvalue):boolean;
  119. begin
  120. if (value.valueord<param2.low) or (value.valueord>param2.high) then
  121. result:=false
  122. else
  123. result:=true;
  124. end;
  125. function compare_generic_params(param1,param2:tdef;constparamsym:tconstsym):boolean;
  126. begin
  127. if (param1.typ=orddef) and (param2.typ=orddef) then
  128. begin
  129. if is_boolean(param2) then
  130. result:=is_boolean(param1)
  131. else if is_char(param2) then
  132. result:=is_char(param1)
  133. else if compare_orddef_by_range(torddef(param1),torddef(param2),constparamsym.value) then
  134. result:=true
  135. else
  136. result:=false;
  137. end
  138. { arraydef is string constant so it's compatible with stringdef }
  139. else if (param1.typ=arraydef) and (param2.typ=stringdef) then
  140. result:=true
  141. { integer ords are compatible with float }
  142. else if (param1.typ=orddef) and is_integer(param1) and (param2.typ=floatdef) then
  143. result:=true
  144. { chars are compatible with stringdef }
  145. else if (param1.typ=orddef) and is_char(param1) and (param2.typ=stringdef) then
  146. result:=true
  147. { undefined def is compatible with all types }
  148. else if param2.typ=undefineddef then
  149. result:=true
  150. { sets require stricter checks }
  151. else if is_set(param2) then
  152. result:=equal_defs(param1,param2)
  153. else
  154. result:=param1.typ=param2.typ;
  155. end;
  156. function create_generic_constsym(fromdef:tdef;node:tnode;out prettyname:string):tconstsym;
  157. const
  158. undefinedname = 'undefined';
  159. var
  160. sym : tconstsym;
  161. setdef : tsetdef;
  162. enumsym : tsym;
  163. enumname : string;
  164. sp : pchar;
  165. ps : ^tconstset;
  166. pd : ^bestreal;
  167. i : integer;
  168. begin
  169. if node=nil then
  170. internalerror(2020011401);
  171. case node.nodetype of
  172. ordconstn:
  173. begin
  174. sym:=cconstsym.create_ord(undefinedname,constord,tordconstnode(node).value,fromdef);
  175. prettyname:=tostr(tordconstnode(node).value.svalue);
  176. end;
  177. stringconstn:
  178. begin
  179. getmem(sp,tstringconstnode(node).len+1);
  180. move(tstringconstnode(node).value_str^,sp^,tstringconstnode(node).len+1);
  181. sym:=cconstsym.create_string(undefinedname,conststring,sp,tstringconstnode(node).len,fromdef);
  182. prettyname:=''''+tstringconstnode(node).value_str+'''';
  183. end;
  184. realconstn:
  185. begin
  186. new(pd);
  187. pd^:=trealconstnode(node).value_real;
  188. sym:=cconstsym.create_ptr(undefinedname,constreal,pd,fromdef);
  189. prettyname:=realtostr(trealconstnode(node).value_real);
  190. end;
  191. setconstn:
  192. begin
  193. new(ps);
  194. ps^:=tsetconstnode(node).value_set^;
  195. sym:=cconstsym.create_ptr(undefinedname,constset,ps,fromdef);
  196. setdef:=tsetdef(tsetconstnode(node).resultdef);
  197. prettyname:='[';
  198. for i := setdef.setbase to setdef.setmax do
  199. if i in tsetconstnode(node).value_set^ then
  200. begin
  201. if setdef.elementdef.typ=enumdef then
  202. enumsym:=tenumdef(setdef.elementdef).int2enumsym(i)
  203. else
  204. enumsym:=nil;
  205. if assigned(enumsym) then
  206. enumname:=enumsym.realname
  207. else if setdef.elementdef.typ=orddef then
  208. begin
  209. if torddef(setdef.elementdef).ordtype=uchar then
  210. enumname:=chr(i)
  211. else
  212. enumname:=tostr(i);
  213. end
  214. else
  215. enumname:=tostr(i);
  216. if length(prettyname) > 1 then
  217. prettyname:=prettyname+','+enumname
  218. else
  219. prettyname:=prettyname+enumname;
  220. end;
  221. prettyname:=prettyname+']';
  222. end;
  223. niln:
  224. begin
  225. { only "nil" is available for pointer constants }
  226. sym:=cconstsym.create_ord(undefinedname,constnil,0,fromdef);
  227. prettyname:='nil';
  228. end;
  229. else
  230. internalerror(2019021601);
  231. end;
  232. { the sym needs an owner for later checks so use the typeparam owner }
  233. sym.owner:=fromdef.owner;
  234. include(sym.symoptions,sp_generic_const);
  235. result:=sym;
  236. end;
  237. procedure maybe_add_waiting_unit(tt:tdef);
  238. var
  239. hmodule : tmodule;
  240. begin
  241. if not assigned(tt) or
  242. not (df_generic in tt.defoptions) then
  243. exit;
  244. hmodule:=find_module_from_symtable(tt.owner);
  245. if not assigned(hmodule) then
  246. internalerror(2012092401);
  247. if hmodule=current_module then
  248. exit;
  249. if not (hmodule.state in [ms_compiled,ms_processed]) then
  250. begin
  251. {$ifdef DEBUG_UNITWAITING}
  252. Writeln('Unit ', current_module.modulename^,
  253. ' waiting for ', hmodule.modulename^);
  254. {$endif DEBUG_UNITWAITING}
  255. if current_module.waitingforunit.indexof(hmodule)<0 then
  256. current_module.waitingforunit.add(hmodule);
  257. if hmodule.waitingunits.indexof(current_module)<0 then
  258. hmodule.waitingunits.add(current_module);
  259. end;
  260. end;
  261. procedure add_forward_generic_def(def:tdef;context:tspecializationcontext);
  262. var
  263. list : tfpobjectlist;
  264. fwdcontext : tspecializationcontext;
  265. begin
  266. if not is_implicit_pointer_object_type(def) then
  267. internalerror(2020070301);
  268. if not (oo_is_forward in tobjectdef(def).objectoptions) then
  269. internalerror(2020070302);
  270. if not assigned(tobjectdef(def).genericdef) then
  271. internalerror(2020070303);
  272. list:=tfpobjectlist(current_module.forwardgenericdefs.find(tobjectdef(def).genericdef.fulltypename));
  273. if not assigned(list) then
  274. begin
  275. list:=tfpobjectlist.create(true);
  276. current_module.forwardgenericdefs.add(tobjectdef(def).genericdef.fulltypename,list);
  277. end;
  278. fwdcontext:=context.getcopy;
  279. fwdcontext.forwarddef:=def;
  280. list.add(fwdcontext);
  281. end;
  282. function check_generic_constraints(genericdef:tstoreddef;paramlist:tfpobjectlist;poslist:tfplist):boolean;
  283. var
  284. i,j,
  285. intfcount : longint;
  286. formaldef,
  287. paradef : tstoreddef;
  288. genparadef : tdef;
  289. objdef,
  290. paraobjdef,
  291. formalobjdef : tobjectdef;
  292. intffound : boolean;
  293. filepos : tfileposinfo;
  294. is_const : boolean;
  295. begin
  296. { check whether the given specialization parameters fit to the eventual
  297. constraints of the generic }
  298. if not assigned(genericdef.genericparas) or (genericdef.genericparas.count=0) then
  299. internalerror(2012101001);
  300. if genericdef.genericparas.count<>paramlist.count then
  301. internalerror(2012101002);
  302. if paramlist.count<>poslist.count then
  303. internalerror(2012120801);
  304. result:=true;
  305. for i:=0 to genericdef.genericparas.count-1 do
  306. begin
  307. filepos:=pfileposinfo(poslist[i])^;
  308. paradef:=tstoreddef(get_generic_param_def(tsym(paramlist[i])));
  309. is_const:=tsym(paramlist[i]).typ=constsym;
  310. genparadef:=genericdef.get_generic_param_def(i);
  311. { validate const params }
  312. if not genericdef.is_generic_param_const(i) and is_const then
  313. begin
  314. MessagePos(filepos,type_e_mismatch);
  315. exit(false);
  316. end
  317. else if genericdef.is_generic_param_const(i) then
  318. begin
  319. { param type mismatch (type <> const) }
  320. if genericdef.is_generic_param_const(i)<>is_const then
  321. begin
  322. MessagePos(filepos,type_e_mismatch);
  323. exit(false);
  324. end;
  325. { type constrained param doesn't match type }
  326. if not compare_generic_params(paradef,genericdef.get_generic_param_def(i),tconstsym(paramlist[i])) then
  327. begin
  328. MessagePos2(filepos,type_e_incompatible_types,FullTypeName(paradef,genparadef),FullTypeName(genparadef,paradef));
  329. exit(false);
  330. end;
  331. end;
  332. { test constraints for non-const params }
  333. if not genericdef.is_generic_param_const(i) then
  334. begin
  335. formaldef:=tstoreddef(ttypesym(genericdef.genericparas[i]).typedef);
  336. if formaldef.typ=undefineddef then
  337. { the parameter is of unspecified type, so no need to check }
  338. continue;
  339. if not (df_genconstraint in formaldef.defoptions) or
  340. not assigned(formaldef.genconstraintdata) then
  341. internalerror(2013021602);
  342. { undefineddef is compatible with anything }
  343. if formaldef.typ=undefineddef then
  344. continue;
  345. if paradef.typ<>formaldef.typ then
  346. begin
  347. case formaldef.typ of
  348. recorddef:
  349. { delphi has own fantasy about record constraint
  350. (almost non-nullable/non-nilable value type) }
  351. if m_delphi in current_settings.modeswitches then
  352. case paradef.typ of
  353. floatdef,enumdef,orddef:
  354. continue;
  355. objectdef:
  356. if tobjectdef(paradef).objecttype=odt_object then
  357. continue
  358. else
  359. MessagePos(filepos,type_e_record_type_expected);
  360. else
  361. MessagePos(filepos,type_e_record_type_expected);
  362. end
  363. else
  364. MessagePos(filepos,type_e_record_type_expected);
  365. objectdef:
  366. case tobjectdef(formaldef).objecttype of
  367. odt_class,
  368. odt_javaclass:
  369. MessagePos1(filepos,type_e_class_type_expected,paradef.typename);
  370. odt_interfacecom,
  371. odt_interfacecorba,
  372. odt_dispinterface,
  373. odt_interfacejava:
  374. MessagePos1(filepos,type_e_interface_type_expected,paradef.typename);
  375. else
  376. internalerror(2012101003);
  377. end;
  378. errordef:
  379. { ignore }
  380. ;
  381. else
  382. internalerror(2012101004);
  383. end;
  384. result:=false;
  385. end
  386. else
  387. begin
  388. { the paradef types are the same, so do special checks for the
  389. cases in which they are needed }
  390. if formaldef.typ=objectdef then
  391. begin
  392. paraobjdef:=tobjectdef(paradef);
  393. formalobjdef:=tobjectdef(formaldef);
  394. if not (formalobjdef.objecttype in [odt_class,odt_javaclass,odt_interfacecom,odt_interfacecorba,odt_interfacejava,odt_dispinterface]) then
  395. internalerror(2012101102);
  396. if formalobjdef.objecttype in [odt_interfacecom,odt_interfacecorba,odt_interfacejava,odt_dispinterface] then
  397. begin
  398. { this is either a concerete interface or class type (the
  399. latter without specific implemented interfaces) }
  400. case paraobjdef.objecttype of
  401. odt_interfacecom,
  402. odt_interfacecorba,
  403. odt_interfacejava,
  404. odt_dispinterface:
  405. begin
  406. if (oo_is_forward in paraobjdef.objectoptions) and
  407. (paraobjdef.objecttype=formalobjdef.objecttype) and
  408. (df_genconstraint in formalobjdef.defoptions) and
  409. (
  410. (formalobjdef.objecttype=odt_interfacecom) and
  411. (formalobjdef.childof=interface_iunknown)
  412. )
  413. or
  414. (
  415. (formalobjdef.objecttype=odt_interfacecorba) and
  416. (formalobjdef.childof=nil)
  417. ) then
  418. continue;
  419. if not def_is_related(paraobjdef,formalobjdef.childof) then
  420. begin
  421. MessagePos2(filepos,type_e_incompatible_types,paraobjdef.typename,formalobjdef.childof.typename);
  422. result:=false;
  423. end;
  424. end;
  425. odt_class,
  426. odt_javaclass:
  427. begin
  428. objdef:=paraobjdef;
  429. intffound:=false;
  430. while assigned(objdef) do
  431. begin
  432. for j:=0 to objdef.implementedinterfaces.count-1 do
  433. if timplementedinterface(objdef.implementedinterfaces[j]).intfdef=formalobjdef.childof then
  434. begin
  435. intffound:=true;
  436. break;
  437. end;
  438. if intffound then
  439. break;
  440. objdef:=objdef.childof;
  441. end;
  442. result:=intffound;
  443. if not result then
  444. MessagePos2(filepos,parser_e_class_doesnt_implement_interface,paraobjdef.typename,formalobjdef.childof.typename);
  445. end;
  446. else
  447. begin
  448. MessagePos1(filepos,type_e_class_or_interface_type_expected,paraobjdef.typename);
  449. result:=false;
  450. end;
  451. end;
  452. end
  453. else
  454. begin
  455. { this is either a "class" or a concrete instance with
  456. or without implemented interfaces }
  457. if not (paraobjdef.objecttype in [odt_class,odt_javaclass]) then
  458. begin
  459. MessagePos1(filepos,type_e_class_type_expected,paraobjdef.typename);
  460. result:=false;
  461. continue;
  462. end;
  463. { for forward declared classes we allow pure TObject/class declarations }
  464. if (oo_is_forward in paraobjdef.objectoptions) and
  465. (df_genconstraint in formaldef.defoptions) then
  466. begin
  467. if (formalobjdef.childof=class_tobject) and
  468. not formalobjdef.implements_any_interfaces then
  469. continue;
  470. end;
  471. if assigned(formalobjdef.childof) and
  472. not def_is_related(paradef,formalobjdef.childof) then
  473. begin
  474. MessagePos2(filepos,type_e_incompatible_types,paraobjdef.typename,formalobjdef.childof.typename);
  475. result:=false;
  476. end;
  477. intfcount:=0;
  478. for j:=0 to formalobjdef.implementedinterfaces.count-1 do
  479. begin
  480. objdef:=paraobjdef;
  481. intffound:=false;
  482. while assigned(objdef) do
  483. begin
  484. intffound:=assigned(
  485. find_implemented_interface(objdef,
  486. timplementedinterface(formalobjdef.implementedinterfaces[j]).intfdef
  487. )
  488. );
  489. if intffound then
  490. break;
  491. objdef:=objdef.childof;
  492. end;
  493. if intffound then
  494. inc(intfcount)
  495. else
  496. MessagePos2(filepos,parser_e_class_doesnt_implement_interface,paraobjdef.typename,timplementedinterface(formalobjdef.implementedinterfaces[j]).intfdef.typename);
  497. end;
  498. if intfcount<>formalobjdef.implementedinterfaces.count then
  499. result:=false;
  500. end;
  501. end;
  502. end;
  503. end;
  504. end;
  505. end;
  506. function parse_generic_specialization_types_internal(paramlist:tfpobjectlist;poslist:tfplist;out prettyname,specializename:ansistring;parsedtype:tdef;parsedpos:tfileposinfo):boolean;
  507. var
  508. old_block_type : tblock_type;
  509. first : boolean;
  510. typeparam : tnode;
  511. parampos : pfileposinfo;
  512. tmpparampos : tfileposinfo;
  513. namepart : string;
  514. module : tmodule;
  515. constprettyname : string;
  516. validparam : boolean;
  517. begin
  518. result:=true;
  519. prettyname:='';
  520. constprettyname:='';
  521. if paramlist=nil then
  522. internalerror(2012061401);
  523. { set the block type to type, so that the parsed type are returned as
  524. ttypenode (e.g. classes are in non type-compatible blocks returned as
  525. tloadvmtaddrnode) }
  526. old_block_type:=block_type;
  527. { if parsedtype is set, then the first type identifer was already parsed
  528. (happens in inline specializations) and thus we only need to parse
  529. the remaining types and do as if the first one was already given }
  530. first:=not assigned(parsedtype);
  531. if assigned(parsedtype) then
  532. begin
  533. paramlist.Add(parsedtype.typesym);
  534. module:=find_module_from_symtable(parsedtype.owner);
  535. if not assigned(module) then
  536. internalerror(2016112801);
  537. namepart:='_$'+hexstr(module.moduleid,8)+'$$'+parsedtype.unique_id_str;
  538. specializename:='$'+namepart;
  539. prettyname:=parsedtype.fullownerhierarchyname(true)+parsedtype.typesym.prettyname;
  540. if assigned(poslist) then
  541. begin
  542. New(parampos);
  543. parampos^:=parsedpos;
  544. poslist.add(parampos);
  545. end;
  546. end
  547. else
  548. specializename:='$';
  549. while not (token in [_GT,_RSHARPBRACKET]) do
  550. begin
  551. { "first" is set to false at the end of the loop! }
  552. if not first then
  553. consume(_COMMA);
  554. block_type:=bt_type;
  555. tmpparampos:=current_filepos;
  556. typeparam:=factor(false,[ef_accept_equal]);
  557. { determine if the typeparam node is a valid type or const }
  558. validparam:=typeparam.nodetype in tgeneric_param_nodes;
  559. if validparam then
  560. begin
  561. if tstoreddef(typeparam.resultdef).is_generic and
  562. (
  563. not parse_generic or
  564. not defs_belong_to_same_generic(typeparam.resultdef,current_genericdef)
  565. ) then
  566. Message(parser_e_no_generics_as_params);
  567. if assigned(poslist) then
  568. begin
  569. New(parampos);
  570. parampos^:=tmpparampos;
  571. poslist.add(parampos);
  572. end;
  573. if typeparam.resultdef.typ<>errordef then
  574. begin
  575. if (typeparam.nodetype=typen) and not assigned(typeparam.resultdef.typesym) then
  576. message(type_e_generics_cannot_reference_itself)
  577. else if (typeparam.resultdef.typ<>errordef) then
  578. begin
  579. { all non-type nodes are considered const }
  580. if typeparam.nodetype<>typen then
  581. paramlist.Add(create_generic_constsym(typeparam.resultdef,typeparam,constprettyname))
  582. else
  583. begin
  584. constprettyname:='';
  585. paramlist.Add(typeparam.resultdef.typesym);
  586. end;
  587. make_prettystring(typeparam.resultdef,first,constprettyname,prettyname,specializename);
  588. end;
  589. end
  590. else
  591. begin
  592. result:=false;
  593. end;
  594. end
  595. else
  596. begin
  597. Message(type_e_type_id_expected);
  598. result:=false;
  599. end;
  600. typeparam.free;
  601. first:=false;
  602. end;
  603. block_type:=old_block_type;
  604. end;
  605. function parse_generic_specialization_types(paramlist:tfpobjectlist;poslist:tfplist;out prettyname,specializename:ansistring):boolean;
  606. var
  607. dummypos : tfileposinfo;
  608. begin
  609. FillChar(dummypos, SizeOf(tfileposinfo), 0);
  610. result:=parse_generic_specialization_types_internal(paramlist,poslist,prettyname,specializename,nil,dummypos);
  611. end;
  612. procedure generate_specialization(var tt:tdef;enforce_unit:boolean;parse_class_parent:boolean;const _prettyname:string);
  613. var
  614. dummypos : tfileposinfo;
  615. begin
  616. FillChar(dummypos, SizeOf(tfileposinfo), 0);
  617. generate_specialization(tt,enforce_unit,parse_class_parent,_prettyname,nil,'',dummypos);
  618. end;
  619. function finalize_specialization(var pd:tprocdef;spezcontext:tspecializationcontext):boolean;
  620. var
  621. def : tdef;
  622. begin
  623. result:=false;
  624. if assigned(spezcontext) then
  625. begin
  626. if not (df_generic in pd.defoptions) then
  627. internalerror(2015060301);
  628. { check whether the given parameters are compatible
  629. to the def's constraints }
  630. if not check_generic_constraints(pd,spezcontext.paramlist,spezcontext.poslist) then
  631. exit;
  632. def:=generate_specialization_phase2(spezcontext,pd,false,'');
  633. case def.typ of
  634. errordef:
  635. { do nothing }
  636. ;
  637. procdef:
  638. pd:=tprocdef(def);
  639. else
  640. internalerror(2015070303);
  641. end;
  642. end;
  643. result:=true;
  644. end;
  645. procedure transfer_unnamed_symbols(owner:tsymtable;unnamed_syms:tfplist);
  646. var
  647. i : integer;
  648. sym : tsym;
  649. begin
  650. for i:=0 to unnamed_syms.count-1 do
  651. begin
  652. sym:=tsym(unnamed_syms[i]);
  653. sym.ChangeOwnerAndName(owner,sym.realname);
  654. end;
  655. unnamed_syms.clear;
  656. end;
  657. function try_implicit_specialization(sym:tsym;para:tnode;pdoverloadlist:tfpobjectlist;var unnamed_syms:tfplist;var first_procsym:tsym;var hasoverload:boolean):boolean;
  658. { hash key for generic parameter lookups }
  659. function generic_param_hash(def:tdef):string;inline;
  660. begin
  661. result:=def.typename;
  662. end;
  663. { returns true if the def a literal array such as [1,2,3] and not a shortstring }
  664. function is_array_literal(def:tdef):boolean;
  665. begin
  666. result:=(def.typ=arraydef) and not is_conststring_array(def);
  667. end;
  668. { makes the specialization context from the generic proc def and generic params }
  669. procedure generate_implicit_specialization(out context:tspecializationcontext;genericdef:tprocdef;genericparams:tfphashlist);
  670. var
  671. parsedpos:tfileposinfo;
  672. poslist:tfplist;
  673. i: longint;
  674. paramtype: ttypesym;
  675. parampos : pfileposinfo;
  676. tmpparampos : tfileposinfo;
  677. paramname: string;
  678. begin
  679. context:=tspecializationcontext.create;
  680. fillchar(parsedpos,sizeof(parsedpos),0);
  681. poslist:=context.poslist;
  682. tmpparampos:=current_filepos;
  683. if genericparams.count<>genericdef.genericparas.count then
  684. internalerror(2021020901);
  685. for i:=0 to genericparams.count-1 do
  686. begin
  687. paramname:=generic_param_hash(ttypesym(genericdef.genericparas[i]).typedef);
  688. paramtype:=ttypesym(genericparams.find(paramname));
  689. if not assigned(paramtype) then
  690. internalerror(2021020902);
  691. new(parampos);
  692. parampos^:=tmpparampos;
  693. poslist.add(parampos);
  694. context.paramlist.Add(paramtype);
  695. make_prettystring(paramtype.typedef,i=0,'',context.prettyname,context.specializename);
  696. end;
  697. context.genname:=genericdef.procsym.realname;
  698. end;
  699. { specialization context parameter lists require a typesym so we need
  700. to generate a placeholder for unnamed constant types like
  701. short strings, open arrays, function pointers etc... }
  702. function create_unnamed_typesym(def:tdef):tsym;
  703. var
  704. newtype: tsym;
  705. begin
  706. newtype:=nil;
  707. if is_conststring_array(def) then
  708. begin
  709. { for constant strings we need to respect various modeswitches }
  710. if (cs_refcountedstrings in current_settings.localswitches) then
  711. begin
  712. if m_default_unicodestring in current_settings.modeswitches then
  713. newtype:=cunicodestringtype.typesym
  714. else
  715. newtype:=cansistringtype.typesym;
  716. end
  717. else
  718. newtype:=cshortstringtype.typesym;
  719. end
  720. else if def.typ=stringdef then
  721. newtype:=tstringdef(def).get_default_string_type.typesym
  722. else
  723. begin
  724. if is_array_constructor(def) then
  725. begin
  726. { array constructor is not a valid parameter type; getreusable
  727. avoids creating multiple implementations for calls with the
  728. same number of array elements of a particular type }
  729. def:=carraydef.getreusable(tarraydef(def).elementdef,tarraydef(def).highrange-tarraydef(def).lowrange+1);
  730. end;
  731. newtype:=ctypesym.create(def.fullownerhierarchyname(false)+typName[def.typ]+'$'+def.unique_id_str,def);
  732. include(newtype.symoptions,sp_generic_unnamed_type);
  733. newtype.owner:=def.owner;
  734. { ensure that there's no warning }
  735. newtype.refs:=1;
  736. end;
  737. if not assigned(newtype) then
  738. internalerror(2021020904);
  739. result:=newtype;
  740. end;
  741. { searches for the generic param in specializations }
  742. function find_param_in_specialization(owner:tprocdef;genericparam:ttypesym;def:tstoreddef):boolean;
  743. var
  744. parasym: ttypesym;
  745. k, i: integer;
  746. begin
  747. result:=false;
  748. for i:=0 to def.genericparas.count-1 do
  749. begin
  750. parasym:=ttypesym(def.genericparas[i]);
  751. { the generic param must have a named typesym }
  752. if not assigned(parasym.typedef.typesym) then
  753. internalerror(2021020907);
  754. { recurse into inline specialization }
  755. if tstoreddef(parasym.typedef).is_specialization then
  756. begin
  757. result:=find_param_in_specialization(owner,genericparam,tstoreddef(parasym.typedef));
  758. if result then
  759. exit;
  760. end
  761. else if (genericparam=parasym.typedef.typesym) and owner.is_generic_param(parasym.typedef) then
  762. exit(true);
  763. end;
  764. end;
  765. { searches for the generic param in arrays }
  766. function find_param_in_array(owner:tprocdef;genericparam:ttypesym;def:tarraydef):boolean;
  767. var
  768. elementdef:tstoreddef;
  769. begin
  770. elementdef:=tstoreddef(def.elementdef);
  771. { recurse into multi-dimensional array }
  772. if elementdef.typ=arraydef then
  773. result:=find_param_in_array(owner,genericparam,tarraydef(elementdef))
  774. { something went wrong during parsing and the element is invalid }
  775. else if elementdef.typ=errordef then
  776. result:=false
  777. else
  778. begin
  779. { the element must have a named typesym }
  780. if not assigned(elementdef.typesym) then
  781. internalerror(2021020906);
  782. result:=(genericparam=elementdef.typesym) and owner.is_generic_param(elementdef);
  783. end;
  784. end;
  785. { tests if the generic param is used in the parameter list }
  786. function is_generic_param_used(owner:tprocdef;genericparam:ttypesym;paras:tfplist):boolean;
  787. var
  788. paravar:tparavarsym;
  789. i: integer;
  790. begin
  791. result:=false;
  792. for i:=0 to paras.count-1 do
  793. begin
  794. paravar:=tparavarsym(paras[i]);
  795. { handle array types by using element types (for example: array of T) }
  796. if paravar.vardef.typ=arraydef then
  797. result:=find_param_in_array(owner,genericparam,tarraydef(paravar.vardef))
  798. { for specializations check search in generic params }
  799. else if tstoreddef(paravar.vardef).is_specialization then
  800. result:=find_param_in_specialization(owner,genericparam,tstoreddef(paravar.vardef))
  801. { something went wrong during parsing and the parameter is invalid }
  802. else if paravar.vardef.typ=errordef then
  803. exit(false)
  804. else
  805. begin
  806. if not assigned(paravar.vardef.typesym) then
  807. internalerror(2021020905);
  808. result:=(genericparam=paravar.vardef.typesym) and owner.is_generic_param(paravar.vardef)
  809. end;
  810. { exit if we find a used parameter }
  811. if result then
  812. exit;
  813. end;
  814. end;
  815. { handle generic specializations by using generic params from caller
  816. to specialize the target. for example "TRec<Integer>" can use "Integer"
  817. to specialize "TRec<T>" with "Integer" for "T". }
  818. procedure handle_specializations(genericparams:tfphashlist;target_def,caller_def:tstoreddef);
  819. var
  820. i,
  821. index : integer;
  822. key : string;
  823. target_param,
  824. caller_param : ttypesym;
  825. begin
  826. { the target and the caller must the same generic def
  827. with the same set of generic parameters }
  828. if target_def.genericdef<>caller_def.genericdef then
  829. internalerror(2021020909);
  830. for i:=0 to target_def.genericparas.count-1 do
  831. begin
  832. target_param:=ttypesym(target_def.genericparas[i]);
  833. caller_param:=ttypesym(caller_def.genericparas[i]);
  834. { reject generics with constants }
  835. if (target_param.typ=constsym) or (caller_param.typ=constsym) then
  836. exit;
  837. key:=generic_param_hash(target_param.typedef);
  838. { the generic param is already used }
  839. index:=genericparams.findindexof(key);
  840. if index>=0 then
  841. continue;
  842. { add the type to the generic params }
  843. genericparams.add(key,caller_param);
  844. end;
  845. end;
  846. { specialize arrays by using element types but arrays may be multi-dimensional
  847. so we need to examine the caller/target pairs recursively in order to
  848. verify the dimensionality is equal }
  849. function handle_arrays(owner:tprocdef;target_def,caller_def:tarraydef;out target_element,caller_element:tdef):boolean;
  850. begin
  851. { the target and the caller are both arrays and the target is a
  852. specialization so we can recurse into the targets element def }
  853. if is_array_literal(target_def.elementdef) and
  854. is_array_literal(caller_def.elementdef) and
  855. target_def.is_specialization then
  856. result:=handle_arrays(owner,tarraydef(target_def.elementdef),tarraydef(caller_def.elementdef),target_element,caller_element)
  857. else
  858. begin
  859. { the caller is an array which means the dimensionality is unbalanced
  860. and thus the arrays are compatible }
  861. if is_array_literal(caller_def.elementdef) then
  862. exit(false);
  863. { if the element is a generic param then return this type
  864. along with the caller element type at the same level }
  865. result:=owner.is_generic_param(target_def.elementdef);
  866. if result then
  867. begin
  868. target_element:=target_def.elementdef;
  869. caller_element:=caller_def.elementdef;
  870. end;
  871. end;
  872. end;
  873. { handle procvars by using the parameters from the caller to specialize
  874. the parameters of the target generic procedure specialization. for example:
  875. type generic TProc<S> = procedure(value: S);
  876. generic procedure Run<T>(proc: specialize TProc<T>);
  877. procedure DoCallback(value: integer);
  878. Run(@DoCallback);
  879. will specialize as Run<integer> because the signature
  880. of DoCallback() matches TProc<S> so we can specialize "S"
  881. with "integer", as they are both parameter #1
  882. }
  883. function handle_procvars(genericparams:tfphashlist;callerparams:tfplist;target_def:tdef;caller_def:tdef):boolean;
  884. var
  885. newparams : tfphashlist;
  886. procedure handle_generic_param(targetparadef,callerparadef:tdef);
  887. var
  888. key : string;
  889. index : integer;
  890. begin
  891. if not assigned(callerparadef.typesym) then
  892. internalerror(2021020908);
  893. key:=generic_param_hash(targetparadef);
  894. { the generic param must not already be used }
  895. index:=genericparams.findindexof(key);
  896. if index<0 then
  897. begin
  898. { add the type to the list }
  899. index:=newparams.findindexof(key);
  900. if index<0 then
  901. newparams.add(key,callerparadef.typesym);
  902. end;
  903. end;
  904. var
  905. i,j : integer;
  906. paravar : tparavarsym;
  907. target_proc,
  908. caller_proc : tprocvardef;
  909. target_proc_para,
  910. caller_proc_para : tparavarsym;
  911. valid_params : integer;
  912. begin
  913. result := false;
  914. target_proc:=tprocvardef(target_def);
  915. caller_proc:=tprocvardef(caller_def);
  916. { parameter count must match exactly
  917. currently default values are not considered }
  918. if target_proc.paras.count<>caller_proc.paras.count then
  919. exit;
  920. { a mixture of functions and procedures is not allowed }
  921. if (not assigned(target_proc.returndef) or is_void(target_proc.returndef)) xor
  922. (not assigned(caller_proc.returndef) or is_void(caller_proc.returndef)) then
  923. exit;
  924. { reject generics with constants }
  925. for i:=0 to target_proc.genericdef.genericparas.count-1 do
  926. if tsym(target_proc.genericdef.genericparas[i]).typ=constsym then
  927. exit;
  928. newparams:=tfphashlist.create;
  929. valid_params:=0;
  930. for i:=0 to target_proc.paras.count-1 do
  931. begin
  932. target_proc_para:=tparavarsym(target_proc.paras[i]);
  933. caller_proc_para:=tparavarsym(caller_proc.paras[i]);
  934. { the parameters are not compatible }
  935. if compare_defs(caller_proc_para.vardef,target_proc_para.vardef,nothingn)=te_incompatible then
  936. begin
  937. newparams.free;
  938. exit(false);
  939. end;
  940. if sp_generic_para in target_proc_para.vardef.typesym.symoptions then
  941. begin
  942. paravar:=tparavarsym(tprocvardef(target_proc.genericdef).paras[i]);
  943. { find the generic param name in the generic def parameters }
  944. j:=target_proc.genericdef.genericparas.findindexof(paravar.vardef.typesym.name);
  945. handle_generic_param(ttypesym(target_proc.genericparas[j]).typedef,caller_proc_para.vardef);
  946. end;
  947. inc(valid_params);
  948. end;
  949. if assigned(target_proc.returndef) and not is_void(target_proc.returndef) then
  950. begin
  951. { or check for exact? }
  952. if compare_defs(caller_proc.returndef,target_proc.returndef,nothingn)<te_equal then
  953. begin
  954. newparams.free;
  955. exit(false);
  956. end;
  957. if sp_generic_para in target_proc.returndef.typesym.symoptions then
  958. begin
  959. handle_generic_param(target_proc.returndef,caller_proc.returndef);
  960. end;
  961. end;
  962. { if the count of valid params matches the target then
  963. transfer the temporary params to the actual params }
  964. result:=valid_params=target_proc.paras.count;
  965. if result then
  966. for i := 0 to newparams.count-1 do
  967. genericparams.add(newparams.nameofindex(i),newparams[i]);
  968. newparams.free;
  969. end;
  970. function maybe_inherited_specialization(givendef,desireddef:tstoreddef;out basedef:tstoreddef):boolean;
  971. begin
  972. result:=false;
  973. basedef:=nil;
  974. if givendef.typ<>objectdef then
  975. begin
  976. result:=givendef.is_specialization and (givendef.genericdef=desireddef.genericdef);
  977. if result then
  978. basedef:=givendef;
  979. end
  980. else
  981. begin
  982. while assigned(givendef) do
  983. begin
  984. if givendef.is_specialization and (givendef.genericdef=desireddef.genericdef) then
  985. begin
  986. basedef:=givendef;
  987. result:=true;
  988. break;
  989. end;
  990. givendef:=tobjectdef(givendef).childof;
  991. end;
  992. end;
  993. end;
  994. { compare generic parameters <T> with call node parameters. }
  995. function is_possible_specialization(callerparams:tfplist;genericdef:tprocdef;out unnamed_syms:tfplist;out genericparams:tfphashlist):boolean;
  996. var
  997. i,j,
  998. count : integer;
  999. paravar : tparavarsym;
  1000. base_def : tstoreddef;
  1001. target_def,
  1002. caller_def : tdef;
  1003. target_key : string;
  1004. index : integer;
  1005. paras : tfplist;
  1006. target_element,
  1007. caller_element : tdef;
  1008. required_param_count : integer;
  1009. adef : tarraydef;
  1010. begin
  1011. result:=false;
  1012. paras:=nil;
  1013. genericparams:=nil;
  1014. required_param_count:=0;
  1015. unnamed_syms:=nil;
  1016. { first perform a check to reject generics with constants }
  1017. for i:=0 to genericdef.genericparas.count-1 do
  1018. if tsym(genericdef.genericparas[i]).typ=constsym then
  1019. exit;
  1020. { build list of visible target function parameters }
  1021. paras:=tfplist.create;
  1022. for i:=0 to genericdef.paras.count-1 do
  1023. begin
  1024. paravar:=tparavarsym(genericdef.paras[i]);
  1025. { ignore hidden parameters }
  1026. if vo_is_hidden_para in paravar.varoptions then
  1027. continue;
  1028. paras.add(paravar);
  1029. { const non-default parameters are required }
  1030. if not assigned(paravar.defaultconstsym) then
  1031. inc(required_param_count);
  1032. end;
  1033. { not enough parameters were supplied }
  1034. if callerparams.count<required_param_count then
  1035. begin
  1036. paras.free;
  1037. exit;
  1038. end;
  1039. { check to make sure the generic parameters are all used
  1040. at least once in the caller parameters. }
  1041. count:=0;
  1042. for i:=0 to genericdef.genericparas.count-1 do
  1043. if is_generic_param_used(genericdef,ttypesym(genericdef.genericparas[i]),paras) then
  1044. inc(count);
  1045. if count<genericdef.genericparas.count then
  1046. begin
  1047. paras.free;
  1048. exit;
  1049. end;
  1050. genericparams:=tfphashlist.create;
  1051. for i:=0 to callerparams.count-1 do
  1052. begin
  1053. caller_def:=ttypesym(callerparams[i]).typedef;
  1054. { caller parameter exceeded the possible parameters }
  1055. if i=paras.count then
  1056. begin
  1057. genericparams.free;
  1058. paras.free;
  1059. exit;
  1060. end;
  1061. target_def:=tparavarsym(paras[i]).vardef;
  1062. target_key:='';
  1063. { strings are compatible with "array of T" so we
  1064. need to use the element type for specialization }
  1065. if is_stringlike(caller_def) and
  1066. is_array_literal(target_def) and
  1067. genericdef.is_generic_param(tarraydef(target_def).elementdef) then
  1068. begin
  1069. target_def:=tarraydef(target_def).elementdef;
  1070. target_key:=generic_param_hash(target_def);
  1071. caller_def:=chartype_for_stringlike(caller_def);
  1072. end
  1073. { non-uniform array constructors (i.e. array of const) are not compatible
  1074. with normal arrays like "array of T" so we reject them }
  1075. else if is_array_literal(target_def) and
  1076. (caller_def.typ=arraydef) and
  1077. (ado_IsConstructor in tarraydef(caller_def).arrayoptions) and
  1078. (ado_IsArrayOfConst in tarraydef(caller_def).arrayoptions) then
  1079. begin
  1080. continue;
  1081. end
  1082. { handle generic arrays }
  1083. else if is_array_literal(caller_def) and
  1084. is_array_literal(target_def) and
  1085. handle_arrays(genericdef,tarraydef(target_def),tarraydef(caller_def),target_element,caller_element) then
  1086. begin
  1087. target_def:=target_element;
  1088. caller_def:=caller_element;
  1089. target_key:=generic_param_hash(target_def);
  1090. end
  1091. { handle generic procvars }
  1092. else if (caller_def.typ=procvardef) and
  1093. (target_def.typ=procvardef) and
  1094. tprocvardef(target_def).is_specialization and
  1095. handle_procvars(genericparams,callerparams,target_def,caller_def) then
  1096. begin
  1097. continue;
  1098. end
  1099. { handle specialized objects by taking the base class as the type to specialize }
  1100. else if is_class_or_object(caller_def) and
  1101. is_class_or_object(target_def) and
  1102. genericdef.is_generic_param(target_def) then
  1103. begin
  1104. target_key:=generic_param_hash(target_def);
  1105. target_def:=tobjectdef(target_def).childof;
  1106. end
  1107. { handle generic specializations }
  1108. else if tstoreddef(target_def).is_specialization and
  1109. maybe_inherited_specialization(tstoreddef(caller_def),tstoreddef(target_def),base_def) then
  1110. begin
  1111. handle_specializations(genericparams,tstoreddef(target_def),base_def);
  1112. continue;
  1113. end
  1114. { handle all other generic params }
  1115. else if target_def.typ=undefineddef then
  1116. target_key:=generic_param_hash(target_def);
  1117. { the param doesn't have a generic key which means we don't need to consider it }
  1118. if target_key='' then
  1119. continue;
  1120. { the generic param is already used }
  1121. index:=genericparams.findindexof(target_key);
  1122. if index>=0 then
  1123. continue;
  1124. { the caller type may not have a typesym so we need to create an unnamed one }
  1125. if not assigned(caller_def.typesym) then
  1126. begin
  1127. sym:=create_unnamed_typesym(caller_def);
  1128. { add the unnamed sym to the list but only it was allocated manually }
  1129. if sym.owner=caller_def.owner then
  1130. begin
  1131. if not assigned(unnamed_syms) then
  1132. unnamed_syms:=tfplist.create;
  1133. unnamed_syms.add(sym);
  1134. end;
  1135. genericparams.add(target_key,sym);
  1136. end
  1137. else
  1138. genericparams.add(target_key,caller_def.typesym);
  1139. end;
  1140. { if the parameter counts match then the specialization is possible }
  1141. result:=genericparams.count=genericdef.genericparas.count;
  1142. { cleanup }
  1143. paras.free;
  1144. if not result then
  1145. genericparams.free;
  1146. end;
  1147. { make an ordered list of parameters from the caller }
  1148. function make_param_list(dummysym:tsym;para:tnode;var unnamed_syms:tfplist):tfplist;
  1149. var
  1150. pt : tcallparanode;
  1151. paradef : tdef;
  1152. sym : tsym;
  1153. i : integer;
  1154. begin
  1155. result:=tfplist.create;
  1156. pt:=tcallparanode(para);
  1157. while assigned(pt) do
  1158. begin
  1159. paradef:=pt.paravalue.resultdef;
  1160. { unnamed parameter types can not be specialized }
  1161. if not assigned(paradef.typesym) then
  1162. begin
  1163. sym:=create_unnamed_typesym(paradef);
  1164. result.insert(0,sym);
  1165. { add the unnamed sym to the list but only if it was allocated manually }
  1166. if sym.owner=paradef.owner then
  1167. begin
  1168. if not assigned(unnamed_syms) then
  1169. unnamed_syms:=tfplist.create;
  1170. unnamed_syms.add(sym);
  1171. end;
  1172. end
  1173. else
  1174. result.insert(0,paradef.typesym);
  1175. pt:=tcallparanode(pt.nextpara);
  1176. end;
  1177. end;
  1178. var
  1179. i,j,k : integer;
  1180. srsym : tprocsym;
  1181. callerparams : tfplist;
  1182. pd : tprocdef;
  1183. dummysym : tprocsym;
  1184. genericparams : tfphashlist;
  1185. spezcontext : tspecializationcontext;
  1186. pd_unnamed_syms : tfplist;
  1187. begin
  1188. result:=false;
  1189. spezcontext:=nil;
  1190. genericparams:=nil;
  1191. dummysym:=tprocsym(sym);
  1192. callerparams:=make_param_list(dummysym,para,unnamed_syms);
  1193. { failed to build the parameter list }
  1194. if not assigned(callerparams) then
  1195. exit;
  1196. for i:=0 to dummysym.genprocsymovlds.count-1 do
  1197. begin
  1198. srsym:=tprocsym(dummysym.genprocsymovlds[i]);
  1199. for j:=0 to srsym.ProcdefList.Count-1 do
  1200. begin
  1201. pd:=tprocdef(srsym.ProcdefList[j]);
  1202. if is_possible_specialization(callerparams,pd,pd_unnamed_syms,genericparams) then
  1203. begin
  1204. generate_implicit_specialization(spezcontext,pd,genericparams);
  1205. genericparams.free;
  1206. { finalize the specialization so it can be added to the list of overloads }
  1207. if not finalize_specialization(pd,spezcontext) then
  1208. begin
  1209. spezcontext.free;
  1210. continue;
  1211. end;
  1212. { handle unnamed syms used by the specialization }
  1213. if pd_unnamed_syms<>nil then
  1214. begin
  1215. transfer_unnamed_symbols(pd.owner,pd_unnamed_syms);
  1216. pd_unnamed_syms.free;
  1217. end;
  1218. pdoverloadlist.add(pd);
  1219. spezcontext.free;
  1220. if po_overload in pd.procoptions then
  1221. hasoverload:=true;
  1222. { store first procsym found }
  1223. if not assigned(first_procsym) then
  1224. first_procsym:=srsym;
  1225. result:=true;
  1226. end
  1227. else
  1228. begin
  1229. { the specialization was not chosen so clean up any unnamed syms }
  1230. if pd_unnamed_syms<>nil then
  1231. begin
  1232. for k:=0 to pd_unnamed_syms.count-1 do
  1233. tsym(pd_unnamed_syms[k]).free;
  1234. pd_unnamed_syms.free;
  1235. end;
  1236. end;
  1237. end;
  1238. end;
  1239. callerparams.free;
  1240. end;
  1241. function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;enforce_unit:boolean):tdef;
  1242. var
  1243. dummypos : tfileposinfo;
  1244. {$push}
  1245. {$warn 5036 off}
  1246. begin
  1247. result:=generate_specialization_phase1(context,genericdef,enforce_unit,nil,'',nil,dummypos);
  1248. end;
  1249. {$pop}
  1250. function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;enforce_unit:boolean;const symname:string;symtable:tsymtable):tdef;
  1251. var
  1252. dummypos : tfileposinfo;
  1253. {$push}
  1254. {$warn 5036 off}
  1255. begin
  1256. result:=generate_specialization_phase1(context,genericdef,enforce_unit,nil,symname,symtable,dummypos);
  1257. end;
  1258. {$pop}
  1259. function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;enforce_unit:boolean;parsedtype:tdef;const symname:string;symtable:tsymtable;parsedpos:tfileposinfo):tdef;
  1260. var
  1261. found,
  1262. err : boolean;
  1263. i,
  1264. gencount : longint;
  1265. countstr,genname,ugenname,prettygenname: string;
  1266. tmpstack : tfpobjectlist;
  1267. symowner : tsymtable;
  1268. hmodule : tmodule;
  1269. begin
  1270. context:=nil;
  1271. result:=nil;
  1272. { either symname must be given or genericdef needs to be valid }
  1273. if (symname='') and
  1274. (not assigned(genericdef) or
  1275. (
  1276. (genericdef.typ<>procdef) and
  1277. (
  1278. not assigned(genericdef.typesym) or
  1279. (genericdef.typesym.typ<>typesym)
  1280. ) and
  1281. (
  1282. (genericdef.typ<>objectdef) or
  1283. not (oo_is_forward in tobjectdef(genericdef).objectoptions)
  1284. )
  1285. ) or
  1286. (
  1287. (genericdef.typ=procdef) and
  1288. (
  1289. not assigned(tprocdef(genericdef).procsym) or
  1290. (tprocdef(genericdef).procsym.typ<>procsym)
  1291. )
  1292. )
  1293. ) then
  1294. begin
  1295. internalerror(2019112401);
  1296. end;
  1297. if not assigned(parsedtype) and not try_to_consume(_LT) then
  1298. begin
  1299. consume(_LSHARPBRACKET);
  1300. { handle "<>" }
  1301. if (token=_GT) or (token=_RSHARPBRACKET) then
  1302. begin
  1303. Message(type_e_type_id_expected);
  1304. if not try_to_consume(_GT) then
  1305. try_to_consume(_RSHARPBRACKET);
  1306. result:=generrordef;
  1307. exit;
  1308. end;
  1309. end;
  1310. context:=tspecializationcontext.create;
  1311. { Parse type parameters }
  1312. err:=not parse_generic_specialization_types_internal(context.paramlist,context.poslist,context.prettyname,context.specializename,parsedtype,parsedpos);
  1313. if err then
  1314. begin
  1315. if not try_to_consume(_GT) then
  1316. try_to_consume(_RSHARPBRACKET);
  1317. context.free;
  1318. context:=nil;
  1319. result:=generrordef;
  1320. exit;
  1321. end;
  1322. { use the name of the symbol as procvars return a user friendly version
  1323. of the name }
  1324. if symname='' then
  1325. begin
  1326. if genericdef.typ=procdef then
  1327. genname:=tprocdef(genericdef).procsym.realname
  1328. else if assigned(genericdef.typesym) then
  1329. genname:=ttypesym(genericdef.typesym).realname
  1330. else if (genericdef.typ=objectdef) and (oo_is_forward in tobjectdef(genericdef).objectoptions) then
  1331. genname:=tobjectdef(genericdef).objrealname^
  1332. else
  1333. internalerror(2020071201);
  1334. end
  1335. else
  1336. genname:=symname;
  1337. { in case of non-Delphi mode the type name could already be a generic
  1338. def (but maybe the wrong one) }
  1339. if assigned(genericdef) and
  1340. ([df_generic,df_specialization]*genericdef.defoptions<>[]) then
  1341. begin
  1342. { remove the type count suffix from the generic's name }
  1343. for i:=Length(genname) downto 1 do
  1344. if genname[i]='$' then
  1345. begin
  1346. genname:=copy(genname,1,i-1);
  1347. break;
  1348. end;
  1349. { in case of a specialization we've only reached the specialization
  1350. checksum yet }
  1351. if df_specialization in genericdef.defoptions then
  1352. for i:=length(genname) downto 1 do
  1353. if genname[i]='$' then
  1354. begin
  1355. genname:=copy(genname,1,i-1);
  1356. break;
  1357. end;
  1358. end
  1359. else
  1360. begin
  1361. split_generic_name(genname,ugenname,gencount);
  1362. if genname<>ugenname then
  1363. genname:=ugenname;
  1364. end;
  1365. { search a generic with the given count of params }
  1366. countstr:='';
  1367. str(context.paramlist.Count,countstr);
  1368. prettygenname:=genname;
  1369. genname:=genname+'$'+countstr;
  1370. ugenname:=upper(genname);
  1371. context.genname:=genname;
  1372. if assigned(genericdef) then
  1373. symowner:=genericdef.owner
  1374. else
  1375. symowner:=symtable;
  1376. if assigned(symowner) and (symowner.symtabletype in [objectsymtable,recordsymtable]) then
  1377. begin
  1378. if symowner.symtabletype = objectsymtable then
  1379. found:=searchsym_in_class(tobjectdef(symowner.defowner),tobjectdef(symowner.defowner),ugenname,context.sym,context.symtable,[])
  1380. else
  1381. found:=searchsym_in_record(tabstractrecorddef(symowner.defowner),ugenname,context.sym,context.symtable);
  1382. if not found then
  1383. found:=searchsym(ugenname,context.sym,context.symtable);
  1384. end
  1385. else if enforce_unit then
  1386. begin
  1387. if not assigned(symowner) then
  1388. internalerror(2022102101);
  1389. if not (symowner.symtabletype in [globalsymtable,recordsymtable]) then
  1390. internalerror(2022102102);
  1391. hmodule:=find_module_from_symtable(symowner);
  1392. if not assigned(hmodule) then
  1393. internalerror(2022102103);
  1394. found:=searchsym_in_module(hmodule,ugenname,context.sym,context.symtable);
  1395. end
  1396. else
  1397. found:=searchsym(ugenname,context.sym,context.symtable);
  1398. if found and (context.sym.typ=absolutevarsym) and
  1399. (vo_is_funcret in tabstractvarsym(context.sym).varoptions) then
  1400. begin
  1401. { we found the function result alias of a generic function; go up the
  1402. symbol stack *before* this alias was inserted, so that we can
  1403. (hopefully) find the correct generic symbol }
  1404. tmpstack:=tfpobjectlist.create(false);
  1405. while assigned(symtablestack.top) do
  1406. begin
  1407. tmpstack.Add(symtablestack.top);
  1408. symtablestack.pop(symtablestack.top);
  1409. if tmpstack.Last=context.symtable then
  1410. break;
  1411. end;
  1412. if not assigned(symtablestack.top) then
  1413. internalerror(2019123001);
  1414. found:=searchsym(ugenname,context.sym,context.symtable);
  1415. for i:=tmpstack.count-1 downto 0 do
  1416. symtablestack.push(tsymtable(tmpstack[i]));
  1417. tmpstack.free;
  1418. end;
  1419. if not found or not (context.sym.typ in [typesym,procsym]) then
  1420. begin
  1421. identifier_not_found(prettygenname);
  1422. if not try_to_consume(_GT) then
  1423. try_to_consume(_RSHARPBRACKET);
  1424. context.free;
  1425. context:=nil;
  1426. result:=generrordef;
  1427. exit;
  1428. end;
  1429. { we've found the correct def }
  1430. if context.sym.typ=typesym then
  1431. result:=tstoreddef(ttypesym(context.sym).typedef)
  1432. else
  1433. begin
  1434. if tprocsym(context.sym).procdeflist.count=0 then
  1435. internalerror(2015061203);
  1436. result:=tstoreddef(tprocsym(context.sym).procdefList[0]);
  1437. end;
  1438. if not try_to_consume(_GT) then
  1439. consume(_RSHARPBRACKET);
  1440. end;
  1441. function generate_specialization_phase2(context:tspecializationcontext;genericdef:tstoreddef;parse_class_parent:boolean;const _prettyname:ansistring):tdef;
  1442. procedure unset_forwarddef(def: tdef);
  1443. var
  1444. st : TSymtable;
  1445. i : longint;
  1446. begin
  1447. case def.typ of
  1448. procdef:
  1449. tprocdef(def).forwarddef:=false;
  1450. objectdef,
  1451. recorddef:
  1452. begin
  1453. st:=def.getsymtable(gs_record);
  1454. for i:=0 to st.deflist.count-1 do
  1455. unset_forwarddef(tdef(st.deflist[i]));
  1456. end;
  1457. else
  1458. ;
  1459. end;
  1460. end;
  1461. procedure retrieve_genericdef_or_procsym(sym:tsym;out gendef:tdef;out psym:tsym);
  1462. var
  1463. i : longint;
  1464. begin
  1465. gendef:=nil;
  1466. psym:=nil;
  1467. case sym.typ of
  1468. typesym:
  1469. begin
  1470. gendef:=ttypesym(sym).typedef
  1471. end;
  1472. procsym:
  1473. begin
  1474. for i:=0 to tprocsym(sym).procdeflist.count-1 do
  1475. if tstoreddef(tprocsym(sym).procdeflist[i]).genericdef=genericdef then
  1476. begin
  1477. gendef:=tdef(tprocsym(sym).procdeflist[i]);
  1478. break;
  1479. end;
  1480. psym:=sym;
  1481. end
  1482. else
  1483. internalerror(200710171);
  1484. end;
  1485. end;
  1486. function find_in_hierarchy(def:tdef;generictypelist:tfphashobjectlist):tdef;
  1487. var
  1488. paramdef1,
  1489. paramdef2 : tdef;
  1490. allequal : boolean;
  1491. i : longint;
  1492. begin
  1493. result:=nil;
  1494. while assigned(def) do
  1495. begin
  1496. if (df_generic in def.defoptions) and (def=genericdef) then
  1497. begin
  1498. result:=def;
  1499. break;
  1500. end;
  1501. { the following happens when a routine with its parent struct
  1502. as parameter is specialized as a parameter or result of a
  1503. generic function }
  1504. if (df_specialization in def.defoptions) and (tstoreddef(def).genericdef=genericdef) then
  1505. begin
  1506. if tstoreddef(def).genericparas.count=generictypelist.count then
  1507. begin
  1508. allequal:=true;
  1509. for i:=0 to generictypelist.count-1 do
  1510. begin
  1511. if tsym(generictypelist[i]).typ<>tsym(tstoreddef(def).genericparas[i]).typ then
  1512. begin
  1513. allequal:=false;
  1514. break;
  1515. end;
  1516. if tsym(generictypelist[i]).typ=constsym then
  1517. paramdef1:=tconstsym(generictypelist[i]).constdef
  1518. else
  1519. paramdef1:=ttypesym(generictypelist[i]).typedef;
  1520. if tsym(tstoreddef(def).genericparas[i]).typ=constsym then
  1521. paramdef2:=tconstsym(tstoreddef(def).genericparas[i]).constdef
  1522. else
  1523. paramdef2:=ttypesym(tstoreddef(def).genericparas[i]).typedef;
  1524. if not equal_defs(paramdef1,paramdef2) then
  1525. begin
  1526. allequal:=false;
  1527. break;
  1528. end;
  1529. if (tsym(generictypelist[i]).typ=constsym) and
  1530. (
  1531. (tconstsym(generictypelist[i]).consttyp<>tconstsym(tstoreddef(def).genericparas[i]).consttyp) or
  1532. not same_constvalue(tconstsym(generictypelist[i]).consttyp,tconstsym(generictypelist[i]).value,tconstsym(tstoreddef(def).genericparas[i]).value)
  1533. ) then
  1534. begin
  1535. allequal:=false;
  1536. break;
  1537. end;
  1538. end;
  1539. if allequal then
  1540. begin
  1541. result:=def;
  1542. break;
  1543. end;
  1544. end;
  1545. end;
  1546. if assigned(def.owner) then
  1547. def:=tstoreddef(def.owner.defowner)
  1548. else
  1549. def:=nil;
  1550. end;
  1551. end;
  1552. var
  1553. finalspecializename,
  1554. ufinalspecializename : tidstring;
  1555. hierarchy,
  1556. prettyname : ansistring;
  1557. generictypelist : tfphashobjectlist;
  1558. srsymtable,
  1559. specializest : tsymtable;
  1560. hashedid : thashedidstring;
  1561. tempst : tglobalsymtable;
  1562. tsrsym : ttypesym;
  1563. psym,
  1564. srsym : tsym;
  1565. flags : thccflags;
  1566. paramdef1,
  1567. paramdef2,
  1568. def : tdef;
  1569. old_block_type : tblock_type;
  1570. state : tspecializationstate;
  1571. old_current_structdef : tabstractrecorddef;
  1572. old_current_specializedef,
  1573. old_current_genericdef : tstoreddef;
  1574. old_current_procinfo : tprocinfo;
  1575. old_module_procinfo : tobject;
  1576. hmodule : tmodule;
  1577. oldcurrent_filepos : tfileposinfo;
  1578. recordbuf : tdynamicarray;
  1579. hadtypetoken : boolean;
  1580. i,
  1581. replaydepth : longint;
  1582. item : tobject;
  1583. allequal,
  1584. hintsprocessed : boolean;
  1585. pd : tprocdef;
  1586. pdflags : tpdflags;
  1587. ppflags : tparse_proc_flags;
  1588. begin
  1589. if not assigned(context) then
  1590. internalerror(2015052203);
  1591. result:=nil;
  1592. pd:=nil;
  1593. hmodule:=nil;
  1594. if not check_generic_constraints(genericdef,context.paramlist,context.poslist) then
  1595. begin
  1596. { the parameters didn't fit the constraints, so don't continue with the
  1597. specialization }
  1598. result:=generrordef;
  1599. exit;
  1600. end;
  1601. { build the new type's name }
  1602. hierarchy:=genericdef.ownerhierarchyname;
  1603. if assigned(genericdef.owner) then
  1604. begin
  1605. hmodule:=find_module_from_symtable(genericdef.owner);
  1606. if not assigned(hmodule) then
  1607. internalerror(2022102801);
  1608. if hierarchy<>'' then
  1609. hierarchy:='.'+hierarchy;
  1610. hierarchy:=hmodule.modulename^+hierarchy;
  1611. end;
  1612. finalspecializename:=generate_generic_name(context.genname,context.specializename,hierarchy);
  1613. ufinalspecializename:=upper(finalspecializename);
  1614. if genericdef.typ=procdef then
  1615. prettyname:=tprocdef(genericdef).procsym.prettyname
  1616. else
  1617. prettyname:=genericdef.typesym.prettyname;
  1618. prettyname:=prettyname+'<'+context.prettyname+'>';
  1619. generictypelist:=tfphashobjectlist.create(false);
  1620. { build the list containing the types for the generic params }
  1621. if not assigned(genericdef.genericparas) then
  1622. internalerror(2013092601);
  1623. if context.paramlist.count<>genericdef.genericparas.count then
  1624. internalerror(2013092603);
  1625. for i:=0 to genericdef.genericparas.Count-1 do
  1626. begin
  1627. srsym:=tsym(genericdef.genericparas[i]);
  1628. if not (sp_generic_para in srsym.symoptions) then
  1629. internalerror(2013092602);
  1630. generictypelist.add(srsym.realname,context.paramlist[i]);
  1631. end;
  1632. { Special case if we are referencing the current defined object }
  1633. if assigned(current_structdef) and
  1634. (current_structdef.objname^=ufinalspecializename) then
  1635. result:=current_structdef;
  1636. { Can we reuse an already specialized type? }
  1637. { for this first check whether we are currently specializing a nested
  1638. type of the current (main) specialization (this is necessary, because
  1639. during that time the symbol of the main specialization will still
  1640. contain a reference to an errordef) }
  1641. if not assigned(result) and assigned(current_specializedef) then
  1642. begin
  1643. def:=current_specializedef;
  1644. repeat
  1645. if def.typ in [objectdef,recorddef] then
  1646. if tabstractrecorddef(def).objname^=ufinalspecializename then begin
  1647. result:=def;
  1648. break;
  1649. end;
  1650. if assigned(def.owner) then
  1651. def:=tstoreddef(def.owner.defowner)
  1652. else
  1653. { this can happen when specializing a generic function }
  1654. def:=nil;
  1655. until not assigned(def) or not (df_specialization in def.defoptions);
  1656. end;
  1657. { if the genericdef is the def we are currently parsing (or one of its parents) then we can
  1658. not use it for specializing as the tokenbuffer is not yet set (and we aren't done with
  1659. parsing anyway), so for now we treat those still as generic defs without doing a partial
  1660. specialization }
  1661. if not assigned(result) then
  1662. begin
  1663. def:=current_genericdef;
  1664. if def=genericdef then
  1665. result:=def
  1666. else if assigned(current_genericdef) then
  1667. result:=find_in_hierarchy(current_genericdef,generictypelist);
  1668. if not assigned(result) and assigned(current_specializedef) then
  1669. result:=find_in_hierarchy(current_specializedef,generictypelist);
  1670. end;
  1671. { decide in which symtable to put the specialization }
  1672. if assigned(context.forwarddef) then
  1673. begin
  1674. specializest:=context.forwarddef.owner;
  1675. end
  1676. else if parse_generic and not assigned(result) then
  1677. begin
  1678. srsymtable:=symtablestack.top;
  1679. if (srsymtable.symtabletype in [localsymtable,parasymtable]) and tstoreddef(srsymtable.defowner).is_specialization then
  1680. { if we are currently specializing a routine we need to specialize into
  1681. the routine's local- or parasymtable so that they are correctly
  1682. registered should the specialization be finalized }
  1683. specializest:=srsymtable
  1684. else if assigned(current_procinfo) and (df_generic in current_procinfo.procdef.defoptions) then
  1685. { if we are parsing the definition of a method we specialize into
  1686. the local symtable of it }
  1687. specializest:=current_procinfo.procdef.getsymtable(gs_local)
  1688. else
  1689. begin
  1690. if not assigned(current_genericdef) then
  1691. internalerror(2014050901);
  1692. { we specialize the partial specialization into the symtable of the currently parsed
  1693. generic }
  1694. case current_genericdef.typ of
  1695. procvardef:
  1696. specializest:=current_genericdef.getsymtable(gs_para);
  1697. procdef:
  1698. specializest:=current_genericdef.getsymtable(gs_local);
  1699. objectdef,
  1700. recorddef:
  1701. specializest:=current_genericdef.getsymtable(gs_record);
  1702. arraydef:
  1703. specializest:=tarraydef(current_genericdef).symtable;
  1704. else
  1705. internalerror(2014050902);
  1706. end;
  1707. end;
  1708. end
  1709. else
  1710. if current_module.is_unit and current_module.in_interface then
  1711. specializest:=current_module.globalsymtable
  1712. else
  1713. specializest:=current_module.localsymtable;
  1714. if not assigned(specializest) then
  1715. internalerror(2014050910);
  1716. { now check whether there is a specialization somewhere else }
  1717. psym:=nil;
  1718. if not assigned(result) then
  1719. begin
  1720. hashedid.id:=ufinalspecializename;
  1721. if (specializest.symtabletype=objectsymtable) and not assigned(context.forwarddef) then
  1722. begin
  1723. { search also in parent classes }
  1724. if not assigned(current_genericdef) or (current_genericdef.typ<>objectdef) then
  1725. internalerror(2016112901);
  1726. if not searchsym_in_class(tobjectdef(current_genericdef),tobjectdef(current_genericdef),ufinalspecializename,srsym,srsymtable,[]) then
  1727. srsym:=nil;
  1728. end
  1729. else
  1730. srsym:=tsym(specializest.findwithhash(hashedid));
  1731. if assigned(context.forwarddef) then
  1732. begin
  1733. { just do a few sanity checks }
  1734. if not assigned(srsym) or not (srsym.typ=typesym) then
  1735. internalerror(2020070306);
  1736. if ttypesym(srsym).typedef<>context.forwarddef then
  1737. internalerror(2020070307);
  1738. end
  1739. else if assigned(srsym) then
  1740. begin
  1741. retrieve_genericdef_or_procsym(srsym,result,psym);
  1742. end
  1743. else
  1744. { the generic could have been specialized in the globalsymtable
  1745. already, so search there as well }
  1746. if (specializest<>current_module.globalsymtable) and assigned(current_module.globalsymtable) then
  1747. begin
  1748. srsym:=tsym(current_module.globalsymtable.findwithhash(hashedid));
  1749. if assigned(srsym) then
  1750. begin
  1751. retrieve_genericdef_or_procsym(srsym,result,psym);
  1752. end;
  1753. end;
  1754. end;
  1755. if not assigned(result) then
  1756. begin
  1757. specialization_init(genericdef,state);
  1758. { push a temporary global symtable so that the specialization is
  1759. added to the correct symtable; this symtable does not contain
  1760. any other symbols, so that the type resolution can not be
  1761. influenced by symbols in the current unit }
  1762. tempst:=tspecializesymtable.create(current_module.modulename^,current_module.moduleid);
  1763. symtablestack.push(tempst);
  1764. { Reparse the original type definition }
  1765. begin
  1766. old_current_specializedef:=nil;
  1767. old_current_genericdef:=nil;
  1768. old_current_structdef:=nil;
  1769. old_current_procinfo:=current_procinfo;
  1770. old_module_procinfo:=current_module.procinfo;
  1771. current_procinfo:=nil;
  1772. current_module.procinfo:=nil;
  1773. if parse_class_parent then
  1774. begin
  1775. old_current_structdef:=current_structdef;
  1776. old_current_genericdef:=current_genericdef;
  1777. old_current_specializedef:=current_specializedef;
  1778. if genericdef.owner.symtabletype in [recordsymtable,objectsymtable] then
  1779. current_structdef:=tabstractrecorddef(genericdef.owner.defowner)
  1780. else
  1781. current_structdef:=nil;
  1782. current_genericdef:=nil;
  1783. current_specializedef:=nil;
  1784. end;
  1785. maybe_add_waiting_unit(genericdef);
  1786. { First a new sym so we can reuse this specialization and
  1787. references to this specialization can be handled }
  1788. if genericdef.typ=procdef then
  1789. if assigned(psym) then
  1790. srsym:=psym
  1791. else
  1792. srsym:=cprocsym.create(finalspecializename)
  1793. else
  1794. srsym:=ctypesym.create(finalspecializename,generrordef);
  1795. { insert the symbol only if we don't know already that we have
  1796. a procsym to add it to and we aren't dealing with a forwarddef }
  1797. if not assigned(psym) and not assigned(context.forwarddef) then
  1798. specializest.insertsym(srsym);
  1799. { specializations are declarations as such it is the wisest to
  1800. declare set the blocktype to "type"; otherwise we'll
  1801. experience unexpected side effects like the addition of
  1802. classrefdefs if we have a generic that's derived from another
  1803. generic }
  1804. old_block_type:=block_type;
  1805. block_type:=bt_type;
  1806. if (
  1807. (genericdef.typ=procdef) and
  1808. not assigned(tprocdef(genericdef).genericdecltokenbuf)
  1809. ) or (
  1810. (genericdef.typ<>procdef) and
  1811. not assigned(genericdef.generictokenbuf)
  1812. ) then
  1813. internalerror(200511171);
  1814. if hmodule=nil then
  1815. internalerror(2012051202);
  1816. oldcurrent_filepos:=current_filepos;
  1817. { use the index the module got from the current compilation process }
  1818. current_filepos.moduleindex:=hmodule.unit_index;
  1819. current_tokenpos:=current_filepos;
  1820. if parse_generic then
  1821. begin
  1822. recordbuf:=current_scanner.recordtokenbuf;
  1823. current_scanner.recordtokenbuf:=nil;
  1824. end
  1825. else
  1826. recordbuf:=nil;
  1827. replaydepth:=current_scanner.replay_stack_depth;
  1828. if genericdef.typ=procdef then
  1829. begin
  1830. current_scanner.startreplaytokens(tprocdef(genericdef).genericdecltokenbuf,hmodule.change_endian);
  1831. parse_proc_head(tprocdef(genericdef).struct,tprocdef(genericdef).proctypeoption,[],genericdef,generictypelist,pd);
  1832. if assigned(pd) then
  1833. begin
  1834. if assigned(psym) then
  1835. pd.procsym:=psym
  1836. else
  1837. pd.procsym:=srsym;
  1838. ppflags:=[];
  1839. if po_classmethod in tprocdef(genericdef).procoptions then
  1840. include(ppflags,ppf_classmethod);
  1841. parse_proc_dec_finish(pd,ppflags,tprocdef(genericdef).struct);
  1842. end;
  1843. result:=pd;
  1844. end
  1845. else
  1846. begin
  1847. current_scanner.startreplaytokens(genericdef.generictokenbuf,hmodule.change_endian);
  1848. if assigned(context.forwarddef) then
  1849. begin
  1850. tsrsym:=nil;
  1851. result:=parse_forward_declaration(context.forwarddef.typesym,ufinalspecializename,finalspecializename,genericdef,generictypelist,tsrsym);
  1852. srsym:=tsrsym;
  1853. end
  1854. else
  1855. begin
  1856. hadtypetoken:=false;
  1857. { ensure a pretty name for error messages, might be chanced below }
  1858. if _prettyname<>'' then
  1859. ttypesym(srsym).fprettyname:=_prettyname
  1860. else
  1861. ttypesym(srsym).fprettyname:=prettyname;
  1862. read_named_type(result,srsym,genericdef,generictypelist,false,hadtypetoken);
  1863. ttypesym(srsym).typedef:=result;
  1864. result.typesym:=srsym;
  1865. end;
  1866. if _prettyname<>'' then
  1867. ttypesym(result.typesym).fprettyname:=_prettyname
  1868. else
  1869. ttypesym(result.typesym).fprettyname:=prettyname;
  1870. end;
  1871. current_filepos:=oldcurrent_filepos;
  1872. { Note regarding hint directives:
  1873. There is no need to remove the flags for them from the
  1874. specialized generic symbol, because hint directives that
  1875. follow the specialization are handled by the code in
  1876. pdecl.types_dec and added to the type symbol.
  1877. E.g.: TFoo = TBar<Blubb> deprecated;
  1878. Here the symbol TBar$1$Blubb will contain the
  1879. "sp_hint_deprecated" flag while the TFoo symbol won't.}
  1880. case result.typ of
  1881. { Build VMT indexes for classes and read hint directives }
  1882. objectdef:
  1883. begin
  1884. if replaydepth<current_scanner.replay_stack_depth then
  1885. begin
  1886. try_consume_hintdirective(srsym.symoptions,srsym.deprecatedmsg);
  1887. if replaydepth<current_scanner.replay_stack_depth then
  1888. consume(_SEMICOLON);
  1889. end;
  1890. if oo_is_forward in tobjectdef(result).objectoptions then
  1891. add_forward_generic_def(result,context)
  1892. else
  1893. build_vmt(tobjectdef(result));
  1894. end;
  1895. { handle params, calling convention, etc }
  1896. procvardef:
  1897. begin
  1898. hintsprocessed:=false;
  1899. if replaydepth<current_scanner.replay_stack_depth then
  1900. begin
  1901. if not check_proc_directive(true) then
  1902. begin
  1903. hintsprocessed:=try_consume_hintdirective(ttypesym(srsym).symoptions,ttypesym(srsym).deprecatedmsg);
  1904. if replaydepth<current_scanner.replay_stack_depth then
  1905. consume(_SEMICOLON);
  1906. end
  1907. else
  1908. hintsprocessed:=true;
  1909. end;
  1910. if replaydepth<current_scanner.replay_stack_depth then
  1911. parse_proctype_directives(tprocvardef(result));
  1912. if po_is_function_ref in tprocvardef(result).procoptions then
  1913. adjust_funcref(result,srsym,nil);
  1914. if result.typ=procvardef then
  1915. flags:=hcc_default_actions_intf
  1916. else
  1917. flags:=hcc_default_actions_intf_struct;
  1918. handle_calling_convention(result,flags);
  1919. if not hintsprocessed and (replaydepth<current_scanner.replay_stack_depth) then
  1920. begin
  1921. try_consume_hintdirective(ttypesym(srsym).symoptions,ttypesym(srsym).deprecatedmsg);
  1922. if replaydepth<current_scanner.replay_stack_depth then
  1923. consume(_SEMICOLON);
  1924. end;
  1925. end;
  1926. procdef:
  1927. begin
  1928. pdflags:=[];
  1929. if genericdef.owner.symtabletype=objectsymtable then
  1930. include(pdflags,pd_object)
  1931. else if genericdef.owner.symtabletype=recordsymtable then
  1932. include(pdflags,pd_record);
  1933. parse_proc_directives(pd,pdflags);
  1934. while try_consume_hintdirective(pd.symoptions,pd.deprecatedmsg) do
  1935. consume(_SEMICOLON);
  1936. if parse_generic then
  1937. handle_calling_convention(tprocdef(result),hcc_default_actions_intf)
  1938. else
  1939. handle_calling_convention(tprocdef(result),hcc_default_actions_impl);
  1940. proc_add_definition(tprocdef(result));
  1941. { for partial specializations we implicitely declare the routine as
  1942. having its implementation although we'll not specialize it in reality }
  1943. if parse_generic then
  1944. unset_forwarddef(result);
  1945. end;
  1946. else
  1947. { parse hint directives for records and arrays }
  1948. if replaydepth<current_scanner.replay_stack_depth then begin
  1949. try_consume_hintdirective(srsym.symoptions,srsym.deprecatedmsg);
  1950. if replaydepth<current_scanner.replay_stack_depth then
  1951. consume(_SEMICOLON);
  1952. end;
  1953. end;
  1954. { Consume the remainder of the buffer }
  1955. while current_scanner.replay_stack_depth>replaydepth do
  1956. consume(token);
  1957. if assigned(recordbuf) then
  1958. begin
  1959. if assigned(current_scanner.recordtokenbuf) then
  1960. internalerror(2014050909);
  1961. current_scanner.recordtokenbuf:=recordbuf;
  1962. end;
  1963. block_type:=old_block_type;
  1964. current_procinfo:=old_current_procinfo;
  1965. current_module.procinfo:=old_module_procinfo;
  1966. if parse_class_parent then
  1967. begin
  1968. current_structdef:=old_current_structdef;
  1969. current_genericdef:=old_current_genericdef;
  1970. current_specializedef:=old_current_specializedef;
  1971. end;
  1972. end;
  1973. { extract all created symbols and defs from the temporary symtable
  1974. and add them to the specializest }
  1975. for i:=tempst.SymList.Count-1 downto 0 do
  1976. begin
  1977. item:=tempst.SymList.Items[i];
  1978. { using changeowner the symbol is automatically added to the
  1979. new symtable }
  1980. tsym(item).ChangeOwner(specializest);
  1981. end;
  1982. for i:=tempst.DefList.Count-1 downto 0 do
  1983. begin
  1984. item:=tempst.DefList.Items[i];
  1985. { using changeowner the def is automatically added to the new
  1986. symtable }
  1987. tdef(item).ChangeOwner(specializest);
  1988. { for partial specializations we implicitely declare any methods as having their
  1989. implementations although we'll not specialize them in reality }
  1990. if parse_generic then
  1991. unset_forwarddef(tdef(item));
  1992. end;
  1993. { if a generic was declared during the specialization we need to
  1994. flag the specialize symtable accordingly }
  1995. if sto_has_generic in tempst.tableoptions then
  1996. specializest.includeoption(sto_has_generic);
  1997. tempst.free;
  1998. specialization_done(state);
  1999. { procdefs are only added once we know which overload we use }
  2000. if not parse_generic and (result.typ<>procdef) then
  2001. current_module.pendingspecializations.add(result.typename,result);
  2002. end;
  2003. generictypelist.free;
  2004. if assigned(genericdef) then
  2005. begin
  2006. { check the hints of the found generic symbol }
  2007. if genericdef.typ=procdef then
  2008. srsym:=tprocdef(genericdef).procsym
  2009. else
  2010. srsym:=genericdef.typesym;
  2011. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  2012. end;
  2013. end;
  2014. procedure generate_specialization(var tt:tdef;enforce_unit:boolean;parse_class_parent:boolean;const _prettyname:string;parsedtype:tdef;const symname:string;parsedpos:tfileposinfo);
  2015. var
  2016. context : tspecializationcontext;
  2017. genericdef : tstoreddef;
  2018. begin
  2019. genericdef:=tstoreddef(generate_specialization_phase1(context,tt,enforce_unit,parsedtype,symname,nil,parsedpos));
  2020. if genericdef<>generrordef then
  2021. genericdef:=tstoreddef(generate_specialization_phase2(context,genericdef,parse_class_parent,_prettyname));
  2022. tt:=genericdef;
  2023. if assigned(context) then
  2024. context.free;
  2025. end;
  2026. function parse_generic_parameters(allowconstraints:boolean):tfphashobjectlist;
  2027. var
  2028. generictype : tstoredsym;
  2029. i,firstidx,const_list_index : longint;
  2030. srsymtable : tsymtable;
  2031. basedef,def : tdef;
  2032. defname : tidstring;
  2033. allowconst,
  2034. allowconstructor,
  2035. is_const,
  2036. doconsume : boolean;
  2037. constraintdata : tgenericconstraintdata;
  2038. old_block_type : tblock_type;
  2039. fileinfo : tfileposinfo;
  2040. begin
  2041. result:=tfphashobjectlist.create(false);
  2042. firstidx:=0;
  2043. const_list_index:=0;
  2044. old_block_type:=block_type;
  2045. block_type:=bt_type;
  2046. allowconst:=true;
  2047. is_const:=false;
  2048. repeat
  2049. if allowconst and try_to_consume(_CONST) then
  2050. begin
  2051. allowconst:=false;
  2052. is_const:=true;
  2053. const_list_index:=result.count;
  2054. end;
  2055. if token=_ID then
  2056. begin
  2057. if is_const then
  2058. generictype:=cconstsym.create_undefined(orgpattern,cundefinedtype)
  2059. else
  2060. generictype:=ctypesym.create(orgpattern,cundefinedtype);
  2061. { type parameters need to be added as strict private }
  2062. generictype.visibility:=vis_strictprivate;
  2063. include(generictype.symoptions,sp_generic_para);
  2064. result.add(orgpattern,generictype);
  2065. end;
  2066. consume(_ID);
  2067. fileinfo:=current_tokenpos;
  2068. { const restriction }
  2069. if is_const and try_to_consume(_COLON) then
  2070. begin
  2071. def:=nil;
  2072. { parse the type and assign the const type to generictype }
  2073. single_type(def,[]);
  2074. for i:=const_list_index to result.count-1 do
  2075. begin
  2076. { finalize constant information once type is known }
  2077. if assigned(def) and (def.typ in tgeneric_param_const_types) then
  2078. begin
  2079. case def.typ of
  2080. orddef,
  2081. enumdef:
  2082. tconstsym(result[i]).consttyp:=constord;
  2083. stringdef:
  2084. tconstsym(result[i]).consttyp:=conststring;
  2085. floatdef:
  2086. tconstsym(result[i]).consttyp:=constreal;
  2087. setdef:
  2088. tconstsym(result[i]).consttyp:=constset;
  2089. { pointer always refers to nil with constants }
  2090. pointerdef:
  2091. tconstsym(result[i]).consttyp:=constnil;
  2092. else
  2093. internalerror(2020011402);
  2094. end;
  2095. tconstsym(result[i]).constdef:=def;
  2096. end
  2097. else
  2098. Message1(type_e_generic_const_type_not_allowed,def.fulltypename);
  2099. end;
  2100. { after type restriction const list terminates }
  2101. is_const:=false;
  2102. end
  2103. { type restriction }
  2104. else if try_to_consume(_COLON) then
  2105. begin
  2106. if not allowconstraints then
  2107. Message(parser_e_generic_constraints_not_allowed_here);
  2108. { construct a name which can be used for a type specification }
  2109. constraintdata:=tgenericconstraintdata.create;
  2110. constraintdata.fileinfo:=fileinfo;
  2111. defname:='';
  2112. str(current_module.deflist.count,defname);
  2113. defname:='$gendef'+defname;
  2114. allowconstructor:=m_delphi in current_settings.modeswitches;
  2115. basedef:=generrordef;
  2116. repeat
  2117. doconsume:=true;
  2118. case token of
  2119. _CONSTRUCTOR:
  2120. begin
  2121. if not allowconstructor or (gcf_constructor in constraintdata.flags) then
  2122. Message(parser_e_illegal_expression);
  2123. include(constraintdata.flags,gcf_constructor);
  2124. allowconstructor:=false;
  2125. end;
  2126. _CLASS:
  2127. begin
  2128. if gcf_class in constraintdata.flags then
  2129. Message(parser_e_illegal_expression);
  2130. if basedef=generrordef then
  2131. include(constraintdata.flags,gcf_class)
  2132. else
  2133. Message(parser_e_illegal_expression);
  2134. end;
  2135. _RECORD:
  2136. begin
  2137. if ([gcf_constructor,gcf_class]*constraintdata.flags<>[])
  2138. or (constraintdata.interfaces.count>0) then
  2139. Message(parser_e_illegal_expression)
  2140. else
  2141. begin
  2142. srsymtable:=trecordsymtable.create(defname,0,1);
  2143. basedef:=crecorddef.create(defname,srsymtable);
  2144. include(constraintdata.flags,gcf_record);
  2145. allowconstructor:=false;
  2146. end;
  2147. end;
  2148. else
  2149. begin
  2150. { after single_type "token" is the trailing ",", ";" or
  2151. ">"! }
  2152. doconsume:=false;
  2153. { def is already set to a class or record }
  2154. if gcf_record in constraintdata.flags then
  2155. Message(parser_e_illegal_expression);
  2156. single_type(def, [stoAllowSpecialization]);
  2157. { only types that are inheritable are allowed }
  2158. if (def.typ<>objectdef) or
  2159. not (tobjectdef(def).objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_interfacejava,odt_javaclass]) then
  2160. Message1(type_e_class_or_interface_type_expected,def.typename)
  2161. else
  2162. case tobjectdef(def).objecttype of
  2163. odt_class,
  2164. odt_javaclass:
  2165. begin
  2166. if gcf_class in constraintdata.flags then
  2167. { "class" + concrete class is not allowed }
  2168. Message(parser_e_illegal_expression)
  2169. else
  2170. { do we already have a concrete class? }
  2171. if basedef<>generrordef then
  2172. Message(parser_e_illegal_expression)
  2173. else
  2174. basedef:=def;
  2175. end;
  2176. odt_interfacecom,
  2177. odt_interfacecorba,
  2178. odt_interfacejava,
  2179. odt_dispinterface:
  2180. constraintdata.interfaces.add(def);
  2181. else
  2182. ;
  2183. end;
  2184. end;
  2185. end;
  2186. if doconsume then
  2187. consume(token);
  2188. until not try_to_consume(_COMMA);
  2189. if ([gcf_class,gcf_constructor]*constraintdata.flags<>[]) or
  2190. (constraintdata.interfaces.count>1) or
  2191. (
  2192. (basedef.typ=objectdef) and
  2193. (tobjectdef(basedef).objecttype in [odt_javaclass,odt_class])
  2194. ) then
  2195. begin
  2196. if basedef.typ=errordef then
  2197. { don't pass an errordef as a parent to a tobjectdef }
  2198. basedef:=class_tobject
  2199. else
  2200. if (basedef.typ<>objectdef) or
  2201. not (tobjectdef(basedef).objecttype in [odt_javaclass,odt_class]) then
  2202. internalerror(2012101101);
  2203. basedef:=cobjectdef.create(tobjectdef(basedef).objecttype,defname,tobjectdef(basedef),false);
  2204. for i:=0 to constraintdata.interfaces.count-1 do
  2205. tobjectdef(basedef).register_implemented_interface(tobjectdef(constraintdata.interfaces[i]),false);
  2206. end
  2207. else
  2208. if constraintdata.interfaces.count=1 then
  2209. begin
  2210. if basedef.typ<>errordef then
  2211. internalerror(2013021601);
  2212. def:=tdef(constraintdata.interfaces[0]);
  2213. basedef:=cobjectdef.create(tobjectdef(def).objecttype,defname,tobjectdef(def),false);
  2214. constraintdata.interfaces.delete(0);
  2215. end;
  2216. if basedef.typ<>errordef then
  2217. with tstoreddef(basedef) do
  2218. begin
  2219. genconstraintdata:=tgenericconstraintdata.create;
  2220. genconstraintdata.flags:=constraintdata.flags;
  2221. genconstraintdata.interfaces.assign(constraintdata.interfaces);
  2222. genconstraintdata.fileinfo:=constraintdata.fileinfo;
  2223. include(defoptions,df_genconstraint);
  2224. end;
  2225. for i:=firstidx to result.count-1 do
  2226. ttypesym(result[i]).typedef:=basedef;
  2227. { we need a typesym in case we do a Delphi-mode inline
  2228. specialization with this parameter; so just use the first sym }
  2229. if not assigned(basedef.typesym) then
  2230. basedef.typesym:=ttypesym(result[firstidx]);
  2231. firstidx:=result.count;
  2232. constraintdata.free;
  2233. end
  2234. else
  2235. begin
  2236. if token=_SEMICOLON then
  2237. begin
  2238. { two different typeless parameters are considered as incompatible }
  2239. for i:=firstidx to result.count-1 do
  2240. if tsym(result[i]).typ<>constsym then
  2241. begin
  2242. ttypesym(result[i]).typedef:=cundefineddef.create(false);
  2243. ttypesym(result[i]).typedef.typesym:=ttypesym(result[i]);
  2244. end;
  2245. { a semicolon terminates a type parameter group }
  2246. firstidx:=result.count;
  2247. end;
  2248. end;
  2249. if token=_SEMICOLON then
  2250. begin
  2251. is_const:=false;
  2252. allowconst:=true;
  2253. end;
  2254. until not (try_to_consume(_COMMA) or try_to_consume(_SEMICOLON));
  2255. { if the constant parameter is not terminated then the type restriction was
  2256. not specified and we need to give an error }
  2257. if is_const then
  2258. consume(_COLON);
  2259. { two different typeless parameters are considered as incompatible }
  2260. for i:=firstidx to result.count-1 do
  2261. if tsym(result[i]).typ<>constsym then
  2262. begin
  2263. ttypesym(result[i]).typedef:=cundefineddef.create(false);
  2264. ttypesym(result[i]).typedef.typesym:=ttypesym(result[i]);
  2265. end;
  2266. block_type:=old_block_type;
  2267. end;
  2268. procedure insert_generic_parameter_types(def:tstoreddef;genericdef:tstoreddef;genericlist:tfphashobjectlist;isfwd:boolean);
  2269. var
  2270. i : longint;
  2271. generictype,
  2272. fwdparam : tstoredsym;
  2273. generictypedef : tdef;
  2274. sym : tsym;
  2275. st : tsymtable;
  2276. fwdok : boolean;
  2277. conv : tconverttype;
  2278. op : tprocdef;
  2279. begin
  2280. def.genericdef:=genericdef;
  2281. if not assigned(genericlist) then
  2282. exit;
  2283. if assigned(genericdef) then
  2284. include(def.defoptions,df_specialization)
  2285. else
  2286. if genericlist.count>0 then
  2287. include(def.defoptions,df_generic);
  2288. case def.typ of
  2289. recorddef,objectdef: st:=tabstractrecorddef(def).symtable;
  2290. arraydef: st:=tarraydef(def).symtable;
  2291. procvardef,procdef: st:=tabstractprocdef(def).parast;
  2292. else
  2293. internalerror(201101020);
  2294. end;
  2295. { if we have a forwarddef we check whether the generic parameters are
  2296. equal and otherwise ignore the list }
  2297. if isfwd then
  2298. begin
  2299. fwdok:=true;
  2300. if (genericlist.count>0) and
  2301. (
  2302. not assigned(def.genericparas)
  2303. or (def.genericparas.count<>genericlist.count)
  2304. ) then
  2305. fwdok:=false
  2306. else
  2307. begin
  2308. for i:=0 to genericlist.count-1 do
  2309. begin
  2310. if def.genericparas.nameofindex(i)<>genericlist.nameofindex(i) then
  2311. begin
  2312. fwdok:=false;
  2313. break;
  2314. end;
  2315. generictype:=tstoredsym(genericlist[i]);
  2316. fwdparam:=tstoredsym(def.genericparas[i]);
  2317. op:=nil;
  2318. conv:=tc_equal;
  2319. if generictype.typ<>fwdparam.typ then
  2320. fwdok:=false
  2321. else if (generictype.typ=typesym) then
  2322. begin
  2323. if compare_defs_ext(ttypesym(generictype).typedef,ttypesym(fwdparam).typedef,nothingn,conv,op,[cdo_strict_genconstraint_check])<te_exact then
  2324. fwdok:=false;
  2325. end
  2326. else if (generictype.typ=constsym) then
  2327. begin
  2328. if (tconstsym(generictype).consttyp<>tconstsym(fwdparam).consttyp) or
  2329. (compare_defs_ext(tconstsym(generictype).constdef,tconstsym(fwdparam).constdef,nothingn,conv,op,[cdo_strict_genconstraint_check])<te_exact) then
  2330. fwdok:=false;
  2331. end
  2332. else
  2333. internalerror(2020070101);
  2334. if not fwdok then
  2335. break;
  2336. end;
  2337. end;
  2338. if not fwdok then
  2339. Message(parser_e_forward_mismatch);
  2340. exit;
  2341. end;
  2342. if (genericlist.count>0) and not assigned(def.genericparas) then
  2343. def.genericparas:=tfphashobjectlist.create(false);
  2344. for i:=0 to genericlist.count-1 do
  2345. begin
  2346. generictype:=tstoredsym(genericlist[i]);
  2347. if assigned(generictype.owner) then
  2348. begin
  2349. if generictype.typ=typesym then
  2350. sym:=ctypesym.create(genericlist.nameofindex(i),ttypesym(generictype).typedef)
  2351. else if generictype.typ=constsym then
  2352. { generictype is a constsym that was created in create_generic_constsym
  2353. during phase 1 so we pass this directly without copying }
  2354. begin
  2355. sym:=generictype;
  2356. { the sym name is still undefined so we set it to match
  2357. the generic param name so it's accessible }
  2358. sym.realname:=genericlist.nameofindex(i);
  2359. include(sym.symoptions,sp_generic_const);
  2360. end
  2361. else
  2362. internalerror(2019021602);
  2363. { type parameters need to be added as strict private }
  2364. sym.visibility:=vis_strictprivate;
  2365. st.insertsym(sym);
  2366. include(sym.symoptions,sp_generic_para);
  2367. end
  2368. else
  2369. begin
  2370. if generictype.typ=typesym then
  2371. begin
  2372. generictypedef:=ttypesym(generictype).typedef;
  2373. if (generictypedef.typ=undefineddef) and (generictypedef<>cundefinedtype) then
  2374. begin
  2375. { the generic parameters were parsed before the genericdef existed thus the
  2376. undefineddefs were added as part of the parent symtable }
  2377. if assigned(generictypedef.owner) then
  2378. generictypedef.owner.DefList.Extract(generictypedef);
  2379. generictypedef.changeowner(st);
  2380. end;
  2381. end;
  2382. st.insertsym(generictype);
  2383. include(generictype.symoptions,sp_generic_para);
  2384. end;
  2385. def.genericparas.add(genericlist.nameofindex(i),generictype);
  2386. end;
  2387. end;
  2388. procedure maybe_insert_generic_rename_symbol(const name:tidstring;genericlist:tfphashobjectlist);
  2389. var
  2390. gensym : ttypesym;
  2391. begin
  2392. { for generics in non-Delphi modes we insert a private type symbol
  2393. that has the same base name as the currently parsed generic and
  2394. that references this defs }
  2395. if not (m_delphi in current_settings.modeswitches) and
  2396. (
  2397. (
  2398. parse_generic and
  2399. assigned(genericlist) and
  2400. (genericlist.count>0)
  2401. ) or
  2402. (
  2403. assigned(current_specializedef) and
  2404. assigned(current_structdef.genericdef) and
  2405. (current_structdef.genericdef.typ in [objectdef,recorddef]) and
  2406. (pos('$',name)>0)
  2407. )
  2408. ) then
  2409. begin
  2410. { we need to pass nil as def here, because the constructor wants
  2411. to set the typesym of the def which is not what we want }
  2412. gensym:=ctypesym.create(copy(name,1,pos('$',name)-1),nil);
  2413. gensym.typedef:=current_structdef;
  2414. include(gensym.symoptions,sp_internal);
  2415. { the symbol should be only visible to the generic class
  2416. itself }
  2417. gensym.visibility:=vis_strictprivate;
  2418. symtablestack.top.insertsym(gensym);
  2419. end;
  2420. end;
  2421. function generate_generic_name(const name:tidstring;const specializename:ansistring;const owner_hierarchy:ansistring):tidstring;
  2422. var
  2423. crc : cardinal;
  2424. begin
  2425. if specializename='' then
  2426. internalerror(2012061901);
  2427. { build the new type's name }
  2428. crc:=UpdateCrc32(0,specializename[1],length(specializename));
  2429. result:=name+'$crc'+hexstr(crc,8);
  2430. if owner_hierarchy<>'' then
  2431. begin
  2432. crc:=UpdateCrc32(0,owner_hierarchy[1],length(owner_hierarchy));
  2433. result:=result+'_crc'+hexstr(crc,8);
  2434. end;
  2435. end;
  2436. procedure split_generic_name(const name:tidstring;out nongeneric:string;out count:longint);
  2437. var
  2438. i,code : longint;
  2439. countstr : string;
  2440. begin
  2441. for i:=length(name) downto 1 do
  2442. if name[i]='$' then
  2443. begin
  2444. nongeneric:=copy(name,1,i-1);
  2445. countstr:=copy(name,i+1,length(name)-i);
  2446. val(countstr,count,code);
  2447. if code<>0 then
  2448. break;
  2449. exit;
  2450. end;
  2451. nongeneric:=name;
  2452. count:=0;
  2453. end;
  2454. procedure add_generic_dummysym(sym:tsym);
  2455. var
  2456. list: TFPObjectList;
  2457. srsym : tsym;
  2458. srsymtable : tsymtable;
  2459. entry : tgenericdummyentry;
  2460. begin
  2461. if sp_generic_dummy in sym.symoptions then
  2462. begin
  2463. { did we already search for a generic with that name? }
  2464. list:=tfpobjectlist(current_module.genericdummysyms.find(sym.name));
  2465. if not assigned(list) then
  2466. begin
  2467. list:=tfpobjectlist.create(true);
  2468. current_module.genericdummysyms.add(sym.name,list);
  2469. end;
  2470. { is the dummy sym still "dummy"? }
  2471. if (sym.typ=typesym) and
  2472. (
  2473. { dummy sym defined in mode Delphi }
  2474. (ttypesym(sym).typedef.typ=undefineddef) or
  2475. { dummy sym defined in non-Delphi mode }
  2476. (tstoreddef(ttypesym(sym).typedef).is_generic)
  2477. ) then
  2478. begin
  2479. { do we have a non-generic type of the same name
  2480. available? }
  2481. if not searchsym_with_flags(sym.name,srsym,srsymtable,[ssf_no_addsymref]) then
  2482. srsym:=nil;
  2483. end
  2484. else if sym.typ=procsym then
  2485. srsym:=sym
  2486. else
  2487. { dummy symbol is already not so dummy anymore }
  2488. srsym:=nil;
  2489. if assigned(srsym) then
  2490. begin
  2491. entry:=tgenericdummyentry.create;
  2492. entry.resolvedsym:=srsym;
  2493. entry.dummysym:=sym;
  2494. list.add(entry);
  2495. end;
  2496. end;
  2497. end;
  2498. function resolve_generic_dummysym(const name:tidstring):tsym;
  2499. var
  2500. list : tfpobjectlist;
  2501. begin
  2502. list:=tfpobjectlist(current_module.genericdummysyms.find(name));
  2503. if assigned(list) and (list.count>0) then
  2504. result:=tgenericdummyentry(list.last).resolvedsym
  2505. else
  2506. result:=nil;
  2507. end;
  2508. function could_be_generic(const name:tidstring):boolean;
  2509. begin
  2510. result:=(name<>'') and
  2511. (current_module.genericdummysyms.findindexof(name)>=0);
  2512. end;
  2513. procedure specialization_init(genericdef:tdef;var state: tspecializationstate);
  2514. var
  2515. pu : tused_unit;
  2516. hmodule : tmodule;
  2517. unitsyms : TFPHashObjectList;
  2518. sym : tsym;
  2519. i : Integer;
  2520. n : string;
  2521. begin
  2522. if not assigned(genericdef) then
  2523. internalerror(200705151);
  2524. { Setup symtablestack at definition time
  2525. to get types right, however this is not perfect, we should probably record
  2526. the resolved symbols }
  2527. state.oldsymtablestack:=symtablestack;
  2528. state.oldextendeddefs:=current_module.extendeddefs;
  2529. state.oldgenericdummysyms:=current_module.genericdummysyms;
  2530. current_module.extendeddefs:=TFPHashObjectList.create(true);
  2531. current_module.genericdummysyms:=tfphashobjectlist.create(true);
  2532. symtablestack:=tdefawaresymtablestack.create;
  2533. if not assigned(genericdef.owner) then
  2534. hmodule:=current_module
  2535. else
  2536. hmodule:=find_module_from_symtable(genericdef.owner);
  2537. if hmodule=nil then
  2538. internalerror(200705152);
  2539. { collect all unit syms in the generic's unit as we need to establish
  2540. their unitsym.module link again so that unit identifiers can be used }
  2541. unitsyms:=tfphashobjectlist.create(false);
  2542. if (hmodule<>current_module) and assigned(hmodule.globalsymtable) then
  2543. for i:=0 to hmodule.globalsymtable.symlist.count-1 do
  2544. begin
  2545. sym:=tsym(hmodule.globalsymtable.symlist[i]);
  2546. if sym.typ=unitsym then
  2547. begin
  2548. n:=sym.realname;
  2549. if (Copy(n,1,7)='$hidden') then
  2550. Delete(n,1,7);
  2551. unitsyms.add(upper(n),sym);
  2552. end;
  2553. end;
  2554. { add all units if we are specializing inside the current unit (as the
  2555. generic could have been declared in the implementation part), but load
  2556. only interface units, if we are in a different unit as then the generic
  2557. needs to be in the interface section }
  2558. pu:=tused_unit(hmodule.used_units.first);
  2559. while assigned(pu) do
  2560. begin
  2561. if not assigned(pu.u.globalsymtable) then
  2562. { in certain circular, but valid unit constellations it can happen
  2563. that we specialize a generic in a different unit that was used
  2564. in the implementation section of the generic's unit and were the
  2565. interface is still being parsed and thus the localsymtable is in
  2566. reality the global symtable }
  2567. if pu.u.in_interface then
  2568. begin
  2569. {
  2570. MVC: The case where localsymtable is also nil can appear in complex cases and still produce valid code.
  2571. In order to allow people in this case to continue, SKIP_INTERNAL20231102 can be defined.
  2572. Default behaviour is to raise an internal error.
  2573. See also
  2574. https://gitlab.com/freepascal.org/fpc/source/-/issues/40502
  2575. }
  2576. {$IFDEF SKIP_INTERNAL20231102}
  2577. if (pu.u.localsymtable<>Nil) then
  2578. {$ELSE}
  2579. if (pu.u.localsymtable=Nil) then
  2580. internalerror(20231102);
  2581. {$ENDIF}
  2582. symtablestack.push(pu.u.localsymtable);
  2583. end
  2584. else
  2585. internalerror(200705153)
  2586. else
  2587. symtablestack.push(pu.u.globalsymtable);
  2588. sym:=tsym(unitsyms.find(pu.u.modulename^));
  2589. if assigned(sym) and not assigned(tunitsym(sym).module) then
  2590. tunitsym(sym).module:=pu.u;
  2591. pu:=tused_unit(pu.next);
  2592. end;
  2593. unitsyms.free;
  2594. if assigned(hmodule.globalsymtable) then
  2595. symtablestack.push(hmodule.globalsymtable);
  2596. { push the localsymtable if needed }
  2597. if ((hmodule<>current_module) or not current_module.in_interface)
  2598. and assigned(hmodule.localsymtable) then
  2599. symtablestack.push(hmodule.localsymtable);
  2600. end;
  2601. procedure specialization_done(var state: tspecializationstate);
  2602. begin
  2603. { Restore symtablestack }
  2604. current_module.extendeddefs.free;
  2605. current_module.extendeddefs:=state.oldextendeddefs;
  2606. current_module.genericdummysyms.free;
  2607. current_module.genericdummysyms:=state.oldgenericdummysyms;
  2608. symtablestack.free;
  2609. symtablestack:=state.oldsymtablestack;
  2610. { clear the state record to be on the safe side }
  2611. fillchar(state, sizeof(state), 0);
  2612. end;
  2613. {****************************************************************************
  2614. SPECIALIZATION BODY GENERATION
  2615. ****************************************************************************}
  2616. procedure process_procdef(def:tprocdef;hmodule:tmodule);
  2617. var
  2618. oldcurrent_filepos : tfileposinfo;
  2619. begin
  2620. if assigned(def.genericdef) and
  2621. (def.genericdef.typ=procdef) and
  2622. assigned(tprocdef(def.genericdef).generictokenbuf) then
  2623. begin
  2624. if not assigned(tprocdef(def.genericdef).generictokenbuf) then
  2625. internalerror(2015061902);
  2626. oldcurrent_filepos:=current_filepos;
  2627. current_filepos:=tprocdef(def.genericdef).fileinfo;
  2628. { use the index the module got from the current compilation process }
  2629. current_filepos.moduleindex:=hmodule.unit_index;
  2630. current_tokenpos:=current_filepos;
  2631. current_scanner.startreplaytokens(tprocdef(def.genericdef).generictokenbuf,hmodule.change_endian);
  2632. read_proc_body(def);
  2633. current_filepos:=oldcurrent_filepos;
  2634. end
  2635. { synthetic routines will be implemented afterwards }
  2636. else if def.synthetickind=tsk_none then
  2637. MessagePos1(def.fileinfo,sym_e_forward_not_resolved,def.fullprocname(false));
  2638. end;
  2639. function process_abstractrecorddef(def:tabstractrecorddef):boolean;
  2640. var
  2641. i : longint;
  2642. hp : tdef;
  2643. hmodule : tmodule;
  2644. begin
  2645. result:=true;
  2646. hmodule:=nil;
  2647. if assigned(def.genericdef) then
  2648. hmodule:=find_module_from_symtable(def.genericdef.owner)
  2649. else if not (df_internal in def.defoptions) then
  2650. internalerror(201202041);
  2651. for i:=0 to def.symtable.DefList.Count-1 do
  2652. begin
  2653. hp:=tdef(def.symtable.DefList[i]);
  2654. if hp.typ=procdef then
  2655. begin
  2656. { only generate the code if we need a body }
  2657. if assigned(tprocdef(hp).struct) and not tprocdef(hp).forwarddef then
  2658. continue;
  2659. { and the body is available already (which is implicitely the
  2660. case if the generic routine is part of another unit) }
  2661. if (
  2662. not assigned(hmodule) or
  2663. (hmodule=current_module) or
  2664. (hmodule.state=ms_compile)
  2665. ) and
  2666. { may not be assigned in case it's a synthetic procdef that
  2667. still needs to be generated }
  2668. (assigned(tprocdef(hp).genericdef) and
  2669. tprocdef(tprocdef(hp).genericdef).forwarddef)
  2670. { when the implementation of the module was not yet parsed, it will not yet have a generictokenbuf }
  2671. or not assigned(tprocdef(tprocdef(hp).genericdef).generictokenbuf) then
  2672. begin
  2673. result:=false;
  2674. continue;
  2675. end;
  2676. process_procdef(tprocdef(hp),hmodule);
  2677. end
  2678. else
  2679. if hp.typ in [objectdef,recorddef] then
  2680. { generate code for subtypes as well }
  2681. result:=process_abstractrecorddef(tabstractrecorddef(hp)) and result;
  2682. end;
  2683. end;
  2684. procedure generate_specialization_procs;
  2685. var
  2686. i : longint;
  2687. list,
  2688. readdlist : tfpobjectlist;
  2689. def : tstoreddef;
  2690. state : tspecializationstate;
  2691. hmodule : tmodule;
  2692. mstate : tmodulestate;
  2693. begin
  2694. { first copy all entries and then work with that list to ensure that
  2695. we don't get an infinite recursion }
  2696. list:=tfpobjectlist.create(false);
  2697. readdlist:=tfpobjectlist.create(false);
  2698. for i:=0 to current_module.pendingspecializations.Count-1 do
  2699. list.add(current_module.pendingspecializations.Items[i]);
  2700. current_module.pendingspecializations.clear;
  2701. for i:=0 to list.count-1 do
  2702. begin
  2703. def:=tstoreddef(list[i]);
  2704. if not tstoreddef(def).is_specialization then
  2705. continue;
  2706. case def.typ of
  2707. procdef:
  2708. begin
  2709. { the use of forwarddef should not backfire as the
  2710. specialization always belongs to the current module }
  2711. if not tprocdef(def).forwarddef then
  2712. continue;
  2713. if not assigned(def.genericdef) then
  2714. internalerror(2015061903);
  2715. hmodule:=find_module_from_symtable(def.genericdef.owner);
  2716. if hmodule=nil then
  2717. internalerror(2015061904);
  2718. { we need to check for a forward declaration only if the
  2719. generic was declared in the same unit (otherwise there
  2720. should be one) }
  2721. mstate:=hmodule.state;
  2722. if ((hmodule=current_module) or (hmodule.state<ms_compiling_waitfinish)) and tprocdef(def.genericdef).forwarddef then
  2723. begin
  2724. readdlist.add(def);
  2725. continue;
  2726. end;
  2727. specialization_init(tstoreddef(def).genericdef,state);
  2728. process_procdef(tprocdef(def),hmodule);
  2729. specialization_done(state);
  2730. end;
  2731. recorddef,
  2732. objectdef:
  2733. begin
  2734. specialization_init(tstoreddef(def).genericdef,state);
  2735. if not process_abstractrecorddef(tabstractrecorddef(def)) then
  2736. readdlist.add(def);
  2737. specialization_done(state);
  2738. end;
  2739. else
  2740. ;
  2741. end;
  2742. end;
  2743. { add those defs back to the pending list for which we don't yet have
  2744. all method bodies }
  2745. for i:=0 to readdlist.count-1 do
  2746. current_module.pendingspecializations.add(tstoreddef(readdlist[i]).typename,readdlist[i]);
  2747. readdlist.free;
  2748. list.free;
  2749. end;
  2750. procedure generate_specializations_for_forwarddef(def:tdef);
  2751. var
  2752. list : tfpobjectlist;
  2753. idx,
  2754. i : longint;
  2755. context : tspecializationcontext;
  2756. begin
  2757. if not tstoreddef(def).is_generic then
  2758. internalerror(2020070304);
  2759. idx:=current_module.forwardgenericdefs.findindexof(def.fulltypename);
  2760. if idx<0 then
  2761. exit;
  2762. list:=tfpobjectlist(current_module.forwardgenericdefs.items[idx]);
  2763. if not assigned(list) then
  2764. internalerror(2020070305);
  2765. for i:=0 to list.count-1 do begin
  2766. context:=tspecializationcontext(list[i]);
  2767. generate_specialization_phase2(context,tstoreddef(def),false,'');
  2768. end;
  2769. current_module.forwardgenericdefs.delete(idx);
  2770. end;
  2771. procedure maybe_add_pending_specialization(def:tdef;unnamed_syms: tfplist);
  2772. var
  2773. hmodule : tmodule;
  2774. st : tsymtable;
  2775. i : integer;
  2776. begin
  2777. if parse_generic then
  2778. exit;
  2779. { transfer ownership of any unnamed syms to be the specialization }
  2780. if unnamed_syms<>nil then
  2781. transfer_unnamed_symbols(tprocdef(def).parast,unnamed_syms);
  2782. st:=def.owner;
  2783. while st.symtabletype in [localsymtable] do
  2784. st:=st.defowner.owner;
  2785. hmodule:=find_module_from_symtable(st);
  2786. if tstoreddef(def).is_specialization and (hmodule=current_module) then
  2787. current_module.pendingspecializations.add(def.typename,def);
  2788. end;
  2789. function determine_generic_def(const name:tidstring):tstoreddef;
  2790. var
  2791. hashedid : THashedIDString;
  2792. pd : tprocdef;
  2793. sym : tsym;
  2794. begin
  2795. result:=nil;
  2796. { check whether this is a declaration of a type inside a
  2797. specialization }
  2798. if assigned(current_structdef) and
  2799. (df_specialization in current_structdef.defoptions) then
  2800. begin
  2801. if not assigned(current_structdef.genericdef) or
  2802. not (current_structdef.genericdef.typ in [recorddef,objectdef]) then
  2803. internalerror(2011052301);
  2804. hashedid.id:=name;
  2805. { we could be inside a method of the specialization
  2806. instead of its declaration, so check that first (as
  2807. local nested types aren't allowed we don't need to
  2808. walk the symtablestack to find the localsymtable) }
  2809. if symtablestack.top.symtabletype=localsymtable then
  2810. begin
  2811. { we are in a method }
  2812. if not assigned(symtablestack.top.defowner) or
  2813. (symtablestack.top.defowner.typ<>procdef) then
  2814. internalerror(2011120701);
  2815. pd:=tprocdef(symtablestack.top.defowner);
  2816. if not assigned(pd.genericdef) or (pd.genericdef.typ<>procdef) then
  2817. internalerror(2011120702);
  2818. sym:=tsym(tprocdef(pd.genericdef).localst.findwithhash(hashedid));
  2819. end
  2820. else
  2821. sym:=nil;
  2822. if not assigned(sym) or not (sym.typ=typesym) then
  2823. begin
  2824. { now search in the declaration of the generic }
  2825. sym:=tsym(tabstractrecorddef(current_structdef.genericdef).symtable.findwithhash(hashedid));
  2826. if not assigned(sym) or not (sym.typ=typesym) then
  2827. internalerror(2011052302);
  2828. end;
  2829. { use the corresponding type in the generic's symtable as
  2830. genericdef for the specialized type }
  2831. result:=tstoreddef(ttypesym(sym).typedef);
  2832. end;
  2833. end;
  2834. end.