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

cleanup and pre-prep for #6810 #8503

Merged
merged 1 commit into from
Feb 7, 2020
Merged

cleanup and pre-prep for #6810 #8503

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
128 changes: 10 additions & 118 deletions src/fsharp/ConstraintSolver.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down
15 changes: 4 additions & 11 deletions src/fsharp/IlxGen.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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
Expand Down
123 changes: 123 additions & 0 deletions src/fsharp/MethodCalls.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
17 changes: 6 additions & 11 deletions src/fsharp/PostInferenceChecks.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand Down
22 changes: 12 additions & 10 deletions src/fsharp/QuotationPickler.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down Expand Up @@ -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])

Expand Down Expand Up @@ -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)

Expand Down Expand Up @@ -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
Expand Down
Loading