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.

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

code cleanup #12121

Merged
merged 10 commits into from
Sep 16, 2021
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
2 changes: 2 additions & 0 deletions .gitignore
Original file line number Diff line number Diff line change
Expand Up @@ -122,3 +122,5 @@ nCrunchTemp_*
/tests/fsharp/core/members/set-only-property/vb.dll
/tests/fsharp/core/members/set-only-property/fs.dll
/tests/fsharp/core/members/set-only-property/cs.dll

.fake
402 changes: 200 additions & 202 deletions src/fsharp/CheckComputationExpressions.fs

Large diffs are not rendered by default.

28 changes: 15 additions & 13 deletions src/fsharp/CheckDeclarations.fs
Original file line number Diff line number Diff line change
Expand Up @@ -2156,14 +2156,14 @@ module MutRecBindingChecking =
/// Update the contents accessible via the recursive namespace declaration, if any
let TcMutRecDefns_UpdateNSContents mutRecNSInfo =
match mutRecNSInfo with
| Some (Some (mspecNS: ModuleOrNamespace), mtypeAcc) ->
mspecNS.entity_modul_contents <- MaybeLazy.Strict !mtypeAcc
| Some (Some (mspecNS: ModuleOrNamespace), mtypeAcc: _ ref) ->
mspecNS.entity_modul_contents <- MaybeLazy.Strict mtypeAcc.Value
| _ -> ()

/// Updates the types of the modules to contain the contents so far
let TcMutRecDefns_UpdateModuleContents mutRecNSInfo defns =
defns |> MutRecShapes.iterModules (fun (MutRecDefnsPhase2DataForModule (mtypeAcc, mspec), _) ->
mspec.entity_modul_contents <- MaybeLazy.Strict !mtypeAcc)
mspec.entity_modul_contents <- MaybeLazy.Strict mtypeAcc.Value)

TcMutRecDefns_UpdateNSContents mutRecNSInfo

Expand Down Expand Up @@ -2206,7 +2206,7 @@ module MutRecBindingChecking =
let envForDecls =
(envForDecls, opens) ||> List.fold (fun env (target, m, moduleRange, openDeclsRef) ->
let env, openDecls = TcOpenDecl cenv m moduleRange env target
openDeclsRef := openDecls
openDeclsRef.Value <- openDecls
env)
// Add the type definitions being defined
let envForDecls = (if report then AddLocalTyconsAndReport cenv.tcSink scopem else AddLocalTycons) cenv.g cenv.amap m tycons envForDecls
Expand Down Expand Up @@ -5120,7 +5120,7 @@ let rec TcSignatureElementNonMutRec cenv parent typeNames endm (env: TcEnv) synS
let envNS = ImplicitlyOpenOwnNamespace cenv.tcSink cenv.g cenv.amap m enclosingNamespacePath envNS

// For 'namespace rec' and 'module rec' we add the thing being defined
let mtypNS = !(envNS.eModuleOrNamespaceTypeAccumulator)
let mtypNS = envNS.eModuleOrNamespaceTypeAccumulator.Value
let mtypRoot, mspecNSs = BuildRootModuleType enclosingNamespacePath envNS.eCompPath mtypNS
let mspecNSOpt = List.tryHead mspecNSs

Expand Down Expand Up @@ -5151,7 +5151,8 @@ let rec TcSignatureElementNonMutRec cenv parent typeNames endm (env: TcEnv) synS
| None -> env, []

// Publish the combined module type
env.eModuleOrNamespaceTypeAccumulator := CombineCcuContentFragments m [!(env.eModuleOrNamespaceTypeAccumulator); mtypRoot]
env.eModuleOrNamespaceTypeAccumulator.Value <-
CombineCcuContentFragments m [env.eModuleOrNamespaceTypeAccumulator.Value; mtypRoot]
env

return env
Expand Down Expand Up @@ -5245,7 +5246,7 @@ and TcModuleOrNamespaceSignatureElementsNonMutRec cenv parent env (id, modKind,
let! envAtEnd = TcSignatureElements cenv parent endm envForModule xml None defs

// mtypeAcc has now accumulated the module type
return !mtypeAcc, envAtEnd
return mtypeAcc.Value, envAtEnd
}

//-------------------------------------------------------------------------
Expand Down Expand Up @@ -5389,7 +5390,7 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem
let! mexpr, topAttrsNew, envAtEnd = TcModuleOrNamespaceElements cenv (Parent (mkLocalModRef mspec)) endm envForModule xml None [] mdefs

// Get the inferred type of the decls and record it in the mspec.
mspec.entity_modul_contents <- MaybeLazy.Strict !mtypeAcc
mspec.entity_modul_contents <- MaybeLazy.Strict mtypeAcc.Value
let modDefn = TMDefRec(false, [], [], [ModuleOrNamespaceBinding.Module(mspec, mexpr)], m)
PublishModuleDefn cenv env mspec
let env = AddLocalSubModuleAndReport cenv.tcSink scopem cenv.g cenv.amap m env mspec
Expand Down Expand Up @@ -5431,7 +5432,7 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem
let envNS = LocateEnv cenv.topCcu env enclosingNamespacePath
let envNS = ImplicitlyOpenOwnNamespace cenv.tcSink cenv.g cenv.amap m enclosingNamespacePath envNS

let mtypNS = !(envNS.eModuleOrNamespaceTypeAccumulator)
let mtypNS = envNS.eModuleOrNamespaceTypeAccumulator.Value
let mtypRoot, mspecNSs = BuildRootModuleType enclosingNamespacePath envNS.eCompPath mtypNS
let mspecNSOpt = List.tryHead mspecNSs

Expand Down Expand Up @@ -5462,7 +5463,8 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem
| None -> env, []

// Publish the combined module type
env.eModuleOrNamespaceTypeAccumulator := CombineCcuContentFragments m [!(env.eModuleOrNamespaceTypeAccumulator); mtypRoot]
env.eModuleOrNamespaceTypeAccumulator.Value <-
CombineCcuContentFragments m [env.eModuleOrNamespaceTypeAccumulator.Value; mtypRoot]
env, openDecls

let modExprRoot = BuildRootModuleExpr enclosingNamespacePath envNS.eCompPath modExpr
Expand Down Expand Up @@ -5592,7 +5594,7 @@ and TcMutRecDefsFinish cenv defs m =
binds |> List.map ModuleOrNamespaceBinding.Binding
| MutRecShape.Module ((MutRecDefnsPhase2DataForModule(mtypeAcc, mspec), _), mdefs) ->
let mexpr = TcMutRecDefsFinish cenv mdefs m
mspec.entity_modul_contents <- MaybeLazy.Strict !mtypeAcc
mspec.entity_modul_contents <- MaybeLazy.Strict mtypeAcc.Value
[ ModuleOrNamespaceBinding.Module(mspec, mexpr) ])

TMDefRec(true, opens, tycons, binds, m)
Expand Down Expand Up @@ -5841,7 +5843,7 @@ let TypeCheckOneImplFile
let defs = [ for x in implFileFrags -> SynModuleDecl.NamespaceFragment x ]
let! mexpr, topAttrs, envAtEnd = TcModuleOrNamespaceElements cenv ParentNone qualNameOfFile.Range envinner PreXmlDoc.Empty None openDecls0 defs

let implFileTypePriorToSig = !mtypeAcc
let implFileTypePriorToSig = mtypeAcc.Value

let topAttrs =
let mainMethodAttrs, others = topAttrs |> List.partition (fun (possTargets, _) -> possTargets &&& AttributeTargets.Method <> enum 0)
Expand Down Expand Up @@ -5948,7 +5950,7 @@ let TypeCheckOneSigFile (g, niceNameGen, amap, topCcu, checkForErrors, condition
let specs = [ for x in sigFileFrags -> SynModuleSigDecl.NamespaceFragment x ]
let! tcEnv = TcSignatureElements cenv ParentNone qualNameOfFile.Range envinner PreXmlDoc.Empty None specs

let sigFileType = !mtypeAcc
let sigFileType = mtypeAcc.Value

if not (checkForErrors()) then
try sigFileType |> IterTyconsOfModuleOrNamespaceType (FinalTypeDefinitionChecksAtEndOfInferenceScope(cenv.infoReader, tcEnv.NameEnv, cenv.tcSink, false, tcEnv.DisplayEnv))
Expand Down
26 changes: 17 additions & 9 deletions src/fsharp/CheckExpressions.fs
Original file line number Diff line number Diff line change
Expand Up @@ -544,10 +544,12 @@ let MakeInnerEnvForMember env (v: Val) =
| Some _ -> MakeInnerEnvForTyconRef env v.MemberApparentEntity v.IsExtensionMember

/// Get the current accumulator for the namespace/module we're in
let GetCurrAccumulatedModuleOrNamespaceType env = !(env.eModuleOrNamespaceTypeAccumulator)
let GetCurrAccumulatedModuleOrNamespaceType env =
env.eModuleOrNamespaceTypeAccumulator.Value

/// Set the current accumulator for the namespace/module we're in, updating the inferred contents
let SetCurrAccumulatedModuleOrNamespaceType env x = env.eModuleOrNamespaceTypeAccumulator := x
let SetCurrAccumulatedModuleOrNamespaceType env x =
env.eModuleOrNamespaceTypeAccumulator.Value <- x

/// Set up the initial environment accounting for the enclosing "namespace X.Y.Z" definition
let LocateEnv ccu env enclosingNamespacePath =
Expand Down Expand Up @@ -2084,7 +2086,7 @@ module GeneralizationHelpers =
| Expr.App (e1, _, _, [], _) -> IsGeneralizableValue g e1
| Expr.TyChoose (_, b, _) -> IsGeneralizableValue g b
| Expr.Obj (_, ty, _, _, _, _, _) -> isInterfaceTy g ty || isDelegateTy g ty
| Expr.Link eref -> IsGeneralizableValue g !eref
| Expr.Link eref -> IsGeneralizableValue g eref.Value

| _ -> false

Expand Down Expand Up @@ -3440,7 +3442,7 @@ let EliminateInitializationGraphs
// n-ary expressions
| Expr.Op (op, _, args, m) -> CheckExprOp st op m; List.iter (CheckExpr (strict st)) args
// misc
| Expr.Link eref -> CheckExpr st !eref
| Expr.Link eref -> CheckExpr st eref.Value
| Expr.TyChoose (_, b, _) -> CheckExpr st b
| Expr.Quote _ -> ()
| Expr.WitnessArg (_witnessInfo, _m) -> ()
Expand Down Expand Up @@ -3528,7 +3530,8 @@ let EliminateInitializationGraphs
let vrhs = (mkLazyDelayed g m ty felazy)

if mustHaveArity then vlazy.SetValReprInfo (Some(InferArityOfExpr g AllowTypeDirectedDetupling.Yes vty [] [] vrhs))
fixupPoints |> List.iter (fun (fp, _) -> fp := mkLazyForce g (!fp).Range ty velazy)
for (fixupPoint, _) in fixupPoints do
fixupPoint.Value <- mkLazyForce g fixupPoint.Value.Range ty velazy

[mkInvisibleBind flazy frhs; mkInvisibleBind vlazy vrhs],
[mkBind seqPtOpt v (mkLazyForce g m ty velazy)]
Expand Down Expand Up @@ -3619,8 +3622,8 @@ let CheckAndRewriteObjectCtor g env (ctorLambdaExpr: Expr) =
and checkAndRewriteCtorUsage expr =
match expr with
| Expr.Link eref ->
let e = checkAndRewriteCtorUsage !eref
eref := e
let e = checkAndRewriteCtorUsage eref.Value
eref.Value <- e
expr

// Type applications are ok, e.g.
Expand Down Expand Up @@ -4713,8 +4716,13 @@ and TryAdjustHiddenVarNameToCompGenName cenv env (id: Ident) altNameRefCellOpt =
match altNameRefCellOpt with
| Some ({contents = SynSimplePatAlternativeIdInfo.Undecided altId } as altNameRefCell) ->
match ResolvePatternLongIdent cenv.tcSink cenv.nameResolver AllIdsOK false id.idRange env.eAccessRights env.eNameResEnv TypeNameResolutionInfo.Default [id] with
| Item.NewDef _ -> None // the name is not in scope as a pattern identifier (e.g. union case), so do not use the alternate ID
| _ -> altNameRefCell := SynSimplePatAlternativeIdInfo.Decided altId; Some altId // the name is in scope as a pattern identifier, so use the alternate ID
| Item.NewDef _ ->
// The name is not in scope as a pattern identifier (e.g. union case), so do not use the alternate ID
None
| _ ->
// The name is in scope as a pattern identifier, so use the alternate ID
altNameRefCell.Value <- SynSimplePatAlternativeIdInfo.Decided altId
Some altId
| Some {contents = SynSimplePatAlternativeIdInfo.Decided altId } -> Some altId
| None -> None

Expand Down
4 changes: 2 additions & 2 deletions src/fsharp/CompilerOptions.fs
Original file line number Diff line number Diff line change
Expand Up @@ -294,10 +294,10 @@ let ParseCompilerOptions (collectOtherArgument: string -> unit, blocks: Compiler
f (getSwitch opt); t
| CompilerOption(s, _, OptionSet f, d, _) :: _ when optToken = s && argString = "" ->
reportDeprecatedOption d
f := true; t
f.Value <- true; t
| CompilerOption(s, _, OptionClear f, d, _) :: _ when optToken = s && argString = "" ->
reportDeprecatedOption d
f := false; t
f.Value <- false; t
| CompilerOption(s, _, OptionString f, d, _) as compilerOption :: _ when optToken = s ->
reportDeprecatedOption d
let oa = getOptionArg compilerOption argString
Expand Down
3 changes: 1 addition & 2 deletions src/fsharp/FSharp.Build/FSharp.Build.fsproj
Original file line number Diff line number Diff line change
Expand Up @@ -7,9 +7,8 @@
<TargetFramework Condition="'$(Configuration)' != 'Proto'">netstandard2.0</TargetFramework>
<TargetFrameworks Condition="'$(Configuration)' == 'Proto'">netstandard2.0</TargetFrameworks>
<AssemblyName>FSharp.Build</AssemblyName>
<NoWarn>$(NoWarn);45;55;62;75;1204</NoWarn>
<NoWarn>$(NoWarn);75</NoWarn> <!-- InternalCommandLineOption -->
<AllowCrossTargeting>true</AllowCrossTargeting>
<OtherFlags>$(OtherFlags) --maxerrors:20 --extraoptimizationloops:1</OtherFlags>
<DefineConstants>$(DefineConstants);LOCALIZATION_FSBUILD</DefineConstants>
<NoWarn>NU1701;FS0075</NoWarn>
<CopyLocalLockFileAssemblies>true</CopyLocalLockFileAssemblies>
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -6,9 +6,7 @@
<OutputType>Library</OutputType>
<TargetFrameworks>netstandard2.0</TargetFrameworks>
<AssemblyName>FSharp.Compiler.Interactive.Settings</AssemblyName>
<NoWarn>$(NoWarn);45;55;62;75;1182;1204</NoWarn>
<AllowCrossTargeting>true</AllowCrossTargeting>
<OtherFlags>$(OtherFlags) --maxerrors:20 --extraoptimizationloops:1</OtherFlags>
</PropertyGroup>

<ItemGroup>
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -5,12 +5,16 @@
<PropertyGroup>
<TargetFrameworks>net472;netstandard2.0</TargetFrameworks>
<OutputType>Library</OutputType>
<NoWarn>$(NoWarn);44;45;54;55;57;61;62;69;65;75;1204;2003;NU5125</NoWarn>
<NoWarn>$(NoWarn);44</NoWarn> <!-- Obsolete -->
<NoWarn>$(NoWarn);57</NoWarn> <!-- Experimental -->
<NoWarn>$(NoWarn);75</NoWarn> <!-- InternalCommandLineOption -->
<NoWarn>$(NoWarn);1204</NoWarn> <!-- This construct is for use in the FSharp.Core library and should not be used directly -->
<NoWarn>$(NoWarn);NU5125</NoWarn>
<AssemblyName>FSharp.Compiler.Service</AssemblyName>
<AllowCrossTargeting>true</AllowCrossTargeting>
<DefineConstants>$(DefineConstants);COMPILER</DefineConstants>
<DefineConstants>$(DefineConstants);ENABLE_MONO_SUPPORT</DefineConstants>
<OtherFlags>$(OtherFlags) /warnon:3218 /warnon:1182 /warnon:3390 --maxerrors:20 --extraoptimizationloops:1 --times</OtherFlags>
<OtherFlags>$(OtherFlags) /warnon:3218 /warnon:1182 /warnon:3390 --extraoptimizationloops:1 --times</OtherFlags>
<Tailcalls>true</Tailcalls> <!-- .tail annotations always emitted for this binary, even in debug mode -->
<FsYaccOutputFolder>$(IntermediateOutputPath)$(TargetFramework)\</FsYaccOutputFolder>
<FsLexOutputFolder>$(IntermediateOutputPath)$(TargetFramework)\</FsLexOutputFolder>
Expand Down
4 changes: 3 additions & 1 deletion src/fsharp/FSharp.Core/FSharp.Core.fsproj
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,9 @@
<PropertyGroup>
<OutputType>Library</OutputType>
<TargetFrameworks>netstandard2.1;netstandard2.0</TargetFrameworks>
<NoWarn>$(NoWarn);45;55;62;75;1204</NoWarn>
<NoWarn>$(NoWarn);62</NoWarn> <!-- ML Compat -->
<NoWarn>$(NoWarn);75</NoWarn> <!-- InternalCommandLineOption -->
<NoWarn>$(NoWarn);1204</NoWarn> <!-- This construct is for use in the FSharp.Core library and should not be used directly -->
<AllowCrossTargeting>true</AllowCrossTargeting>
<DefineConstants>$(DefineConstants);FSHARP_CORE</DefineConstants>
<DefineConstants Condition="'$(Configuration)' == 'Proto'">BUILDING_WITH_LKG;$(DefineConstants)</DefineConstants>
Expand Down
69 changes: 40 additions & 29 deletions src/fsharp/FSharp.Core/seq.fs
Original file line number Diff line number Diff line change
Expand Up @@ -980,46 +980,57 @@ namespace Microsoft.FSharp.Collections
// * the prefix followed by elts from the enumerator are the initial sequence.
// * the prefix contains only as many elements as the longest enumeration so far.
let prefix = ResizeArray<_>()
let enumeratorR = ref None
// None = Unstarted.
// Some(Some e) = Started.
// Some None = Finished.

// None = Unstarted.
// Some(Some e) = Started.
// Some None = Finished.
let mutable enumeratorR = None

let oneStepTo i =
// If possible, step the enumeration to prefix length i (at most one step).
// Be speculative, since this could have already happened via another thread.
if not (i < prefix.Count) then // is a step still required?
if i >= prefix.Count then // is a step still required?
// If not yet started, start it (create enumerator).
match !enumeratorR with
| None -> enumeratorR := Some (Some (source.GetEnumerator()))
| Some _ -> ()
match (!enumeratorR).Value with
| Some enumerator -> if enumerator.MoveNext() then
prefix.Add(enumerator.Current)
else
enumerator.Dispose() // Move failed, dispose enumerator,
enumeratorR := Some None // drop it and record finished.
let optEnumerator =
match enumeratorR with
| None ->
let optEnumerator = Some (source.GetEnumerator())
enumeratorR <- Some optEnumerator
optEnumerator
| Some optEnumerator ->
optEnumerator

match optEnumerator with
| Some enumerator ->
if enumerator.MoveNext() then
prefix.Add(enumerator.Current)
else
enumerator.Dispose() // Move failed, dispose enumerator,
enumeratorR <- Some None // drop it and record finished.
| None -> ()

let result =
unfold (fun i ->
// i being the next position to be returned
// A lock is needed over the reads to prefix.Count since the list may be being resized
// NOTE: we could change to a reader/writer lock here
lock enumeratorR (fun () ->
if i < prefix.Count then
Some (prefix.[i],i+1)
else
oneStepTo i
if i < prefix.Count then
Some (prefix.[i],i+1)
else
None)) 0
// i being the next position to be returned
// A lock is needed over the reads to prefix.Count since the list may be being resized
// NOTE: we could change to a reader/writer lock here
lock prefix (fun () ->
if i < prefix.Count then
Some (prefix.[i],i+1)
else
oneStepTo i
if i < prefix.Count then
Some (prefix.[i],i+1)
else
None)) 0
let cleanup() =
lock enumeratorR (fun () ->
lock prefix (fun () ->
prefix.Clear()
match !enumeratorR with
match enumeratorR with
| Some (Some e) -> IEnumerator.dispose e
| _ -> ()
enumeratorR := None)
enumeratorR <- None)

(new CachedSeq<_>(cleanup, result) :> seq<_>)

[<CompiledName("AllPairs")>]
Expand Down
Loading