Skip to content

Propose to use :> instead of :?> - fixes #1127 #1149

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

Merged
merged 1 commit into from
May 18, 2016
Merged

Propose to use :> instead of :?> - fixes #1127 #1149

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
31 changes: 21 additions & 10 deletions src/fsharp/CompileOps.fs
View file
Open in desktop
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 @@ -662,13 +663,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
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -128,6 +128,10 @@ type ContextInfo =
| RecordFields
/// The type equation comes from the verification of a tuple in record fields.
| TupleInRecordFields
/// 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 @@ -139,7 +143,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 @@ -1922,9 +1926,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 @@ -1941,7 +1952,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 @@ -1957,10 +1968,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 @@ -2439,10 +2450,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
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -60,6 +60,10 @@ type ContextInfo =
| RecordFields
/// The type equation comes from the verification of a tuple in record fields.
| TupleInRecordFields
/// 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 @@ -70,7 +74,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 @@ -110,7 +114,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
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1294,3 +1294,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