"Fossies" - the Fresh Open Source Software Archive

Member "fsharp-4.5/src/fsharp/MethodOverrides.fs" (5 Sep 2018, 43310 Bytes) of package /linux/misc/mono-sources/fsharp/fsharp-4.5.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) F# source code syntax highlighting (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file. See also the latest Fossies "Diffs" side-by-side code changes report for "MethodOverrides.fs": 4.1.33_vs_4.5.

    1 // Copyright (c) Microsoft Corporation.  All Rights Reserved.  See License.txt in the project root for license information.
    2 
    3 /// Primary logic related to method overrides.
    4 module internal Microsoft.FSharp.Compiler.MethodOverrides
    5 
    6 open Microsoft.FSharp.Compiler 
    7 open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library 
    8 open Microsoft.FSharp.Compiler.Ast
    9 open Microsoft.FSharp.Compiler.ErrorLogger
   10 open Microsoft.FSharp.Compiler.Lib
   11 open Microsoft.FSharp.Compiler.Infos
   12 open Microsoft.FSharp.Compiler.AccessibilityLogic
   13 open Microsoft.FSharp.Compiler.NameResolution
   14 open Microsoft.FSharp.Compiler.Range
   15 open Microsoft.FSharp.Compiler.InfoReader
   16 open Microsoft.FSharp.Compiler.Tast
   17 open Microsoft.FSharp.Compiler.Tastops
   18 open Microsoft.FSharp.Compiler.TcGlobals
   19 open Microsoft.FSharp.Compiler.TypeRelations
   20 
   21 //-------------------------------------------------------------------------
   22 // Completeness of classes
   23 //------------------------------------------------------------------------- 
   24 
   25 type OverrideCanImplement = 
   26     | CanImplementAnyInterfaceSlot
   27     | CanImplementAnyClassHierarchySlot
   28     | CanImplementAnySlot
   29     | CanImplementNoSlots
   30     
   31 /// The overall information about a method implementation in a class or object expression 
   32 type OverrideInfo = 
   33     | Override of OverrideCanImplement * TyconRef * Ident * (Typars * TyparInst) * TType list list * TType option * bool * bool
   34     member x.CanImplement = let (Override(a,_,_,_,_,_,_,_)) = x in a
   35     member x.BoundingTyconRef = let (Override(_,ty,_,_,_,_,_,_)) = x in ty
   36     member x.LogicalName = let (Override(_,_,id,_,_,_,_,_)) = x in id.idText
   37     member x.Range = let (Override(_,_,id,_,_,_,_,_)) = x in id.idRange
   38     member x.IsFakeEventProperty = let (Override(_,_,_,_,_,_,b,_)) = x in b
   39     member x.ArgTypes = let (Override(_,_,_,_,b,_,_,_)) = x in b
   40     member x.ReturnType = let (Override(_,_,_,_,_,b,_,_)) = x in b
   41     member x.IsCompilerGenerated = let (Override(_,_,_,_,_,_,_,b)) = x in b
   42 
   43 // If the bool is true then the slot is optional, i.e. is an interface slot
   44 // which does not _have_ to be implemented, because an inherited implementation 
   45 // is available.
   46 type RequiredSlot = RequiredSlot of MethInfo * (* isOptional: *) bool 
   47 
   48 type SlotImplSet = SlotImplSet of RequiredSlot list * NameMultiMap<RequiredSlot> * OverrideInfo list * PropInfo list
   49 
   50 exception TypeIsImplicitlyAbstract of range
   51 exception OverrideDoesntOverride of DisplayEnv * OverrideInfo * MethInfo option * TcGlobals * Import.ImportMap * range
   52 
   53 module DispatchSlotChecking =
   54 
   55     /// Print the signature of an override to a buffer as part of an error message
   56     let PrintOverrideToBuffer denv os (Override(_,_,id,(mtps,memberToParentInst),argTys,retTy,_,_)) = 
   57        let denv = { denv with showTyparBinding = true }
   58        let retTy = (retTy  |> GetFSharpViewOfReturnType denv.g)
   59        let argInfos = 
   60            match argTys with 
   61            | [] -> [[(denv.g.unit_ty,ValReprInfo.unnamedTopArg1)]]
   62            | _ -> argTys |> List.mapSquared (fun ty -> (ty, ValReprInfo.unnamedTopArg1)) 
   63        Layout.bufferL os (NicePrint.prettyLayoutOfMemberSig denv (memberToParentInst,id.idText,mtps, argInfos, retTy))
   64 
   65     /// Print the signature of a MethInfo to a buffer as part of an error message
   66     let PrintMethInfoSigToBuffer g amap m denv os minfo =
   67         let denv = { denv with showTyparBinding = true }
   68         let (CompiledSig(argTys,retTy,fmtps,ttpinst)) = CompiledSigOfMeth g amap m minfo
   69         let retTy = (retTy  |> GetFSharpViewOfReturnType g)
   70         let argInfos = argTys |> List.mapSquared (fun ty -> (ty, ValReprInfo.unnamedTopArg1))
   71         let nm = minfo.LogicalName
   72         Layout.bufferL os (NicePrint.prettyLayoutOfMemberSig denv (ttpinst,nm,fmtps, argInfos, retTy))
   73 
   74     /// Format the signature of an override as a string as part of an error message
   75     let FormatOverride denv d = bufs (fun buf -> PrintOverrideToBuffer denv buf d)
   76 
   77     /// Format the signature of a MethInfo as a string as part of an error message
   78     let FormatMethInfoSig g amap m denv d = bufs (fun buf -> PrintMethInfoSigToBuffer g amap m denv buf d)
   79 
   80     /// Get the override info for an existing (inherited) method being used to implement a dispatch slot.
   81     let GetInheritedMemberOverrideInfo g amap m parentType (minfo:MethInfo) = 
   82         let nm = minfo.LogicalName
   83         let (CompiledSig (argTys,retTy,fmtps,ttpinst)) = CompiledSigOfMeth g amap m minfo
   84 
   85         let isFakeEventProperty = minfo.IsFSharpEventPropertyMethod
   86         Override(parentType, minfo.ApparentEnclosingTyconRef, mkSynId m nm, (fmtps,ttpinst),argTys,retTy,isFakeEventProperty,false)
   87 
   88     /// Get the override info for a value being used to implement a dispatch slot.
   89     let GetTypeMemberOverrideInfo g reqdTy (overrideBy:ValRef) = 
   90         let _,argInfos,retTy,_ = GetTypeOfMemberInMemberForm g overrideBy
   91         let nm = overrideBy.LogicalName
   92 
   93         let argTys = argInfos |> List.mapSquared fst
   94         
   95         let memberMethodTypars,memberToParentInst,argTys,retTy = 
   96             match PartitionValRefTypars g overrideBy with
   97             | Some(_,_,memberMethodTypars,memberToParentInst,_tinst) -> 
   98                 let argTys = argTys |> List.mapSquared (instType memberToParentInst) 
   99                 let retTy = retTy |> Option.map (instType memberToParentInst) 
  100                 memberMethodTypars, memberToParentInst,argTys, retTy
  101             | None -> 
  102                 error(Error(FSComp.SR.typrelMethodIsOverconstrained(),overrideBy.Range))
  103         let implKind = 
  104             if ValRefIsExplicitImpl g overrideBy then 
  105                 
  106                 let belongsToReqdTy = 
  107                     match overrideBy.MemberInfo.Value.ImplementedSlotSigs with
  108                     | [] -> false
  109                     | ss :: _ -> isInterfaceTy g ss.ImplementedType && typeEquiv g reqdTy ss.ImplementedType
  110                 if belongsToReqdTy then 
  111                     CanImplementAnyInterfaceSlot
  112                 else
  113                     CanImplementNoSlots
  114             else if overrideBy.IsDispatchSlotMember then 
  115                 CanImplementNoSlots
  116                 // abstract slots can only implement interface slots
  117                 //CanImplementAnyInterfaceSlot  <<----- Change to this to enable implicit interface implementation
  118             
  119             else 
  120                 CanImplementAnyClassHierarchySlot
  121                 //CanImplementAnySlot  <<----- Change to this to enable implicit interface implementation
  122 
  123         let isFakeEventProperty = overrideBy.IsFSharpEventProperty(g)
  124         Override(implKind,overrideBy.MemberApparentEntity, mkSynId overrideBy.Range nm, (memberMethodTypars,memberToParentInst),argTys,retTy,isFakeEventProperty, overrideBy.IsCompilerGenerated)
  125 
  126     /// Get the override information for an object expression method being used to implement dispatch slots
  127     let GetObjectExprOverrideInfo g amap (implty, id:Ident, memberFlags, ty, arityInfo, bindingAttribs, rhsExpr) = 
  128         // Dissect the type
  129         let tps, argInfos, retTy, _ = GetMemberTypeInMemberForm g memberFlags arityInfo ty id.idRange
  130         let argTys = argInfos |> List.mapSquared fst
  131         // Dissect the implementation
  132         let _, ctorThisValOpt, baseValOpt, vsl, rhsExpr,_ = destTopLambda g amap arityInfo (rhsExpr,ty)
  133         assert ctorThisValOpt.IsNone
  134 
  135         // Drop 'this'
  136         match vsl with 
  137         | [thisv]::vs -> 
  138             // Check for empty variable list from a () arg
  139             let vs = if vs.Length = 1 && argInfos.IsEmpty then [] else vs
  140             let implKind = 
  141                 if isInterfaceTy g implty then 
  142                     CanImplementAnyInterfaceSlot 
  143                 else 
  144                     CanImplementAnyClassHierarchySlot
  145                     //CanImplementAnySlot  <<----- Change to this to enable implicit interface implementation
  146             let isFakeEventProperty = CompileAsEvent g bindingAttribs
  147             let overrideByInfo = Override(implKind, tcrefOfAppTy g implty, id, (tps,[]), argTys, retTy, isFakeEventProperty, false)
  148             overrideByInfo, (baseValOpt, thisv, vs, bindingAttribs, rhsExpr)
  149         | _ -> 
  150             error(InternalError("Unexpected shape for object expression override",id.idRange))
  151           
  152     /// Check if an override matches a dispatch slot by name
  153     let IsNameMatch (dispatchSlot:MethInfo) (overrideBy: OverrideInfo) = 
  154         (overrideBy.LogicalName = dispatchSlot.LogicalName)
  155           
  156     /// Check if an override matches a dispatch slot by name
  157     let IsImplMatch g (dispatchSlot:MethInfo) (overrideBy: OverrideInfo) = 
  158         // If the override is listed as only relevant to one type, and we're matching it against an abstract slot of an interface type,
  159         // then check that interface type is the right type.
  160         match overrideBy.CanImplement with 
  161         | CanImplementNoSlots -> false
  162         | CanImplementAnySlot -> true 
  163         | CanImplementAnyClassHierarchySlot -> not (isInterfaceTy g dispatchSlot.ApparentEnclosingType)
  164         | CanImplementAnyInterfaceSlot -> isInterfaceTy g dispatchSlot.ApparentEnclosingType
  165 
  166     /// Check if the kinds of type parameters match between a dispatch slot and an override.
  167     let IsTyparKindMatch (CompiledSig(_,_,fvmtps,_)) (Override(_,_,_,(mtps,_),_,_,_,_)) = 
  168         List.lengthsEqAndForall2 (fun (tp1:Typar) (tp2:Typar) -> tp1.Kind = tp2.Kind) mtps fvmtps
  169         
  170     /// Check if an override is a partial match for the requirements for a dispatch slot 
  171     let IsPartialMatch g (dispatchSlot:MethInfo) compiledSig (Override(_,_,_,(mtps,_),argTys,_retTy,_,_) as overrideBy) = 
  172         IsNameMatch dispatchSlot overrideBy &&
  173         let (CompiledSig (vargtys,_,fvmtps,_)) = compiledSig
  174         mtps.Length = fvmtps.Length &&
  175         IsTyparKindMatch compiledSig overrideBy && 
  176         argTys.Length = vargtys.Length &&
  177         IsImplMatch g dispatchSlot overrideBy  
  178           
  179     /// Compute the reverse of a type parameter renaming.
  180     let ReverseTyparRenaming g tinst = 
  181         tinst |> List.map (fun (tp,ty) -> (destTyparTy g ty, mkTyparTy tp))
  182 
  183     /// Compose two instantiations of type parameters.
  184     let ComposeTyparInsts inst1 inst2 = 
  185         inst1 |> List.map (map2Of2 (instType inst2)) 
  186      
  187     /// Check if an override exactly matches the requirements for a dispatch slot 
  188     let IsExactMatch g amap m dispatchSlot (Override(_,_,_,(mtps,mtpinst),argTys,retTy,_,_) as overrideBy) =
  189         let compiledSig = CompiledSigOfMeth g amap m dispatchSlot
  190         IsPartialMatch g dispatchSlot compiledSig overrideBy &&
  191         let (CompiledSig (vargtys,vrty,fvmtps,ttpinst)) = compiledSig
  192 
  193         // Compare the types. CompiledSigOfMeth, GetObjectExprOverrideInfo and GetTypeMemberOverrideInfo have already 
  194         // applied all relevant substitutions except the renamings from fvtmps <-> mtps 
  195 
  196         let aenv = TypeEquivEnv.FromEquivTypars fvmtps mtps 
  197 
  198         List.forall2 (List.lengthsEqAndForall2 (typeAEquiv g aenv)) vargtys argTys &&
  199         returnTypesAEquiv g aenv vrty retTy &&
  200         
  201         // Comparing the method typars and their constraints is much trickier since the substitutions have not been applied 
  202         // to the constraints of these babies. This is partly because constraints are directly attached to typars so it's 
  203         // difficult to apply substitutions to them unless we separate them off at some point, which we don't as yet.        
  204         //
  205         // Given   C<ctps>
  206         //         D<dtps>
  207         //         dispatchSlot :   C<ctys[dtps]>.M<fvmtps[ctps]>(...)
  208         //         overrideBy:  parent: D<dtys[dtps]>  value: !<ttps> <mtps[ttps]>(...) 
  209         //         
  210         //     where X[dtps] indicates that X may involve free type variables dtps
  211         //     
  212         //     we have 
  213         //         ttpinst maps  ctps --> ctys[dtps] 
  214         //         mtpinst maps  ttps --> dtps
  215         //       
  216         //     compare fvtmps[ctps] and mtps[ttps] by 
  217         //        fvtmps[ctps]  @ ttpinst     -- gives fvtmps[dtps]
  218         //        fvtmps[dtps] @ rev(mtpinst) -- gives fvtmps[ttps]
  219         //        
  220         //     Now fvtmps[ttps] and mtpinst[ttps] are comparable, i.e. have constraints w.r.t. the same set of type variables 
  221         //         
  222         // i.e.  Compose the substitutions ttpinst and rev(mtpinst) 
  223         
  224         let ttpinst = 
  225             // check we can reverse - in some error recovery situations we can't 
  226             if mtpinst |> List.exists (snd >> isTyparTy g >> not) then ttpinst 
  227             else ComposeTyparInsts ttpinst (ReverseTyparRenaming g mtpinst)
  228 
  229         // Compare under the composed substitutions 
  230         let aenv = TypeEquivEnv.FromTyparInst ttpinst 
  231         
  232         typarsAEquiv g aenv fvmtps mtps
  233 
  234     /// Check if an override implements a dispatch slot 
  235     let OverrideImplementsDispatchSlot g amap m dispatchSlot availPriorOverride =
  236         IsExactMatch g amap m dispatchSlot availPriorOverride &&
  237         // The override has to actually be in some subtype of the dispatch slot
  238         ExistsHeadTypeInEntireHierarchy g amap m (generalizedTyconRef availPriorOverride.BoundingTyconRef) dispatchSlot.DeclaringTyconRef
  239 
  240     /// Check if a dispatch slot is already implemented
  241     let DispatchSlotIsAlreadyImplemented g amap m availPriorOverridesKeyed (dispatchSlot: MethInfo) =
  242         availPriorOverridesKeyed 
  243             |> NameMultiMap.find  dispatchSlot.LogicalName  
  244             |> List.exists (OverrideImplementsDispatchSlot g amap m dispatchSlot)
  245 
  246 
  247     /// Check all dispatch slots are implemented by some override.
  248     let CheckDispatchSlotsAreImplemented (denv,g,amap,m,
  249                                           nenv,sink:TcResultsSink,
  250                                           isOverallTyAbstract,
  251                                           reqdTy,
  252                                           dispatchSlots:RequiredSlot list,
  253                                           availPriorOverrides:OverrideInfo list,
  254                                           overrides:OverrideInfo list) = 
  255 
  256         let isReqdTyInterface = isInterfaceTy g reqdTy 
  257         let showMissingMethodsAndRaiseErrors = (isReqdTyInterface || not isOverallTyAbstract)
  258         let res = ref true
  259         let fail exn = (res := false ; if showMissingMethodsAndRaiseErrors then errorR exn)
  260         
  261         // Index the availPriorOverrides and overrides by name
  262         let availPriorOverridesKeyed = availPriorOverrides |> NameMultiMap.initBy (fun ov -> ov.LogicalName)
  263         let overridesKeyed = overrides |> NameMultiMap.initBy (fun ov -> ov.LogicalName)
  264         
  265         dispatchSlots |> List.iter (fun (RequiredSlot(dispatchSlot,isOptional)) -> 
  266           
  267             match NameMultiMap.find dispatchSlot.LogicalName overridesKeyed 
  268                     |> List.filter (OverrideImplementsDispatchSlot g amap m dispatchSlot)  with
  269             | [ovd] -> 
  270                 if not ovd.IsCompilerGenerated then 
  271                     let item = Item.MethodGroup(ovd.LogicalName,[dispatchSlot],None)
  272                     CallNameResolutionSink sink (ovd.Range,nenv,item,item,dispatchSlot.FormalMethodTyparInst,ItemOccurence.Implemented,denv,AccessorDomain.AccessibleFromSomewhere)
  273                 sink |> ignore
  274                 ()
  275             | [] -> 
  276                 if not isOptional &&
  277                    // Check that no available prior override implements this dispatch slot
  278                    not (DispatchSlotIsAlreadyImplemented g amap m availPriorOverridesKeyed dispatchSlot) 
  279                 then 
  280                     // error reporting path
  281                     let compiledSig = CompiledSigOfMeth g amap m dispatchSlot
  282                     
  283                     let noimpl() = 
  284                         if isReqdTyInterface then 
  285                             fail(Error(FSComp.SR.typrelNoImplementationGivenWithSuggestion(NicePrint.stringOfMethInfo amap m denv dispatchSlot), m))
  286                         else 
  287                             fail(Error(FSComp.SR.typrelNoImplementationGiven(NicePrint.stringOfMethInfo amap m denv dispatchSlot), m))
  288                     
  289                     match overrides |> List.filter (IsPartialMatch g dispatchSlot compiledSig) with 
  290                     | [] -> 
  291                         let possibleOverrides =
  292                             overrides
  293                             |> List.filter (fun overrideBy -> IsNameMatch dispatchSlot overrideBy && IsImplMatch g dispatchSlot overrideBy)
  294 
  295                         match possibleOverrides with 
  296                         | [] -> 
  297                             noimpl()
  298                         | [ Override(_,_,_,(mtps,_),argTys,_,_,_) as overrideBy ] ->
  299                             let moreThanOnePossibleDispatchSlot =
  300                                 dispatchSlots
  301                                 |> List.filter (fun (RequiredSlot(dispatchSlot,_)) -> IsNameMatch dispatchSlot overrideBy && IsImplMatch g dispatchSlot overrideBy)
  302                                 |> isNilOrSingleton
  303                                 |> not
  304                             
  305                             let (CompiledSig (vargtys,_,fvmtps,_)) = compiledSig
  306 
  307                             if moreThanOnePossibleDispatchSlot then
  308                                 noimpl()
  309 
  310                             elif argTys.Length <> vargtys.Length then 
  311                                 fail(Error(FSComp.SR.typrelMemberDoesNotHaveCorrectNumberOfArguments(FormatOverride denv overrideBy, FormatMethInfoSig g amap m denv dispatchSlot), overrideBy.Range))
  312                             elif mtps.Length <> fvmtps.Length then
  313                                 fail(Error(FSComp.SR.typrelMemberDoesNotHaveCorrectNumberOfTypeParameters(FormatOverride denv overrideBy, FormatMethInfoSig g amap m denv dispatchSlot), overrideBy.Range))
  314                             elif not (IsTyparKindMatch compiledSig overrideBy) then
  315                                 fail(Error(FSComp.SR.typrelMemberDoesNotHaveCorrectKindsOfGenericParameters(FormatOverride denv overrideBy, FormatMethInfoSig g amap m denv dispatchSlot), overrideBy.Range))
  316                             else 
  317                                 fail(Error(FSComp.SR.typrelMemberCannotImplement(FormatOverride denv overrideBy, NicePrint.stringOfMethInfo amap m denv dispatchSlot, FormatMethInfoSig g amap m denv dispatchSlot), overrideBy.Range))
  318                         | overrideBy :: _ -> 
  319                             errorR(Error(FSComp.SR.typrelOverloadNotFound(FormatMethInfoSig g amap m denv dispatchSlot, FormatMethInfoSig g amap m denv dispatchSlot),overrideBy.Range))
  320 
  321                     | [ overrideBy ] -> 
  322                         if dispatchSlots |> List.exists (fun (RequiredSlot(dispatchSlot,_)) -> OverrideImplementsDispatchSlot g amap m dispatchSlot overrideBy) then
  323                             noimpl()
  324                         else
  325                             // Error will be reported below in CheckOverridesAreAllUsedOnce 
  326                             ()
  327                         
  328                     | _ -> 
  329                         fail(Error(FSComp.SR.typrelOverrideWasAmbiguous(FormatMethInfoSig g amap m denv dispatchSlot),m))
  330             | _ -> fail(Error(FSComp.SR.typrelMoreThenOneOverride(FormatMethInfoSig g amap m denv dispatchSlot),m)))
  331         !res
  332 
  333     /// Check all implementations implement some dispatch slot.
  334     let CheckOverridesAreAllUsedOnce(denv, g, amap, isObjExpr, reqdTy,
  335                                      dispatchSlotsKeyed: NameMultiMap<RequiredSlot>,
  336                                      availPriorOverrides: OverrideInfo list,
  337                                      overrides: OverrideInfo list) = 
  338         let availPriorOverridesKeyed = availPriorOverrides |> NameMultiMap.initBy (fun ov -> ov.LogicalName)
  339         for overrideBy in overrides do 
  340           if not overrideBy.IsFakeEventProperty then
  341             let m = overrideBy.Range
  342             let relevantVirts = NameMultiMap.find overrideBy.LogicalName dispatchSlotsKeyed
  343             let relevantVirts = relevantVirts |> List.map (fun (RequiredSlot(dispatchSlot,_)) -> dispatchSlot)
  344 
  345             match relevantVirts |> List.filter (fun dispatchSlot -> OverrideImplementsDispatchSlot g amap m dispatchSlot overrideBy) with
  346             | [] -> 
  347                 // This is all error reporting
  348                 match relevantVirts |> List.filter (fun dispatchSlot -> IsPartialMatch g dispatchSlot (CompiledSigOfMeth g amap m dispatchSlot) overrideBy) with 
  349                 | [dispatchSlot] -> 
  350                     errorR(OverrideDoesntOverride(denv,overrideBy,Some dispatchSlot,g,amap,m))
  351                 | _ -> 
  352                     match relevantVirts |> List.filter (fun dispatchSlot -> IsNameMatch dispatchSlot overrideBy) with 
  353                     | [] -> errorR(OverrideDoesntOverride(denv,overrideBy,None,g,amap,m))
  354                     | [dispatchSlot] -> 
  355                         errorR(OverrideDoesntOverride(denv, overrideBy, Some dispatchSlot, g, amap, m))
  356                     | possibleDispatchSlots -> 
  357                        let details =
  358                             possibleDispatchSlots
  359                             |> List.map (fun dispatchSlot -> FormatMethInfoSig g amap m denv dispatchSlot)
  360                             |> Seq.map (sprintf "%s   %s" System.Environment.NewLine)
  361                             |> String.concat ""
  362 
  363                        errorR(Error(FSComp.SR.typrelMemberHasMultiplePossibleDispatchSlots(FormatOverride denv overrideBy, details), overrideBy.Range))
  364 
  365 
  366             | [dispatchSlot] -> 
  367                 if dispatchSlot.IsFinal && (isObjExpr || not (typeEquiv g reqdTy dispatchSlot.ApparentEnclosingType)) then 
  368                     errorR(Error(FSComp.SR.typrelMethodIsSealed(NicePrint.stringOfMethInfo amap m denv dispatchSlot),m))
  369             | dispatchSlots -> 
  370                 match dispatchSlots |> List.filter (fun dispatchSlot -> 
  371                               isInterfaceTy g dispatchSlot.ApparentEnclosingType || 
  372                               not (DispatchSlotIsAlreadyImplemented g amap m availPriorOverridesKeyed dispatchSlot)) with
  373                 | h1 :: h2 :: _ -> 
  374                     errorR(Error(FSComp.SR.typrelOverrideImplementsMoreThenOneSlot((FormatOverride denv overrideBy), (NicePrint.stringOfMethInfo amap m denv h1), (NicePrint.stringOfMethInfo amap m denv h2)),m))
  375                 | _ -> 
  376                     // dispatch slots are ordered from the derived classes to base
  377                     // so we can check the topmost dispatch slot if it is final
  378                     match dispatchSlots with
  379                     | meth::_ when meth.IsFinal -> errorR(Error(FSComp.SR.tcCannotOverrideSealedMethod((sprintf "%s::%s" (meth.ApparentEnclosingType.ToString()) (meth.LogicalName))), m))
  380                     | _ -> ()
  381 
  382 
  383 
  384     /// Get the slots of a type that can or must be implemented. This depends
  385     /// partly on the full set of interface types that are being implemented
  386     /// simultaneously, e.g.
  387     ///    { new C with  interface I2 = ... interface I3 = ... }
  388     /// allReqdTys = {C;I2;I3}
  389     ///
  390     /// allReqdTys can include one class/record/union type. 
  391     let GetSlotImplSets (infoReader:InfoReader) denv isObjExpr allReqdTys = 
  392 
  393         let g = infoReader.g
  394         let amap = infoReader.amap
  395         
  396         let availImpliedInterfaces : TType list = 
  397             [ for (reqdTy,m) in allReqdTys do
  398                 if not (isInterfaceTy g reqdTy) then 
  399                     let baseTyOpt = if isObjExpr then Some reqdTy else GetSuperTypeOfType g amap m reqdTy 
  400                     match baseTyOpt with 
  401                     | None -> ()
  402                     | Some baseTy -> yield! AllInterfacesOfType g amap m AllowMultiIntfInstantiations.Yes baseTy  ]
  403                     
  404         // For each implemented type, get a list containing the transitive closure of
  405         // interface types implied by the type. This includes the implemented type itself if the implemented type
  406         // is an interface type.
  407         let intfSets = 
  408             allReqdTys |> List.mapi (fun i (reqdTy,m) -> 
  409                 let interfaces = AllInterfacesOfType g amap m AllowMultiIntfInstantiations.Yes reqdTy 
  410                 let impliedTys = (if isInterfaceTy g reqdTy then interfaces else reqdTy :: interfaces)
  411                 (i, reqdTy, impliedTys,m))
  412 
  413         // For each implemented type, reduce its list of implied interfaces by subtracting out those implied 
  414         // by another implemented interface type.
  415         //
  416         // REVIEW: Note complexity O(ity*jty)
  417         let reqdTyInfos = 
  418             intfSets |> List.map (fun (i,reqdTy,impliedTys,m) -> 
  419                 let reduced = 
  420                     (impliedTys,intfSets) ||> List.fold (fun acc (j,jty,impliedTys2,m) -> 
  421                          if i <> j && TypeFeasiblySubsumesType 0 g amap m jty CanCoerce reqdTy 
  422                          then ListSet.subtract (TypesFeasiblyEquiv 0 g amap m) acc impliedTys2
  423                          else acc ) 
  424                 (i, reqdTy, m, reduced))
  425 
  426         // Check that, for each implemented type, at least one implemented type is implied. This is enough to capture
  427         // duplicates.
  428         for (_i, reqdTy, m, impliedTys) in reqdTyInfos do
  429             if isInterfaceTy g reqdTy && isNil impliedTys then 
  430                 errorR(Error(FSComp.SR.typrelDuplicateInterface(),m))
  431 
  432         // Check that no interface type is implied twice
  433         //
  434         // Note complexity O(reqdTy*reqdTy)
  435         for (i, _reqdTy, reqdTyRange, impliedTys) in reqdTyInfos do
  436             for (j,_,_,impliedTys2) in reqdTyInfos do
  437                 if i > j then  
  438                     let overlap = ListSet.intersect (TypesFeasiblyEquiv 0 g amap reqdTyRange) impliedTys impliedTys2
  439                     overlap |> List.iter (fun overlappingTy -> 
  440                         if not (isNil (GetImmediateIntrinsicMethInfosOfType (None,AccessibleFromSomewhere) g amap reqdTyRange overlappingTy |> List.filter (fun minfo -> minfo.IsVirtual))) then
  441                             errorR(Error(FSComp.SR.typrelNeedExplicitImplementation(NicePrint.minimalStringOfType denv (List.head overlap)),reqdTyRange)))
  442 
  443         // Get the SlotImplSet for each implemented type
  444         // This contains the list of required members and the list of available members
  445         [ for (_,reqdTy,reqdTyRange,impliedTys) in reqdTyInfos do
  446 
  447             // Build a set of the implied interface types, for quicker lookup, by nominal type
  448             let isImpliedInterfaceTable = 
  449                 impliedTys 
  450                 |> List.filter (isInterfaceTy g) 
  451                 |> List.map (fun ty -> tcrefOfAppTy g ty, ()) 
  452                 |> TyconRefMap.OfList 
  453             
  454             // Is a member an abstract slot of one of the implied interface types?
  455             let isImpliedInterfaceType ty =
  456                 isAppTy g ty &&
  457                 isImpliedInterfaceTable.ContainsKey (tcrefOfAppTy g ty) &&
  458                 impliedTys |> List.exists (TypesFeasiblyEquiv 0 g amap reqdTyRange ty)
  459 
  460             //let isSlotImpl (minfo:MethInfo) = 
  461             //    not minfo.IsAbstract && minfo.IsVirtual 
  462 
  463             // Compute the abstract slots that require implementations
  464             let dispatchSlots = 
  465                 [ if isInterfaceTy g reqdTy then 
  466                       for impliedTy in impliedTys  do
  467                           // Check if the interface has an inherited implementation
  468                           // If so, you do not have to implement all the methods - each
  469                           // specific method is "optionally" implemented.
  470                           let isOptional = 
  471                               ListSet.contains (typeEquiv g) impliedTy availImpliedInterfaces
  472                           for reqdSlot in GetImmediateIntrinsicMethInfosOfType (None,AccessibleFromSomewhere) g amap reqdTyRange impliedTy do
  473                               yield RequiredSlot(reqdSlot, isOptional)
  474                   else
  475                       
  476                       // In the normal case, the requirements for a class are precisely all the abstract slots up the whole hierarchy.
  477                       // So here we get and yield all of those.
  478                       for minfo in reqdTy |> GetIntrinsicMethInfosOfType infoReader (None,AccessibleFromSomewhere,AllowMultiIntfInstantiations.Yes) IgnoreOverrides reqdTyRange do
  479                          if minfo.IsDispatchSlot then
  480                              yield RequiredSlot(minfo,(*isOptional=*) not minfo.IsAbstract) ]
  481                 
  482                 
  483             // Compute the methods that are available to implement abstract slots from the base class
  484             //
  485             // This is used in CheckDispatchSlotsAreImplemented when we think a dispatch slot may not
  486             // have been implemented. 
  487             let availPriorOverrides : OverrideInfo list = 
  488                 if isInterfaceTy g reqdTy then 
  489                     []
  490                 else 
  491                     let reqdTy = 
  492                         let baseTyOpt = if isObjExpr then Some reqdTy else GetSuperTypeOfType g amap reqdTyRange reqdTy 
  493                         match baseTyOpt with 
  494                         | None -> reqdTy
  495                         | Some baseTy -> baseTy 
  496                     [ // Get any class hierarchy methods on this type 
  497                       //
  498                       // NOTE: What we have below is an over-approximation that will get too many methods 
  499                       // and not always correctly relate them to the slots they implement. For example, 
  500                       // we may get an override from a base class and believe it implements a fresh, new abstract
  501                       // slot in a subclass. 
  502                       for minfos in infoReader.GetRawIntrinsicMethodSetsOfType(None,AccessibleFromSomewhere,AllowMultiIntfInstantiations.Yes,reqdTyRange,reqdTy) do
  503                         for minfo in minfos do
  504                           if not minfo.IsAbstract then 
  505                               yield GetInheritedMemberOverrideInfo g amap reqdTyRange CanImplementAnyClassHierarchySlot minfo   ]
  506                      
  507             // We also collect up the properties. This is used for abstract slot inference when overriding properties
  508             let isRelevantRequiredProperty (x:PropInfo) = 
  509                 (x.IsVirtualProperty && not (isInterfaceTy g reqdTy)) ||
  510                 isImpliedInterfaceType x.ApparentEnclosingType
  511                 
  512             let reqdProperties = 
  513                 GetIntrinsicPropInfosOfType infoReader (None,AccessibleFromSomewhere,AllowMultiIntfInstantiations.Yes) IgnoreOverrides reqdTyRange reqdTy 
  514                 |> List.filter isRelevantRequiredProperty
  515                 
  516             let dispatchSlotsKeyed = dispatchSlots |> NameMultiMap.initBy (fun (RequiredSlot(v,_)) -> v.LogicalName) 
  517             yield SlotImplSet(dispatchSlots, dispatchSlotsKeyed, availPriorOverrides, reqdProperties) ]
  518 
  519 
  520     /// Check that a type definition implements all its required interfaces after processing all declarations 
  521     /// within a file.
  522     let CheckImplementationRelationAtEndOfInferenceScope (infoReader :InfoReader,denv,nenv,sink,tycon:Tycon,isImplementation) =
  523 
  524         let g = infoReader.g
  525         let amap = infoReader.amap
  526 
  527         let tcaug = tycon.TypeContents        
  528         let interfaces = tycon.ImmediateInterfacesOfFSharpTycon |> List.map (fun (ity,_compgen,m) -> (ity,m))
  529 
  530         let overallTy = generalizedTyconRef (mkLocalTyconRef tycon)
  531 
  532         let allReqdTys = (overallTy,tycon.Range) :: interfaces 
  533 
  534         // Get all the members that are immediately part of this type
  535         // Include the auto-generated members
  536         let allImmediateMembers = tycon.MembersOfFSharpTyconSorted @ tycon.AllGeneratedValues
  537 
  538         // Get all the members we have to implement, organized by each type we explicitly implement
  539         let slotImplSets = GetSlotImplSets infoReader denv false allReqdTys
  540 
  541         let allImpls = List.zip allReqdTys slotImplSets
  542 
  543         // Find the methods relevant to implementing the abstract slots listed under the reqdType being checked.
  544         let allImmediateMembersThatMightImplementDispatchSlots = 
  545             allImmediateMembers |> List.filter (fun overrideBy -> 
  546                 overrideBy.IsInstanceMember   &&  // exclude static
  547                 overrideBy.IsVirtualMember &&  // exclude non virtual (e.g. keep override/default). [4469]
  548                 not overrideBy.IsDispatchSlotMember)
  549 
  550         let mustOverrideSomething reqdTy (overrideBy:ValRef) =
  551            let memberInfo = overrideBy.MemberInfo.Value
  552            not (overrideBy.IsFSharpEventProperty(g)) &&
  553            memberInfo.MemberFlags.IsOverrideOrExplicitImpl && 
  554     
  555            match memberInfo.ImplementedSlotSigs with 
  556            | [] -> 
  557                 // Are we looking at the implementation of the class hierarchy? If so include all the override members
  558                 not (isInterfaceTy g reqdTy)
  559            | ss -> 
  560                  ss |> List.forall (fun ss -> 
  561                      let ty = ss.ImplementedType
  562                      if isInterfaceTy g ty then 
  563                          // Is this a method impl listed under the reqdTy?
  564                          typeEquiv g ty reqdTy
  565                      else
  566                          not (isInterfaceTy g reqdTy) )
  567         
  568 
  569         // We check all the abstracts related to the class hierarchy and then check each interface implementation
  570         for ((reqdTy,m),slotImplSet) in allImpls do
  571             let (SlotImplSet(dispatchSlots, dispatchSlotsKeyed, availPriorOverrides,_)) = slotImplSet
  572             try 
  573 
  574                 // Now extract the information about each overriding method relevant to this SlotImplSet
  575                 let allImmediateMembersThatMightImplementDispatchSlots = 
  576                     allImmediateMembersThatMightImplementDispatchSlots
  577                     |> List.map (fun overrideBy -> overrideBy,GetTypeMemberOverrideInfo g reqdTy overrideBy)
  578                 
  579                 // Now check the implementation
  580                 // We don't give missing method errors for abstract classes 
  581                 
  582                 if isImplementation && not (isInterfaceTy g overallTy) then 
  583                     let overrides = allImmediateMembersThatMightImplementDispatchSlots |> List.map snd 
  584                     let allCorrect = CheckDispatchSlotsAreImplemented (denv,g,amap,m,nenv,sink,tcaug.tcaug_abstract,reqdTy,dispatchSlots,availPriorOverrides,overrides)
  585                     
  586                     // Tell the user to mark the thing abstract if it was missing implementations
  587                     if not allCorrect && not tcaug.tcaug_abstract && not (isInterfaceTy g reqdTy) then 
  588                         errorR(TypeIsImplicitlyAbstract(m))
  589                     
  590                     let overridesToCheck = 
  591                         allImmediateMembersThatMightImplementDispatchSlots 
  592                            |> List.filter (fst >> mustOverrideSomething reqdTy)
  593                            |> List.map snd
  594 
  595                     CheckOverridesAreAllUsedOnce (denv, g, amap, false, reqdTy, dispatchSlotsKeyed, availPriorOverrides, overridesToCheck)
  596 
  597             with e -> errorRecovery e m
  598 
  599         // Now record the full slotsigs of the abstract members implemented by each override.
  600         // This is used to generate IL MethodImpls in the code generator.
  601         allImmediateMembersThatMightImplementDispatchSlots |> List.iter (fun overrideBy -> 
  602 
  603             let isFakeEventProperty = overrideBy.IsFSharpEventProperty(g)
  604             let overriden = 
  605                 if isFakeEventProperty then 
  606                     let slotsigs = overrideBy.MemberInfo.Value.ImplementedSlotSigs 
  607                     slotsigs |> List.map (ReparentSlotSigToUseMethodTypars g overrideBy.Range overrideBy)
  608                 else
  609                     [ for ((reqdTy,m),(SlotImplSet(_dispatchSlots,dispatchSlotsKeyed,_,_))) in allImpls do
  610                           let overrideByInfo = GetTypeMemberOverrideInfo g reqdTy overrideBy
  611                           let overridenForThisSlotImplSet = 
  612                               [ for (RequiredSlot(dispatchSlot,_)) in NameMultiMap.find overrideByInfo.LogicalName dispatchSlotsKeyed do 
  613                                     if OverrideImplementsDispatchSlot g amap m dispatchSlot overrideByInfo then 
  614                                         if tyconRefEq g overrideByInfo.BoundingTyconRef dispatchSlot.DeclaringTyconRef then 
  615                                              match dispatchSlot.ArbitraryValRef with 
  616                                              | Some virtMember -> 
  617                                                   if virtMember.MemberInfo.Value.IsImplemented then errorR(Error(FSComp.SR.tcDefaultImplementationAlreadyExists(),overrideByInfo.Range))
  618                                                   virtMember.MemberInfo.Value.IsImplemented <- true
  619                                              | None -> () // not an F# slot
  620 
  621                                         // Get the slotsig of the overridden method 
  622                                         let slotsig = dispatchSlot.GetSlotSig(amap, m)
  623 
  624                                         // The slotsig from the overridden method is in terms of the type parameters on the parent type of the overriding method,
  625                                         // Modify map the slotsig so it is in terms of the type parameters for the overriding method 
  626                                         let slotsig = ReparentSlotSigToUseMethodTypars g m overrideBy slotsig
  627                      
  628                                         // Record the slotsig via mutation
  629                                         yield slotsig ]
  630                           //if mustOverrideSomething reqdTy overrideBy then 
  631                           //    assert nonNil overridenForThisSlotImplSet
  632                           yield! overridenForThisSlotImplSet ]
  633                 
  634             overrideBy.MemberInfo.Value.ImplementedSlotSigs <- overriden)
  635 
  636 
  637 
  638 //-------------------------------------------------------------------------
  639 // "Type Completion" inference and a few other checks at the end of the inference scope
  640 //------------------------------------------------------------------------- 
  641 
  642 
  643 /// "Type Completion" inference and a few other checks at the end of the inference scope
  644 let FinalTypeDefinitionChecksAtEndOfInferenceScope (infoReader:InfoReader, nenv, sink, isImplementation, denv) (tycon:Tycon) =
  645 
  646     let g = infoReader.g
  647     let amap = infoReader.amap
  648 
  649     let tcaug = tycon.TypeContents
  650     tcaug.tcaug_closed <- true
  651   
  652     // Note you only have to explicitly implement 'System.IComparable' to customize structural comparison AND equality on F# types 
  653     if isImplementation &&
  654 #if !NO_EXTENSIONTYPING
  655        not tycon.IsProvidedGeneratedTycon &&
  656 #endif
  657        Option.isNone tycon.GeneratedCompareToValues &&
  658        tycon.HasInterface g g.mk_IComparable_ty && 
  659        not (tycon.HasOverride g "Equals" [g.obj_ty]) && 
  660        not tycon.IsFSharpInterfaceTycon
  661      then
  662         (* Warn when we're doing this for class types *)
  663         if AugmentWithHashCompare.TyconIsCandidateForAugmentationWithEquals g tycon then
  664             warning(Error(FSComp.SR.typrelTypeImplementsIComparableShouldOverrideObjectEquals(tycon.DisplayName),tycon.Range))
  665         else
  666             warning(Error(FSComp.SR.typrelTypeImplementsIComparableDefaultObjectEqualsProvided(tycon.DisplayName),tycon.Range))
  667 
  668     AugmentWithHashCompare.CheckAugmentationAttribs isImplementation g amap tycon
  669     // Check some conditions about generic comparison and hashing. We can only check this condition after we've done the augmentation 
  670     if isImplementation 
  671 #if !NO_EXTENSIONTYPING
  672        && not tycon.IsProvidedGeneratedTycon  
  673 #endif
  674        then
  675         let tcaug = tycon.TypeContents
  676         let m = tycon.Range
  677         let hasExplicitObjectGetHashCode = tycon.HasOverride g "GetHashCode" []
  678         let hasExplicitObjectEqualsOverride = tycon.HasOverride g "Equals" [g.obj_ty]
  679 
  680         if (Option.isSome tycon.GeneratedHashAndEqualsWithComparerValues) && 
  681            (hasExplicitObjectGetHashCode || hasExplicitObjectEqualsOverride) then 
  682             errorR(Error(FSComp.SR.typrelExplicitImplementationOfGetHashCodeOrEquals(tycon.DisplayName),m)) 
  683 
  684         if not hasExplicitObjectEqualsOverride && hasExplicitObjectGetHashCode then 
  685             warning(Error(FSComp.SR.typrelExplicitImplementationOfGetHashCode(tycon.DisplayName),m)) 
  686 
  687         if hasExplicitObjectEqualsOverride && not hasExplicitObjectGetHashCode then 
  688             warning(Error(FSComp.SR.typrelExplicitImplementationOfEquals(tycon.DisplayName),m)) 
  689 
  690 
  691         // remember these values to ensure we don't generate these methods during codegen 
  692         tcaug.SetHasObjectGetHashCode hasExplicitObjectGetHashCode
  693 
  694         if not tycon.IsHiddenReprTycon
  695            && not tycon.IsTypeAbbrev
  696            && not tycon.IsMeasureableReprTycon
  697            && not tycon.IsAsmReprTycon
  698            && not tycon.IsFSharpInterfaceTycon
  699            && not tycon.IsFSharpDelegateTycon then 
  700 
  701             DispatchSlotChecking.CheckImplementationRelationAtEndOfInferenceScope (infoReader,denv,nenv,sink,tycon,isImplementation) 
  702     
  703 /// Get the methods relevant to determining if a uniquely-identified-override exists based on the syntactic information 
  704 /// at the member signature prior to type inference. This is used to pre-assign type information if it does 
  705 let GetAbstractMethInfosForSynMethodDecl(infoReader:InfoReader,ad,memberName:Ident,bindm,typToSearchForAbstractMembers,valSynData) =
  706     let minfos = 
  707         match typToSearchForAbstractMembers with 
  708         | _,Some(SlotImplSet(_, dispatchSlotsKeyed,_,_)) -> 
  709             NameMultiMap.find  memberName.idText dispatchSlotsKeyed |> List.map (fun (RequiredSlot(dispatchSlot,_)) -> dispatchSlot)
  710         | ty, None -> 
  711             GetIntrinsicMethInfosOfType infoReader (Some(memberName.idText), ad, AllowMultiIntfInstantiations.Yes) IgnoreOverrides bindm ty
  712     let dispatchSlots = minfos |> List.filter (fun minfo -> minfo.IsDispatchSlot)
  713     let topValSynArities = SynInfo.AritiesOfArgs valSynData
  714     let topValSynArities = if List.isEmpty topValSynArities then topValSynArities else topValSynArities.Tail
  715     let dispatchSlotsArityMatch = dispatchSlots |> List.filter (fun minfo -> minfo.NumArgs = topValSynArities) 
  716     dispatchSlots,dispatchSlotsArityMatch 
  717 
  718 /// Get the properties relevant to determining if a uniquely-identified-override exists based on the syntactic information 
  719 /// at the member signature prior to type inference. This is used to pre-assign type information if it does 
  720 let GetAbstractPropInfosForSynPropertyDecl(infoReader:InfoReader,ad,memberName:Ident,bindm,typToSearchForAbstractMembers,_k,_valSynData) = 
  721     let pinfos = 
  722         match typToSearchForAbstractMembers with 
  723         | _,Some(SlotImplSet(_,_,_,reqdProps)) -> 
  724             reqdProps |> List.filter (fun pinfo -> pinfo.PropertyName = memberName.idText) 
  725         | ty, None -> 
  726             GetIntrinsicPropInfosOfType infoReader (Some(memberName.idText), ad, AllowMultiIntfInstantiations.Yes) IgnoreOverrides bindm ty
  727         
  728     let dispatchSlots = pinfos |> List.filter (fun pinfo -> pinfo.IsVirtualProperty)
  729     dispatchSlots
  730