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

Avoid calling CanMemberSigsMatchUpToCheck twice #1685

Merged
merged 3 commits into from
Nov 7, 2016
Merged

Avoid calling CanMemberSigsMatchUpToCheck twice #1685

Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
6e1d614
Upgrade Trace class to support redo tupled with the existing undo
gusty Oct 30, 2016
0c257aa
Avoid calling twice CanMemberSigsMatchUpToCheck with ArgsMustSubsumeO…
gusty Oct 30, 2016
c3cc8b1
Encapsulate replay
gusty Oct 31, 2016
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
136 changes: 70 additions & 66 deletions src/fsharp/ConstraintSolver.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -304,30 +304,39 @@ let BakedInTraitConstraintNames =
// Run the constraint solver with undo (used during method overload resolution)

type Trace =
{ mutable actions: (unit -> unit) list }
{ mutable actions: ((unit -> unit) * (unit -> unit)) list }
static member New () = { actions = [] }
member t.Undo () = List.iter (fun a -> a ()) t.actions
member t.Push f = t.actions <- f :: t.actions
member t.Undo () = List.iter (fun (_, a) -> a ()) t.actions
member t.Push f undo = t.actions <- (f, undo) :: t.actions

type OptionalTrace =
| NoTrace
| WithTrace of Trace
member x.HasTrace = match x with NoTrace -> false | WithTrace _ -> true

member t.Exec f undo =
match t with
| WithTrace trace -> trace.Push f undo; f()
| NoTrace -> f()
member t.AddFromReplay source =
source.actions |> List.rev |>
match t with
| WithTrace trace -> List.iter (fun (action, undo) -> trace.Push action undo; action())
| NoTrace -> List.iter (fun (action, _ ) -> action())

let CollectThenUndo f =
let trace = Trace.New()
let res = f trace
trace.Undo();
res

let CheckThenUndo f = CollectThenUndo f |> CheckNoErrorsAndGetWarnings

let FilterEachThenUndo f meths =
meths |> List.choose (fun calledMeth ->
match CheckThenUndo (fun trace -> f trace calledMeth) with
let trace = Trace.New()
let res = f trace calledMeth
trace.Undo()
match res |> CheckNoErrorsAndGetWarnings with
| None -> None
| Some warns -> Some (calledMeth,warns.Length))
| Some warns -> Some (calledMeth,warns.Length,trace))

let ShowAccessDomain ad =
match ad with
Expand Down Expand Up @@ -411,16 +420,13 @@ let SubstMeasure (r:Typar) ms =
| None -> tp.typar_solution <- Some (TType_measure ms)
| Some _ -> error(InternalError("already solved",r.Range));

let rec TransactStaticReq (csenv:ConstraintSolverEnv) trace (tpr:Typar) req =
let rec TransactStaticReq (csenv:ConstraintSolverEnv) (trace:OptionalTrace) (tpr:Typar) req =
let m = csenv.m
if (tpr.Rigidity.ErrorIfUnified && tpr.StaticReq <> req) then
ErrorD(ConstraintSolverError(FSComp.SR.csTypeCannotBeResolvedAtCompileTime(tpr.Name),m,m))
else
let orig = tpr.StaticReq
match trace with
| NoTrace -> ()
| WithTrace trace -> trace.Push (fun () -> tpr.SetStaticReq orig)
tpr.SetStaticReq req;
trace.Exec (fun () -> tpr.SetStaticReq req) (fun () -> tpr.SetStaticReq orig)
CompleteD

and SolveTypStaticReqTypar (csenv:ConstraintSolverEnv) trace req (tpr:Typar) =
Expand All @@ -444,12 +450,9 @@ and SolveTypStaticReq (csenv:ConstraintSolverEnv) trace req ty =
SolveTypStaticReqTypar csenv trace req tpr
else CompleteD

let rec TransactDynamicReq trace (tpr:Typar) req =
let rec TransactDynamicReq (trace:OptionalTrace) (tpr:Typar) req =
let orig = tpr.DynamicReq
match trace with
| NoTrace -> ()
| WithTrace trace -> trace.Push (fun () -> tpr.SetDynamicReq orig)
tpr.SetDynamicReq req;
trace.Exec (fun () -> tpr.SetDynamicReq req) (fun () -> tpr.SetDynamicReq orig)
CompleteD

and SolveTypDynamicReq (csenv:ConstraintSolverEnv) trace req ty =
Expand Down Expand Up @@ -654,7 +657,7 @@ let CheckWarnIfRigid (csenv:ConstraintSolverEnv) ty1 (r:Typar) ty =

/// Add the constraint "ty1 = ty" to the constraint problem, where ty1 is a type variable.
/// Propagate all effects of adding this constraint, e.g. to solve other variables
let rec SolveTyparEqualsTyp (csenv:ConstraintSolverEnv) ndeep m2 trace ty1 ty =
let rec SolveTyparEqualsTyp (csenv:ConstraintSolverEnv) ndeep m2 (trace:OptionalTrace) ty1 ty =
let m = csenv.m

DepthCheck ndeep m ++ (fun () ->
Expand All @@ -673,10 +676,7 @@ let rec SolveTyparEqualsTyp (csenv:ConstraintSolverEnv) ndeep m2 trace ty1 ty =
// We may need to make use of the equation when solving the constraints.
// Record a entry in the undo trace if one is provided
let tpdata = r.Data
match trace with
| NoTrace -> ()
| WithTrace trace -> trace.Push (fun () -> tpdata.typar_solution <- None)
tpdata.typar_solution <- Some ty;
trace.Exec (fun () -> tpdata.typar_solution <- Some ty) (fun () -> tpdata.typar_solution <- None)

(* dprintf "setting typar %d to type %s at %a\n" r.Stamp ((DebugPrint.showType ty)) outputRange m; *)

Expand Down Expand Up @@ -1354,12 +1354,9 @@ and MemberConstraintSolutionOfRecdFieldInfo rfinfo isSet =
FSRecdFieldSln(rfinfo.TypeInst,rfinfo.RecdFieldRef,isSet)

/// Write into the reference cell stored in the TAST and add to the undo trace if necessary
and TransactMemberConstraintSolution traitInfo trace sln =
and TransactMemberConstraintSolution traitInfo (trace:OptionalTrace) sln =
let prev = traitInfo.Solution
traitInfo.Solution <- Some sln
match trace with
| NoTrace -> ()
| WithTrace trace -> trace.Push (fun () -> traitInfo.Solution <- prev)
trace.Exec (fun () -> traitInfo.Solution <- Some sln) (fun () -> traitInfo.Solution <- prev)

/// Only consider overload resolution if canonicalizing or all the types are now nominal.
/// That is, don't perform resolution if more nominal information may influence the set of available overloads
Expand Down Expand Up @@ -1414,19 +1411,14 @@ and SolveRelevantMemberConstraints (csenv:ConstraintSolverEnv) ndeep permitWeakR
else
ResultD false))

and SolveRelevantMemberConstraintsForTypar (csenv:ConstraintSolverEnv) ndeep permitWeakResolution trace tp =
and SolveRelevantMemberConstraintsForTypar (csenv:ConstraintSolverEnv) ndeep permitWeakResolution (trace:OptionalTrace) tp =
let cxst = csenv.SolverState.ExtraCxs
let tpn = tp.Stamp
let cxs = cxst.FindAll tpn
if List.isEmpty cxs then ResultD false else

cxs |> List.iter (fun _ -> cxst.Remove tpn);

assert (List.isEmpty (cxst.FindAll tpn))

match trace with
| NoTrace -> ()
| WithTrace trace -> trace.Push (fun () -> cxs |> List.iter (fun cx -> cxst.Add(tpn,cx)))
trace.Exec (fun () -> cxs |> List.iter (fun _ -> cxst.Remove tpn)) (fun () -> cxs |> List.iter (fun cx -> cxst.Add(tpn,cx)))
assert (List.isEmpty (cxst.FindAll tpn))

cxs |> AtLeastOneD (fun (traitInfo,m2) ->
let csenv = { csenv with m = m2 }
Expand All @@ -1451,10 +1443,7 @@ and AddMemberConstraint (csenv:ConstraintSolverEnv) ndeep m2 trace traitInfo sup

// check the constraint is not already listed for this type variable
if not (cxs |> List.exists (fun (traitInfo2,_) -> traitsAEquiv g aenv traitInfo traitInfo2)) then
match trace with
| NoTrace -> ()
| WithTrace trace -> trace.Push (fun () -> csenv.SolverState.ExtraCxs.Remove tpn)
csenv.SolverState.ExtraCxs.Add (tpn,(traitInfo,m2))
trace.Exec (fun () -> csenv.SolverState.ExtraCxs.Add (tpn,(traitInfo,m2))) (fun () -> csenv.SolverState.ExtraCxs.Remove tpn)
);

// Associate the constraint with each type variable in the support, so if the type variable
Expand Down Expand Up @@ -1627,10 +1616,7 @@ and AddConstraint (csenv:ConstraintSolverEnv) ndeep m2 trace tp newConstraint =
// Record a entry in the undo trace if one is provided
let d = tp.Data
let orig = d.typar_constraints
match trace with
| NoTrace -> ()
| WithTrace trace -> trace.Push (fun () -> d.typar_constraints <- orig)
d.typar_constraints <- newConstraints
trace.Exec (fun () -> d.typar_constraints <- newConstraints) (fun () -> d.typar_constraints <- orig)

CompleteD)))

Expand Down Expand Up @@ -2123,17 +2109,17 @@ and ResolveOverloading
let isOpConversion = (methodName = "op_Explicit" || methodName = "op_Implicit")
// See what candidates we have based on name and arity
let candidates = calledMethGroup |> List.filter (fun cmeth -> cmeth.IsCandidate(m,ad))
let calledMethOpt, errors =
let calledMethOpt, errors, calledMethTrace =

match calledMethGroup,candidates with
| _,[calledMeth] when not isOpConversion ->
Some calledMeth, CompleteD
Some calledMeth, CompleteD, NoTrace

| [],_ when not isOpConversion ->
None, ErrorD (Error (FSComp.SR.csMethodNotFound(methodName),m))
None, ErrorD (Error (FSComp.SR.csMethodNotFound(methodName),m)), NoTrace

| _,[] when not isOpConversion ->
None, ReportNoCandidatesError csenv callerArgCounts methodName ad calledMethGroup
None, ReportNoCandidatesError csenv callerArgCounts methodName ad calledMethGroup, NoTrace

| _,_ ->

Expand All @@ -2157,8 +2143,8 @@ and ResolveOverloading
(ArgsEquivInsideUndo csenv cx.IsSome)
reqdRetTyOpt
calledMeth) with
| [(calledMeth,_)] ->
Some calledMeth, CompleteD
| [(calledMeth,_,_)] ->
Some calledMeth, CompleteD, NoTrace // Can't re-play the trace since ArgsEquivInsideUndo was used

| _ ->
// Now determine the applicable methods.
Expand Down Expand Up @@ -2215,10 +2201,10 @@ and ResolveOverloading
| OkResult _ -> None
| ErrorResult(_,exn) -> Some (calledMeth, exn)))

None,ErrorD (failOverloading (FSComp.SR.csNoOverloadsFound methodName) errors)
None,ErrorD (failOverloading (FSComp.SR.csNoOverloadsFound methodName) errors), NoTrace

| [(calledMeth,_)] ->
Some calledMeth, CompleteD
| [(calledMeth,_,t)] ->
Some calledMeth, CompleteD, WithTrace t

| applicableMeths ->

Expand Down Expand Up @@ -2254,7 +2240,7 @@ and ResolveOverloading
if c <> 0 then c else
0

let better (candidate:CalledMeth<_>, candidateWarnCount) (other:CalledMeth<_>, otherWarnCount) =
let better (candidate:CalledMeth<_>, candidateWarnCount, _) (other:CalledMeth<_>, otherWarnCount, _) =
// Prefer methods that don't give "this code is less generic" warnings
// Note: Relies on 'compare' respecting true > false
let c = compare (candidateWarnCount = 0) (otherWarnCount = 0)
Expand Down Expand Up @@ -2345,7 +2331,7 @@ and ResolveOverloading
else
None)
match bestMethods with
| [(calledMeth,_)] -> Some(calledMeth), CompleteD
| [(calledMeth,_,t)] -> Some(calledMeth), CompleteD, WithTrace t
| bestMethods ->
let methodNames =
let methods =
Expand All @@ -2356,8 +2342,8 @@ and ResolveOverloading
| [] ->
match applicableMeths with
| [] -> candidates
| m -> m |> List.map fst
| m -> m |> List.map fst
| m -> m |> List.map (fun (x,_,_) -> x)
| m -> m |> List.map (fun (x,_,_) -> x)
methods
|> List.map (fun cmeth -> NicePrint.stringOfMethInfo amap m denv cmeth.Method)
|> List.sort
Expand All @@ -2366,7 +2352,7 @@ and ResolveOverloading
match methodNames with
| [] -> msg
| names -> sprintf "%s %s" msg (FSComp.SR.csCandidates (String.concat ", " names))
None, ErrorD (failOverloading msg [])
None, ErrorD (failOverloading msg []), NoTrace

// If we've got a candidate solution: make the final checks - no undo here!
// Allow subsumption on arguments. Include the return type.
Expand All @@ -2375,7 +2361,11 @@ and ResolveOverloading
| Some(calledMeth) ->
calledMethOpt,
errors ++ (fun () ->
let cxsln = Option.map (fun traitInfo -> (traitInfo, MemberConstraintSolutionOfMethInfo csenv.SolverState m calledMeth.Method calledMeth.CalledTyArgs)) cx
let cxsln = Option.map (fun traitInfo -> (traitInfo, MemberConstraintSolutionOfMethInfo csenv.SolverState m calledMeth.Method calledMeth.CalledTyArgs)) cx
match calledMethTrace with
| NoTrace ->

// No trace available for CanMemberSigsMatchUpToCheck with ArgsMustSubsumeOrConvert
CanMemberSigsMatchUpToCheck
csenv
permitOptArgs
Expand All @@ -2384,7 +2374,25 @@ and ResolveOverloading
(TypesMustSubsumeOrConvertInsideUndo csenv ndeep trace cxsln m)// REVIEW: this should not be an "InsideUndo" operation
(ArgsMustSubsumeOrConvert csenv ndeep trace cxsln cx.IsSome)
reqdRetTyOpt
calledMeth)
calledMeth
| WithTrace calledMethTrc ->

// Re-play existing trace
trace.AddFromReplay calledMethTrc

// Unify return type
match reqdRetTyOpt with
| None -> CompleteD
| Some _ when calledMeth.Method.IsConstructor -> CompleteD
| Some reqdRetTy ->
let methodRetTy =
if List.isEmpty calledMeth.UnnamedCalledOutArgs then
calledMeth.ReturnType
else
let outArgTys = calledMeth.UnnamedCalledOutArgs |> List.map (fun calledArg -> destByrefTy g calledArg.CalledArgumentType)
if isUnitTy g calledMeth.ReturnType then mkRefTupledTy g outArgTys
else mkRefTupledTy g (calledMeth.ReturnType :: outArgTys)
MustUnify csenv ndeep trace cxsln reqdRetTy methodRetTy)

| None ->
None, errors
Expand Down Expand Up @@ -2425,17 +2433,13 @@ let UnifyUniqueOverloading
| _ ->
ResultD false

let EliminateConstraintsForGeneralizedTypars csenv trace (generalizedTypars: Typars) =
let EliminateConstraintsForGeneralizedTypars csenv (trace:OptionalTrace) (generalizedTypars: Typars) =
// Remove the global constraints where this type variable appears in the support of the constraint
generalizedTypars |> List.iter (fun tp ->
let tpn = tp.Stamp
let cxst = csenv.SolverState.ExtraCxs
let cxs = cxst.FindAll tpn
cxs |> List.iter (fun cx ->
cxst.Remove tpn
match trace with
| NoTrace -> ()
| WithTrace trace -> trace.Push (fun () -> (csenv.SolverState.ExtraCxs.Add (tpn,cx))))
cxs |> List.iter (fun cx -> trace.Exec (fun () -> cxst.Remove tpn) (fun () -> (csenv.SolverState.ExtraCxs.Add (tpn,cx))))
)


Expand Down