Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

for expression optimization #219

Closed
wants to merge 1 commit into from
Closed

for expression optimization #219

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 1 addition & 2 deletions src/fsharp/creflect.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down
17 changes: 14 additions & 3 deletions src/fsharp/env.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -245,6 +245,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;
Expand Down Expand Up @@ -482,9 +483,11 @@ type public TcGlobals =

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;
Expand Down Expand Up @@ -642,6 +645,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
Expand Down Expand Up @@ -791,7 +795,7 @@ let mkTcGlobals (compilingFslib,sysCcu,ilg,fslibCcu,directoryToResolveRelativePa
fslib_MFQueryRunExtensionsHighPriority_nleref

fslib_MFSeqModule_nleref
fslib_MFListModule_nleref
fslib_MFListModule_nleref
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

whitespace

fslib_MFArrayModule_nleref
fslib_MFArray2DModule_nleref
fslib_MFArray3DModule_nleref
Expand Down Expand Up @@ -893,6 +897,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)
Expand All @@ -917,6 +923,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))
Expand All @@ -941,6 +948,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))
Expand Down Expand Up @@ -1086,6 +1094,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
Expand Down Expand Up @@ -1358,8 +1367,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;
Expand Down Expand Up @@ -1397,11 +1406,13 @@ 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;
lazy_force_info = lazy_force_info;
lazy_create_info = lazy_create_info;

create_instance_info = create_instance_info;
create_event_info = create_event_info;
seq_to_list_info = seq_to_list_info;
Expand Down
6 changes: 3 additions & 3 deletions src/fsharp/opt.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1664,9 +1664,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
Expand Down Expand Up @@ -2035,6 +2032,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
Expand Down
115 changes: 95 additions & 20 deletions src/fsharp/tastops.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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)
Expand Down Expand Up @@ -5906,6 +5913,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)


Expand Down Expand Up @@ -6052,6 +6061,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.
Expand Down Expand Up @@ -7779,34 +7796,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 =
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The exciting stuff

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
7 changes: 6 additions & 1 deletion src/fsharp/tastops.fsi
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
6 changes: 6 additions & 0 deletions tests/fsharp/core/forexpression/build.bat
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
@if "%_echo%"=="" echo off

call %~d0%~p0..\..\single-test-build.bat

exit /b %ERRORLEVEL%

7 changes: 7 additions & 0 deletions tests/fsharp/core/forexpression/run.bat
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,7 @@
@if "%_echo%"=="" echo off

call %~d0%~p0..\..\single-test-run.bat

exit /b %ERRORLEVEL%


Loading