Skip to content

Commit

Permalink
* [MethodCalls.fs] Defining CallerArgs<'T> in, this replaces passing …
Browse files Browse the repository at this point in the history
…of callerArgsCount, uncurriedCallerArgs and other variants in the overload resolution logic happening in ConstraintSolver & TypeChecker

* [TypeChecker.fs] pass CallerArgs instace at call sites for overload resolution + some commented code as we'll be building a list of given argument types (probably moving as a CallerArgs method or property)
* [ConstraintSolver.fs/fsi] pipe the overload resolution traced callback to `trace.CollectThenUndoOrCommit` as that expression is long and more important in that context
  • Loading branch information
smoothdeveloper committed Apr 22, 2019
1 parent 6a11f3d commit 3533a60
Show file tree
Hide file tree
Showing 4 changed files with 65 additions and 34 deletions.
47 changes: 32 additions & 15 deletions src/fsharp/ConstraintSolver.fs
Original file line number Diff line number Diff line change
Expand Up @@ -158,7 +158,7 @@ type ContextInfo =
exception ConstraintSolverTupleDiffLengths of displayEnv: DisplayEnv * TType list * TType list * range * range
exception ConstraintSolverInfiniteTypes of displayEnv: DisplayEnv * contextInfo: ContextInfo * TType * TType * range * range
exception ConstraintSolverTypesNotInEqualityRelation of displayEnv: DisplayEnv * TType * TType * range * range * ContextInfo
exception ConstraintSolverTypesNotInSubsumptionRelation of displayEnv: DisplayEnv * TType * TType * range * range
exception ConstraintSolverTypesNotInSubsumptionRelation of displayEnv: DisplayEnv * argT: TType * paramT: TType * range * range
exception ConstraintSolverMissingConstraint of displayEnv: DisplayEnv * Tast.Typar * Tast.TyparConstraint * range * range
exception ConstraintSolverError of string * range * range
exception ConstraintSolverRelatedInformation of string option * range * exn
Expand Down Expand Up @@ -1367,13 +1367,30 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload
// curried members may not be used to satisfy constraints
|> List.choose (fun minfo ->
if minfo.IsCurried then None else
let callerArgs = argtys |> List.map (fun argty -> CallerArg(argty, m, false, dummyExpr))
let callerArgs =
{ Unnamed = List.singleton (argtys |> List.map (fun argty -> CallerArg(argty, m, false, dummyExpr)))
Named = List.singleton List.empty }
let minst = FreshenMethInfo m minfo
let objtys = minfo.GetObjArgTypes(amap, m, minst)
Some(CalledMeth<Expr>(csenv.InfoReader, None, false, FreshenMethInfo, m, AccessibleFromEverywhere, minfo, minst, minst, None, objtys, [(callerArgs, [])], false, false, None)))
Some(CalledMeth<Expr>(csenv.InfoReader, None, false, FreshenMethInfo, m, AccessibleFromEverywhere, minfo, minst, minst, None, objtys, callerArgs, false, false, None)))

let methOverloadResult, errors =
trace.CollectThenUndoOrCommit (fun (a, _) -> Option.isSome a) (fun trace -> ResolveOverloading csenv (WithTrace trace) nm ndeep (Some traitInfo) (0, 0) AccessibleFromEverywhere calledMethGroup false (Some rty))
(fun trace ->
let permitOptArgs = false

ResolveOverloading
csenv
(WithTrace trace)
nm
ndeep
(Some traitInfo)
CallerArgs.Empty
AccessibleFromEverywhere
calledMethGroup
permitOptArgs
(Some rty)
)
|> trace.CollectThenUndoOrCommit (fun (a, _) -> Option.isSome a)

match anonRecdPropSearch, recdPropSearch, methOverloadResult with
| Some (anonInfo, tinst, i), None, None ->
Expand Down Expand Up @@ -2286,15 +2303,15 @@ and ReportNoCandidatesErrorSynExpr csenv callerArgCounts methodName ad calledMet
// This is used after analyzing the types of arguments
and ResolveOverloading
(csenv: ConstraintSolverEnv)
trace // The undo trace, if any
methodName // The name of the method being called, for error reporting
ndeep // Depth of inference
cx // We're doing overload resolution as part of constraint solving, where special rules apply for op_Explicit and op_Implicit constraints.
callerArgCounts // How many named/unnamed args id the caller provide?
ad // The access domain of the caller, e.g. a module, type etc.
calledMethGroup // The set of methods being called
permitOptArgs // Can we supply optional arguments?
reqdRetTyOpt // The expected return type, if known
trace // The undo trace, if any
methodName // The name of the method being called, for error reporting
ndeep // Depth of inference
cx // We're doing overload resolution as part of constraint solving, where special rules apply for op_Explicit and op_Implicit constraints.
(callerArgs: CallerArgs<Expr>)
ad // The access domain of the caller, e.g. a module, type etc.
calledMethGroup // The set of methods being called
permitOptArgs // Can we supply optional arguments?
reqdRetTyOpt // The expected return type, if known
=
let g = csenv.g
let amap = csenv.amap
Expand All @@ -2313,7 +2330,7 @@ and ResolveOverloading
None, ErrorD (Error (FSComp.SR.csMethodNotFound(methodName), m)), NoTrace

| _, [] when not isOpConversion ->
None, ReportNoCandidatesErrorExpr csenv callerArgCounts methodName ad calledMethGroup, NoTrace
None, ReportNoCandidatesErrorExpr csenv callerArgs.CallerArgCounts methodName ad calledMethGroup, NoTrace

| _, _ ->

Expand Down Expand Up @@ -2555,7 +2572,7 @@ and ResolveOverloading
let msg =
match methodNames with
| [] -> msg
| names -> sprintf "%s %s" msg (sprintf "fooo %s" (String.concat ", " names)) // FSComp.SR.csCandidates (String.concat ", " names))
| names -> sprintf "%s %s" msg (FSComp.SR.csCandidates (String.concat System.Environment.NewLine names)) // FSComp.SR.csCandidates (String.concat ", " names))
None, ErrorD (failOverloading msg []), NoTrace

// If we've got a candidate solution: make the final checks - no undo here!
Expand Down
4 changes: 2 additions & 2 deletions src/fsharp/ConstraintSolver.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -79,7 +79,7 @@ type ContextInfo =
exception ConstraintSolverTupleDiffLengths of displayEnv: DisplayEnv * TType list * TType list * range * range
exception ConstraintSolverInfiniteTypes of displayEnv: DisplayEnv * contextInfo: ContextInfo * TType * TType * range * range
exception ConstraintSolverTypesNotInEqualityRelation of displayEnv: DisplayEnv * TType * TType * range * range * ContextInfo
exception ConstraintSolverTypesNotInSubsumptionRelation of displayEnv: DisplayEnv * TType * TType * range * range
exception ConstraintSolverTypesNotInSubsumptionRelation of displayEnv: DisplayEnv * argT: TType * paramT: TType * range * range
exception ConstraintSolverMissingConstraint of displayEnv: DisplayEnv * Typar * TyparConstraint * range * range
exception ConstraintSolverError of string * range * range
exception ConstraintSolverRelatedInformation of string option * range * exn
Expand Down Expand Up @@ -117,7 +117,7 @@ val SimplifyMeasuresInTypeScheme : TcGlobals -> bool -> Typars -> TT
val SolveTyparEqualsType : ConstraintSolverEnv -> int -> range -> OptionalTrace -> TType -> TType -> OperationResult<unit>
val SolveTypeEqualsTypeKeepAbbrevs : ConstraintSolverEnv -> int -> range -> OptionalTrace -> TType -> TType -> OperationResult<unit>
val CanonicalizeRelevantMemberConstraints : ConstraintSolverEnv -> int -> OptionalTrace -> Typars -> OperationResult<unit>
val ResolveOverloading : ConstraintSolverEnv -> OptionalTrace -> string -> ndeep: int -> TraitConstraintInfo option -> int * int -> AccessorDomain -> CalledMeth<Expr> list -> bool -> TType option -> CalledMeth<Expr> option * OperationResult<unit>
val ResolveOverloading : ConstraintSolverEnv -> OptionalTrace -> methodName: string -> ndeep: int -> cx: TraitConstraintInfo option -> callerArgs: CallerArgs<Expr> -> AccessorDomain -> calledMethGroup: CalledMeth<Expr> list -> permitOptArgs: bool -> reqdRetTyOpt: TType option -> CalledMeth<Expr> option * OperationResult<unit>
val UnifyUniqueOverloading : ConstraintSolverEnv -> int * int -> string -> AccessorDomain -> CalledMeth<SynExpr> list -> TType -> OperationResult<bool>
val EliminateConstraintsForGeneralizedTypars : ConstraintSolverEnv -> OptionalTrace -> Typars -> unit

Expand Down
35 changes: 23 additions & 12 deletions src/fsharp/MethodCalls.fs
Original file line number Diff line number Diff line change
Expand Up @@ -99,6 +99,16 @@ type CallerNamedArg<'T> =
member x.Name = x.Ident.idText
member x.CallerArg = (let (CallerNamedArg(_, a)) = x in a)

/// Represents the list of unnamed / named arguments at method call site
// todo: figure out / document why we are using list²
[<Struct>]
type CallerArgs<'T> =
{ Unnamed: CallerArg<'T> list list
Named: CallerNamedArg<'T> list list }
with
static member Empty : CallerArgs<'T> = { Unnamed = List.empty; Named = List.empty }
member x.CallerArgCounts = (List.length x.Unnamed, List.length x.Named)
member x.CurriedCallerArgs = List.zip x.Unnamed x.Named
//-------------------------------------------------------------------------
// Callsite conversions
//-------------------------------------------------------------------------
Expand Down Expand Up @@ -229,27 +239,28 @@ type CalledMeth<'T>
(infoReader: InfoReader,
nameEnv: NameResolutionEnv option,
isCheckingAttributeCall,
freshenMethInfo, // a function to help generate fresh type variables the property setters methods in generic classes
m,
ad, // the access domain of the place where the call is taking place
minfo: MethInfo, // the method we're attempting to call
calledTyArgs, // the 'called type arguments', i.e. the fresh generic instantiation of the method we're attempting to call
callerTyArgs: TType list, // the 'caller type arguments', i.e. user-given generic instantiation of the method we're attempting to call
freshenMethInfo, // a function to help generate fresh type variables the property setters methods in generic classes
m, // range
ad, // the access domain of the place where the call is taking place
minfo: MethInfo, // the method we're attempting to call
calledTyArgs, // the 'called type arguments', i.e. the fresh generic instantiation of the method we're attempting to call
callerTyArgs: TType list, // the 'caller type arguments', i.e. user-given generic instantiation of the method we're attempting to call
pinfoOpt: PropInfo option, // the property related to the method we're attempting to call, if any
callerObjArgTys: TType list, // the types of the actual object argument, if any
curriedCallerArgs: (CallerArg<'T> list * CallerNamedArg<'T> list) list, // the data about any arguments supplied by the caller
allowParamArgs: bool, // do we allow the use of a param args method in its "expanded" form?
allowOutAndOptArgs: bool, // do we allow the use of the transformation that converts out arguments as tuple returns?
callerObjArgTys: TType list, // the types of the actual object argument, if any
callerArgs: CallerArgs<'T>, // the data about any arguments supplied by the caller
allowParamArgs: bool, // do we allow the use of a param args method in its "expanded" form?
allowOutAndOptArgs: bool, // do we allow the use of the transformation that converts out arguments as tuple returns?
tyargsOpt : TType option) // method parameters
=
let g = infoReader.g
let methodRetTy = minfo.GetFSharpReturnTy(infoReader.amap, m, calledTyArgs)

let fullCurriedCalledArgs = MakeCalledArgs infoReader.amap m minfo calledTyArgs
do assert (fullCurriedCalledArgs.Length = fullCurriedCalledArgs.Length)

let argSetInfos =
(curriedCallerArgs, fullCurriedCalledArgs) ||> List.map2 (fun (unnamedCallerArgs, namedCallerArgs) fullCalledArgs ->
(callerArgs.CurriedCallerArgs, fullCurriedCalledArgs)
||> List.map2 (fun (unnamedCallerArgs, namedCallerArgs) fullCalledArgs ->
// Find the arguments not given by name
let unnamedCalledArgs =
fullCalledArgs |> List.filter (fun calledArg ->
Expand Down
13 changes: 8 additions & 5 deletions src/fsharp/TypeChecker.fs
Original file line number Diff line number Diff line change
Expand Up @@ -9776,7 +9776,7 @@ and TcMethodApplication

let callerArgCounts = (List.sumBy List.length unnamedCurriedCallerArgs, List.sumBy List.length namedCurriedCallerArgs)

let callerArgs = List.zip unnamedCurriedCallerArgs namedCurriedCallerArgs
let callerArgs = { Unnamed = unnamedCurriedCallerArgs; Named = namedCurriedCallerArgs }

let makeOneCalledMeth (minfo, pinfoOpt, usesParamArrayConversion) =
let minst = FreshenMethInfo mItem minfo
Expand Down Expand Up @@ -9876,8 +9876,12 @@ and TcMethodApplication
/// Select the called method that's the result of overload resolution
let finalCalledMeth =

let callerArgs = List.zip unnamedCurriedCallerArgs namedCurriedCallerArgs

let callerArgs = { Unnamed = unnamedCurriedCallerArgs ; Named = namedCurriedCallerArgs }
//let argumentTypesWithNames = [
// yield! (unnamedCurriedCallerArgs |> List.map (List.map (fun i -> None, i.Type)))
// yield! (namedCurriedCallerArgs |> List.map (List.map (fun i -> Some i.Name, i.CallerArg.Type)))
//]
//printfn "%A" argumentTypesWithNames
let postArgumentTypeCheckingCalledMethGroup =
preArgumentTypeCheckingCalledMethGroup |> List.map (fun (minfo: MethInfo, minst, pinfoOpt, usesParamArrayConversion) ->
let callerTyArgs =
Expand All @@ -9886,7 +9890,6 @@ and TcMethodApplication
| None -> minst
CalledMeth<Expr>(cenv.infoReader, Some(env.NameEnv), isCheckingAttributeCall, FreshenMethInfo, mMethExpr, ad, minfo, minst, callerTyArgs, pinfoOpt, callerObjArgTys, callerArgs, usesParamArrayConversion, true, objTyOpt))

let callerArgCounts = (unnamedCurriedCallerArgs.Length, namedCurriedCallerArgs.Length)
let csenv = MakeConstraintSolverEnv ContextInfo.NoContext cenv.css mMethExpr denv

// Commit unassociated constraints prior to member overload resolution where there is ambiguity
Expand All @@ -9897,7 +9900,7 @@ and TcMethodApplication
(unnamedCurriedCallerArgs |> List.collectSquared (fun callerArg -> freeInTypeLeftToRight cenv.g false callerArg.Type)))

let result, errors =
ResolveOverloading csenv NoTrace methodName 0 None callerArgCounts ad postArgumentTypeCheckingCalledMethGroup true (Some returnTy)
ResolveOverloading csenv NoTrace methodName 0 None callerArgs ad postArgumentTypeCheckingCalledMethGroup true (Some returnTy)

match afterResolution, result with
| AfterResolution.DoNothing, _ -> ()
Expand Down

0 comments on commit 3533a60

Please sign in to comment.