genphp.ml 64 KB

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