pgenutil.pas 127 KB

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