@@ -1186,9 +1186,9 @@ let IsTyFuncValRefExpr = function
11861186| _ -> false
11871187
11881188/// Type applications of existing functions are always simple constants, with the exception of F# 'type functions'
1189- /// REVIEW: we could also include any under-applied application here.
11901189let rec IsSmallConstExpr x =
11911190match xwith
1191+ | Expr.Op( TOp.LValueOp( LAddrOf_, _), [], [], _) -> true // &x is always a constant
11921192| Expr.Val( v, _, _ m) -> not v.IsMutable
11931193| Expr.App( fe, _, _ tyargs, args, _) -> isNil args&& not ( IsTyFuncValRefExpr fe) && IsSmallConstExpr fe
11941194| _ -> false
@@ -1202,11 +1202,29 @@ let ValueOfExpr expr =
12021202// Dead binding elimination
12031203//-------------------------------------------------------------------------
12041204
1205+ // Allow discard of "let v = *byref" if "v" is unused anywhere. The read effect
1206+ // can be discarded because it is always assumed that reading byref pointers (without using
1207+ // the value of the read) doesn't raise exceptions or cause other "interesting" side effects.
1208+ //
1209+ // This allows discarding the implicit deref when matching on struct unions, e.g.
1210+ //
1211+ // [<Struct; NoComparison; NoEquality>]
1212+ // type SingleRec =
1213+ // | SingleUnion of int
1214+ // member x.Next = let (SingleUnion i) = x in SingleUnion (i+1)
1215+ //
1216+ // See https://github.com/Microsoft/visualfsharp/issues/5136
1217+ let IsDiscardableEffectExpr expr =
1218+ match exprwith
1219+ | Expr.Op( TOp.LValueOp( LByrefGet_, _), [], [], _) -> true
1220+ | _ -> false
1221+
1222+ /// Checks is a value binding is non-discardable
12051223let ValueIsUsedOrHasEffect cenv fvs ( b : Binding , binfo ) =
12061224let v = b.Var
12071225not ( cenv.settings.EliminateUnusedBindings()) ||
12081226 Option.isSome v.MemberInfo||
1209- binfo.HasEffect||
1227+ ( binfo.HasEffect&& not ( IsDiscardableEffectExpr b.Expr )) ||
12101228 v.IsFixed||
12111229 Zset.contains v( fvs())
12121230
@@ -1276,7 +1294,7 @@ and OpHasEffect g m op =
12761294| TOp.ValFieldGet rfref-> rfref.RecdField.IsMutable|| ( TryFindTyconRefBoolAttribute g Range.range0 g.attrib_ AllowNullLiteralAttribute rfref.TyconRef= Sometrue )
12771295| TOp.ValFieldGetAddr( rfref, _ readonly) -> rfref.RecdField.IsMutable
12781296| TOp.UnionCaseFieldGetAddr_ -> false // union case fields are immutable
1279- | TOp.LValueOp( LAddrOf_, lv ) -> lv.IsMutable
1297+ | TOp.LValueOp( LAddrOf_, _ )-> false // addresses of values are always constants
12801298| TOp.UnionCaseFieldSet_
12811299| TOp.ExnFieldSet_
12821300| TOp.Coerce
@@ -1856,7 +1874,7 @@ and OptimizeInterfaceImpl cenv env baseValOpt (ty, overrides) =
18561874
18571875and OptimizeExprOp cenv env ( op , tyargs , args , m ) =
18581876
1859- (* Special cases*)
1877+ // Special cases
18601878match op, tyargs, argswith
18611879| TOp.Coerce, [ toty; fromty], [ e] ->
18621880let e ' , einfo = OptimizeExpr cenv env e
@@ -1868,26 +1886,38 @@ and OptimizeExprOp cenv env (op, tyargs, args, m) =
18681886 HasEffect= true
18691887 MightMakeCriticalTailcall= false
18701888 Info= UnknownValue}
1871- (* Handle addresses*)
1889+
1890+ // Handle address-of
18721891| TOp.LValueOp(( LAddrOf_ as lop), lv), _, _ ->
1873- let e , _ = OptimizeExpr cenv env( exprForValRef m lv)
1874- let op ' =
1875- match e with
1892+ let newVal , _ = OptimizeExpr cenv env( exprForValRef m lv)
1893+ let newOp =
1894+ match newVal with
18761895// Do not optimize if it's a top level static binding.
18771896| Expr.Val( v, _, _) when not v.IsCompiledAsTopLevel-> TOp.LValueOp( lop, v)
18781897| _ -> op
1879- Expr.Op( op', tyargs, args, m),
1898+ let newExpr = Expr.Op( newOp, tyargs, args, m)
1899+ newExpr,
18801900{ TotalSize= 1
18811901 FunctionSize= 1
1882- HasEffect= OpHasEffect cenv.g mop'
1902+ HasEffect= OpHasEffect cenv.g mnewOp
18831903 MightMakeCriticalTailcall= false
1884- Info= UnknownValue}
1885- (* Handle these as special cases since mutables are allowed inside their bodies*)
1886- | TOp.While( spWhile, marker), _, [ Expr.Lambda(_, _, _, [_], e1, _, _); Expr.Lambda(_, _, _, [_], e2, _, _)] -> OptimizeWhileLoop cenv{ envwith inLoop= true } ( spWhile, marker, e1, e2, m)
1887- | TOp.For( spStart, dir), _, [ Expr.Lambda(_, _, _, [_], e1, _, _); Expr.Lambda(_, _, _, [_], e2, _, _); Expr.Lambda(_, _, _, [ v], e3, _, _)] -> OptimizeFastIntegerForLoop cenv{ envwith inLoop= true } ( spStart, v, e1, dir, e2, e3, m)
1888- | TOp.TryFinally( spTry, spFinally), [ resty], [ Expr.Lambda(_, _, _, [_], e1, _, _); Expr.Lambda(_, _, _, [_], e2, _, _)] -> OptimizeTryFinally cenv env( spTry, spFinally, e1, e2, m, resty)
1889- | TOp.TryCatch( spTry, spWith), [ resty], [ Expr.Lambda(_, _, _, [_], e1, _, _); Expr.Lambda(_, _, _, [ vf], ef, _, _); Expr.Lambda(_, _, _, [ vh], eh, _, _)] -> OptimizeTryCatch cenv env( e1, vf, ef, vh, eh, m, resty, spTry, spWith)
1890- | TOp.TraitCall( traitInfo), [], args-> OptimizeTraitCall cenv env( traitInfo, args, m)
1904+ Info= ValueOfExpr newExpr}
1905+
1906+ // Handle these as special cases since mutables are allowed inside their bodies
1907+ | TOp.While( spWhile, marker), _, [ Expr.Lambda(_, _, _, [_], e1, _, _); Expr.Lambda(_, _, _, [_], e2, _, _)] ->
1908+ OptimizeWhileLoop cenv{ envwith inLoop= true } ( spWhile, marker, e1, e2, m)
1909+
1910+ | TOp.For( spStart, dir), _, [ Expr.Lambda(_, _, _, [_], e1, _, _); Expr.Lambda(_, _, _, [_], e2, _, _); Expr.Lambda(_, _, _, [ v], e3, _, _)] ->
1911+ OptimizeFastIntegerForLoop cenv{ envwith inLoop= true } ( spStart, v, e1, dir, e2, e3, m)
1912+
1913+ | TOp.TryFinally( spTry, spFinally), [ resty], [ Expr.Lambda(_, _, _, [_], e1, _, _); Expr.Lambda(_, _, _, [_], e2, _, _)] ->
1914+ OptimizeTryFinally cenv env( spTry, spFinally, e1, e2, m, resty)
1915+
1916+ | TOp.TryCatch( spTry, spWith), [ resty], [ Expr.Lambda(_, _, _, [_], e1, _, _); Expr.Lambda(_, _, _, [ vf], ef, _, _); Expr.Lambda(_, _, _, [ vh], eh, _, _)] ->
1917+ OptimizeTryCatch cenv env( e1, vf, ef, vh, eh, m, resty, spTry, spWith)
1918+
1919+ | TOp.TraitCall( traitInfo), [], args->
1920+ OptimizeTraitCall cenv env( traitInfo, args, m)
18911921
18921922// This code hooks arr.Length. The idea is to ensure loops end up in the "same shape"as the forms of loops that the .NET JIT
18931923// guarantees to optimize.
@@ -1906,20 +1936,20 @@ and OptimizeExprOp cenv env (op, tyargs, args, m) =
19061936| TOp.ILAsm([], [ ty]), _, [ a] when typeEquiv cenv.g( tyOfExpr cenv.g a) ty-> OptimizeExpr cenv env a
19071937
19081938| _ ->
1909- (* *)
1910- let args ' , arginfos = OptimizeExprsThenConsiderSplits cenv env args
1911- let knownValue =
1912- match op, arginfoswith
1913- | TOp.ValFieldGet( rf), [ e1info] -> TryOptimizeRecordFieldGet cenv env( e1info, rf, tyargs, m)
1914- | TOp.TupleFieldGet( tupInfo, n), [ e1info] -> TryOptimizeTupleFieldGet cenv env( tupInfo, e1info, tyargs, n, m)
1915- | TOp.UnionCaseFieldGet( cspec, n), [ e1info] -> TryOptimizeUnionCaseGet cenv env( e1info, cspec, tyargs, n, m)
1916- | _ -> None
1917- match knownValuewith
1918- | Some valu->
1919- match TryOptimizeVal cenv env( false , valu, m) with
1920- | Some res-> OptimizeExpr cenv env res(* discard e1 since guard ensures it has no effects*)
1921- | None-> OptimizeExprOpFallback cenv env( op, tyargs, args', m) arginfos valu
1922- | None-> OptimizeExprOpFallback cenv env( op, tyargs, args', m) arginfos UnknownValue
1939+ // Reductions
1940+ let args ' , arginfos = OptimizeExprsThenConsiderSplits cenv env args
1941+ let knownValue =
1942+ match op, arginfoswith
1943+ | TOp.ValFieldGet( rf), [ e1info] -> TryOptimizeRecordFieldGet cenv env( e1info, rf, tyargs, m)
1944+ | TOp.TupleFieldGet( tupInfo, n), [ e1info] -> TryOptimizeTupleFieldGet cenv env( tupInfo, e1info, tyargs, n, m)
1945+ | TOp.UnionCaseFieldGet( cspec, n), [ e1info] -> TryOptimizeUnionCaseGet cenv env( e1info, cspec, tyargs, n, m)
1946+ | _ -> None
1947+ match knownValuewith
1948+ | Some valu->
1949+ match TryOptimizeVal cenv env( false , valu, m) with
1950+ | Some res-> OptimizeExpr cenv env res(* discard e1 since guard ensures it has no effects*)
1951+ | None-> OptimizeExprOpFallback cenv env( op, tyargs, args', m) arginfos valu
1952+ | None-> OptimizeExprOpFallback cenv env( op, tyargs, args', m) arginfos UnknownValue
19231953
19241954
19251955and OptimizeExprOpFallback cenv env ( op , tyargs , args' , m ) arginfos valu =
