Skip to content

Commit f87b2ab

Browse files
Jand42Jand42
committed
test signatures resolved from IL to F# members, fixes
1 parent c751673 commit f87b2ab

File tree

7 files changed

+294
-81
lines changed

7 files changed

+294
-81
lines changed

‎src/fsharp/TastOps.fs‎

Lines changed: 15 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -621,18 +621,16 @@ 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,args) ->
624+
| TType_app (tcref,tinst) ->
625625
let tycon = tcref.Deref
626-
let strippedArgs = args |> List.map (stripTyEqnsA g canShortcut)
627626
match tycon.TypeAbbrev with
628627
| Some abbrevTy ->
629-
stripTyEqnsA g canShortcut (applyTyconAbbrev abbrevTy tycon strippedArgs)
628+
stripTyEqnsA g canShortcut (applyTyconAbbrev abbrevTy tycon tinst)
630629
| None ->
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
630+
if tycon.IsMeasureableReprTycon && List.forall (isDimensionless g) tinst then
631+
stripTyEqnsA g canShortcut (reduceTyconMeasureableOrProvided g tycon tinst)
632+
else
634633
ty
635-
else instType (mkTyconInst tycon strippedArgs) ty
636634
| ty -> ty
637635

638636
let stripTyEqns g ty = stripTyEqnsA g false ty
@@ -646,20 +644,14 @@ let rec stripTyEqnsAndErase eraseFuncAndTuple g ty =
646644
match ty with
647645
| TType_app (tcref,args) ->
648646
let tycon = tcref.Deref
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
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
663655
| ty -> ty
664656

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

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

839830
and typarsAEquivAux erasureFlag g (aenv: TypeEquivEnv) tps1 tps2 =
840831
List.length tps1 = List.length tps2 &&
@@ -850,11 +841,7 @@ and typeAEquivAux erasureFlag g aenv ty1 ty2 =
850841
let ty2 = stripTyEqnsWrtErasure erasureFlag g ty2
851842
match ty1, ty2 with
852843
| TType_forall(tps1,rty1), TType_forall(tps2,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
844+
typarsAEquivAux erasureFlag g aenv tps1 tps2 && typeAEquivAux erasureFlag g (aenv.BindEquivTypars tps1 tps2) rty1 rty2
858845
| TType_var tp1, TType_var tp2 when typarEq tp1 tp2 ->
859846
true
860847
| TType_var tp1, _ when aenv.EquivTypars.ContainsKey tp1 ->

‎src/fsharp/tast.fs‎

Lines changed: 2 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -274,8 +274,6 @@ 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
279277
member x.ErrorIfUnified = match x with TyparRigidity.Rigid -> true | _ -> false
280278
member x.WarnIfUnified = match x with TyparRigidity.WillBeRigid | TyparRigidity.WarnIfNotRigid -> true | _ -> false
281279
member x.WarnIfMissingConstraint = match x with TyparRigidity.WillBeRigid -> true | _ -> false
@@ -296,8 +294,7 @@ type TyparFlags(flags:int32) =
296294
| TyparRigidity.WillBeRigid -> 0b000000100000
297295
| TyparRigidity.WarnIfNotRigid -> 0b000001000000
298296
| TyparRigidity.Flexible -> 0b000001100000
299-
| TyparRigidity.Anon -> 0b000010000000
300-
| TyparRigidity.Unresolved -> 0b000010100000) |||
297+
| TyparRigidity.Anon -> 0b000010000000) |||
301298
(match kind with
302299
| TyparKind.Type -> 0b000000000000
303300
| TyparKind.Measure -> 0b000100000000) |||
@@ -329,7 +326,6 @@ type TyparFlags(flags:int32) =
329326
| 0b000001000000 -> TyparRigidity.WarnIfNotRigid
330327
| 0b000001100000 -> TyparRigidity.Flexible
331328
| 0b000010000000 -> TyparRigidity.Anon
332-
| 0b000010100000 -> TyparRigidity.Unresolved
333329
| _ -> failwith "unreachable"
334330

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

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

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

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

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

‎src/fsharp/vs/Exprs.fs‎

Lines changed: 25 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -687,6 +687,7 @@ module FSharpExprConvert =
687687
let isProp = isPropGet || isPropSet
688688

689689
let tcref, subClass =
690+
// this does not matter currently, type checking fails to resolve it when a TP references a union case subclass
690691
try
691692
// if the type is an union case class, lookup will fail
692693
Import.ImportILTypeRef cenv.amap m ilMethRef.EnclosingTypeRef, None
@@ -712,33 +713,36 @@ module FSharpExprConvert =
712713
// takes a possibly fake ValRef and tries to resolve it to an F# expression
713714
let makeFSExpr isMember (vr: ValRef) =
714715
let nlr = vr.nlr
715-
let e =
716+
let enclosingEntity =
716717
try
717718
nlr.EnclosingEntity.Deref
718719
with _ ->
719720
failwithf "Failed to resolve type '%s'" (nlr.EnclosingEntity.CompiledName)
720721
let ccu = nlr.EnclosingEntity.nlr.Ccu
721-
let possible = e.ModuleOrNamespaceType.TryLinkVal(ccu, nlr.ItemKey)
722-
match possible with
723-
| Some _ -> makeFSCall isMember vr
724-
| None ->
725722
let vName = nlr.ItemKey.PartialKey.LogicalName // this is actually compiled name
726723
let findByName =
727-
e.MembersOfFSharpTyconSorted |> List.filter (fun v -> v.CompiledName = vName)
724+
enclosingEntity.MembersOfFSharpTyconSorted |> List.filter (fun v -> v.CompiledName = vName)
728725
match findByName with
729726
| [v] ->
730727
makeFSCall isMember v
731728
| [] ->
732729
let typR = ConvType cenv (mkAppTy tcref enclTypeArgs)
733-
if e.IsModuleOrNamespace then
734-
let findModuleMemberByName = e.ModuleOrNamespaceType.AllValsAndMembers |> Seq.tryFind (fun v -> v.CompiledName = vName)
730+
if enclosingEntity.IsModuleOrNamespace then
731+
let findModuleMemberByName =
732+
enclosingEntity.ModuleOrNamespaceType.AllValsAndMembers
733+
|> Seq.filter (fun v ->
734+
v.CompiledName = vName &&
735+
match v.ActualParent with
736+
| Parent p -> p.PublicPath = enclosingEntity.PublicPath
737+
| _ -> false
738+
) |> List.ofSeq
735739
match findModuleMemberByName with
736-
| Some v ->
737-
let vr = VRefNonLocalPreResolved v nlr
740+
| [v] ->
741+
let vr = VRefLocal v
738742
makeFSCall isMember vr
739743
| _ ->
740-
failwithf "Module member not found: %s" vName
741-
elif e.IsRecordTycon then
744+
failwith "Failed to resolve overload"
745+
elif enclosingEntity.IsRecordTycon then
742746
if isProp then
743747
let name = PrettyNaming.ChopPropertyName vName
744748
let projR = ConvRecdFieldRef cenv (RFRef(tcref, name))
@@ -753,7 +757,7 @@ module FSharpExprConvert =
753757
E.NewRecord(typR, argsR)
754758
else
755759
failwith "Failed to recognize record type member"
756-
elif e.IsUnionTycon then
760+
elif enclosingEntity.IsUnionTycon then
757761
if vName = "GetTag" then
758762
let objR = ConvExpr cenv env callArgs.Head
759763
E.UnionCaseTag(objR, typR)
@@ -778,8 +782,8 @@ module FSharpExprConvert =
778782
| _ ->
779783
failwith "Failed to recognize union type member"
780784
else
781-
let names = e.MembersOfFSharpTyconSorted |> List.map (fun v -> v.CompiledName) |> String.concat ", "
782-
failwithf "Member '%s' not found in type %s, found: %s" vName e.DisplayName names
785+
let names = enclosingEntity.MembersOfFSharpTyconSorted |> List.map (fun v -> v.CompiledName) |> String.concat ", "
786+
failwithf "Member '%s' not found in type %s, found: %s" vName enclosingEntity.DisplayName names
783787
| _ -> // member is overloaded
784788
match nlr.ItemKey.TypeForLinkage with
785789
| None -> failwith "Type of signature could not be resolved"
@@ -826,7 +830,7 @@ module FSharpExprConvert =
826830
let isStatic = isCtor || ilMethRef.CallingConv.IsStatic
827831
let scoref = ilMethRef.EnclosingTypeRef.Scope
828832
let typars1 = tcref.Typars(m)
829-
let typars2 = [ 1 .. ilMethRef.GenericArity ] |> List.map (fun _ -> NewUnresolvedTypar "T" m)
833+
let typars2 = [ 1 .. ilMethRef.GenericArity ] |> List.map (fun _ -> NewRigidTypar "T" m)
830834
let tinst1 = typars1 |> generalizeTypars
831835
let tinst2 = typars2 |> generalizeTypars
832836
// TODO: this will not work for curried methods in F# classes.
@@ -846,18 +850,11 @@ module FSharpExprConvert =
846850
let argCount = List.sum (List.map List.length argtys) + (if isStatic then 0 else 1)
847851
let key = ValLinkageFullKey({ MemberParentMangledName=memberParentName; MemberIsOverride=false; LogicalName=logicalName; TotalArgCount= argCount },Some linkageType)
848852

849-
let enclosingNonLocalRef = mkNonLocalEntityRef tcref.nlr.Ccu tcref.PublicPath.Value.EnclosingPath
850-
851-
try
852-
let vref = mkNonLocalValRef enclosingNonLocalRef key
853-
makeFSExpr isMember vref
854-
with _ ->
855-
// union compiler generated members can be found up in parent module/namespace
856-
// also class members with a CompiledName
857-
let (PubPath p) = tcref.PublicPath.Value
858-
let enclosingNonLocalRef = mkNonLocalEntityRef tcref.nlr.Ccu p
859-
let vref = mkNonLocalValRef enclosingNonLocalRef key
860-
makeFSExpr isMember vref
853+
let (PubPath p) = tcref.PublicPath.Value
854+
let enclosingNonLocalRef = mkNonLocalEntityRef tcref.nlr.Ccu p
855+
let vref = mkNonLocalValRef enclosingNonLocalRef key
856+
makeFSExpr isMember vref
857+
861858
else
862859
let key = ValLinkageFullKey({ MemberParentMangledName=memberParentName; MemberIsOverride=false; LogicalName=logicalName; TotalArgCount= 0 },None)
863860
let vref = mkNonLocalValRef tcref.nlr key

0 commit comments

Comments
 (0)