Forráskód Böngészése

use an int32 after typing, added negative numbers optimization, added error when negative range.

Nicolas Cannasse 19 éve
szülő
commit
5afc7d31aa
5 módosított fájl, 24 hozzáadás és 13 törlés
  1. 1 1
      genjs.ml
  2. 8 7
      genneko.ml
  3. 1 1
      genswf8.ml
  4. 1 1
      type.ml
  5. 13 3
      typer.ml

+ 1 - 1
genjs.ml

@@ -111,7 +111,7 @@ let handle_break ctx e =
 let this ctx = if ctx.in_value then "$this" else "this"
 let this ctx = if ctx.in_value then "$this" else "this"
 
 
 let gen_constant ctx p = function
 let gen_constant ctx p = function
-	| TInt s
+	| TInt i -> print ctx "%ld" i
 	| TFloat s -> spr ctx s
 	| TFloat s -> spr ctx s
 	| TString s -> 
 	| TString s -> 
 		if String.contains s '\000' then Typer.error "A String cannot contain \\0 characters" p;
 		if String.contains s '\000' then Typer.error "A String cannot contain \\0 characters" p;

+ 8 - 7
genneko.ml

@@ -128,9 +128,10 @@ let gen_type_path p (path,t) =
 		let epath = List.fold_left (fun e path -> field p e path) (ident p path) l in
 		let epath = List.fold_left (fun e path -> field p e path) (ident p path) l in
 		field p epath t
 		field p epath t
 
 
-let gen_constant p c =
+let gen_constant pe c =
+	let p = pos pe in
 	match c with
 	match c with
-	| TInt i -> (try int p (int_of_string i) with _ -> (EConst (Float i),p))
+	| TInt i -> (try int p (Int32.to_int i) with _ -> Typer.error "This integer is too big to be compiled to a Neko 31-bit integer. Please use a Float instead" pe)
 	| TFloat f -> (EConst (Float f),p)
 	| TFloat f -> (EConst (Float f),p)
 	| TString s -> call p (field p (ident p "String") "new") [str p s]
 	| TString s -> call p (field p (ident p "String") "new") [str p s]
 	| TBool b -> (EConst (if b then True else False),p)
 	| TBool b -> (EConst (if b then True else False),p)
@@ -200,7 +201,7 @@ and gen_expr ctx e =
 	let p = pos e.epos in
 	let p = pos e.epos in
 	match e.eexpr with
 	match e.eexpr with
 	| TConst c ->
 	| TConst c ->
-		gen_constant p c
+		gen_constant e.epos c
 	| TLocal s ->
 	| TLocal s ->
 		let isref = try PMap.find s ctx.locals with Not_found -> false in
 		let isref = try PMap.find s ctx.locals with Not_found -> false in
 		if isref then
 		if isref then
@@ -388,7 +389,7 @@ let gen_method ctx p c acc =
 	| Some e ->
 	| Some e ->
 		match e.eexpr with
 		match e.eexpr with
 		| TCall ({ eexpr = TField ({ eexpr = TType (TClassDecl { cl_path = (["neko"],"Lib") }) }, "load")},[{ eexpr = TConst (TString m) };{ eexpr = TConst (TString f) };{ eexpr = TConst (TInt n) }]) ->
 		| TCall ({ eexpr = TField ({ eexpr = TType (TClassDecl { cl_path = (["neko"],"Lib") }) }, "load")},[{ eexpr = TConst (TString m) };{ eexpr = TConst (TString f) };{ eexpr = TConst (TInt n) }]) ->
-			(c.cf_name, call (pos e.epos) (EField (builtin p "loader","loadprim"),p) [(EBinop ("+",(EBinop ("+",str p m,str p "@"),p),str p f),p); (EConst (Int (int_of_string n)),p)]) :: acc
+			(c.cf_name, call (pos e.epos) (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)]) :: acc
 		| TFunction _ -> ((if c.cf_name = "new" then "__construct__" else c.cf_name), gen_expr ctx e) :: acc
 		| TFunction _ -> ((if c.cf_name = "new" then "__construct__" else c.cf_name), gen_expr ctx e) :: acc
 		| _ -> (c.cf_name, null p) :: acc
 		| _ -> (c.cf_name, null p) :: acc
 
 
@@ -548,7 +549,7 @@ let gen_package h t =
 	loop [] (fst (t_path t))
 	loop [] (fst (t_path t))
 
 
 let gen_boot hres =
 let gen_boot hres =
-	let loop name data acc = (name , gen_constant null_pos (TString data)) :: acc in
+	let loop name data acc = (name , gen_constant Ast.null_pos (TString data)) :: acc in
 	let objres = (EObject (Hashtbl.fold loop hres []),null_pos) in
 	let objres = (EObject (Hashtbl.fold loop hres []),null_pos) in
 	(EBlock [
 	(EBlock [
 		call null_pos (field null_pos (gen_type_path null_pos (["neko"],"Boot")) "__init") [];
 		call null_pos (field null_pos (gen_type_path null_pos (["neko"],"Boot")) "__init") [];
@@ -561,7 +562,7 @@ let gen_name acc t =
 	| TEnumDecl e ->
 	| TEnumDecl e ->
 		let p = pos e.e_pos in
 		let p = pos e.e_pos in
 		let name = fst e.e_path @ [snd e.e_path] in
 		let name = fst e.e_path @ [snd e.e_path] in
-		let arr = call p (field p (ident p "Array") "new1") [array p (List.map (fun n -> gen_constant p (TString n)) name); int p (List.length name)] in
+		let arr = call p (field p (ident p "Array") "new1") [array p (List.map (fun n -> gen_constant e.e_pos (TString n)) name); int p (List.length name)] in
 		(EBinop ("=",field p (gen_type_path p e.e_path) "__ename__",arr),p) :: acc
 		(EBinop ("=",field p (gen_type_path p e.e_path) "__ename__",arr),p) :: acc
 	| TClassDecl c -> 
 	| TClassDecl c -> 
 		if c.cl_extern then
 		if c.cl_extern then
@@ -570,7 +571,7 @@ let gen_name acc t =
 			let p = pos c.cl_pos in
 			let p = pos c.cl_pos in
 			let name = fst c.cl_path @ [snd c.cl_path] in
 			let name = fst c.cl_path @ [snd c.cl_path] in
 			let interf = field p (gen_type_path p c.cl_path) "__interfaces__" in
 			let interf = field p (gen_type_path p c.cl_path) "__interfaces__" in
-			let arr = call p (field p (ident p "Array") "new1") [array p (List.map (fun n -> gen_constant p (TString n)) name); int p (List.length name)] in
+			let arr = call p (field p (ident p "Array") "new1") [array p (List.map (fun n -> gen_constant c.cl_pos (TString n)) name); int p (List.length name)] in
 			(EBinop ("=",field p (gen_type_path p c.cl_path) "__name__",arr),p) :: 
 			(EBinop ("=",field p (gen_type_path p c.cl_path) "__name__",arr),p) :: 
 			(EBinop ("=",interf, call p (field p (ident p "Array") "new1") [interf; int p (List.length c.cl_implements)]),p) ::
 			(EBinop ("=",interf, call p (field p (ident p "Array") "new1") [interf; int p (List.length c.cl_implements)]),p) ::
 			acc
 			acc

+ 1 - 1
genswf8.ml

@@ -492,7 +492,7 @@ let rec gen_big_string ctx s =
 
 
 let rec gen_constant ctx c p =
 let rec gen_constant ctx c p =
 	match c with
 	match c with
-	| TInt s -> (try push ctx [VInt32 (Int32.of_string s)] with _ -> gen_constant ctx (TFloat s) p)
+	| TInt i -> push ctx [VInt32 i]
 	| TFloat s -> push ctx [VFloat (try float_of_string s with _ -> error p)]
 	| TFloat s -> push ctx [VFloat (try float_of_string s with _ -> error p)]
 	| TString s -> 
 	| TString s -> 
 		if String.contains s '\000' then Typer.error "A String cannot contain \\0 characters" p;
 		if String.contains s '\000' then Typer.error "A String cannot contain \\0 characters" p;

+ 1 - 1
type.ml

@@ -35,7 +35,7 @@ type t =
 	| TLazy of (unit -> t) ref
 	| TLazy of (unit -> t) ref
 
 
 and tconstant =
 and tconstant =
-	| TInt of string
+	| TInt of int32
 	| TFloat of string
 	| TFloat of string
 	| TString of string
 	| TString of string
 	| TBool of bool
 	| TBool of bool

+ 13 - 3
typer.ml

@@ -776,7 +776,11 @@ let type_type ctx tpath p =
 
 
 let type_constant ctx c p =
 let type_constant ctx c p =
 	match c with
 	match c with
-	| Int i -> mk (TConst (TInt i)) (t_int ctx) p
+	| Int s -> 
+		(try 
+			mk (TConst (TInt (Int32.of_string s))) (t_int ctx) p
+		with
+			_ -> mk (TConst (TFloat s)) (t_float ctx) p)
 	| Float f -> mk (TConst (TFloat f)) (t_float ctx) p
 	| Float f -> mk (TConst (TFloat f)) (t_float ctx) p
 	| String s -> mk (TConst (TString s)) (t_string ctx) p
 	| String s -> mk (TConst (TString s)) (t_string ctx) p
 	| Regexp (r,opt) ->
 	| Regexp (r,opt) ->
@@ -1076,7 +1080,9 @@ and type_unop ctx op flag e p =
 				t_int ctx
 				t_int ctx
 			end
 			end
 		) in
 		) in
-		mk (TUnop (op,flag,e)) t p
+		(match op, e.eexpr with
+		| Neg , TConst (TInt i) -> mk (TConst (TInt (Int32.neg i))) t p
+		| _ -> mk (TUnop (op,flag,e)) t p)
 	| AccNo s ->
 	| AccNo s ->
 		error ("The field or identifier " ^ s ^ " is not accessible for " ^ (if set then "writing" else "reading")) p
 		error ("The field or identifier " ^ s ^ " is not accessible for " ^ (if set then "writing" else "reading")) p
 	| AccSet (e,m,t,f) ->
 	| AccSet (e,m,t,f) ->
@@ -1338,7 +1344,7 @@ and type_expr ctx ?(need_val=true) (e,p) =
 			let v = add_local ctx v t in
 			let v = add_local ctx v t in
 			v , t , e
 			v , t , e
 		) vl in
 		) vl in
-		mk (TVars vl) (t_void ctx) p
+		mk (TVars vl) (t_void ctx) p	
 	| EFor (i,e1,e2) ->
 	| EFor (i,e1,e2) ->
 		let e1 = type_expr ctx e1 in
 		let e1 = type_expr ctx e1 in
 		let t, pt = t_iterator ctx in
 		let t, pt = t_iterator ctx in
@@ -1372,6 +1378,10 @@ and type_expr ctx ?(need_val=true) (e,p) =
 				| TContinue -> raise Exit
 				| TContinue -> raise Exit
 				| _ -> iter loop e
 				| _ -> iter loop e
 			in
 			in
+			(match i1.eexpr , i2.eexpr with
+			| TConst (TInt a), TConst (TInt b) when Int32.compare b a <= 0 ->
+				error "Range operate can't iterate backwards" p
+			| _ -> ());
 			let max = gen_local ctx i2.etype in
 			let max = gen_local ctx i2.etype in
 			let n = gen_local ctx i1.etype in
 			let n = gen_local ctx i1.etype in
 			let e2 = type_expr ~need_val:false ctx e2 in
 			let e2 = type_expr ~need_val:false ctx e2 in