Skip to content

Commit 1056c03

Browse files
Jand42Jand42
committed
fix #568: recognize provided expressions
1 parent 670e657 commit 1056c03

File tree

16 files changed

+555
-142
lines changed

16 files changed

+555
-142
lines changed

‎FSharp.Compiler.Service.sln‎

Lines changed: 21 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
Microsoft Visual Studio Solution File, Format Version 12.00
22
# Visual Studio 14
3-
VisualStudioVersion = 14.0.25123.0
3+
VisualStudioVersion = 14.0.25420.1
44
MinimumVisualStudioVersion = 10.0.40219.1
55
Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "project", "project", "{B6B68AE6-E7A4-4D43-9B34-FFA74BFE192B}"
66
ProjectSection(SolutionItems) = preProject
@@ -63,6 +63,8 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FSharp.Compiler.Service.Pro
6363
EndProject
6464
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}"
6565
EndProject
66+
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "TestTP", "tests\service\data\TestTP\TestTP.fsproj", "{FF76BD3C-5E0A-4752-B6C3-044F6E15719B}"
67+
EndProject
6668
Global
6769
GlobalSection(SolutionConfigurationPlatforms) = preSolution
6870
Debug|Any CPU = Debug|Any CPU
@@ -247,6 +249,24 @@ Global
247249
{893C3CD9-5AF8-4027-A667-21E62FC2C703}.Release|Mixed Platforms.ActiveCfg = Release|Any CPU
248250
{893C3CD9-5AF8-4027-A667-21E62FC2C703}.Release|Mixed Platforms.Build.0 = Release|Any CPU
249251
{893C3CD9-5AF8-4027-A667-21E62FC2C703}.Release|x86.ActiveCfg = Release|Any CPU
252+
{FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
253+
{FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Debug|Any CPU.Build.0 = Debug|Any CPU
254+
{FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Debug|Mixed Platforms.ActiveCfg = Debug|Any CPU
255+
{FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Debug|Mixed Platforms.Build.0 = Debug|Any CPU
256+
{FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Debug|x86.ActiveCfg = Debug|Any CPU
257+
{FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Debug|x86.Build.0 = Debug|Any CPU
258+
{FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Proto|Any CPU.ActiveCfg = Release|Any CPU
259+
{FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Proto|Any CPU.Build.0 = Release|Any CPU
260+
{FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Proto|Mixed Platforms.ActiveCfg = Release|Any CPU
261+
{FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Proto|Mixed Platforms.Build.0 = Release|Any CPU
262+
{FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Proto|x86.ActiveCfg = Release|Any CPU
263+
{FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Proto|x86.Build.0 = Release|Any CPU
264+
{FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Release|Any CPU.ActiveCfg = Release|Any CPU
265+
{FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Release|Any CPU.Build.0 = Release|Any CPU
266+
{FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Release|Mixed Platforms.ActiveCfg = Release|Any CPU
267+
{FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Release|Mixed Platforms.Build.0 = Release|Any CPU
268+
{FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Release|x86.ActiveCfg = Release|Any CPU
269+
{FF76BD3C-5E0A-4752-B6C3-044F6E15719B}.Release|x86.Build.0 = Release|Any CPU
250270
EndGlobalSection
251271
GlobalSection(SolutionProperties) = preSolution
252272
HideSolutionNode = FALSE

‎src/absil/il.fs‎

Lines changed: 56 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -4265,20 +4265,74 @@ let compareILVersions (a1,a2,a3,a4) ((b1,b2,b3,b4) : ILVersionInfo) =
42654265
if c <> 0 then c else
42664266
0
42674267

4268+
let qunscope_scoref scoref_old =
4269+
match scoref_old with
4270+
| ILScopeRef.Local -> None
4271+
| _ -> Some ILScopeRef.Local
4272+
4273+
let qunscope_tref (x:ILTypeRef) =
4274+
match qunscope_scoref x.Scope with
4275+
| None -> None
4276+
| Some s -> Some (ILTypeRef.Create(s,x.Enclosing,x.Name))
4277+
4278+
let unscopeILScopeRef y = match qunscope_scoref y with Some x -> x | None -> y
4279+
let unscopeILTypeRef y = match qunscope_tref y with Some x -> x | None -> y
4280+
4281+
let rec unscopeILTypeSpecQuick (tspec:ILTypeSpec) =
4282+
let tref = tspec.TypeRef
4283+
let tinst = tspec.GenericArgs
4284+
let qtref = qunscope_tref tref
4285+
if ILList.isEmpty tinst && isNone qtref then
4286+
None (* avoid reallocation in the common case *)
4287+
else
4288+
match qtref with
4289+
| None -> Some (ILTypeSpec.Create (tref, unscopeILTypes tinst))
4290+
| Some tref -> Some (ILTypeSpec.Create (tref, unscopeILTypes tinst))
4291+
4292+
and unscopeILTypeSpec x y =
4293+
match rescopeILTypeSpecQuick x y with
4294+
| Some x -> x
4295+
| None -> y
4296+
4297+
and unscopeILType typ =
4298+
match typ with
4299+
| ILType.Ptr t -> ILType.Ptr (unscopeILType t)
4300+
| ILType.FunctionPointer t -> ILType.FunctionPointer (unscopeILCallSig t)
4301+
| ILType.Byref t -> ILType.Byref (unscopeILType t)
4302+
| ILType.Boxed cr ->
4303+
match unscopeILTypeSpecQuick cr with
4304+
| Some res -> mkILBoxedType res
4305+
| None -> typ // avoid reallocation in the common case
4306+
| ILType.Array (s,ty) -> ILType.Array (s,unscopeILType ty)
4307+
| ILType.Value cr ->
4308+
match unscopeILTypeSpecQuick cr with
4309+
| Some res -> ILType.Value res
4310+
| None -> typ // avoid reallocation in the common case
4311+
| ILType.Modified(b,tref,ty) -> ILType.Modified(b,unscopeILTypeRef tref, unscopeILType ty)
4312+
| x -> x
4313+
4314+
and unscopeILTypes i =
4315+
if ILList.isEmpty i then i
4316+
else ILList.map unscopeILType i
4317+
4318+
and unscopeILCallSig csig =
4319+
mkILCallSigRaw (csig.CallingConv,unscopeILTypes csig.ArgTypes,unscopeILType csig.ReturnType)
42684320

42694321
let resolveILMethodRefWithRescope r td (mref:ILMethodRef) =
42704322
let args = mref.ArgTypes
42714323
let nargs = args.Length
42724324
let nm = mref.Name
42734325
let possibles = td.Methods.FindByNameAndArity (nm,nargs)
42744326
if isNil possibles then failwith ("no method named "+nm+" found in type "+td.Name);
4327+
let argTypes = mref.ArgTypes |> List.map r
4328+
let retType : ILType = r mref.ReturnType
42754329
match
42764330
possibles |> List.filter (fun md ->
42774331
mref.CallingConv = md.CallingConv &&
42784332
// REVIEW: this uses equality on ILType. For CMOD_OPTIONAL this is not going to be correct
4279-
(md.Parameters,mref.ArgTypes) ||> ILList.lengthsEqAndForall2 (fun p1 p2 -> r p1.Type = p2) &&
4333+
(md.Parameters,argTypes) ||> ILList.lengthsEqAndForall2 (fun p1 p2 -> r p1.Type = p2) &&
42804334
// REVIEW: this uses equality on ILType. For CMOD_OPTIONAL this is not going to be correct
4281-
r md.Return.Type = mref.ReturnType) with
4335+
r md.Return.Type = retType) with
42824336
| [] -> failwith ("no method named "+nm+" with appropriate argument types found in type "+td.Name)
42834337
| [mdef] -> mdef
42844338
| _ -> failwith ("multiple methods named "+nm+" appear with identical argument types in type "+td.Name)

‎src/absil/il.fsi‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1973,6 +1973,9 @@ val rescopeILMethodRef: ILScopeRef -> ILMethodRef -> ILMethodRef
19731973
/// the new scope.
19741974
val rescopeILFieldRef: ILScopeRef -> ILFieldRef -> ILFieldRef
19751975

1976+
/// Unscoping. Clears every scope information, use for looking up IL method references only.
1977+
val unscopeILType: ILType -> ILType
1978+
19761979

19771980
//-----------------------------------------------------------------------
19781981
// The ILCode Builder utility.

‎src/fsharp/TastOps.fs‎

Lines changed: 28 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -621,16 +621,18 @@ let reduceTyconRefMeasureableOrProvided (g:TcGlobals) (tcref:TyconRef) tyargs =
621621
let rec stripTyEqnsA g canShortcut ty =
622622
let ty = stripTyparEqnsAux canShortcut ty
623623
match ty with
624-
| TType_app (tcref,tinst) ->
624+
| TType_app (tcref,args) ->
625625
let tycon = tcref.Deref
626+
let strippedArgs = args |> List.map (stripTyEqnsA g canShortcut)
626627
match tycon.TypeAbbrev with
627628
| Some abbrevTy ->
628-
stripTyEqnsA g canShortcut (applyTyconAbbrev abbrevTy tycon tinst)
629+
stripTyEqnsA g canShortcut (applyTyconAbbrev abbrevTy tycon strippedArgs)
629630
| None ->
630-
if tycon.IsMeasureableReprTycon && List.forall (isDimensionless g) tinst then
631-
stripTyEqnsA g canShortcut (reduceTyconMeasureableOrProvided g tycon tinst)
632-
else
631+
if tycon.IsMeasureableReprTycon && List.forall (isDimensionless g) args then
632+
stripTyEqnsA g canShortcut (reduceTyconMeasureableOrProvided g tycon strippedArgs)
633+
elif List.isEmpty args || List.forall2 (===) args strippedArgs then
633634
ty
635+
else instType (mkTyconInst tycon strippedArgs) ty
634636
| ty -> ty
635637

636638
let stripTyEqns g ty = stripTyEqnsA g false ty
@@ -644,14 +646,20 @@ let rec stripTyEqnsAndErase eraseFuncAndTuple g ty =
644646
match ty with
645647
| TType_app (tcref,args) ->
646648
let tycon = tcref.Deref
647-
if tycon.IsErased then
648-
stripTyEqnsAndErase eraseFuncAndTuple g (reduceTyconMeasureableOrProvided g tycon args)
649-
elif tyconRefEq g tcref g.nativeptr_tcr && eraseFuncAndTuple then
650-
stripTyEqnsAndErase eraseFuncAndTuple g g.nativeint_ty
651-
else
652-
ty
653-
| TType_fun(a,b) when eraseFuncAndTuple -> TType_app(g.fastFunc_tcr,[ a; b])
654-
| TType_tuple(l) when eraseFuncAndTuple -> mkCompiledTupleTy g l
649+
let strippedArgs = args |> List.map (stripTyEqnsAndErase eraseFuncAndTuple g)
650+
match tycon.TypeAbbrev with
651+
| Some abbrevTy ->
652+
stripTyEqnsAndErase eraseFuncAndTuple g (applyTyconAbbrev abbrevTy tycon strippedArgs)
653+
| None ->
654+
if tycon.IsErased then
655+
stripTyEqnsAndErase eraseFuncAndTuple g (reduceTyconMeasureableOrProvided g tycon strippedArgs)
656+
elif tyconRefEq g tcref g.nativeptr_tcr && eraseFuncAndTuple then
657+
stripTyEqnsAndErase eraseFuncAndTuple g g.nativeint_ty
658+
elif List.isEmpty args || List.forall2 (===) args strippedArgs then
659+
ty
660+
else instType (mkTyconInst tycon strippedArgs) ty
661+
| TType_fun(a,b) when eraseFuncAndTuple -> TType_app(g.fastFunc_tcr,[ a; b]) |> stripTyEqnsAndErase eraseFuncAndTuple g
662+
| TType_tuple(l) when eraseFuncAndTuple -> mkCompiledTupleTy g l |> stripTyEqnsAndErase eraseFuncAndTuple g
655663
| ty -> ty
656664

657665
let stripTyEqnsAndMeasureEqns g ty =
@@ -825,7 +833,8 @@ and typarConstraintsAEquivAux erasureFlag g aenv tpc1 tpc2 =
825833

826834
and typarConstraintSetsAEquivAux erasureFlag g aenv (tp1:Typar) (tp2:Typar) =
827835
tp1.StaticReq = tp2.StaticReq &&
828-
ListSet.equals (typarConstraintsAEquivAux erasureFlag g aenv) tp1.Constraints tp2.Constraints
836+
(tp1.Rigidity = TyparRigidity.Unresolved || tp2.Rigidity = TyparRigidity.Unresolved ||
837+
ListSet.equals (typarConstraintsAEquivAux erasureFlag g aenv) tp1.Constraints tp2.Constraints)
829838

830839
and typarsAEquivAux erasureFlag g (aenv: TypeEquivEnv) tps1 tps2 =
831840
List.length tps1 = List.length tps2 &&
@@ -841,7 +850,11 @@ and typeAEquivAux erasureFlag g aenv ty1 ty2 =
841850
let ty2 = stripTyEqnsWrtErasure erasureFlag g ty2
842851
match ty1, ty2 with
843852
| TType_forall(tps1,rty1), TType_forall(tps2,rty2) ->
844-
typarsAEquivAux erasureFlag g aenv tps1 tps2 && typeAEquivAux erasureFlag g (aenv.BindEquivTypars tps1 tps2) rty1 rty2
853+
let sameConstraints = typarsAEquivAux erasureFlag g aenv tps1 tps2
854+
if sameConstraints then
855+
typeAEquivAux erasureFlag g (aenv.BindEquivTypars tps1 tps2) rty1 rty2
856+
else
857+
false
845858
| TType_var tp1, TType_var tp2 when typarEq tp1 tp2 ->
846859
true
847860
| TType_var tp1, _ when aenv.EquivTypars.ContainsKey tp1 ->

‎src/fsharp/tast.fs‎

Lines changed: 8 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -274,6 +274,8 @@ type TyparRigidity =
274274
/// Indicates the type parameter derives from an '_' anonymous type
275275
/// For units-of-measure, we give a warning if this gets solved to '1'
276276
| Anon
277+
/// Indicates a type parameter coming from an IL method reference
278+
| Unresolved
277279
member x.ErrorIfUnified = match x with TyparRigidity.Rigid -> true | _ -> false
278280
member x.WarnIfUnified = match x with TyparRigidity.WillBeRigid | TyparRigidity.WarnIfNotRigid -> true | _ -> false
279281
member x.WarnIfMissingConstraint = match x with TyparRigidity.WillBeRigid -> true | _ -> false
@@ -294,7 +296,8 @@ type TyparFlags(flags:int32) =
294296
| TyparRigidity.WillBeRigid -> 0b000000100000
295297
| TyparRigidity.WarnIfNotRigid -> 0b000001000000
296298
| TyparRigidity.Flexible -> 0b000001100000
297-
| TyparRigidity.Anon -> 0b000010000000) |||
299+
| TyparRigidity.Anon -> 0b000010000000
300+
| TyparRigidity.Unresolved -> 0b000010100000) |||
298301
(match kind with
299302
| TyparKind.Type -> 0b000000000000
300303
| TyparKind.Measure -> 0b000100000000) |||
@@ -326,6 +329,7 @@ type TyparFlags(flags:int32) =
326329
| 0b000001000000 -> TyparRigidity.WarnIfNotRigid
327330
| 0b000001100000 -> TyparRigidity.Flexible
328331
| 0b000010000000 -> TyparRigidity.Anon
332+
| 0b000010100000 -> TyparRigidity.Unresolved
329333
| _ -> failwith "unreachable"
330334

331335
/// Indicates whether a type variable can be instantiated by types or units-of-measure.
@@ -774,7 +778,7 @@ type Entity =
774778

775779
/// Get the Abstract IL scope, nesting and metadata for this
776780
/// type definition, assuming it is backed by Abstract IL metadata.
777-
member x.ILTyconInfo = match x.TypeReprInfo with | TILObjectRepr (a,b,c) -> (a,b,c) | _ -> assert false; failwith "not a .NET type definition"
781+
member x.ILTyconInfo = match x.TypeReprInfo with | TILObjectRepr (a,b,c) -> (a,b,c) | i -> failwithf "not a .NET type definition: %+A" i
778782

779783
/// Get the Abstract IL metadata for this type definition, assuming it is backed by Abstract IL metadata.
780784
member x.ILTyconRawMetadata = let _,_,td = x.ILTyconInfo in td
@@ -4551,6 +4555,8 @@ let NewTypar (kind,rigid,Typar(id,staticReq,isCompGen),isFromError,dynamicReq,at
45514555

45524556
let NewRigidTypar nm m = NewTypar (TyparKind.Type,TyparRigidity.Rigid,Typar(mkSynId m nm,NoStaticReq,true),false,TyparDynamicReq.Yes,[],false,false)
45534557

4558+
let NewUnresolvedTypar nm m = NewTypar (TyparKind.Type,TyparRigidity.Unresolved,Typar(mkSynId m nm,NoStaticReq,true),false,TyparDynamicReq.Yes,[],false,false)
4559+
45544560
let NewUnionCase id nm tys rty attribs docOption access : UnionCase =
45554561
{ Id=id
45564562
CompiledName=nm

0 commit comments

Comments
 (0)