genphp.ml 62 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298
  1. (*
  2. * haXe/PHP Compiler
  3. * Copyright (c)2008 Franco Ponticelli
  4. * based on and including code by (c)2005-2008 Nicolas Cannasse
  5. *
  6. * This program is free software; you can redistribute it and/or modify
  7. * it under the terms of the GNU General Public License as published by
  8. * the Free Software Foundation; either version 2 of the License, or
  9. * (at your option) any later version.
  10. *
  11. * This program is distributed in the hope that it will be useful,
  12. * but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. * GNU General Public License for more details.
  15. *
  16. * You should have received a copy of the GNU General Public License
  17. * along with this program; if not, write to the Free Software
  18. * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
  19. *)
  20. open Ast
  21. open Type
  22. open Common
  23. type method_name = {
  24. mutable mpath : path;
  25. mutable mname : string;
  26. }
  27. type inline_method = {
  28. iname : string;
  29. iindex : int;
  30. iexpr : texpr;
  31. ihasthis : bool;
  32. iin_block : bool;
  33. iarguments : string list;
  34. ilocals : (string,string) PMap.t;
  35. iinv_locals : (string,string) PMap.t;
  36. }
  37. type context = {
  38. com : Common.context;
  39. ch : out_channel;
  40. buf : Buffer.t;
  41. path : path;
  42. stack : Codegen.stack_context;
  43. mutable nested_loops : int;
  44. mutable inline_index : int;
  45. mutable curclass : tclass;
  46. mutable curmethod : string;
  47. mutable tabs : string;
  48. mutable in_value : string option;
  49. mutable in_loop : bool;
  50. mutable in_block : bool;
  51. mutable in_instance_method : bool;
  52. mutable imports : (string,string list list) Hashtbl.t;
  53. mutable extern_required_paths : (string list * string) list;
  54. mutable extern_classes_with_init : path list;
  55. mutable locals : (string,string) PMap.t;
  56. mutable inv_locals : (string,string) PMap.t;
  57. mutable local_types : t list;
  58. mutable inits : texpr list;
  59. mutable constructor_block : bool;
  60. mutable all_dynamic_methods: method_name list;
  61. mutable dynamic_methods: tclass_field list;
  62. mutable is_call : bool;
  63. mutable cwd : string;
  64. mutable inline_methods : inline_method list;
  65. mutable lib_path : string;
  66. }
  67. let join_class_path path separator =
  68. let result = match fst path, snd path with
  69. | [], s -> s
  70. | el, s -> String.concat separator el ^ separator ^ s in
  71. if (String.contains result '+') then begin
  72. let idx = String.index result '+' in
  73. (String.sub result 0 idx) ^ (String.sub result (idx+1) ((String.length result) - idx -1 ) )
  74. end else
  75. result;;
  76. (* Get a string to represent a type.
  77. The "suffix" will be nothing or "_obj", depending if we want the name of the
  78. pointer class or the pointee (_obj class *)
  79. let rec class_string klass suffix params =
  80. (match klass.cl_path with
  81. (* Array class *)
  82. | ([],"Array") -> (snd klass.cl_path) ^ suffix ^ "<" ^ (String.concat ","
  83. (List.map type_string params) ) ^ " >"
  84. | _ when klass.cl_kind=KTypeParameter -> "Dynamic"
  85. | ([],"#Int") -> "/* # */int"
  86. | (["haxe";"io"],"Unsigned_char__") -> "unsigned char"
  87. | ([],"Class") -> "Class"
  88. | ([],"Null") -> (match params with
  89. | [t] ->
  90. (match follow t with
  91. | TInst ({ cl_path = [],"Int" },_)
  92. | TInst ({ cl_path = [],"Float" },_)
  93. | TEnum ({ e_path = [],"Bool" },_) -> "Dynamic"
  94. | _ -> "/*NULL*/" ^ (type_string t) )
  95. | _ -> assert false);
  96. (* Normal class *)
  97. | _ -> (join_class_path klass.cl_path "::") ^ suffix
  98. )
  99. and type_string_suff suffix haxe_type =
  100. (match haxe_type with
  101. | TMono r -> (match !r with None -> "Dynamic" | Some t -> type_string_suff suffix t)
  102. | TEnum ({ e_path = ([],"Void") },[]) -> "Void"
  103. | TEnum ({ e_path = ([],"Bool") },[]) -> "bool"
  104. | TInst ({ cl_path = ([],"Float") },[]) -> "double"
  105. | TInst ({ cl_path = ([],"Int") },[]) -> "int"
  106. | TEnum (enum,params) -> (join_class_path enum.e_path "::") ^ suffix
  107. | TInst (klass,params) -> (class_string klass suffix params)
  108. | TType (type_def,params) ->
  109. (match type_def.t_path with
  110. | [] , "Null" ->
  111. (match params with
  112. | [t] ->
  113. (match follow t with
  114. | TInst ({ cl_path = [],"Int" },_)
  115. | TInst ({ cl_path = [],"Float" },_)
  116. | TEnum ({ e_path = [],"Bool" },_) -> "Dynamic"
  117. | _ -> type_string_suff suffix t)
  118. | _ -> assert false);
  119. | [] , "Array" ->
  120. (match params with
  121. | [t] -> "Array<" ^ (type_string (follow t) ) ^ " >"
  122. | _ -> assert false)
  123. | _ -> type_string_suff suffix (apply_params type_def.t_types params type_def.t_type)
  124. )
  125. | TFun (args,haxe_type) -> "Dynamic"
  126. | TAnon anon -> "Dynamic"
  127. | TDynamic haxe_type -> "Dynamic"
  128. | TLazy func -> type_string_suff suffix ((!func)())
  129. )
  130. and type_string haxe_type =
  131. type_string_suff "" haxe_type;;
  132. let debug_expression expression type_too =
  133. "/* " ^ Type.s_expr_kind expression ^ (if (type_too) then " = " ^ (type_string (follow expression.etype)) else "") ^ " */";;
  134. let rec register_extern_required_path ctx path =
  135. if (List.exists(fun p -> p = path) ctx.extern_classes_with_init) && not (List.exists(fun p -> p = path) ctx.extern_required_paths) then
  136. ctx.extern_required_paths <- path :: ctx.extern_required_paths
  137. let s_expr_expr = Type.s_expr_kind
  138. let s_expr_name e =
  139. s_type (print_context()) (follow e.etype)
  140. let s_type_name t =
  141. s_type (print_context()) t
  142. let rec is_uncertain_type t =
  143. match follow t with
  144. | TInst (c, _) -> c.cl_interface
  145. | TMono _ -> true
  146. | TAnon a ->
  147. (match !(a.a_status) with
  148. | Statics _
  149. | EnumStatics _ -> false
  150. | _ -> true)
  151. | TDynamic _ -> true
  152. | _ -> false
  153. let is_uncertain_expr e =
  154. is_uncertain_type e.etype
  155. let rec is_anonym_type t =
  156. match follow t with
  157. | TAnon a ->
  158. (match !(a.a_status) with
  159. | Statics _
  160. | EnumStatics _ -> false
  161. | _ -> true)
  162. | TDynamic _ -> true
  163. | _ -> false
  164. let is_anonym_expr e = is_anonym_type e.etype
  165. let rec is_unknown_type t =
  166. match follow t with
  167. | TMono r ->
  168. (match !r with
  169. | None -> true
  170. | Some t -> is_unknown_type t)
  171. | _ -> false
  172. let is_unknown_expr e = is_unknown_type e.etype
  173. let rec is_string_type t =
  174. match follow t with
  175. | TInst ({cl_path = ([], "String")}, _) -> true
  176. | TAnon a ->
  177. (match !(a.a_status) with
  178. | Statics ({cl_path = ([], "String")}) -> true
  179. | _ -> false)
  180. | _ -> false
  181. let is_string_expr e = is_string_type e.etype
  182. let to_string ctx e =
  183. let v = alloc_var "__call__" t_dynamic in
  184. let f = mk (TLocal v) t_dynamic e.epos in
  185. mk (TCall (f, [ Codegen.string ctx.com "_hx_string_rec" e.epos; e; Codegen.string ctx.com "" e.epos])) ctx.com.basic.tstring e.epos
  186. let as_string_expr ctx e =
  187. match e.eexpr with
  188. | TConst (TNull) ->
  189. to_string ctx e
  190. | _ when not (is_string_expr e) ->
  191. to_string ctx e
  192. | _ -> e
  193. let spr ctx s = Buffer.add_string ctx.buf s
  194. let print ctx = Printf.kprintf (fun s -> Buffer.add_string ctx.buf s)
  195. (*--php-prefix - added by skial bainn*)
  196. let prefix_class com name =
  197. match com.php_prefix with
  198. | Some prefix_class (* when not (String.length name <= 2 || String.sub name 0 2 = "__") *) ->
  199. prefix_class ^ name
  200. | _ ->
  201. name
  202. let prefix_init_replace com code =
  203. let r = Str.regexp "php_Boot" in
  204. Str.global_replace r ("php_" ^ (prefix_class com "Boot")) code
  205. let s_path ctx path isextern p =
  206. if isextern then begin
  207. register_extern_required_path ctx path;
  208. snd path
  209. end else begin
  210. (match path with
  211. (*--php-prefix*)
  212. | ([],"List") -> (prefix_class ctx.com "HList")
  213. (*--php-prefix*)
  214. | ([],name) -> (prefix_class ctx.com name)
  215. | (pack,name) ->
  216. (try
  217. (match Hashtbl.find ctx.imports name with
  218. | [p] when p = pack ->
  219. ()
  220. | packs ->
  221. if not (List.mem pack packs) then Hashtbl.replace ctx.imports name (pack :: packs))
  222. with Not_found ->
  223. Hashtbl.add ctx.imports name [pack]);
  224. (*--php-prefix*)
  225. String.concat "_" pack ^ "_" ^ (prefix_class ctx.com name))
  226. end
  227. let s_path_haxe path =
  228. match fst path, snd path with
  229. | [], s -> s
  230. | el, s -> String.concat "." el ^ "." ^ s
  231. let s_ident n =
  232. let suf = "h" in
  233. (*
  234. haxe reserved words that match php ones: break, case, class, continue, default, do, else, extends, for, function, if, new, return, static, switch, var, while, interface, implements, public, private, try, catch, throw
  235. *)
  236. (* PHP only (for future use): cfunction, old_function *)
  237. match String.lowercase n with
  238. | "and" | "or" | "xor" | "__file__" | "exception" | "__line__" | "array"
  239. | "as" | "const" | "declare" | "die" | "echo"| "elseif" | "empty"
  240. | "enddeclare" | "endfor" | "endforeach" | "endif" | "endswitch"
  241. | "endwhile" | "eval" | "exit" | "foreach"| "global" | "include"
  242. | "include_once" | "isset" | "list" | "namespace" | "print" | "require" | "require_once"
  243. | "unset" | "use" | "__function__" | "__class__" | "__method__" | "final"
  244. | "php_user_filter" | "protected" | "abstract" | "__set" | "__get" | "__call"
  245. | "clone" | "instanceof" -> suf ^ n
  246. | _ -> n
  247. let s_ident_local n =
  248. let suf = "h" in
  249. match String.lowercase n with
  250. | "globals" | "_server" | "_get" | "_post" | "_cookie" | "_files"
  251. | "_env" | "_request" | "_session" -> suf ^ n
  252. | _ -> n
  253. let create_directory com ldir =
  254. let atm_path = ref (String.create 0) in
  255. atm_path := com.file;
  256. if not (Sys.file_exists com.file) then (Unix.mkdir com.file 0o755);
  257. (List.iter (fun p -> atm_path := !atm_path ^ "/" ^ p; if not (Sys.file_exists !atm_path) then (Unix.mkdir !atm_path 0o755);) ldir)
  258. let write_resource dir name data =
  259. let i = ref 0 in
  260. String.iter (fun c ->
  261. if c = '\\' || c = '/' || c = ':' || c = '*' || c = '?' || c = '"' || c = '<' || c = '>' || c = '|' then String.blit "_" 0 name !i 1;
  262. incr i
  263. ) name;
  264. let rdir = dir ^ "/res" in
  265. if not (Sys.file_exists dir) then Unix.mkdir dir 0o755;
  266. if not (Sys.file_exists rdir) then Unix.mkdir rdir 0o755;
  267. let ch = open_out_bin (rdir ^ "/" ^ name) in
  268. output_string ch data;
  269. close_out ch
  270. let stack_init com use_add =
  271. Codegen.stack_context_init com "GLOBALS['%s']" "GLOBALS['%e']" "»spos" "»tmp" use_add null_pos
  272. let init com cwd path def_type =
  273. let rec create acc = function
  274. | [] -> ()
  275. | d :: l ->
  276. let pdir = String.concat "/" (List.rev (d :: acc)) in
  277. if not (Sys.file_exists pdir) then Unix.mkdir pdir 0o755;
  278. create (d :: acc) l
  279. in
  280. let dir = if cwd <> "" then com.file :: (cwd :: fst path) else com.file :: fst path; in
  281. create [] dir;
  282. let filename path =
  283. prefix_class com (match path with
  284. | [], "List" -> "HList";
  285. | _, s -> s) in
  286. (*--php-prefix*)
  287. let ch = open_out_bin (String.concat "/" dir ^ "/" ^ (filename path) ^ (if def_type = 0 then ".class" else if def_type = 1 then ".enum" else if def_type = 2 then ".interface" else ".extern") ^ ".php") in
  288. let imports = Hashtbl.create 0 in
  289. Hashtbl.add imports (snd path) [fst path];
  290. {
  291. com = com;
  292. stack = stack_init com false;
  293. tabs = "";
  294. ch = ch;
  295. path = path;
  296. buf = Buffer.create (1 lsl 14);
  297. in_value = None;
  298. in_loop = false;
  299. in_instance_method = false;
  300. imports = imports;
  301. extern_required_paths = [];
  302. extern_classes_with_init = [];
  303. curclass = null_class;
  304. curmethod = "";
  305. locals = PMap.empty;
  306. inv_locals = PMap.empty;
  307. local_types = [];
  308. inits = [];
  309. constructor_block = false;
  310. dynamic_methods = [];
  311. all_dynamic_methods = [];
  312. is_call = false;
  313. cwd = cwd;
  314. inline_methods = [];
  315. nested_loops = 0;
  316. inline_index = 0;
  317. in_block = false;
  318. lib_path = match com.php_lib with None -> "lib" | Some s -> s;
  319. }
  320. let unsupported msg p = error ("This expression cannot be generated to PHP: " ^ msg) p
  321. let newline ctx =
  322. match Buffer.nth ctx.buf (Buffer.length ctx.buf - 1) with
  323. | '}' | '{' | ':' | ' ' -> print ctx "\n%s" ctx.tabs
  324. | _ -> print ctx ";\n%s" ctx.tabs
  325. let rec concat ctx s f = function
  326. | [] -> ()
  327. | [x] -> f x
  328. | x :: l ->
  329. f x;
  330. spr ctx s;
  331. concat ctx s f l
  332. let open_block ctx =
  333. let oldt = ctx.tabs in
  334. ctx.tabs <- "\t" ^ ctx.tabs;
  335. (fun() -> ctx.tabs <- oldt)
  336. let parent e =
  337. match e.eexpr with
  338. | TParenthesis _ -> e
  339. | _ -> mk (TParenthesis e) e.etype e.epos
  340. let inc_extern_path ctx path =
  341. let rec slashes n =
  342. if n = 0 then "" else ("../" ^ slashes (n-1))
  343. in
  344. let pre = if ctx.cwd = "" then ctx.lib_path ^ "/" else "" in
  345. match path with
  346. | ([],name) ->
  347. pre ^ (slashes (List.length (fst ctx.path))) ^ (prefix_class ctx.com name) ^ ".extern.php"
  348. | (pack,name) ->
  349. pre ^ (slashes (List.length (fst ctx.path))) ^ String.concat "/" pack ^ "/" ^ (prefix_class ctx.com name) ^ ".extern.php"
  350. let close ctx =
  351. output_string ctx.ch "<?php\n";
  352. List.iter (fun path ->
  353. if path <> ctx.path then output_string ctx.ch ("require_once dirname(__FILE__).'/" ^ (inc_extern_path ctx path) ^ "';\n");
  354. ) (List.rev ctx.extern_required_paths);
  355. output_string ctx.ch "\n";
  356. output_string ctx.ch (Buffer.contents ctx.buf);
  357. close_out ctx.ch
  358. let save_locals ctx =
  359. let old = ctx.locals in
  360. let old_inv = ctx.inv_locals in
  361. (fun() -> ctx.locals <- old; ctx.inv_locals <- old_inv)
  362. let define_local ctx l =
  363. let rec loop n =
  364. let name = (if n = 1 then s_ident_local l else s_ident_local (l ^ string_of_int n)) in
  365. if PMap.mem name ctx.inv_locals then
  366. loop (n+1)
  367. else begin
  368. ctx.locals <- PMap.add l name ctx.locals;
  369. ctx.inv_locals <- PMap.add name l ctx.inv_locals;
  370. name
  371. end
  372. in
  373. loop 1
  374. let this ctx =
  375. if ctx.in_value <> None then "$»this" else "$this"
  376. let escape_bin s =
  377. let b = Buffer.create 0 in
  378. for i = 0 to String.length s - 1 do
  379. match Char.code (String.unsafe_get s i) with
  380. | c when c = Char.code('\\') or c = Char.code('"') or c = Char.code('$') ->
  381. Buffer.add_string b "\\";
  382. Buffer.add_char b (Char.chr c)
  383. | c when c < 32 ->
  384. Buffer.add_string b (Printf.sprintf "\\x%.2X" c)
  385. | c ->
  386. Buffer.add_char b (Char.chr c)
  387. done;
  388. Buffer.contents b
  389. let gen_constant ctx p = function
  390. | TInt i -> print ctx "%ld" i
  391. | TFloat s -> spr ctx s
  392. | TString s ->
  393. print ctx "\"%s\"" (escape_bin s)
  394. | TBool b -> spr ctx (if b then "true" else "false")
  395. | TNull -> spr ctx "null"
  396. | TThis -> spr ctx (this ctx)
  397. | TSuper -> spr ctx "ERROR /* unexpected call to super in gen_constant */"
  398. let s_funarg ctx arg t p c =
  399. let byref = if (String.length arg > 7 && String.sub arg 0 7 = "byref__") then "&" else "" in
  400. print ctx "%s$%s" byref (s_ident_local arg)
  401. let is_in_dynamic_methods ctx e s =
  402. List.exists (fun dm ->
  403. (* TODO: I agree, this is a mess ... but after hours of trials and errors I gave up; maybe in a calmer day *)
  404. ((String.concat "." ((fst dm.mpath) @ ["#" ^ (snd dm.mpath)])) ^ "." ^ dm.mname) = (s_type_name e.etype ^ "." ^ s)
  405. ) ctx.all_dynamic_methods
  406. let is_dynamic_method f =
  407. (match f.cf_kind with
  408. | Var _ -> true
  409. | Method MethDynamic -> true
  410. | _ -> false)
  411. let fun_block ctx f p =
  412. let e = (match f.tf_expr with { eexpr = TBlock [{ eexpr = TBlock _ } as e] } -> e | e -> e) in
  413. let e = List.fold_left (fun e (v,c) ->
  414. match c with
  415. | None | Some TNull -> e
  416. | Some c -> Codegen.concat (Codegen.set_default ctx.com v c p) e
  417. ) e f.tf_args in
  418. if ctx.com.debug then begin
  419. Codegen.stack_block ctx.stack ctx.curclass ctx.curmethod e
  420. end else
  421. mk_block e
  422. let rec gen_array_args ctx lst =
  423. match lst with
  424. | [] -> ()
  425. | h :: t ->
  426. spr ctx "[";
  427. gen_value ctx h;
  428. spr ctx "]";
  429. gen_array_args ctx t
  430. and gen_call ctx e el =
  431. let rec genargs lst =
  432. (match lst with
  433. | [] -> ()
  434. | h :: [] ->
  435. spr ctx " = ";
  436. gen_value ctx h;
  437. | h :: t ->
  438. spr ctx "[";
  439. gen_value ctx h;
  440. spr ctx "]";
  441. genargs t)
  442. in
  443. match e.eexpr , el with
  444. | TConst TSuper , params ->
  445. (match ctx.curclass.cl_super with
  446. | None -> assert false
  447. | Some (c,_) ->
  448. spr ctx "parent::__construct(";
  449. concat ctx "," (gen_value ctx) params;
  450. spr ctx ")";
  451. );
  452. | TField ({ eexpr = TConst TSuper },name) , params ->
  453. (match ctx.curclass.cl_super with
  454. | None -> assert false
  455. | Some (c,_) ->
  456. print ctx "parent::%s(" (s_ident name);
  457. concat ctx "," (gen_value ctx) params;
  458. spr ctx ")";
  459. );
  460. | TLocal { v_name = "__set__" }, { eexpr = TConst (TString code) } :: el ->
  461. print ctx "$%s" code;
  462. genargs el;
  463. | TLocal { v_name = "__set__" }, e :: el ->
  464. gen_value ctx e;
  465. genargs el;
  466. | TLocal { v_name = "__setfield__" }, e :: (f :: el) ->
  467. gen_value ctx e;
  468. spr ctx "->{";
  469. gen_value ctx f;
  470. spr ctx "}";
  471. genargs el;
  472. | TLocal { v_name = "__field__" }, e :: ({ eexpr = TConst (TString code) } :: el) ->
  473. gen_value ctx e;
  474. spr ctx "->";
  475. spr ctx code;
  476. gen_array_args ctx el;
  477. | TLocal { v_name = "__field__" }, e :: (f :: el) ->
  478. gen_value ctx e;
  479. spr ctx "->";
  480. gen_value ctx f;
  481. gen_array_args ctx el;
  482. | TLocal { v_name = "__prefix__" }, [] ->
  483. (match ctx.com.php_prefix with
  484. | Some prefix ->
  485. print ctx "\"%s\"" prefix
  486. | None ->
  487. spr ctx "null")
  488. | TLocal { v_name = "__var__" }, { eexpr = TConst (TString code) } :: el ->
  489. print ctx "$%s" code;
  490. gen_array_args ctx el;
  491. | TLocal { v_name = "__var__" }, e :: el ->
  492. gen_value ctx e;
  493. gen_array_args ctx el;
  494. | TLocal { v_name = "__call__" }, { eexpr = TConst (TString code) } :: el ->
  495. spr ctx code;
  496. spr ctx "(";
  497. concat ctx ", " (gen_value ctx) el;
  498. spr ctx ")";
  499. | TLocal { v_name = "__php__" }, [{ eexpr = TConst (TString code) }] ->
  500. (*--php-prefix*)
  501. spr ctx (prefix_init_replace ctx.com code)
  502. | TLocal { v_name = "__instanceof__" }, [e1;{ eexpr = TConst (TString t) }] ->
  503. gen_value ctx e1;
  504. print ctx " instanceof %s" t;
  505. | TLocal { v_name = "__physeq__" }, [e1;e2] ->
  506. spr ctx "(";
  507. gen_value ctx e1;
  508. spr ctx " === ";
  509. gen_value ctx e2;
  510. spr ctx ")"
  511. | TLocal _, []
  512. | TFunction _, []
  513. | TCall _, []
  514. | TParenthesis _, []
  515. | TBlock _, [] ->
  516. ctx.is_call <- true;
  517. spr ctx "call_user_func(";
  518. gen_value ctx e;
  519. ctx.is_call <- false;
  520. spr ctx ")";
  521. | TLocal _, el
  522. | TFunction _, el
  523. | TCall _, el
  524. | TParenthesis _, el
  525. | TBlock _, el ->
  526. ctx.is_call <- true;
  527. spr ctx "call_user_func_array(";
  528. gen_value ctx e;
  529. ctx.is_call <- false;
  530. spr ctx ", array(";
  531. concat ctx ", " (gen_value ctx) el;
  532. spr ctx "))"
  533. (*
  534. | TCall (x,_), el when (match x.eexpr with | TLocal _ -> false | _ -> true) ->
  535. ctx.is_call <- true;
  536. spr ctx "call_user_func_array(";
  537. gen_value ctx e;
  538. ctx.is_call <- false;
  539. spr ctx ", array(";
  540. concat ctx ", " (gen_value ctx) el;
  541. spr ctx "))"
  542. *)
  543. | _ ->
  544. ctx.is_call <- true;
  545. gen_value ctx e;
  546. ctx.is_call <- false;
  547. spr ctx "(";
  548. concat ctx ", " (gen_value ctx) el;
  549. spr ctx ")";
  550. and could_be_string_var s =
  551. s = "length"
  552. and gen_uncertain_string_var ctx s e =
  553. match s with
  554. | "length" ->
  555. spr ctx "_hx_len(";
  556. gen_value ctx e;
  557. spr ctx ")"
  558. | _ ->
  559. gen_field_access ctx true e s;
  560. and gen_string_var ctx s e =
  561. match s with
  562. | "length" ->
  563. spr ctx "strlen(";
  564. gen_value ctx e;
  565. spr ctx ")"
  566. | _ ->
  567. unsupported "gen_string_var " e.epos;
  568. and gen_string_static_call ctx s e el =
  569. match s with
  570. | "fromCharCode" ->
  571. spr ctx "chr(";
  572. concat ctx ", " (gen_value ctx) el;
  573. spr ctx ")";
  574. | _ -> unsupported "gen_string_static_call " e.epos;
  575. and could_be_string_call s =
  576. s = "substr" || s = "charAt" || s = "charCodeAt" || s = "indexOf" ||
  577. s = "lastIndexOf" || s = "split" || s = "toLowerCase" || s = "toString" || s = "toUpperCase"
  578. and gen_string_call ctx s e el =
  579. match s with
  580. | "substr" ->
  581. spr ctx "_hx_substr(";
  582. gen_value ctx e;
  583. spr ctx ", ";
  584. concat ctx ", " (gen_value ctx) el;
  585. spr ctx ")"
  586. | "charAt" ->
  587. spr ctx "_hx_char_at(";
  588. gen_value ctx e;
  589. spr ctx ", ";
  590. concat ctx ", " (gen_value ctx) el;
  591. spr ctx ")"
  592. | "cca" ->
  593. spr ctx "ord(substr(";
  594. gen_value ctx e;
  595. spr ctx ",";
  596. concat ctx ", " (gen_value ctx) el;
  597. spr ctx ",1))"
  598. | "charCodeAt" ->
  599. spr ctx "_hx_char_code_at(";
  600. gen_value ctx e;
  601. spr ctx ", ";
  602. concat ctx ", " (gen_value ctx) el;
  603. spr ctx ")"
  604. | "indexOf" ->
  605. spr ctx "_hx_index_of(";
  606. gen_value ctx e;
  607. spr ctx ", ";
  608. concat ctx ", " (gen_value ctx) el;
  609. spr ctx ")"
  610. | "lastIndexOf" ->
  611. spr ctx "_hx_last_index_of(";
  612. gen_value ctx e;
  613. spr ctx ", ";
  614. concat ctx ", " (gen_value ctx) el;
  615. spr ctx ")"
  616. | "split" ->
  617. spr ctx "_hx_explode(";
  618. concat ctx ", " (gen_value ctx) el;
  619. spr ctx ", ";
  620. gen_value ctx e;
  621. spr ctx ")"
  622. | "toLowerCase" ->
  623. spr ctx "strtolower(";
  624. gen_value ctx e;
  625. spr ctx ")"
  626. | "toUpperCase" ->
  627. spr ctx "strtoupper(";
  628. gen_value ctx e;
  629. spr ctx ")"
  630. | "toString" ->
  631. gen_value ctx e;
  632. | _ ->
  633. unsupported "gen_string_call" e.epos;
  634. and gen_uncertain_string_call ctx s e el =
  635. spr ctx "_hx_string_call(";
  636. gen_value ctx e;
  637. print ctx ", \"%s\", array(" s;
  638. concat ctx ", " (gen_value ctx) el;
  639. spr ctx "))"
  640. and gen_field_op ctx e =
  641. match e.eexpr with
  642. | TField (f,s) ->
  643. (match follow e.etype with
  644. | TFun _ ->
  645. gen_field_access ctx true f s
  646. | _ ->
  647. gen_value_op ctx e)
  648. | _ ->
  649. gen_value_op ctx e
  650. and gen_value_op ctx e =
  651. match e.eexpr with
  652. | TBinop (op,_,_) when op = Ast.OpAnd || op = Ast.OpOr || op = Ast.OpXor ->
  653. gen_value ctx e;
  654. | _ ->
  655. gen_value ctx e
  656. and is_static t =
  657. match follow t with
  658. | TAnon a -> (match !(a.a_status) with
  659. | Statics c -> true
  660. | _ -> false)
  661. | _ -> false
  662. and gen_member_access ctx isvar e s =
  663. match follow e.etype with
  664. | TAnon a ->
  665. (match !(a.a_status) with
  666. | EnumStatics _
  667. | Statics _ -> print ctx "::%s%s" (if isvar then "$" else "") (s_ident s)
  668. | _ -> print ctx "->%s" (s_ident s))
  669. | _ -> print ctx "->%s" (s_ident s)
  670. and gen_field_access ctx isvar e s =
  671. match e.eexpr with
  672. | TTypeExpr t ->
  673. spr ctx (s_path ctx (t_path t) false e.epos);
  674. gen_member_access ctx isvar e s
  675. | TLocal _ ->
  676. gen_expr ctx e;
  677. print ctx "->%s" (s_ident s)
  678. | TArray (e1,e2) ->
  679. spr ctx "_hx_array_get(";
  680. gen_value ctx e1;
  681. spr ctx ", ";
  682. gen_value ctx e2;
  683. spr ctx ")";
  684. gen_member_access ctx isvar e s
  685. | TBlock _
  686. | TParenthesis _
  687. | TObjectDecl _
  688. | TArrayDecl _
  689. | TNew _ ->
  690. spr ctx "_hx_deref(";
  691. ctx.is_call <- false;
  692. gen_value ctx e;
  693. spr ctx ")";
  694. gen_member_access ctx isvar e s
  695. | TCast (ec, _) when (match ec.eexpr with | TNew _ | TArrayDecl _ -> true | _ -> false) ->
  696. spr ctx "_hx_deref(";
  697. ctx.is_call <- false;
  698. gen_value ctx e;
  699. spr ctx ")";
  700. gen_member_access ctx isvar e s
  701. | _ ->
  702. gen_expr ctx e;
  703. gen_member_access ctx isvar e s
  704. and gen_dynamic_function ctx isstatic name f params p =
  705. let old = ctx.in_value in
  706. let old_l = ctx.locals in
  707. let old_li = ctx.inv_locals in
  708. let old_t = ctx.local_types in
  709. ctx.in_value <- None;
  710. ctx.local_types <- List.map snd params @ ctx.local_types;
  711. let byref = if (String.length name > 9 && String.sub name 0 9 = "__byref__") then "&" else "" in
  712. print ctx "function %s%s(" byref name;
  713. concat ctx ", " (fun (v,c) ->
  714. let arg = define_local ctx v.v_name in
  715. s_funarg ctx arg v.v_type p c;
  716. ) f.tf_args;
  717. spr ctx ") {";
  718. if (List.length f.tf_args) > 0 then begin
  719. if isstatic then
  720. print ctx " return call_user_func_array(self::$%s, array(" name
  721. else
  722. print ctx " return call_user_func_array($this->%s, array(" name;
  723. concat ctx ", " (fun (v,_) ->
  724. spr ctx ("$" ^ v.v_name)
  725. ) f.tf_args;
  726. print ctx ")); }";
  727. end else if isstatic then
  728. print ctx " return call_user_func(self::$%s); }" name
  729. else
  730. print ctx " return call_user_func($this->%s); }" name;
  731. newline ctx;
  732. if isstatic then
  733. print ctx "public static $%s = null" name
  734. else
  735. print ctx "public $%s = null" name;
  736. ctx.in_value <- old;
  737. ctx.locals <- old_l;
  738. ctx.inv_locals <- old_li;
  739. ctx.local_types <- old_t
  740. and gen_function ctx name f params p =
  741. let old = ctx.in_value in
  742. let old_l = ctx.locals in
  743. let old_li = ctx.inv_locals in
  744. let old_t = ctx.local_types in
  745. ctx.in_value <- None;
  746. ctx.local_types <- List.map snd params @ ctx.local_types;
  747. let byref = if (String.length name > 9 && String.sub name 0 9 = "__byref__") then "&" else "" in
  748. print ctx "function %s%s(" byref name;
  749. concat ctx ", " (fun (v,o) ->
  750. let arg = define_local ctx v.v_name in
  751. s_funarg ctx arg v.v_type p o;
  752. ) f.tf_args;
  753. print ctx ") ";
  754. gen_expr ctx (fun_block ctx f p);
  755. ctx.in_value <- old;
  756. ctx.locals <- old_l;
  757. ctx.inv_locals <- old_li;
  758. ctx.local_types <- old_t
  759. and gen_inline_function ctx f hasthis p =
  760. ctx.nested_loops <- ctx.nested_loops - 1;
  761. let old = ctx.in_value in
  762. let old_l = ctx.locals in
  763. let old_li = ctx.inv_locals in
  764. let old_t = ctx.local_types in
  765. ctx.in_value <- Some "closure";
  766. let args a = List.map (fun (v,_) -> v.v_name) a in
  767. let arguments = ref [] in
  768. if hasthis then begin arguments := "this" :: !arguments end;
  769. PMap.iter (fun n _ -> arguments := !arguments @ [n]) old_li;
  770. spr ctx "array(new _hx_lambda(array(";
  771. let c = ref 0 in
  772. List.iter (fun a ->
  773. if !c > 0 then spr ctx ", ";
  774. incr c;
  775. print ctx "&$%s" a;
  776. ) (remove_internals !arguments);
  777. spr ctx "), \"";
  778. spr ctx (inline_function ctx (args f.tf_args) hasthis (fun_block ctx f p));
  779. print ctx "\"), 'execute')";
  780. ctx.in_value <- old;
  781. ctx.locals <- old_l;
  782. ctx.inv_locals <- old_li;
  783. ctx.local_types <- old_t;
  784. ctx.nested_loops <- ctx.nested_loops + 1;
  785. and unset_locals ctx old_l =
  786. let lst = ref [] in
  787. PMap.iter (fun n _ ->
  788. if not (PMap.exists n old_l) then
  789. lst := ["$" ^ n] @ !lst;
  790. ) ctx.inv_locals;
  791. if (List.length !lst) > 0 then begin
  792. newline ctx;
  793. spr ctx "unset(";
  794. concat ctx "," (fun (s) -> spr ctx s; ) !lst;
  795. spr ctx ")"
  796. end
  797. and gen_while_expr ctx e =
  798. let old_loop = ctx.in_loop in
  799. ctx.in_loop <- true;
  800. let old_nested_loops = ctx.nested_loops in
  801. ctx.nested_loops <- 1;
  802. let old_l = ctx.inv_locals in
  803. let b = save_locals ctx in
  804. (match e.eexpr with
  805. | TBlock (el) ->
  806. List.iter (fun e -> newline ctx; gen_expr ctx e) el;
  807. | _ ->
  808. newline ctx;
  809. gen_expr ctx e);
  810. unset_locals ctx old_l;
  811. b();
  812. ctx.nested_loops <- old_nested_loops;
  813. ctx.in_loop <- old_loop
  814. and gen_expr ctx e =
  815. let in_block = ctx.in_block in
  816. ctx.in_block <- false;
  817. let restore_in_block ctx inb =
  818. if inb then ctx.in_block <- true
  819. in
  820. match e.eexpr with
  821. | TConst c ->
  822. gen_constant ctx e.epos c
  823. | TLocal v ->
  824. spr ctx ("$" ^ (try PMap.find v.v_name ctx.locals with Not_found -> (s_ident_local v.v_name)))
  825. | TEnumField (en,s) ->
  826. (match (try PMap.find s en.e_constrs with Not_found -> error ("Unknown local " ^ s) e.epos).ef_type with
  827. | TFun (args,_) -> print ctx "%s::%s" (s_path ctx en.e_path en.e_extern e.epos) (s_ident s)
  828. | _ -> print ctx "%s::$%s" (s_path ctx en.e_path en.e_extern e.epos) (s_ident s))
  829. | TArray (e1,e2) ->
  830. (match e1.eexpr with
  831. | TCall _
  832. | TBlock _
  833. | TParenthesis _
  834. | TArrayDecl _ ->
  835. spr ctx "_hx_array_get(";
  836. gen_value ctx e1;
  837. spr ctx ", ";
  838. gen_value ctx e2;
  839. spr ctx ")";
  840. | TCast (ec, _) when (match ec.eexpr with | TArrayDecl _ | TBlock _ -> true | _ -> false) ->
  841. spr ctx "_hx_array_get(";
  842. gen_value ctx e1;
  843. spr ctx ", ";
  844. gen_value ctx e2;
  845. spr ctx ")";
  846. | _ ->
  847. gen_value ctx e1;
  848. spr ctx "[";
  849. gen_value ctx e2;
  850. spr ctx "]");
  851. | TBinop (op,e1,e2) ->
  852. (* these operators are non-assoc in php, let let's make sure to separate them with parenthesises *)
  853. let non_assoc = function
  854. | (Ast.OpEq | Ast.OpNotEq | Ast.OpGt | Ast.OpGte | Ast.OpLt | Ast.OpLte) -> true
  855. | _ -> false
  856. in
  857. (match e1.eexpr with
  858. | TBinop (op2,_,_) when non_assoc op && non_assoc op2 ->
  859. gen_expr ctx { e with eexpr = TBinop (op,mk (TParenthesis e1) e1.etype e1.epos,e2) }
  860. | _ ->
  861. let leftside e =
  862. (match e.eexpr with
  863. | TArray(te1, te2) ->
  864. gen_value ctx te1;
  865. spr ctx "->»a[";
  866. gen_value ctx te2;
  867. spr ctx "]";
  868. | _ ->
  869. gen_field_op ctx e1;) in
  870. let leftsidec e =
  871. (match e.eexpr with
  872. | TArray(te1, te2) ->
  873. gen_value ctx te1;
  874. spr ctx "->»a[";
  875. gen_value ctx te2;
  876. spr ctx "]";
  877. | TField (e1,s) ->
  878. gen_field_access ctx true e1 s
  879. | _ ->
  880. gen_field_op ctx e1;) in
  881. let leftsidef e =
  882. (match e.eexpr with
  883. | TField (e1,s) ->
  884. gen_field_access ctx true e1 s;
  885. | _ ->
  886. gen_field_op ctx e1;
  887. ) in
  888. (match op with
  889. | Ast.OpAssign ->
  890. (match e1.eexpr with
  891. | TArray(te1, te2) when (match te1.eexpr with | TCall _ | TParenthesis _ -> true | _ -> false) ->
  892. spr ctx "_hx_array_assign(";
  893. gen_value ctx te1;
  894. spr ctx ", ";
  895. gen_value ctx te2;
  896. spr ctx ", ";
  897. gen_value_op ctx e2;
  898. spr ctx ")";
  899. | _ ->
  900. leftsidef e1;
  901. spr ctx " = ";
  902. gen_value_op ctx e2;
  903. )
  904. | Ast.OpAssignOp(Ast.OpAdd) when (is_uncertain_expr e1 && is_uncertain_expr e2) ->
  905. leftside e1;
  906. spr ctx " = ";
  907. spr ctx "_hx_add(";
  908. gen_value_op ctx e1;
  909. spr ctx ", ";
  910. gen_value_op ctx e2;
  911. spr ctx ")";
  912. | Ast.OpAssignOp(Ast.OpAdd) when (is_string_expr e1 || is_string_expr e2) ->
  913. leftside e1;
  914. spr ctx " .= ";
  915. gen_value_op ctx (as_string_expr ctx e2);
  916. | Ast.OpAssignOp(Ast.OpShl) ->
  917. leftside e1;
  918. spr ctx " <<= ";
  919. gen_value_op ctx e2;
  920. | Ast.OpAssignOp(Ast.OpUShr) ->
  921. leftside e1;
  922. spr ctx " = ";
  923. spr ctx "_hx_shift_right(";
  924. gen_value_op ctx e1;
  925. spr ctx ", ";
  926. gen_value_op ctx e2;
  927. spr ctx ")";
  928. | Ast.OpAssignOp(_) ->
  929. leftsidec e1;
  930. print ctx " %s " (Ast.s_binop op);
  931. gen_value_op ctx e2;
  932. | Ast.OpAdd when (is_uncertain_expr e1 && is_uncertain_expr e2) ->
  933. spr ctx "_hx_add(";
  934. gen_value_op ctx e1;
  935. spr ctx ", ";
  936. gen_value_op ctx e2;
  937. spr ctx ")";
  938. | Ast.OpAdd when (is_string_expr e1 || is_string_expr e2) ->
  939. gen_value_op ctx (as_string_expr ctx e1);
  940. spr ctx " . ";
  941. gen_value_op ctx (as_string_expr ctx e2);
  942. | Ast.OpShl ->
  943. gen_value_op ctx e1;
  944. spr ctx " << ";
  945. gen_value_op ctx e2;
  946. | Ast.OpUShr ->
  947. spr ctx "_hx_shift_right(";
  948. gen_value_op ctx e1;
  949. spr ctx ", ";
  950. gen_value_op ctx e2;
  951. spr ctx ")";
  952. | Ast.OpNotEq
  953. | Ast.OpEq ->
  954. let s_op = if op = Ast.OpNotEq then " != " else " == " in
  955. let s_phop = if op = Ast.OpNotEq then " !== " else " === " in
  956. let se1 = s_expr_name e1 in
  957. let se2 = s_expr_name e2 in
  958. if
  959. e1.eexpr = TConst (TNull)
  960. || e2.eexpr = TConst (TNull)
  961. then begin
  962. (match e1.eexpr with
  963. | TField (f, s) when is_anonym_expr e1 || is_unknown_expr e1 ->
  964. spr ctx "_hx_field(";
  965. gen_value ctx f;
  966. print ctx ", \"%s\")" s;
  967. | _ ->
  968. gen_field_op ctx e1;
  969. );
  970. spr ctx s_phop;
  971. (match e2.eexpr with
  972. | TField (f, s) when is_anonym_expr e2 || is_unknown_expr e2 ->
  973. spr ctx "_hx_field(";
  974. gen_value ctx f;
  975. print ctx ", \"%s\")" s;
  976. | _ ->
  977. gen_field_op ctx e2);
  978. end else if
  979. ((se1 = "Int" || se1 = "Null<Int>") && (se2 = "Int" || se2 = "Null<Int>"))
  980. || ((se1 = "Float" || se1 = "Null<Float>") && (se2 = "Float" || se2 = "Null<Float>"))
  981. then begin
  982. gen_field_op ctx e1;
  983. spr ctx s_phop;
  984. gen_field_op ctx e2;
  985. end else if
  986. ((se1 = "Int" || se1 = "Float" || se1 = "Null<Int>" || se1 = "Null<Float>")
  987. && (se1 = "Int" || se1 = "Float" || se1 = "Null<Int>" || se1 = "Null<Float>"))
  988. || (is_unknown_expr e1 && is_unknown_expr e2)
  989. || is_anonym_expr e1
  990. || is_anonym_expr e2
  991. then begin
  992. if op = Ast.OpNotEq then spr ctx "!";
  993. spr ctx "_hx_equal(";
  994. gen_field_op ctx e1;
  995. spr ctx ", ";
  996. gen_field_op ctx e2;
  997. spr ctx ")";
  998. end else if
  999. (
  1000. se1 == se2
  1001. || (match e1.eexpr with | TConst _ | TLocal _ | TArray _ | TNew _ -> true | _ -> false)
  1002. || (match e2.eexpr with | TConst _ | TLocal _ | TArray _ | TNew _ -> true | _ -> false)
  1003. || is_string_expr e1
  1004. || is_string_expr e2
  1005. || is_anonym_expr e1
  1006. || is_anonym_expr e2
  1007. || is_unknown_expr e1
  1008. || is_unknown_expr e2
  1009. )
  1010. && (type_string (follow e1.etype)) <> "Dynamic"
  1011. && (type_string (follow e2.etype)) <> "Dynamic"
  1012. then begin
  1013. gen_field_op ctx e1;
  1014. spr ctx s_phop;
  1015. gen_field_op ctx e2;
  1016. end else begin
  1017. gen_field_op ctx e1;
  1018. spr ctx s_op;
  1019. gen_field_op ctx e2;
  1020. end
  1021. | _ ->
  1022. leftside e1;
  1023. print ctx " %s " (Ast.s_binop op);
  1024. gen_value_op ctx e2;
  1025. ));
  1026. | TField (e1,s)
  1027. | TClosure (e1,s) ->
  1028. (match follow e.etype with
  1029. | TFun (args, _) ->
  1030. (if ctx.is_call then begin
  1031. gen_field_access ctx false e1 s
  1032. end else if is_in_dynamic_methods ctx e1 s then begin
  1033. gen_field_access ctx true e1 s;
  1034. end else begin
  1035. let ob ex =
  1036. (match ex with
  1037. | TTypeExpr t ->
  1038. print ctx "\"";
  1039. spr ctx (s_path ctx (t_path t) false e1.epos);
  1040. print ctx "\""
  1041. | _ ->
  1042. gen_expr ctx e1) in
  1043. spr ctx "(isset(";
  1044. gen_field_access ctx true e1 s;
  1045. spr ctx ") ? ";
  1046. gen_field_access ctx true e1 s;
  1047. spr ctx ": array(";
  1048. ob e1.eexpr;
  1049. print ctx ", \"%s\"))" (s_ident s);
  1050. end)
  1051. | TMono _ ->
  1052. if ctx.is_call then
  1053. gen_field_access ctx false e1 s
  1054. else
  1055. gen_uncertain_string_var ctx s e1
  1056. | _ ->
  1057. if is_string_expr e1 then
  1058. gen_string_var ctx s e1
  1059. else if is_uncertain_expr e1 then
  1060. gen_uncertain_string_var ctx s e1
  1061. else
  1062. gen_field_access ctx true e1 s
  1063. )
  1064. | TTypeExpr t ->
  1065. print ctx "_hx_qtype(\"%s\")" (s_path_haxe (t_path t))
  1066. | TParenthesis e ->
  1067. (match e.eexpr with
  1068. | TParenthesis _
  1069. | TReturn _ ->
  1070. gen_value ctx e;
  1071. | _ ->
  1072. spr ctx "(";
  1073. gen_value ctx e;
  1074. spr ctx ")"
  1075. );
  1076. | TReturn eo ->
  1077. (match eo with
  1078. | None ->
  1079. spr ctx "return"
  1080. | Some e when (match follow e.etype with TEnum({ e_path = [],"Void" },[]) -> true | _ -> false) ->
  1081. gen_value ctx e;
  1082. newline ctx;
  1083. spr ctx "return"
  1084. | Some e ->
  1085. (match e.eexpr with
  1086. | TThrow _ -> ()
  1087. | _ -> spr ctx "return ");
  1088. gen_value ctx e;
  1089. );
  1090. | TBreak ->
  1091. if ctx.in_loop then spr ctx "break" else print ctx "break %d" ctx.nested_loops
  1092. | TContinue ->
  1093. if ctx.in_loop then spr ctx "continue" else print ctx "continue %d" ctx.nested_loops
  1094. | TBlock [] ->
  1095. spr ctx ""
  1096. | TBlock el ->
  1097. let old_l = ctx.inv_locals in
  1098. let b = save_locals ctx in
  1099. print ctx "{";
  1100. let bend = open_block ctx in
  1101. let cb = (
  1102. if not ctx.constructor_block then
  1103. (fun () -> ())
  1104. else begin
  1105. ctx.constructor_block <- false;
  1106. if List.length ctx.dynamic_methods > 0 then newline ctx else spr ctx " ";
  1107. List.iter (fun (f) ->
  1108. let name = f.cf_name in
  1109. match f.cf_expr with
  1110. | Some { eexpr = TFunction fd } ->
  1111. print ctx "if(!isset($this->%s)) $this->%s = " name name;
  1112. gen_inline_function ctx fd true e.epos;
  1113. newline ctx;
  1114. | _ -> ()
  1115. ) ctx.dynamic_methods;
  1116. if Codegen.constructor_side_effects e then begin
  1117. print ctx "if(!%s::$skip_constructor) {" (s_path ctx (["php"],"Boot") false e.epos);
  1118. (fun() -> print ctx "}")
  1119. end else
  1120. (fun() -> ());
  1121. end) in
  1122. let remaining = ref (List.length el) in
  1123. let build e =
  1124. (match e.eexpr with
  1125. | TBlock [] -> ()
  1126. | _ -> newline ctx);
  1127. if (in_block && !remaining = 1) then begin
  1128. (match e.eexpr with
  1129. | TIf _
  1130. | TSwitch _
  1131. | TThrow _
  1132. | TWhile _
  1133. | TFor _
  1134. | TMatch _
  1135. | TTry _
  1136. | TBreak
  1137. | TBlock _ ->
  1138. restore_in_block ctx in_block;
  1139. gen_expr ctx e;
  1140. unset_locals ctx old_l;
  1141. | TReturn (Some e1) ->
  1142. (match e1.eexpr with
  1143. | TIf _
  1144. | TSwitch _
  1145. | TThrow _
  1146. | TWhile _
  1147. | TFor _
  1148. | TMatch _
  1149. | TTry _
  1150. | TBlock _ -> ()
  1151. | _ ->
  1152. spr ctx "return "
  1153. );
  1154. gen_expr ctx e1;
  1155. | _ ->
  1156. spr ctx "return ";
  1157. gen_value ctx e;
  1158. )
  1159. end else begin
  1160. gen_expr ctx e;
  1161. end;
  1162. decr remaining;
  1163. in
  1164. List.iter build el;
  1165. if ctx.in_loop then begin
  1166. unset_locals ctx old_l;
  1167. end;
  1168. bend();
  1169. newline ctx;
  1170. cb();
  1171. print ctx "}";
  1172. b();
  1173. | TFunction f ->
  1174. let old = ctx.in_value, ctx.in_loop in
  1175. let old_meth = ctx.curmethod in
  1176. ctx.in_value <- None;
  1177. ctx.in_loop <- false;
  1178. ctx.curmethod <- ctx.curmethod ^ "@" ^ string_of_int (Lexer.get_error_line e.epos);
  1179. gen_inline_function ctx f false e.epos;
  1180. ctx.curmethod <- old_meth;
  1181. ctx.in_value <- fst old;
  1182. ctx.in_loop <- snd old;
  1183. | TCall (ec,el) ->
  1184. (match ec.eexpr with
  1185. | TArray _ ->
  1186. spr ctx "call_user_func_array(";
  1187. gen_value ctx ec;
  1188. spr ctx ", array(";
  1189. concat ctx ", " (gen_value ctx) el;
  1190. spr ctx "))";
  1191. | TField (ef,s) when is_static ef.etype && is_string_expr ef ->
  1192. gen_string_static_call ctx s ef el
  1193. | TField (ef,s) when is_string_expr ef ->
  1194. gen_string_call ctx s ef el
  1195. | TField (ef,s) when is_anonym_expr ef && could_be_string_call s ->
  1196. gen_uncertain_string_call ctx s ef el
  1197. | _ ->
  1198. gen_call ctx ec el);
  1199. | TArrayDecl el ->
  1200. spr ctx "new _hx_array(array(";
  1201. concat ctx ", " (gen_value ctx) el;
  1202. spr ctx "))";
  1203. | TThrow e ->
  1204. spr ctx "throw new HException(";
  1205. gen_value ctx e;
  1206. spr ctx ")";
  1207. | TVars [] ->
  1208. ()
  1209. | TVars vl ->
  1210. spr ctx "$";
  1211. concat ctx ("; $") (fun (v,e) ->
  1212. let restore = save_locals ctx in
  1213. let n = define_local ctx v.v_name in
  1214. let restore2 = save_locals ctx in
  1215. restore();
  1216. (match e with
  1217. | None ->
  1218. print ctx "%s = null" (s_ident_local n)
  1219. | Some e ->
  1220. print ctx "%s = " (s_ident_local n);
  1221. gen_value ctx e);
  1222. restore2()
  1223. ) vl;
  1224. | TNew (c,_,el) ->
  1225. (match c.cl_path, el with
  1226. | ([], "String"), _ ->
  1227. concat ctx "" (gen_value ctx) el
  1228. | ([], "Array"), el ->
  1229. spr ctx "new _hx_array(array(";
  1230. concat ctx ", " (gen_value ctx) el;
  1231. spr ctx "))"
  1232. | (_, _), _ ->
  1233. print ctx "new %s(" (s_path ctx c.cl_path c.cl_extern e.epos);
  1234. let count = ref (-1) in
  1235. concat ctx ", " (fun e ->
  1236. incr count;
  1237. match c.cl_constructor with
  1238. | Some f ->
  1239. gen_value ctx e;
  1240. | _ -> ();
  1241. ) el;
  1242. spr ctx ")")
  1243. | TIf (cond,e,eelse) ->
  1244. spr ctx "if";
  1245. gen_value ctx (parent cond);
  1246. spr ctx " ";
  1247. restore_in_block ctx in_block;
  1248. gen_expr ctx (mk_block e);
  1249. (match eelse with
  1250. | None -> ()
  1251. | Some e when e.eexpr = TConst(TNull) -> ()
  1252. | Some e ->
  1253. spr ctx " else ";
  1254. restore_in_block ctx in_block;
  1255. gen_expr ctx (mk_block e));
  1256. | TUnop (op,Ast.Prefix,e) ->
  1257. (match e.eexpr with
  1258. | TArray(te1, te2) ->
  1259. (match op with
  1260. | Increment ->
  1261. spr ctx "_hx_array_increment(";
  1262. gen_value ctx te1;
  1263. spr ctx ",";
  1264. gen_value ctx te2;
  1265. spr ctx ")";
  1266. | Decrement ->
  1267. spr ctx "_hx_array_decrement(";
  1268. gen_value ctx te1;
  1269. spr ctx ",";
  1270. gen_value ctx te2;
  1271. spr ctx ")";
  1272. (*
  1273. let t = define_local ctx "»t" in
  1274. gen_value ctx te1;
  1275. print ctx "[%s = " t;
  1276. gen_value ctx te2;
  1277. spr ctx "] = ";
  1278. gen_value ctx te1;
  1279. print ctx "[%s]" t;
  1280. print ctx "[%s]" t;
  1281. *)
  1282. | _ ->
  1283. spr ctx (Ast.s_unop op);
  1284. gen_value ctx te1;
  1285. spr ctx "[";
  1286. gen_value ctx te2;
  1287. spr ctx "]";
  1288. );
  1289. | TField (e1,s) ->
  1290. spr ctx (Ast.s_unop op);
  1291. gen_field_access ctx true e1 s
  1292. | _ ->
  1293. spr ctx (Ast.s_unop op);
  1294. gen_value ctx e)
  1295. | TUnop (op,Ast.Postfix,e) ->
  1296. (match e.eexpr with
  1297. | TArray(te1, te2) ->
  1298. gen_value ctx te1;
  1299. spr ctx "->»a[";
  1300. gen_value ctx te2;
  1301. spr ctx "]";
  1302. | TField (e1,s) ->
  1303. gen_field_access ctx true e1 s
  1304. | _ ->
  1305. gen_value ctx e);
  1306. spr ctx (Ast.s_unop op)
  1307. | TWhile (cond,e,Ast.NormalWhile) ->
  1308. let old = save_locals ctx in
  1309. spr ctx "while";
  1310. gen_value ctx (parent cond);
  1311. spr ctx " {";
  1312. let bend = open_block ctx in
  1313. gen_while_expr ctx e;
  1314. bend();
  1315. newline ctx;
  1316. spr ctx "}";
  1317. old()
  1318. | TWhile (cond,e,Ast.DoWhile) ->
  1319. let old = save_locals ctx in
  1320. spr ctx "do {";
  1321. let bend = open_block ctx in
  1322. gen_while_expr ctx e;
  1323. bend();
  1324. newline ctx;
  1325. spr ctx "} while";
  1326. gen_value ctx (parent cond);
  1327. old()
  1328. | TObjectDecl fields ->
  1329. spr ctx "_hx_anonymous(array(";
  1330. concat ctx ", " (fun (f,e) -> print ctx "\"%s\" => " (escape_bin f); gen_value ctx e) fields;
  1331. spr ctx "))"
  1332. | TFor (v,it,e) ->
  1333. let b = save_locals ctx in
  1334. let tmp = define_local ctx "»it" in
  1335. let v = define_local ctx v.v_name in
  1336. (match it.eexpr with
  1337. | TCall (e,_) ->
  1338. (match e.eexpr with
  1339. | TField (e,f) ->
  1340. spr ctx "if(null == ";
  1341. gen_value ctx e;
  1342. spr ctx ") throw new HException('null iterable')";
  1343. newline ctx;
  1344. | _ ->
  1345. ());
  1346. | _ -> ()
  1347. );
  1348. print ctx "$%s = " tmp;
  1349. gen_value ctx it;
  1350. newline ctx;
  1351. print ctx "while($%s->hasNext()) {" tmp;
  1352. let bend = open_block ctx in
  1353. newline ctx;
  1354. print ctx "$%s = $%s->next()" v tmp;
  1355. gen_while_expr ctx e;
  1356. bend();
  1357. newline ctx;
  1358. spr ctx "}";
  1359. b();
  1360. | TTry (e,catchs) ->
  1361. spr ctx "try ";
  1362. restore_in_block ctx in_block;
  1363. gen_expr ctx (mk_block e);
  1364. let old = save_locals ctx in
  1365. let ex = define_local ctx "»e" in
  1366. print ctx "catch(Exception $%s) {" ex;
  1367. let bend = open_block ctx in
  1368. let first = ref true in
  1369. let catchall = ref false in
  1370. let evar = define_local ctx "_ex_" in
  1371. newline ctx;
  1372. print ctx "$%s = ($%s instanceof HException) ? $%s->e : $%s" evar ex ex ex;
  1373. old();
  1374. List.iter (fun (v,e) ->
  1375. let ev = define_local ctx v.v_name in
  1376. newline ctx;
  1377. let b = save_locals ctx in
  1378. if not !first then spr ctx "else ";
  1379. (match follow v.v_type with
  1380. | TEnum (te,_) -> (match snd te.e_path with
  1381. | "Bool" -> print ctx "if(is_bool($%s = $%s))" ev evar
  1382. | _ -> print ctx "if(($%s = $%s) instanceof %s)" ev evar (s_path ctx te.e_path te.e_extern e.epos));
  1383. restore_in_block ctx in_block;
  1384. gen_expr ctx (mk_block e);
  1385. | TInst (tc,_) -> (match snd tc.cl_path with
  1386. | "Int" -> print ctx "if(is_int($%s = $%s))" ev evar
  1387. | "Float" -> print ctx "if(is_numeric($%s = $%s))" ev evar
  1388. | "String" -> print ctx "if(is_string($%s = $%s))" ev evar
  1389. | "Array" -> print ctx "if(($%s = $%s) instanceof _hx_array)" ev evar
  1390. | _ -> print ctx "if(($%s = $%s) instanceof %s)" ev evar (s_path ctx tc.cl_path tc.cl_extern e.epos));
  1391. restore_in_block ctx in_block;
  1392. gen_expr ctx (mk_block e);
  1393. | TFun _
  1394. | TLazy _
  1395. | TType _
  1396. | TAnon _ ->
  1397. assert false
  1398. | TMono _
  1399. | TDynamic _ ->
  1400. catchall := true;
  1401. if not !first then spr ctx "{ ";
  1402. print ctx "$%s = $%s" ev evar;
  1403. newline ctx;
  1404. restore_in_block ctx in_block;
  1405. gen_expr ctx (mk_block e);
  1406. if not !first then spr ctx "}"
  1407. );
  1408. b();
  1409. first := false;
  1410. ) catchs;
  1411. if not !catchall then
  1412. print ctx " else throw $%s;" ex;
  1413. bend();
  1414. newline ctx;
  1415. spr ctx "}"
  1416. | TMatch (e,_,cases,def) ->
  1417. let b = save_locals ctx in
  1418. let tmp = define_local ctx "»t" in
  1419. print ctx "$%s = " tmp;
  1420. gen_value ctx e;
  1421. newline ctx;
  1422. print ctx "switch($%s->index) {" tmp;
  1423. let old_loop = ctx.in_loop in
  1424. ctx.in_loop <- false;
  1425. ctx.nested_loops <- ctx.nested_loops + 1;
  1426. newline ctx;
  1427. List.iter (fun (cl,params,e) ->
  1428. List.iter (fun c ->
  1429. print ctx "case %d:" c;
  1430. newline ctx;
  1431. ) cl;
  1432. let b = save_locals ctx in
  1433. (match params with
  1434. | None | Some [] -> ()
  1435. | Some l ->
  1436. let n = ref (-1) in
  1437. let l = List.fold_left (fun acc v -> incr n; match v with None -> acc | Some v -> (v.v_name,v.v_type,!n) :: acc) [] l in
  1438. match l with
  1439. | [] -> ()
  1440. | l ->
  1441. concat ctx "; " (fun (v,t,n) ->
  1442. let v = define_local ctx v in
  1443. print ctx "$%s = $%s->params[%d]" v tmp n;
  1444. ) l;
  1445. newline ctx);
  1446. restore_in_block ctx in_block;
  1447. gen_expr ctx (mk_block e);
  1448. print ctx "break";
  1449. newline ctx;
  1450. b()
  1451. ) cases;
  1452. (match def with
  1453. | None -> ()
  1454. | Some e ->
  1455. spr ctx "default:";
  1456. restore_in_block ctx in_block;
  1457. gen_expr ctx (mk_block e);
  1458. print ctx "break";
  1459. newline ctx;
  1460. );
  1461. ctx.nested_loops <- ctx.nested_loops - 1;
  1462. ctx.in_loop <- old_loop;
  1463. spr ctx "}";
  1464. b()
  1465. | TSwitch (e,cases,def) ->
  1466. let old_loop = ctx.in_loop in
  1467. ctx.in_loop <- false;
  1468. ctx.nested_loops <- ctx.nested_loops + 1;
  1469. let old = save_locals ctx in
  1470. spr ctx "switch";
  1471. gen_value ctx (parent e);
  1472. spr ctx " {";
  1473. newline ctx;
  1474. List.iter (fun (el,e2) ->
  1475. List.iter (fun e ->
  1476. spr ctx "case ";
  1477. gen_value ctx e;
  1478. spr ctx ":";
  1479. ) el;
  1480. restore_in_block ctx in_block;
  1481. gen_expr ctx (mk_block e2);
  1482. print ctx "break";
  1483. newline ctx;
  1484. ) cases;
  1485. (match def with
  1486. | None -> ()
  1487. | Some e ->
  1488. spr ctx "default:";
  1489. restore_in_block ctx in_block;
  1490. gen_expr ctx (mk_block e);
  1491. print ctx "break";
  1492. newline ctx;
  1493. );
  1494. spr ctx "}";
  1495. ctx.nested_loops <- ctx.nested_loops - 1;
  1496. ctx.in_loop <- old_loop;
  1497. old()
  1498. | TCast (e,None) ->
  1499. gen_expr ctx e
  1500. | TCast (e1,Some t) ->
  1501. let mk_texpr = function
  1502. | TClassDecl c -> TAnon { a_fields = PMap.empty; a_status = ref (Statics c) }
  1503. | TEnumDecl e -> TAnon { a_fields = PMap.empty; a_status = ref (EnumStatics e) }
  1504. | TTypeDecl _ -> assert false
  1505. in
  1506. spr ctx "_hx_cast(";
  1507. gen_expr ctx e1;
  1508. spr ctx ", ";
  1509. gen_expr ctx (mk (TTypeExpr t) (mk_texpr t) e1.epos);
  1510. spr ctx ")"
  1511. and argument_list_from_locals include_this in_var l =
  1512. let lst = ref [] in
  1513. if (include_this && in_var) then lst := "»this" :: !lst
  1514. else if include_this then lst := "this" :: !lst;
  1515. PMap.iter (fun n _ ->
  1516. lst := !lst @ [n];
  1517. ) l;
  1518. !lst
  1519. and remove_internals args =
  1520. List.filter (fun a -> a = "»this" or '»' <> String.get a 0) args;
  1521. and inline_block ctx e =
  1522. let index = ctx.inline_index in
  1523. ctx.inline_index <- ctx.inline_index + 1;
  1524. let block = {
  1525. iname = (s_path ctx ctx.curclass.cl_path ctx.curclass.cl_extern ctx.curclass.cl_pos) ^ "_" ^ string_of_int index;
  1526. iindex = index;
  1527. ihasthis = ctx.in_instance_method; (* param this *)
  1528. iarguments = [];
  1529. iexpr = e;
  1530. ilocals = ctx.locals;
  1531. iin_block = true;
  1532. iinv_locals = ctx.inv_locals;
  1533. } in
  1534. print ctx "%s(" block.iname;
  1535. let in_value = (match ctx.in_value with Some _ -> true | _ -> false) in
  1536. (match remove_internals (argument_list_from_locals ctx.in_instance_method in_value ctx.locals) with
  1537. | [] -> ()
  1538. | l -> print ctx "$%s" (String.concat ", $" l)
  1539. );
  1540. spr ctx ")";
  1541. ctx.inline_methods <- ctx.inline_methods @ [block]
  1542. and inline_function ctx args hasthis e =
  1543. let index = ctx.inline_index in
  1544. ctx.inline_index <- ctx.inline_index + 1;
  1545. let block = {
  1546. iname = (s_path ctx ctx.curclass.cl_path ctx.curclass.cl_extern ctx.curclass.cl_pos) ^ "_" ^ string_of_int index;
  1547. iindex = index;
  1548. ihasthis = hasthis; (* param this *)
  1549. iarguments = args;
  1550. iexpr = e;
  1551. ilocals = ctx.locals;
  1552. iin_block = false;
  1553. iinv_locals = ctx.inv_locals;
  1554. } in
  1555. ctx.inline_methods <- ctx.inline_methods @ [block];
  1556. block.iname
  1557. and canbe_ternary_param e =
  1558. match e.eexpr with
  1559. | TTypeExpr _
  1560. | TConst _
  1561. | TLocal _
  1562. | TEnumField _
  1563. | TParenthesis _
  1564. | TObjectDecl _
  1565. | TArrayDecl _
  1566. | TCall _
  1567. | TUnop _
  1568. | TNew _
  1569. | TCast (_, _)
  1570. | TBlock [_] ->
  1571. true
  1572. | TIf (_,e,eelse) ->
  1573. cangen_ternary e eelse
  1574. | _ ->
  1575. false
  1576. and cangen_ternary e eelse =
  1577. match eelse with
  1578. | Some other ->
  1579. (canbe_ternary_param e) && (canbe_ternary_param other)
  1580. | _ ->
  1581. false
  1582. and gen_value ctx e =
  1583. match e.eexpr with
  1584. | TTypeExpr _
  1585. | TConst _
  1586. | TLocal _
  1587. | TEnumField _
  1588. | TArray _
  1589. | TBinop _
  1590. | TField _
  1591. | TClosure _
  1592. | TParenthesis _
  1593. | TObjectDecl _
  1594. | TArrayDecl _
  1595. | TCall _
  1596. | TUnop _
  1597. | TNew _
  1598. | TFunction _ ->
  1599. gen_expr ctx e
  1600. | TBlock [] ->
  1601. ()
  1602. | TCast (e, _)
  1603. | TBlock [e] ->
  1604. gen_value ctx e
  1605. | TIf (cond,e,eelse) when (cangen_ternary e eelse) ->
  1606. spr ctx "(";
  1607. gen_value ctx cond;
  1608. spr ctx " ? ";
  1609. gen_value ctx e;
  1610. (match eelse with
  1611. | Some e ->
  1612. spr ctx " : ";
  1613. gen_value ctx e
  1614. | _ ->());
  1615. spr ctx ")";
  1616. (*
  1617. | TIf (cond,e,eelse) ->
  1618. spr ctx "if";
  1619. gen_value ctx (parent cond);
  1620. spr ctx " ";
  1621. restore_in_block ctx in_block;
  1622. gen_expr ctx (mk_block e);
  1623. (match eelse with
  1624. | None -> ()
  1625. | Some e when e.eexpr = TConst(TNull) -> ()
  1626. | Some e ->
  1627. spr ctx " else ";
  1628. restore_in_block ctx in_block;
  1629. gen_expr ctx (mk_block e));
  1630. *)
  1631. | TBlock _
  1632. | TBreak
  1633. | TContinue
  1634. | TVars _
  1635. | TReturn _
  1636. | TWhile _
  1637. | TThrow _
  1638. | TSwitch _
  1639. | TFor _
  1640. | TMatch _
  1641. | TIf _
  1642. | TTry _ ->
  1643. inline_block ctx e
  1644. let rec is_instance_method_defined cls m =
  1645. if PMap.exists m cls.cl_fields then
  1646. true
  1647. else
  1648. match cls.cl_super with
  1649. | Some (scls, _) ->
  1650. is_instance_method_defined scls m
  1651. | None ->
  1652. false
  1653. let is_method_defined ctx m static =
  1654. if static then
  1655. PMap.exists m ctx.curclass.cl_statics
  1656. else
  1657. is_instance_method_defined ctx.curclass m
  1658. let generate_self_method ctx rights m static setter =
  1659. if setter then (
  1660. if static then
  1661. print ctx "%s function %s($v) { return call_user_func(self::$%s, $v); }" rights (s_ident m) (s_ident m)
  1662. else
  1663. print ctx "%s function %s($v) { return call_user_func($this->%s, $v); }" rights (s_ident m) (s_ident m)
  1664. ) else (
  1665. if static then
  1666. print ctx "%s function %s() { return call_user_func(self::$%s); }" rights (s_ident m) (s_ident m)
  1667. else
  1668. print ctx "%s function %s() { return call_user_func($this->%s); }" rights (s_ident m) (s_ident m)
  1669. );
  1670. newline ctx
  1671. let generate_field ctx static f =
  1672. newline ctx;
  1673. ctx.locals <- PMap.empty;
  1674. ctx.inv_locals <- PMap.empty;
  1675. ctx.in_instance_method <- not static;
  1676. let rights = if static then "static" else "public" in
  1677. let p = ctx.curclass.cl_pos in
  1678. match f.cf_expr with
  1679. | Some { eexpr = TFunction fd } ->
  1680. if f.cf_name = "__construct" then
  1681. ctx.curmethod <- "new"
  1682. else
  1683. ctx.curmethod <- f.cf_name;
  1684. spr ctx (rights ^ " ");
  1685. if is_dynamic_method f then
  1686. gen_dynamic_function ctx static (s_ident f.cf_name) fd f.cf_params p
  1687. else
  1688. gen_function ctx (s_ident f.cf_name) fd f.cf_params p
  1689. | _ ->
  1690. if ctx.curclass.cl_interface then
  1691. match follow f.cf_type, f.cf_kind with
  1692. | TFun (args,r), Method _ ->
  1693. print ctx "function %s(" (s_ident f.cf_name);
  1694. concat ctx ", " (fun (arg,o,t) ->
  1695. s_funarg ctx arg t p o;
  1696. ) args;
  1697. print ctx ")";
  1698. | _ -> spr ctx "//"; ()
  1699. else if
  1700. (match f.cf_kind with
  1701. | Var v ->
  1702. (match v.v_read, v.v_write with
  1703. | AccCall m1, AccCall m2 ->
  1704. if not (is_method_defined ctx m1 static) then (
  1705. generate_self_method ctx rights m1 static false;
  1706. print ctx "%s $%s" rights (s_ident m1);
  1707. if not (is_method_defined ctx m2 static) then
  1708. newline ctx);
  1709. if not (is_method_defined ctx m2 static) then (
  1710. generate_self_method ctx rights m2 static true;
  1711. print ctx "%s $%s" rights (s_ident m2);
  1712. newline ctx);
  1713. false
  1714. | AccCall m, _ ->
  1715. if not (is_method_defined ctx m static) then generate_self_method ctx rights m static false;
  1716. print ctx "%s $%s" rights (s_ident f.cf_name);
  1717. true
  1718. | _, AccCall m ->
  1719. if not (is_method_defined ctx m static) then generate_self_method ctx rights m static true;
  1720. print ctx "%s $%s" rights (s_ident f.cf_name);
  1721. true
  1722. | _ ->
  1723. false)
  1724. | _ -> false) then
  1725. ()
  1726. else begin
  1727. let name = s_ident f.cf_name in
  1728. if static then
  1729. (match f.cf_kind with
  1730. | Var _ ->
  1731. (match follow f.cf_type with
  1732. | TFun _
  1733. | TDynamic _ ->
  1734. print ctx "static function %s() { $»args = func_get_args(); return call_user_func_array(self::$%s, $»args); }" name name;
  1735. newline ctx;
  1736. | _ ->
  1737. ()
  1738. )
  1739. | _ ->
  1740. ()
  1741. );
  1742. print ctx "%s $%s" rights name;
  1743. match f.cf_expr with
  1744. | None -> ()
  1745. | Some e ->
  1746. match e.eexpr with
  1747. | TConst _ ->
  1748. print ctx " = ";
  1749. gen_value ctx e
  1750. | _ -> ()
  1751. end
  1752. let generate_static_field_assign ctx path f =
  1753. let p = ctx.curclass.cl_pos in
  1754. if not ctx.curclass.cl_interface then
  1755. (match f.cf_expr with
  1756. | None -> ()
  1757. | Some e ->
  1758. match e.eexpr with
  1759. | TConst _ -> ()
  1760. | TFunction fd ->
  1761. (match f.cf_kind with
  1762. | Var _ when
  1763. (match follow f.cf_type with
  1764. | TFun _
  1765. | TDynamic _ ->
  1766. true;
  1767. | _ ->
  1768. false) ->
  1769. newline ctx;
  1770. print ctx "%s::$%s = " (s_path ctx path false p) (s_ident f.cf_name);
  1771. gen_value ctx e
  1772. | Method MethDynamic ->
  1773. newline ctx;
  1774. print ctx "%s::$%s = " (s_path ctx path false p) (s_ident f.cf_name);
  1775. gen_value ctx e
  1776. | _ -> ())
  1777. | _ ->
  1778. newline ctx;
  1779. print ctx "%s::$%s = " (s_path ctx path false p) (s_ident f.cf_name);
  1780. gen_value ctx e)
  1781. let rec super_has_dynamic c =
  1782. match c.cl_super with
  1783. | None -> false
  1784. | Some (csup, _) -> (match csup.cl_dynamic with
  1785. | Some _ -> true
  1786. | _ -> super_has_dynamic csup)
  1787. let generate_inline_method ctx c m =
  1788. (match ctx.inline_methods with
  1789. | [] -> ()
  1790. | h :: t -> ctx.inline_methods <- t
  1791. );
  1792. ctx.curclass <- c;
  1793. let old = save_locals ctx in
  1794. ctx.in_value <- Some m.iname;
  1795. ctx.in_block <- m.iin_block;
  1796. ctx.in_loop <- false;
  1797. ctx.locals <- m.ilocals;
  1798. ctx.inv_locals <- m.iinv_locals;
  1799. newline ctx;
  1800. print ctx "function %s(" m.iname;
  1801. (* arguments *)
  1802. let in_value = (match ctx.in_value with Some _ -> true | _ -> false) in
  1803. let arguments = remove_internals (argument_list_from_locals m.ihasthis in_value ctx.locals) in
  1804. let arguments = match arguments with
  1805. | [h] when h = "this" -> ["»this"]
  1806. | h :: t when h = "this" -> "»this" :: t
  1807. | _ -> arguments
  1808. in
  1809. let marguments = List.map (define_local ctx) m.iarguments in
  1810. let arguments = (List.map (fun a -> "&$" ^ a) arguments) @ (List.map (fun a -> "$" ^ a) marguments) in
  1811. (match arguments with
  1812. | [] -> ()
  1813. | l -> spr ctx (String.concat ", " arguments)
  1814. );
  1815. spr ctx ") {";
  1816. ctx.nested_loops <- ctx.nested_loops - 1;
  1817. let block = open_block ctx in
  1818. newline ctx;
  1819. (* blocks *)
  1820. if ctx.com.debug then begin
  1821. (*--php-prefix*)
  1822. (* print_endline (s_path_haxe c.cl_path); *)
  1823. spr ctx "$»spos = $GLOBALS['%s']->length";
  1824. newline ctx;
  1825. end;
  1826. (*
  1827. if ctx.com.debug then begin
  1828. (*--php-prefix*)
  1829. print_endline (s_path_haxe c.cl_path);
  1830. print ctx "\t$GLOBALS['%s']->push('%s:lambda_%d')" "%s" (s_path_haxe c.cl_path) m.iindex;
  1831. newline ctx;
  1832. spr ctx "\t$»spos = $GLOBALS['%s']->length";
  1833. newline ctx;
  1834. end;
  1835. *)
  1836. gen_expr ctx m.iexpr;
  1837. block();
  1838. old();
  1839. ctx.nested_loops <- ctx.nested_loops + 1;
  1840. newline ctx;
  1841. spr ctx "}"
  1842. let generate_class ctx c =
  1843. let requires_constructor = ref true in
  1844. ctx.curclass <- c;
  1845. ctx.local_types <- List.map snd c.cl_types;
  1846. print ctx "%s %s " (if c.cl_interface then "interface" else "class") (s_path ctx c.cl_path c.cl_extern c.cl_pos);
  1847. (match c.cl_super with
  1848. | None -> ()
  1849. | Some (csup,_) ->
  1850. requires_constructor := false;
  1851. print ctx "extends %s " (s_path ctx csup.cl_path csup.cl_extern c.cl_pos));
  1852. let implements = ExtList.List.unique ~cmp:(fun a b -> (fst a).cl_path = (fst b).cl_path) c.cl_implements in
  1853. (match implements with
  1854. | [] -> ()
  1855. | l ->
  1856. spr ctx (if c.cl_interface then "extends " else "implements ");
  1857. concat ctx ", " (fun (i,_) ->
  1858. print ctx "%s" (s_path ctx i.cl_path i.cl_extern c.cl_pos)) l);
  1859. spr ctx "{";
  1860. let get_dynamic_methods = List.filter is_dynamic_method c.cl_ordered_fields in
  1861. if not ctx.curclass.cl_interface then ctx.dynamic_methods <- get_dynamic_methods;
  1862. let cl = open_block ctx in
  1863. (match c.cl_constructor with
  1864. | None ->
  1865. if !requires_constructor && not c.cl_interface then begin
  1866. newline ctx;
  1867. spr ctx "public function __construct(){}"
  1868. end;
  1869. | Some f ->
  1870. let f = { f with
  1871. cf_name = "__construct";
  1872. cf_public = true;
  1873. } in
  1874. ctx.constructor_block <- true;
  1875. generate_field ctx false f;
  1876. );
  1877. List.iter (generate_field ctx false) c.cl_ordered_fields;
  1878. (match c.cl_dynamic with
  1879. | Some _ when not c.cl_interface && not (super_has_dynamic c) ->
  1880. newline ctx;
  1881. spr ctx "public $»dynamics = array();\n\tpublic function __get($n) {\n\t\tif(isset($this->»dynamics[$n]))\n\t\t\treturn $this->»dynamics[$n];\n\t}\n\tpublic function __set($n, $v) {\n\t\t$this->»dynamics[$n] = $v;\n\t}\n\tpublic function __call($n, $a) {\n\t\tif(isset($this->»dynamics[$n]) && is_callable($this->»dynamics[$n]))\n\t\t\treturn call_user_func_array($this->»dynamics[$n], $a);\n\t\tif('toString' == $n)\n\t\t\treturn $this->__toString();\n\t\tthrow new HException(\"Unable to call «\".$n.\"»\");\n\t}"
  1882. | Some _
  1883. | _ ->
  1884. if List.length ctx.dynamic_methods > 0 then begin
  1885. newline ctx;
  1886. spr ctx "public function __call($m, $a) {\n\t\tif(isset($this->$m) && is_callable($this->$m))\n\t\t\treturn call_user_func_array($this->$m, $a);\n\t\telse if(isset($this->»dynamics[$m]) && is_callable($this->»dynamics[$m]))\n\t\t\treturn call_user_func_array($this->»dynamics[$m], $a);\n\t\telse if('toString' == $m)\n\t\t\treturn $this->__toString();\n\t\telse\n\t\t\tthrow new HException('Unable to call «'.$m.'»');\n\t}";
  1887. end;
  1888. );
  1889. List.iter (generate_field ctx true) c.cl_ordered_statics;
  1890. let gen_props props =
  1891. String.concat "," (List.map (fun (p,v) -> "\"" ^ p ^ "\" => \"" ^ v ^ "\"") props)
  1892. in
  1893. let rec fields c =
  1894. let list = Codegen.get_properties (c.cl_ordered_statics @ c.cl_ordered_fields) in
  1895. match c.cl_super with
  1896. | Some (csup, _) ->
  1897. list @ fields csup
  1898. | None ->
  1899. list
  1900. in
  1901. if not c.cl_interface then (match fields c with
  1902. | [] ->
  1903. ()
  1904. | props ->
  1905. newline ctx;
  1906. print ctx "static $__properties__ = array(%s)" (gen_props props);
  1907. );
  1908. cl();
  1909. newline ctx;
  1910. if PMap.exists "__toString" c.cl_fields then
  1911. ()
  1912. else if PMap.exists "toString" c.cl_fields && (not c.cl_interface) && (not c.cl_extern) then begin
  1913. print ctx "\tfunction __toString() { return $this->toString(); }";
  1914. newline ctx
  1915. end else if (not c.cl_interface) && (not c.cl_extern) then begin
  1916. print ctx "\tfunction __toString() { return '%s'; }" (s_path_haxe c.cl_path) ;
  1917. newline ctx
  1918. end;
  1919. print ctx "}"
  1920. let createmain com e =
  1921. let filename = match com.php_front with None -> "index.php" | Some n -> n in
  1922. let ctx = {
  1923. com = com;
  1924. stack = stack_init com false;
  1925. tabs = "";
  1926. ch = open_out_bin (com.file ^ "/" ^ filename);
  1927. path = ([], "");
  1928. buf = Buffer.create (1 lsl 14);
  1929. in_value = None;
  1930. in_loop = false;
  1931. in_instance_method = false;
  1932. imports = Hashtbl.create 0;
  1933. extern_required_paths = [];
  1934. extern_classes_with_init = [];
  1935. curclass = null_class;
  1936. curmethod = "";
  1937. locals = PMap.empty;
  1938. inv_locals = PMap.empty;
  1939. local_types = [];
  1940. inits = [];
  1941. constructor_block = false;
  1942. dynamic_methods = [];
  1943. all_dynamic_methods = [];
  1944. is_call = false;
  1945. cwd = "";
  1946. inline_methods = [];
  1947. nested_loops = 0;
  1948. inline_index = 0;
  1949. in_block = false;
  1950. lib_path = match com.php_lib with None -> "lib" | Some s -> s;
  1951. } in
  1952. spr ctx "if(version_compare(PHP_VERSION, '5.1.0', '<')) {
  1953. exit('Your current PHP version is: ' . PHP_VERSION . '. Haxe/PHP generates code for version 5.1.0 or later');
  1954. }";
  1955. newline ctx;
  1956. newline ctx;
  1957. spr ctx ("require_once dirname(__FILE__).'/" ^ ctx.lib_path ^ "/php/" ^ (prefix_class com "Boot.class.php';\n\n"));
  1958. gen_value ctx e;
  1959. newline ctx;
  1960. spr ctx "\n?>";
  1961. close ctx
  1962. let generate_main ctx c =
  1963. (match c.cl_ordered_statics with
  1964. | [{ cf_expr = Some e }] ->
  1965. gen_value ctx e;
  1966. | _ -> assert false);
  1967. newline ctx
  1968. let generate_enum ctx e =
  1969. ctx.local_types <- List.map snd e.e_types;
  1970. let pack = open_block ctx in
  1971. let ename = s_path ctx e.e_path e.e_extern e.e_pos in
  1972. print ctx "class %s extends Enum {" ename;
  1973. PMap.iter (fun _ c ->
  1974. newline ctx;
  1975. match c.ef_type with
  1976. | TFun (args,_) ->
  1977. print ctx "public static function %s($" c.ef_name;
  1978. concat ctx ", $" (fun (a,o,t) ->
  1979. spr ctx a;
  1980. if o then spr ctx " = null";
  1981. ) args;
  1982. spr ctx ") {";
  1983. print ctx " return new %s(\"%s\", %d, array($" ename c.ef_name c.ef_index;
  1984. concat ctx ", $" (fun (a,_,_) -> spr ctx a) args;
  1985. print ctx ")); }";
  1986. | _ ->
  1987. print ctx "public static $%s" c.ef_name;
  1988. ) e.e_constrs;
  1989. newline ctx;
  1990. spr ctx "public static $__constructors = array(";
  1991. let first = ref true in
  1992. PMap.iter (fun _ c ->
  1993. if not !first then spr ctx ", ";
  1994. print ctx "%d => '%s'" c.ef_index c.ef_name;
  1995. first := false;
  1996. ) e.e_constrs;
  1997. spr ctx ")";
  1998. newline ctx;
  1999. (match Codegen.build_metadata ctx.com (TEnumDecl e) with
  2000. | None -> ()
  2001. | Some _ ->
  2002. spr ctx "public static $__meta__";
  2003. newline ctx);
  2004. pack();
  2005. print ctx "}";
  2006. PMap.iter (fun _ c ->
  2007. match c.ef_type with
  2008. | TFun (args,_) ->
  2009. ();
  2010. | _ ->
  2011. newline ctx;
  2012. print ctx "%s::$%s = new %s(\"%s\", %d)" ename c.ef_name ename c.ef_name c.ef_index;
  2013. ) e.e_constrs;
  2014. newline ctx;
  2015. match Codegen.build_metadata ctx.com (TEnumDecl e) with
  2016. | None -> ()
  2017. | Some e ->
  2018. print ctx "%s::$__meta__ = " ename;
  2019. gen_expr ctx e;
  2020. newline ctx
  2021. let generate com =
  2022. let all_dynamic_methods = ref [] in
  2023. let extern_classes_with_init = ref [] in
  2024. let php_lib_path = (match com.php_lib with None -> "lib" | Some n -> n) in
  2025. create_directory com (Str.split (Str.regexp "/") php_lib_path);
  2026. (* check for methods with the same name but different case *)
  2027. let check_class_fields c =
  2028. let lc_names = ref [] in
  2029. let special_cases = ["toString"] in
  2030. let loop c lst static =
  2031. let in_special_cases name =
  2032. (List.exists (fun n -> String.lowercase n = name) (special_cases @ c.cl_overrides))
  2033. in
  2034. List.iter(fun cf ->
  2035. let name = String.lowercase cf.cf_name in
  2036. let prefixed_name s = (if s then "s_" else "i_") ^ name in
  2037. match cf.cf_kind, cf.cf_expr with
  2038. | (Method _, Some e) when not (in_special_cases name) ->
  2039. (try
  2040. let lc = List.find (fun n ->
  2041. let n = snd n in
  2042. if static then
  2043. (n = (prefixed_name false))
  2044. else
  2045. ((n = (prefixed_name false)) or (n = (prefixed_name true)))
  2046. ) !lc_names in
  2047. unsupported ("method '" ^ (s_type_path c.cl_path) ^ "." ^ cf.cf_name ^ "' already exists here '" ^ (fst lc) ^ "' (different case?)") c.cl_pos
  2048. with Not_found ->
  2049. lc_names := ((s_type_path c.cl_path) ^ "." ^ cf.cf_name, prefixed_name static) :: !lc_names)
  2050. | _ ->
  2051. ()
  2052. ) lst
  2053. in
  2054. let rec _check_class_fields cl =
  2055. (match cl.cl_super with
  2056. | Some (s,_) -> _check_class_fields s
  2057. | _ -> ());
  2058. loop cl cl.cl_ordered_statics true;
  2059. loop cl cl.cl_ordered_fields false
  2060. in
  2061. _check_class_fields c
  2062. in
  2063. List.iter (fun t ->
  2064. (match t with
  2065. | TClassDecl c ->
  2066. check_class_fields c
  2067. | TEnumDecl e ->
  2068. let e_names = ref [] in
  2069. List.iter(fun en -> (
  2070. if List.exists (fun n -> n = String.lowercase en) !e_names then
  2071. unsupported ("'" ^ en ^ "' constructor exists with different case") e.e_pos
  2072. else
  2073. e_names := (String.lowercase en) :: !e_names
  2074. )) (e.e_names)
  2075. | _ -> ())
  2076. ) com.types;
  2077. List.iter (fun t ->
  2078. (match t with
  2079. | TClassDecl c ->
  2080. let dynamic_methods_names lst =
  2081. List.map (fun fd -> {
  2082. mpath = c.cl_path;
  2083. mname = fd.cf_name;
  2084. }) (List.filter is_dynamic_method lst)
  2085. in
  2086. all_dynamic_methods := dynamic_methods_names c.cl_ordered_fields @ !all_dynamic_methods;
  2087. if c.cl_extern then
  2088. (match c.cl_init with
  2089. | Some _ ->
  2090. extern_classes_with_init := c.cl_path :: !extern_classes_with_init;
  2091. | _ ->
  2092. ())
  2093. else
  2094. all_dynamic_methods := dynamic_methods_names c.cl_ordered_statics @ !all_dynamic_methods;
  2095. | _ -> ())
  2096. ) com.types;
  2097. List.iter (Codegen.fix_abstract_inheritance com) com.types;
  2098. List.iter (fun t ->
  2099. (match t with
  2100. | TClassDecl c ->
  2101. if c.cl_extern then begin
  2102. (match c.cl_init with
  2103. | None -> ()
  2104. | Some e ->
  2105. let ctx = init com php_lib_path c.cl_path 3 in
  2106. gen_expr ctx e;
  2107. newline ctx;
  2108. close ctx;
  2109. );
  2110. end else
  2111. let ctx = init com php_lib_path c.cl_path (if c.cl_interface then 2 else 0) in
  2112. ctx.extern_classes_with_init <- !extern_classes_with_init;
  2113. ctx.all_dynamic_methods <- !all_dynamic_methods;
  2114. generate_class ctx c;
  2115. (match c.cl_init with
  2116. | None -> ()
  2117. | Some e ->
  2118. newline ctx;
  2119. gen_expr ctx e);
  2120. List.iter (generate_static_field_assign ctx c.cl_path) c.cl_ordered_statics;
  2121. if c.cl_path = (["php"], "Boot") & com.debug then begin
  2122. newline ctx;
  2123. print ctx "$%s = new _hx_array(array())" ctx.stack.Codegen.stack_var;
  2124. newline ctx;
  2125. print ctx "$%s = new _hx_array(array())" ctx.stack.Codegen.stack_exc_var;
  2126. end;
  2127. let rec loop l =
  2128. match l with
  2129. | [] -> ()
  2130. | h :: _ ->
  2131. generate_inline_method ctx c h;
  2132. loop ctx.inline_methods
  2133. in
  2134. loop ctx.inline_methods;
  2135. newline ctx;
  2136. close ctx
  2137. | TEnumDecl e ->
  2138. if e.e_extern then
  2139. ()
  2140. else
  2141. let ctx = init com php_lib_path e.e_path 1 in
  2142. generate_enum ctx e;
  2143. close ctx
  2144. | TTypeDecl t ->
  2145. ());
  2146. ) com.types;
  2147. (match com.main with
  2148. | None -> ()
  2149. | Some e -> createmain com e);
  2150. Hashtbl.iter (fun name data ->
  2151. write_resource com.file name data
  2152. ) com.resources;