pgenutil.pas 128 KB

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