open FSharp.Compiler

open FSharp.Compiler.AbstractIL.IL

open FSharp.Compiler.AbstractIL.Internal.Library

open FSharp.Compiler.Range

open FSharp.Compiler.Ast

open FSharp.Compiler.ErrorLogger

open FSharp.Compiler.Lib

open FSharp.Compiler.Infos

open FSharp.Compiler.AccessibilityLogic

open FSharp.Compiler.NameResolution

open FSharp.Compiler.InfoReader

open FSharp.Compiler.Tast

open FSharp.Compiler.Tastops

open FSharp.Compiler.Tastops.DebugPrint

open FSharp.Compiler.TcGlobals

open FSharp.Compiler.TypeRelations

open FSharp.Compiler.AttributeChecking

open Internal.Utilities

#if !NO_EXTENSIONTYPING

open FSharp.Compiler.ExtensionTyping

type CallerArg<'T> =

/// CallerArg(ty, range, isOpt, exprInfo)

| CallerArg of TType * range * bool * 'T

member x.Type = (let (CallerArg(ty, _, _, _)) = x in ty)

member x.Range = (let (CallerArg(_, m, _, _)) = x in m)

member x.IsOptional = (let (CallerArg(_, _, isOpt, _)) = x in isOpt)

member x.Expr = (let (CallerArg(_, _, _, expr)) = x in expr)

type CalledArg =

{ Position: (int * int)

IsParamArray : bool

OptArgInfo : OptionalArgInfo

CallerInfo : CallerInfo

IsInArg: bool

IsOutArg: bool

ReflArgInfo: ReflectedArgInfo

NameOpt: Ident option

CalledArgumentType : TType }

let CalledArg (pos, isParamArray, optArgInfo, callerInfo, isInArg, isOutArg, nameOpt, reflArgInfo, calledArgTy) =

{ Position=pos

IsParamArray=isParamArray

OptArgInfo=optArgInfo

CallerInfo=callerInfo

IsInArg=isInArg

IsOutArg=isOutArg

ReflArgInfo=reflArgInfo

NameOpt=nameOpt

CalledArgumentType=calledArgTy }

type AssignedCalledArg<'T> =

{ /// The identifier for a named argument, if any

NamedArgIdOpt : Ident option

/// The called argument in the method

CalledArg: CalledArg

/// The argument on the caller side

CallerArg: CallerArg<'T> }

member x.Position = x.CalledArg.Position

type AssignedItemSetterTarget =

| AssignedPropSetter of PropInfo * MethInfo * TypeInst (* the MethInfo is a non-indexer setter property *)

| AssignedILFieldSetter of ILFieldInfo

| AssignedRecdFieldSetter of RecdFieldInfo

type AssignedItemSetter<'T> = AssignedItemSetter of Ident * AssignedItemSetterTarget * CallerArg<'T>

type CallerNamedArg<'T> =

| CallerNamedArg of Ident * CallerArg<'T>

member x.Ident = (let (CallerNamedArg(id, _)) = x in id)

member x.Name = x.Ident.idText

member x.CallerArg = (let (CallerNamedArg(_, a)) = x in a)

let AdjustCalledArgType (infoReader: InfoReader) isConstraint (calledArg: CalledArg) (callerArg: CallerArg<_>) =

let g = infoReader.g

// #424218 - when overload resolution is part of constraint solving - do not perform type-directed conversions

let calledArgTy = calledArg.CalledArgumentType

let callerArgTy = callerArg.Type

let m = callerArg.Range

if isConstraint then

calledArgTy

else

// If the called method argument is an inref type, then the caller may provide a byref or value

if isInByrefTy g calledArgTy then

#if IMPLICIT_ADDRESS_OF

if isByrefTy g callerArgTy then

calledArgTy

else

destByrefTy g calledArgTy

calledArgTy

// If the called method argument is a (non inref) byref type, then the caller may provide a byref or ref.

elif isByrefTy g calledArgTy then

if isByrefTy g callerArgTy then

calledArgTy

else

mkRefCellTy g (destByrefTy g calledArgTy)

else

// If the called method argument is a delegate type, and the caller is known to be a function type, then the caller may provide a function

// If the called method argument is an Expression<T> type, and the caller is known to be a function type, then the caller may provide a T

// If the called method argument is an [<AutoQuote>] Quotations.Expr<T>, and the caller is not known to be a quoted expression type, then the caller may provide a T

let calledArgTy =

let adjustDelegateTy calledTy =

let (SigOfFunctionForDelegate(_, delArgTys, _, fty)) = GetSigOfFunctionForDelegate infoReader calledTy m AccessibleFromSomewhere

let delArgTys = if isNil delArgTys then [g.unit_ty] else delArgTys

if (fst (stripFunTy g callerArgTy)).Length = delArgTys.Length

then fty

else calledArgTy

if isDelegateTy g calledArgTy && isFunTy g callerArgTy then

adjustDelegateTy calledArgTy

elif isLinqExpressionTy g calledArgTy && isFunTy g callerArgTy then

let origArgTy = calledArgTy

let calledArgTy = destLinqExpressionTy g calledArgTy

if isDelegateTy g calledArgTy then

adjustDelegateTy calledArgTy

else

// BUG 435170: called arg is Expr<'t> where 't is not delegate - such conversion is not legal -> return original type

origArgTy

elif calledArg.ReflArgInfo.AutoQuote && isQuotedExprTy g calledArgTy && not (isQuotedExprTy g callerArgTy) then

destQuotedExprTy g calledArgTy

else calledArgTy

// Adjust the called argument type to take into account whether the caller's argument is M(?arg=Some(3)) or M(arg=1)

// If the called method argument is Callee-side optional with type Option<T>, and the caller argument is not explicitly optional (callerArg.IsOptional), then the caller may provide a T

// If the called method argument is Caller-side optional with type Nullable<T>, and the caller argument is not explicitly optional (callerArg.IsOptional), then the caller may provide a T

let calledArgTy =

match calledArg.OptArgInfo with

| NotOptional -> calledArgTy

| CalleeSide when not callerArg.IsOptional && isOptionTy g calledArgTy -> destOptionTy g calledArgTy

// This will be added in https://github.com/dotnet/fsharp/pull/7276

//| CallerSide _ when not callerArg.IsOptional && isNullableTy g calledArgTy -> destNullableTy g calledArgTy

| CalleeSide

| CallerSide _ -> calledArgTy

calledArgTy

type CalledMethArgSet<'T> =

{ /// The called arguments corresponding to "unnamed" arguments

UnnamedCalledArgs : CalledArg list

/// Any unnamed caller arguments not otherwise assigned

UnnamedCallerArgs : CallerArg<'T> list

/// The called "ParamArray" argument, if any

ParamArrayCalledArgOpt : CalledArg option

/// Any unnamed caller arguments assigned to a "param array" argument

ParamArrayCallerArgs : CallerArg<'T> list

/// Named args

AssignedNamedArgs: AssignedCalledArg<'T> list }

member x.NumUnnamedCallerArgs = x.UnnamedCallerArgs.Length

member x.NumAssignedNamedArgs = x.AssignedNamedArgs.Length

member x.NumUnnamedCalledArgs = x.UnnamedCalledArgs.Length

let MakeCalledArgs amap m (minfo: MethInfo) minst =

// Mark up the arguments with their position, so we can sort them back into order later

let paramDatas = minfo.GetParamDatas(amap, m, minst)

paramDatas |> List.mapiSquared (fun i j (ParamData(isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfoFlags, nmOpt, reflArgInfo, typeOfCalledArg)) ->

{ Position=(i,j)

IsParamArray=isParamArrayArg

OptArgInfo=optArgInfo

CallerInfo = callerInfoFlags

IsInArg=isInArg

IsOutArg=isOutArg

ReflArgInfo=reflArgInfo

NameOpt=nmOpt

CalledArgumentType=typeOfCalledArg })

type CalledMeth<'T>

(infoReader: InfoReader,

nameEnv: NameResolutionEnv option,

isCheckingAttributeCall,

freshenMethInfo, // a function to help generate fresh type variables the property setters methods in generic classes

m,

ad, // the access domain of the place where the call is taking place

minfo: MethInfo, // the method we're attempting to call

calledTyArgs, // the 'called type arguments', i.e. the fresh generic instantiation of the method we're attempting to call

callerTyArgs: TType list, // the 'caller type arguments', i.e. user-given generic instantiation of the method we're attempting to call

pinfoOpt: PropInfo option, // the property related to the method we're attempting to call, if any

callerObjArgTys: TType list, // the types of the actual object argument, if any

curriedCallerArgs: (CallerArg<'T> list * CallerNamedArg<'T> list) list, // the data about any arguments supplied by the caller

allowParamArgs: bool, // do we allow the use of a param args method in its "expanded" form?

allowOutAndOptArgs: bool, // do we allow the use of the transformation that converts out arguments as tuple returns?

tyargsOpt : TType option) // method parameters

=

let g = infoReader.g

let methodRetTy = minfo.GetFSharpReturnTy(infoReader.amap, m, calledTyArgs)

let fullCurriedCalledArgs = MakeCalledArgs infoReader.amap m minfo calledTyArgs

do assert (fullCurriedCalledArgs.Length = fullCurriedCalledArgs.Length)

let argSetInfos =

(curriedCallerArgs, fullCurriedCalledArgs) ||> List.map2 (fun (unnamedCallerArgs, namedCallerArgs) fullCalledArgs ->

// Find the arguments not given by name

let unnamedCalledArgs =

fullCalledArgs |> List.filter (fun calledArg ->

match calledArg.NameOpt with

| Some nm -> namedCallerArgs |> List.forall (fun (CallerNamedArg(nm2, _e)) -> nm.idText <> nm2.idText)

| None -> true)

// See if any of them are 'out' arguments being returned as part of a return tuple

let minArgs, unnamedCalledArgs, unnamedCalledOptArgs, unnamedCalledOutArgs =

let nUnnamedCallerArgs = unnamedCallerArgs.Length

let nUnnamedCalledArgs = unnamedCalledArgs.Length

if allowOutAndOptArgs && nUnnamedCallerArgs < nUnnamedCalledArgs then

let unnamedCalledArgsTrimmed, unnamedCalledOptOrOutArgs = List.splitAt nUnnamedCallerArgs unnamedCalledArgs

// Check if all optional/out arguments are byref-out args

if unnamedCalledOptOrOutArgs |> List.forall (fun x -> x.IsOutArg && isByrefTy g x.CalledArgumentType) then

nUnnamedCallerArgs - 1, unnamedCalledArgsTrimmed, [], unnamedCalledOptOrOutArgs

// Check if all optional/out arguments are optional args

elif unnamedCalledOptOrOutArgs |> List.forall (fun x -> x.OptArgInfo.IsOptional) then

nUnnamedCallerArgs - 1, unnamedCalledArgsTrimmed, unnamedCalledOptOrOutArgs, []

// Otherwise drop them on the floor

else

nUnnamedCalledArgs - 1, unnamedCalledArgs, [], []

else

nUnnamedCalledArgs - 1, unnamedCalledArgs, [], []

let (unnamedCallerArgs, paramArrayCallerArgs), unnamedCalledArgs, paramArrayCalledArgOpt =

let supportsParamArgs =

allowParamArgs &&

minArgs >= 0 &&

unnamedCalledArgs |> List.last |> (fun calledArg -> calledArg.IsParamArray && isArray1DTy g calledArg.CalledArgumentType)

if supportsParamArgs && unnamedCallerArgs.Length >= minArgs then

let a, b = List.frontAndBack unnamedCalledArgs

List.splitAt minArgs unnamedCallerArgs, a, Some(b)

else

(unnamedCallerArgs, []), unnamedCalledArgs, None

let assignedNamedArgs =

fullCalledArgs |> List.choose (fun calledArg ->

match calledArg.NameOpt with

| Some nm ->

namedCallerArgs |> List.tryPick (fun (CallerNamedArg(nm2, callerArg)) ->

if nm.idText = nm2.idText then Some { NamedArgIdOpt = Some nm2; CallerArg=callerArg; CalledArg=calledArg }

else None)

| _ -> None)

let unassignedNamedItems =

namedCallerArgs |> List.filter (fun (CallerNamedArg(nm, _e)) ->

fullCalledArgs |> List.forall (fun calledArg ->

match calledArg.NameOpt with

| Some nm2 -> nm.idText <> nm2.idText

| None -> true))

let attributeAssignedNamedItems =

if isCheckingAttributeCall then

// The process for assigning names-->properties is substantially different for attribute specifications

// because it permits the bindings of names to immutable fields. So we use the old

// code for this.

unassignedNamedItems

else

[]

let assignedNamedProps, unassignedNamedItems =

let returnedObjTy = if minfo.IsConstructor then minfo.ApparentEnclosingType else methodRetTy

unassignedNamedItems |> List.splitChoose (fun (CallerNamedArg(id, e) as arg) ->

let nm = id.idText

let pinfos = GetIntrinsicPropInfoSetsOfType infoReader (Some nm) ad AllowMultiIntfInstantiations.Yes IgnoreOverrides id.idRange returnedObjTy

let pinfos = pinfos |> ExcludeHiddenOfPropInfos g infoReader.amap m

match pinfos with

| [pinfo] when pinfo.HasSetter && not pinfo.IsIndexer ->

let pminfo = pinfo.SetterMethod

let pminst = freshenMethInfo m pminfo

Choice1Of2(AssignedItemSetter(id, AssignedPropSetter(pinfo, pminfo, pminst), e))

| _ ->

let epinfos =

match nameEnv with

| Some ne -> ExtensionPropInfosOfTypeInScope ResultCollectionSettings.AllResults infoReader ne (Some nm) ad m returnedObjTy

| _ -> []

match epinfos with

| [pinfo] when pinfo.HasSetter && not pinfo.IsIndexer ->

let pminfo = pinfo.SetterMethod

let pminst = match minfo with

| MethInfo.FSMeth(_, TType.TType_app(_, types), _, _) -> types

| _ -> freshenMethInfo m pminfo

let pminst = match tyargsOpt with

| Some(TType.TType_app(_, types)) -> types

| _ -> pminst

Choice1Of2(AssignedItemSetter(id, AssignedPropSetter(pinfo, pminfo, pminst), e))

| _ ->

match infoReader.GetILFieldInfosOfType(Some(nm), ad, m, returnedObjTy) with

| finfo :: _ ->

Choice1Of2(AssignedItemSetter(id, AssignedILFieldSetter(finfo), e))

| _ ->

match infoReader.TryFindRecdOrClassFieldInfoOfType(nm, m, returnedObjTy) with

| ValueSome rfinfo ->

Choice1Of2(AssignedItemSetter(id, AssignedRecdFieldSetter(rfinfo), e))

| _ ->

Choice2Of2(arg))

let names = namedCallerArgs |> List.map (fun (CallerNamedArg(nm, _)) -> nm.idText)

if (List.noRepeats String.order names).Length <> namedCallerArgs.Length then

errorR(Error(FSComp.SR.typrelNamedArgumentHasBeenAssignedMoreThenOnce(), m))

let argSet = { UnnamedCalledArgs=unnamedCalledArgs; UnnamedCallerArgs=unnamedCallerArgs; ParamArrayCalledArgOpt=paramArrayCalledArgOpt; ParamArrayCallerArgs=paramArrayCallerArgs; AssignedNamedArgs=assignedNamedArgs }

(argSet, assignedNamedProps, unassignedNamedItems, attributeAssignedNamedItems, unnamedCalledOptArgs, unnamedCalledOutArgs))

let argSets = argSetInfos |> List.map (fun (x, _, _, _, _, _) -> x)

let assignedNamedProps = argSetInfos |> List.collect (fun (_, x, _, _, _, _) -> x)

let unassignedNamedItems = argSetInfos |> List.collect (fun (_, _, x, _, _, _) -> x)

let attributeAssignedNamedItems = argSetInfos |> List.collect (fun (_, _, _, x, _, _) -> x)

let unnamedCalledOptArgs = argSetInfos |> List.collect (fun (_, _, _, _, x, _) -> x)

let unnamedCalledOutArgs = argSetInfos |> List.collect (fun (_, _, _, _, _, x) -> x)

member x.infoReader = infoReader

member x.amap = infoReader.amap

/// the method we're attempting to call

member x.Method = minfo

/// the instantiation of the method we're attempting to call

member x.CalledTyArgs = calledTyArgs

/// the instantiation of the method we're attempting to call

member x.CalledTyparInst =

let tps = minfo.FormalMethodTypars

if tps.Length = calledTyArgs.Length then mkTyparInst tps calledTyArgs else []

/// the formal instantiation of the method we're attempting to call

member x.CallerTyArgs = callerTyArgs

/// The types of the actual object arguments, if any

member x.CallerObjArgTys = callerObjArgTys

/// The argument analysis for each set of curried arguments

member x.ArgSets = argSets

/// return type after implicit deference of byref returns is taken into account

member x.CalledReturnTypeAfterByrefDeref =

let retTy = methodRetTy

if isByrefTy g retTy then destByrefTy g retTy else retTy

/// return type after tupling of out args is taken into account

member x.CalledReturnTypeAfterOutArgTupling =

let retTy = x.CalledReturnTypeAfterByrefDeref

if isNil unnamedCalledOutArgs then

retTy

else

let outArgTys = unnamedCalledOutArgs |> List.map (fun calledArg -> destByrefTy g calledArg.CalledArgumentType)

if isUnitTy g retTy then mkRefTupledTy g outArgTys

else mkRefTupledTy g (retTy :: outArgTys)

/// named setters

member x.AssignedItemSetters = assignedNamedProps

/// the property related to the method we're attempting to call, if any

member x.AssociatedPropertyInfo = pinfoOpt

/// unassigned args

member x.UnassignedNamedArgs = unassignedNamedItems

/// args assigned to specify values for attribute fields and properties (these are not necessarily "property sets")

member x.AttributeAssignedNamedArgs = attributeAssignedNamedItems

/// unnamed called optional args: pass defaults for these

member x.UnnamedCalledOptArgs = unnamedCalledOptArgs

/// unnamed called out args: return these as part of the return tuple

member x.UnnamedCalledOutArgs = unnamedCalledOutArgs

static member GetMethod (x: CalledMeth<'T>) = x.Method

member x.NumArgSets = x.ArgSets.Length

member x.HasOptArgs = not (isNil x.UnnamedCalledOptArgs)

member x.HasOutArgs = not (isNil x.UnnamedCalledOutArgs)

member x.UsesParamArrayConversion = x.ArgSets |> List.exists (fun argSet -> argSet.ParamArrayCalledArgOpt.IsSome)

member x.ParamArrayCalledArgOpt = x.ArgSets |> List.tryPick (fun argSet -> argSet.ParamArrayCalledArgOpt)

member x.ParamArrayCallerArgs = x.ArgSets |> List.tryPick (fun argSet -> if Option.isSome argSet.ParamArrayCalledArgOpt then Some argSet.ParamArrayCallerArgs else None )

member x.ParamArrayElementType =

assert (x.UsesParamArrayConversion)

x.ParamArrayCalledArgOpt.Value.CalledArgumentType |> destArrayTy x.amap.g

member x.NumAssignedProps = x.AssignedItemSetters.Length

member x.CalledObjArgTys(m) =

match x.Method.GetObjArgTypes(x.amap, m, x.CalledTyArgs) with

| [ thisArgTy ] when isByrefTy g thisArgTy -> [ destByrefTy g thisArgTy ]

| res -> res

member x.NumCalledTyArgs = x.CalledTyArgs.Length

member x.NumCallerTyArgs = x.CallerTyArgs.Length

member x.AssignsAllNamedArgs = isNil x.UnassignedNamedArgs

member x.HasCorrectArity =

(x.NumCalledTyArgs = x.NumCallerTyArgs) &&

x.ArgSets |> List.forall (fun argSet -> argSet.NumUnnamedCalledArgs = argSet.NumUnnamedCallerArgs)

member x.HasCorrectGenericArity =

(x.NumCalledTyArgs = x.NumCallerTyArgs)

member x.IsAccessible(m, ad) =

IsMethInfoAccessible x.amap m ad x.Method

member x.HasCorrectObjArgs(m) =

x.CalledObjArgTys(m).Length = x.CallerObjArgTys.Length

member x.IsCandidate(m, ad) =

x.IsAccessible(m, ad) &&

x.HasCorrectArity &&

x.HasCorrectObjArgs(m) &&

x.AssignsAllNamedArgs

member x.AssignedUnnamedArgs =

// We use Seq.map2 to tolerate there being mismatched caller/called args

x.ArgSets |> List.map (fun argSet ->

(argSet.UnnamedCalledArgs, argSet.UnnamedCallerArgs) ||> Seq.map2 (fun calledArg callerArg ->

{ NamedArgIdOpt=None; CalledArg=calledArg; CallerArg=callerArg }) |> Seq.toList)

member x.AssignedNamedArgs =

x.ArgSets |> List.map (fun argSet -> argSet.AssignedNamedArgs)

member x.AllUnnamedCalledArgs = x.ArgSets |> List.collect (fun x -> x.UnnamedCalledArgs)

member x.TotalNumUnnamedCalledArgs = x.ArgSets |> List.sumBy (fun x -> x.NumUnnamedCalledArgs)

member x.TotalNumUnnamedCallerArgs = x.ArgSets |> List.sumBy (fun x -> x.NumUnnamedCallerArgs)

member x.TotalNumAssignedNamedArgs = x.ArgSets |> List.sumBy (fun x -> x.NumAssignedNamedArgs)

let NamesOfCalledArgs (calledArgs: CalledArg list) =

calledArgs |> List.choose (fun x -> x.NameOpt)

type ArgumentAnalysis =

| NoInfo

| ArgDoesNotMatch

| CallerLambdaHasArgTypes of TType list

| CalledArgMatchesType of TType

let InferLambdaArgsForLambdaPropagation origRhsExpr =

let rec loop e =

match e with

| SynExpr.Lambda (_, _, _, rest, _) -> 1 + loop rest

| SynExpr.MatchLambda _ -> 1

| _ -> 0

loop origRhsExpr

let ExamineArgumentForLambdaPropagation (infoReader: InfoReader) (arg: AssignedCalledArg<SynExpr>) =

let g = infoReader.g

// Find the explicit lambda arguments of the caller. Ignore parentheses.

let argExpr = match arg.CallerArg.Expr with SynExpr.Paren (x, _, _, _) -> x | x -> x

let countOfCallerLambdaArg = InferLambdaArgsForLambdaPropagation argExpr

// Adjust for Expression<_>, Func<_, _>, ...

let adjustedCalledArgTy = AdjustCalledArgType infoReader false arg.CalledArg arg.CallerArg

if countOfCallerLambdaArg > 0 then

// Decompose the explicit function type of the target

let calledLambdaArgTys, _calledLambdaRetTy = Tastops.stripFunTy g adjustedCalledArgTy

if calledLambdaArgTys.Length >= countOfCallerLambdaArg then

// success

CallerLambdaHasArgTypes calledLambdaArgTys

elif isDelegateTy g (if isLinqExpressionTy g adjustedCalledArgTy then destLinqExpressionTy g adjustedCalledArgTy else adjustedCalledArgTy) then

ArgDoesNotMatch // delegate arity mismatch

else

NoInfo // not a function type on the called side - no information

else CalledArgMatchesType(adjustedCalledArgTy) // not a lambda on the caller side - push information from caller to called

let ExamineMethodForLambdaPropagation (x: CalledMeth<SynExpr>) =

let unnamedInfo = x.AssignedUnnamedArgs |> List.mapSquared (ExamineArgumentForLambdaPropagation x.infoReader)

let namedInfo = x.AssignedNamedArgs |> List.mapSquared (fun arg -> (arg.NamedArgIdOpt.Value, ExamineArgumentForLambdaPropagation x.infoReader arg))

if unnamedInfo |> List.existsSquared (function CallerLambdaHasArgTypes _ -> true | _ -> false) ||

namedInfo |> List.existsSquared (function (_, CallerLambdaHasArgTypes _) -> true | _ -> false) then

Some (unnamedInfo, namedInfo)

else

None

let BuildObjCtorCall (g: TcGlobals) m =

let ilMethRef = (mkILCtorMethSpecForTy(g.ilg.typ_Object, [])).MethodRef

Expr.Op (TOp.ILCall (false, false, false, false, CtorValUsedAsSuperInit, false, true, ilMethRef, [], [], [g.obj_ty]), [], [], m)

let BuildNewDelegateExpr (eventInfoOpt: EventInfo option, g, amap, delegateTy, invokeMethInfo: MethInfo, delArgTys, f, fty, m) =

let slotsig = invokeMethInfo.GetSlotSig(amap, m)

let delArgVals, expr =

let topValInfo = ValReprInfo([], List.replicate (max 1 (List.length delArgTys)) ValReprInfo.unnamedTopArg, ValReprInfo.unnamedRetVal)

// Try to pull apart an explicit lambda and use it directly

// Don't do this in the case where we're adjusting the arguments of a function used to build a .NET-compatible event handler

let lambdaContents =

if Option.isSome eventInfoOpt then

None

else

tryDestTopLambda g amap topValInfo (f, fty)

match lambdaContents with

| None ->

if List.exists (isByrefTy g) delArgTys then

error(Error(FSComp.SR.tcFunctionRequiresExplicitLambda(List.length delArgTys), m))

let delArgVals = delArgTys |> List.mapi (fun i argty -> fst (mkCompGenLocal m ("delegateArg" + string i) argty))

let expr =

let args =

match eventInfoOpt with

| Some einfo ->

match delArgVals with

| [] -> error(nonStandardEventError einfo.EventName m)

| h :: _ when not (isObjTy g h.Type) -> error(nonStandardEventError einfo.EventName m)

| h :: t -> [exprForVal m h; mkRefTupledVars g m t]

| None ->

if isNil delArgTys then [mkUnit g m] else List.map (exprForVal m) delArgVals

mkApps g ((f, fty), [], args, m)

delArgVals, expr

| Some _ ->

let _, _, _, vsl, body, _ = IteratedAdjustArityOfLambda g amap topValInfo f

List.concat vsl, body

let meth = TObjExprMethod(slotsig, [], [], [delArgVals], expr, m)

mkObjExpr(delegateTy, None, BuildObjCtorCall g m, [meth], [], m)

let CoerceFromFSharpFuncToDelegate g amap infoReader ad callerArgTy m callerArgExpr delegateTy =

let (SigOfFunctionForDelegate(invokeMethInfo, delArgTys, _, _)) = GetSigOfFunctionForDelegate infoReader delegateTy m ad

BuildNewDelegateExpr (None, g, amap, delegateTy, invokeMethInfo, delArgTys, callerArgExpr, callerArgTy, m)

let AdjustCallerArgExprForCoercions (g: TcGlobals) amap infoReader ad isOutArg calledArgTy (reflArgInfo: ReflectedArgInfo) callerArgTy m callerArgExpr =

if isByrefTy g calledArgTy && isRefCellTy g callerArgTy then

None, Expr.Op (TOp.RefAddrGet false, [destRefCellTy g callerArgTy], [callerArgExpr], m)

#if IMPLICIT_ADDRESS_OF

elif isInByrefTy g calledArgTy && not (isByrefTy g callerArgTy) then

let wrap, callerArgExprAddress, _readonly, _writeonly = mkExprAddrOfExpr g true false NeverMutates callerArgExpr None m

Some wrap, callerArgExprAddress

elif isDelegateTy g calledArgTy && isFunTy g callerArgTy then

None, CoerceFromFSharpFuncToDelegate g amap infoReader ad callerArgTy m callerArgExpr calledArgTy

elif isLinqExpressionTy g calledArgTy && isDelegateTy g (destLinqExpressionTy g calledArgTy) && isFunTy g callerArgTy then

let delegateTy = destLinqExpressionTy g calledArgTy

let expr = CoerceFromFSharpFuncToDelegate g amap infoReader ad callerArgTy m callerArgExpr delegateTy

None, mkCallQuoteToLinqLambdaExpression g m delegateTy (Expr.Quote (expr, ref None, false, m, mkQuotedExprTy g delegateTy))

// auto conversions to quotations (to match auto conversions to LINQ expressions)

elif reflArgInfo.AutoQuote && isQuotedExprTy g calledArgTy && not (isQuotedExprTy g callerArgTy) then

match reflArgInfo with

| ReflectedArgInfo.Quote true ->

None, mkCallLiftValueWithDefn g m calledArgTy callerArgExpr

| ReflectedArgInfo.Quote false ->

None, Expr.Quote (callerArgExpr, ref None, false, m, calledArgTy)

| ReflectedArgInfo.None -> failwith "unreachable" // unreachable due to reflArgInfo.AutoQuote condition

// Note: out args do not need to be coerced

elif isOutArg then

None, callerArgExpr

// Note: not all these casts are reported in quotations

else

None, mkCoerceIfNeeded g calledArgTy callerArgTy callerArgExpr

let AdjustOptionalCallerArgExprs tcFieldInit eCallerMemberName g (calledMeth: CalledMeth<_>) mItem mMethExpr =

let assignedNamedArgs = calledMeth.ArgSets |> List.collect (fun argSet -> argSet.AssignedNamedArgs)

let unnamedCalledArgs = calledMeth.ArgSets |> List.collect (fun argSet -> argSet.UnnamedCalledArgs)

let unnamedCallerArgs = calledMeth.ArgSets |> List.collect (fun argSet -> argSet.UnnamedCallerArgs)

let unnamedArgs =

(unnamedCalledArgs, unnamedCallerArgs) ||> List.map2 (fun called caller ->

{ NamedArgIdOpt = None; CalledArg=called; CallerArg=caller })

let emptyPreBinder (e: Expr) = e

// Adjust all the optional arguments that require a default value to be inserted into the call

let optArgs, optArgPreBinder =

(emptyPreBinder, calledMeth.UnnamedCalledOptArgs) ||> List.mapFold (fun wrapper calledArg ->

let calledArgTy = calledArg.CalledArgumentType

let wrapper2, expr =

match calledArg.OptArgInfo with

| NotOptional ->

error(InternalError("Unexpected NotOptional", mItem))

| CallerSide dfltVal ->

let rec build currCalledArgTy currDfltVal =

match currDfltVal with

| MissingValue ->

// Add an I_nop if this is an initonly field to make sure we never recognize it as an lvalue. See mkExprAddrOfExpr.

emptyPreBinder, mkAsmExpr ([ mkNormalLdsfld (fspec_Missing_Value g); AI_nop ], [], [], [currCalledArgTy], mMethExpr)

| DefaultValue ->

emptyPreBinder, mkDefault(mMethExpr, currCalledArgTy)

| Constant fieldInit ->

match currCalledArgTy with

| NullableTy g inst when fieldInit <> ILFieldInit.Null ->

let nullableTy = mkILNonGenericBoxedTy(g.FindSysILTypeRef "System.Nullable`1")

let ctor = mkILCtorMethSpecForTy(nullableTy, [ILType.TypeVar 0us]).MethodRef

let ctorArgs = [Expr.Const (tcFieldInit mMethExpr fieldInit, mMethExpr, inst)]

emptyPreBinder, Expr.Op (TOp.ILCall (false, false, true, true, NormalValUse, false, false, ctor, [inst], [], [currCalledArgTy]), [], ctorArgs, mMethExpr)

| ByrefTy g inst ->

build inst (PassByRef(inst, currDfltVal))

| _ ->

match calledArg.CallerInfo, eCallerMemberName with

| CallerLineNumber, _ when typeEquiv g currCalledArgTy g.int_ty ->

emptyPreBinder, Expr.Const (Const.Int32(mMethExpr.StartLine), mMethExpr, currCalledArgTy)

| CallerFilePath, _ when typeEquiv g currCalledArgTy g.string_ty ->

let fileName = mMethExpr.FileName |> FileSystem.GetFullPathShim |> PathMap.apply g.pathMap

emptyPreBinder, Expr.Const (Const.String fileName, mMethExpr, currCalledArgTy)

| CallerMemberName, Some callerName when (typeEquiv g currCalledArgTy g.string_ty) ->

emptyPreBinder, Expr.Const (Const.String callerName, mMethExpr, currCalledArgTy)

| _ ->

emptyPreBinder, Expr.Const (tcFieldInit mMethExpr fieldInit, mMethExpr, currCalledArgTy)

| WrapperForIDispatch ->

match g.TryFindSysILTypeRef "System.Runtime.InteropServices.DispatchWrapper" with

| None -> error(Error(FSComp.SR.fscSystemRuntimeInteropServicesIsRequired(), mMethExpr))

| Some tref ->

let ty = mkILNonGenericBoxedTy tref

let mref = mkILCtorMethSpecForTy(ty, [g.ilg.typ_Object]).MethodRef

let expr = Expr.Op (TOp.ILCall (false, false, false, true, NormalValUse, false, false, mref, [], [], [g.obj_ty]), [], [mkDefault(mMethExpr, currCalledArgTy)], mMethExpr)

emptyPreBinder, expr

| WrapperForIUnknown ->

match g.TryFindSysILTypeRef "System.Runtime.InteropServices.UnknownWrapper" with

| None -> error(Error(FSComp.SR.fscSystemRuntimeInteropServicesIsRequired(), mMethExpr))

| Some tref ->

let ty = mkILNonGenericBoxedTy tref

let mref = mkILCtorMethSpecForTy(ty, [g.ilg.typ_Object]).MethodRef

let expr = Expr.Op (TOp.ILCall (false, false, false, true, NormalValUse, false, false, mref, [], [], [g.obj_ty]), [], [mkDefault(mMethExpr, currCalledArgTy)], mMethExpr)

emptyPreBinder, expr

| PassByRef (ty, dfltVal2) ->

let v, _ = mkCompGenLocal mMethExpr "defaultByrefArg" ty

let wrapper2, rhs = build currCalledArgTy dfltVal2

(wrapper2 >> mkCompGenLet mMethExpr v rhs), mkValAddr mMethExpr false (mkLocalValRef v)

build calledArgTy dfltVal

| CalleeSide ->

let calledNonOptTy =

if isOptionTy g calledArgTy then

destOptionTy g calledArgTy

else

calledArgTy // should be unreachable

match calledArg.CallerInfo, eCallerMemberName with

| CallerLineNumber, _ when typeEquiv g calledNonOptTy g.int_ty ->

let lineExpr = Expr.Const(Const.Int32 mMethExpr.StartLine, mMethExpr, calledNonOptTy)

emptyPreBinder, mkSome g calledNonOptTy lineExpr mMethExpr

| CallerFilePath, _ when typeEquiv g calledNonOptTy g.string_ty ->

let fileName = mMethExpr.FileName |> FileSystem.GetFullPathShim |> PathMap.apply g.pathMap

let filePathExpr = Expr.Const (Const.String(fileName), mMethExpr, calledNonOptTy)

emptyPreBinder, mkSome g calledNonOptTy filePathExpr mMethExpr

| CallerMemberName, Some(callerName) when typeEquiv g calledNonOptTy g.string_ty ->

let memberNameExpr = Expr.Const (Const.String callerName, mMethExpr, calledNonOptTy)

emptyPreBinder, mkSome g calledNonOptTy memberNameExpr mMethExpr

| _ ->

emptyPreBinder, mkNone g calledNonOptTy mMethExpr

// Combine the variable allocators (if any)

let wrapper = (wrapper >> wrapper2)

let callerArg = CallerArg(calledArgTy, mMethExpr, false, expr)

{ NamedArgIdOpt = None; CalledArg = calledArg; CallerArg = callerArg }, wrapper)

// Adjust all the optional arguments

let wrapOptionalArg (assignedArg: AssignedCalledArg<_>) =

let (CallerArg(callerArgTy, m, isOptCallerArg, callerArgExpr)) = assignedArg.CallerArg

match assignedArg.CalledArg.OptArgInfo with

| NotOptional ->

if isOptCallerArg then errorR(Error(FSComp.SR.tcFormalArgumentIsNotOptional(), m))

assignedArg

| _ ->

let callerArgExpr2 =

match assignedArg.CalledArg.OptArgInfo with

| CallerSide _ ->

if isOptCallerArg then

// M(?x=bopt) when M(A) --> M(?x=bopt.Value) for caller-side

// STRUCT OPTIONS: if we allow struct options as optional arguments then we should take

// the address correctly.

mkUnionCaseFieldGetUnprovenViaExprAddr (callerArgExpr, mkSomeCase g, [destOptionTy g callerArgTy], 0, m)

else

// M(x=b) when M(A) --> M(?x=b) for caller-side

callerArgExpr

| CalleeSide ->

if isOptCallerArg then

// M(?x=bopt) when M(A) --> M(?x=Some(bopt.Value))

callerArgExpr

else

// M(x=b) when M(A) --> M(?x=Some(b :> A))

let calledArgTy = assignedArg.CalledArg.CalledArgumentType

if isOptionTy g calledArgTy then

let calledNonOptTy = destOptionTy g calledArgTy

mkSome g calledNonOptTy (mkCoerceIfNeeded g calledNonOptTy callerArgTy callerArgExpr) m

else

callerArgExpr // should be unreachable

| _ -> failwith "Unreachable"

{ assignedArg with CallerArg=CallerArg(tyOfExpr g callerArgExpr2, m, isOptCallerArg, callerArgExpr2) }

let adjustedNormalUnnamedArgs = List.map wrapOptionalArg unnamedArgs

let adjustedAssignedNamedArgs = List.map wrapOptionalArg assignedNamedArgs

optArgs, optArgPreBinder, adjustedNormalUnnamedArgs, adjustedAssignedNamedArgs

let AdjustOutCallerArgExprs g (calledMeth: CalledMeth<_>) mMethExpr =

calledMeth.UnnamedCalledOutArgs |> List.map (fun calledArg ->

let calledArgTy = calledArg.CalledArgumentType

let outArgTy = destByrefTy g calledArgTy

let outv, outArgExpr = mkMutableCompGenLocal mMethExpr PrettyNaming.outArgCompilerGeneratedName outArgTy // mutable!

let expr = mkDefault (mMethExpr, outArgTy)

let callerArg = CallerArg (calledArgTy, mMethExpr, false, mkValAddr mMethExpr false (mkLocalValRef outv))

let outArg = { NamedArgIdOpt=None;CalledArg=calledArg;CallerArg=callerArg }

outArg, outArgExpr, mkCompGenBind outv expr)

|> List.unzip3

let AdjustParamArrayCallerArgExprs g amap infoReader ad (calledMeth: CalledMeth<_>) mMethExpr =

let argSets = calledMeth.ArgSets

let paramArrayCallerArgs = argSets |> List.collect (fun argSet -> argSet.ParamArrayCallerArgs)

match calledMeth.ParamArrayCalledArgOpt with

| None ->

[], []

| Some paramArrayCalledArg ->

let paramArrayCalledArgElementType = destArrayTy g paramArrayCalledArg.CalledArgumentType

let paramArrayPreBinders, es =

paramArrayCallerArgs

|> List.map (fun callerArg ->

let (CallerArg(callerArgTy, m, isOutArg, callerArgExpr)) = callerArg

AdjustCallerArgExprForCoercions g amap infoReader ad isOutArg paramArrayCalledArgElementType paramArrayCalledArg.ReflArgInfo callerArgTy m callerArgExpr)

|> List.unzip

let arg =

[ { NamedArgIdOpt = None

CalledArg=paramArrayCalledArg

CallerArg=CallerArg(paramArrayCalledArg.CalledArgumentType, mMethExpr, false, Expr.Op (TOp.Array, [paramArrayCalledArgElementType], es, mMethExpr)) } ]

paramArrayPreBinders, arg

let AdjustCallerArgExprs tcFieldInit eCallerMemberName g amap infoReader ad (calledMeth: CalledMeth<_>) objArgs lambdaVars mItem mMethExpr =

let calledMethInfo = calledMeth.Method

// Some of the code below must allocate temporary variables or bind other variables to particular values.

// As usual we represent variable allocators by expr -> expr functions

// which we then use to wrap the whole expression. These will either do nothing or pre-bind a variable. It doesn't

// matter what order they are applied in as long as they are all composed together.

let emptyPreBinder (e: Expr) = e

// For unapplied 'e.M' we first evaluate 'e' outside the lambda, i.e. 'let v = e in (fun arg -> v.M(arg))'

let objArgPreBinder, objArgs =

match objArgs, lambdaVars with

| [objArg], Some _ ->

if calledMethInfo.IsExtensionMember && calledMethInfo.ObjArgNeedsAddress(amap, mMethExpr) then

error(Error(FSComp.SR.tcCannotPartiallyApplyExtensionMethodForByref(calledMethInfo.DisplayName), mMethExpr))

let objArgTy = tyOfExpr g objArg

let v, ve = mkCompGenLocal mMethExpr "objectArg" objArgTy

(fun body -> mkCompGenLet mMethExpr v objArg body), [ve]

| _ ->

emptyPreBinder, objArgs

// Handle param array and optional arguments

let paramArrayPreBinders, paramArrayArgs =

AdjustParamArrayCallerArgExprs g amap infoReader ad calledMeth mMethExpr

let optArgs, optArgPreBinder, adjustedNormalUnnamedArgs, adjustedFinalAssignedNamedArgs =

AdjustOptionalCallerArgExprs tcFieldInit eCallerMemberName g calledMeth mItem mMethExpr

let outArgs, outArgExprs, outArgTmpBinds =

AdjustOutCallerArgExprs g calledMeth mMethExpr

let allArgs =

adjustedNormalUnnamedArgs @

adjustedFinalAssignedNamedArgs @

paramArrayArgs @

optArgs @

outArgs

let allArgs =

allArgs |> List.sortBy (fun x -> x.Position)

let allArgsPreBinders, allArgsCoerced =

allArgs

|> List.map (fun assignedArg ->

let isOutArg = assignedArg.CalledArg.IsOutArg

let reflArgInfo = assignedArg.CalledArg.ReflArgInfo

let calledArgTy = assignedArg.CalledArg.CalledArgumentType

let (CallerArg(callerArgTy, m, _, e)) = assignedArg.CallerArg

AdjustCallerArgExprForCoercions g amap infoReader ad isOutArg calledArgTy reflArgInfo callerArgTy m e)

|> List.unzip

objArgPreBinder, objArgs, allArgsPreBinders, allArgs, allArgsCoerced, optArgPreBinder, paramArrayPreBinders, outArgExprs, outArgTmpBinds

let IsBaseCall objArgs =

match objArgs with

| [Expr.Val (v, _, _)] when v.BaseOrThisInfo = BaseVal -> true

| _ -> false

let ComputeConstrainedCallInfo g amap m (objArgs, minfo: MethInfo) =

match objArgs with

| [objArgExpr] when not minfo.IsExtensionMember ->

let methObjTy = minfo.ApparentEnclosingType

let objArgTy = tyOfExpr g objArgExpr

if TypeDefinitelySubsumesTypeNoCoercion 0 g amap m methObjTy objArgTy

// Constrained calls to class types can only ever be needed for the three class types that

// are base types of value types

|| (isClassTy g methObjTy &&

(not (typeEquiv g methObjTy g.system_Object_ty ||

typeEquiv g methObjTy g.system_Value_ty ||

typeEquiv g methObjTy g.system_Enum_ty))) then

None

else

// The object argument is a value type or variable type and the target method is an interface or System.Object

// type. A .NET 2.0 generic constrained call is required

Some objArgTy

| _ ->

None

let TakeObjAddrForMethodCall g amap (minfo: MethInfo) isMutable m objArgs f =

let ccallInfo = ComputeConstrainedCallInfo g amap m (objArgs, minfo)

let wrap, objArgs =

match objArgs with

| [objArgExpr] ->

let hasCallInfo = ccallInfo.IsSome

let mustTakeAddress = hasCallInfo || minfo.ObjArgNeedsAddress(amap, m)

let objArgTy = tyOfExpr g objArgExpr

let isMutable =

match isMutable with

| DefinitelyMutates

| NeverMutates

| AddressOfOp -> isMutable

| PossiblyMutates ->

// Check to see if the method is read-only. Perf optimization.

// If there is an extension member whose first arg is an inref, we must return NeverMutates.

if mustTakeAddress && (minfo.IsReadOnly || minfo.IsReadOnlyExtensionMember (amap, m)) then

NeverMutates

else

isMutable

let wrap, objArgExprAddr, isReadOnly, _isWriteOnly =

mkExprAddrOfExpr g mustTakeAddress hasCallInfo isMutable objArgExpr None m

// Extension members and calls to class constraints may need a coercion for their object argument

let objArgExprCoerced =

if not hasCallInfo &&

not (TypeDefinitelySubsumesTypeNoCoercion 0 g amap m minfo.ApparentEnclosingType objArgTy) then

mkCoerceExpr(objArgExprAddr, minfo.ApparentEnclosingType, m, objArgTy)

else

objArgExprAddr

// Check to see if the extension member uses the extending type as a byref.

// If so, make sure we don't allow readonly/immutable values to be passed byref from an extension member.

// An inref will work though.

if isReadOnly && mustTakeAddress && minfo.IsExtensionMember then

minfo.TryObjArgByrefType(amap, m, minfo.FormalMethodInst)

|> Option.iter (fun ty ->

if not (isInByrefTy g ty) then

errorR(Error(FSComp.SR.tcCannotCallExtensionMethodInrefToByref(minfo.DisplayName), m)))

wrap, [objArgExprCoerced]

| _ ->

id, objArgs

let e, ety = f ccallInfo objArgs

wrap e, ety

let BuildILMethInfoCall g amap m isProp (minfo: ILMethInfo) valUseFlags minst direct args =

let valu = isStructTy g minfo.ApparentEnclosingType

let ctor = minfo.IsConstructor

if minfo.IsClassConstructor then

error (InternalError (minfo.ILName+": cannot call a class constructor", m))

let useCallvirt =

not valu && not direct && minfo.IsVirtual

let isProtected = minfo.IsProtectedAccessibility

let ilMethRef = minfo.ILMethodRef

let newobj = ctor && (match valUseFlags with NormalValUse -> true | _ -> false)

let exprTy = if ctor then minfo.ApparentEnclosingType else minfo.GetFSharpReturnTy(amap, m, minst)

let retTy = if not ctor && ilMethRef.ReturnType = ILType.Void then [] else [exprTy]

let isDllImport = minfo.IsDllImport g