Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

add a warning to mutable use bindings #1277

Merged
merged 1 commit into from
Jun 24, 2016
Merged

add a warning to mutable use bindings #1277

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
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
1 change: 1 addition & 0 deletions src/fsharp/FSComp.txt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1307,3 +1307,4 @@ estApplyStaticArgumentsForMethodNotImplemented,"A type provider implemented GetS
3201,tcModuleAbbrevFirstInMutRec,"In a recursive declaration group, module abbreviations must come after all 'open' declarations and before other declarations"
3202,tcUnsupportedMutRecDecl,"This declaration is not supported in recursive declaration groups"
3203,parsInvalidUseOfRec,"Invalid use of 'rec' keyword"
3204,tcUseMayNotBeMutable,"This feature is deprecated. A 'use' binding may not be marked 'mutable'."
43 changes: 23 additions & 20 deletions src/fsharp/TypeChecker.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1196,7 +1196,6 @@ type TcPatPhase2Input =
type CheckedBindingInfo =
| CheckedBindingInfo of
ValInline *
bool * (* immutable? *)
Tast.Attribs *
XmlDoc *
(TcPatPhase2Input -> PatternMatchCompilation.Pattern) *
Expand All @@ -1209,8 +1208,8 @@ type CheckedBindingInfo =
SequencePointInfoForBinding *
bool * (* compiler generated? *)
Const option (* literal value? *)
member x.Expr = let (CheckedBindingInfo(_,_,_,_,_,_,_,expr,_,_,_,_,_,_)) = x in expr
member x.SeqPoint = let (CheckedBindingInfo(_,_,_,_,_,_,_,_,_,_,_,spBind,_,_)) = x in spBind
member x.Expr = let (CheckedBindingInfo(_,_,_,_,_,_,expr,_,_,_,_,_,_)) = x in expr
member x.SeqPoint = let (CheckedBindingInfo(_,_,_,_,_,_,_,_,_,_,spBind,_,_)) = x in spBind

//-------------------------------------------------------------------------
// Helpers related to type schemes
Expand Down Expand Up @@ -2174,7 +2173,7 @@ module GeneralizationHelpers =
let ComputeAndGeneralizeGenericTypars (cenv,
denv:DisplayEnv,
m,
immut,
canGeneralize,
freeInEnv:FreeTypars,
canInferTypars,
genConstrainedTyparFlag,
Expand All @@ -2187,7 +2186,7 @@ module GeneralizationHelpers =

let allDeclaredTypars = NormalizeDeclaredTyparsForEquiRecursiveInference cenv.g allDeclaredTypars
let typarsToAttemptToGeneralize =
if immut && (match exprOpt with None -> true | Some e -> IsGeneralizableValue cenv.g e)
if canGeneralize && (match exprOpt with None -> true | Some e -> IsGeneralizableValue cenv.g e)
then (ListSet.unionFavourLeft typarEq allDeclaredTypars maxInferredTypars)
else allDeclaredTypars

Expand Down Expand Up @@ -6262,9 +6261,9 @@ and TcObjectExprBinding cenv (env: TcEnv) implty tpenv (absSlotInfo,bind) =
| _ ->
implty --> NewInferenceType ()

let (CheckedBindingInfo(inlineFlag,immut,bindingAttribs,_,_,ExplicitTyparInfo(_,declaredTypars,_),nameToPrelimValSchemeMap,rhsExpr,_,_,m,_,_,_),tpenv) =
let (CheckedBindingInfo(inlineFlag,bindingAttribs,_,_,ExplicitTyparInfo(_,declaredTypars,_),nameToPrelimValSchemeMap,rhsExpr,_,_,m,_,_,_),tpenv) =
let flex, tpenv = TcNonrecBindingTyparDecls cenv env tpenv bind
TcNormalizedBinding ObjectExpressionOverrideBinding cenv env tpenv bindingTy None NoSafeInitInfo ([],flex) bind
TcNormalizedBinding ObjectExpressionOverrideBinding cenv env tpenv false bindingTy None NoSafeInitInfo ([],flex) bind

// 4c. generalize the binding - only relevant when implementing a generic virtual method

Expand All @@ -6283,7 +6282,7 @@ and TcObjectExprBinding cenv (env: TcEnv) implty tpenv (absSlotInfo,bind) =

let freeInEnv = GeneralizationHelpers.ComputeUngeneralizableTypars env

let generalizedTypars = GeneralizationHelpers.ComputeAndGeneralizeGenericTypars(cenv,denv,m,immut,freeInEnv,false,CanGeneralizeConstrainedTypars,inlineFlag,Some(rhsExpr),declaredTypars,[],bindingTy,false)
let generalizedTypars = GeneralizationHelpers.ComputeAndGeneralizeGenericTypars(cenv,denv,m,true,freeInEnv,false,CanGeneralizeConstrainedTypars,inlineFlag,Some(rhsExpr),declaredTypars,[],bindingTy,false)
let declaredTypars = ChooseCanonicalDeclaredTyparsAfterInference cenv.g env.DisplayEnv declaredTypars m

let generalizedTypars = PlaceTyparsInDeclarationOrder declaredTypars generalizedTypars
Expand Down Expand Up @@ -9773,7 +9772,7 @@ and TcStaticOptimizationConstraint cenv env tpenv c =
TTyconIsStruct(mkTyparTy tp'),tpenv

/// Binding checking code, for all bindings including let bindings, let-rec bindings, member bindings and object-expression bindings and
and TcNormalizedBinding declKind (cenv:cenv) env tpenv overallTy safeThisValOpt safeInitInfo (enclosingDeclaredTypars,(ExplicitTyparInfo(_,declaredTypars,_) as flex)) bind =
and TcNormalizedBinding declKind (cenv:cenv) env tpenv isUse overallTy safeThisValOpt safeInitInfo (enclosingDeclaredTypars,(ExplicitTyparInfo(_,declaredTypars,_) as flex)) bind =
let envinner = AddDeclaredTypars NoCheckForDuplicateTypars (enclosingDeclaredTypars@declaredTypars) env

match bind with
Expand All @@ -9798,6 +9797,7 @@ and TcNormalizedBinding declKind (cenv:cenv) env tpenv overallTy safeThisValOpt

let argAttribs =
spatsL |> List.map (SynInfo.InferSynArgInfoFromSimplePats >> List.map (SynInfo.AttribsOfArgData >> TcAttrs AttributeTargets.Parameter))

let retAttribs =
match rtyOpt with
| Some (SynBindingReturnInfo(_,_,retAttrs)) -> TcAttrs AttributeTargets.ReturnValue retAttrs
Expand All @@ -9817,6 +9817,9 @@ and TcNormalizedBinding declKind (cenv:cenv) env tpenv overallTy safeThisValOpt
if (not isMutable || isThreadStatic) then
errorR(Error(FSComp.SR.tcVolatileFieldsMustBeMutable(),mBinding))

if isUse && isMutable then
warning(Error(FSComp.SR.tcUseMayNotBeMutable(),mBinding))

if HasFSharpAttributeOpt cenv.g cenv.g.attrib_DllImportAttribute valAttribs then
if not declKind.CanBeDllImport || (match memberFlagsOpt with Some memberFlags -> memberFlags.IsInstance | _ -> false) then
errorR(Error(FSComp.SR.tcDllImportNotAllowed(),mBinding))
Expand Down Expand Up @@ -9916,7 +9919,7 @@ and TcNormalizedBinding declKind (cenv:cenv) env tpenv overallTy safeThisValOpt
if hasLiteralAttr && nonNil declaredTypars then
errorR(Error(FSComp.SR.tcLiteralCannotHaveGenericParameters(),mBinding))

CheckedBindingInfo(inlineFlag,true,valAttribs,doc,tcPatPhase2,flex,nameToPrelimValSchemeMap,rhsExpr',argAndRetAttribs,overallTy,mBinding,spBind,compgen,konst),tpenv
CheckedBindingInfo(inlineFlag,valAttribs,doc,tcPatPhase2,flex,nameToPrelimValSchemeMap,rhsExpr',argAndRetAttribs,overallTy,mBinding,spBind,compgen,konst),tpenv

and TcLiteral cenv overallTy env tpenv (attrs,synLiteralValExpr) =
let hasLiteralAttr = HasFSharpAttribute cenv.g cenv.g.attrib_LiteralAttribute attrs
Expand Down Expand Up @@ -9958,10 +9961,10 @@ and TcNonrecBindingTyparDecls cenv env tpenv bind =
let (NormalizedBinding(_,_,_,_,_,_,synTyparDecls,_,_,_,_,_)) = bind
TcBindingTyparDecls true cenv env tpenv synTyparDecls

and TcNonRecursiveBinding declKind cenv env tpenv ty b =
and TcNonRecursiveBinding declKind cenv env tpenv isUse ty b =
let b = BindingNormalization.NormalizeBinding ValOrMemberBinding cenv env b
let flex, tpenv = TcNonrecBindingTyparDecls cenv env tpenv b
TcNormalizedBinding declKind cenv env tpenv ty None NoSafeInitInfo ([],flex) b
TcNormalizedBinding declKind cenv env tpenv isUse ty None NoSafeInitInfo ([],flex) b

//-------------------------------------------------------------------------
// TcAttribute*
Expand Down Expand Up @@ -10164,14 +10167,14 @@ and TcAttributes cenv env attrTgt synAttribs =
and TcLetBinding cenv isUse env containerInfo declKind tpenv (binds,bindsm,scopem) =

// Typecheck all the bindings...
let binds',tpenv = List.mapFold (fun tpenv b -> TcNonRecursiveBinding declKind cenv env tpenv (NewInferenceType ()) b) tpenv binds
let binds',tpenv = List.mapFold (fun tpenv b -> TcNonRecursiveBinding declKind cenv env tpenv isUse (NewInferenceType ()) b) tpenv binds
let (ContainerInfo(altActualParent,_)) = containerInfo

// Canonicalize constraints prior to generalization
let denv = env.DisplayEnv
GeneralizationHelpers.CanonicalizePartialInferenceProblem (cenv,denv,bindsm)
(binds' |> List.collect (fun tbinfo ->
let (CheckedBindingInfo(_,_,_,_,_,flex,_,_,_,tauTy,_,_,_,_)) = tbinfo
let (CheckedBindingInfo(_,_,_,_,flex,_,_,_,tauTy,_,_,_,_)) = tbinfo
let (ExplicitTyparInfo(_,declaredTypars,_)) = flex
let maxInferredTypars = (freeInTypeLeftToRight cenv.g false tauTy)
declaredTypars @ maxInferredTypars))
Expand All @@ -10180,7 +10183,7 @@ and TcLetBinding cenv isUse env containerInfo declKind tpenv (binds,bindsm,scope

// Generalize the bindings...
(((fun x -> x), env, tpenv), binds') ||> List.fold (fun (mkf_sofar,env,tpenv) tbinfo ->
let (CheckedBindingInfo(inlineFlag,immut,attrs,doc,tcPatPhase2,flex,nameToPrelimValSchemeMap,rhsExpr,_,tauTy,m,spBind,_,konst)) = tbinfo
let (CheckedBindingInfo(inlineFlag,attrs,doc,tcPatPhase2,flex,nameToPrelimValSchemeMap,rhsExpr,_,tauTy,m,spBind,_,konst)) = tbinfo
let enclosingDeclaredTypars = []
let (ExplicitTyparInfo(_,declaredTypars,canInferTypars)) = flex
let allDeclaredTypars = enclosingDeclaredTypars @ declaredTypars
Expand All @@ -10194,7 +10197,7 @@ and TcLetBinding cenv isUse env containerInfo declKind tpenv (binds,bindsm,scope
[]
else
let freeInEnv = lazyFreeInEnv.Force()
GeneralizationHelpers.ComputeAndGeneralizeGenericTypars(cenv,denv, m, immut, freeInEnv, canInferTypars, GeneralizationHelpers.CanGeneralizeConstrainedTyparsForDecl(declKind), inlineFlag, Some rhsExpr, allDeclaredTypars, maxInferredTypars,tauTy,false)
GeneralizationHelpers.ComputeAndGeneralizeGenericTypars(cenv,denv, m, true, freeInEnv, canInferTypars, GeneralizationHelpers.CanGeneralizeConstrainedTyparsForDecl(declKind), inlineFlag, Some rhsExpr, allDeclaredTypars, maxInferredTypars,tauTy,false)

let prelimValSchemes2 = GeneralizeVals cenv denv enclosingDeclaredTypars generalizedTypars nameToPrelimValSchemeMap

Expand Down Expand Up @@ -10809,7 +10812,7 @@ and TcLetrecBinding
let envRec = MakeInnerEnvForMember cenv envRec vspec

let checkedBind,tpenv =
TcNormalizedBinding declKind cenv envRec tpenv tau safeThisValOpt safeInitInfo (enclosingDeclaredTypars,flex) rbind.SyntacticBinding
TcNormalizedBinding declKind cenv envRec tpenv false tau safeThisValOpt safeInitInfo (enclosingDeclaredTypars,flex) rbind.SyntacticBinding

(try UnifyTypes cenv envRec vspec.Range (allDeclaredTypars +-> tau) vspec.Type
with e -> error (Recursion(envRec.DisplayEnv,vspec.Id,tau,vspec.Type,vspec.Range)))
Expand Down Expand Up @@ -11026,7 +11029,7 @@ and TcLetrecComputeAndGeneralizeGenericTyparsForBinding cenv denv freeInEnv (pgr

let rbinfo = pgrbind.RecBindingInfo
let vspec = rbinfo.Val
let (CheckedBindingInfo(inlineFlag,immut,_,_,_,_,_,expr,_,_,m,_,_,_)) = pgrbind.CheckedBinding
let (CheckedBindingInfo(inlineFlag,_,_,_,_,_,expr,_,_,m,_,_,_)) = pgrbind.CheckedBinding
let (ExplicitTyparInfo(rigidCopyOfDeclaredTypars,declaredTypars,_)) = rbinfo.ExplicitTyparInfo
let allDeclaredTypars = rbinfo.EnclosingDeclaredTypars @ declaredTypars

Expand All @@ -11047,7 +11050,7 @@ and TcLetrecComputeAndGeneralizeGenericTyparsForBinding cenv denv freeInEnv (pgr
let maxInferredTypars = freeInTypeLeftToRight cenv.g false tau

let canGeneralizeConstrained = GeneralizationHelpers.CanGeneralizeConstrainedTyparsForDecl rbinfo.DeclKind
let generalizedTypars = GeneralizationHelpers.ComputeAndGeneralizeGenericTypars (cenv,denv,m,immut,freeInEnv,canInferTypars,canGeneralizeConstrained,inlineFlag, Some(expr), allDeclaredTypars, maxInferredTypars,tau,isCtor)
let generalizedTypars = GeneralizationHelpers.ComputeAndGeneralizeGenericTypars (cenv,denv,m,true,freeInEnv,canInferTypars,canGeneralizeConstrained,inlineFlag, Some(expr), allDeclaredTypars, maxInferredTypars,tau,isCtor)
generalizedTypars

/// Compute the type variables which may have member constraints that need to be canonicalized prior to generalization
Expand All @@ -11065,7 +11068,7 @@ and TcLetrecComputeSupportForBinding cenv (pgrbind : PreGeneralizationRecursiveB
and TcLetrecGeneralizeBinding cenv denv generalizedTypars (pgrbind : PreGeneralizationRecursiveBinding) : PostGeneralizationRecursiveBinding =

let (RBInfo(_,_,enclosingDeclaredTypars,_,vspec,flex,partialValReprInfo,memberInfoOpt,_,_,_,vis,_,declKind)) = pgrbind.RecBindingInfo
let (CheckedBindingInfo(inlineFlag,_,_,_,_,_,_,expr,argAttribs,_,_,_,compgen,_)) = pgrbind.CheckedBinding
let (CheckedBindingInfo(inlineFlag,_,_,_,_,_,expr,argAttribs,_,_,_,compgen,_)) = pgrbind.CheckedBinding

let _,tau = vspec.TypeScheme

Expand Down
4 changes: 3 additions & 1 deletion tests/fsharp/typecheck/sigs/neg96.bsl
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,2 +1,4 @@

neg95.fs(11,9,11,21): typecheck error FS0039: The value or constructor 'StructRecord' is not defined
neg95.fs(11,9,11,21): typecheck error FS0039: The value or constructor 'StructRecord' is not defined

neg96.fs(14,17,14,18): typecheck error FS3204: This feature is deprecated. A 'use' binding may not be marked 'mutable'.
4 changes: 4 additions & 0 deletions tests/fsharp/typecheck/sigs/neg96.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -9,3 +9,7 @@ type StructRecord =
}

let x = StructRecord ()

let invalidUse() =
use mutable x = (null : System.IDisposable)
()