genphp.ml 65 KB

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