Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 809 lines (771 sloc) 26.409 kb
9a2f153 added empty genneko
ncannasse authored
1 (*
2 * Haxe Compiler
3 * Copyright (c)2005 Nicolas Cannasse
4 *
5 * This program is free software; you can redistribute it and/or modify
6 * it under the terms of the GNU General Public License as published by
7 * the Free Software Foundation; either version 2 of the License, or
8 * (at your option) any later version.
9 *
10 * This program is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
14 *
15 * You should have received a copy of the GNU General Public License
16 * along with this program; if not, write to the Free Software
17 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
18 *)
19 open Ast
20 open Type
f3dec0d neko include
ncannasse authored
21 open Nast
22 open Nxml
3e965e4 2.0 base :
ncannasse authored
23 open Common
9a2f153 added empty genneko
ncannasse authored
24
e95654c added context and environment locals sharing.
ncannasse authored
25 type context = {
4c6a556 added interp
ncannasse authored
26 com : Common.context;
885a64f macros working !
ncannasse authored
27 packages : (string list, unit) Hashtbl.t;
28 globals : (string list * string, string) Hashtbl.t;
29 mutable curglobal : int;
cd3da56 macros interp working (still need to pass unit tests)
ncannasse authored
30 mutable macros : bool;
45f1b99 added neko methods
ncannasse authored
31 mutable curclass : string;
32 mutable curmethod : string;
4b030ab fixed curclass/curmethod in __init__
ncannasse authored
33 mutable inits : (tclass * texpr) list;
e95654c added context and environment locals sharing.
ncannasse authored
34 }
35
45f98f2 removed classpath from neko debug infos filenames.
ncannasse authored
36 let files = Hashtbl.create 0
37
45f1b99 added neko methods
ncannasse authored
38 let pos ctx p =
cd3da56 macros interp working (still need to pass unit tests)
ncannasse authored
39 if ctx.macros then
40 {
41 psource = p.pfile;
42 pline = p.pmin lor (p.pmax lsl 16);
43 }
44 else let file = (match ctx.com.debug with
45f1b99 added neko methods
ncannasse authored
45 | true -> ctx.curclass ^ "::" ^ ctx.curmethod
46 | false ->
47 try
48 Hashtbl.find files p.pfile
49 with Not_found -> try
3e965e4 2.0 base :
ncannasse authored
50 (* lookup relative path *)
45f1b99 added neko methods
ncannasse authored
51 let len = String.length p.pfile in
52 let base = List.find (fun path ->
53 let l = String.length path in
3e965e4 2.0 base :
ncannasse authored
54 len > l && String.sub p.pfile 0 l = path
55 ) ctx.com.Common.class_path in
45f1b99 added neko methods
ncannasse authored
56 let l = String.length base in
57 let path = String.sub p.pfile l (len - l) in
58 Hashtbl.add files p.pfile path;
59 path
60 with Not_found ->
61 Hashtbl.add files p.pfile p.pfile;
62 p.pfile
45f98f2 removed classpath from neko debug infos filenames.
ncannasse authored
63 ) in
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
64 {
45f98f2 removed classpath from neko debug infos filenames.
ncannasse authored
65 psource = file;
4780c0a automate + simplify lexer line_index build
ncannasse authored
66 pline = Lexer.get_error_line p;
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
67 }
68
885a64f macros working !
ncannasse authored
69 let gen_global_name ctx path =
70 match path with
71 | [], name -> name
72 | _ ->
73 try
74 Hashtbl.find ctx.globals path
75 with Not_found ->
76 let name = "@G" ^ string_of_int ctx.curglobal in
77 ctx.curglobal <- ctx.curglobal + 1;
78 Hashtbl.add ctx.globals path name;
79 name
80
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
81 let null p =
82 (EConst Null,p)
83
84 let this p =
85 (EConst This,p)
86
87 let int p n =
88 (EConst (Int n),p)
89
90 let str p s =
91 (EConst (String s),p)
92
93 let ident p s =
94 let l = String.length s in
95 if l > 10 && String.sub s 0 10 = "__dollar__" then
96 (EConst (Builtin (String.sub s 10 (l - 10))),p)
97 else
98 (EConst (Ident s),p)
99
100 let field p e f =
101 (EField (e,f),p)
102
103 let builtin p n =
104 (EConst (Builtin n),p)
105
106 let call p e el =
107 (ECall (e,el),p)
108
109 let array p el =
b135b0b added optional arguments
ncannasse authored
110 call p (builtin p "array") el
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
111
112 let pmap_list f p =
113 PMap.fold (fun v acc -> f v :: acc) p []
114
3732184 fixed returned value.
ncannasse authored
115 let rec needs_return e =
116 match e with
117 | (EBlock l,_) ->
118 let rec loop = function
119 | [] -> true
120 | [x] -> needs_return x
121 | _ :: l -> loop l
122 in
123 loop l
124 | (EReturn _,_) ->
125 false
126 | _ ->
127 true
128
129 let with_return e =
130 if needs_return e then
131 let p = snd e in
132 let ret = EReturn (Some (null p)),p in
133 match e with
134 | (EBlock l,_) ->
135 (EBlock (l @ [ret]),p)
136 | _ ->
137 (EBlock [e;ret] , p)
138 else
139 e
140
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
141 let gen_type_path p (path,t) =
142 match path with
b135b0b added optional arguments
ncannasse authored
143 | [] ->
b16b185 fixed native serialization problems.
ncannasse authored
144 ident p t
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
145 | path :: l ->
146 let epath = List.fold_left (fun e path -> field p e path) (ident p path) l in
b16b185 fixed native serialization problems.
ncannasse authored
147 field p epath t
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
148
2be6a38 allowed > 64k res
ncannasse authored
149 let rec gen_big_string ctx p s =
150 let max = 1 lsl 16 - 1 in
151 if String.length s > max then
152 (EBinop ("+",str p (String.sub s 0 max),gen_big_string ctx p (String.sub s max (String.length s - max))),p)
153 else
154 str p s
155
45f1b99 added neko methods
ncannasse authored
156 let gen_constant ctx pe c =
157 let p = pos ctx pe in
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
158 match c with
a8e3b29 fixed neko int overflow detection
ncannasse authored
159 | TInt i ->
160 (try
161 let h = Int32.to_int (Int32.shift_right_logical i 24) in
162 if (h land 128 = 0) <> (h land 64 = 0) then raise Exit;
163 int p (Int32.to_int i)
164 with _ ->
165 error "This integer is too big to be compiled to a Neko 31-bit integer. Please use a Float instead" pe)
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
166 | TFloat f -> (EConst (Float f),p)
2be6a38 allowed > 64k res
ncannasse authored
167 | TString s -> call p (field p (ident p "String") "new") [gen_big_string ctx p s]
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
168 | TBool b -> (EConst (if b then True else False),p)
169 | TNull -> null p
b135b0b added optional arguments
ncannasse authored
170 | TThis -> this p
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
171 | TSuper -> assert false
172
e95654c added context and environment locals sharing.
ncannasse authored
173 let rec gen_binop ctx p op e1 e2 =
15bb296 removed === and !==
ncannasse authored
174 (EBinop (Ast.s_binop op,gen_expr ctx e1,gen_expr ctx e2),p)
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
175
b135b0b added optional arguments
ncannasse authored
176 and gen_unop ctx p op flag e =
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
177 match op with
e95654c added context and environment locals sharing.
ncannasse authored
178 | Increment -> (EBinop ((if flag = Prefix then "+=" else "++="), gen_expr ctx e , int p 1),p)
179 | Decrement -> (EBinop ((if flag = Prefix then "-=" else "--="), gen_expr ctx e , int p 1),p)
180 | Not -> call p (builtin p "not") [gen_expr ctx e]
181 | Neg -> (EBinop ("-",int p 0, gen_expr ctx e),p)
bf830d4 added ~ implementation for neko
ncannasse authored
182 | NegBits -> (EBinop ("-",int p (-1), gen_expr ctx e),p)
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
183
e95654c added context and environment locals sharing.
ncannasse authored
184 and gen_call ctx p e el =
26f0219 added inheritance and packages.
ncannasse authored
185 match e.eexpr , el with
186 | TConst TSuper , _ ->
187 let c = (match follow e.etype with TInst (c,_) -> c | _ -> assert false) in
188 call p (builtin p "call") [
189 field p (gen_type_path p c.cl_path) "__construct__";
190 this p;
e95654c added context and environment locals sharing.
ncannasse authored
191 array p (List.map (gen_expr ctx) el)
26f0219 added inheritance and packages.
ncannasse authored
192 ]
25423b1 added tvar structure : allow immediate variable renaming and no name con...
ncannasse authored
193 | TLocal { v_name = "__resources__" }, [] ->
4c6a556 added interp
ncannasse authored
194 call p (builtin p "array") (Hashtbl.fold (fun name data acc ->
a2d0acc fixed bug when resource > 64KB
ncannasse authored
195 (EObject [("name",gen_constant ctx e.epos (TString name));("data",gen_big_string ctx p data)],p) :: acc
f30f5ba removed Std.chr, Std.ord
ncannasse authored
196 ) ctx.com.resources [])
26f0219 added inheritance and packages.
ncannasse authored
197 | TField ({ eexpr = TConst TSuper; etype = t },f) , _ ->
198 let c = (match follow t with TInst (c,_) -> c | _ -> assert false) in
199 call p (builtin p "call") [
200 field p (gen_type_path p (fst c.cl_path,"@" ^ snd c.cl_path)) f;
201 this p;
e95654c added context and environment locals sharing.
ncannasse authored
202 array p (List.map (gen_expr ctx) el)
26f0219 added inheritance and packages.
ncannasse authored
203 ]
204 | _ , _ ->
440066f bugfix : allow immediate calling of neko functions (body should not eat ...
ncannasse authored
205 let e = (match gen_expr ctx e with EFunction _, _ as e -> (EBlock [e],p) | e -> e) in
206 call p e (List.map (gen_expr ctx) el)
26f0219 added inheritance and packages.
ncannasse authored
207
b135b0b added optional arguments
ncannasse authored
208 and gen_expr ctx e =
45f1b99 added neko methods
ncannasse authored
209 let p = pos ctx e.epos in
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
210 match e.eexpr with
211 | TConst c ->
45f1b99 added neko methods
ncannasse authored
212 gen_constant ctx e.epos c
2393d91 partial support for Reflect.getProperty/setProperty
ncannasse authored
213 | TLocal v when v.v_name.[0] = '$' ->
214 (EConst (Builtin (String.sub v.v_name 1 (String.length v.v_name - 1))),p)
25423b1 added tvar structure : allow immediate variable renaming and no name con...
ncannasse authored
215 | TLocal v ->
216 if v.v_capture then
217 (EArray (ident p v.v_name,int p 0),p)
e95654c added context and environment locals sharing.
ncannasse authored
218 else
25423b1 added tvar structure : allow immediate variable renaming and no name con...
ncannasse authored
219 ident p v.v_name
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
220 | TEnumField (e,f) ->
221 field p (gen_type_path p e.e_path) f
222 | TArray (e1,e2) ->
e95654c added context and environment locals sharing.
ncannasse authored
223 (EArray (gen_expr ctx e1,gen_expr ctx e2),p)
28e03ae fixed bug in neko generator w/ closures.
ncannasse authored
224 | TBinop (OpAssign,{ eexpr = TField (e1,f) },e2) ->
225 (EBinop ("=",field p (gen_expr ctx e1) f,gen_expr ctx e2),p)
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
226 | TBinop (op,e1,e2) ->
e95654c added context and environment locals sharing.
ncannasse authored
227 gen_binop ctx p op e1 e2
91c1fd5 added TClosure
ncannasse authored
228 | TField (e,f) ->
229 field p (gen_expr ctx e) f
bf97c0c closure parameters in signature
ncannasse authored
230 | TClosure (({ eexpr = TTypeExpr _ } as e),f) ->
231 field p (gen_expr ctx e) f
91c1fd5 added TClosure
ncannasse authored
232 | TClosure (e2,f) ->
233 (match follow e.etype with
234 | TFun (args,_) ->
235 let n = List.length args in
236 if n > 5 then error "Cannot create closure with more than 5 arguments" e.epos;
237 let tmp = ident p "@tmp" in
238 EBlock [
239 (EVars ["@tmp", Some (gen_expr ctx e2); "@fun", Some (field p tmp f)] , p);
07fc981 added --interp support (pass most unit tests, miss regexp/xml)
ncannasse authored
240 if ctx.macros then
241 call p (builtin p "closure") [ident p "@fun";tmp]
242 else
243 call p (ident p ("@closure" ^ string_of_int n)) [tmp;ident p "@fun"]
91c1fd5 added TClosure
ncannasse authored
244 ] , p
245 | _ -> assert false)
4f68ab6 signature => typedef
ncannasse authored
246 | TTypeExpr t ->
f721fbb added signatures.
ncannasse authored
247 gen_type_path p (t_path t)
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
248 | TParenthesis e ->
e95654c added context and environment locals sharing.
ncannasse authored
249 (EParenthesis (gen_expr ctx e),p)
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
250 | TObjectDecl fl ->
2391f1d fixed Std.string({ toString : function() return foo }) on flash9/neko
ncannasse authored
251 let hasToString = ref false in
252 let fl = List.map (fun (f,e) -> if f = "toString" then hasToString := (match follow e.etype with TFun ([],_) -> true | _ -> false); f , gen_expr ctx e) fl in
253 (EObject (if !hasToString then ("__string",ident p "@default__string") :: fl else fl),p)
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
254 | TArrayDecl el ->
e95654c added context and environment locals sharing.
ncannasse authored
255 call p (field p (ident p "Array") "new1") [array p (List.map (gen_expr ctx) el); int p (List.length el)]
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
256 | TCall (e,el) ->
e95654c added context and environment locals sharing.
ncannasse authored
257 gen_call ctx p e el
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
258 | TNew (c,_,params) ->
e95654c added context and environment locals sharing.
ncannasse authored
259 call p (field p (gen_type_path p c.cl_path) "new") (List.map (gen_expr ctx) params)
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
260 | TUnop (op,flag,e) ->
e95654c added context and environment locals sharing.
ncannasse authored
261 gen_unop ctx p op flag e
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
262 | TVars vl ->
25423b1 added tvar structure : allow immediate variable renaming and no name con...
ncannasse authored
263 (EVars (List.map (fun (v,e) ->
b135b0b added optional arguments
ncannasse authored
264 let e = (match e with
265 | None ->
25423b1 added tvar structure : allow immediate variable renaming and no name con...
ncannasse authored
266 if v.v_capture then
e95654c added context and environment locals sharing.
ncannasse authored
267 Some (call p (builtin p "array") [null p])
268 else
b135b0b added optional arguments
ncannasse authored
269 None
270 | Some e ->
e95654c added context and environment locals sharing.
ncannasse authored
271 let e = gen_expr ctx e in
25423b1 added tvar structure : allow immediate variable renaming and no name con...
ncannasse authored
272 if v.v_capture then
e95654c added context and environment locals sharing.
ncannasse authored
273 Some (call p (builtin p "array") [e])
274 else
275 Some e
b135b0b added optional arguments
ncannasse authored
276 ) in
25423b1 added tvar structure : allow immediate variable renaming and no name con...
ncannasse authored
277 v.v_name , e
e95654c added context and environment locals sharing.
ncannasse authored
278 ) vl),p)
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
279 | TFunction f ->
25423b1 added tvar structure : allow immediate variable renaming and no name con...
ncannasse authored
280 let inits = List.fold_left (fun acc (a,c) ->
dd7c21d bugfix captured var + default value
ncannasse authored
281 let acc = if a.v_capture then
25423b1 added tvar structure : allow immediate variable renaming and no name con...
ncannasse authored
282 (EBinop ("=",ident p a.v_name,call p (builtin p "array") [ident p a.v_name]),p) :: acc
e95654c added context and environment locals sharing.
ncannasse authored
283 else
284 acc
dd7c21d bugfix captured var + default value
ncannasse authored
285 in
286 match c with
287 | None | Some TNull -> acc
288 | Some c -> gen_expr ctx (Codegen.set_default ctx.com a c e.epos) :: acc
e95654c added context and environment locals sharing.
ncannasse authored
289 ) [] f.tf_args in
290 let e = gen_expr ctx f.tf_expr in
79352e2 parameter default values
ncannasse authored
291 let e = (match inits with [] -> e | _ -> EBlock (List.rev (e :: inits)),p) in
25423b1 added tvar structure : allow immediate variable renaming and no name con...
ncannasse authored
292 (EFunction (List.map arg_name f.tf_args, with_return e),p)
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
293 | TBlock el ->
25423b1 added tvar structure : allow immediate variable renaming and no name con...
ncannasse authored
294 (EBlock (List.map (gen_expr ctx) el), p)
295 | TFor (v, it, e) ->
e95654c added context and environment locals sharing.
ncannasse authored
296 let it = gen_expr ctx it in
297 let e = gen_expr ctx e in
298 let next = call p (field p (ident p "@tmp") "next") [] in
25423b1 added tvar structure : allow immediate variable renaming and no name con...
ncannasse authored
299 let next = (if v.v_capture then call p (builtin p "array") [next] else next) in
b135b0b added optional arguments
ncannasse authored
300 (EBlock
e95654c added context and environment locals sharing.
ncannasse authored
301 [(EVars ["@tmp", Some it],p);
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
302 (EWhile (call p (field p (ident p "@tmp") "hasNext") [],
8766995 array object, fixed bug in for, added TSwitch, added __string generation...
ncannasse authored
303 (EBlock [
25423b1 added tvar structure : allow immediate variable renaming and no name con...
ncannasse authored
304 (EVars [v.v_name, Some next],p);
e95654c added context and environment locals sharing.
ncannasse authored
305 e
8766995 array object, fixed bug in for, added TSwitch, added __string generation...
ncannasse authored
306 ],p)
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
307 ,NormalWhile),p)]
b135b0b added optional arguments
ncannasse authored
308 ,p)
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
309 | TIf (cond,e1,e2) ->
e95654c added context and environment locals sharing.
ncannasse authored
310 (EIf (gen_expr ctx cond,gen_expr ctx e1,(match e2 with None -> None | Some e -> Some (gen_expr ctx e))),p)
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
311 | TWhile (econd,e,flag) ->
e95654c added context and environment locals sharing.
ncannasse authored
312 (EWhile (gen_expr ctx econd, gen_expr ctx e, match flag with Ast.NormalWhile -> NormalWhile | Ast.DoWhile -> DoWhile),p)
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
313 | TTry (e,catchs) ->
59e2b50 catchs are working.
ncannasse authored
314 let rec loop = function
315 | [] -> call p (builtin p "rethrow") [ident p "@tmp"]
25423b1 added tvar structure : allow immediate variable renaming and no name con...
ncannasse authored
316 | (v,e) :: l ->
59e2b50 catchs are working.
ncannasse authored
317 let e2 = loop l in
25423b1 added tvar structure : allow immediate variable renaming and no name con...
ncannasse authored
318 let path = (match follow v.v_type with
59e2b50 catchs are working.
ncannasse authored
319 | TInst (c,_) -> Some c.cl_path
320 | TEnum (e,_) -> Some e.e_path
321 | TDynamic _ -> None
322 | _ -> assert false
323 ) in
324 let cond = (match path with
325 | None -> (EConst True,p)
ee697cb packages reorganized.
ncannasse authored
326 | Some path -> call p (field p (gen_type_path p (["neko"],"Boot")) "__instanceof") [ident p "@tmp"; gen_type_path p path]
59e2b50 catchs are working.
ncannasse authored
327 ) in
e95654c added context and environment locals sharing.
ncannasse authored
328 let id = ident p "@tmp" in
25423b1 added tvar structure : allow immediate variable renaming and no name con...
ncannasse authored
329 let id = (if v.v_capture then call p (builtin p "array") [id] else id) in
e95654c added context and environment locals sharing.
ncannasse authored
330 let e = gen_expr ctx e in
59e2b50 catchs are working.
ncannasse authored
331 (EIf (cond,(EBlock [
25423b1 added tvar structure : allow immediate variable renaming and no name con...
ncannasse authored
332 EVars [v.v_name,Some id],p;
e95654c added context and environment locals sharing.
ncannasse authored
333 e;
59e2b50 catchs are working.
ncannasse authored
334 ],p),Some e2),p)
335 in
336 let catchs = loop catchs in
d9b8674 convert neko string to haxe string on catch.
ncannasse authored
337 let catchs = (EBlock [
338 (EIf (
339 (EBinop ("==",call p (builtin p "typeof") [ident p "@tmp"],builtin p "tstring"),p),
340 (EBinop ("=",ident p "@tmp",call p (field p (ident p "String") "new") [ident p "@tmp"]),p),
341 None
342 ),p);
343 catchs;
344 ],p) in
e95654c added context and environment locals sharing.
ncannasse authored
345 (ETry (gen_expr ctx e,"@tmp",catchs),p)
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
346 | TReturn eo ->
3732184 fixed returned value.
ncannasse authored
347 (EReturn (match eo with None -> Some (null p) | Some e -> Some (gen_expr ctx e)),p)
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
348 | TBreak ->
349 (EBreak None,p)
350 | TContinue ->
351 (EContinue,p)
352 | TThrow e ->
e95654c added context and environment locals sharing.
ncannasse authored
353 call p (builtin p "throw") [gen_expr ctx e]
1da61b3 added TCast
ncannasse authored
354 | TCast (e,None) ->
355 gen_expr ctx e
356 | TCast (e1,Some t) ->
ef7bf2f fixed $t usage
ncannasse authored
357 gen_expr ctx (Codegen.default_cast ~vtmp:"@tmp" ctx.com e1 t e.etype e.epos)
7203c8b changed TMatch.
ncannasse authored
358 | TMatch (e,_,cases,eo) ->
989e344 minor fix for switch exception position
ncannasse authored
359 let p = pos ctx e.epos in
33105df added multiple expressions in 'case'.
ncannasse authored
360 let etmp = (EVars ["@tmp",Some (gen_expr ctx e)],p) in
75325cb indexed enums
ncannasse authored
361 let eindex = field p (ident p "@tmp") "index" in
33105df added multiple expressions in 'case'.
ncannasse authored
362 let gen_params params e =
363 match params with
364 | None ->
365 gen_expr ctx e
366 | Some el ->
367 let count = ref (-1) in
25423b1 added tvar structure : allow immediate variable renaming and no name con...
ncannasse authored
368 let vars = List.fold_left (fun acc v ->
33105df added multiple expressions in 'case'.
ncannasse authored
369 incr count;
370 match v with
371 | None ->
372 acc
373 | Some v ->
374 let e = (EArray (ident p "@tmp",int p (!count)),p) in
25423b1 added tvar structure : allow immediate variable renaming and no name con...
ncannasse authored
375 let e = (if v.v_capture then call p (builtin p "array") [e] else e) in
376 (v.v_name , Some e) :: acc
33105df added multiple expressions in 'case'.
ncannasse authored
377 ) [] el in
378 let e = gen_expr ctx e in
379 (EBlock [
380 (EVars ["@tmp",Some (field p (ident p "@tmp") "args")],p);
381 (match vars with [] -> null p | _ -> EVars vars,p);
382 e
383 ],p)
384 in
385 (try
386 (EBlock [
387 etmp;
7203c8b changed TMatch.
ncannasse authored
388 (ESwitch (
75325cb indexed enums
ncannasse authored
389 eindex,
33105df added multiple expressions in 'case'.
ncannasse authored
390 List.map (fun (cl,params,e2) ->
391 let cond = match cl with
75325cb indexed enums
ncannasse authored
392 | [s] -> int p s
33105df added multiple expressions in 'case'.
ncannasse authored
393 | _ -> raise Exit
a5d74a2 removed neko array limit
ncannasse authored
394 in
33105df added multiple expressions in 'case'.
ncannasse authored
395 cond , gen_params params e2
7203c8b changed TMatch.
ncannasse authored
396 ) cases,
e95654c added context and environment locals sharing.
ncannasse authored
397 (match eo with None -> None | Some e -> Some (gen_expr ctx e))
8766995 array object, fixed bug in for, added TSwitch, added __string generation...
ncannasse authored
398 ),p)
33105df added multiple expressions in 'case'.
ncannasse authored
399 ],p)
400 with
401 Exit ->
402 (EBlock [
403 etmp;
75325cb indexed enums
ncannasse authored
404 (EVars ["@index",Some eindex],p);
33105df added multiple expressions in 'case'.
ncannasse authored
405 List.fold_left (fun acc (cl,params,e2) ->
406 let cond = (match cl with
407 | [] -> assert false
408 | c :: l ->
75325cb indexed enums
ncannasse authored
409 let eq c = (EBinop ("==",ident p "@index",int p c),p) in
33105df added multiple expressions in 'case'.
ncannasse authored
410 List.fold_left (fun acc c -> (EBinop ("||",acc,eq c),p)) (eq c) l
411 ) in
412 EIf (cond,gen_params params e2,Some acc),p
413 ) (match eo with None -> null p | Some e -> (gen_expr ctx e)) (List.rev cases)
414 ],p)
415 )
7203c8b changed TMatch.
ncannasse authored
416 | TSwitch (e,cases,eo) ->
33105df added multiple expressions in 'case'.
ncannasse authored
417 let e = gen_expr ctx e in
418 let eo = (match eo with None -> None | Some e -> Some (gen_expr ctx e)) in
a5d74a2 removed neko array limit
ncannasse authored
419 try
33105df added multiple expressions in 'case'.
ncannasse authored
420 (ESwitch (
421 e,
422 List.map (fun (el,e2) ->
423 match List.map (gen_expr ctx) el with
424 | [] -> assert false
425 | [e] -> e, gen_expr ctx e2
426 | _ -> raise Exit
427 ) cases,
428 eo
429 ),p)
430 with
431 Exit ->
432 (EBlock [
433 (EVars ["@tmp",Some e],p);
434 List.fold_left (fun acc (el,e) ->
435 let cond = (match el with
436 | [] -> assert false
437 | e :: l ->
438 let eq e = (EBinop ("==",ident p "@tmp",gen_expr ctx e),p) in
439 List.fold_left (fun acc e -> (EBinop ("||",acc,eq e),p)) (eq e) l
440 ) in
441 EIf (cond,gen_expr ctx e,Some acc),p
442 ) (match eo with None -> null p | Some e -> e) (List.rev cases)
443 ],p)
c394634 added neko instanceof.
ncannasse authored
444
e95654c added context and environment locals sharing.
ncannasse authored
445 let gen_method ctx p c acc =
45f1b99 added neko methods
ncannasse authored
446 ctx.curmethod <- c.cf_name;
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
447 match c.cf_expr with
b135b0b added optional arguments
ncannasse authored
448 | None ->
b1f11ea changed cf_get & cf_set to cf_kind
ncannasse authored
449 (match c.cf_kind with
450 | Var { v_read = AccResolve } -> acc
451 | _ -> (c.cf_name, null p) :: acc)
a5d74a2 removed neko array limit
ncannasse authored
452 | Some e ->
6aec611 strings-as-objects and class constructors working.
ncannasse authored
453 match e.eexpr with
5b3522d priority for loadLazy
ncannasse authored
454 | TCall ({ eexpr = TField ({ eexpr = TTypeExpr (TClassDecl { cl_path = (["neko"],"Lib") }) }, load)},[{ eexpr = TConst (TString m) };{ eexpr = TConst (TString f) };{ eexpr = TConst (TInt n) }]) when load = "load" || load = "loadLazy" ->
6f2dc0b fixed loadLazy
ncannasse authored
455 let p = pos ctx e.epos in
456 let e = call p (EField (builtin p "loader","loadprim"),p) [(EBinop ("+",(EBinop ("+",str p m,str p "@"),p),str p f),p); (EConst (Int (Int32.to_int n)),p)] in
457 let e = (if load = "load" then e else (ETry (e,"@e",call p (ident p "@lazy_error") [ident p "@e"]),p)) in
458 (c.cf_name, e) :: acc
e95654c added context and environment locals sharing.
ncannasse authored
459 | TFunction _ -> ((if c.cf_name = "new" then "__construct__" else c.cf_name), gen_expr ctx e) :: acc
133c3ae fixed metadata.
ncannasse authored
460 | _ -> (c.cf_name, null p) :: acc
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
461
b135b0b added optional arguments
ncannasse authored
462 let gen_class ctx c =
45f1b99 added neko methods
ncannasse authored
463 ctx.curclass <- s_type_path c.cl_path;
464 ctx.curmethod <- "$init";
465 let p = pos ctx c.cl_pos in
ee2ce73 added some positions and little change in structures.
ncannasse authored
466 let clpath = gen_type_path p (fst c.cl_path,"@" ^ snd c.cl_path) in
467 let stpath = gen_type_path p c.cl_path in
35d146b changed constructor storage.
ncannasse authored
468 let fnew = (match c.cl_constructor with
469 | Some f ->
470 (match follow f.cf_type with
6aec611 strings-as-objects and class constructors working.
ncannasse authored
471 | TFun (args,_) ->
25423b1 added tvar structure : allow immediate variable renaming and no name con...
ncannasse authored
472 let params = List.map (fun (n,_,_) -> n) args in
e95654c added context and environment locals sharing.
ncannasse authored
473 gen_method ctx p f ["new",(EFunction (params,(EBlock [
5989c8c neko 1.2 / prototypes.
ncannasse authored
474 (EVars ["@o",Some (call p (builtin p "new") [null p])],p);
475 (call p (builtin p "objsetproto") [ident p "@o"; clpath]);
6aec611 strings-as-objects and class constructors working.
ncannasse authored
476 (call p (builtin p "call") [field p (this p) "__construct__"; ident p "@o"; array p (List.map (ident p) params)]);
477 (EReturn (Some (ident p "@o")),p)
478 ],p)),p)]
35d146b changed constructor storage.
ncannasse authored
479 | _ -> [])
480 | None ->
6aec611 strings-as-objects and class constructors working.
ncannasse authored
481 []
482 ) in
8766995 array object, fixed bug in for, added TSwitch, added __string generation...
ncannasse authored
483 let fstring = (try
484 let f = PMap.find "toString" c.cl_fields in
485 match follow f.cf_type with
2391f1d fixed Std.string({ toString : function() return foo }) on flash9/neko
ncannasse authored
486 | TFun ([],_) -> ["__string",ident p "@default__string"]
8766995 array object, fixed bug in for, added TSwitch, added __string generation...
ncannasse authored
487 | _ -> []
b135b0b added optional arguments
ncannasse authored
488 with Not_found ->
8766995 array object, fixed bug in for, added TSwitch, added __string generation...
ncannasse authored
489 []
82621f7 better enums + serialization support.
ncannasse authored
490 ) in
491 let fserialize = "__serialize" , ident p "@serialize" in
cc1c2ff removed __construct__ and class.toString, __super__ and __interfaces__ a...
ncannasse authored
492 let others = (match c.cl_implements with
493 | [] -> []
494 | l -> ["__interfaces__",array p (List.map (fun (c,_) -> gen_type_path p c.cl_path) l)]
495 ) @ (match c.cl_super with
496 | None -> []
497 | Some (c,_) -> ["__super__", gen_type_path p c.cl_path]
498 ) in
cf69a59 fix neko getEnumConstructs
ncannasse authored
499 let build (f,e) = (EBinop ("=",field p (ident p "@tmp") f,e),p) in
500 let tmp = (EVars ["@tmp",Some (call p (builtin p "new") [null p])],p) in
501 let estat = (EBinop ("=", stpath, ident p "@tmp"),p) in
2393d91 partial support for Reflect.getProperty/setProperty
ncannasse authored
502 let gen_props props = (EObject (List.map (fun (n,s) -> n,str p s) props),p) in
503 let sprops = (match Codegen.get_properties c.cl_ordered_statics with
504 | [] -> []
505 | l -> ["__properties__",gen_props l]
506 ) in
cf69a59 fix neko getEnumConstructs
ncannasse authored
507 let sfields = List.map build
508 (
2393d91 partial support for Reflect.getProperty/setProperty
ncannasse authored
509 ("prototype",clpath) :: sprops @
cc1c2ff removed __construct__ and class.toString, __super__ and __interfaces__ a...
ncannasse authored
510 PMap.fold (gen_method ctx p) c.cl_statics (fnew @ others)
cf69a59 fix neko getEnumConstructs
ncannasse authored
511 )
512 in
513 let eclass = (EBinop ("=", clpath, ident p "@tmp"),p) in
514 let mfields = List.map build
515 (PMap.fold (gen_method ctx p) c.cl_fields (fserialize :: fstring))
516 in
2393d91 partial support for Reflect.getProperty/setProperty
ncannasse authored
517 let props = Codegen.get_properties c.cl_ordered_fields in
c2a870a added @classes generation.
ncannasse authored
518 let emeta = (EBinop ("=",field p clpath "__class__",stpath),p) ::
2393d91 partial support for Reflect.getProperty/setProperty
ncannasse authored
519 (match props with
520 | [] -> []
521 | _ ->
522 let props = gen_props props in
523 let props = (match c.cl_super with
524 | Some (csup,_) when Codegen.has_properties csup ->
525 (EBlock [
526 (EVars ["@tmp",Some props],p);
527 call p (builtin p "objsetproto") [ident p "@tmp";field p (field p (gen_type_path p csup.cl_path) "prototype") "__properties__"];
528 ident p "@tmp"
529 ],p)
530 | _ -> props
531 ) in
532 [EBinop ("=",field p clpath "__properties__",props),p])
533 @ match c.cl_path with
b16b185 fixed native serialization problems.
ncannasse authored
534 | [] , name -> [(EBinop ("=",field p (ident p "@classes") name,ident p name),p)]
c2a870a added @classes generation.
ncannasse authored
535 | _ -> []
536 in
9f3c7e0 added Class support for makeExpr
ncannasse authored
537 let emeta = if ctx.macros then
538 (EBinop ("=",field p stpath "__ct__",call p (builtin p "typewrap") [Obj.magic (TClassDecl c)]),p) :: emeta
539 else
540 emeta
541 in
cf69a59 fix neko getEnumConstructs
ncannasse authored
542 let eextends = (match c.cl_super with
543 | None -> []
544 | Some (c,_) ->
545 let esuper = gen_type_path p (fst c.cl_path,"@" ^ snd c.cl_path) in
546 [call p (builtin p "objsetproto") [clpath; esuper]]
547 ) in
548 (EBlock (tmp :: eclass :: mfields @ tmp :: estat :: sfields @ eextends @ emeta),p)
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
549
45f1b99 added neko methods
ncannasse authored
550 let gen_enum_constr ctx path c =
551 ctx.curmethod <- c.ef_name;
552 let p = pos ctx c.ef_pos in
3f5469c added Enum.toString
ncannasse authored
553 (EBinop ("=",field p path c.ef_name, match follow c.ef_type with
554 | TFun (params,_) ->
25423b1 added tvar structure : allow immediate variable renaming and no name con...
ncannasse authored
555 let params = List.map (fun (n,_,_) -> n) params in
3f5469c added Enum.toString
ncannasse authored
556 (EFunction (params,
82621f7 better enums + serialization support.
ncannasse authored
557 (EBlock [
558 (EVars ["@tmp",Some (EObject [
559 "tag" , str p c.ef_name;
75325cb indexed enums
ncannasse authored
560 "index" , int p c.ef_index;
82621f7 better enums + serialization support.
ncannasse authored
561 "args" , array p (List.map (ident p) params);
562 ],p)],p);
563 call p (builtin p "objsetproto") [ident p "@tmp"; field p path "prototype"];
564 ident p "@tmp";
3f5469c added Enum.toString
ncannasse authored
565 ],p)
566 ),p)
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
567 | _ ->
82621f7 better enums + serialization support.
ncannasse authored
568 (EBlock [
75325cb indexed enums
ncannasse authored
569 (EVars ["@tmp",Some (EObject ["tag" , str p c.ef_name; "index", int p c.ef_index; "__serialize" , ident p "@tag_serialize"],p)],p);
a5d74a2 removed neko array limit
ncannasse authored
570 call p (builtin p "objsetproto") [ident p "@tmp"; field p path "prototype"];
82621f7 better enums + serialization support.
ncannasse authored
571 ident p "@tmp";
3f5469c added Enum.toString
ncannasse authored
572 ],p)
573 ),p)
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
574
45f1b99 added neko methods
ncannasse authored
575 let gen_enum ctx e =
576 ctx.curclass <- s_type_path e.e_path;
577 ctx.curmethod <- "$init";
578 let p = pos ctx e.e_pos in
885a64f macros working !
ncannasse authored
579 let path = gen_type_path p e.e_path in
580 let uname = (EConst (Ident (gen_global_name ctx e.e_path)),p) in
3f5469c added Enum.toString
ncannasse authored
581 (EBlock (
885a64f macros working !
ncannasse authored
582 (EBinop ("=",uname, call p (builtin p "new") [null p]),p) ::
583 (EBinop ("=",path, uname),p) ::
584 (EBinop ("=",field p uname "prototype", (EObject [
585 "__enum__" , uname;
82621f7 better enums + serialization support.
ncannasse authored
586 "__serialize" , ident p "@serialize";
587 "__string" , ident p "@enum_to_string"
588 ],p)),p) ::
885a64f macros working !
ncannasse authored
589 pmap_list (gen_enum_constr ctx uname) e.e_constrs @
cae4e7e added metadata api
ncannasse authored
590 (match e.e_path with
b16b185 fixed native serialization problems.
ncannasse authored
591 | [] , name -> [EBinop ("=",field p (ident p "@classes") name,ident p name),p]
a2b9000 bugfix metadata with parameters for enums
ncannasse authored
592 | _ -> [])
3f5469c added Enum.toString
ncannasse authored
593 ),p)
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
594
ae2decd extern enums
ncannasse authored
595 let gen_type ctx t acc =
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
596 match t with
b135b0b added optional arguments
ncannasse authored
597 | TClassDecl c ->
7ac9ec5 __init__ support.
ncannasse authored
598 (match c.cl_init with
599 | None -> ()
4b030ab fixed curclass/curmethod in __init__
ncannasse authored
600 | Some e -> ctx.inits <- (c,e) :: ctx.inits);
a3c7874 replaced @Main class by common.main expression
ncannasse authored
601 if c.cl_extern then
ae2decd extern enums
ncannasse authored
602 acc
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
603 else
ae2decd extern enums
ncannasse authored
604 gen_class ctx c :: acc
b135b0b added optional arguments
ncannasse authored
605 | TEnumDecl e ->
ae2decd extern enums
ncannasse authored
606 if e.e_extern then
607 acc
852fae8 don't generate Bool (fail to compile pure neko code).
ncannasse authored
608 else
45f1b99 added neko methods
ncannasse authored
609 gen_enum ctx e :: acc
4f68ab6 signature => typedef
ncannasse authored
610 | TTypeDecl t ->
ae2decd extern enums
ncannasse authored
611 acc
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
612
e95654c added context and environment locals sharing.
ncannasse authored
613 let gen_static_vars ctx t =
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
614 match t with
4f68ab6 signature => typedef
ncannasse authored
615 | TEnumDecl _ | TTypeDecl _ -> []
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
616 | TClassDecl c ->
617 if c.cl_extern then
618 []
619 else
3960c84 enforced static variable generation order.
ncannasse authored
620 List.fold_right (fun f acc ->
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
621 match f.cf_expr with
622 | None -> acc
623 | Some e ->
624 match e.eexpr with
625 | TFunction _ -> acc
b135b0b added optional arguments
ncannasse authored
626 | _ ->
45f1b99 added neko methods
ncannasse authored
627 ctx.curclass <- s_type_path c.cl_path;
628 ctx.curmethod <- "$statics";
629 let p = pos ctx e.epos in
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
630 (EBinop ("=",
631 (field p (gen_type_path p c.cl_path) f.cf_name),
e95654c added context and environment locals sharing.
ncannasse authored
632 gen_expr ctx e
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
633 ),p) :: acc
3960c84 enforced static variable generation order.
ncannasse authored
634 ) c.cl_ordered_statics []
ee54bf1 added. style missing inheritance, switch, and a few more things
ncannasse authored
635
885a64f macros working !
ncannasse authored
636 let gen_package ctx t =
26f0219 added inheritance and packages.
ncannasse authored
637 let rec loop acc p =
638 match p with
639 | [] -> []
640 | x :: l ->
641 let path = acc @ [x] in
885a64f macros working !
ncannasse authored
642 if not (Hashtbl.mem ctx.packages path) then begin
45f1b99 added neko methods
ncannasse authored
643 let p = pos ctx (match t with TClassDecl c -> c.cl_pos | TEnumDecl e -> e.e_pos | TTypeDecl t -> t.t_pos) in
b135b0b added optional arguments
ncannasse authored
644 let e = (EBinop ("=",gen_type_path p (acc,x),call p (builtin p "new") [null p]),p) in
885a64f macros working !
ncannasse authored
645 Hashtbl.add ctx.packages path ();
c2a870a added @classes generation.
ncannasse authored
646 (match acc with
647 | [] ->
b16b185 fixed native serialization problems.
ncannasse authored
648 let reg = (EBinop ("=",field p (ident p "@classes") x,ident p x),p) in
c2a870a added @classes generation.
ncannasse authored
649 e :: reg :: loop path l
650 | _ ->
651 e :: loop path l)
26f0219 added inheritance and packages.
ncannasse authored
652 end else
653 loop path l
654 in
f721fbb added signatures.
ncannasse authored
655 loop [] (fst (t_path t))
26f0219 added inheritance and packages.
ncannasse authored
656
f30f5ba removed Std.chr, Std.ord
ncannasse authored
657 let gen_boot ctx =
5110b05 added -res
ncannasse authored
658 (EBlock [
c2a870a added @classes generation.
ncannasse authored
659 EBinop ("=",field null_pos (gen_type_path null_pos (["neko"],"Boot")) "__classes",ident null_pos "@classes"),null_pos;
b16b185 fixed native serialization problems.
ncannasse authored
660 call null_pos (field null_pos (gen_type_path null_pos (["neko"],"Boot")) "__init") [];
5110b05 added -res
ncannasse authored
661 ],null_pos)
6aec611 strings-as-objects and class constructors working.
ncannasse authored
662
45f1b99 added neko methods
ncannasse authored
663 let gen_name ctx acc t =
8a434c6 added metadata __name__ and Class.toString repr.
ncannasse authored
664 match t with
ae2decd extern enums
ncannasse authored
665 | TEnumDecl e when e.e_extern ->
ce2ba20 different Void & Dynamic handling.
ncannasse authored
666 acc
9429a54 added enums __name__
ncannasse authored
667 | TEnumDecl e ->
45f1b99 added neko methods
ncannasse authored
668 let p = pos ctx e.e_pos in
9429a54 added enums __name__
ncannasse authored
669 let name = fst e.e_path @ [snd e.e_path] in
45f1b99 added neko methods
ncannasse authored
670 let arr = call p (field p (ident p "Array") "new1") [array p (List.map (fun n -> gen_constant ctx e.e_pos (TString n)) name); int p (List.length name)] in
cf69a59 fix neko getEnumConstructs
ncannasse authored
671 let path = gen_type_path p e.e_path in
672 let setname = (EBinop ("=",field p path "__ename__",arr),p) in
673 let arr = call p (field p (ident p "Array") "new1") [array p (List.map (fun n -> gen_constant ctx e.e_pos (TString n)) e.e_names); int p (List.length e.e_names)] in
4c6a556 added interp
ncannasse authored
674 let setconstrs = (EBinop ("=", field p path "__constructs__", arr),p) in
a2b9000 bugfix metadata with parameters for enums
ncannasse authored
675 let meta = (match Codegen.build_metadata ctx.com (TEnumDecl e) with
676 | None -> []
677 | Some e -> [EBinop ("=",field p path "__meta__", gen_expr ctx e),p]
678 ) in
b370411 added Context.makeExpr + BaseType.module
ncannasse authored
679 let meta = if ctx.macros then
680 (EBinop ("=",field p path "__et__",call p (builtin p "typewrap") [Obj.magic t]),p) :: meta
681 else
682 meta
683 in
a2b9000 bugfix metadata with parameters for enums
ncannasse authored
684 setname :: setconstrs :: meta @ acc
b135b0b added optional arguments
ncannasse authored
685 | TClassDecl c ->
a3c7874 replaced @Main class by common.main expression
ncannasse authored
686 if c.cl_extern then
8a434c6 added metadata __name__ and Class.toString repr.
ncannasse authored
687 acc
688 else
45f1b99 added neko methods
ncannasse authored
689 let p = pos ctx c.cl_pos in
8a434c6 added metadata __name__ and Class.toString repr.
ncannasse authored
690 let name = fst c.cl_path @ [snd c.cl_path] in
45f1b99 added neko methods
ncannasse authored
691 let arr = call p (field p (ident p "Array") "new1") [array p (List.map (fun n -> gen_constant ctx c.cl_pos (TString n)) name); int p (List.length name)] in
b135b0b added optional arguments
ncannasse authored
692 (EBinop ("=",field p (gen_type_path p c.cl_path) "__name__",arr),p) ::
cc1c2ff removed __construct__ and class.toString, __super__ and __interfaces__ a...
ncannasse authored
693 (match c.cl_implements with
694 | [] -> acc
695 | l ->
696 let interf = field p (gen_type_path p c.cl_path) "__interfaces__" in
697 (EBinop ("=",interf, call p (field p (ident p "Array") "new1") [interf; int p (List.length l)]),p) :: acc)
4f68ab6 signature => typedef
ncannasse authored
698 | TTypeDecl _ ->
f721fbb added signatures.
ncannasse authored
699 acc
8a434c6 added metadata __name__ and Class.toString repr.
ncannasse authored
700
c406411 allowed ndlls with haxelib.
ncannasse authored
701 let generate_libs_init = function
702 | [] -> ""
703 | libs ->
a5d74a2 removed neko array limit
ncannasse authored
704 let boot =
8e7d15b system-independant runtime haxelib repository resolution.
ncannasse authored
705 "var @s = $loader.loadprim(\"std@sys_string\",0)();" ^
706 "var @env = $loader.loadprim(\"std@get_env\",1);" ^
707 "var @b = if( @s == \"Windows\" ) " ^
708 "@env(\"HAXEPATH\") + \"lib\\\\\"" ^
de4a581 minor
ncannasse authored
709 "else try $loader.loadprim(\"std@file_contents\",1)(@env(\"HOME\")+\"/.haxelib\") + \"/\"" ^
8e7d15b system-independant runtime haxelib repository resolution.
ncannasse authored
710 "catch e if( @s == \"Linux\" ) \"/usr/lib/haxe/lib/\" else \"/usr/local/lib/haxe/lib/\";" ^
711 "@s = @s + \"/\";"
712 in
c406411 allowed ndlls with haxelib.
ncannasse authored
713 List.fold_left (fun acc l ->
133607a allowed haxelib "dev" mode.
ncannasse authored
714 let full_path = l.[0] = '/' || l.[1] = ':' in
715 acc ^ "$loader.path = $array(" ^ (if full_path then "" else "@b + ") ^ "\"" ^ Nast.escape l ^ "\" + @s,$loader.path);"
8e7d15b system-independant runtime haxelib repository resolution.
ncannasse authored
716 ) boot libs
c406411 allowed ndlls with haxelib.
ncannasse authored
717
cd3da56 macros interp working (still need to pass unit tests)
ncannasse authored
718 let new_context com macros =
4c6a556 added interp
ncannasse authored
719 {
720 com = com;
885a64f macros working !
ncannasse authored
721 globals = Hashtbl.create 0;
722 curglobal = 0;
723 packages = Hashtbl.create 0;
cd3da56 macros interp working (still need to pass unit tests)
ncannasse authored
724 macros = macros;
45f1b99 added neko methods
ncannasse authored
725 curclass = "$boot";
726 curmethod = "$init";
7ac9ec5 __init__ support.
ncannasse authored
727 inits = [];
4c6a556 added interp
ncannasse authored
728 }
729
730 let header() =
731 let p = { psource = "<header>"; pline = 1 } in
732 let fields l =
733 let rec loop = function
734 | [] -> assert false
735 | [x] -> ident p x
736 | x :: l -> field p (loop l) x
737 in
738 loop (List.rev l)
739 in
740 let func pl e =
741 (EFunction (pl,(EReturn (Some e),p)),p)
742 in
743 let inits = [
744 "@classes",call p (builtin p "new") [null p];
745 "@enum_to_string",func [] (call p (fields ["neko";"Boot";"__enum_str"]) [this p]);
746 "@serialize",func [] (call p (fields ["neko";"Boot";"__serialize"]) [this p]);
747 "@tag_serialize",func [] (call p (fields ["neko";"Boot";"__tagserialize"]) [this p]);
748 "@lazy_error",func ["e"] (call p (builtin p "varargs") [func ["_"] (call p (builtin p "throw") [ident p "e"])]);
2391f1d fixed Std.string({ toString : function() return foo }) on flash9/neko
ncannasse authored
749 "@default__string",func [] (EBlock [
750 EVars ["@s",Some (call p (field p (this p) "toString") [])] ,p;
751 EIf ((EBinop ("!=",call p (builtin p "typeof") [ident p "@s"],builtin p "tobject"),p),(EReturn (Some (null p)),p),None),p;
752 EReturn (Some (field p (ident p "@s") "__s")),p;
753 ],p)
4c6a556 added interp
ncannasse authored
754 ] in
755 let inits = inits @ List.map (fun nargs ->
756 let args = Array.to_list (Array.init nargs (fun i -> Printf.sprintf "%c" (char_of_int (int_of_char 'a' + i)))) in
757 let efun = (EFunction (args,(EBlock [
39a69b0 bugfix
ncannasse authored
758 (EBinop ("=",(EConst This,p),ident p "@this"),p);
4c6a556 added interp
ncannasse authored
759 call p (ident p "@fun") (List.map (ident p) args);
760 ],p)),p) in
761 let eif = EIf ((EBinop ("==",ident p "@fun",null p),p),null p,Some efun) in
762 let e = func ["@this";"@fun"] (eif,p) in
763 "@closure" ^ string_of_int nargs, e
764 ) [0;1;2;3;4;5] in
765 List.map (fun (v,e)-> EBinop ("=",ident p v,e),p) inits
766
885a64f macros working !
ncannasse authored
767 let build ctx types =
768 let packs = List.concat (List.map (gen_package ctx) types) in
769 let names = List.fold_left (gen_name ctx) [] types in
770 let methods = List.rev (List.fold_left (fun acc t -> gen_type ctx t acc) [] types) in
f30f5ba removed Std.chr, Std.ord
ncannasse authored
771 let boot = gen_boot ctx in
4c6a556 added interp
ncannasse authored
772 let inits = List.map (fun (c,e) ->
4b030ab fixed curclass/curmethod in __init__
ncannasse authored
773 ctx.curclass <- s_type_path c.cl_path;
774 ctx.curmethod <- "__init__";
775 gen_expr ctx e
776 ) (List.rev ctx.inits) in
885a64f macros working !
ncannasse authored
777 ctx.inits <- [];
778 let vars = List.concat (List.map (gen_static_vars ctx) types) in
779 packs @ methods @ boot :: names @ inits @ vars
780
24debd7 added cache file support and wait on socket
ncannasse authored
781 let generate com =
885a64f macros working !
ncannasse authored
782 let ctx = new_context com false in
783 let t = Common.timer "neko generation" in
24debd7 added cache file support and wait on socket
ncannasse authored
784 let libs = (ENeko (generate_libs_init com.neko_libs) , { psource = "<header>"; pline = 1; }) in
885a64f macros working !
ncannasse authored
785 let el = build ctx com.types in
a3c7874 replaced @Main class by common.main expression
ncannasse authored
786 let emain = (match com.main with None -> [] | Some e -> [gen_expr ctx e]) in
787 let e = (EBlock ((header()) @ libs :: el @ emain), null_pos) in
3e965e4 2.0 base :
ncannasse authored
788 let neko_file = (try Filename.chop_extension com.file with _ -> com.file) ^ ".neko" in
9546a08 use binast
ncannasse authored
789 let ch = IO.output_channel (open_out_bin neko_file) in
842a18f removed --neko-source (only use -D neko-source)
ncannasse authored
790 let source = Common.defined com "neko-source" in
af031a9 fix with untyped.
ncannasse authored
791 if source then Nxml.write ch (Nxml.to_xml e) else Binast.write ch e;
70c028e added nekovm command.
ncannasse authored
792 IO.close_out ch;
4c6a556 added interp
ncannasse authored
793 t();
b16c11e fixed minor bugs.
ncannasse authored
794 let command cmd = try Sys.command cmd with _ -> -1 in
54f48f6 minor commandline flags changes (added -debug).
ncannasse authored
795 if source then begin
d763fbb allow spaces in neko output file
ncannasse authored
796 if command ("nekoc -p \"" ^ neko_file ^ "\"") <> 0 then failwith "Failed to print neko code";
852fae8 don't generate Bool (fail to compile pure neko code).
ncannasse authored
797 Sys.remove neko_file;
3e965e4 2.0 base :
ncannasse authored
798 Sys.rename ((try Filename.chop_extension com.file with _ -> com.file) ^ "2.neko") neko_file;
7b0a81b prioritize neko.Lib.load calls
ncannasse authored
799 end;
3e965e4 2.0 base :
ncannasse authored
800 let c = Common.timer "neko compilation" in
41aab87 fix
ncannasse authored
801 if command ("nekoc \"" ^ neko_file ^ "\"") <> 0 then failwith "Neko compilation failure";
76dcc33 added timers
ncannasse authored
802 c();
0185631 preserve neko output file extension
ncannasse authored
803 let output = Filename.chop_extension neko_file ^ ".n" in
72fd3a6 minor fix
ncannasse authored
804 if output <> com.file then begin
805 (try Sys.remove com.file with _ -> ());
806 Sys.rename output com.file;
807 end;
54f48f6 minor commandline flags changes (added -debug).
ncannasse authored
808 if not source then Sys.remove neko_file
Something went wrong with that request. Please try again.