Skip to content

Commit

Permalink
Propose to use :> instead of :?> - fixes dotnet#1127
Browse files Browse the repository at this point in the history
  • Loading branch information
@forki
forki committed May 11, 2016
1 parent f53d92a commit 4cda2e7
Show file tree
Hide file tree
Showing 18 changed files with 162 additions and 86 deletions.
33 changes: 22 additions & 11 deletions src/fsharp/CompileOps.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -118,7 +118,7 @@ let GetRangeOfError(err:PhasedError) =
| IndentationProblem(_,m)
| ErrorFromAddingTypeEquation(_,_,_,_,_,_,m)
| ErrorFromApplyingDefault(_,_,_,_,_,m)
| ErrorsFromAddingSubsumptionConstraint(_,_,_,_,_,m)
| ErrorsFromAddingSubsumptionConstraint(_,_,_,_,_,_,m)
| FunctionExpected(_,_,m)
| BakedInMemberConstraintName(_,m)
| StandardOperatorRedefinitionWarning(_,m)
Expand Down Expand Up @@ -369,6 +369,7 @@ let GetErrorNumber(err:PhasedError) =
#if EXTENSIONTYPING
| :? TypeProviderError as e -> e.Number
#endif
| ErrorsFromAddingSubsumptionConstraint (_,_,_,_,_,ContextInfo.DowncastUsedInsteadOfUpcast _,_) -> fst (FSComp.SR.considerUpcast("",""))
| _ -> 193
GetFromException err.Exception

Expand Down Expand Up @@ -413,9 +414,9 @@ let SplitRelatedErrors(err:PhasedError) =
| ErrorFromApplyingDefault(g,denv,tp,defaultType,e,m) ->
let e,related = SplitRelatedException e
ErrorFromApplyingDefault(g,denv,tp,defaultType,e.Exception,m)|>ToPhased, related
| ErrorsFromAddingSubsumptionConstraint(g,denv,t1,t2,e,m) ->
| ErrorsFromAddingSubsumptionConstraint(g,denv,t1,t2,e,contextInfo,m) ->
let e,related = SplitRelatedException e
ErrorsFromAddingSubsumptionConstraint(g,denv,t1,t2,e.Exception,m)|>ToPhased, related
ErrorsFromAddingSubsumptionConstraint(g,denv,t1,t2,e.Exception,contextInfo,m)|>ToPhased, related
| ErrorFromAddingConstraint(x,e,m) ->
let e,related = SplitRelatedException e
ErrorFromAddingConstraint(x,e.Exception,m)|>ToPhased, related
Expand Down Expand Up @@ -645,7 +646,7 @@ let OutputPhasedErrorR (os:System.Text.StringBuilder) (err:PhasedError) =
match contextInfo with
| ContextInfo.OmittedElseBranch -> os.Append(FSComp.SR.missingElseBranch(t2)) |> ignore
| ContextInfo.ElseBranchWithDifferentType -> os.Append(FSComp.SR.elseBranchHasWrongType(t1,t2)) |> ignore
| ContextInfo.NoContext -> os.Append(ErrorFromAddingTypeEquation1E().Format t2 t1 tpcs) |> ignore
| _ -> os.Append(ErrorFromAddingTypeEquation1E().Format t2 t1 tpcs) |> ignore
| ErrorFromAddingTypeEquation(_,_,_,_,((ConstraintSolverTypesNotInSubsumptionRelation _ | ConstraintSolverError _) as e), _, _) ->
OutputExceptionR os e
| ErrorFromAddingTypeEquation(g,denv,t1,t2,e,_,_) ->
Expand All @@ -659,13 +660,23 @@ let OutputPhasedErrorR (os:System.Text.StringBuilder) (err:PhasedError) =
os.Append(ErrorFromApplyingDefault1E().Format defaultType) |> ignore
OutputExceptionR os e
os.Append(ErrorFromApplyingDefault2E().Format) |> ignore
| ErrorsFromAddingSubsumptionConstraint(g,denv,t1,t2,e,_) ->
if not (typeEquiv g t1 t2) then (
let t1,t2,tpcs = NicePrint.minimalStringsOfTwoTypes denv t1 t2
if t1 <> (t2 + tpcs) then
os.Append(ErrorsFromAddingSubsumptionConstraintE().Format t2 t1 tpcs) |> ignore
)
OutputExceptionR os e
| ErrorsFromAddingSubsumptionConstraint(g,denv,t1,t2,e,contextInfo,_) ->
match contextInfo with
| ContextInfo.DowncastUsedInsteadOfUpcast isOperator ->
let t1,t2,_ = NicePrint.minimalStringsOfTwoTypes denv t1 t2
if isOperator then
os.Append(FSComp.SR.considerUpcastOperator(t1,t2) |> snd) |> ignore
else
os.Append(FSComp.SR.considerUpcast(t1,t2) |> snd) |> ignore
| _ ->
if not (typeEquiv g t1 t2) then
let t1,t2,tpcs = NicePrint.minimalStringsOfTwoTypes denv t1 t2
if t1 <> (t2 + tpcs) then
os.Append(ErrorsFromAddingSubsumptionConstraintE().Format t2 t1 tpcs) |> ignore
else
OutputExceptionR os e
else
OutputExceptionR os e
| UpperCaseIdentifierInPattern(_) ->
os.Append(UpperCaseIdentifierInPatternE().Format) |> ignore
| NotUpperCaseConstructor(_) ->
Expand Down
29 changes: 19 additions & 10 deletions src/fsharp/ConstraintSolver.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -124,6 +124,10 @@ type ContextInfo =
| OmittedElseBranch
/// The type equation comes from an else branch that might have different type than the corresponding if branch.
| ElseBranchWithDifferentType
/// The type equation comes from a runtime type test.
| RuntimeTypeTest of bool
/// The type equation comes from an downcast where a upcast could be used.
| DowncastUsedInsteadOfUpcast of bool

exception ConstraintSolverTupleDiffLengths of DisplayEnv * TType list * TType list * range * range
exception ConstraintSolverInfiniteTypes of DisplayEnv * TType * TType * range * range
Expand All @@ -135,7 +139,7 @@ exception ConstraintSolverRelatedInformation of string option * range * exn

exception ErrorFromApplyingDefault of TcGlobals * DisplayEnv * Tast.Typar * TType * exn * range
exception ErrorFromAddingTypeEquation of TcGlobals * DisplayEnv * TType * TType * exn * ContextInfo * range
exception ErrorsFromAddingSubsumptionConstraint of TcGlobals * DisplayEnv * TType * TType * exn * range
exception ErrorsFromAddingSubsumptionConstraint of TcGlobals * DisplayEnv * TType * TType * exn * ContextInfo * range
exception ErrorFromAddingConstraint of DisplayEnv * exn * range
exception PossibleOverload of DisplayEnv * string * exn * range
exception UnresolvedOverloading of DisplayEnv * exn list * string * range
Expand Down Expand Up @@ -1918,9 +1922,16 @@ and private DefinitelyEquiv (csenv:ConstraintSolverEnv) isConstraint calledArg (

// Assert a subtype constraint, and wrap an ErrorsFromAddingSubsumptionConstraint error around any failure
// to allow us to report the outer types involved in the constraint
and private SolveTypSubsumesTypWithReport (csenv:ConstraintSolverEnv) ndeep m trace ty1 ty2 =
and private SolveTypSubsumesTypWithReport contextInfo (csenv:ConstraintSolverEnv) ndeep m trace ty1 ty2 =
TryD (fun () -> SolveTypSubsumesTypKeepAbbrevs csenv ndeep m trace ty1 ty2)
(fun res -> ErrorD (ErrorsFromAddingSubsumptionConstraint(csenv.g,csenv.DisplayEnv,ty1,ty2,res,m)))
(fun res ->
match contextInfo with
| ContextInfo.RuntimeTypeTest isOperator ->
// test if we can cast other way around
match CollectThenUndo (fun newTrace -> SolveTypSubsumesTypKeepAbbrevs csenv ndeep m (OptionalTrace.WithTrace newTrace) ty2 ty1) with
| OkResult _ -> ErrorD (ErrorsFromAddingSubsumptionConstraint(csenv.g,csenv.DisplayEnv,ty1,ty2,res,ContextInfo.DowncastUsedInsteadOfUpcast isOperator,m))
| _ -> ErrorD (ErrorsFromAddingSubsumptionConstraint(csenv.g,csenv.DisplayEnv,ty1,ty2,res,ContextInfo.NoContext,m))
| _ -> ErrorD (ErrorsFromAddingSubsumptionConstraint(csenv.g,csenv.DisplayEnv,ty1,ty2,res,contextInfo,m)))

and private SolveTypEqualsTypWithReport contextInfo (csenv:ConstraintSolverEnv) ndeep m trace ty1 ty2 =
TryD (fun () -> SolveTypEqualsTypKeepAbbrevs csenv ndeep m trace ty1 ty2)
Expand All @@ -1937,7 +1948,7 @@ and ArgsMustSubsumeOrConvert
let g = csenv.g
let m = callerArg.Range
let calledArgTy = AdjustCalledArgType csenv.InfoReader isConstraint calledArg callerArg
SolveTypSubsumesTypWithReport csenv ndeep m trace calledArgTy callerArg.Type ++ (fun () ->
SolveTypSubsumesTypWithReport ContextInfo.NoContext csenv ndeep m trace calledArgTy callerArg.Type ++ (fun () ->

if calledArg.IsParamArray && isArray1DTy g calledArgTy && not (isArray1DTy g callerArg.Type)
then
Expand All @@ -1953,10 +1964,10 @@ and MustUnifyInsideUndo csenv ndeep trace ty1 ty2 =

and ArgsMustSubsumeOrConvertInsideUndo (csenv:ConstraintSolverEnv) ndeep trace isConstraint calledArg (CallerArg(callerArgTy,m,_,_) as callerArg) =
let calledArgTy = AdjustCalledArgType csenv.InfoReader isConstraint calledArg callerArg
SolveTypSubsumesTypWithReport csenv ndeep m (WithTrace trace) calledArgTy callerArgTy
SolveTypSubsumesTypWithReport ContextInfo.NoContext csenv ndeep m (WithTrace trace) calledArgTy callerArgTy

and TypesMustSubsumeOrConvertInsideUndo (csenv:ConstraintSolverEnv) ndeep trace m calledArgTy callerArgTy =
SolveTypSubsumesTypWithReport csenv ndeep m trace calledArgTy callerArgTy
SolveTypSubsumesTypWithReport ContextInfo.NoContext csenv ndeep m trace calledArgTy callerArgTy

and ArgsEquivInsideUndo (csenv:ConstraintSolverEnv) _trace isConstraint calledArg (CallerArg(callerArgTy,m,_,_) as callerArg) =
let calledArgTy = AdjustCalledArgType csenv.InfoReader isConstraint calledArg callerArg
Expand Down Expand Up @@ -2435,10 +2446,8 @@ let AddCxTypeMustSubsumeTypeMatchingOnlyUndoIfFailed denv css m ty1 ty2 =
let csenv = { csenv with MatchingOnly = true }
UndoIfFailed (fun trace -> SolveTypSubsumesTypKeepAbbrevs csenv 0 m (WithTrace(trace)) ty1 ty2)



let AddCxTypeMustSubsumeType denv css m trace ty1 ty2 =
SolveTypSubsumesTypWithReport (MakeConstraintSolverEnv css m denv) 0 m trace ty1 ty2
let AddCxTypeMustSubsumeType contextInfo denv css m trace ty1 ty2 =
SolveTypSubsumesTypWithReport contextInfo (MakeConstraintSolverEnv css m denv) 0 m trace ty1 ty2
|> RaiseOperationResult

let AddCxMethodConstraint denv css m trace traitInfo =
Expand Down
8 changes: 6 additions & 2 deletions src/fsharp/ConstraintSolver.fsi
View file
Original file line number Diff line number Diff line change
Expand Up @@ -56,6 +56,10 @@ type ContextInfo =
| OmittedElseBranch
/// The type equation comes from an else branch that might have different type than the corresponding if branch.
| ElseBranchWithDifferentType
/// The type equation comes from a runtime type test.
| RuntimeTypeTest of bool
/// The type equation comes from an downcast where a upcast could be used.
| DowncastUsedInsteadOfUpcast of bool

exception ConstraintSolverTupleDiffLengths of DisplayEnv * TType list * TType list * range * range
exception ConstraintSolverInfiniteTypes of DisplayEnv * TType * TType * range * range
Expand All @@ -66,7 +70,7 @@ exception ConstraintSolverError of string * range * rang
exception ConstraintSolverRelatedInformation of string option * range * exn
exception ErrorFromApplyingDefault of TcGlobals * DisplayEnv * Typar * TType * exn * range
exception ErrorFromAddingTypeEquation of TcGlobals * DisplayEnv * TType * TType * exn * ContextInfo * range
exception ErrorsFromAddingSubsumptionConstraint of TcGlobals * DisplayEnv * TType * TType * exn * range
exception ErrorsFromAddingSubsumptionConstraint of TcGlobals * DisplayEnv * TType * TType * exn * ContextInfo * range
exception ErrorFromAddingConstraint of DisplayEnv * exn * range
exception UnresolvedConversionOperator of DisplayEnv * TType * TType * range
exception PossibleOverload of DisplayEnv * string * exn * range
Expand Down Expand Up @@ -106,7 +110,7 @@ val AddConstraint : ConstraintSolverEnv -> int -> Ra
val AddCxTypeEqualsType : ContextInfo -> DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> unit
val AddCxTypeEqualsTypeUndoIfFailed : DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool
val AddCxTypeEqualsTypeMatchingOnlyUndoIfFailed : DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool
val AddCxTypeMustSubsumeType : DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> TType -> unit
val AddCxTypeMustSubsumeType : ContextInfo -> DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> TType -> unit
val AddCxTypeMustSubsumeTypeUndoIfFailed : DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool
val AddCxTypeMustSubsumeTypeMatchingOnlyUndoIfFailed : DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool
val AddCxMethodConstraint : DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TraitConstraintInfo -> unit
Expand Down
2 changes: 2 additions & 0 deletions src/fsharp/FSComp.txt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1293,3 +1293,5 @@ estApplyStaticArgumentsForMethodNotImplemented,"A type provider implemented GetS
3195,optsResponseFileNameInvalid,"Response file name '%s' is empty, contains invalid characters, has a drive specification without an absolute path, or is too long"
3196,fsharpCoreNotFoundToBeCopied,"Cannot find FSharp.Core.dll in compiler's directory"
3197,etMissingStaticArgumentsToMethod,"This provided method requires static parameters"
3198,considerUpcast,"The conversion from %s to %s is a compile-time safe upcast, not a downcast. Consider using 'upcast' instead of 'downcast'."
3198,considerUpcastOperator,"The conversion from %s to %s is a compile-time safe upcast, not a downcast. Consider using the :> (upcast) operator instead of the :?> (downcast) operator."
Loading

0 comments on commit 4cda2e7

Please sign in to comment.