open System.Collections.Generic

open Internal.Utilities

open Microsoft.FSharp.Compiler

open Microsoft.FSharp.Compiler.AbstractIL

open Microsoft.FSharp.Compiler.AbstractIL.IL

open Microsoft.FSharp.Compiler.AbstractIL.Internal

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

open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics

open Microsoft.FSharp.Compiler.AccessibilityLogic

open Microsoft.FSharp.Compiler.Ast

open Microsoft.FSharp.Compiler.ErrorLogger

open Microsoft.FSharp.Compiler.Range

open Microsoft.FSharp.Compiler.Tast

open Microsoft.FSharp.Compiler.Tastops

open Microsoft.FSharp.Compiler.TcGlobals

open Microsoft.FSharp.Compiler.Lib

open Microsoft.FSharp.Compiler.Layout

open Microsoft.FSharp.Compiler.Infos

open Microsoft.FSharp.Compiler.PrettyNaming

open Microsoft.FSharp.Compiler.InfoReader

open Microsoft.FSharp.Compiler.TypeRelations

let testFlagMemberBody = ref false

let testHookMemberBody (membInfo: ValMemberInfo) (expr:Expr) =

if !testFlagMemberBody then

let m = expr.Range

printf "TestMemberBody,%A,%s,%d,%d,%d,%d\n"

membInfo.MemberFlags.MemberKind

m.FileName

m.StartLine

m.StartColumn

m.EndLine

m.EndColumn

type env =

{ boundTyparNames: string list

boundTypars: TyparMap<unit>

argVals: ValMap<unit>

/// "module remap info", i.e. hiding information down the signature chain, used to compute what's hidden by a signature

sigToImplRemapInfo: (Remap * SignatureHidingInfo) list

/// Constructor limited - are we in the prelude of a constructor, prior to object initialization

limited: bool

/// Are we in a quotation?

quote : bool

/// Are we under [<ReflectedDefinition>]?

reflect : bool }

let BindTypar env (tp:Typar) =

{ env with

boundTyparNames = tp.Name :: env.boundTyparNames

boundTypars = env.boundTypars.Add (tp, ()) }

let BindTypars g env (tps:Typar list) =

let tps = NormalizeDeclaredTyparsForEquiRecursiveInference g tps

if List.isEmpty tps then env else

// Here we mutate to provide better names for generalized type parameters

let nms = PrettyTypes.PrettyTyparNames (fun _ -> true) env.boundTyparNames tps

(tps,nms) ||> List.iter2 (fun tp nm ->

if PrettyTypes.NeedsPrettyTyparName tp then

tp.Data.typar_id <- ident (nm,tp.Range))

List.fold BindTypar env tps

let SetArgVals env (vs: Val list) =

{ env with argVals = ValMap.OfList (List.map (fun v -> (v,())) vs) }

type cenv =

{ boundVals: Dictionary<Stamp,int> // really a hash set

mutable potentialUnboundUsesOfVals: StampMap<range>

g: TcGlobals

amap: Import.ImportMap

/// For reading metadata

infoReader: InfoReader

internalsVisibleToPaths : CompilationPath list

denv: DisplayEnv

viewCcu : CcuThunk

reportErrors: bool

isLastCompiland : bool*bool

// outputs

mutable usesQuotations : bool

mutable entryPointGiven:bool }

let BindVal cenv (v:Val) =

//printfn "binding %s..." v.DisplayName

let alreadyDone = cenv.boundVals.ContainsKey v.Stamp

cenv.boundVals.[v.Stamp] <- 1

if not alreadyDone &&

cenv.reportErrors &&

not v.HasBeenReferenced &&

not v.IsCompiledAsTopLevel &&

not (v.DisplayName.StartsWith("_", System.StringComparison.Ordinal)) &&

not v.IsCompilerGenerated then

match v.BaseOrThisInfo with

| ValBaseOrThisInfo.CtorThisVal ->

warning (Error(FSComp.SR.chkUnusedThisVariable v.DisplayName, v.Range))

| _ ->

warning (Error(FSComp.SR.chkUnusedValue v.DisplayName, v.Range))

let BindVals cenv vs = List.iter (BindVal cenv) vs

let rec CheckTypeDeep ((visitTyp,visitTyconRefOpt,visitAppTyOpt,visitTraitSolutionOpt, visitTyparOpt) as f) g env typ =

// We iterate the _solved_ constraints as well, to pick up any record of trait constraint solutions

// This means we walk _all_ the constraints _everywhere_ in a type, including

// those attached to _solved_ type variables. This is used by PostTypeCheckSemanticChecks to detect uses of

// values as solutions to trait constraints and determine if inference has caused the value to escape its scope.

// The only record of these solutions is in the _solved_ constraints of types.

// In an ideal world we would, instead, record the solutions to these constraints as "witness variables" in expressions,

// rather than solely in types.

match typ with

| TType_var tp when tp.Solution.IsSome ->

tp.Constraints |> List.iter (fun cx ->

match cx with

| TyparConstraint.MayResolveMember((TTrait(_,_,_,_,_,soln)),_) ->

match visitTraitSolutionOpt, !soln with

| Some visitTraitSolution, Some sln -> visitTraitSolution sln

| _ -> ()

| _ -> ())

| _ -> ()

let typ = stripTyparEqns typ

visitTyp typ

match typ with

| TType_forall (tps,body) ->

let env = BindTypars g env tps

CheckTypeDeep f g env body

tps |> List.iter (fun tp -> tp.Constraints |> List.iter (CheckTypeConstraintDeep f g env))

| TType_measure _ -> ()

| TType_app (tcref,tinst) ->

match visitTyconRefOpt with

| Some visitTyconRef -> visitTyconRef tcref

| None -> ()

CheckTypesDeep f g env tinst

match visitAppTyOpt with

| Some visitAppTy -> visitAppTy (tcref, tinst)

| None -> ()

| TType_ucase (_,tinst) -> CheckTypesDeep f g env tinst

| TType_tuple (_,typs) -> CheckTypesDeep f g env typs

| TType_fun (s,t) -> CheckTypeDeep f g env s; CheckTypeDeep f g env t

| TType_var tp ->

if not tp.IsSolved then

match visitTyparOpt with

| None -> ()

| Some visitTypar ->

visitTypar (env,tp)

and CheckTypesDeep f g env tys = List.iter (CheckTypeDeep f g env) tys

and CheckTypeConstraintDeep f g env x =

match x with

| TyparConstraint.CoercesTo(ty,_) -> CheckTypeDeep f g env ty

| TyparConstraint.MayResolveMember(traitInfo,_) -> CheckTraitInfoDeep f g env traitInfo

| TyparConstraint.DefaultsTo(_,ty,_) -> CheckTypeDeep f g env ty

| TyparConstraint.SimpleChoice(tys,_) -> CheckTypesDeep f g env tys

| TyparConstraint.IsEnum(uty,_) -> CheckTypeDeep f g env uty

| TyparConstraint.IsDelegate(aty,bty,_) -> CheckTypeDeep f g env aty; CheckTypeDeep f g env bty

| TyparConstraint.SupportsComparison _

| TyparConstraint.SupportsEquality _

| TyparConstraint.SupportsNull _

| TyparConstraint.IsNonNullableStruct _

| TyparConstraint.IsUnmanaged _

| TyparConstraint.IsReferenceType _

| TyparConstraint.RequiresDefaultConstructor _ -> ()

and CheckTraitInfoDeep ((_,_,_,visitTraitSolutionOpt,_) as f) g env (TTrait(typs,_,_,argtys,rty,soln)) =

CheckTypesDeep f g env typs

CheckTypesDeep f g env argtys

Option.iter (CheckTypeDeep f g env) rty

match visitTraitSolutionOpt, !soln with

| Some visitTraitSolution, Some sln -> visitTraitSolution sln

| _ -> ()

let CheckForByrefLikeType cenv env typ check =

CheckTypeDeep (ignore, Some (fun tcref -> if isByrefLikeTyconRef cenv.g tcref then check()), None, None, None) cenv.g env typ

let CheckEscapes cenv allowProtected m syntacticArgs body = (* m is a range suited to error reporting *)

if cenv.reportErrors then

let cantBeFree v =

// First, if v is a syntactic argument, then it can be free since it was passed in.

// The following can not be free:

// a) BaseVal can never escape.

// b) Byref typed values can never escape.

// Note that: Local mutables can be free, as they will be boxed later.

// These checks must correspond to the tests governing the error messages below.

let passedIn = ListSet.contains valEq v syntacticArgs

if passedIn then

false

else

(v.BaseOrThisInfo = BaseVal) ||

(isByrefLikeTy cenv.g v.Type)

let frees = freeInExpr CollectLocals body

let fvs = frees.FreeLocals

if not allowProtected && frees.UsesMethodLocalConstructs then

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

elif Zset.exists cantBeFree fvs then

let v = List.find cantBeFree (Zset.elements fvs)

(* byref error before mutable error (byrefs are mutable...). *)

if (isByrefLikeTy cenv.g v.Type) then

// Inner functions are not guaranteed to compile to method with a predictable arity (number of arguments).

// As such, partial applications involving byref arguments could lead to closures containing byrefs.

// For safety, such functions are assumed to have no known arity, and so can not accept byrefs.

errorR(Error(FSComp.SR.chkByrefUsedInInvalidWay(v.DisplayName), m))

elif v.BaseOrThisInfo = BaseVal then

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

else

(* Should be dead code, unless governing tests change *)

errorR(InternalError(FSComp.SR.chkVariableUsedInInvalidWay(v.DisplayName), m))

Some frees

else

None

let AccessInternalsVisibleToAsInternal thisCompPath internalsVisibleToPaths access =

// Each internalsVisibleToPath is a compPath for the internals of some assembly.

// Replace those by the compPath for the internals of this assembly.

// This makes those internals visible here, but still internal. Bug://3737

(access,internalsVisibleToPaths) ||> List.fold (fun access internalsVisibleToPath ->

accessSubstPaths (thisCompPath,internalsVisibleToPath) access)

let CheckTypeForAccess (cenv:cenv) env objName valAcc m ty =

if cenv.reportErrors then

let visitType ty =

// We deliberately only check the fully stripped type for accessibility,

// because references to private type abbreviations are permitted

match tryDestAppTy cenv.g ty with

| None -> ()

| Some tcref ->

let thisCompPath = compPathOfCcu cenv.viewCcu

let tyconAcc = tcref.Accessibility |> AccessInternalsVisibleToAsInternal thisCompPath cenv.internalsVisibleToPaths

if isLessAccessible tyconAcc valAcc then

errorR(Error(FSComp.SR.chkTypeLessAccessibleThanType(tcref.DisplayName, (objName())), m))

CheckTypeDeep (visitType, None, None, None, None) cenv.g env ty

let WarnOnWrongTypeForAccess (cenv:cenv) env objName valAcc m ty =

if cenv.reportErrors then

let visitType ty =

// We deliberately only check the fully stripped type for accessibility,

// because references to private type abbreviations are permitted

match tryDestAppTy cenv.g ty with

| None -> ()

| Some tcref ->

let thisCompPath = compPathOfCcu cenv.viewCcu

let tyconAcc = tcref.Accessibility |> AccessInternalsVisibleToAsInternal thisCompPath cenv.internalsVisibleToPaths

if isLessAccessible tyconAcc valAcc then

let errorText = FSComp.SR.chkTypeLessAccessibleThanType(tcref.DisplayName, (objName())) |> snd

let warningText = errorText + System.Environment.NewLine + FSComp.SR.tcTypeAbbreviationsCheckedAtCompileTime()

warning(AttributeChecking.ObsoleteWarning(warningText, m))

CheckTypeDeep (visitType, None, None, None, None) cenv.g env ty

let CheckType permitByrefs (cenv:cenv) env m ty =

if cenv.reportErrors then

let visitTypar (env,tp) =

if not (env.boundTypars.ContainsKey tp) then

if tp.IsCompilerGenerated then

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

else

errorR (Error(FSComp.SR.checkNotSufficientlyGenericBecauseOfScope(tp.DisplayName),m))

let visitTyconRef tcref =

if not permitByrefs && isByrefLikeTyconRef cenv.g tcref then

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

if tyconRefEq cenv.g cenv.g.system_Void_tcref tcref then

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

// check if T contains byref types in case of byref<T>

let visitAppTy (tcref,tinst) =

if isByrefLikeTyconRef cenv.g tcref then

let visitType ty0 =

match tryDestAppTy cenv.g ty0 with

| None -> ()

| Some tcref ->

if isByrefLikeTyconRef cenv.g tcref then

errorR(Error(FSComp.SR.chkNoByrefsOfByrefs(NicePrint.minimalStringOfType cenv.denv ty), m))

CheckTypesDeep (visitType, None, None, None, None) cenv.g env tinst

let visitTraitSolution info =

match info with

| FSMethSln(_,vref,_) ->

//printfn "considering %s..." vref.DisplayName

if valRefInThisAssembly cenv.g.compilingFslib vref && not (cenv.boundVals.ContainsKey(vref.Stamp)) then

//printfn "recording %s..." vref.DisplayName

cenv.potentialUnboundUsesOfVals <- cenv.potentialUnboundUsesOfVals.Add(vref.Stamp,m)

| _ -> ()

CheckTypeDeep (ignore, Some visitTyconRef, Some visitAppTy, Some visitTraitSolution, Some visitTypar) cenv.g env ty

let CheckTypeNoByrefs (cenv:cenv) env m ty = CheckType false cenv env m ty

let CheckTypePermitByrefs (cenv:cenv) env m ty = CheckType true cenv env m ty

let CheckTypeInstNoByrefs cenv env m tyargs =

tyargs |> List.iter (CheckTypeNoByrefs cenv env m)

let CheckTypeInstPermitByrefs cenv env m tyargs =

tyargs |> List.iter (CheckType true cenv env m)

type ByrefContext =

/// Tuple of arguments where elements can be byrefs

| TupleOfArgsPermitByrefs of int

/// Context allows for byref typed expr. Flag indicates if this is a byref-return position

| PermitByref of isReturn: bool

/// General (byref type expr not allowed)

| NoByrefs

let noByrefs context = match context with PermitByref _ -> false | _ -> true

let mkArgsPermitByrefs isByrefReturnCall n =

if n=1 then PermitByref isByrefReturnCall

else TupleOfArgsPermitByrefs n

let mkArgsForAppliedVal isByrefReturnCall (vref:ValRef) =

match vref.ValReprInfo with

| Some topValInfo -> List.map (mkArgsPermitByrefs isByrefReturnCall) topValInfo.AritiesOfArgs

| None -> []

let rec mkArgsForAppliedExpr isByrefReturnCall x =

match x with

// recognise val

| Expr.Val (vref,_,_) -> mkArgsForAppliedVal isByrefReturnCall vref

// step through reclink

| Expr.Link eref -> mkArgsForAppliedExpr isByrefReturnCall !eref

// step through instantiations

| Expr.App(f,_fty,_tyargs,[],_) -> mkArgsForAppliedExpr isByrefReturnCall f

// step through subsumption coercions

| Expr.Op(TOp.Coerce,_,[f],_) -> mkArgsForAppliedExpr isByrefReturnCall f

| _ -> []

let (|OptionalCoerce|) = function

| Expr.Op(TOp.Coerce _, _, [Expr.App(f, _, _, [], _)], _) -> f

| x -> x

let CheckNoReraise cenv freesOpt (body:Expr) =

if cenv.reportErrors then

// Avoid recomputing the free variables

let fvs = match freesOpt with None -> freeInExpr CollectLocals body | Some fvs -> fvs

if fvs.UsesUnboundRethrow then

errorR(Error(FSComp.SR.chkErrorContainsCallToRethrow(), body.Range))

let isSpliceOperator g v = valRefEq g v g.splice_expr_vref || valRefEq g v g.splice_raw_expr_vref

let CheckMultipleInterfaceInstantiations cenv interfaces m =

let keyf ty = assert isAppTy cenv.g ty; (tcrefOfAppTy cenv.g ty).Stamp

let table = interfaces |> MultiMap.initBy keyf

let firstInterfaceWithMultipleGenericInstantiations =

interfaces |> List.tryPick (fun typ1 ->

table |> MultiMap.find (keyf typ1) |> List.tryPick (fun typ2 ->

if // same nominal type

tyconRefEq cenv.g (tcrefOfAppTy cenv.g typ1) (tcrefOfAppTy cenv.g typ2) &&

// different instantiations

not (typeEquivAux EraseNone cenv.g typ1 typ2)

then Some (typ1,typ2)

else None))

match firstInterfaceWithMultipleGenericInstantiations with

| None -> ()

| Some (typ1,typ2) ->

errorR(Error(FSComp.SR.chkMultipleGenericInterfaceInstantiations((NicePrint.minimalStringOfType cenv.denv typ1), (NicePrint.minimalStringOfType cenv.denv typ2)),m))

let rec CheckExprNoByrefs (cenv:cenv) (env:env) expr =

CheckExpr cenv env expr NoByrefs

and CheckVal (cenv:cenv) (env:env) v m context =

if cenv.reportErrors then

if isSpliceOperator cenv.g v && not env.quote then errorR(Error(FSComp.SR.chkSplicingOnlyInQuotations(), m))

if isSpliceOperator cenv.g v then errorR(Error(FSComp.SR.chkNoFirstClassSplicing(), m))

if valRefEq cenv.g v cenv.g.addrof_vref then errorR(Error(FSComp.SR.chkNoFirstClassAddressOf(), m))

if valRefEq cenv.g v cenv.g.reraise_vref then errorR(Error(FSComp.SR.chkNoFirstClassRethrow(), m))

if noByrefs context && isByrefLikeTy cenv.g v.Type then

// byref typed val can only occur in permitting contexts

errorR(Error(FSComp.SR.chkNoByrefAtThisPoint(v.DisplayName), m))

CheckTypePermitByrefs cenv env m v.Type

and CheckExpr (cenv:cenv) (env:env) expr (context:ByrefContext) =

let expr = stripExpr expr

match expr with

| Expr.Sequential (e1,e2,dir,_,_) ->

CheckExprNoByrefs cenv env e1

match dir with

| NormalSeq -> CheckExpr cenv env e2 context // carry context into _;RHS (normal sequencing only)

| ThenDoSeq -> CheckExprNoByrefs cenv {env with limited=false} e2

| Expr.Let (bind,body,_,_) ->

CheckBinding cenv env false bind

BindVal cenv bind.Var

CheckExpr cenv env body context

| Expr.Const (_,m,ty) ->

CheckTypePermitByrefs cenv env m ty

| Expr.Val (v,vFlags,m) ->

if cenv.reportErrors then

if v.BaseOrThisInfo = BaseVal then

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

if (match vFlags with NormalValUse -> true | _ -> false) &&

v.IsConstructor &&

(match v.ActualParent with Parent tcref -> isAbstractTycon tcref.Deref | _ -> false) then

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

if isByrefTy cenv.g v.Type &&

// A byref return location...

(match context with PermitByref isReturn -> isReturn | _ -> false) &&

// The value is a local....

v.ValReprInfo.IsNone &&

// The value is not an argument...

not (env.argVals.ContainsVal(v.Deref)) then

errorR(Error(FSComp.SR.chkNoByrefReturnOfLocal(v.DisplayName), m))

CheckVal cenv env v m context

| Expr.Quote(ast,savedConv,_isFromQueryExpression,m,ty) ->

CheckExprNoByrefs cenv {env with quote=true} ast

if cenv.reportErrors then

cenv.usesQuotations <- true

try

let qscope = QuotationTranslator.QuotationGenerationScope.Create (cenv.g,cenv.amap,cenv.viewCcu, QuotationTranslator.IsReflectedDefinition.No)

let qdata = QuotationTranslator.ConvExprPublic qscope QuotationTranslator.QuotationTranslationEnv.Empty ast

let typeDefs,spliceTypes,spliceExprs = qscope.Close()

match savedConv.Value with

| None -> savedConv:= Some (typeDefs, List.map fst spliceTypes, List.map fst spliceExprs, qdata)

| Some _ -> ()

with QuotationTranslator.InvalidQuotedTerm e ->

errorRecovery e m

CheckTypeNoByrefs cenv env m ty

| Expr.Obj (_,typ,basev,superInitCall,overrides,iimpls,m) ->

CheckExprNoByrefs cenv env superInitCall

CheckMethods cenv env basev overrides

CheckInterfaceImpls cenv env basev iimpls

CheckTypePermitByrefs cenv env m typ

let interfaces =

[ if isInterfaceTy cenv.g typ then

yield! AllSuperTypesOfType cenv.g cenv.amap m AllowMultiIntfInstantiations.Yes typ

for (ty,_) in iimpls do

yield! AllSuperTypesOfType cenv.g cenv.amap m AllowMultiIntfInstantiations.Yes ty ]

|> List.filter (isInterfaceTy cenv.g)

CheckMultipleInterfaceInstantiations cenv interfaces m

// Allow base calls to F# methods

| Expr.App((InnerExprPat(ExprValWithPossibleTypeInst(v,vFlags,_,_) as f)),fty,tyargs,(Expr.Val(baseVal,_,_) :: rest),m)

when ((match vFlags with VSlotDirectCall -> true | _ -> false) &&

baseVal.BaseOrThisInfo = BaseVal) ->

// dprintfn "GOT BASE VAL USE"

let memberInfo = Option.get v.MemberInfo

if memberInfo.MemberFlags.IsDispatchSlot then

errorR(Error(FSComp.SR.tcCannotCallAbstractBaseMember(v.DisplayName),m))

else

CheckVal cenv env v m NoByrefs

CheckVal cenv env baseVal m NoByrefs

CheckTypePermitByrefs cenv env m fty

CheckTypeInstPermitByrefs cenv env m tyargs

CheckExprs cenv env rest (List.tail (mkArgsForAppliedExpr false f))

// Allow base calls to IL methods

| Expr.Op (TOp.ILCall (virt,_,_,_,_,_,_,mref,enclTypeArgs,methTypeArgs,tys),tyargs,(Expr.Val(baseVal,_,_)::rest),m)

when not virt && baseVal.BaseOrThisInfo = BaseVal ->

// Disallow calls to abstract base methods on IL types.

match tryDestAppTy cenv.g baseVal.Type with

| Some tcref when tcref.IsILTycon ->

try

// This is awkward - we have to explicitly re-resolve back to the IL metadata to determine if the method is abstract.

// We believe this may be fragile in some situations, since we are using the Abstract IL code to compare

// type equality, and it would be much better to remove any F# dependency on that implementation of IL type

// equality. It would be better to make this check in tc.fs when we have the Abstract IL metadata for the method to hand.

let mdef = resolveILMethodRef tcref.ILTyconRawMetadata mref

if mdef.IsAbstract then

errorR(Error(FSComp.SR.tcCannotCallAbstractBaseMember(mdef.Name),m))

with _ -> () // defensive coding

| _ -> ()

CheckTypeInstNoByrefs cenv env m tyargs

CheckTypeInstNoByrefs cenv env m enclTypeArgs

CheckTypeInstNoByrefs cenv env m methTypeArgs

CheckTypeInstNoByrefs cenv env m tys

CheckVal cenv env baseVal m NoByrefs

CheckExprsPermitByrefs cenv env rest

| Expr.Op (c,tyargs,args,m) ->

CheckExprOp cenv env (c,tyargs,args,m) context

// Allow 'typeof<System.Void>' calls as a special case, the only accepted use of System.Void!

| TypeOfExpr cenv.g ty when isVoidTy cenv.g ty ->

() // typeof<System.Void> allowed. Special case. No further checks.

| TypeDefOfExpr cenv.g ty when isVoidTy cenv.g ty ->

() // typedefof<System.Void> allowed. Special case. No further checks.

// Allow '%expr' in quotations

| Expr.App(Expr.Val(vref,_,_),_,tinst,[arg],m) when isSpliceOperator cenv.g vref && env.quote ->

CheckTypeInstPermitByrefs cenv env m tinst

CheckExprNoByrefs cenv env arg

| Expr.App(f,fty,tyargs,argsl,m) ->

if cenv.reportErrors then

let g = cenv.g

match f with

| OptionalCoerce(Expr.Val(v, _, funcRange))

when (valRefEq g v g.raise_vref || valRefEq g v g.failwith_vref || valRefEq g v g.null_arg_vref || valRefEq g v g.invalid_op_vref) ->

match argsl with

| [] | [_] -> ()

| _ :: _ :: _ ->

warning(Error(FSComp.SR.checkRaiseFamilyFunctionArgumentCount(v.DisplayName, 1, List.length argsl), funcRange))

| OptionalCoerce(Expr.Val(v, _, funcRange)) when valRefEq g v g.invalid_arg_vref ->

match argsl with

| [] | [_] | [_; _] -> ()

| _ :: _ :: _ :: _ ->

warning(Error(FSComp.SR.checkRaiseFamilyFunctionArgumentCount(v.DisplayName, 2, List.length argsl), funcRange))

| OptionalCoerce(Expr.Val(failwithfFunc, _, funcRange)) when valRefEq g failwithfFunc g.failwithf_vref ->

match argsl with

| Expr.App (Expr.Val(newFormat, _, _), _, [_; typB; typC; _; _], [Expr.Const(Const.String formatString, formatRange, _)], _) :: xs when valRefEq g newFormat g.new_format_vref ->

match CheckFormatStrings.TryCountFormatStringArguments formatRange g formatString typB typC with

| Some n ->

let expected = n + 1

let actual = List.length xs + 1

if expected < actual then

warning(Error(FSComp.SR.checkRaiseFamilyFunctionArgumentCount(failwithfFunc.DisplayName, expected, actual), funcRange))

| None -> ()

| _ ->

()

| _ ->

()

CheckTypeInstNoByrefs cenv env m tyargs

CheckTypePermitByrefs cenv env m fty

CheckTypeInstPermitByrefs cenv env m tyargs

CheckExprNoByrefs cenv env f

let isByrefReturnCall =

// if return is a byref, and being used as a return, then all arguments must be usable as byref returns

match context with

| PermitByref true when isByrefTy cenv.g (tyOfExpr cenv.g expr) -> true

| _ -> false

CheckExprs cenv env argsl (mkArgsForAppliedExpr isByrefReturnCall f)

// REVIEW: fold the next two cases together

| Expr.Lambda(_,_ctorThisValOpt,_baseValOpt,argvs,_,m,rty) ->

let topValInfo = ValReprInfo ([],[argvs |> List.map (fun _ -> ValReprInfo.unnamedTopArg1)],ValReprInfo.unnamedRetVal)

let ty = mkMultiLambdaTy m argvs rty in

CheckLambdas false None cenv env false topValInfo false expr m ty

| Expr.TyLambda(_,tps,_,m,rty) ->

let topValInfo = ValReprInfo (ValReprInfo.InferTyparInfo tps,[],ValReprInfo.unnamedRetVal)

let ty = tryMkForallTy tps rty in

CheckLambdas false None cenv env false topValInfo false expr m ty

| Expr.TyChoose(tps,e1,_) ->

let env = BindTypars cenv.g env tps

CheckExprNoByrefs cenv env e1

| Expr.Match(_,_,dtree,targets,m,ty) ->

CheckTypePermitByrefs cenv env m ty // computed byrefs allowed at each branch

CheckDecisionTree cenv env dtree

CheckDecisionTreeTargets cenv env targets context

| Expr.LetRec (binds,e,_,_) ->

BindVals cenv (valsOfBinds binds)

CheckBindings cenv env binds

CheckExprNoByrefs cenv env e

| Expr.StaticOptimization (constraints,e2,e3,m) ->

CheckExprNoByrefs cenv env e2

CheckExprNoByrefs cenv env e3

constraints |> List.iter (function

| TTyconEqualsTycon(ty1,ty2) ->

CheckTypeNoByrefs cenv env m ty1

CheckTypeNoByrefs cenv env m ty2

| TTyconIsStruct(ty1) ->

CheckTypeNoByrefs cenv env m ty1)

| Expr.Link _ ->

failwith "Unexpected reclink"

and CheckMethods cenv env baseValOpt l =

l |> List.iter (CheckMethod cenv env baseValOpt)

and CheckMethod cenv env baseValOpt (TObjExprMethod(_,attribs,tps,vs,body,m)) =

let env = BindTypars cenv.g env tps

let vs = List.concat vs

CheckAttribs cenv env attribs

CheckNoReraise cenv None body

CheckEscapes cenv true m (match baseValOpt with Some x -> x:: vs | None -> vs) body |> ignore

CheckExprPermitByref cenv env body

and CheckInterfaceImpls cenv env baseValOpt l =

l |> List.iter (CheckInterfaceImpl cenv env baseValOpt)

and CheckInterfaceImpl cenv env baseValOpt (_ty,overrides) =

CheckMethods cenv env baseValOpt overrides

and CheckExprOp cenv env (op,tyargs,args,m) context =

let limitedCheck() =

if env.limited then errorR(Error(FSComp.SR.chkObjCtorsCantUseExceptionHandling(), m))

List.iter (CheckTypePermitByrefs cenv env m) tyargs

(* Special cases *)

match op,tyargs,args with

// Handle these as special cases since mutables are allowed inside their bodies

| TOp.While _,_,[Expr.Lambda(_,_,_,[_],e1,_,_);Expr.Lambda(_,_,_,[_],e2,_,_)] ->

CheckTypeInstNoByrefs cenv env m tyargs

CheckExprsNoByrefs cenv env [e1;e2]

| TOp.TryFinally _,[_],[Expr.Lambda(_,_,_,[_],e1,_,_); Expr.Lambda(_,_,_,[_],e2,_,_)] ->

CheckTypeInstPermitByrefs cenv env m tyargs // result of a try/finally can be a byref

limitedCheck()

CheckExpr cenv env e1 context // result of a try/finally can be a byref if in a position where the overall expression is can be a byref

CheckExprNoByrefs cenv env e2

| TOp.For(_),_,[Expr.Lambda(_,_,_,[_],e1,_,_);Expr.Lambda(_,_,_,[_],e2,_,_);Expr.Lambda(_,_,_,[_],e3,_,_)] ->

CheckTypeInstNoByrefs cenv env m tyargs

CheckExprsNoByrefs cenv env [e1;e2;e3]

| TOp.TryCatch _,[_],[Expr.Lambda(_,_,_,[_],e1,_,_); Expr.Lambda(_,_,_,[_],_e2,_,_); Expr.Lambda(_,_,_,[_],e3,_,_)] ->

CheckTypeInstPermitByrefs cenv env m tyargs // result of a try/catch can be a byref

limitedCheck()

CheckExpr cenv env e1 context // result of a try/catch can be a byref if in a position where the overall expression is can be a byref

// [(* e2; -- don't check filter body - duplicates logic in 'catch' body *) e3]

CheckExpr cenv env e3 context // result of a try/catch can be a byref if in a position where the overall expression is can be a byref

| TOp.ILCall (_,_,_,_,_,_,_,_,enclTypeArgs,methTypeArgs,tys),_,_ ->

CheckTypeInstNoByrefs cenv env m tyargs

CheckTypeInstNoByrefs cenv env m enclTypeArgs

CheckTypeInstNoByrefs cenv env m methTypeArgs

CheckTypeInstPermitByrefs cenv env m tys // permit byref returns

// if return is a byref, and being used as a return, then all arguments must be usable as byref returns

match context,tys with

| PermitByref true, [ty] when isByrefTy cenv.g ty -> CheckExprsPermitByrefReturns cenv env args

| _ -> CheckExprsPermitByrefs cenv env args

| TOp.Tuple tupInfo,_,_ when not (evalTupInfoIsStruct tupInfo) ->

match context with

| TupleOfArgsPermitByrefs nArity ->

if cenv.reportErrors then

if args.Length <> nArity then

errorR(InternalError("Tuple arity does not correspond to planned function argument arity",m))

// This tuple should not be generated. The known function arity

// means it just bundles arguments.

CheckExprsPermitByrefs cenv env args

| _ ->

CheckTypeInstNoByrefs cenv env m tyargs

CheckExprsNoByrefs cenv env args

| TOp.LValueOp(LGetAddr,v),_,_ ->

if cenv.reportErrors then

if noByrefs context && cenv.reportErrors then

errorR(Error(FSComp.SR.chkNoAddressOfAtThisPoint(v.DisplayName), m))

elif (// The context is a byref return....

match context with PermitByref isReturn -> isReturn | _ -> false) &&

// The value is a local....

v.ValReprInfo.IsNone &&

// The value is not an argument...

not (env.argVals.ContainsVal(v.Deref)) then

errorR(Error(FSComp.SR.chkNoByrefReturnOfLocal(v.DisplayName), m))

// Address-of operator generates byref, and context permits this.

CheckExprsNoByrefs cenv env args

| TOp.TupleFieldGet _,_,[arg1] ->

CheckTypeInstNoByrefs cenv env m tyargs

CheckExprsPermitByrefs cenv env [arg1] (* Compiled pattern matches on immutable value structs come through here. *)

| TOp.ValFieldGet _rf,_,[arg1] ->

CheckTypeInstNoByrefs cenv env m tyargs

//See mkRecdFieldGetViaExprAddr -- byref arg1 when #args =1

// Property getters on mutable structs come through here.

CheckExprsPermitByrefs cenv env [arg1]

| TOp.ValFieldSet _rf,_,[arg1;arg2] ->

CheckTypeInstNoByrefs cenv env m tyargs

// See mkRecdFieldSetViaExprAddr -- byref arg1 when #args=2

// Field setters on mutable structs come through here

CheckExprsPermitByrefs cenv env [arg1]

CheckExprsNoByrefs cenv env [arg2]

| TOp.Coerce,[_ty1;_ty2],[x] ->

// Subsumption coercions of functions may involve byrefs in other argument positions

CheckTypeInstPermitByrefs cenv env m tyargs

CheckExpr cenv env x context

| TOp.Reraise,[_ty1],[] ->

CheckTypeInstNoByrefs cenv env m tyargs

| TOp.ValFieldGetAddr rfref,tyargs,[] ->

if noByrefs context && cenv.reportErrors then

errorR(Error(FSComp.SR.chkNoAddressStaticFieldAtThisPoint(rfref.FieldName), m))

CheckTypeInstNoByrefs cenv env m tyargs

// NOTE: there are no arg exprs to check in this case

| TOp.ValFieldGetAddr rfref,tyargs,[rx] ->

if noByrefs context && cenv.reportErrors then

errorR(Error(FSComp.SR.chkNoAddressFieldAtThisPoint(rfref.FieldName), m))

// This construct is used for &(rx.rfield) and &(rx->rfield). Relax to permit byref types for rx. [See Bug 1263].

CheckTypeInstNoByrefs cenv env m tyargs

CheckExprPermitByref cenv env rx

| TOp.UnionCaseFieldGet _,_,[arg1] ->

CheckTypeInstNoByrefs cenv env m tyargs

CheckExprPermitByref cenv env arg1

| TOp.UnionCaseTagGet _,_,[arg1] ->

CheckTypeInstNoByrefs cenv env m tyargs

CheckExprPermitByref cenv env arg1 // allow byref - it may be address-of-struct

| TOp.UnionCaseFieldGetAddr (uref, _idx),tyargs,[rx] ->

if noByrefs context && cenv.reportErrors then

errorR(Error(FSComp.SR.chkNoAddressFieldAtThisPoint(uref.CaseName), m))

CheckTypeInstNoByrefs cenv env m tyargs

// allow rx to be byref here, for struct unions

CheckExprPermitByref cenv env rx

| TOp.ILAsm (instrs,tys),_,_ ->

CheckTypeInstPermitByrefs cenv env m tys

CheckTypeInstNoByrefs cenv env m tyargs

match instrs,args with

| [ I_stfld (_alignment,_vol,_fspec) ],[lhs;rhs] ->

// permit byref for lhs lvalue

CheckExprPermitByref cenv env lhs

CheckExprNoByrefs cenv env rhs

| [ I_ldfld (_alignment,_vol,_fspec) ],[lhs] ->

// permit byref for lhs lvalue

CheckExprPermitByref cenv env lhs

| [ I_ldfld (_alignment,_vol,_fspec); AI_nop ],[lhs] ->

// permit byref for lhs lvalue of readonly value

CheckExprPermitByref cenv env lhs

| [ I_ldflda (fspec) | I_ldsflda (fspec) ],[lhs] ->

if noByrefs context && cenv.reportErrors then

errorR(Error(FSComp.SR.chkNoAddressFieldAtThisPoint(fspec.Name), m))

// permit byref for lhs lvalue

CheckExprPermitByref cenv env lhs

| [ I_ldelema (_,isNativePtr,_,_) ],lhsArray::indices ->

if not(isNativePtr) && noByrefs context && cenv.reportErrors then

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

// permit byref for lhs lvalue

CheckExprPermitByref cenv env lhsArray

CheckExprsNoByrefs cenv env indices

| [ AI_conv _ ],_ ->

// permit byref for args to conv

CheckExprsPermitByrefs cenv env args

| _ ->

CheckExprsNoByrefs cenv env args

| TOp.TraitCall _,_,_ ->

CheckTypeInstNoByrefs cenv env m tyargs

// allow args to be byref here

CheckExprsPermitByrefs cenv env args

| ( TOp.Tuple _

| TOp.UnionCase _

| TOp.ExnConstr _

| TOp.Array

| TOp.Bytes _

| TOp.UInt16s _

| TOp.Recd _

| TOp.ValFieldSet _

| TOp.UnionCaseTagGet _

| TOp.UnionCaseProof _

| TOp.UnionCaseFieldGet _

| TOp.UnionCaseFieldSet _

| TOp.ExnFieldGet _

| TOp.ExnFieldSet _

| TOp.TupleFieldGet _

| TOp.RefAddrGet

| _ (* catch all! *)

),_,_ ->

CheckTypeInstNoByrefs cenv env m tyargs

CheckExprsNoByrefs cenv env args

and CheckLambdas isTop (memInfo: ValMemberInfo option) cenv env inlined topValInfo alwaysCheckNoReraise e m ety =

// The topValInfo here says we are _guaranteeing_ to compile a function value

// as a .NET method with precisely the corresponding argument counts.

match e with

| Expr.TyChoose(tps,e1,m) ->

let env = BindTypars cenv.g env tps

CheckLambdas isTop memInfo cenv env inlined topValInfo alwaysCheckNoReraise e1 m ety

| Expr.Lambda (_,_,_,_,_,m,_)

| Expr.TyLambda(_,_,_,m,_) ->

let tps,ctorThisValOpt,baseValOpt,vsl,body,bodyty = destTopLambda cenv.g cenv.amap topValInfo (e, ety) in

let env = BindTypars cenv.g env tps

let thisAndBase = Option.toList ctorThisValOpt @ Option.toList baseValOpt

let restArgs = List.concat vsl

let syntacticArgs = thisAndBase @ restArgs

let env = SetArgVals env restArgs

match memInfo with

| None -> ()

| Some mi ->

// ctorThis and baseVal values are always considered used

for v in thisAndBase do v.SetHasBeenReferenced()

// instance method 'this' is always considered used

match mi.MemberFlags.IsInstance, restArgs with

| true, firstArg::_ -> firstArg.SetHasBeenReferenced()

| _ -> ()

// any byRef arguments are considered used, as they may be 'out's

restArgs |> List.iter (fun arg -> if isByrefTy cenv.g arg.Type then arg.SetHasBeenReferenced())

syntacticArgs |> List.iter (CheckValSpec cenv env)

syntacticArgs |> List.iter (BindVal cenv)

// Trigger a test hook

match memInfo with

| None -> ()

| Some membInfo -> testHookMemberBody membInfo body

// Check escapes in the body. Allow access to protected things within members.

let freesOpt = CheckEscapes cenv (Option.isSome memInfo) m syntacticArgs body

// no reraise under lambda expression

CheckNoReraise cenv freesOpt body

// Check the body of the lambda

if (not (List.isEmpty tps) || not (List.isEmpty vsl)) && isTop && not cenv.g.compilingFslib && isByrefTy cenv.g bodyty then

// allow byref to occur as return position for byref-typed top level function or method

CheckExprPermitByrefReturn cenv env body

else

CheckExprNoByrefs cenv env body

// Check byref return types

if cenv.reportErrors then

if (not inlined && (List.isEmpty tps && List.isEmpty vsl)) || not isTop then

CheckForByrefLikeType cenv env bodyty (fun () ->

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

elif not cenv.g.compilingFslib && isByrefTy cenv.g bodyty then

// check no byrefs-in-the-byref

CheckForByrefLikeType cenv env (destByrefTy cenv.g bodyty) (fun () ->

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

for tp in tps do

if tp.Constraints |> List.sumBy (function TyparConstraint.CoercesTo(ty,_) when isClassTy cenv.g ty -> 1 | _ -> 0) > 1 then

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

// This path is for expression bindings that are not actually lambdas

| _ ->

// Permit byrefs for let x = ...

CheckTypePermitByrefs cenv env m ety

if not inlined && isByrefLikeTy cenv.g ety then

// allow byref to occur as RHS of byref binding.

CheckExprPermitByref cenv env e

else

CheckExprNoByrefs cenv env e

if alwaysCheckNoReraise then

CheckNoReraise cenv None e

and CheckExprs cenv env exprs contexts =

let contexts = Array.ofList contexts

let argArity i = if i < contexts.Length then contexts.[i] else NoByrefs

exprs |> List.iteri (fun i exp -> CheckExpr cenv env exp (argArity i))

and CheckExprsNoByrefs cenv env exprs =

exprs |> List.iter (CheckExprNoByrefs cenv env)