fix #568: recognize provided expressions

FSharp.Compiler.Service.sln

@@ -1,6 +1,6 @@
 Microsoft Visual Studio Solution File, Format Version 12.00
 # Visual Studio 14
-VisualStudioVersion = 14.0.25123.0
+VisualStudioVersion = 14.0.25420.1
 MinimumVisualStudioVersion = 10.0.40219.1
 Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "project", "project", "{B6B68AE6-E7A4-4D43-9B34-FFA74BFE192B}"
 	ProjectSection(SolutionItems) = preProject
@@ -63,6 +63,8 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FSharp.Compiler.Service.Pro
 EndProject
 Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FSharp.Compiler.Service.ProjectCracker", "src\fsharp\FSharp.Compiler.Service.ProjectCracker\FSharp.Compiler.Service.ProjectCracker.fsproj", "{893C3CD9-5AF8-4027-A667-21E62FC2C703}"
 EndProject
+Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "TestTP", "tests\service\data\TestTP\TestTP.fsproj", "{FF76BD3C-5E0A-4752-B6C3-044F6E15719B}"
+EndProject
 Global
 	GlobalSection(SolutionConfigurationPlatforms) = preSolution
 		Debug|Any CPU = Debug|Any CPU
@@ -247,6 +249,24 @@ Global
 		{893C3CD9-5AF8-4027-A667-21E62FC2C703}.Release|Mixed Platforms.ActiveCfg = Release|Any CPU
 		{893C3CD9-5AF8-4027-A667-21E62FC2C703}.Release|Mixed Platforms.Build.0 = Release|Any CPU
 		{893C3CD9-5AF8-4027-A667-21E62FC2C703}.Release|x86.ActiveCfg = Release|Any CPU
+		{FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
+		{FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Debug|Any CPU.Build.0 = Debug|Any CPU
+		{FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Debug|Mixed Platforms.ActiveCfg = Debug|Any CPU
+		{FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Debug|Mixed Platforms.Build.0 = Debug|Any CPU
+		{FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Debug|x86.ActiveCfg = Debug|Any CPU
+		{FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Debug|x86.Build.0 = Debug|Any CPU
+		{FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Proto|Any CPU.ActiveCfg = Release|Any CPU
+		{FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Proto|Any CPU.Build.0 = Release|Any CPU
+		{FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Proto|Mixed Platforms.ActiveCfg = Release|Any CPU
+		{FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Proto|Mixed Platforms.Build.0 = Release|Any CPU
+		{FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Proto|x86.ActiveCfg = Release|Any CPU
+		{FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Proto|x86.Build.0 = Release|Any CPU
+		{FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Release|Any CPU.ActiveCfg = Release|Any CPU
+		{FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Release|Any CPU.Build.0 = Release|Any CPU
+		{FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Release|Mixed Platforms.ActiveCfg = Release|Any CPU
+		{FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Release|Mixed Platforms.Build.0 = Release|Any CPU
+		{FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Release|x86.ActiveCfg = Release|Any CPU
+		{FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Release|x86.Build.0 = Release|Any CPU
 	EndGlobalSection
 	GlobalSection(SolutionProperties) = preSolution
 		HideSolutionNode = FALSE

src/absil/il.fs

@@ -4265,20 +4265,74 @@ let compareILVersions (a1,a2,a3,a4) ((b1,b2,b3,b4) : ILVersionInfo) =
     if c <> 0 then c else
     0
 
+let qunscope_scoref scoref_old = 
+    match scoref_old with 
+    | ILScopeRef.Local -> None
+    | _ -> Some ILScopeRef.Local
+
+let qunscope_tref (x:ILTypeRef) = 
+    match qunscope_scoref x.Scope with 
+    | None -> None
+    | Some s -> Some (ILTypeRef.Create(s,x.Enclosing,x.Name))
+
+let unscopeILScopeRef y = match qunscope_scoref y with Some x -> x | None -> y
+let unscopeILTypeRef y = match qunscope_tref y with Some x -> x | None -> y
+
+let rec unscopeILTypeSpecQuick (tspec:ILTypeSpec) = 
+    let tref = tspec.TypeRef
+    let tinst = tspec.GenericArgs
+    let qtref = qunscope_tref tref
+    if ILList.isEmpty tinst && isNone qtref then 
+        None (* avoid reallocation in the common case *)
+    else
+        match qtref with 
+        | None ->  Some (ILTypeSpec.Create (tref, unscopeILTypes tinst))
+        | Some tref ->  Some (ILTypeSpec.Create (tref, unscopeILTypes tinst))
+
+and unscopeILTypeSpec x y = 
+    match rescopeILTypeSpecQuick x y with 
+    | Some x -> x 
+    | None -> y
+
+and unscopeILType typ = 
+    match typ with 
+    | ILType.Ptr t -> ILType.Ptr (unscopeILType t)
+    | ILType.FunctionPointer t -> ILType.FunctionPointer (unscopeILCallSig t)
+    | ILType.Byref t -> ILType.Byref (unscopeILType t)
+    | ILType.Boxed cr -> 
+        match unscopeILTypeSpecQuick cr with 
+        | Some res -> mkILBoxedType res
+        | None -> typ  // avoid reallocation in the common case 
+    | ILType.Array (s,ty) -> ILType.Array (s,unscopeILType ty)
+    | ILType.Value cr -> 
+        match unscopeILTypeSpecQuick cr with 
+        | Some res -> ILType.Value res
+        | None -> typ  // avoid reallocation in the common case 
+    | ILType.Modified(b,tref,ty) -> ILType.Modified(b,unscopeILTypeRef tref, unscopeILType ty)
+    | x -> x
+
+and unscopeILTypes i = 
+    if ILList.isEmpty i then i
+    else ILList.map unscopeILType i
+
+and unscopeILCallSig csig = 
+    mkILCallSigRaw (csig.CallingConv,unscopeILTypes csig.ArgTypes,unscopeILType csig.ReturnType)
 
 let resolveILMethodRefWithRescope r td (mref:ILMethodRef) = 
     let args = mref.ArgTypes
     let nargs = args.Length
     let nm = mref.Name
     let possibles = td.Methods.FindByNameAndArity (nm,nargs)
     if isNil possibles then failwith ("no method named "+nm+" found in type "+td.Name);
+    let argTypes = mref.ArgTypes |> List.map r
+    let retType : ILType = r mref.ReturnType
     match 
       possibles |> List.filter (fun md -> 
           mref.CallingConv = md.CallingConv &&
           // REVIEW: this uses equality on ILType.  For CMOD_OPTIONAL this is not going to be correct
-          (md.Parameters,mref.ArgTypes) ||>  ILList.lengthsEqAndForall2 (fun p1 p2 -> r p1.Type = p2) &&
+          (md.Parameters,argTypes) ||>  ILList.lengthsEqAndForall2 (fun p1 p2 -> r p1.Type = p2) &&
           // REVIEW: this uses equality on ILType.  For CMOD_OPTIONAL this is not going to be correct 
-          r md.Return.Type = mref.ReturnType)  with 
+          r md.Return.Type = retType)  with 
     | [] -> failwith ("no method named "+nm+" with appropriate argument types found in type "+td.Name)
     | [mdef] ->  mdef
     | _ -> failwith ("multiple methods named "+nm+" appear with identical argument types in type "+td.Name)

src/absil/il.fsi

@@ -1973,6 +1973,9 @@ val rescopeILMethodRef: ILScopeRef -> ILMethodRef -> ILMethodRef
 /// the new scope. 
 val rescopeILFieldRef: ILScopeRef -> ILFieldRef -> ILFieldRef
 
+/// Unscoping. Clears every scope information, use for looking up IL method references only.
+val unscopeILType: ILType -> ILType
+
 
 //-----------------------------------------------------------------------
 // The ILCode Builder utility.

src/fsharp/TastOps.fs

@@ -621,16 +621,18 @@ let reduceTyconRefMeasureableOrProvided (g:TcGlobals) (tcref:TyconRef) tyargs =
 let rec stripTyEqnsA g canShortcut ty = 
     let ty = stripTyparEqnsAux canShortcut ty 
     match ty with 
-    | TType_app (tcref,tinst) -> 
+    | TType_app (tcref,args) -> 
         let tycon = tcref.Deref
+        let strippedArgs = args |> List.map (stripTyEqnsA g canShortcut)
         match tycon.TypeAbbrev with 
         | Some abbrevTy -> 
-            stripTyEqnsA g canShortcut (applyTyconAbbrev abbrevTy tycon tinst)
+            stripTyEqnsA g canShortcut (applyTyconAbbrev abbrevTy tycon strippedArgs)
         | None -> 
-            if tycon.IsMeasureableReprTycon && List.forall (isDimensionless g) tinst then
-                stripTyEqnsA g canShortcut (reduceTyconMeasureableOrProvided g tycon tinst)
-            else 
+            if tycon.IsMeasureableReprTycon && List.forall (isDimensionless g) args then
+                stripTyEqnsA g canShortcut (reduceTyconMeasureableOrProvided g tycon strippedArgs)
+            elif List.isEmpty args || List.forall2 (===) args strippedArgs then 
                 ty
+            else instType (mkTyconInst tycon strippedArgs) ty 
     | ty -> ty
 
 let stripTyEqns g ty = stripTyEqnsA g false ty
@@ -644,14 +646,20 @@ let rec stripTyEqnsAndErase eraseFuncAndTuple g ty =
     match ty with
     | TType_app (tcref,args) -> 
         let tycon = tcref.Deref
-        if tycon.IsErased  then
-            stripTyEqnsAndErase eraseFuncAndTuple g (reduceTyconMeasureableOrProvided g tycon args)
-        elif tyconRefEq g tcref g.nativeptr_tcr && eraseFuncAndTuple then 
-            stripTyEqnsAndErase eraseFuncAndTuple g g.nativeint_ty
-        else
-            ty
-    | TType_fun(a,b) when eraseFuncAndTuple -> TType_app(g.fastFunc_tcr,[ a; b]) 
-    | TType_tuple(l) when eraseFuncAndTuple -> mkCompiledTupleTy g l
+        let strippedArgs = args |> List.map (stripTyEqnsAndErase eraseFuncAndTuple g)
+        match tycon.TypeAbbrev with 
+        | Some abbrevTy -> 
+            stripTyEqnsAndErase eraseFuncAndTuple g (applyTyconAbbrev abbrevTy tycon strippedArgs)
+        | None -> 
+            if tycon.IsErased  then
+                stripTyEqnsAndErase eraseFuncAndTuple g (reduceTyconMeasureableOrProvided g tycon strippedArgs)
+            elif tyconRefEq g tcref g.nativeptr_tcr && eraseFuncAndTuple then 
+                stripTyEqnsAndErase eraseFuncAndTuple g g.nativeint_ty
+            elif List.isEmpty args || List.forall2 (===) args strippedArgs then
+                ty 
+            else instType (mkTyconInst tycon strippedArgs) ty 
+    | TType_fun(a,b) when eraseFuncAndTuple -> TType_app(g.fastFunc_tcr,[ a; b]) |> stripTyEqnsAndErase eraseFuncAndTuple g
+    | TType_tuple(l) when eraseFuncAndTuple -> mkCompiledTupleTy g l |> stripTyEqnsAndErase eraseFuncAndTuple g
     | ty -> ty
 
 let stripTyEqnsAndMeasureEqns g ty =
@@ -825,7 +833,8 @@ and typarConstraintsAEquivAux erasureFlag g aenv tpc1 tpc2 =
 
 and typarConstraintSetsAEquivAux erasureFlag g aenv (tp1:Typar) (tp2:Typar) = 
     tp1.StaticReq = tp2.StaticReq &&
-    ListSet.equals (typarConstraintsAEquivAux erasureFlag g aenv) tp1.Constraints tp2.Constraints
+    (tp1.Rigidity = TyparRigidity.Unresolved || tp2.Rigidity = TyparRigidity.Unresolved ||
+        ListSet.equals (typarConstraintsAEquivAux erasureFlag g aenv) tp1.Constraints tp2.Constraints)
 
 and typarsAEquivAux erasureFlag g (aenv: TypeEquivEnv) tps1 tps2 = 
     List.length tps1 = List.length tps2 &&
@@ -841,7 +850,11 @@ and typeAEquivAux erasureFlag g aenv ty1 ty2 =
     let ty2 = stripTyEqnsWrtErasure erasureFlag g ty2
     match ty1, ty2 with
     | TType_forall(tps1,rty1), TType_forall(tps2,rty2) -> 
-        typarsAEquivAux erasureFlag g aenv tps1 tps2 && typeAEquivAux erasureFlag g (aenv.BindEquivTypars tps1 tps2) rty1 rty2
+        let sameConstraints = typarsAEquivAux erasureFlag g aenv tps1 tps2 
+        if sameConstraints then
+            typeAEquivAux erasureFlag g (aenv.BindEquivTypars tps1 tps2) rty1 rty2
+        else
+            false
     | TType_var tp1, TType_var tp2 when typarEq tp1 tp2 -> 
         true
     | TType_var tp1, _ when aenv.EquivTypars.ContainsKey tp1 -> 

src/fsharp/tast.fs

@@ -274,6 +274,8 @@ type TyparRigidity =
     /// Indicates the type parameter derives from an '_' anonymous type
     /// For units-of-measure, we give a warning if this gets solved to '1'
     | Anon
+    /// Indicates a type parameter coming from an IL method reference
+    | Unresolved
     member x.ErrorIfUnified = match x with TyparRigidity.Rigid -> true | _ -> false
     member x.WarnIfUnified = match x with TyparRigidity.WillBeRigid | TyparRigidity.WarnIfNotRigid -> true | _ -> false
     member x.WarnIfMissingConstraint = match x with TyparRigidity.WillBeRigid -> true | _ -> false
@@ -294,7 +296,8 @@ type TyparFlags(flags:int32) =
                      | TyparRigidity.WillBeRigid    -> 0b000000100000
                      | TyparRigidity.WarnIfNotRigid -> 0b000001000000
                      | TyparRigidity.Flexible       -> 0b000001100000
-                     | TyparRigidity.Anon           -> 0b000010000000) |||
+                     | TyparRigidity.Anon           -> 0b000010000000
+                     | TyparRigidity.Unresolved     -> 0b000010100000) |||
                    (match kind with
                      | TyparKind.Type            -> 0b000000000000
                      | TyparKind.Measure         -> 0b000100000000) |||
@@ -326,6 +329,7 @@ type TyparFlags(flags:int32) =
                                             | 0b000001000000 -> TyparRigidity.WarnIfNotRigid
                                             | 0b000001100000 -> TyparRigidity.Flexible
                                             | 0b000010000000 -> TyparRigidity.Anon
+                                            | 0b000010100000 -> TyparRigidity.Unresolved
                                             | _          -> failwith "unreachable"
 
     /// Indicates whether a type variable can be instantiated by types or units-of-measure.
@@ -774,7 +778,7 @@ type Entity =
 
     /// Get the Abstract IL scope, nesting and metadata for this 
     /// type definition, assuming it is backed by Abstract IL metadata.
-    member x.ILTyconInfo = match x.TypeReprInfo with | TILObjectRepr (a,b,c) -> (a,b,c) |  _ -> assert false; failwith "not a .NET type definition"
+    member x.ILTyconInfo = match x.TypeReprInfo with | TILObjectRepr (a,b,c) -> (a,b,c) |  i -> failwithf "not a .NET type definition: %+A" i
 
     /// Get the Abstract IL metadata for this type definition, assuming it is backed by Abstract IL metadata.
     member x.ILTyconRawMetadata = let _,_,td = x.ILTyconInfo in td
@@ -4551,6 +4555,8 @@ let NewTypar (kind,rigid,Typar(id,staticReq,isCompGen),isFromError,dynamicReq,at
 
 let NewRigidTypar nm m = NewTypar (TyparKind.Type,TyparRigidity.Rigid,Typar(mkSynId m nm,NoStaticReq,true),false,TyparDynamicReq.Yes,[],false,false)
 
+let NewUnresolvedTypar nm m = NewTypar (TyparKind.Type,TyparRigidity.Unresolved,Typar(mkSynId m nm,NoStaticReq,true),false,TyparDynamicReq.Yes,[],false,false)
+
 let NewUnionCase id nm tys rty attribs docOption access : UnionCase = 
     { Id=id
       CompiledName=nm