pgenutil.pas 122 KB

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