/// This "special" node is immediately eliminated by the use of IteratedFlexibleAdjustArityOfLambdaBody as soon as we

/// first transform the tree (currently in optimization)

let MakeApplicableExprWithFlex cenv (env: TcEnv)compatexpr =

let MakeApplicableExprWithFlex cenv (env: TcEnv) expr =

let exprTy = tyOfExpr cenv.g expr

let m = expr.Range

let isNonFlexibleType ty = isSealedTy cenv.g ty

let argTys, retTy = stripFunTy cenv.g exprTy

let curriedActualTypes = argTys |> List.map (tryDestRefTupleTy cenv.g)

let noFlexInserted =

(curriedActualTypes.IsEmpty ||

curriedActualTypes |> List.exists (List.exists (isByrefTy cenv.g)) ||

curriedActualTypes |> List.forall (List.forall isNonFlexibleType))

if noFlexInserted then

if (curriedActualTypes.IsEmpty ||

curriedActualTypes |> List.exists (List.exists (isByrefTy cenv.g)) ||

curriedActualTypes |> List.forall (List.forall isNonFlexibleType)) then

ApplicableExpr (cenv, expr, true)

else

let curriedFlexibleTypes =

curriedActualTypes |> List.mapSquared (fun actualType ->

if isNonFlexibleType actualType then

actualType

if isNonFlexibleType actualType

then actualType

else

let flexibleType = NewInferenceType ()

// For backwards compatibility mark some extra flexibility points as IsCompatFlex, meaning that the

// type variable will not be generalized

if compat then

let tp = destTyparTy cenv.g flexibleType

tp.SetIsCompatFlex(true)

AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css m NoTrace actualType flexibleType

AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css m NoTrace actualType flexibleType;

flexibleType)

// Create a coercion to represent the expansion of the application

let args = match args with SynConstructorArgs.Pats args -> args | _ -> error(Error(FSComp.SR.tcNamedActivePattern(apinfo.ActiveTags.[idx]), m))

// TOTAL/PARTIAL ACTIVE PATTERNS

let _, vexp, _, _, tinst, _ = TcVal true cenv env tpenv vref None None m

let vexp = MakeApplicableExprWithFlex cenv envfalsevexp

let vexp = MakeApplicableExprWithFlex cenv env vexp

let vexpty = vexp.Type

let activePatArgsAsSynPats, patarg =

and TcExprFlex cenv flex compat ty (env: TcEnv) tpenv (e: SynExpr) =

if flex then

let argty = NewInferenceType ()

// For backwards compatibility mark some extra flexibility points as IsCompatFlex, meaning that the

// type variable will not be generalized

if compat then

let tp = destTyparTy cenv.g argty

tp.SetIsCompatFlex(true)

(destTyparTy cenv.g argty).SetIsCompatFlex(true)

AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css e.Range NoTrace ty argty

let e', tpenv = TcExpr cenv argty env tpenv e

let e' = mkCoerceIfNeeded cenv.g ty argty e'

let lam = mkMultiLambda mItem vs (constrApp, tyOfExpr cenv.g constrApp)

lam)

UnionCaseOrExnCheck env nargtys nargs mItem

let expr =MakeApplicableExprWithFlex cenv env true (mkExpr())

let exprTy =expr.Type

PropagateThenTcDelayed cenv overallTy env tpenv mItem expr exprTy ExprAtomicFlag.Atomic delayed

let expr = mkExpr()

let exprTy =tyOfExpr cenv.g expr

PropagateThenTcDelayed cenv overallTy env tpenv mItem(MakeApplicableExprNoFlex cenvexpr) exprTy ExprAtomicFlag.Atomic delayed

| Item.Types(nm, (ty::_)) ->

// - it isn't a VSlotDirectCall (uses of base values do not take type arguments

let checkTys tpenv kinds = TcTypesOrMeasures (Some kinds) cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv tys mItem

let _, vexp, isSpecial, _, _, tpenv = TcVal true cenv env tpenv vref (Some (NormalValUse, checkTys)) (Some afterResolution) mItem

let vexpFlex = (if isSpecial then MakeApplicableExprNoFlex cenv vexp else MakeApplicableExprWithFlex cenv envfalsevexp)

let vexpFlex = (if isSpecial then MakeApplicableExprNoFlex cenv vexp else MakeApplicableExprWithFlex cenv env vexp)

// We need to eventually record the type resolution for an expression, but this is done

// inside PropagateThenTcDelayed, so we don't have to explicitly call 'CallExprHasTypeSink' here

PropagateThenTcDelayed cenv overallTy env tpenv mExprAndTypeArgs vexpFlex vexpFlex.Type ExprAtomicFlag.Atomic otherDelayed

// Value get

| _ ->

let _, vexp, isSpecial, _, _, tpenv = TcVal true cenv env tpenv vref None (Some afterResolution) mItem

let vexpFlex = (if isSpecial then MakeApplicableExprNoFlex cenv vexp else MakeApplicableExprWithFlex cenv envfalsevexp)

let vexpFlex = (if isSpecial then MakeApplicableExprNoFlex cenv vexp else MakeApplicableExprWithFlex cenv env vexp)

PropagateThenTcDelayed cenv overallTy env tpenv mItem vexpFlex vexpFlex.Type ExprAtomicFlag.Atomic delayed

| Item.Property (nm, pinfos) ->

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

mkAsmExpr ([ mkNormalLdsfld fspec ] @ (if finfo.IsInitOnly then [ AI_nop ] else []), finfo.TypeInst, [], [exprty], mItem)

PropagateThenTcDelayed cenv overallTy env tpenv mItem (MakeApplicableExprWithFlex cenv envfalseexpr) exprty ExprAtomicFlag.Atomic delayed

PropagateThenTcDelayed cenv overallTy env tpenv mItem (MakeApplicableExprWithFlex cenv env expr) exprty ExprAtomicFlag.Atomic delayed

| Item.RecdField rfinfo ->

// Get static F# field or literal

| Some lit -> Expr.Const(lit, mItem, exprty)

// Get static F# field

| None -> mkStaticRecdFieldGet (fref, rfinfo.TypeInst, mItem)

PropagateThenTcDelayed cenv overallTy env tpenv mItem (MakeApplicableExprWithFlex cenv envfalseexpr) exprty ExprAtomicFlag.Atomic delayed

PropagateThenTcDelayed cenv overallTy env tpenv mItem (MakeApplicableExprWithFlex cenv env expr) exprty ExprAtomicFlag.Atomic delayed

| Item.Event einfo ->

// Instance IL event (fake up event-as-value)

// Instance F# Record or Class field

let objExpr' = mkRecdFieldGet cenv.g (objExpr, rfinfo.RecdFieldRef, rfinfo.TypeInst, mExprAndItem)

PropagateThenTcDelayed cenv overallTy env tpenv mExprAndItem (MakeApplicableExprWithFlex cenv envfalseobjExpr') fieldTy ExprAtomicFlag.Atomic delayed

PropagateThenTcDelayed cenv overallTy env tpenv mExprAndItem (MakeApplicableExprWithFlex cenv env objExpr') fieldTy ExprAtomicFlag.Atomic delayed

| Item.ILField finfo ->

// Get or set instance IL field

expr, tpenv

| _ ->

let expr = BuildILFieldGet cenv.g cenv.amap mExprAndItem objExpr finfo

PropagateThenTcDelayed cenv overallTy env tpenv mExprAndItem (MakeApplicableExprWithFlex cenv envfalseexpr) exprty ExprAtomicFlag.Atomic delayed

PropagateThenTcDelayed cenv overallTy env tpenv mExprAndItem (MakeApplicableExprWithFlex cenv env expr) exprty ExprAtomicFlag.Atomic delayed

| Item.Event einfo ->

// Instance IL event (fake up event-as-value)

typeT=| Aofseq<int>

typeU=| Bofseq<int>

match xwith

| Call(None,_,

[PropertyGet(None,_,_);

Let(_, Lambda(_, NewUnionCase(unioncase,_)),

Lambda(_, Application(_, Coerce(_, ty))))])->

unioncase.Name= caseName&&

ty.Name="IEnumerable`1"

test"check struct flexible union constructor"

(<@ testList|> A@>|> testFunction"A")

test"check flexible union constructor"

(<@ testList|> B@>|> testFunction"B")

check"we09ceo"(q.Equals(1))false

neg20.fs(99,26,99,33): typecheck error FS0001: All elements of a list constructor expression must have the same type. This expression was expectedto have type 'B', but here has type 'A'.

neg20.fs(108,12,108,16): typecheck error FS0001: Type mismatch. Expecting a

'B* B-> 'a'

but given a

'A* A-> Data'

The type 'B' doesnot match the type 'A'

neg20.fs(109,12,109,16): typecheck error FS0001: Type mismatch. Expecting a

'A* B-> 'a'

but given a

'A* A-> Data'

The type 'B' doesnot match the type 'A'

neg20.fs(110,12,110,16): typecheck error FS0001: Type mismatch. Expecting a

'B* A-> 'a'

but given a

'A* A-> Data'

The type 'B' doesnot match the type 'A'

neg20.fs(128,19,128,22): typecheck error FS0001: This expression was expectedto have type

'string'

but here has type

letpBB=(new B(),new B())

letpAB=(new A(),new B())

letpBA=(new B(),new A())

pBB|> Data// permitted

pAB|> Data// permitted

pBA|> Data// permitted

pBB|> Data//notpermitted (questionable)

pAB|> Data//notpermitted (questionable)

pBA|> Data//notpermitted (questionable)

pBB|> data// permitted

pAB|> data// permitted

pBA|> data// permitted

SOURCE=E_UnionFieldConflictingName.fs SCFLAGS="--test:ErrorRanges"# E_UnionFieldConflictingName.fs

SOURCE=E_UnionConstructorBadFieldName.fs SCFLAGS="--test:ErrorRanges"# E_UnionConstructorBadFieldName.fs

SOURCE=E_FieldNameUsedMulti.fs SCFLAGS="--test:ErrorRanges"# E_FieldNameUsedMulti.fs

SOURCE=E_FieldMemberClash.fs SCFLAGS="--test:ErrorRanges"# E_FieldMemberClash.fs

SOURCE=ConstructorFlexibleWhenPiping.fsx# ConstructorFlexibleWhenPiping.fsx

SOURCE=StructConstructorFlexibleWhenPiping.fsx# StructConstructorFlexibleWhenPiping.fsx

SOURCE=E_FieldMemberClash.fs SCFLAGS="--test:ErrorRanges"# E_FieldMemberClash.fs