symcreat.pas 14 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437
  1. {
  2. Copyright (c) 2011 by Jonas Maebe
  3. This unit provides helpers for creating new syms/defs based on string
  4. representations.
  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. {$i fpcdefs.inc}
  19. unit symcreat;
  20. interface
  21. uses
  22. finput,tokens,scanner,
  23. symconst,symdef,symbase;
  24. type
  25. tscannerstate = record
  26. old_scanner: tscannerfile;
  27. old_token: ttoken;
  28. old_c: char;
  29. valid: boolean;
  30. end;
  31. { save/restore the scanner state before/after injecting }
  32. procedure replace_scanner(const tempname: string; out sstate: tscannerstate);
  33. procedure restore_scanner(const sstate: tscannerstate);
  34. { parses a (class or regular) method/constructor/destructor declaration from
  35. str, as if it were declared in astruct's declaration body
  36. WARNING: save the scanner state before calling this routine, and restore
  37. when done. }
  38. function str_parse_method_dec(str: ansistring; potype: tproctypeoption; is_classdef: boolean; astruct: tabstractrecorddef; out pd: tprocdef): boolean;
  39. { parses a (class or regular) method/constructor/destructor implementation
  40. from str, as if it appeared in the current unit's implementation section
  41. WARNING: save the scanner state before calling this routine, and restore
  42. when done. }
  43. function str_parse_method_impl(str: ansistring; usefwpd: tprocdef; is_classdef: boolean):boolean;
  44. { in the JVM, constructors are not automatically inherited (so you can hide
  45. them). To emulate the Pascal behaviour, we have to automatically add
  46. all parent constructors to the current class as well.}
  47. procedure add_missing_parent_constructors_intf(obj: tobjectdef);
  48. { goes through all defs in st to add implementations for synthetic methods
  49. added earlier }
  50. procedure add_synthetic_method_implementations(st: tsymtable);
  51. procedure finish_copied_procdef(var pd: tprocdef; const realname: string; newparentst: tsymtable; newstruct: tabstractrecorddef);
  52. implementation
  53. uses
  54. cutils,globtype,globals,verbose,systems,comphook,
  55. symtype,symsym,symtable,defutil,
  56. pbase,pdecobj,pdecsub,psub,
  57. defcmp;
  58. procedure replace_scanner(const tempname: string; out sstate: tscannerstate);
  59. var
  60. old_block_type: tblock_type;
  61. begin
  62. { would require saving of idtoken, pattern etc }
  63. if (token=_ID) then
  64. internalerror(2011032201);
  65. sstate.old_scanner:=current_scanner;
  66. sstate.old_token:=token;
  67. sstate.old_c:=c;
  68. sstate.valid:=true;
  69. { creating a new scanner resets the block type, while we want to continue
  70. in the current one }
  71. old_block_type:=block_type;
  72. current_scanner:=tscannerfile.Create('_Macro_.'+tempname);
  73. block_type:=old_block_type;
  74. end;
  75. procedure restore_scanner(const sstate: tscannerstate);
  76. begin
  77. if sstate.valid then
  78. begin
  79. current_scanner.free;
  80. current_scanner:=sstate.old_scanner;
  81. token:=sstate.old_token;
  82. c:=sstate.old_c;
  83. end;
  84. end;
  85. function str_parse_method_dec(str: ansistring; potype: tproctypeoption; is_classdef: boolean; astruct: tabstractrecorddef; out pd: tprocdef): boolean;
  86. var
  87. oldparse_only: boolean;
  88. begin
  89. Message1(parser_d_internal_parser_string,str);
  90. oldparse_only:=parse_only;
  91. parse_only:=true;
  92. result:=false;
  93. { inject the string in the scanner }
  94. str:=str+'end;';
  95. current_scanner.substitutemacro('meth_head_macro',@str[1],length(str),current_scanner.line_no,current_scanner.inputfile.ref_index);
  96. current_scanner.readtoken(false);
  97. { and parse it... }
  98. case potype of
  99. potype_class_constructor:
  100. pd:=class_constructor_head(astruct);
  101. potype_class_destructor:
  102. pd:=class_destructor_head(astruct);
  103. potype_constructor:
  104. pd:=constructor_head;
  105. potype_destructor:
  106. pd:=destructor_head;
  107. else
  108. pd:=method_dec(astruct,is_classdef);
  109. end;
  110. if assigned(pd) then
  111. result:=true;
  112. parse_only:=oldparse_only;
  113. end;
  114. function str_parse_method_impl(str: ansistring; usefwpd: tprocdef; is_classdef: boolean):boolean;
  115. var
  116. oldparse_only: boolean;
  117. tmpstr: ansistring;
  118. begin
  119. if ((status.verbosity and v_debug)<>0) then
  120. begin
  121. if assigned(usefwpd) then
  122. Message1(parser_d_internal_parser_string,usefwpd.customprocname([pno_proctypeoption,pno_paranames,pno_noclassmarker,pno_noleadingdollar]))
  123. else
  124. begin
  125. if is_classdef then
  126. tmpstr:='class '
  127. else
  128. tmpstr:='';
  129. Message1(parser_d_internal_parser_string,tmpstr+str);
  130. end;
  131. end;
  132. oldparse_only:=parse_only;
  133. parse_only:=false;
  134. result:=false;
  135. { inject the string in the scanner }
  136. str:=str+'end;';
  137. current_scanner.substitutemacro('meth_impl_macro',@str[1],length(str),current_scanner.line_no,current_scanner.inputfile.ref_index);
  138. current_scanner.readtoken(false);
  139. { and parse it... }
  140. read_proc(is_classdef,usefwpd);
  141. parse_only:=oldparse_only;
  142. result:=true;
  143. end;
  144. procedure add_missing_parent_constructors_intf(obj: tobjectdef);
  145. var
  146. parent: tobjectdef;
  147. def: tdef;
  148. parentpd,
  149. childpd: tprocdef;
  150. i: longint;
  151. srsym: tsym;
  152. srsymtable: tsymtable;
  153. begin
  154. if (oo_is_external in obj.objectoptions) or
  155. not assigned(obj.childof) then
  156. exit;
  157. parent:=obj.childof;
  158. { find all constructor in the parent }
  159. for i:=0 to tobjectsymtable(parent.symtable).deflist.count-1 do
  160. begin
  161. def:=tdef(tobjectsymtable(parent.symtable).deflist[i]);
  162. if (def.typ<>procdef) or
  163. (tprocdef(def).proctypeoption<>potype_constructor) or
  164. not is_visible_for_object(tprocdef(def),obj) then
  165. continue;
  166. parentpd:=tprocdef(def);
  167. { do we have this constructor too? (don't use
  168. search_struct_member/searchsym_in_class, since those will
  169. search parents too) }
  170. if searchsym_in_record(obj,parentpd.procsym.name,srsym,srsymtable) then
  171. begin
  172. { there's a symbol with the same name, is it a constructor
  173. with the same parameters? }
  174. if srsym.typ=procsym then
  175. begin
  176. childpd:=tprocsym(srsym).find_procdef_bytype_and_para(
  177. potype_constructor,parentpd.paras,nil,
  178. [cpo_ignorehidden,cpo_ignoreuniv,cpo_openequalisexact]);
  179. if assigned(childpd) then
  180. continue;
  181. end;
  182. end;
  183. { if we get here, we did not find it in the current objectdef ->
  184. add }
  185. childpd:=tprocdef(parentpd.getcopy);
  186. finish_copied_procdef(childpd,parentpd.procsym.realname,obj.symtable,obj);
  187. exclude(childpd.procoptions,po_external);
  188. include(childpd.procoptions,po_overload);
  189. childpd.synthetickind:=tsk_anon_inherited;
  190. include(obj.objectoptions,oo_has_constructor);
  191. end;
  192. end;
  193. procedure implement_anon_inherited(pd: tprocdef);
  194. var
  195. str: ansistring;
  196. isclassmethod: boolean;
  197. begin
  198. isclassmethod:=
  199. (po_classmethod in pd.procoptions) and
  200. not(pd.proctypeoption in [potype_constructor,potype_destructor]);
  201. str:='begin inherited end;';
  202. str_parse_method_impl(str,pd,isclassmethod);
  203. end;
  204. procedure implement_jvm_clone(pd: tprocdef);
  205. var
  206. struct: tabstractrecorddef;
  207. str: ansistring;
  208. i: longint;
  209. sym: tsym;
  210. fsym: tfieldvarsym;
  211. begin
  212. if not(pd.struct.typ in [recorddef,objectdef]) then
  213. internalerror(2011032802);
  214. struct:=pd.struct;
  215. { anonymous record types must get an artificial name, so we can generate
  216. a typecast at the scanner level }
  217. if (struct.typ=recorddef) and
  218. not assigned(struct.typesym) then
  219. internalerror(2011032812);
  220. { the inherited clone will already copy all fields in a shallow way ->
  221. copy records/regular arrays in a regular way }
  222. str:='begin clone:=inherited;';
  223. for i:=0 to struct.symtable.symlist.count-1 do
  224. begin
  225. sym:=tsym(struct.symtable.symlist[i]);
  226. if (sym.typ=fieldvarsym) then
  227. begin
  228. fsym:=tfieldvarsym(sym);
  229. if (fsym.vardef.typ=recorddef) or
  230. ((fsym.vardef.typ=arraydef) and
  231. not is_dynamic_array(fsym.vardef)) or
  232. ((fsym.vardef.typ=setdef) and
  233. not is_smallset(fsym.vardef)) then
  234. str:=str+struct.typesym.realname+'(clone).'+fsym.realname+':='+fsym.realname+';';
  235. end;
  236. end;
  237. str:=str+'end;';
  238. str_parse_method_impl(str,pd,false);
  239. end;
  240. procedure implement_record_deepcopy(pd: tprocdef);
  241. var
  242. struct: tabstractrecorddef;
  243. str: ansistring;
  244. i: longint;
  245. sym: tsym;
  246. fsym: tfieldvarsym;
  247. begin
  248. if not(pd.struct.typ in [recorddef,objectdef]) then
  249. internalerror(2011032810);
  250. struct:=pd.struct;
  251. { anonymous record types must get an artificial name, so we can generate
  252. a typecast at the scanner level }
  253. if (struct.typ=recorddef) and
  254. not assigned(struct.typesym) then
  255. internalerror(2011032811);
  256. { copy all fields }
  257. str:='begin ';
  258. for i:=0 to struct.symtable.symlist.count-1 do
  259. begin
  260. sym:=tsym(struct.symtable.symlist[i]);
  261. if (sym.typ=fieldvarsym) then
  262. begin
  263. fsym:=tfieldvarsym(sym);
  264. str:=str+'result.'+fsym.realname+':='+fsym.realname+';';
  265. end;
  266. end;
  267. str:=str+'end;';
  268. str_parse_method_impl(str,pd,false);
  269. end;
  270. procedure implement_empty(pd: tprocdef);
  271. var
  272. str: ansistring;
  273. isclassmethod: boolean;
  274. begin
  275. isclassmethod:=
  276. (po_classmethod in pd.procoptions) and
  277. not(pd.proctypeoption in [potype_constructor,potype_destructor]);
  278. str:='begin end;';
  279. str_parse_method_impl(str,pd,isclassmethod);
  280. end;
  281. procedure add_synthetic_method_implementations_for_struct(struct: tabstractrecorddef);
  282. var
  283. i : longint;
  284. def : tdef;
  285. pd : tprocdef;
  286. begin
  287. for i:=0 to struct.symtable.deflist.count-1 do
  288. begin
  289. def:=tdef(struct.symtable.deflist[i]);
  290. if (def.typ<>procdef) then
  291. continue;
  292. pd:=tprocdef(def);
  293. case pd.synthetickind of
  294. tsk_none:
  295. ;
  296. tsk_anon_inherited:
  297. implement_anon_inherited(pd);
  298. tsk_jvm_clone:
  299. implement_jvm_clone(pd);
  300. tsk_record_deepcopy:
  301. implement_record_deepcopy(pd);
  302. tsk_empty,
  303. { special handling for this one is done in tnodeutils.wrap_proc_body }
  304. tsk_tcinit:
  305. implement_empty(pd);
  306. else
  307. internalerror(2011032801);
  308. end;
  309. end;
  310. end;
  311. procedure add_synthetic_method_implementations(st: tsymtable);
  312. var
  313. i: longint;
  314. def: tdef;
  315. sstate: tscannerstate;
  316. begin
  317. { only necessary for the JVM target currently }
  318. if not (target_info.system in [system_jvm_java32]) then
  319. exit;
  320. sstate.valid:=false;
  321. for i:=0 to st.deflist.count-1 do
  322. begin
  323. def:=tdef(st.deflist[i]);
  324. if (is_javaclass(def) and
  325. not(oo_is_external in tobjectdef(def).objectoptions)) or
  326. (def.typ=recorddef) then
  327. begin
  328. if not sstate.valid then
  329. replace_scanner('synthetic_impl',sstate);
  330. add_synthetic_method_implementations_for_struct(tabstractrecorddef(def));
  331. { also complete nested types }
  332. add_synthetic_method_implementations(tabstractrecorddef(def).symtable);
  333. end;
  334. end;
  335. restore_scanner(sstate);
  336. end;
  337. procedure finish_copied_procdef(var pd: tprocdef; const realname: string; newparentst: tsymtable; newstruct: tabstractrecorddef);
  338. var
  339. sym: tsym;
  340. parasym: tparavarsym;
  341. ps: tprocsym;
  342. hdef: tdef;
  343. stname: string;
  344. i: longint;
  345. begin
  346. { associate the procdef with a procsym in the owner }
  347. if not(pd.proctypeoption in [potype_class_constructor,potype_class_destructor]) then
  348. stname:=upper(realname)
  349. else
  350. stname:=lower(realname);
  351. sym:=tsym(newparentst.find(stname));
  352. if assigned(sym) then
  353. begin
  354. if sym.typ<>procsym then
  355. internalerror(2011040601);
  356. ps:=tprocsym(sym);
  357. end
  358. else
  359. begin
  360. ps:=tprocsym.create(realname);
  361. newparentst.insert(ps);
  362. end;
  363. pd.procsym:=ps;
  364. pd.struct:=newstruct;
  365. { in case of methods, replace the special parameter types with new ones }
  366. if assigned(newstruct) then
  367. begin
  368. symtablestack.push(pd.parast);
  369. for i:=0 to pd.paras.count-1 do
  370. begin
  371. parasym:=tparavarsym(pd.paras[i]);
  372. if vo_is_self in parasym.varoptions then
  373. begin
  374. if parasym.vardef.typ=classrefdef then
  375. parasym.vardef:=tclassrefdef.create(newstruct)
  376. else
  377. parasym.vardef:=newstruct;
  378. end
  379. end;
  380. { also fix returndef in case of a constructor }
  381. if pd.proctypeoption=potype_constructor then
  382. pd.returndef:=newstruct;
  383. symtablestack.pop(pd.parast);
  384. end;
  385. proc_add_definition(pd);
  386. end;
  387. end.