diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs
index 0e6ba2aac83..e1cd687dee8 100644
--- a/src/fsharp/IlxGen.fs
+++ b/src/fsharp/IlxGen.fs
@@ -3667,6 +3667,27 @@ and FreeVarStorageForWitnessInfos (cenv: cenv) (eenv: IlxGenEnv) takenNames ilCl
ilFv, (w, storage))
|> List.unzip
+//--------------------------------------------------------------------------
+// Locally erased type functions
+//--------------------------------------------------------------------------
+
+/// Check for type lambda with entirely erased type arguments that is stored as
+/// local variable (not method or property). For example
+// let foo() =
+// let a = 0<_>
+// ()
+// in debug code , here `a` will be a TyLamba. However the compiled representation of
+// `a` is an integer.
+and IsLocalErasedTyLambda g eenv (v: Val) e =
+ match e with
+ | Expr.TyLambda (_, tyargs, body, _, _) when
+ tyargs |> List.forall (fun tp -> tp.IsErased) &&
+ (match StorageForVal g v.Range v eenv with Local _ -> true | _ -> false) ->
+ match stripExpr body with
+ | Expr.Lambda _ -> None
+ | _ -> Some body
+ | _ -> None
+
//--------------------------------------------------------------------------
// Named local type functions
//--------------------------------------------------------------------------
@@ -5082,9 +5103,9 @@ and GenGenericArgs m (tyenv: TypeReprEnv) tps =
tps |> DropErasedTypars |> List.map (fun c -> (mkILTyvarTy tyenv.[c, m]))
/// Generate a local type function contract class and implementation
-and GenClosureAsLocalTypeFunction cenv (cgbuf: CodeGenBuffer) eenv isLocalTypeFunc thisVars expr m =
+and GenClosureAsLocalTypeFunction cenv (cgbuf: CodeGenBuffer) eenv thisVars expr m =
let g = cenv.g
- let cloinfo, body, eenvinner = GetIlxClosureInfo cenv m ILBoxity.AsObject isLocalTypeFunc true thisVars eenv expr
+ let cloinfo, body, eenvinner = GetIlxClosureInfo cenv m ILBoxity.AsObject true true thisVars eenv expr
let ilCloTypeRef = cloinfo.cloSpec.TypeRef
let entryPointInfo = thisVars |> List.map (fun v -> (v, BranchCallClosure cloinfo.cloArityInfo))
// Now generate the actual closure implementation w.r.t. eenvinner
@@ -5109,10 +5130,10 @@ and GenClosureAsLocalTypeFunction cenv (cgbuf: CodeGenBuffer) eenv isLocalTypeFu
let cloTypeDefs = GenClosureTypeDefs cenv (ilCloTypeRef, cloinfo.cloILGenericParams, [], cloinfo.ilCloAllFreeVars, ilCloLambdas, ilCtorBody, cloMethods, [], g.ilg.typ_Object, [], Some cloinfo.cloSpec)
cloinfo, ilCloTypeRef, cloTypeDefs
-and GenClosureAsFirstClassFunction cenv (cgbuf: CodeGenBuffer) eenv isLocalTypeFunc thisVars m expr =
+and GenClosureAsFirstClassFunction cenv (cgbuf: CodeGenBuffer) eenv thisVars m expr =
let g = cenv.g
- let cloinfo, body, eenvinner = GetIlxClosureInfo cenv m ILBoxity.AsObject isLocalTypeFunc true thisVars eenv expr
- let entryPointInfo = thisVars |> List.map (fun v -> (v, BranchCallClosure cloinfo.cloArityInfo))
+ let cloinfo, body, eenvinner = GetIlxClosureInfo cenv m ILBoxity.AsObject false true thisVars eenv expr
+ let entryPointInfo = thisVars |> List.map (fun v -> (v, BranchCallClosure (cloinfo.cloArityInfo)))
let ilCloTypeRef = cloinfo.cloSpec.TypeRef
let ilCloBody = CodeGenMethodForExpr cenv cgbuf.mgbuf (SPAlways, entryPointInfo, cloinfo.cloName, eenvinner, 1, body, Return)
@@ -5127,9 +5148,9 @@ and GenLambdaClosure cenv (cgbuf: CodeGenBuffer) eenv isLocalTypeFunc thisVars e
let cloinfo, ilCloTypeRef, cloTypeDefs =
if isLocalTypeFunc then
- GenClosureAsLocalTypeFunction cenv cgbuf eenv isLocalTypeFunc thisVars expr m
+ GenClosureAsLocalTypeFunction cenv cgbuf eenv thisVars expr m
else
- GenClosureAsFirstClassFunction cenv cgbuf eenv isLocalTypeFunc thisVars m expr
+ GenClosureAsFirstClassFunction cenv cgbuf eenv thisVars m expr
CountClosure()
for cloTypeDef in cloTypeDefs do
@@ -5283,7 +5304,6 @@ and GetIlxClosureFreeVars cenv m (thisVars: ValRef list) boxity eenvouter takenN
// Return a various results
(cloFreeTyvars, cloWitnessInfos, cloFreeVars, ilCloTypeRef, ilCloAllFreeVars, eenvinner)
-
and GetIlxClosureInfo cenv m boxity isLocalTypeFunc canUseStaticField thisVars eenvouter expr =
let g = cenv.g
let returnTy =
@@ -6927,26 +6947,20 @@ and GenGetVal cenv cgbuf eenv (v: ValRef, m) sequel =
GenGetValRefAndSequel cenv cgbuf eenv m v None
GenSequel cenv eenv.cloc cgbuf sequel
-and GenBindingRhs cenv cgbuf eenv sp (vspec: Val) e =
+and GenBindingRhs cenv cgbuf eenv sp (vspec: Val) expr =
let g = cenv.g
- match e with
+ match expr with
| Expr.TyLambda _ | Expr.Lambda _ ->
- let isLocalTypeFunc = IsNamedLocalTypeFuncVal g vspec e
- match e with
- | Expr.TyLambda (_, tyargs, body, _, ttype) when
- (
- tyargs |> List.forall (fun tp -> tp.IsErased) &&
- (match StorageForVal g vspec.Range vspec eenv with Local _ -> true | _ -> false) &&
- (isLocalTypeFunc || isStructOrEnumTyconTy g ttype)
- ) ->
- // type lambda with erased type arguments that is stored as local variable (not method or property)- inline body
+ match IsLocalErasedTyLambda g eenv vspec expr with
+ | Some body ->
GenExpr cenv cgbuf eenv sp body Continue
- | _ ->
+ | None ->
+ let isLocalTypeFunc = IsNamedLocalTypeFuncVal g vspec expr
let thisVars = if isLocalTypeFunc then [] else [ mkLocalValRef vspec ]
- GenLambda cenv cgbuf eenv isLocalTypeFunc thisVars e Continue
+ GenLambda cenv cgbuf eenv isLocalTypeFunc thisVars expr Continue
| _ ->
- GenExpr cenv cgbuf eenv sp e Continue
+ GenExpr cenv cgbuf eenv sp expr Continue
and CommitStartScope cgbuf startScopeMarkOpt =
match startScopeMarkOpt with
@@ -7091,14 +7105,14 @@ and AllocLocalVal cenv cgbuf v eenv repr scopeMarks =
if isUnitTy g ty && not v.IsMutable then Null, eenv
else
match repr with
- | Some r when IsNamedLocalTypeFuncVal g v r ->
- let ftyvs = (freeInExpr CollectTypars r).FreeTyvars
+ | Some repr when IsNamedLocalTypeFuncVal g v repr ->
+ let ftyvs = (freeInExpr CollectTypars repr).FreeTyvars
// known, named, non-escaping type functions
let cloinfoGenerate eenv =
let eenvinner =
{eenv with
letBoundVars=(mkLocalValRef v) :: eenv.letBoundVars}
- let cloinfo, _, _ = GetIlxClosureInfo cenv v.Range ILBoxity.AsObject true true [] eenvinner r
+ let cloinfo, _, _ = GetIlxClosureInfo cenv v.Range ILBoxity.AsObject true true [] eenvinner repr
cloinfo
let idx, realloc, eenv = AllocLocal cenv cgbuf eenv v.IsCompilerGenerated (v.CompiledName g.CompilerGlobalState, g.ilg.typ_Object, false) scopeMarks
diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj
index 3ad6dd6550f..c4d4843f328 100644
--- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj
+++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj
@@ -83,4 +83,4 @@
-
\ No newline at end of file
+
diff --git a/tests/fsharp/core/genericmeasures/test.fsx b/tests/fsharp/core/genericmeasures/test.fsx
index 265b1865826..374c8e8321e 100644
--- a/tests/fsharp/core/genericmeasures/test.fsx
+++ b/tests/fsharp/core/genericmeasures/test.fsx
@@ -8,17 +8,26 @@ module Core_genericMeasures =
type C<'T> = class end
[] type t
+ [] type t2
let f1 (_ : int) = ()
let f2 (_ : float) = ()
let f3 (_ : int<_>) = ()
let f4 (_ : float<_>) = ()
let f5 (_ : C<'a>) = ()
- let f6 (_ : list<'a>) = ()
+ let f6 (xs : list<'a>) =
+ match box xs with
+ | null -> failwith "unexpected null list"
+ | _ -> if List.length xs <> 0 then failwith "expected empty list"
+ let f7 (xs : list<'a>) =
+ match box xs with
+ | null -> failwith "unexpected null list"
+ | _ -> if List.length xs <> 0 then failwith "expected empty list"
let foo() =
let a = 0<_>
let b = 0.0<_>
let c = null : C>
+ let c2 = c : C>
let d = null : C>
let e = [] : list>
let f = [] : list>
@@ -26,12 +35,14 @@ module Core_genericMeasures =
let h = null : C<_ * int<_> * _>
let i : List> = List.empty
let j : List> = List.empty
+ let k : List> = j
f1 a
f2 b
f3 a
f4 b
f5 c
+ f5 c2
f5 d
f6 e
f6 f
@@ -39,6 +50,12 @@ module Core_genericMeasures =
f5 h
f6 i
f6 j
+ f7 (i : List>)
+ f7 (i : List>)
+ f7 (j : List>)
+ f7 (j : List>)
+ f7 (k : List>)
+ f7 (k : List>)
type T =
static member Foo(_ : int) = ()
diff --git a/tests/fsharp/core/innerpoly/test.fsx b/tests/fsharp/core/innerpoly/test.fsx
index 76c88c8fd78..012df22100f 100644
--- a/tests/fsharp/core/innerpoly/test.fsx
+++ b/tests/fsharp/core/innerpoly/test.fsx
@@ -475,6 +475,7 @@ module Bug11620B =
0
main ()
+
#endif
diff --git a/tests/fsharp/core/unitsOfMeasure/test.fs b/tests/fsharp/core/unitsOfMeasure/test.fs
index deafae9588a..93094a79892 100644
--- a/tests/fsharp/core/unitsOfMeasure/test.fs
+++ b/tests/fsharp/core/unitsOfMeasure/test.fs
@@ -29,16 +29,36 @@ let foo =
problem // Error: Incorrect number of type arguments to local call
-let nullReferenceError weightedList =
- let rec loop accumululatedWeight (remaining : float<'u> list) =
- match remaining with
- | [] -> accumululatedWeight
- | weight :: tail ->
- loop (accumululatedWeight + weight) tail
-
- loop 0.0<_> weightedList
-
-let ``is this null?`` = nullReferenceError [ 0.3; 0.3; 0.4 ]
+// This was causing bad codegen in debug code
+module InnerFunctionGenericOnlyByMeasure =
+ let nullReferenceError weightedList =
+ let rec loop accumululatedWeight (remaining : float<'u> list) =
+ match remaining with
+ | [] -> accumululatedWeight
+ | weight :: tail ->
+ loop (accumululatedWeight + weight) tail
+
+ loop 0.0<_> weightedList
+
+ let ``is this null?`` = nullReferenceError [ 0.3; 0.3; 0.4 ]
+
+// Another variation on the above test case, where the recursive thing is a type function generic unly by a unit of measure
+module TopLevelTypeFunctionGenericOnlyByMeasure =
+ type C< [] 'u> =
+ abstract Invoke: float<'u> list -> int
+
+ let rec loop<[]'u> =
+ { new C<'u> with
+ member _.Invoke(xs) =
+ match xs with
+ | [] -> 1
+ | weight :: tail ->
+ loop<'u>.Invoke(tail) }
+
+ let nullReferenceError2 (weightedList: float<'u> list) =
+ loop<'u>.Invoke(weightedList)
+
+ let ``is this null 2?`` = nullReferenceError2 [ 0.3; 0.3; 0.4 ]
module TestLibrary =
diff --git a/tests/fsharp/tests.fs b/tests/fsharp/tests.fs
index c310593cbe9..4d864994ec0 100644
--- a/tests/fsharp/tests.fs
+++ b/tests/fsharp/tests.fs
@@ -88,7 +88,7 @@ module CoreTests =
[]
let ``comprehensionshw-FSI_BASIC`` () = singleTestBuildAndRun "core/comprehensions-hw" FSI_BASIC
- []
+ []
let ``genericmeasures-FSC_BASIC_OPT_MINUS`` () = singleTestBuildAndRun "core/genericmeasures" FSC_BASIC_OPT_MINUS
[]