Merge pull request #1278 from dsyme/srtp-1

[RFC FS-1017] Allow all inferrable SRTP constraints to be written in signatures

Author: dsyme

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))
 
@@ -8478,11 +8478,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 

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>

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:

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

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<CFunctor, _, _, _, _> (f, a)
+
+    let inline replace (a : ^a) (f : ^b) : ^a0 when (CFunctor or  ^b) : (static member replace :  ^a *  ^b ->  ^a0) =
+      replace_instance<CFunctor, _, _, _> (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) 
 

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<int>' 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<int>' 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<int>' 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>, 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>, 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<int>' 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<int>' does not support the operator '?=?'. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'.

tests/fsharpqa/Source/Diagnostics/General/E_NullableOperators01.fs

@@ -25,39 +25,21 @@ let _ = iq <? iq
 let _ = iq =? iq
 let _ = iq <>? iq
 
-//<Expects status="error" span="(7,16-7,18)" id="FS0001">None of the types 'System\.Nullable<int>, int' support the operator '\?>='\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$</Expects>
 //<Expects status="error" span="(7,12-7,15)" id="FS0043">None of the types 'System\.Nullable<int>, int' support the operator '\?>='\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$</Expects>
-//<Expects status="error" span="(8,15-8,17)" id="FS0001">The type 'System\.Nullable<int>' does not support the operator '\?>'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$</Expects>
 //<Expects status="error" span="(8,12-8,14)" id="FS0043">The type 'System\.Nullable<int>' does not support the operator '\?>'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$</Expects>
-//<Expects status="error" span="(9,16-9,18)" id="FS0001">The type 'System\.Nullable<int>' does not support the operator '\?<='\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$</Expects>
 //<Expects status="error" span="(9,12-9,15)" id="FS0043">The type 'System\.Nullable<int>' does not support the operator '\?<='\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$</Expects>
-//<Expects status="error" span="(10,15-10,17)" id="FS0001">The type 'System\.Nullable<int>' does not support the operator '\?<'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$</Expects>
 //<Expects status="error" span="(10,12-10,14)" id="FS0043">The type 'System\.Nullable<int>' does not support the operator '\?<'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$</Expects>
-//<Expects status="error" span="(11,15-11,17)" id="FS0001">The type 'System\.Nullable<int>' does not support the operator '\?='\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$</Expects>
 //<Expects status="error" span="(11,12-11,14)" id="FS0043">The type 'System\.Nullable<int>' does not support the operator '\?='\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$</Expects>
-//<Expects status="error" span="(12,16-12,18)" id="FS0001">The type 'System\.Nullable<int>' does not support the operator '\?<>'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$</Expects>
 //<Expects status="error" span="(12,12-12,15)" id="FS0043">The type 'System\.Nullable<int>' does not support the operator '\?<>'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$</Expects>
-//<Expects status="error" span="(14,17-14,19)" id="FS0001">The type 'System\.Nullable<int>' does not support the operator '\?>=\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$</Expects>
 //<Expects status="error" span="(14,12-14,16)" id="FS0043">The type 'System\.Nullable<int>' does not support the operator '\?>=\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$</Expects>
-//<Expects status="error" span="(15,16-15,18)" id="FS0001">The type 'System\.Nullable<int>' does not support the operator '\?>\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$</Expects>
 //<Expects status="error" span="(15,12-15,15)" id="FS0043">The type 'System\.Nullable<int>' does not support the operator '\?>\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$</Expects>
-//<Expects status="error" span="(16,17-16,19)" id="FS0001">The type 'System\.Nullable<int>' does not support the operator '\?<=\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$</Expects>
 //<Expects status="error" span="(16,12-16,16)" id="FS0043">The type 'System\.Nullable<int>' does not support the operator '\?<=\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$</Expects>
-//<Expects status="error" span="(17,16-17,18)" id="FS0001">The type 'System\.Nullable<int>' does not support the operator '\?<\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$</Expects>
 //<Expects status="error" span="(17,12-17,15)" id="FS0043">The type 'System\.Nullable<int>' does not support the operator '\?<\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$</Expects>
-//<Expects status="error" span="(18,16-18,18)" id="FS0001">The type 'System\.Nullable<int>' does not support the operator '\?=\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$</Expects>
 //<Expects status="error" span="(18,12-18,15)" id="FS0043">The type 'System\.Nullable<int>' does not support the operator '\?=\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$</Expects>
-//<Expects status="error" span="(19,17-19,19)" id="FS0001">The type 'System\.Nullable<int>' does not support the operator '\?<>\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$</Expects>
 //<Expects status="error" span="(19,12-19,16)" id="FS0043">The type 'System\.Nullable<int>' does not support the operator '\?<>\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$</Expects>
-//<Expects status="error" span="(21,16-21,18)" id="FS0001">The type 'System\.Nullable<int>' does not support the operator '>=\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$</Expects>
 //<Expects status="error" span="(21,12-21,15)" id="FS0043">The type 'System\.Nullable<int>' does not support the operator '>=\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$</Expects>
-//<Expects status="error" span="(22,15-22,17)" id="FS0001">The type 'System\.Nullable<int>' does not support the operator '>\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$</Expects>
 //<Expects status="error" span="(22,12-22,14)" id="FS0043">The type 'System\.Nullable<int>' does not support the operator '>\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$</Expects>
-//<Expects status="error" span="(23,16-23,18)" id="FS0001">The type 'System\.Nullable<int>' does not support the operator '<=\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$</Expects>
 //<Expects status="error" span="(23,12-23,15)" id="FS0043">The type 'System\.Nullable<int>' does not support the operator '<=\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$</Expects>
-//<Expects status="error" span="(24,15-24,17)" id="FS0001">The type 'System\.Nullable<int>' does not support the operator '<\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$</Expects>
 //<Expects status="error" span="(24,12-24,14)" id="FS0043">The type 'System\.Nullable<int>' does not support the operator '<\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$</Expects>
-//<Expects status="error" span="(25,15-25,17)" id="FS0001">The type 'System\.Nullable<int>' does not support the operator '=\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$</Expects>
 //<Expects status="error" span="(25,12-25,14)" id="FS0043">The type 'System\.Nullable<int>' does not support the operator '=\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$</Expects>
-//<Expects status="error" span="(26,16-26,18)" id="FS0001">The type 'System\.Nullable<int>' does not support the operator '<>\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$</Expects>
 //<Expects status="error" span="(26,12-26,15)" id="FS0043">The type 'System\.Nullable<int>' does not support the operator '<>\?'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$</Expects>