genphp.ml 64 KB

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