open System.Collections.Generic

open Microsoft.FSharp.Compiler.AbstractIL.IL

open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library

open Microsoft.FSharp.Compiler

open Microsoft.FSharp.Compiler.AccessibilityLogic

open Microsoft.FSharp.Compiler.Ast

open Microsoft.FSharp.Compiler.AttributeChecking

open Microsoft.FSharp.Compiler.ErrorLogger

open Microsoft.FSharp.Compiler.Infos

open Microsoft.FSharp.Compiler.Range

open Microsoft.FSharp.Compiler.Tast

open Microsoft.FSharp.Compiler.Tastops

open Microsoft.FSharp.Compiler.TcGlobals

let private SelectImmediateMemberVals g optFilter f (tcref:TyconRef) =

let chooser (vref:ValRef) =

match vref.MemberInfo with

// The 'when' condition is a workaround for the fact that values providing

// override and interface implementations are published in inferred module types

// These cannot be selected directly via the "." notation.

// However, it certainly is useful to be able to publish these values, as we can in theory

// optimize code to make direct calls to these methods.

| Some membInfo when not (ValRefIsExplicitImpl g vref) ->

f membInfo vref

| _ ->

None

match optFilter with

| None -> tcref.MembersOfFSharpTyconByName |> NameMultiMap.chooseRange chooser

| Some nm -> tcref.MembersOfFSharpTyconByName |> NameMultiMap.find nm |> List.choose chooser

let private checkFilter optFilter (nm:string) = match optFilter with None -> true | Some n2 -> nm = n2

let TrySelectMemberVal g optFilter typ pri _membInfo (vref:ValRef) =

if checkFilter optFilter vref.LogicalName then

Some(FSMeth(g,typ,vref,pri))

else

None

let rec GetImmediateIntrinsicMethInfosOfTypeAux (optFilter,ad) g amap m origTy metadataTy =

let minfos =

match metadataOfTy g metadataTy with

#if !NO_EXTENSIONTYPING

| ProvidedTypeMetadata info ->

let st = info.ProvidedType

let meths =

match optFilter with

| Some name -> st.PApplyArray ((fun st -> st.GetMethods() |> Array.filter (fun mi -> mi.Name = name) ), "GetMethods", m)

| None -> st.PApplyArray ((fun st -> st.GetMethods()), "GetMethods", m)

[ for mi in meths -> ProvidedMeth(amap, mi.Coerce(m), None, m) ]

| ILTypeMetadata _ ->

let tinfo = ILTypeInfo.FromType g origTy

let mdefs = tinfo.RawMetadata.Methods

let mdefs = match optFilter with None -> mdefs.AsList | Some nm -> mdefs.FindByName nm

mdefs |> List.map (fun mdef -> MethInfo.CreateILMeth(amap, m, origTy, mdef))

| FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata ->

// Tuple types also support the properties Item1-8, Rest from the compiled tuple type

// In this case convert to the .NET Tuple type that carries metadata and try again

if isAnyTupleTy g metadataTy then

let betterMetadataTy = helpEnsureTypeHasMetadata g metadataTy

GetImmediateIntrinsicMethInfosOfTypeAux (optFilter,ad) g amap m origTy betterMetadataTy

else

match tryDestAppTy g metadataTy with

| None -> []

| Some tcref ->

SelectImmediateMemberVals g optFilter (TrySelectMemberVal g optFilter origTy None) tcref

let minfos = minfos |> List.filter (IsMethInfoAccessible amap m ad)

minfos

let GetImmediateIntrinsicMethInfosOfType (optFilter,ad) g amap m typ =

GetImmediateIntrinsicMethInfosOfTypeAux (optFilter,ad) g amap m typ typ

type PropertyCollector(g, amap, m, typ, optFilter, ad) =

let hashIdentity =

HashIdentity.FromFunctions

(fun (pinfo:PropInfo) -> hash pinfo.PropertyName)

(fun pinfo1 pinfo2 ->

pinfo1.IsStatic = pinfo2.IsStatic &&

PropInfosEquivByNameAndPartialSig EraseNone g amap m pinfo1 pinfo2 &&

pinfo1.IsDefiniteFSharpOverride = pinfo2.IsDefiniteFSharpOverride )

let props = new Dictionary<PropInfo,PropInfo>(hashIdentity)

let add pinfo =

match props.TryGetValue(pinfo), pinfo with

| (true, FSProp (_, typ, Some vref1 ,_)), FSProp (_, _, _, Some vref2)

| (true, FSProp (_, typ, _, Some vref2)), FSProp (_, _, Some vref1, _) ->

let pinfo = FSProp (g,typ,Some vref1,Some vref2)

props.[pinfo] <- pinfo

| (true, _), _ ->

// This assert fires while editing bad code. We will give a warning later in check.fs

//assert ("unexpected case"= "")

()

| _ ->

props.[pinfo] <- pinfo

member x.Collect(membInfo:ValMemberInfo,vref:ValRef) =

match membInfo.MemberFlags.MemberKind with

| MemberKind.PropertyGet ->

let pinfo = FSProp(g,typ,Some vref,None)

if checkFilter optFilter vref.PropertyName && IsPropInfoAccessible g amap m ad pinfo then

add pinfo

| MemberKind.PropertySet ->

let pinfo = FSProp(g,typ,None,Some vref)

if checkFilter optFilter vref.PropertyName && IsPropInfoAccessible g amap m ad pinfo then

add pinfo

| _ ->

()

member x.Close() = [ for KeyValue(_,pinfo) in props -> pinfo ]

let rec GetImmediateIntrinsicPropInfosOfTypeAux (optFilter,ad) g amap m origTy metadataTy =

let pinfos =

match metadataOfTy g metadataTy with

#if !NO_EXTENSIONTYPING

| ProvidedTypeMetadata info ->

let st = info.ProvidedType

let matchingProps =

match optFilter with

| Some name ->

match st.PApply((fun st -> st.GetProperty name), m) with

| Tainted.Null -> [||]

| pi -> [|pi|]

| None ->

st.PApplyArray((fun st -> st.GetProperties()), "GetProperties", m)

matchingProps

|> Seq.map(fun pi -> ProvidedProp(amap, pi, m))

|> List.ofSeq

| ILTypeMetadata _ ->

let tinfo = ILTypeInfo.FromType g origTy

let pdefs = tinfo.RawMetadata.Properties

let pdefs = match optFilter with None -> pdefs.AsList | Some nm -> pdefs.LookupByName nm

pdefs |> List.map (fun pdef -> ILProp(ILPropInfo(tinfo, pdef)))

| FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata ->

// Tuple types also support the properties Item1-8, Rest from the compiled tuple type

// In this case convert to the .NET Tuple type that carries metadata and try again

if isAnyTupleTy g metadataTy then

let betterMetadataTy = helpEnsureTypeHasMetadata g metadataTy

GetImmediateIntrinsicPropInfosOfTypeAux (optFilter,ad) g amap m origTy betterMetadataTy

else

match tryDestAppTy g metadataTy with

| None -> []

| Some tcref ->

let propCollector = new PropertyCollector(g, amap, m, origTy, optFilter, ad)

SelectImmediateMemberVals g None (fun membInfo vref -> propCollector.Collect(membInfo, vref); None) tcref |> ignore

propCollector.Close()

let pinfos = pinfos |> List.filter (IsPropInfoAccessible g amap m ad)

pinfos

let rec GetImmediateIntrinsicPropInfosOfType (optFilter,ad) g amap m typ =

GetImmediateIntrinsicPropInfosOfTypeAux (optFilter,ad) g amap m typ typ

let IsIndexerType g amap typ =

isArray1DTy g typ ||

isListTy g typ ||

match tryDestAppTy g typ with

| Some tcref ->

let _, entityTy = generalizeTyconRef tcref

let props = GetImmediateIntrinsicPropInfosOfType (None, AccessibleFromSomeFSharpCode) g amap range0 entityTy

props |> List.exists (fun x -> x.PropertyName = "Item")

| None -> false

type HierarchyItem =

| MethodItem of MethInfo list list

| PropertyItem of PropInfo list list

| RecdFieldItem of RecdFieldInfo

| EventItem of EventInfo list

| ILFieldItem of ILFieldInfo list

type InfoReader(g: TcGlobals, amap: Import.ImportMap) =

/// Get the declared IL fields of a type, not including inherited fields

let GetImmediateIntrinsicILFieldsOfType (optFilter, ad) m typ =

let infos =

match metadataOfTy g typ with

#if !NO_EXTENSIONTYPING

| ProvidedTypeMetadata info ->

let st = info.ProvidedType

match optFilter with

| None ->

[ for fi in st.PApplyArray((fun st -> st.GetFields()), "GetFields" , m) -> ProvidedField(amap,fi,m) ]

| Some name ->

match st.PApply ((fun st -> st.GetField name), m) with

| Tainted.Null -> []

| fi -> [ ProvidedField(amap,fi,m) ]

| ILTypeMetadata _ ->

let tinfo = ILTypeInfo.FromType g typ

let fdefs = tinfo.RawMetadata.Fields

let fdefs = match optFilter with None -> fdefs.AsList | Some nm -> fdefs.LookupByName nm

fdefs |> List.map (fun pd -> ILFieldInfo(tinfo,pd))

| FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata ->

[]

let infos = infos |> List.filter (IsILFieldInfoAccessible g amap m ad)

infos

/// Get the declared events of a type, not including inherited events, and not including F#-declared CLIEvents

let ComputeImmediateIntrinsicEventsOfType (optFilter, ad) m typ =

let infos =

match metadataOfTy g typ with

#if !NO_EXTENSIONTYPING

| ProvidedTypeMetadata info ->

let st = info.ProvidedType

match optFilter with

| None ->

[ for ei in st.PApplyArray((fun st -> st.GetEvents()), "GetEvents" , m) -> ProvidedEvent(amap,ei,m) ]

| Some name ->

match st.PApply ((fun st -> st.GetEvent name), m) with

| Tainted.Null -> []

| ei -> [ ProvidedEvent(amap,ei,m) ]

| ILTypeMetadata _ ->

let tinfo = ILTypeInfo.FromType g typ

let edefs = tinfo.RawMetadata.Events

let edefs = match optFilter with None -> edefs.AsList | Some nm -> edefs.LookupByName nm

[ for edef in edefs do

let ileinfo = ILEventInfo(tinfo,edef)

if IsILEventInfoAccessible g amap m ad ileinfo then

yield ILEvent ileinfo ]

| FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata ->

[]

infos

/// Make a reference to a record or class field

let MakeRecdFieldInfo g typ (tcref:TyconRef) fspec =

RecdFieldInfo(argsOfAppTy g typ,tcref.MakeNestedRecdFieldRef fspec)

/// Get the F#-declared record fields or class 'val' fields of a type

let GetImmediateIntrinsicRecdOrClassFieldsOfType (optFilter, _ad) _m typ =

match tryDestAppTy g typ with

| None -> []

| Some tcref ->

// Note;secret fields are not allowed in lookups here, as we're only looking

// up user-visible fields in name resolution.

match optFilter with

| Some nm ->

match tcref.GetFieldByName nm with

| Some rfield when not rfield.IsCompilerGenerated -> [MakeRecdFieldInfo g typ tcref rfield]

| _ -> []

| None ->

[ for fdef in tcref.AllFieldsArray do

if not fdef.IsCompilerGenerated then

yield MakeRecdFieldInfo g typ tcref fdef ]

/// The primitive reader for the method info sets up a hierarchy

let GetIntrinsicMethodSetsUncached ((optFilter,ad,allowMultiIntfInst),m,typ) =

FoldPrimaryHierarchyOfType (fun typ acc -> GetImmediateIntrinsicMethInfosOfType (optFilter,ad) g amap m typ :: acc) g amap m allowMultiIntfInst typ []

/// The primitive reader for the property info sets up a hierarchy

let GetIntrinsicPropertySetsUncached ((optFilter,ad,allowMultiIntfInst),m,typ) =

FoldPrimaryHierarchyOfType (fun typ acc -> GetImmediateIntrinsicPropInfosOfType (optFilter,ad) g amap m typ :: acc) g amap m allowMultiIntfInst typ []

let GetIntrinsicILFieldInfosUncached ((optFilter,ad),m,typ) =

FoldPrimaryHierarchyOfType (fun typ acc -> GetImmediateIntrinsicILFieldsOfType (optFilter,ad) m typ @ acc) g amap m AllowMultiIntfInstantiations.Yes typ []

let GetIntrinsicEventInfosUncached ((optFilter,ad),m,typ) =

FoldPrimaryHierarchyOfType (fun typ acc -> ComputeImmediateIntrinsicEventsOfType (optFilter,ad) m typ @ acc) g amap m AllowMultiIntfInstantiations.Yes typ []

let GetIntrinsicRecdOrClassFieldInfosUncached ((optFilter,ad),m,typ) =

FoldPrimaryHierarchyOfType (fun typ acc -> GetImmediateIntrinsicRecdOrClassFieldsOfType (optFilter,ad) m typ @ acc) g amap m AllowMultiIntfInstantiations.Yes typ []

let GetEntireTypeHierachyUncached (allowMultiIntfInst,m,typ) =

FoldEntireHierarchyOfType (fun typ acc -> typ :: acc) g amap m allowMultiIntfInst typ []

let GetPrimaryTypeHierachyUncached (allowMultiIntfInst,m,typ) =

FoldPrimaryHierarchyOfType (fun typ acc -> typ :: acc) g amap m allowMultiIntfInst typ []

/// The primitive reader for the named items up a hierarchy

let GetIntrinsicNamedItemsUncached ((nm,ad),m,typ) =

if nm = ".ctor" then None else // '.ctor' lookups only ever happen via constructor syntax

let optFilter = Some nm

FoldPrimaryHierarchyOfType (fun typ acc ->

let minfos = GetImmediateIntrinsicMethInfosOfType (optFilter,ad) g amap m typ

let pinfos = GetImmediateIntrinsicPropInfosOfType (optFilter,ad) g amap m typ

let finfos = GetImmediateIntrinsicILFieldsOfType (optFilter,ad) m typ

let einfos = ComputeImmediateIntrinsicEventsOfType (optFilter,ad) m typ

let rfinfos = GetImmediateIntrinsicRecdOrClassFieldsOfType (optFilter,ad) m typ

match acc with

| Some(MethodItem(inheritedMethSets)) when not (isNil minfos) -> Some(MethodItem (minfos::inheritedMethSets))

| _ when not (isNil minfos) -> Some(MethodItem ([minfos]))

| Some(PropertyItem(inheritedPropSets)) when not (isNil pinfos) -> Some(PropertyItem(pinfos::inheritedPropSets))

| _ when not (isNil pinfos) -> Some(PropertyItem([pinfos]))

| _ when not (isNil finfos) -> Some(ILFieldItem(finfos))

| _ when not (isNil einfos) -> Some(EventItem(einfos))

| _ when not (isNil rfinfos) ->

match rfinfos with

| [single] -> Some(RecdFieldItem(single))

| _ -> failwith "Unexpected multiple fields with the same name" // Because an explicit name (i.e., nm) was supplied, there will be only one element at most.

| _ -> acc)

g amap m

AllowMultiIntfInstantiations.Yes

typ

None

/// Make a cache for function 'f' keyed by type (plus some additional 'flags') that only

/// caches computations for monomorphic types.

let MakeInfoCache f (flagsEq : System.Collections.Generic.IEqualityComparer<_>) =

new MemoizationTable<_,_>

(compute=f,

// Only cache closed, monomorphic types (closed = all members for the type

// have been processed). Generic type instantiations could be processed if we had

// a decent hash function for these.

canMemoize=(fun (_flags,(_:range),typ) ->

match stripTyEqns g typ with

| TType_app(tcref,[]) -> tcref.TypeContents.tcaug_closed

| _ -> false),

keyComparer=

{ new System.Collections.Generic.IEqualityComparer<_> with

member x.Equals((flags1,_,typ1),(flags2,_,typ2)) =

// Ignoring the ranges - that's OK.

flagsEq.Equals(flags1,flags2) &&

match stripTyEqns g typ1, stripTyEqns g typ2 with

| TType_app(tcref1,[]),TType_app(tcref2,[]) -> tyconRefEq g tcref1 tcref2

| _ -> false

member x.GetHashCode((flags,_,typ)) =

// Ignoring the ranges - that's OK.

flagsEq.GetHashCode flags +

(match stripTyEqns g typ with

| TType_app(tcref,[]) -> hash tcref.LogicalName

| _ -> 0) })

let hashFlags0 =

{ new System.Collections.Generic.IEqualityComparer<_> with

member x.GetHashCode((filter: string option, ad: AccessorDomain, _allowMultiIntfInst1)) = hash filter + AccessorDomain.CustomGetHashCode ad

member x.Equals((filter1, ad1, allowMultiIntfInst1), (filter2,ad2, allowMultiIntfInst2)) =

(filter1 = filter2) && AccessorDomain.CustomEquals(g,ad1,ad2) && allowMultiIntfInst1 = allowMultiIntfInst2 }

let hashFlags1 =

{ new System.Collections.Generic.IEqualityComparer<_> with

member x.GetHashCode((filter: string option,ad: AccessorDomain)) = hash filter + AccessorDomain.CustomGetHashCode ad

member x.Equals((filter1,ad1), (filter2,ad2)) = (filter1 = filter2) && AccessorDomain.CustomEquals(g,ad1,ad2) }

let hashFlags2 =

{ new System.Collections.Generic.IEqualityComparer<_> with

member x.GetHashCode((nm: string,ad: AccessorDomain)) = hash nm + AccessorDomain.CustomGetHashCode ad

member x.Equals((nm1,ad1), (nm2,ad2)) = (nm1 = nm2) && AccessorDomain.CustomEquals(g,ad1,ad2) }

let methodInfoCache = MakeInfoCache GetIntrinsicMethodSetsUncached hashFlags0

let propertyInfoCache = MakeInfoCache GetIntrinsicPropertySetsUncached hashFlags0

let recdOrClassFieldInfoCache = MakeInfoCache GetIntrinsicRecdOrClassFieldInfosUncached hashFlags1

let ilFieldInfoCache = MakeInfoCache GetIntrinsicILFieldInfosUncached hashFlags1

let eventInfoCache = MakeInfoCache GetIntrinsicEventInfosUncached hashFlags1

let namedItemsCache = MakeInfoCache GetIntrinsicNamedItemsUncached hashFlags2

let entireTypeHierarchyCache = MakeInfoCache GetEntireTypeHierachyUncached HashIdentity.Structural

let primaryTypeHierarchyCache = MakeInfoCache GetPrimaryTypeHierachyUncached HashIdentity.Structural

member x.g = g

member x.amap = amap

/// Read the raw method sets of a type, including inherited ones. Cache the result for monomorphic types

member x.GetRawIntrinsicMethodSetsOfType (optFilter,ad,allowMultiIntfInst,m,typ) =

methodInfoCache.Apply(((optFilter,ad,allowMultiIntfInst),m,typ))

/// Read the raw property sets of a type, including inherited ones. Cache the result for monomorphic types

member x.GetRawIntrinsicPropertySetsOfType (optFilter,ad,allowMultiIntfInst,m,typ) =

propertyInfoCache.Apply(((optFilter,ad,allowMultiIntfInst),m,typ))

/// Read the record or class fields of a type, including inherited ones. Cache the result for monomorphic types.

member x.GetRecordOrClassFieldsOfType (optFilter,ad,m,typ) =

recdOrClassFieldInfoCache.Apply(((optFilter,ad),m,typ))

/// Read the IL fields of a type, including inherited ones. Cache the result for monomorphic types.

member x.GetILFieldInfosOfType (optFilter,ad,m,typ) =

ilFieldInfoCache.Apply(((optFilter,ad),m,typ))

member x.GetImmediateIntrinsicEventsOfType (optFilter,ad,m,typ) = ComputeImmediateIntrinsicEventsOfType (optFilter,ad) m typ

/// Read the events of a type, including inherited ones. Cache the result for monomorphic types.

member x.GetEventInfosOfType (optFilter,ad,m,typ) =

eventInfoCache.Apply(((optFilter,ad),m,typ))

/// Try and find a record or class field for a type.

member x.TryFindRecdOrClassFieldInfoOfType (nm,m,typ) =

match recdOrClassFieldInfoCache.Apply((Some nm,AccessibleFromSomewhere),m,typ) with

| [] -> None

| [single] -> Some single

| flds ->

// multiple fields with the same name can come from different classes,

// so filter them by the given type name

match tryDestAppTy g typ with

| None -> None

| Some tcref ->

match flds |> List.filter (fun rfinfo -> tyconRefEq g tcref rfinfo.TyconRef) with

| [] -> None

| [single] -> Some single

| _ -> failwith "unexpected multiple fields with same name" // Because it should have been already reported as duplicate fields

/// Try and find an item with the given name in a type.

member x.TryFindNamedItemOfType (nm,ad,m,typ) =

namedItemsCache.Apply(((nm,ad),m,typ))

/// Get the super-types of a type, including interface types.

member x.GetEntireTypeHierachy (allowMultiIntfInst,m,typ) =

entireTypeHierarchyCache.Apply((allowMultiIntfInst,m,typ))

/// Get the super-types of a type, excluding interface types.

member x.GetPrimaryTypeHierachy (allowMultiIntfInst,m,typ) =

primaryTypeHierarchyCache.Apply((allowMultiIntfInst,m,typ))

let rec GetIntrinsicConstructorInfosOfTypeAux (infoReader:InfoReader) m origTy metadataTy =

protectAssemblyExploration [] (fun () ->

let g = infoReader.g

let amap = infoReader.amap

match metadataOfTy g metadataTy with

#if !NO_EXTENSIONTYPING

| ProvidedTypeMetadata info ->

let st = info.ProvidedType

[ for ci in st.PApplyArray((fun st -> st.GetConstructors()), "GetConstructors", m) do

yield ProvidedMeth(amap,ci.Coerce(m),None,m) ]

| ILTypeMetadata _ ->

let tinfo = ILTypeInfo.FromType g origTy

tinfo.RawMetadata.Methods.FindByName ".ctor"

|> List.filter (fun md -> md.IsConstructor)

|> List.map (fun mdef -> MethInfo.CreateILMeth (amap, m, origTy, mdef))

| FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata ->

// Tuple types also support the properties Item1-8, Rest from the compiled tuple type

// In this case convert to the .NET Tuple type that carries metadata and try again

if isAnyTupleTy g metadataTy then

let betterMetadataTy = helpEnsureTypeHasMetadata g metadataTy

GetIntrinsicConstructorInfosOfTypeAux infoReader m origTy betterMetadataTy

else

match tryDestAppTy g metadataTy with

| None -> []

| Some tcref ->

tcref.MembersOfFSharpTyconByName

|> NameMultiMap.find ".ctor"

|> List.choose(fun vref ->

match vref.MemberInfo with

| Some membInfo when (membInfo.MemberFlags.MemberKind = MemberKind.Constructor) -> Some vref

| _ -> None)

|> List.map (fun x -> FSMeth(g, origTy, x, None))

)

let GetIntrinsicConstructorInfosOfType infoReader m typ =

GetIntrinsicConstructorInfosOfTypeAux infoReader m typ typ

type FindMemberFlag =

/// Prefer items toward the top of the hierarchy, which we do if the items are virtual

/// but not when resolving base calls.

| IgnoreOverrides

/// Get overrides instead of abstract slots when measuring whether a class/interface implements all its required slots.

| PreferOverrides

type private IndexedList<'T>(itemLists: 'T list list, itemsByName: NameMultiMap<'T>) =

/// Get the item sets

member x.Items = itemLists

/// Get the items with a particular name

member x.ItemsWithName(nm) = NameMultiMap.find nm itemsByName

/// Add new items, extracting the names using the given function.

member x.AddItems(items,nmf) = IndexedList<'T>(items::itemLists,List.foldBack (fun x acc -> NameMultiMap.add (nmf x) x acc) items itemsByName )

/// Get an empty set of items

static member Empty = IndexedList<'T>([],NameMultiMap.empty)

/// Filter a set of new items to add according to the content of the list. Only keep an item

/// if it passes 'keepTest' for all matching items already in the list.

member x.FilterNewItems keepTest nmf itemsToAdd =

// Have we already seen an item with the same name and that is in the same equivalence class?

// If so, ignore this one. Note we can check against the original incoming 'ilist' because we are assuming that

// none the elements of 'itemsToAdd' are equivalent.

itemsToAdd |> List.filter (fun item -> List.forall (keepTest item) (x.ItemsWithName(nmf item)))

let private FilterItemsInSubTypesBasedOnItemsInSuperTypes nmf keepTest itemLists =

let rec loop itemLists =

match itemLists with

| [] -> IndexedList.Empty

| items :: itemsInSuperTypes ->

let ilist = loop itemsInSuperTypes

let itemsToAdd = ilist.FilterNewItems keepTest nmf items

ilist.AddItems(itemsToAdd,nmf)

(loop itemLists).Items

let private FilterItemsInSuperTypesBasedOnItemsInSubTypes nmf keepTest itemLists =

let rec loop itemLists (indexedItemsInSubTypes:IndexedList<_>) =

match itemLists with

| [] -> List.rev indexedItemsInSubTypes.Items

| items :: itemsInSuperTypes ->

let itemsToAdd = items |> List.filter (fun item -> keepTest item (indexedItemsInSubTypes.ItemsWithName(nmf item)))

let ilist = indexedItemsInSubTypes.AddItems(itemsToAdd,nmf)

loop itemsInSuperTypes ilist

loop itemLists IndexedList.Empty

let private ExcludeItemsInSuperTypesBasedOnEquivTestWithItemsInSubTypes nmf equivTest itemLists =

FilterItemsInSuperTypesBasedOnItemsInSubTypes nmf (fun item1 items -> not (items |> List.exists (fun item2 -> equivTest item1 item2))) itemLists

let private FilterOverrides findFlag (isVirt:'a->bool,isNewSlot,isDefiniteOverride,isFinal,equivSigs,nmf:'a->string) items =

let equivVirts x y = isVirt x && isVirt y && equivSigs x y

match findFlag with

| PreferOverrides ->

items

// For each F#-declared override, get rid of any equivalent abstract member in the same type

// This is because F# abstract members with default overrides give rise to two members with the

// same logical signature in the same type, e.g.

// type ClassType1() =

// abstract VirtualMethod1: string -> int

// default x.VirtualMethod1(s) = 3

|> List.map (fun items ->

let definiteOverrides = items |> List.filter isDefiniteOverride

items |> List.filter (fun item -> (isDefiniteOverride item || not (List.exists (equivVirts item) definiteOverrides))))

// only keep virtuals that are not signature-equivalent to virtuals in subtypes

|> ExcludeItemsInSuperTypesBasedOnEquivTestWithItemsInSubTypes nmf equivVirts

| IgnoreOverrides ->

let equivNewSlots x y = isNewSlot x && isNewSlot y && equivSigs x y

items

// Remove any F#-declared overrides. These may occur in the same type as the abstract member (unlike with .NET metadata)

// Include any 'newslot' declared methods.

|> List.map (List.filter (fun x -> not (isDefiniteOverride x)))

// Remove any virtuals that are signature-equivalent to virtuals in subtypes, except for newslots

// That is, keep if it's

/// (a) not virtual

// (b) is a new slot or

// (c) not equivalent

// We keep virtual finals around for error detection later on

|> FilterItemsInSubTypesBasedOnItemsInSuperTypes nmf (fun newItem priorItem ->

(isVirt newItem && isFinal newItem) || not (isVirt newItem) || isNewSlot newItem || not (equivVirts newItem priorItem) )

// Remove any abstract slots in supertypes that are (a) hidden by another newslot and (b) implemented

// We leave unimplemented ones around to give errors, e.g. for

// [<AbstractClass>]

// type PA() =

// abstract M : int -> unit

//

// [<AbstractClass>]

// type PB<'a>() =

// inherit PA()

// abstract M : 'a -> unit

//

// [<AbstractClass>]

// type PC() =

// inherit PB<int>()

// // Here, PA.M and PB<int>.M have the same signature, so PA.M is unimplementable.

// // REVIEW: in future we may give a friendly error at this point

//

// type PD() =

// inherit PC()

// override this.M(x:int) = ()

|> FilterItemsInSuperTypesBasedOnItemsInSubTypes nmf (fun item1 superTypeItems ->

not (isNewSlot item1 &&

superTypeItems |> List.exists (equivNewSlots item1) &&

superTypeItems |> List.exists (fun item2 -> isDefiniteOverride item1 && equivVirts item1 item2)))

let private FilterOverridesOfMethInfos findFlag g amap m minfos =

FilterOverrides findFlag ((fun (minfo:MethInfo) -> minfo.IsVirtual),(fun minfo -> minfo.IsNewSlot),(fun minfo -> minfo.IsDefiniteFSharpOverride),(fun minfo -> minfo.IsFinal),MethInfosEquivByNameAndSig EraseNone true g amap m,(fun minfo -> minfo.LogicalName)) minfos

let private FilterOverridesOfPropInfos findFlag g amap m props =

FilterOverrides findFlag ((fun (pinfo:PropInfo) -> pinfo.IsVirtualProperty),(fun pinfo -> pinfo.IsNewSlot),(fun pinfo -> pinfo.IsDefiniteFSharpOverride),(fun _ -> false),PropInfosEquivByNameAndSig EraseNone g amap m, (fun pinfo -> pinfo.PropertyName)) props

let ExcludeHiddenOfMethInfos g amap m (minfos:MethInfo list list) =

minfos

|> ExcludeItemsInSuperTypesBasedOnEquivTestWithItemsInSubTypes

(fun minfo -> minfo.LogicalName)

(fun m1 m2 ->

// only hide those truly from super classes

not (tyconRefEq g m1.DeclaringTyconRef m2.DeclaringTyconRef) &&

MethInfosEquivByNameAndPartialSig EraseNone true g amap m m1 m2)

|> List.concat

let ExcludeHiddenOfPropInfos g amap m pinfos =

pinfos

|> ExcludeItemsInSuperTypesBasedOnEquivTestWithItemsInSubTypes (fun (pinfo:PropInfo) -> pinfo.PropertyName) (PropInfosEquivByNameAndPartialSig EraseNone g amap m)

|> List.concat

let GetIntrinsicMethInfoSetsOfType (infoReader:InfoReader) (optFilter,ad,allowMultiIntfInst) findFlag m typ =

infoReader.GetRawIntrinsicMethodSetsOfType(optFilter,ad,allowMultiIntfInst,m,typ)

|> FilterOverridesOfMethInfos findFlag infoReader.g infoReader.amap m

let GetIntrinsicPropInfoSetsOfType (infoReader:InfoReader) (optFilter,ad,allowMultiIntfInst) findFlag m typ =

infoReader.GetRawIntrinsicPropertySetsOfType(optFilter,ad,allowMultiIntfInst,m,typ)

|> FilterOverridesOfPropInfos findFlag infoReader.g infoReader.amap m

let GetIntrinsicMethInfosOfType infoReader (optFilter,ad,allowMultiIntfInst) findFlag m typ =

GetIntrinsicMethInfoSetsOfType infoReader (optFilter,ad,allowMultiIntfInst) findFlag m typ |> List.concat

let GetIntrinsicPropInfosOfType infoReader (optFilter,ad,allowMultiIntfInst) findFlag m typ =

GetIntrinsicPropInfoSetsOfType infoReader (optFilter,ad,allowMultiIntfInst) findFlag m typ |> List.concat

let TryFindIntrinsicNamedItemOfType (infoReader:InfoReader) (nm,ad) findFlag m typ =

match infoReader.TryFindNamedItemOfType(nm, ad, m, typ) with

| Some item ->

match item with

| PropertyItem psets -> Some(PropertyItem (psets |> FilterOverridesOfPropInfos findFlag infoReader.g infoReader.amap m))

| MethodItem msets -> Some(MethodItem (msets |> FilterOverridesOfMethInfos findFlag infoReader.g infoReader.amap m))

| _ -> Some(item)

| None -> None

let TryFindIntrinsicMethInfo infoReader m ad nm ty =

GetIntrinsicMethInfosOfType infoReader (Some nm,ad,AllowMultiIntfInstantiations.Yes) IgnoreOverrides m ty

let TryFindPropInfo infoReader m ad nm ty =

GetIntrinsicPropInfosOfType infoReader (Some nm,ad,AllowMultiIntfInstantiations.Yes) IgnoreOverrides m ty

type SigOfFunctionForDelegate = SigOfFunctionForDelegate of MethInfo * TType list * TType * TType

let GetSigOfFunctionForDelegate (infoReader:InfoReader) delty m ad =

let g = infoReader.g

let amap = infoReader.amap

let invokeMethInfo =

match GetIntrinsicMethInfosOfType infoReader (Some "Invoke",ad,AllowMultiIntfInstantiations.Yes) IgnoreOverrides m delty with

| [h] -> h

| [] -> error(Error(FSComp.SR.noInvokeMethodsFound (),m))

| h :: _ -> warning(InternalError(FSComp.SR.moreThanOneInvokeMethodFound (),m)); h

let minst = [] // a delegate's Invoke method is never generic

let compiledViewOfDelArgTys =

match invokeMethInfo.GetParamTypes(amap, m, minst) with

| [args] -> args

| _ -> error(Error(FSComp.SR.delegatesNotAllowedToHaveCurriedSignatures (),m))

let fsharpViewOfDelArgTys =

match compiledViewOfDelArgTys with

| [] -> [g.unit_ty]

| _ -> compiledViewOfDelArgTys

let delRetTy = invokeMethInfo.GetFSharpReturnTy(amap, m, minst)

CheckMethInfoAttributes g m None invokeMethInfo |> CommitOperationResult

let fty = mkIteratedFunTy fsharpViewOfDelArgTys delRetTy

SigOfFunctionForDelegate(invokeMethInfo,compiledViewOfDelArgTys,delRetTy,fty)

let TryDestStandardDelegateTyp (infoReader:InfoReader) m ad delTy =

let g = infoReader.g

let (SigOfFunctionForDelegate(_,compiledViewOfDelArgTys,delRetTy,_)) = GetSigOfFunctionForDelegate infoReader delTy m ad

match compiledViewOfDelArgTys with

| senderTy :: argTys when (isObjTy g senderTy) && not (List.exists (isByrefTy g) argTys) -> Some(mkRefTupledTy g argTys,delRetTy)

| _ -> None

let IsStandardEventInfo (infoReader:InfoReader) m ad (einfo:EventInfo) =

let dty = einfo.GetDelegateType(infoReader.amap,m)

match TryDestStandardDelegateTyp infoReader m ad dty with

| Some _ -> true

| None -> false

let ArgsTypOfEventInfo (infoReader:InfoReader) m ad (einfo:EventInfo) =

let amap = infoReader.amap

let dty = einfo.GetDelegateType(amap,m)

match TryDestStandardDelegateTyp infoReader m ad dty with

| Some(argtys,_) -> argtys

| None -> error(nonStandardEventError einfo.EventName m)

let PropTypOfEventInfo (infoReader:InfoReader) m ad (einfo:EventInfo) =

let g = infoReader.g

let amap = infoReader.amap

let delTy = einfo.GetDelegateType(amap,m)

let argsTy = ArgsTypOfEventInfo infoReader m ad einfo

mkIEventType g delTy argsTy