genphp.ml 64 KB

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