for expression optimization on lists and strings

Previously 'for i in expr do body' only had optimization
when the type of expr was an 1D-array.

'for i in expr do body' now has optimizations for when expr
is of type 'string' and 'List`1'.

These optimizations increases the performance of the for
expression but also reduces the number of objects created.

closes dotnet/fsharp#219

commit e3935d95ce12a28f87e2d77c537b6f18e6d54d98
Author: latkin <latkin@microsoft.com>
Date:   Thu Aug 6 12:53:35 2015 -0700

    Add cross-version test cases

commit 1427f418ab1a2fb2b06684fafff809932714cf0a
Merge: 01dc508 73509e9
Author: latkin <latkin@microsoft.com>
Date:   Thu Aug 6 10:42:54 2015 -0700

    Merge branch 'pr/for_optimization' of https://github.com/mrange/visualfsharp into mrange-pr/for_optimization

    Conflicts:
    	src/fsharp/TcGlobals.fs
    	tests/fsharpqa/Source/Optimizations/ForLoop/env.lst

commit 73509e956679a52f7b77d692cc85b3a835bca5b4
Author: mrange <marten_range@hotmail.com>
Date:   Mon Mar 9 00:04:11 2015 +0100

    'for i in expr do body' optimization..

    Previously 'for i in expr do body' only had optimization
    when the type of expr was an 1D-array.

    'for i in expr do body' now has optimizations for when expr
    is of type 'string' and 'List`1'.

    These optimizations increases the performance of the for
    expression but also reduces the number of objects created.

    latkin provided the following fixes:
    1. Adapting tests to work with core\portable and core\netcore
    2. Loop item over strings sometimes uses object, not char
    3. Adjustments to debug ranges so that debug stepping behavior is consistent/unchanged
    4. Updating codegen tests to represent corrected debug ranges

Author: mrange

src/fsharp/Optimizer.fs

@@ -1716,9 +1716,6 @@ let TryDetectQueryQuoteAndRun cenv (expr:Expr) =
 
 let rec OptimizeExpr cenv (env:IncrementalOptimizationEnv) expr =
 
-    // foreach --> fast integer for loops
-    let expr = DetectFastIntegerForLoops cenv.g expr
-
     // Eliminate subsumption coercions for functions. This must be done post-typechecking because we need
     // complete inference types.
     let expr = NormalizeAndAdjustPossibleSubsumptionExprs cenv.g expr
@@ -2087,6 +2084,9 @@ and OptimizeLetRec cenv env (binds,bodyExpr,m) =
 //------------------------------------------------------------------------- 
 
 and OptimizeLinearExpr cenv env expr contf =
+
+    let expr = DetectAndOptimizeForExpression cenv.g OptimizeAllForExpressions expr
+
     if verboseOptimizations then dprintf "OptimizeLinearExpr\n";
     let expr = if cenv.settings.ExpandStructrualValues() then ExpandStructuralBinding cenv expr else expr 
     match expr with 

src/fsharp/QuotationTranslator.fs

@@ -203,8 +203,7 @@ and ConvExpr cenv env (expr : Expr) =
 
 and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP.ExprData = 
 
-    // Eliminate integer 'for' loops 
-    let expr = DetectFastIntegerForLoops cenv.g expr
+    let expr = DetectAndOptimizeForExpression cenv.g OptimizeIntRangesOnly expr
 
     // Eliminate subsumption coercions for functions. This must be done post-typechecking because we need
     // complete inference types.

src/fsharp/TastOps.fs

@@ -1427,6 +1427,11 @@ let destArrayTy (g:TcGlobals) ty =
     | [ty] -> ty
     | _ -> failwith "destArrayTy";
 
+let destListTy (g:TcGlobals) ty =
+    let _,tinst = destAppTy g ty
+    match tinst with
+    | [ty] -> ty
+    | _ -> failwith "destListTy";
 
 let isTypeConstructorEqualToOptional g tcOpt tc = 
     match tcOpt with
@@ -1439,6 +1444,8 @@ let isByrefLikeTyconRef g tcref =
     isTypeConstructorEqualToOptional g g.system_ArgIterator_tcref tcref ||
     isTypeConstructorEqualToOptional g g.system_RuntimeArgumentHandle_tcref tcref
 
+let isStringTy  g ty = ty |> stripTyEqns g |> (function TType_app(tcref,_) -> tyconRefEq g tcref g.system_String_tcref   | _ -> false)
+let isListTy    g ty = ty |> stripTyEqns g |> (function TType_app(tcref,_) -> tyconRefEq g tcref g.list_tcr_canon   | _ -> false)
 let isArrayTy   g ty = ty |> stripTyEqns g |> (function TType_app(tcref,_) -> isArrayTyconRef g tcref                | _ -> false) 
 let isArray1DTy  g ty = ty |> stripTyEqns g |> (function TType_app(tcref,_) -> tyconRefEq g tcref g.il_arr_tcr_map.[0]  | _ -> false) 
 let isUnitTy     g ty = ty |> stripTyEqns g |> (function TType_app(tcref,_) -> tyconRefEq g g.unit_tcr_canon tcref      | _ -> false) 
@@ -5856,6 +5863,8 @@ let mkIsInst ty e m = mkAsmExpr ([ isinst ], [ty],[e], [ ty ], m)
 
 let mspec_Object_GetHashCode     ilg = IL.mkILNonGenericInstanceMethSpecInTy(ilg.typ_Object,"GetHashCode",[],ilg.typ_int32)
 let mspec_Type_GetTypeFromHandle ilg = IL.mkILNonGenericStaticMethSpecInTy(ilg.typ_Type,"GetTypeFromHandle",[ilg.typ_RuntimeTypeHandle],ilg.typ_Type)
+let mspec_String_Length          ilg = mkILNonGenericInstanceMethSpecInTy (ilg.typ_String, "get_Length", [], ilg.typ_int32)
+
 let fspec_Missing_Value  ilg = IL.mkILFieldSpecInTy(ilg.typ_Missing.Value, "Value", ilg.typ_Missing.Value)
 
 
@@ -6002,6 +6011,14 @@ let mkCallQuoteToLinqLambdaExpression g m ty e1 =
 let mkLazyDelayed g m ty f = mkApps g (typedExprForIntrinsic g m g.lazy_create_info, [[ty]], [ f ],  m) 
 let mkLazyForce g m ty e = mkApps g (typedExprForIntrinsic g m g.lazy_force_info, [[ty]], [ e; mkUnit g m ],  m) 
 
+let mkGetString g m e1 e2 = mkApps g (typedExprForIntrinsic g m g.getstring_info, [], [e1;e2], m)
+let mkGetStringChar = mkGetString
+let mkGetStringLength g m e =
+    let mspec = mspec_String_Length g.ilg
+    /// ILCall(useCallvirt,isProtected,valu,newobj,valUseFlags,isProp,noTailCall,mref,actualTypeInst,actualMethInst, retTy)
+    Expr.Op(TOp.ILCall(false,false,false,false,ValUseFlag.NormalValUse,true,false,mspec.MethodRef,[],[],[g.int32_ty]),[],[e],m)
+
+
 // Quotations can't contain any IL.
 // As a result, we aim to get rid of all IL generation in the typechecker and pattern match
 // compiler, or else train the quotation generator to understand the generated IL. 
@@ -7723,34 +7740,92 @@ let (|RangeInt32Step|_|) g expr =
          when valRefEq g vf g.range_op_vref && typeEquiv g tyarg g.int_ty -> Some(startExpr, 1, finishExpr)
 
     // detect (RangeInt32 startExpr N finishExpr), the inlined/compiled form of 'n .. m' and 'n .. N .. m'
-    | Expr.App(Expr.Val(vf,_,_),_,[],[startExpr; Int32Expr n; finishExpr],_) 
+    | Expr.App(Expr.Val(vf,_,_),_,[],[startExpr; Int32Expr n; finishExpr],_)
          when valRefEq g vf g.range_int32_op_vref -> Some(startExpr, n, finishExpr)
 
     | _ -> None
 
-         
-// Detect the compiled or optimized form of a 'for <elemVar> in <startExpr> .. <finishExpr>  do <bodyExpr>' expression over integers
-// Detect the compiled or optimized form of a 'for <elemVar> in <startExpr> .. <step> .. <finishExpr>  do <bodyExpr>' expression over integers when step is positive
-let (|CompiledInt32ForEachExprWithKnownStep|_|) g expr = 
-    match expr with 
-    | Let (_enumerableVar, RangeInt32Step g (startExpr, step, finishExpr), _, 
-           Let (_enumeratorVar, _getEnumExpr, spBind,
-              TryFinally (WhileLoopForCompiledForEachExpr (_guardExpr, Let (elemVar,_currentExpr,_,bodyExpr), m), _cleanupExpr))) -> 
+let (|ExtractTypeOfExpr|_|) g expr = Some (tyOfExpr g expr)
 
-        let spForLoop = match spBind with SequencePointAtBinding(spStart) -> SequencePointAtForLoop(spStart) |  _ -> NoSequencePointAtForLoop 
+type OptimizeForExpressionOptions = OptimizeIntRangesOnly | OptimizeAllForExpressions
 
-        Some(spForLoop,elemVar,startExpr,step,finishExpr,bodyExpr,m)
-    | _ -> 
-        None
+let DetectAndOptimizeForExpression g option expr =
+    match expr with
+    | Let (_, enumerableExpr, _,
+           Let (_, _, enumeratorBind,
+              TryFinally (WhileLoopForCompiledForEachExpr (_, Let (elemVar,_,_,bodyExpr), _), _))) ->
 
-let DetectFastIntegerForLoops g expr = 
-    match expr with 
-    | CompiledInt32ForEachExprWithKnownStep g (spForLoop,elemVar,startExpr,step,finishExpr,bodyExpr,m) 
-         // fast for loops only allow steps 1 and -1 steps at the moment
-         when step = 1 || step = -1 -> 
+      let m = enumerableExpr.Range
+      let mBody = bodyExpr.Range
+
+      let spForLoop,mForLoop = match enumeratorBind with SequencePointAtBinding(spStart) -> SequencePointAtForLoop(spStart),spStart  |  _ -> NoSequencePointAtForLoop,m
+      let spWhileLoop   = match enumeratorBind with SequencePointAtBinding(spStart) -> SequencePointAtWhileLoop(spStart)|  _ -> NoSequencePointAtWhileLoop
+
+      match option,enumerableExpr with
+      | _,RangeInt32Step g (startExpr, step, finishExpr) ->
+        match step with
+        | -1 | 1  ->
             mkFastForLoop  g (spForLoop,m,elemVar,startExpr,(step = 1),finishExpr,bodyExpr)
-    | _ -> expr
+        | _ -> expr
+      | OptimizeAllForExpressions,ExtractTypeOfExpr g ty when isStringTy g ty ->
+        // type is string, optimize for expression as:
+        //  let $str = enumerable
+        //  for $idx in 0..(str.Length - 1) do
+        //      let elem = str.[idx]
+        //      body elem
+
+        let strVar      ,strExpr    = mkCompGenLocal m "str" ty
+        let idxVar      ,idxExpr    = mkCompGenLocal m "idx" g.int32_ty
+
+        let lengthExpr              = mkGetStringLength g m strExpr
+        let charExpr                = mkGetStringChar g m strExpr idxExpr
+
+        let startExpr               = mkZero g m
+        let finishExpr              = mkDecr g mForLoop lengthExpr
+        let loopItemExpr            = mkCoerceIfNeeded g elemVar.Type g.char_ty charExpr  // for compat reasons, loop item over string is sometimes object, not char
+        let bodyExpr                = mkCompGenLet mBody elemVar loopItemExpr bodyExpr
+        let forExpr                 = mkFastForLoop g (spForLoop,m,idxVar,startExpr,true,finishExpr,bodyExpr)
+        let expr                    = mkCompGenLet m strVar enumerableExpr forExpr
 
+        expr
+      | OptimizeAllForExpressions,ExtractTypeOfExpr g ty when isListTy g ty ->
+        // type is list, optimize for expression as:
+        //  let mutable $currentVar = listExpr
+        //  let mutable $nextVar    = $tailOrNull
+        //  while $guardExpr do
+        //    let i = $headExpr
+        //    bodyExpr ()
+        //    $current   <- $next
+        //    $next      <- $tailOrNull
+
+        let IndexHead                   = 0
+        let IndexTail                   = 1
+
+        let currentVar  ,currentExpr    = mkMutableCompGenLocal m "current" ty
+        let nextVar     ,nextExpr       = mkMutableCompGenLocal m "next" ty
+        let elemTy                      = destListTy g ty
+
+        let guardExpr                   = mkNonNullTest g m nextExpr
+        let headOrDefaultExpr           = mkUnionCaseFieldGetUnproven(currentExpr,g.cons_ucref,[elemTy],IndexHead,m)
+        let tailOrNullExpr              = mkUnionCaseFieldGetUnproven(currentExpr,g.cons_ucref,[elemTy],IndexTail,mBody)
+        let bodyExpr                    =
+            mkCompGenLet m elemVar headOrDefaultExpr
+                (mkCompGenSequential mBody
+                    bodyExpr
+                    (mkCompGenSequential mBody
+                        (mkValSet mBody (mkLocalValRef currentVar) nextExpr)
+                        (mkValSet mBody (mkLocalValRef nextVar) tailOrNullExpr)
+                    )
+                )
+        let whileExpr                   = mkWhile g (spWhileLoop, WhileLoopForCompiledForEachExprMarker, guardExpr, bodyExpr, m)
+
+        let expr =
+            mkCompGenLet m currentVar enumerableExpr
+                (mkCompGenLet m nextVar tailOrNullExpr whileExpr)
+
+        expr
+      | _ -> expr
+    | _ -> expr
 
 // Used to remove Expr.Link for inner expressions in pattern matches
-let (|InnerExprPat|) expr = stripExpr expr 
+let (|InnerExprPat|) expr = stripExpr expr

src/fsharp/TastOps.fsi

@@ -949,10 +949,13 @@ type TypeDefMetadata =
 val metadataOfTycon : Tycon -> TypeDefMetadata
 val metadataOfTy : TcGlobals -> TType -> TypeDefMetadata
 
+val isStringTy       : TcGlobals -> TType -> bool
+val isListTy         : TcGlobals -> TType -> bool
 val isILAppTy      : TcGlobals -> TType -> bool
 val isArrayTy        : TcGlobals -> TType -> bool
 val isArray1DTy       : TcGlobals -> TType -> bool
 val destArrayTy     : TcGlobals -> TType -> TType
+val destListTy      : TcGlobals -> TType -> TType
 
 val mkArrayTy         : TcGlobals -> int -> TType -> range -> TType
 val isArrayTyconRef      : TcGlobals -> TyconRef -> bool
@@ -1373,7 +1376,9 @@ val (|SpecialComparableHeadType|_|) : TcGlobals -> TType -> TType list option
 val (|SpecialEquatableHeadType|_|) : TcGlobals -> TType -> TType list option
 val (|SpecialNotEquatableHeadType|_|) : TcGlobals -> TType -> unit option
 
-val DetectFastIntegerForLoops : TcGlobals -> Expr -> Expr
+type OptimizeForExpressionOptions = OptimizeIntRangesOnly | OptimizeAllForExpressions
+val DetectAndOptimizeForExpression : TcGlobals -> OptimizeForExpressionOptions -> Expr -> Expr
+
 val TryEliminateDesugaredConstants : TcGlobals -> range -> Const -> Expr option
 
 val ValIsExplicitImpl : TcGlobals -> Val -> bool

src/fsharp/TcGlobals.fs

@@ -242,6 +242,7 @@ type public TcGlobals =
       system_Exception_typ         : TType 
       system_Int32_typ             : TType 
       system_String_typ            : TType 
+      system_String_tcref          : TyconRef
       system_Type_typ              : TType 
       system_TypedReference_tcref  : TyconRef option
       system_ArgIterator_tcref     : TyconRef option 
@@ -478,10 +479,12 @@ type public TcGlobals =
       istype_fast_info          : IntrinsicValRef
 
       dispose_info              : IntrinsicValRef
+      
+      getstring_info            : IntrinsicValRef
 
       range_op_vref             : ValRef
+      range_step_op_vref        : ValRef
       range_int32_op_vref       : ValRef
-      //range_step_op_vref        : ValRef
       array_get_vref            : ValRef
       array2D_get_vref          : ValRef
       array3D_get_vref          : ValRef
@@ -639,6 +642,7 @@ let mkTcGlobals (compilingFslib,sysCcu,ilg,fslibCcu,directoryToResolveRelativePa
 
   let bool_ty         = mkNonGenericTy bool_tcr   
   let int_ty          = mkNonGenericTy int_tcr    
+  let char_ty         = mkNonGenericTy char_tcr
   let obj_ty          = mkNonGenericTy obj_tcr    
   let string_ty       = mkNonGenericTy string_tcr
   let byte_ty         = mkNonGenericTy byte_tcr
@@ -788,7 +792,7 @@ let mkTcGlobals (compilingFslib,sysCcu,ilg,fslibCcu,directoryToResolveRelativePa
                             fslib_MFQueryRunExtensionsHighPriority_nleref 
 
                             fslib_MFSeqModule_nleref    
-                            fslib_MFListModule_nleref   
+                            fslib_MFListModule_nleref
                             fslib_MFArrayModule_nleref   
                             fslib_MFArray2DModule_nleref   
                             fslib_MFArray3DModule_nleref   
@@ -890,6 +894,8 @@ let mkTcGlobals (compilingFslib,sysCcu,ilg,fslibCcu,directoryToResolveRelativePa
 
   let dispose_info               = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref,                    "Dispose"                              ,None                 ,None          ,[vara],     ([[varaTy]],unit_ty))
 
+  let getstring_info             = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref,                    "GetString"                            ,None                 ,None          ,[],         ([[string_ty];[int_ty]],char_ty))
+
   let reference_equality_inner_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref,                        "PhysicalEqualityIntrinsic"            ,None                 ,None          ,[vara],     mk_rel_sig varaTy)  
 
   let bitwise_or_info            = makeIntrinsicValRef(fslib_MFOperators_nleref,                             "op_BitwiseOr"                         ,None                 ,None          ,[vara],     mk_binop_ty varaTy)  
@@ -914,6 +920,7 @@ let mkTcGlobals (compilingFslib,sysCcu,ilg,fslibCcu,directoryToResolveRelativePa
   let typedefof_info             = makeIntrinsicValRef(fslib_MFOperators_nleref,                             "typedefof"                            ,None                 ,Some "TypeDefOf",[vara],     ([],system_Type_typ))  
   let enum_info                  = makeIntrinsicValRef(fslib_MFOperators_nleref,                             "enum"                                 ,None                 ,Some "ToEnum" ,[vara],     ([[int_ty]],varaTy))  
   let range_op_info              = makeIntrinsicValRef(fslib_MFOperators_nleref,                             "op_Range"                             ,None                 ,None          ,[vara],     ([[varaTy];[varaTy]],mkSeqTy varaTy))
+  let range_step_op_info         = makeIntrinsicValRef(fslib_MFOperators_nleref,                             "op_RangeStep"                         ,None                 ,None          ,[vara;varb],([[varaTy];[varbTy];[varaTy]],mkSeqTy varaTy))
   let range_int32_op_info        = makeIntrinsicValRef(fslib_MFOperatorIntrinsics_nleref,                    "RangeInt32"                           ,None                 ,None          ,[],     ([[int_ty];[int_ty];[int_ty]],mkSeqTy int_ty))
   let array2D_get_info           = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref,                    "GetArray2D"                           ,None                 ,None          ,[vara],     ([[mkArrayType 2 varaTy];[int_ty]; [int_ty]],varaTy))  
   let array3D_get_info           = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref,                    "GetArray3D"                           ,None                 ,None          ,[vara],     ([[mkArrayType 3 varaTy];[int_ty]; [int_ty]; [int_ty]],varaTy))
@@ -938,6 +945,7 @@ let mkTcGlobals (compilingFslib,sysCcu,ilg,fslibCcu,directoryToResolveRelativePa
     // Lazy\Value for > 4.0
                                    makeIntrinsicValRef(fslib_MFLazyExtensions_nleref,                        "Force"                                ,Some "Lazy`1"        ,None                          ,[vara],     ([[mkLazyTy varaTy]; []], varaTy))
   let lazy_create_info           = makeIntrinsicValRef(fslib_MFLazyExtensions_nleref,                        "Create"                               ,Some "Lazy`1"        ,None                          ,[vara],     ([[unit_ty --> varaTy]], mkLazyTy varaTy))
+
   let seq_info                   = makeIntrinsicValRef(fslib_MFOperators_nleref,                             "seq"                                  ,None                 ,Some "CreateSequence"         ,[vara],     ([[mkSeqTy varaTy]], mkSeqTy varaTy))
   let splice_expr_info           = makeIntrinsicValRef(fslib_MFExtraTopLevelOperators_nleref,                "op_Splice"                            ,None                 ,None                          ,[vara],     ([[mkQuotedExprTy varaTy]], varaTy))
   let splice_raw_expr_info       = makeIntrinsicValRef(fslib_MFExtraTopLevelOperators_nleref,                "op_SpliceUntyped"                     ,None                 ,None                          ,[vara],     ([[mkRawQuotedExprTy]], varaTy))
@@ -1083,6 +1091,7 @@ let mkTcGlobals (compilingFslib,sysCcu,ilg,fslibCcu,directoryToResolveRelativePa
     system_Enum_typ      = mkSysNonGenericTy sys "Enum"
     system_Exception_typ = mkSysNonGenericTy sys "Exception"
     system_String_typ    = mkSysNonGenericTy sys "String"
+    system_String_tcref  = mkSysTyconRef sys "String"
     system_Int32_typ     = mkSysNonGenericTy sys "Int32"
     system_Type_typ                  = system_Type_typ
     system_TypedReference_tcref        = if ilg.traits.TypedReferenceTypeScopeRef.IsSome then Some(mkSysTyconRef sys "TypedReference") else None
@@ -1355,8 +1364,8 @@ let mkTcGlobals (compilingFslib,sysCcu,ilg,fslibCcu,directoryToResolveRelativePa
     enum_vref                  = ValRefForIntrinsic enum_info
     enumOfValue_vref           = ValRefForIntrinsic enumOfValue_info
     range_op_vref              = ValRefForIntrinsic range_op_info
+    range_step_op_vref         = ValRefForIntrinsic range_step_op_info
     range_int32_op_vref        = ValRefForIntrinsic range_int32_op_info
-    //range_step_op_vref         = ValRefForIntrinsic range_step_op_info
     array_length_info          = array_length_info
     array_get_vref             = ValRefForIntrinsic array_get_info
     array2D_get_vref           = ValRefForIntrinsic array2D_get_info
@@ -1394,6 +1403,7 @@ let mkTcGlobals (compilingFslib,sysCcu,ilg,fslibCcu,directoryToResolveRelativePa
     get_generic_er_equality_comparer_info        = get_generic_er_equality_comparer_info
     get_generic_per_equality_comparer_info    = get_generic_per_equality_comparer_info
     dispose_info               = dispose_info
+    getstring_info             = getstring_info
     unbox_fast_info            = unbox_fast_info
     istype_info                = istype_info
     istype_fast_info           = istype_fast_info

tests/fsharp/core/forexpression/build.bat

@@ -0,0 +1,6 @@
+@if "%_echo%"=="" echo off
+
+call %~d0%~p0..\..\single-test-build.bat
+
+exit /b %ERRORLEVEL%
+

tests/fsharp/core/forexpression/run.bat

@@ -0,0 +1,7 @@
+@if "%_echo%"=="" echo off
+
+call %~d0%~p0..\..\single-test-run.bat
+
+exit /b %ERRORLEVEL%
+
+