pgenutil.pas 122 KB

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