diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index c77de8b545f..6fc5fc3f1b5 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -4133,13 +4133,12 @@ let rec TcTyparConstraint ridx cenv newOk checkCxs occ (env: TcEnv) tpenv c = AddCxMethodConstraint env.DisplayEnv cenv.css m NoTrace traitInfo tpenv -and TcPseudoMemberSpec cenv newOk env synTypars tpenv memSpfn m = +and TcPseudoMemberSpec cenv newOk env synTypes tpenv memSpfn m = #if ALLOW_MEMBER_CONSTRAINTS_ON_MEASURES let tps,tpenv = List.mapFold (TcTyparOrMeasurePar None cenv env newOk) tpenv synTypars #else - let tps,tpenv = List.mapFold (TcTypar cenv env newOk) tpenv synTypars + let tys,tpenv = List.mapFold (TcTypeAndRecover cenv newOk CheckCxs ItemOccurence.UseInType env) tpenv synTypes #endif - let tys = List.map mkTyparTy tps match memSpfn with | SynMemberSig.Member (valSpfn,memberFlags,m) -> // REVIEW: Test pseudo constraints cannot refer to polymorphic methods. @@ -5824,7 +5823,8 @@ and TcExprUndelayed cenv overallTy env tpenv (expr: SynExpr) = TcLongIdentThen cenv overallTy env tpenv lidwd [ DelayedApp(ExprAtomicFlag.Atomic, e1, mStmt); MakeDelayedSet(e2,mStmt) ] | SynExpr.TraitCall(tps,memSpfn,arg,m) -> - let (TTrait(_,logicalCompiledName,_,argtys,returnTy,_) as traitInfo),tpenv = TcPseudoMemberSpec cenv NewTyparsOK env tps tpenv memSpfn m + let synTypes = tps |> List.map (fun tp -> SynType.Var(tp,m)) + let (TTrait(_,logicalCompiledName,_,argtys,returnTy,_) as traitInfo),tpenv = TcPseudoMemberSpec cenv NewTyparsOK env synTypes tpenv memSpfn m if List.contains logicalCompiledName BakedInTraitConstraintNames then warning(BakedInMemberConstraintName(logicalCompiledName,m)) @@ -8464,11 +8464,13 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterOverloadResolution let logicalCompiledName = ComputeLogicalName id memberFlags let traitInfo = TTrait(argTys,logicalCompiledName,memberFlags,argTys,Some retTy, sln) - AddCxMethodConstraint env.DisplayEnv cenv.css mItem NoTrace traitInfo - let expr = Expr.Op(TOp.TraitCall(traitInfo), [], ves, mItem) let expr = mkLambdas mItem [] vs (expr,retTy) - PropagateThenTcDelayed cenv overallTy env tpenv mItem (MakeApplicableExprNoFlex cenv expr) (tyOfExpr cenv.g expr) ExprAtomicFlag.NonAtomic delayed + let resultExpr = PropagateThenTcDelayed cenv overallTy env tpenv mItem (MakeApplicableExprNoFlex cenv expr) (tyOfExpr cenv.g expr) ExprAtomicFlag.NonAtomic delayed + // Add the constraint after the arguments have been checked to allow annotations to kick in on rigid type parameters + AddCxMethodConstraint env.DisplayEnv cenv.css mItem NoTrace traitInfo + resultExpr + | Item.DelegateCtor typ -> match delayed with diff --git a/src/fsharp/ast.fs b/src/fsharp/ast.fs index 657d32c41f5..2d16b31799e 100644 --- a/src/fsharp/ast.fs +++ b/src/fsharp/ast.fs @@ -391,7 +391,7 @@ and /// F# syntax is 'typar :> type | WhereTyparSubtypeOfType of SynTypar * SynType * range /// F# syntax is ^T : (static member MemberName : ^T * int -> ^T) - | WhereTyparSupportsMember of SynTypar list * SynMemberSig * range + | WhereTyparSupportsMember of SynType list * SynMemberSig * range /// F# syntax is 'typar : enum<'UnderlyingType> | WhereTyparIsEnum of SynTypar * SynType list * range /// F# syntax is 'typar : delegate<'Args,unit> diff --git a/src/fsharp/pars.fsy b/src/fsharp/pars.fsy index 37f87a0dc55..0d3c55ba373 100755 --- a/src/fsharp/pars.fsy +++ b/src/fsharp/pars.fsy @@ -2172,7 +2172,8 @@ typeConstraint: { WhereTyparSupportsNull($1,lhs parseState) } | typar COLON LPAREN classMemberSpfn rparen - { WhereTyparSupportsMember([ $1 ],$4,lhs parseState) } + { let tp = $1 + WhereTyparSupportsMember([ SynType.Var(tp, tp.Range) ],$4,lhs parseState) } | LPAREN typarAlts rparen COLON LPAREN classMemberSpfn rparen { WhereTyparSupportsMember(List.rev($2),$6,lhs parseState) } @@ -2193,8 +2194,8 @@ typeConstraint: | nm -> raiseParseErrorAt (rhs parseState 3) (FSComp.SR.parsUnexpectedIdentifier(nm)) } typarAlts: - | typarAlts OR typar { $3::$1 } - | typar { [$1] } + | typarAlts OR appType { $3::$1 } + | appType { [$1] } /* The core of a union type definition */ unionTypeRepr: diff --git a/tests/fsharp/core/members/ops/test.fsx b/tests/fsharp/core/members/ops/test.fsx index 915efac9089..68341524c7e 100644 --- a/tests/fsharp/core/members/ops/test.fsx +++ b/tests/fsharp/core/members/ops/test.fsx @@ -345,7 +345,13 @@ module MiscOperatorOverloadTests = res +// See https://github.com/Microsoft/visualfsharp/issues/1306 +module OperatorConstraintsWithExplicitRigidTypeParameters = + type M() = class end + let inline empty< ^R when ( ^R or M) : (static member ( $ ) : ^R * M -> ^R)> = + let m = M() + Unchecked.defaultof< ^R> $ m: ^R module EnumerationOperatorTests = let x1 : System.DateTimeKind = enum 3 diff --git a/tests/fsharp/core/subtype/test.fsx b/tests/fsharp/core/subtype/test.fsx index f5f3e38eb97..1a56d8e862d 100644 --- a/tests/fsharp/core/subtype/test.fsx +++ b/tests/fsharp/core/subtype/test.fsx @@ -1725,6 +1725,53 @@ module GenericPropertyConstraintSolvedByRecord = let v = print_foo_memb { foo=1 } + +module SRTPFix = + + open System + + let inline konst x _ = x + + type CFunctor() = + static member inline fmap (f : ^a -> ^b, a : ^a list) = List.map f a + static member inline fmap (f : ^a -> ^b, a : ^a option) = + match a with + | None -> None + | Some x -> Some (f x) + + // default implementation of replace + static member inline replace< ^a, ^b, ^c, ^d, ^e when ^a :> CFunctor and (^a or ^d) : (static member fmap : (^b -> ^c) * ^d -> ^e) > (a, f) = + ((^a or ^d) : (static member fmap : (^b -> ^c) * ^d -> ^e) (konst a, f)) + + // call overridden replace if present + static member inline replace< ^a, ^b, ^c when ^b : (static member replace : ^a * ^b -> ^c)>(a : ^a, f : ^b) = + (^b : (static member replace : ^a * ^b -> ^c) (a, f)) + + let inline replace_instance< ^a, ^b, ^c, ^d when (^a or ^c) : (static member replace : ^b * ^c -> ^d)> (a : ^b, f : ^c) = + ((^a or ^c) : (static member replace : ^b * ^c -> ^d) (a, f)) + + let inline fmap_instance< ^a, ^b, ^c, ^d, ^e when (^a or ^d) : (static member fmap : (^b -> ^c) * ^d -> ^e)>(f : ^b -> ^c, a : ^d) = + ((^a or ^d) : (static member fmap : (^b -> ^c) * ^d -> ^e) (f, a)) + + let inline fmap (f : ^a -> ^b) (a : ^c) = + fmap_instance (f, a) + + let inline replace (a : ^a) (f : ^b) : ^a0 when (CFunctor or ^b) : (static member replace : ^a * ^b -> ^a0) = + replace_instance (a, f) + + (* + type test(arg : string) = class + member __.data = arg + static member inline fmap (f : char -> char, a : test) = String.map f a.data + static member inline replace (a : char, f : test) = test.fmap (konst a, f) + end + + let _ = + printfn "%A" <| fmap id [1;2;3]; + printfn "%A" <| replace 5 [1;2;3]; + printfn "%A" <| fmap ((+) 1) (Some 2); + printfn "%A" <| replace 'q' (test("HI")) + *) let aa = if not failures.IsEmpty then (printfn "Test Failed, failures = %A" failures; exit 1) diff --git a/tests/fsharp/typecheck/sigs/neg60.bsl b/tests/fsharp/typecheck/sigs/neg60.bsl index b52ab605303..9e05fc389f2 100644 --- a/tests/fsharp/typecheck/sigs/neg60.bsl +++ b/tests/fsharp/typecheck/sigs/neg60.bsl @@ -64,12 +64,8 @@ but here has type neg60.fs(71,36,71,40): typecheck error FS0043: The type 'System.Nullable' does not have 'null' as a proper value. To create a null value for a Nullable type use 'System.Nullable()'. -neg60.fs(77,20,77,22): typecheck error FS0001: The type 'System.Nullable' does not support the operator '?>='. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'. - neg60.fs(77,16,77,19): typecheck error FS0043: The type 'System.Nullable' does not support the operator '?>='. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'. -neg60.fs(78,20,78,22): typecheck error FS0001: None of the types 'System.Nullable, int' support the operator '?>='. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'. - neg60.fs(78,16,78,19): typecheck error FS0043: None of the types 'System.Nullable, int' support the operator '?>='. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'. neg60.fs(79,18,79,21): typecheck error FS0001: The type ''a * 'b' does not match the type 'int' @@ -82,4 +78,4 @@ neg60.fs(80,19,80,20): typecheck error FS0043: Expecting a type supporting the o neg60.fs(81,22,81,34): typecheck error FS0002: This function takes too many arguments, or is used in a context where a function is not expected -neg60.fs(87,14,87,15): typecheck error FS0001: The type 'System.Nullable' does not support the operator '?=?'. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'. +neg60.fs(87,10,87,13): typecheck error FS0043: The type 'System.Nullable' does not support the operator '?=?'. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'. diff --git a/tests/fsharpqa/Source/Diagnostics/General/E_NullableOperators01.fs b/tests/fsharpqa/Source/Diagnostics/General/E_NullableOperators01.fs index 7b5c7b39e8e..fbe1aab5902 100644 --- a/tests/fsharpqa/Source/Diagnostics/General/E_NullableOperators01.fs +++ b/tests/fsharpqa/Source/Diagnostics/General/E_NullableOperators01.fs @@ -25,39 +25,21 @@ let _ = iq ? iq -//None of the types 'System\.Nullable, int' support the operator '\?>='\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ //None of the types 'System\.Nullable, int' support the operator '\?>='\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ -//The type 'System\.Nullable' does not support the operator '\?>'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ //The type 'System\.Nullable' does not support the operator '\?>'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ -//The type 'System\.Nullable' does not support the operator '\?<='\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ //The type 'System\.Nullable' does not support the operator '\?<='\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ -//The type 'System\.Nullable' does not support the operator '\?<'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ //The type 'System\.Nullable' does not support the operator '\?<'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ -//The type 'System\.Nullable' does not support the operator '\?='\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ //The type 'System\.Nullable' does not support the operator '\?='\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ -//The type 'System\.Nullable' does not support the operator '\?<>'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ //The type 'System\.Nullable' does not support the operator '\?<>'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ -//The type 'System\.Nullable' does not support the operator '\?>=\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ //The type 'System\.Nullable' does not support the operator '\?>=\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ -//The type 'System\.Nullable' does not support the operator '\?>\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ //The type 'System\.Nullable' does not support the operator '\?>\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ -//The type 'System\.Nullable' does not support the operator '\?<=\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ //The type 'System\.Nullable' does not support the operator '\?<=\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ -//The type 'System\.Nullable' does not support the operator '\?<\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ //The type 'System\.Nullable' does not support the operator '\?<\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ -//The type 'System\.Nullable' does not support the operator '\?=\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ //The type 'System\.Nullable' does not support the operator '\?=\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ -//The type 'System\.Nullable' does not support the operator '\?<>\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ //The type 'System\.Nullable' does not support the operator '\?<>\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ -//The type 'System\.Nullable' does not support the operator '>=\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ //The type 'System\.Nullable' does not support the operator '>=\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ -//The type 'System\.Nullable' does not support the operator '>\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ //The type 'System\.Nullable' does not support the operator '>\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ -//The type 'System\.Nullable' does not support the operator '<=\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ //The type 'System\.Nullable' does not support the operator '<=\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ -//The type 'System\.Nullable' does not support the operator '<\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ //The type 'System\.Nullable' does not support the operator '<\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ -//The type 'System\.Nullable' does not support the operator '=\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ //The type 'System\.Nullable' does not support the operator '=\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ -//The type 'System\.Nullable' does not support the operator '<>\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ //The type 'System\.Nullable' does not support the operator '<>\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$