Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
40 changes: 20 additions & 20 deletions src/absil/il.fs
Original file line number Diff line number Diff line change
Expand Up @@ -633,8 +633,6 @@ and

static member Create(tref,inst) = { tspecTypeRef =tref; tspecInst=inst }

override x.ToString() = x.TypeRef.ToString() + if isNil x.GenericArgs then "" else "<...>"

member x.BasicQualifiedName =
let tc = x.TypeRef.BasicQualifiedName
if isNil x.GenericArgs then
Expand All @@ -647,6 +645,8 @@ and

member x.FullName=x.TypeRef.FullName

override x.ToString() = x.TypeRef.ToString() + if isNil x.GenericArgs then "" else "<...>"

and [<RequireQualifiedAccess; StructuralEquality; StructuralComparison>]
ILType =
| Void
Expand Down Expand Up @@ -685,34 +685,34 @@ and [<RequireQualifiedAccess; StructuralEquality; StructuralComparison>]
x.AddQualifiedNameExtension(x.BasicQualifiedName)

member x.TypeSpec =
match x with
| ILType.Boxed tr | ILType.Value tr -> tr
| _ -> invalidOp "not a nominal type"
match x with
| ILType.Boxed tr | ILType.Value tr -> tr
| _ -> invalidOp "not a nominal type"

member x.Boxity =
match x with
| ILType.Boxed _ -> AsObject
| ILType.Value _ -> AsValue
| _ -> invalidOp "not a nominal type"
match x with
| ILType.Boxed _ -> AsObject
| ILType.Value _ -> AsValue
| _ -> invalidOp "not a nominal type"

member x.TypeRef =
match x with
| ILType.Boxed tspec | ILType.Value tspec -> tspec.TypeRef
| _ -> invalidOp "not a nominal type"
match x with
| ILType.Boxed tspec | ILType.Value tspec -> tspec.TypeRef
| _ -> invalidOp "not a nominal type"

member x.IsNominal =
match x with
| ILType.Boxed _ | ILType.Value _ -> true
| _ -> false
match x with
| ILType.Boxed _ | ILType.Value _ -> true
| _ -> false

member x.GenericArgs =
match x with
| ILType.Boxed tspec | ILType.Value tspec -> tspec.GenericArgs
| _ -> []
match x with
| ILType.Boxed tspec | ILType.Value tspec -> tspec.GenericArgs
| _ -> []

member x.IsTyvar =
match x with
| ILType.TypeVar _ -> true | _ -> false
match x with
| ILType.TypeVar _ -> true | _ -> false

and [<StructuralEquality; StructuralComparison>]
ILCallingSignature =
Expand Down
6 changes: 3 additions & 3 deletions src/fsharp/Optimizer.fs
Original file line number Diff line number Diff line change
Expand Up @@ -1261,9 +1261,9 @@ and OpHasEffect g op =
| TOp.Recd (ctor, tcref) ->
match ctor with
| RecdExprIsObjInit -> true
| RecdExpr -> isRecdOrUnionOrStructTyconRefAllocObservable g tcref
| TOp.UnionCase ucref -> isRecdOrUnionOrStructTyconRefAllocObservable g ucref.TyconRef
| TOp.ExnConstr ecref -> isExnAllocObservable ecref
| RecdExpr -> isRecdOrUnionOrStructTyconRefDefinitelyMutable g tcref
| TOp.UnionCase ucref -> isRecdOrUnionOrStructTyconRefDefinitelyMutable g ucref.TyconRef
| TOp.ExnConstr ecref -> isExnDefinitelyMutable ecref
| TOp.Bytes _ | TOp.UInt16s _ | TOp.Array -> true (* alloc observable *)
| TOp.UnionCaseTagGet _ -> false
| TOp.UnionCaseProof _ -> false
Expand Down
31 changes: 16 additions & 15 deletions src/fsharp/TastOps.fs
Original file line number Diff line number Diff line change
Expand Up @@ -5217,27 +5217,28 @@ and remarkBind m (TBind(v, repr, _)) =


//--------------------------------------------------------------------------
// Reference semantics?
// Mutability analysis
//--------------------------------------------------------------------------

let isRecdOrStructFieldAllocObservable (f:RecdField) = not f.IsStatic && f.IsMutable
let isUnionCaseAllocObservable (uc:UnionCase) = uc.FieldTable.FieldsByIndex |> Array.exists isRecdOrStructFieldAllocObservable
let isUnionCaseRefAllocObservable (uc:UnionCaseRef) = uc.UnionCase |> isUnionCaseAllocObservable
let isRecdOrStructFieldDefinitelyMutable (f:RecdField) = not f.IsStatic && f.IsMutable
let isUnionCaseDefinitelyMutable (uc:UnionCase) = uc.FieldTable.FieldsByIndex |> Array.exists isRecdOrStructFieldDefinitelyMutable
let isUnionCaseRefDefinitelyMutable (uc:UnionCaseRef) = uc.UnionCase |> isUnionCaseDefinitelyMutable

let isRecdOrUnionOrStructTyconAllocObservable (_g:TcGlobals) (tycon:Tycon) =
/// This is an incomplete check for .NET struct types. Returning 'false' doesn't mean the thing is immutable.
let isRecdOrUnionOrStructTyconDefinitelyMutable (_g:TcGlobals) (tycon:Tycon) =
if tycon.IsUnionTycon then
tycon.UnionCasesArray |> Array.exists isUnionCaseAllocObservable
tycon.UnionCasesArray |> Array.exists isUnionCaseDefinitelyMutable
elif tycon.IsRecordTycon || tycon.IsStructOrEnumTycon then
tycon.AllFieldsArray |> Array.exists isRecdOrStructFieldAllocObservable
tycon.AllFieldsArray |> Array.exists isRecdOrStructFieldDefinitelyMutable
else
false

let isRecdOrUnionOrStructTyconRefAllocObservable g (tcr : TyconRef) = isRecdOrUnionOrStructTyconAllocObservable g tcr.Deref
let isRecdOrUnionOrStructTyconRefDefinitelyMutable g (tcr : TyconRef) = isRecdOrUnionOrStructTyconDefinitelyMutable g tcr.Deref

// Although from the pure F# perspective exception values cannot be changed, the .NET
// implementation of exception objects attaches a whole bunch of stack information to
// each raised object. Hence we treat exception objects as if they have identity
let isExnAllocObservable (_ecref:TyconRef) = true
let isExnDefinitelyMutable (_ecref:TyconRef) = true

// Some of the implementations of library functions on lists use mutation on the tail
// of the cons cell. These cells are always private, i.e. not accessible by any other
Expand Down Expand Up @@ -5556,11 +5557,11 @@ let mkAndSimplifyMatch spBind exprm matchm ty tree targets =
type Mutates = DefinitelyMutates | PossiblyMutates | NeverMutates
exception DefensiveCopyWarning of string * range

let isRecdOrStructTyImmutable g ty =
let isRecdOrStructTyReadOnly g ty =
match tryDestAppTy g ty with
| None -> false
| Some tcref ->
not (isRecdOrUnionOrStructTyconRefAllocObservable g tcref) ||
not (isRecdOrUnionOrStructTyconRefDefinitelyMutable g tcref) ||
tyconRefEq g tcref g.decimal_tcr ||
tyconRefEq g tcref g.date_tcr

Expand All @@ -5575,7 +5576,7 @@ let isRecdOrStructTyImmutable g ty =
// let g1 = A.G(1)
// (fun () -> g1.x1)
//
// Note: isRecdOrStructTyImmutable implies PossiblyMutates or NeverMutates
// Note: isRecdOrStructTyReadOnly implies PossiblyMutates or NeverMutates
//
// We only do this for true local or closure fields because we can't take addresses of immutable static
// fields across assemblies.
Expand All @@ -5586,7 +5587,7 @@ let CanTakeAddressOfImmutableVal g (v:ValRef) mut =
not v.IsMemberOrModuleBinding &&
(match mut with
| NeverMutates -> true
| PossiblyMutates -> isRecdOrStructTyImmutable g v.Type
| PossiblyMutates -> isRecdOrStructTyReadOnly g v.Type
| DefinitelyMutates -> false)

let MustTakeAddressOfVal (g:TcGlobals) (v:ValRef) =
Expand All @@ -5605,13 +5606,13 @@ let CanTakeAddressOfRecdFieldRef (g:TcGlobals) (rfref: RecdFieldRef) mut tinst =
mut <> DefinitelyMutates &&
// We only do this if the field is defined in this assembly because we can't take addresses across assemblies for immutable fields
entityRefInThisAssembly g.compilingFslib rfref.TyconRef &&
isRecdOrStructTyImmutable g (actualTyOfRecdFieldRef rfref tinst)
isRecdOrStructTyReadOnly g (actualTyOfRecdFieldRef rfref tinst)

let CanTakeAddressOfUnionFieldRef (g:TcGlobals) (uref: UnionCaseRef) mut tinst cidx =
mut <> DefinitelyMutates &&
// We only do this if the field is defined in this assembly because we can't take addresses across assemblies for immutable fields
entityRefInThisAssembly g.compilingFslib uref.TyconRef &&
isRecdOrStructTyImmutable g (actualTyOfUnionFieldRef uref cidx tinst)
isRecdOrStructTyReadOnly g (actualTyOfUnionFieldRef uref cidx tinst)


let rec mkExprAddrOfExprAux g mustTakeAddress useReadonlyForGenericArrayAddress mut e addrExprVal m =
Expand Down
6 changes: 3 additions & 3 deletions src/fsharp/TastOps.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -1091,9 +1091,9 @@ val TypeHasDefaultValue : TcGlobals -> range -> TType -> bool

val isAbstractTycon : Tycon -> bool

val isUnionCaseRefAllocObservable : UnionCaseRef -> bool
val isRecdOrUnionOrStructTyconRefAllocObservable : TcGlobals -> TyconRef -> bool
val isExnAllocObservable : TyconRef -> bool
val isUnionCaseRefDefinitelyMutable : UnionCaseRef -> bool
val isRecdOrUnionOrStructTyconRefDefinitelyMutable : TcGlobals -> TyconRef -> bool
val isExnDefinitelyMutable : TyconRef -> bool
val isUnionCaseFieldMutable : TcGlobals -> UnionCaseRef -> int -> bool
val isExnFieldMutable : TyconRef -> int -> bool

Expand Down
6 changes: 3 additions & 3 deletions src/fsharp/TypeChecker.fs
Original file line number Diff line number Diff line change
Expand Up @@ -2169,13 +2169,13 @@ module GeneralizationHelpers =
| Expr.Op(op, _, args, _) ->
match op with
| TOp.Tuple _ -> true
| TOp.UnionCase uc -> not (isUnionCaseRefAllocObservable uc)
| TOp.UnionCase uc -> not (isUnionCaseRefDefinitelyMutable uc)
| TOp.Recd(ctorInfo, tcref) ->
match ctorInfo with
| RecdExpr -> not (isRecdOrUnionOrStructTyconRefAllocObservable g tcref)
| RecdExpr -> not (isRecdOrUnionOrStructTyconRefDefinitelyMutable g tcref)
| RecdExprIsObjInit -> false
| TOp.Array -> isNil args
| TOp.ExnConstr ec -> not (isExnAllocObservable ec)
| TOp.ExnConstr ec -> not (isExnDefinitelyMutable ec)

| TOp.ILAsm([], _) -> true

Expand Down
Loading