genphp.ml 65 KB

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