cleanup and pre-prep for dotnet#6810 (dotnet#8503)

Author: dsyme

src/fsharp/ConstraintSolver.fs

@@ -3024,130 +3024,22 @@ let ApplyTyparDefaultAtPriority denv css priority (tp: Typar) =
                 |> RaiseOperationResult
         | _ -> ())
 
+let CreateCodegenState tcVal g amap = 
+    { g = g
+      amap = amap
+      TcVal = tcVal
+      ExtraCxs = HashMultiMap(10, HashIdentity.Structural)
+      InfoReader = new InfoReader(g, amap) }
+
 let CodegenWitnessThatTypeSupportsTraitConstraint tcVal g amap m (traitInfo: TraitConstraintInfo) argExprs = trackErrors {
-    let css = 
-        { g = g
-          amap = amap
-          TcVal = tcVal
-          ExtraCxs = HashMultiMap(10, HashIdentity.Structural)
-          InfoReader = new InfoReader(g, amap) }
+    let css = CreateCodegenState tcVal g amap
 
     let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m (DisplayEnv.Empty g)
 
     let! _res = SolveMemberConstraint csenv true PermitWeakResolution.Yes 0 m NoTrace traitInfo
 
-    let sln = 
-        match traitInfo.Solution with 
-        | None -> Choice5Of5()
-        | Some sln ->
-
-            // Given the solution information, reconstruct the MethInfo for the solution
-            match sln with 
-            | ILMethSln(origTy, extOpt, mref, minst) ->
-                let metadataTy = convertToTypeWithMetadataIfPossible g origTy
-                let tcref = tcrefOfAppTy g metadataTy
-                let mdef = IL.resolveILMethodRef tcref.ILTyconRawMetadata mref
-                let ilMethInfo =
-                    match extOpt with 
-                    | None -> MethInfo.CreateILMeth(amap, m, origTy, mdef)
-                    | Some ilActualTypeRef -> 
-                        let actualTyconRef = Import.ImportILTypeRef amap m ilActualTypeRef 
-                        MethInfo.CreateILExtensionMeth(amap, m, origTy, actualTyconRef, None, mdef)
-                Choice1Of5 (ilMethInfo, minst)
-
-            | FSMethSln(ty, vref, minst) ->
-                Choice1Of5  (FSMeth(g, ty, vref, None), minst)
-
-            | FSRecdFieldSln(tinst, rfref, isSetProp) ->
-                Choice2Of5  (tinst, rfref, isSetProp)
-
-            | FSAnonRecdFieldSln(anonInfo, tinst, i) -> 
-                Choice3Of5  (anonInfo, tinst, i)
-
-            | BuiltInSln -> 
-                Choice5Of5 ()
-
-            | ClosedExprSln expr -> 
-                Choice4Of5 expr
-    return!
-        match sln with
-        | Choice1Of5(minfo, methArgTys) -> 
-            let argExprs = 
-                // FIX for #421894 - typechecker assumes that coercion can be applied for the trait calls arguments but codegen doesn't emit coercion operations
-                // result - generation of non-verifiable code
-                // fix - apply coercion for the arguments (excluding 'receiver' argument in instance calls)
-
-                // flatten list of argument types (looks like trait calls with curried arguments are not supported so we can just convert argument list in straightforward way)
-                let argTypes =
-                    minfo.GetParamTypes(amap, m, methArgTys) 
-                    |> List.concat 
-                // do not apply coercion to the 'receiver' argument
-                let receiverArgOpt, argExprs = 
-                    if minfo.IsInstance then
-                        match argExprs with
-                        | h :: t -> Some h, t
-                        | argExprs -> None, argExprs
-                    else None, argExprs
-                let convertedArgs = (argExprs, argTypes) ||> List.map2 (fun expr expectedTy -> mkCoerceIfNeeded g expectedTy (tyOfExpr g expr) expr)
-                match receiverArgOpt with
-                | Some r -> r :: convertedArgs
-                | None -> convertedArgs
-
-            // Fix bug 1281: If we resolve to an instance method on a struct and we haven't yet taken 
-            // the address of the object then go do that 
-            if minfo.IsStruct && minfo.IsInstance && (match argExprs with [] -> false | h :: _ -> not (isByrefTy g (tyOfExpr g h))) then 
-                let h, t = List.headAndTail argExprs
-                let wrap, h', _readonly, _writeonly = mkExprAddrOfExpr g true false PossiblyMutates h None m 
-                ResultD (Some (wrap (Expr.Op (TOp.TraitCall (traitInfo), [], (h' :: t), m))))
-            else        
-                ResultD (Some (MakeMethInfoCall amap m minfo methArgTys argExprs ))
-
-        | Choice2Of5 (tinst, rfref, isSet) -> 
-            let res = 
-                match isSet, rfref.RecdField.IsStatic, argExprs.Length with 
-
-                // static setter
-                | true, true, 1 -> 
-                    Some (mkStaticRecdFieldSet (rfref, tinst, argExprs.[0], m))
-
-                // instance setter
-                | true, false, 2 -> 
-                    // If we resolve to an instance field on a struct and we haven't yet taken 
-                    // the address of the object then go do that 
-                    if rfref.Tycon.IsStructOrEnumTycon && not (isByrefTy g (tyOfExpr g argExprs.[0])) then 
-                        let h = List.head argExprs
-                        let wrap, h', _readonly, _writeonly = mkExprAddrOfExpr g true false DefinitelyMutates h None m 
-                        Some (wrap (mkRecdFieldSetViaExprAddr (h', rfref, tinst, argExprs.[1], m)))
-                    else        
-                        Some (mkRecdFieldSetViaExprAddr (argExprs.[0], rfref, tinst, argExprs.[1], m))
-
-                // static getter
-                | false, true, 0 -> 
-                        Some (mkStaticRecdFieldGet (rfref, tinst, m))
-
-                // instance getter
-                | false, false, 1 -> 
-                        if rfref.Tycon.IsStructOrEnumTycon && isByrefTy g (tyOfExpr g argExprs.[0]) then 
-                            Some (mkRecdFieldGetViaExprAddr (argExprs.[0], rfref, tinst, m))
-                        else 
-                            Some (mkRecdFieldGet g (argExprs.[0], rfref, tinst, m))
-                | _ -> None 
-            ResultD res
-
-        | Choice3Of5 (anonInfo, tinst, i) -> 
-            let res = 
-                let tupInfo = anonInfo.TupInfo
-                if evalTupInfoIsStruct tupInfo && isByrefTy g (tyOfExpr g argExprs.[0]) then 
-                    Some (mkAnonRecdFieldGetViaExprAddr (anonInfo, argExprs.[0], tinst, i, m))
-                else 
-                    Some (mkAnonRecdFieldGet g (anonInfo, argExprs.[0], tinst, i, m))
-            ResultD res
-
-        | Choice4Of5 expr ->
-            ResultD (Some (MakeApplicationAndBetaReduce g (expr, tyOfExpr g expr, [], argExprs, m)))
-
-        | Choice5Of5 () ->
-            ResultD None
+    let sln = GenWitnessExpr amap g m traitInfo argExprs
+    return sln
   }
 
 let ChooseTyparSolutionAndSolve css denv tp =

src/fsharp/IlxGen.fs

@@ -3789,9 +3789,9 @@ and GenQuotation cenv cgbuf eenv (ast, conv, m, ety) sequel =
         | None ->
             try
                 let qscope = QuotationTranslator.QuotationGenerationScope.Create (g, cenv.amap, cenv.viewCcu, QuotationTranslator.IsReflectedDefinition.No)
-                let astSpec = QuotationTranslator.ConvExprPublic qscope QuotationTranslator.QuotationTranslationEnv.Empty ast
-                let referencedTypeDefs, spliceTypes, spliceArgExprs = qscope.Close()
-                referencedTypeDefs, List.map fst spliceTypes, List.map fst spliceArgExprs, astSpec
+                let astSpec = QuotationTranslator.ConvExprPublic qscope ast
+                let referencedTypeDefs, typeSplices, exprSplices = qscope.Close()
+                referencedTypeDefs, List.map fst typeSplices, List.map fst exprSplices, astSpec
             with
                 QuotationTranslator.InvalidQuotedTerm e -> error e
 
@@ -7579,14 +7579,7 @@ let GenerateCode (cenv, anonTypeTable, eenv, TypedAssemblyAfterOptimization file
             let defns =
               reflectedDefinitions |> List.choose (fun ((methName, v), e) ->
                     try
-                      let ety = tyOfExpr g e
-                      let tps, taue, _ =
-                        match e with
-                        | Expr.TyLambda (_, tps, b, _, _) -> tps, b, applyForallTy g ety (List.map mkTyparTy tps)
-                        | _ -> [], e, ety
-                      let env = QuotationTranslator.QuotationTranslationEnv.Empty.BindTypars tps
-                      let astExpr = QuotationTranslator.ConvExprPublic qscope env taue
-                      let mbaseR = QuotationTranslator.ConvMethodBase qscope env (methName, v)
+                      let mbaseR, astExpr = QuotationTranslator.ConvReflectedDefinition qscope methName v e
 
                       Some(mbaseR, astExpr)
                     with

src/fsharp/MethodCalls.fs

@@ -1782,3 +1782,126 @@ let CheckRecdFieldMutation m denv (rfinfo: RecdFieldInfo) =
     if not rfinfo.RecdField.IsMutable then
         errorR (FieldNotMutable (denv, rfinfo.RecdFieldRef, m))
 
+
+/// Generate a witness for the given (solved) constraint.  Five possiblilities are taken
+/// into account.
+///   1. The constraint is solved by a .NET-declared method or an F#-declared method
+///   2. The constraint is solved by an F# record field
+///   3. The constraint is solved by an F# anonymous record field
+///   4. The constraint is considered solved by a "built in" solution
+///   5. The constraint is solved by a closed expression given by a provided method from a type provider
+/// 
+/// In each case an expression is returned where the method is applied to the given arguments, or the
+/// field is dereferenced.
+/// 
+/// None is returned in the cases where the trait has not been solved (e.g. is part of generic code)
+/// or there is an unexpected mismatch of some kind.
+let GenWitnessExpr amap g m (traitInfo: TraitConstraintInfo) argExprs =
+
+    let sln = 
+        match traitInfo.Solution with 
+        | None -> Choice5Of5()
+        | Some sln ->
+
+            // Given the solution information, reconstruct the MethInfo for the solution
+            match sln with 
+            | ILMethSln(origTy, extOpt, mref, minst) ->
+                let metadataTy = convertToTypeWithMetadataIfPossible g origTy
+                let tcref = tcrefOfAppTy g metadataTy
+                let mdef = resolveILMethodRef tcref.ILTyconRawMetadata mref
+                let ilMethInfo =
+                    match extOpt with 
+                    | None -> MethInfo.CreateILMeth(amap, m, origTy, mdef)
+                    | Some ilActualTypeRef -> 
+                        let actualTyconRef = Import.ImportILTypeRef amap m ilActualTypeRef 
+                        MethInfo.CreateILExtensionMeth(amap, m, origTy, actualTyconRef, None, mdef)
+                Choice1Of5 (ilMethInfo, minst)
+
+            | FSMethSln(ty, vref, minst) ->
+                Choice1Of5  (FSMeth(g, ty, vref, None), minst)
+
+            | FSRecdFieldSln(tinst, rfref, isSetProp) ->
+                Choice2Of5  (tinst, rfref, isSetProp)
+
+            | FSAnonRecdFieldSln(anonInfo, tinst, i) -> 
+                Choice3Of5  (anonInfo, tinst, i)
+
+            | BuiltInSln -> 
+                Choice5Of5 ()
+
+            | ClosedExprSln expr -> 
+                Choice4Of5 expr
+    match sln with
+    | Choice1Of5(minfo, methArgTys) -> 
+        let argExprs = 
+            // FIX for #421894 - typechecker assumes that coercion can be applied for the trait calls arguments but codegen doesn't emit coercion operations
+            // result - generation of non-verifiable code
+            // fix - apply coercion for the arguments (excluding 'receiver' argument in instance calls)
+
+            // flatten list of argument types (looks like trait calls with curried arguments are not supported so we can just convert argument list in straightforward way)
+            let argTypes =
+                minfo.GetParamTypes(amap, m, methArgTys) 
+                |> List.concat 
+            // do not apply coercion to the 'receiver' argument
+            let receiverArgOpt, argExprs = 
+                if minfo.IsInstance then
+                    match argExprs with
+                    | h :: t -> Some h, t
+                    | argExprs -> None, argExprs
+                else None, argExprs
+            let convertedArgs = (argExprs, argTypes) ||> List.map2 (fun expr expectedTy -> mkCoerceIfNeeded g expectedTy (tyOfExpr g expr) expr)
+            match receiverArgOpt with
+            | Some r -> r :: convertedArgs
+            | None -> convertedArgs
+
+        // Fix bug 1281: If we resolve to an instance method on a struct and we haven't yet taken 
+        // the address of the object then go do that 
+        if minfo.IsStruct && minfo.IsInstance && (match argExprs with [] -> false | h :: _ -> not (isByrefTy g (tyOfExpr g h))) then 
+            let h, t = List.headAndTail argExprs
+            let wrap, h', _readonly, _writeonly = mkExprAddrOfExpr g true false PossiblyMutates h None m 
+            Some (wrap (Expr.Op (TOp.TraitCall (traitInfo), [], (h' :: t), m)))
+        else        
+            Some (MakeMethInfoCall amap m minfo methArgTys argExprs )
+
+    | Choice2Of5 (tinst, rfref, isSet) -> 
+        match isSet, rfref.RecdField.IsStatic, argExprs.Length with 
+
+        // static setter
+        | true, true, 1 -> 
+            Some (mkStaticRecdFieldSet (rfref, tinst, argExprs.[0], m))
+
+        // instance setter
+        | true, false, 2 -> 
+            // If we resolve to an instance field on a struct and we haven't yet taken 
+            // the address of the object then go do that 
+            if rfref.Tycon.IsStructOrEnumTycon && not (isByrefTy g (tyOfExpr g argExprs.[0])) then 
+                let h = List.head argExprs
+                let wrap, h', _readonly, _writeonly = mkExprAddrOfExpr g true false DefinitelyMutates h None m 
+                Some (wrap (mkRecdFieldSetViaExprAddr (h', rfref, tinst, argExprs.[1], m)))
+            else        
+                Some (mkRecdFieldSetViaExprAddr (argExprs.[0], rfref, tinst, argExprs.[1], m))
+
+        // static getter
+        | false, true, 0 -> 
+                Some (mkStaticRecdFieldGet (rfref, tinst, m))
+
+        // instance getter
+        | false, false, 1 -> 
+                if rfref.Tycon.IsStructOrEnumTycon && isByrefTy g (tyOfExpr g argExprs.[0]) then 
+                    Some (mkRecdFieldGetViaExprAddr (argExprs.[0], rfref, tinst, m))
+                else 
+                    Some (mkRecdFieldGet g (argExprs.[0], rfref, tinst, m))
+        | _ -> None 
+
+    | Choice3Of5 (anonInfo, tinst, i) -> 
+        let tupInfo = anonInfo.TupInfo
+        if evalTupInfoIsStruct tupInfo && isByrefTy g (tyOfExpr g argExprs.[0]) then 
+            Some (mkAnonRecdFieldGetViaExprAddr (anonInfo, argExprs.[0], tinst, i, m))
+        else 
+            Some (mkAnonRecdFieldGet g (anonInfo, argExprs.[0], tinst, i, m))
+
+    | Choice4Of5 expr ->
+        Some (MakeApplicationAndBetaReduce g (expr, tyOfExpr g expr, [], argExprs, m))
+
+    | Choice5Of5 () ->
+        None

src/fsharp/PostInferenceChecks.fs

@@ -973,7 +973,7 @@ and CheckExpr (cenv: cenv) (env: env) origExpr (context: PermitByRefExpr) : Limi
             // Translate to quotation data
             try 
                 let qscope = QuotationTranslator.QuotationGenerationScope.Create (g, cenv.amap, cenv.viewCcu, QuotationTranslator.IsReflectedDefinition.No) 
-                let qdata = QuotationTranslator.ConvExprPublic qscope QuotationTranslator.QuotationTranslationEnv.Empty ast  
+                let qdata = QuotationTranslator.ConvExprPublic qscope ast  
                 let typeDefs, spliceTypes, spliceExprs = qscope.Close()
                 match savedConv.Value with 
                 | None -> savedConv:= Some (typeDefs, List.map fst spliceTypes, List.map fst spliceExprs, qdata)
@@ -1752,18 +1752,13 @@ and CheckBinding cenv env alwaysCheckNoReraise context (TBind(v, bindRhs, _) as
                 // no real need for that except that it helps us to bundle all reflected definitions up into 
                 // one blob for pickling to the binary format
                 try
-                    let ety = tyOfExpr g bindRhs
-                    let tps, taue, _ = 
-                      match bindRhs with 
-                      | Expr.TyLambda (_, tps, b, _, _) -> tps, b, applyForallTy g ety (List.map mkTyparTy tps)
-                      | _ -> [], bindRhs, ety
-                    let env = QuotationTranslator.QuotationTranslationEnv.Empty.BindTypars tps
                     let qscope = QuotationTranslator.QuotationGenerationScope.Create (g, cenv.amap, cenv.viewCcu, QuotationTranslator.IsReflectedDefinition.Yes) 
-                    QuotationTranslator.ConvExprPublic qscope env taue  |> ignore
-                    let _, _, argExprs = qscope.Close()
-                    if not (isNil argExprs) then 
+                    let methName = v.CompiledName g.CompilerGlobalState
+                    QuotationTranslator.ConvReflectedDefinition qscope methName v bindRhs |> ignore
+
+                    let _, _, exprSplices = qscope.Close()
+                    if not (isNil exprSplices) then 
                         errorR(Error(FSComp.SR.chkReflectedDefCantSplice(), v.Range))
-                    QuotationTranslator.ConvMethodBase qscope env (v.CompiledName g.CompilerGlobalState, v) |> ignore
                 with 
                   | QuotationTranslator.InvalidQuotedTerm e -> 
                           errorR e

src/fsharp/QuotationPickler.fs

@@ -45,8 +45,6 @@ type VarData =
       vType: TypeData
       vMutable: bool } 
 
-type FieldData = NamedTypeData * string
-type RecdFieldData = NamedTypeData * string
 type PropInfoData = NamedTypeData * string * TypeData * TypeData list
 
 type CombOp = 
@@ -145,15 +143,15 @@ let mkLetRec (ves, body) =
 
 let mkRecdMk      (n, tys, args)            = CombExpr(RecdMkOp n, tys, args)  
 
-let mkRecdGet     ((d1, d2), tyargs, args)   = CombExpr(RecdGetOp(d1, d2), tyargs, args)
+let mkRecdGet     (d1, d2, tyargs, args)   = CombExpr(RecdGetOp(d1, d2), tyargs, args)
 
-let mkRecdSet     ((d1, d2), tyargs, args)   = CombExpr(RecdSetOp(d1, d2), tyargs, args)
+let mkRecdSet     (d1, d2, tyargs, args)   = CombExpr(RecdSetOp(d1, d2), tyargs, args)
 
-let mkUnion         ((d1, d2), tyargs, args)   = CombExpr(SumMkOp(d1, d2), tyargs, args)
+let mkUnion         (d1, d2, tyargs, args)   = CombExpr(SumMkOp(d1, d2), tyargs, args)
 
-let mkUnionFieldGet ((d1, d2, d3), tyargs, arg) = CombExpr(SumFieldGetOp(d1, d2, d3), tyargs, [arg])
+let mkUnionFieldGet (d1, d2, d3, tyargs, arg) = CombExpr(SumFieldGetOp(d1, d2, d3), tyargs, [arg])
 
-let mkUnionCaseTagTest  ((d1, d2), tyargs, arg)    = CombExpr(SumTagTestOp(d1, d2), tyargs, [arg])
+let mkUnionCaseTagTest  (d1, d2, tyargs, arg)    = CombExpr(SumTagTestOp(d1, d2), tyargs, [arg])
 
 let mkTupleGet    (ty, n, e)                = CombExpr(TupleGetOp n, [ty], [e]) 
 
@@ -215,9 +213,9 @@ let mkPropGet  (d, tyargs, args) = CombExpr(PropGetOp(d), tyargs, args)
 
 let mkPropSet  (d, tyargs, args) = CombExpr(PropSetOp(d), tyargs, args)
 
-let mkFieldGet ((d1, d2), tyargs, args) = CombExpr(FieldGetOp(d1, d2), tyargs, args)
+let mkFieldGet (d1, d2, tyargs, args) = CombExpr(FieldGetOp(d1, d2), tyargs, args)
 
-let mkFieldSet ((d1, d2), tyargs, args) = CombExpr(FieldSetOp(d1, d2), tyargs, args)
+let mkFieldSet (d1, d2, tyargs, args) = CombExpr(FieldSetOp(d1, d2), tyargs, args)
 
 let mkCtorCall   (d, tyargs, args) = CombExpr(CtorCallOp(d), tyargs, args)
 
@@ -409,7 +407,11 @@ let p_PropInfoData a st =
 let p_CombOp x st = 
     match x with 
     | CondOp        -> p_byte 0 st
-    | ModuleValueOp (x, y, z) -> p_byte 1 st; p_tup3 p_NamedType p_string p_bool (x, y, z) st
+    | ModuleValueOp (x, y, z) -> 
+        p_byte 1 st
+        p_NamedType x st 
+        p_string y st 
+        p_bool z st
     | LetRecOp      -> p_byte 2 st
     | RecdMkOp  a   -> p_byte 3 st; p_NamedType a st
     | RecdGetOp  (x, y)  -> p_byte 4 st; p_recdFieldSpec (x, y) st