open System.Collections.Generic

open FSharp.Compiler.AbstractIL.Internal.Library

open FSharp.Compiler

open FSharp.Compiler.AccessibilityLogic

open FSharp.Compiler.Ast

open FSharp.Compiler.AttributeChecking

open FSharp.Compiler.ErrorLogger

open FSharp.Compiler.Infos

open FSharp.Compiler.Range

open FSharp.Compiler.Tast

open FSharp.Compiler.Tastops

open 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 ty pri _membInfo (vref: ValRef) =

if checkFilter optFilter vref.LogicalName then

Some(FSMeth(g, ty, 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 methods get_Item1-8, get_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 = convertToTypeWithMetadataIfPossible g metadataTy

GetImmediateIntrinsicMethInfosOfTypeAux (optFilter, ad) g amap m origTy betterMetadataTy

// Function types support methods FSharpFunc<_, _>.FromConverter and friends from .NET metadata,

// but not instance methods (you can't write "f.Invoke(x)", you have to write "f x")

elif isFunTy g metadataTy then

let betterMetadataTy = convertToTypeWithMetadataIfPossible g metadataTy

GetImmediateIntrinsicMethInfosOfTypeAux (optFilter, ad) g amap m origTy betterMetadataTy

|> List.filter (fun minfo -> not minfo.IsInstance)

else

match tryDestAppTy g metadataTy with

| ValueNone -> []

| ValueSome 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 ty =

GetImmediateIntrinsicMethInfosOfTypeAux (optFilter, ad) g amap m ty ty

type PropertyCollector(g, amap, m, ty, 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 (_, ty, Some vref1, _)), FSProp (_, _, _, Some vref2)

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

let pinfo = FSProp (g, ty, 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, ty, Some vref, None)

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

add pinfo

| MemberKind.PropertySet ->

let pinfo = FSProp(g, ty, 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 || isFunTy g metadataTy then

let betterMetadataTy = convertToTypeWithMetadataIfPossible g metadataTy

GetImmediateIntrinsicPropInfosOfTypeAux (optFilter, ad) g amap m origTy betterMetadataTy

else

match tryDestAppTy g metadataTy with

| ValueNone -> []

| ValueSome 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 ty =

GetImmediateIntrinsicPropInfosOfTypeAux (optFilter, ad) g amap m ty ty

let IsIndexerType g amap ty =

isArray1DTy g ty ||

isListTy g ty ||

match tryDestAppTy g ty with

| ValueSome tcref ->

let _, entityTy = generalizeTyconRef tcref

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

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

| ValueNone -> 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 ty =

let infos =

match metadataOfTy g ty 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 ty

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 ty =

let infos =

match metadataOfTy g ty 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 ty

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 ty (tcref: TyconRef) fspec =

RecdFieldInfo(argsOfAppTy g ty, tcref.MakeNestedRecdFieldRef fspec)

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

let GetImmediateIntrinsicRecdOrClassFieldsOfType (optFilter, _ad) _m ty =

match tryDestAppTy g ty with

| ValueNone -> []

| ValueSome 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 ty tcref rfield]

| _ -> []

| None ->

[ for fdef in tcref.AllFieldsArray do

if not fdef.IsCompilerGenerated then

yield MakeRecdFieldInfo g ty tcref fdef ]

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

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

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

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

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

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

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

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

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

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

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

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

let GetEntireTypeHierarchyUncached (allowMultiIntfInst, m, ty) =

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

let GetPrimaryTypeHierarchyUncached (allowMultiIntfInst, m, ty) =

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

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

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

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

let optFilter = Some nm

FoldPrimaryHierarchyOfType (fun ty acc ->

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

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

let finfos = GetImmediateIntrinsicILFieldsOfType (optFilter, ad) m ty

let einfos = ComputeImmediateIntrinsicEventsOfType (optFilter, ad) m ty

let rfinfos = GetImmediateIntrinsicRecdOrClassFieldsOfType (optFilter, ad) m ty

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

ty

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), ty) ->

match stripTyEqns g ty 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, _, ty)) =

// Ignoring the ranges - that's OK.

flagsEq.GetHashCode flags +

(match stripTyEqns g ty 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 GetEntireTypeHierarchyUncached HashIdentity.Structural

let primaryTypeHierarchyCache = MakeInfoCache GetPrimaryTypeHierarchyUncached 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, ty) =

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

| [] -> ValueNone

| [single] -> ValueSome single

| flds ->

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

// so filter them by the given type name

match tryDestAppTy g ty with

| ValueNone -> ValueNone

| ValueSome tcref ->

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

| [] -> ValueNone

| [single] -> ValueSome 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, ty) =

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

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

member x.GetEntireTypeHierarchy (allowMultiIntfInst, m, ty) =

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

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

member x.GetPrimaryTypeHierarchy (allowMultiIntfInst, m, ty) =

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

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 constructors. In this case convert to the .NET Tuple type that carries metadata and try again

// Function types also support constructors. In this case convert to the FSharpFunc type that carries metadata and try again

if isAnyTupleTy g metadataTy || isFunTy g metadataTy then

let betterMetadataTy = convertToTypeWithMetadataIfPossible g metadataTy

GetIntrinsicConstructorInfosOfTypeAux infoReader m origTy betterMetadataTy

else

match tryDestAppTy g metadataTy with

| ValueNone -> []

| ValueSome 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 ty =

GetIntrinsicConstructorInfosOfTypeAux infoReader m ty ty

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 =

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))

let private FilterOverridesOfPropInfos findFlag g amap m props =

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))

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 ty =

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

|> FilterOverridesOfMethInfos findFlag infoReader.g infoReader.amap m

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

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

|> FilterOverridesOfPropInfos findFlag infoReader.g infoReader.amap m

let GetIntrinsicMethInfosOfType infoReader optFilter ad allowMultiIntfInst findFlag m ty =

GetIntrinsicMethInfoSetsOfType infoReader optFilter ad allowMultiIntfInst findFlag m ty |> List.concat

let GetIntrinsicPropInfosOfType infoReader optFilter ad allowMultiIntfInst findFlag m ty =

GetIntrinsicPropInfoSetsOfType infoReader optFilter ad allowMultiIntfInst findFlag m ty |> List.concat

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

match infoReader.TryFindNamedItemOfType(nm, ad, m, ty) 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 TryDestStandardDelegateType (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 TryDestStandardDelegateType 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 TryDestStandardDelegateType 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