pgenutil.pas 122 KB

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