pgenutil.pas 126 KB

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