optimized for loops

doc/CHANGES.txt

@@ -2,7 +2,6 @@
 	fixed Int32.compare, added Int32.read and Int32.write
 	fixed type of unitialized registers in flash9
 	fixed Sqlite transactions (commit and rollback now restart a transaction)
-	optimized a...b loops (tmp variable can't be modified)
 	several flash9 optimizations
 	flash9 debug support (with -D fdb)
 	set align to TopLeft if not defined for flash9
@@ -19,6 +18,7 @@
 	fixed DateTools.format %I and %l in Flash/JS
 	securized Hash for JS and Flash
 	compiletime F9 class generation for F8 swflib
+	optimized for loops (Array and IntIter)
 
 2007-10-31: 1.16
 	use _sans font for default flash traces (better Linux support)

transform.ml

@@ -323,42 +323,3 @@ let rec is_volatile t =
 		| _ -> is_volatile (apply_params t.t_types tl t.t_type))
 	| _ ->
 		false
-
-let optimize_for_loop i pt e1 make_e2 p t_void t_bool gen_local error =
-	match e1.eexpr with
-	| TNew ({ cl_path = ([],"IntIter") },[],[i1;i2]) ->
-		(match i1.eexpr , i2.eexpr with
-		| TConst (TInt a), TConst (TInt b) when Int32.compare b a <= 0 -> ignore(error "Range operate can't iterate backwards" p);
-		| _ -> ());
-		let max = gen_local i2.etype in
-		let ident = mk (TLocal i) i1.etype p in
-		let incr = mk (TUnop (Increment,Prefix,ident)) i1.etype p in
-		let rec check e =
-			match e.eexpr with
-			| TBinop (OpAssign,{ eexpr = TLocal l },_)
-			| TBinop (OpAssignOp _,{ eexpr = TLocal l },_)
-			| TUnop (Increment,_,{ eexpr = TLocal l })
-			| TUnop (Decrement,_,{ eexpr = TLocal l })  when l = i ->
-				error "Loop variable cannot be modified" e.epos
-			| TFunction f when List.exists (fun (l,_,_) -> l = i) f.tf_args ->
-				e
-			| TContinue ->
-				mk (TBlock [incr;e]) e.etype e.epos
-			| _ ->
-				map check e
-		in
-		let e2 = check (make_e2()) in
-		let block = match e2.eexpr with
-			| TBlock el -> mk (TBlock (el@[incr])) t_void e2.epos
-			| _ -> mk (TBlock [e2;incr]) t_void p
-		in
-		mk (TBlock [
-			mk (TVars [i,i1.etype,Some i1;max,i2.etype,Some i2]) t_void p;
-			mk (TWhile (
-				mk (TBinop (OpLt, ident, mk (TLocal max) i2.etype p)) t_bool p,
-				block,
-				NormalWhile
-			)) t_void p;
-		]) t_void p
-	| _ ->
-		mk (TFor (i,pt,e1,make_e2())) t_void p

typer.ml

@@ -1702,34 +1702,10 @@ and type_expr ctx ?(need_val=true) (e,p) =
 		mk (TVars vl) (t_void ctx) p
 	| EFor (i,e1,e2) ->
 		let e1 = type_expr ctx e1 in
-		let t, pt = t_iterator ctx in
-		let e1 = (match follow e1.etype with
-		| TAnon _
-		| TInst _ ->
-			(try
-				unify_raise ctx e1.etype t e1.epos;
-				e1
-			with Error (Unify _,_) ->
-				let acc = acc_get (type_field ctx e1 "iterator" e1.epos true) e1.epos in
-				match follow acc.etype with
-				| TFun ([],it) ->
-					unify ctx it t e1.epos;
-					mk (TCall (acc,[])) t e1.epos
-				| _ ->
-					error "The field iterator is not a method" e1.epos
-			)
-		| TMono _
-		| TDynamic _ ->
-			error "You can't iterate on a Dynamic value, please specify Iterator or Iterable" e1.epos;
-		| _ ->
-			unify ctx e1.etype t e1.epos;
-			e1
-		) in
 		let old_loop = ctx.in_loop in
 		let old_locals = save_locals ctx in
-		let i = add_local ctx i pt in
 		ctx.in_loop <- true;
-		let e = Transform.optimize_for_loop i pt e1 (fun () -> type_expr ~need_val:false ctx e2) p (t_void ctx) (t_bool ctx) (gen_local ctx) error in
+		let e = optimize_for_loop ctx i e1 e2 p in
 		ctx.in_loop <- old_loop;
 		old_locals();
 		e
@@ -2075,6 +2051,115 @@ and type_function ctx t static constr f p =
 	ctx.opened <- old_opened;
 	e , fargs
 
+and optimize_for_loop ctx i e1 e2 p =
+	let t_void = t_void ctx in
+	match e1.eexpr with
+	| TNew ({ cl_path = ([],"IntIter") },[],[i1;i2]) ->
+		let t_int = t_int ctx in
+		let max = (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				
+			| _, TConst _ | _ , TLocal _ -> None
+			| _ -> Some (gen_local ctx t_int)
+		) in		
+		let i = add_local ctx i t_int in
+		let ident = mk (TLocal i) t_int p in
+		let incr = mk (TUnop (Increment,Prefix,ident)) t_int p in
+		let rec check e =
+			match e.eexpr with
+			| TBinop (OpAssign,{ eexpr = TLocal l },_)
+			| TBinop (OpAssignOp _,{ eexpr = TLocal l },_)
+			| TUnop (Increment,_,{ eexpr = TLocal l })
+			| TUnop (Decrement,_,{ eexpr = TLocal l })  when l = i ->
+				error "Loop variable cannot be modified" e.epos				
+			| TFunction f when List.exists (fun (l,_,_) -> l = i) f.tf_args ->
+				e
+			| TContinue ->
+				mk (TBlock [incr;e]) e.etype e.epos
+			| _ ->
+				Transform.map check e
+		in
+		let e2 = check (type_expr ~need_val:false ctx e2) in
+		let block = match e2.eexpr with
+			| TBlock el -> mk (TBlock (el@[incr])) t_void e2.epos
+			| _ -> mk (TBlock [e2;incr]) t_void p
+		in
+		(match max with
+		| None ->
+			mk (TBlock [
+				mk (TVars [i,i1.etype,Some i1]) t_void p;
+				mk (TWhile (
+					mk (TBinop (OpLt, ident, i2)) (t_bool ctx) p,
+					block,
+					NormalWhile
+				)) t_void p;
+			]) t_void p
+		| Some max ->
+			mk (TBlock [
+				mk (TVars [i,i1.etype,Some i1;max,i2.etype,Some i2]) t_void p;
+				mk (TWhile (
+					mk (TBinop (OpLt, ident, mk (TLocal max) i2.etype p)) (t_bool ctx) p,
+					block,
+					NormalWhile
+				)) t_void p;
+			]) t_void p)
+	| _  ->
+		match follow e1.etype with
+		| TInst({ cl_path = [],"Array" },[pt]) ->
+			let t_int = t_int ctx in
+			let i = add_local ctx i pt in
+			let index = gen_local ctx t_int in
+			let arr, avars = (match e1.eexpr with
+				| TLocal _ -> e1, []
+				| _ ->
+					let atmp = gen_local ctx e1.etype in
+					mk (TLocal atmp) e1.etype e1.epos, [atmp,e1.etype,Some e1]
+			) in
+			let iexpr = mk (TLocal index) t_int p in
+			let e2 = type_expr ~need_val:false ctx e2 in
+			let aget = mk (TVars [i,pt,Some (mk (TArray (arr,iexpr)) pt p)]) t_void p in
+			let incr = mk (TUnop (Increment,Prefix,iexpr)) t_int p in
+			let block = match e2.eexpr with
+				| TBlock el -> mk (TBlock (aget :: incr :: el)) t_void e2.epos
+				| _ -> mk (TBlock [aget;incr;e2]) t_void p
+			in
+			let ivar = index, t_int, Some (mk (TConst (TInt 0l)) t_int p) in			
+			mk (TBlock [
+				mk (TVars (ivar :: avars)) t_void p;
+				mk (TWhile (
+					mk (TBinop (OpLt, iexpr, mk (TField (arr,"length")) t_int p)) (t_bool ctx) p,
+					block,
+					NormalWhile
+				)) t_void p;
+			]) t_void p
+		| _ ->
+			let t, pt = t_iterator ctx in
+			let i = add_local ctx i pt in
+			let e1 = (match follow e1.etype with
+			| TAnon _
+			| TInst _ ->
+				(try
+					unify_raise ctx e1.etype t e1.epos;
+					e1
+				with Error (Unify _,_) ->
+					let acc = acc_get (type_field ctx e1 "iterator" e1.epos true) e1.epos in
+					match follow acc.etype with
+					| TFun ([],it) ->
+						unify ctx it t e1.epos;
+						mk (TCall (acc,[])) t e1.epos
+					| _ ->
+						error "The field iterator is not a method" e1.epos
+				)
+			| TMono _
+			| TDynamic _ ->
+				error "You can't iterate on a Dynamic value, please specify Iterator or Iterable" e1.epos;
+			| _ ->
+				unify ctx e1.etype t e1.epos;
+				e1
+			) in
+			let e2 = type_expr ~need_val:false ctx e2 in
+			mk (TFor (i,pt,e1,e2)) t_void p
+
+
 let type_static_var ctx t e p =
 	ctx.in_static <- true;
 	let e = type_expr ctx e in