Skip to content
Draft
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
1 change: 1 addition & 0 deletions docs/release-notes/.FSharp.Compiler.Service/10.0.100.md
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,7 @@
* Add support for `when 'T : Enum` library-only static optimization constraint. ([PR #18546](https://github.com/dotnet/fsharp/pull/18546))
* Add support for tail calls in computation expressions ([PR #18804](https://github.com/dotnet/fsharp/pull/18804))
* Add `--typecheck-only` flag support for F# Interactive (FSI) scripts to type-check without execution. ([Issue #18686](https://github.com/dotnet/fsharp/issues/18686))
* Allow open declarations in expression scope. ([Suggestion](https://github.com/fsharp/fslang-suggestions/issues/96), [PR #18814](https://github.com/dotnet/fsharp/pull/18814))

### Fixed

Expand Down
1 change: 1 addition & 0 deletions docs/release-notes/.Language/preview.md
Original file line number Diff line number Diff line change
Expand Up @@ -11,6 +11,7 @@
* Allow `let!`, `use!`, `and!` type annotations without requiring parentheses (([PR #18508](https://github.com/dotnet/fsharp/pull/18508) and [PR #18682](https://github.com/dotnet/fsharp/pull/18682)))
* Exception names are now validated for illegal characters using the same mechanism as types/modules/namespaces ([Issue #18763](https://github.com/dotnet/fsharp/issues/18763))
* Support tail calls in computation expressions ([PR #18804](https://github.com/dotnet/fsharp/pull/18804))
* Allow open declarations in expression scope. ([Suggestion](https://github.com/fsharp/fslang-suggestions/issues/96), [PR #18814](https://github.com/dotnet/fsharp/pull/18814))

### Fixed

Expand Down
90 changes: 90 additions & 0 deletions src/Compiler/Checking/CheckBasics.fs
Original file line number Diff line number Diff line change
Expand Up @@ -379,3 +379,93 @@ type TcFileState =
}

override _.ToString() = "<cenv>"

open FSharp.Compiler.AttributeChecking
open FSharp.Compiler.Syntax.PrettyNaming
open FSharp.Compiler.Text.Range
open FSharp.Compiler.TypedTreeBasics

let CheckNamespaceModuleOrTypeName (g: TcGlobals) (id: Ident) =
// type names '[]' etc. are used in fslib
if not g.compilingFSharpCore && id.idText.IndexOfAny IllegalCharactersInTypeAndNamespaceNames <> -1 then
errorR(Error(FSComp.SR.tcInvalidNamespaceModuleTypeUnionName(), id.idRange))

/// Adjust the TcEnv to account for opening the set of modules or namespaces implied by an `open` declaration
let OpenModuleOrNamespaceRefs tcSink g amap scopem root env mvvs openDeclaration =
let env =
if isNil mvvs then env else
{ env with eNameResEnv = AddModuleOrNamespaceRefsContentsToNameEnv g amap env.eAccessRights scopem root env.eNameResEnv mvvs }
CallEnvSink tcSink (scopem, env.NameEnv, env.eAccessRights)
CallOpenDeclarationSink tcSink openDeclaration
env

//-------------------------------------------------------------------------
// Bind 'open' declarations
//-------------------------------------------------------------------------

let TcOpenLidAndPermitAutoResolve tcSink (env: TcEnv) amap (longId : Ident list) =
let ad = env.AccessRights
match longId with
| [] -> []
| id :: rest ->
let m = longId |> List.map (fun id -> id.idRange) |> List.reduce unionRanges
match ResolveLongIdentAsModuleOrNamespace tcSink amap m true OpenQualified env.NameEnv ad id rest true ShouldNotifySink.Yes with
| Result res -> res
| Exception err ->
errorR(err); []

let TcOpenModuleOrNamespaceDecl tcSink g amap scopem env (longId, m) =
match TcOpenLidAndPermitAutoResolve tcSink env amap longId with
| [] -> env, []
| modrefs ->

// validate opened namespace names
for id in longId do
if id.idText <> MangledGlobalName then
CheckNamespaceModuleOrTypeName g id

let IsPartiallyQualifiedNamespace (modref: ModuleOrNamespaceRef) =
let (CompPath(_, _, p)) = modref.CompilationPath
// Bug FSharp 1.0 3274: FSI paths don't count when determining this warning
let p =
match p with
| [] -> []
| (h, _) :: t -> if h.StartsWithOrdinal FsiDynamicModulePrefix then t else p

// See https://fslang.uservoice.com/forums/245727-f-language/suggestions/6107641-make-microsoft-prefix-optional-when-using-core-f
let isFSharpCoreSpecialCase =
match ccuOfTyconRef modref with
| None -> false
| Some ccu ->
ccuEq ccu g.fslibCcu &&
// Check if we're using a reference one string shorter than what we expect.
//
// "p" is the fully qualified path _containing_ the thing we're opening, e.g. "Microsoft.FSharp" when opening "Microsoft.FSharp.Data"
// "longId" is the text being used, e.g. "FSharp.Data"
// Length of thing being opened = p.Length + 1
// Length of reference = longId.Length
// So the reference is a "shortened" reference if (p.Length + 1) - 1 = longId.Length
(p.Length + 1) - 1 = longId.Length &&
fst p[0] = "Microsoft"

modref.IsNamespace &&
p.Length >= longId.Length &&
not isFSharpCoreSpecialCase
// Allow "open Foo" for "Microsoft.Foo" from FSharp.Core

modrefs |> List.iter (fun (_, modref, _) ->
if modref.IsModule && HasFSharpAttribute g g.attrib_RequireQualifiedAccessAttribute modref.Attribs then
errorR(Error(FSComp.SR.tcModuleRequiresQualifiedAccess(fullDisplayTextOfModRef modref), m)))

// Bug FSharp 1.0 3133: 'open Lexing'. Skip this warning if we successfully resolved to at least a module name
if not (modrefs |> List.exists (fun (_, modref, _) -> modref.IsModule && not (HasFSharpAttribute g g.attrib_RequireQualifiedAccessAttribute modref.Attribs))) then
modrefs |> List.iter (fun (_, modref, _) ->
if IsPartiallyQualifiedNamespace modref then
errorR(Error(FSComp.SR.tcOpenUsedWithPartiallyQualifiedPath(fullDisplayTextOfModRef modref), m)))

let modrefs = List.map p23 modrefs
modrefs |> List.iter (fun modref -> CheckEntityAttributes g modref m |> CommitOperationResult)

let openDecl = OpenDeclaration.Create (SynOpenDeclTarget.ModuleOrNamespace (SynLongIdent(longId, [], []), m), modrefs, [], scopem, false)
let env = OpenModuleOrNamespaceRefs tcSink g amap scopem false env modrefs openDecl
env, [openDecl]
9 changes: 9 additions & 0 deletions src/Compiler/Checking/CheckBasics.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -358,3 +358,12 @@ type TcFileState =
-> range * Expr * TType * SynExpr
-> Expr * UnscopedTyparEnv) ->
TcFileState

val TcOpenModuleOrNamespaceDecl:
tcSink: TcResultsSink ->
g: TcGlobals ->
amap: Import.ImportMap ->
scopem: range ->
env: TcEnv ->
longId: LongIdent * m: range ->
TcEnv * OpenDeclaration list
102 changes: 2 additions & 100 deletions src/Compiler/Checking/CheckDeclarations.fs
Original file line number Diff line number Diff line change
Expand Up @@ -294,14 +294,6 @@ let OpenModuleOrNamespaceRefs tcSink g amap scopem root env mvvs openDeclaration
CallOpenDeclarationSink tcSink openDeclaration
env

/// Adjust the TcEnv to account for opening a type implied by an `open type` declaration
let OpenTypeContent tcSink g amap scopem env (ty: TType) openDeclaration =
let env =
{ env with eNameResEnv = AddTypeContentsToNameEnv g amap env.eAccessRights scopem env.eNameResEnv ty }
CallEnvSink tcSink (scopem, env.NameEnv, env.eAccessRights)
CallOpenDeclarationSink tcSink openDeclaration
env

/// Adjust the TcEnv to account for a new root Ccu being available, e.g. a referenced assembly
let AddRootModuleOrNamespaceRefs g amap m env modrefs =
if isNil modrefs then env else
Expand Down Expand Up @@ -681,99 +673,9 @@ let TcTyconMemberSpecs cenv env containerInfo declKind tpenv augSpfn =
// Bind 'open' declarations
//-------------------------------------------------------------------------

let TcOpenLidAndPermitAutoResolve tcSink (env: TcEnv) amap (longId : Ident list) =
let ad = env.AccessRights
match longId with
| [] -> []
| id :: rest ->
let m = longId |> List.map (fun id -> id.idRange) |> List.reduce unionRanges
match ResolveLongIdentAsModuleOrNamespace tcSink amap m true OpenQualified env.NameEnv ad id rest true ShouldNotifySink.Yes with
| Result res -> res
| Exception err ->
errorR(err); []

let TcOpenModuleOrNamespaceDecl tcSink g amap scopem env (longId, m) =
match TcOpenLidAndPermitAutoResolve tcSink env amap longId with
| [] -> env, []
| modrefs ->

// validate opened namespace names
for id in longId do
if id.idText <> MangledGlobalName then
CheckNamespaceModuleOrTypeName g id

let IsPartiallyQualifiedNamespace (modref: ModuleOrNamespaceRef) =
let (CompPath(_, _, p)) = modref.CompilationPath
// Bug FSharp 1.0 3274: FSI paths don't count when determining this warning
let p =
match p with
| [] -> []
| (h, _) :: t -> if h.StartsWithOrdinal FsiDynamicModulePrefix then t else p

// See https://fslang.uservoice.com/forums/245727-f-language/suggestions/6107641-make-microsoft-prefix-optional-when-using-core-f
let isFSharpCoreSpecialCase =
match ccuOfTyconRef modref with
| None -> false
| Some ccu ->
ccuEq ccu g.fslibCcu &&
// Check if we're using a reference one string shorter than what we expect.
//
// "p" is the fully qualified path _containing_ the thing we're opening, e.g. "Microsoft.FSharp" when opening "Microsoft.FSharp.Data"
// "longId" is the text being used, e.g. "FSharp.Data"
// Length of thing being opened = p.Length + 1
// Length of reference = longId.Length
// So the reference is a "shortened" reference if (p.Length + 1) - 1 = longId.Length
(p.Length + 1) - 1 = longId.Length &&
fst p[0] = "Microsoft"

modref.IsNamespace &&
p.Length >= longId.Length &&
not isFSharpCoreSpecialCase
// Allow "open Foo" for "Microsoft.Foo" from FSharp.Core

modrefs |> List.iter (fun (_, modref, _) ->
if modref.IsModule && HasFSharpAttribute g g.attrib_RequireQualifiedAccessAttribute modref.Attribs then
errorR(Error(FSComp.SR.tcModuleRequiresQualifiedAccess(fullDisplayTextOfModRef modref), m)))

// Bug FSharp 1.0 3133: 'open Lexing'. Skip this warning if we successfully resolved to at least a module name
if not (modrefs |> List.exists (fun (_, modref, _) -> modref.IsModule && not (HasFSharpAttribute g g.attrib_RequireQualifiedAccessAttribute modref.Attribs))) then
modrefs |> List.iter (fun (_, modref, _) ->
if IsPartiallyQualifiedNamespace modref then
errorR(Error(FSComp.SR.tcOpenUsedWithPartiallyQualifiedPath(fullDisplayTextOfModRef modref), m)))

let modrefs = List.map p23 modrefs
modrefs |> List.iter (fun modref -> CheckEntityAttributes g modref m |> CommitOperationResult)

let openDecl = OpenDeclaration.Create (SynOpenDeclTarget.ModuleOrNamespace (SynLongIdent(longId, [], []), m), modrefs, [], scopem, false)
let env = OpenModuleOrNamespaceRefs tcSink g amap scopem false env modrefs openDecl
env, [openDecl]

let TcOpenTypeDecl (cenv: cenv) mOpenDecl scopem env (synType: SynType, m) =
let g = cenv.g

checkLanguageFeatureError g.langVersion LanguageFeature.OpenTypeDeclaration mOpenDecl

let ty, _tpenv = TcType cenv NoNewTypars CheckCxs ItemOccurrence.Open WarnOnIWSAM.Yes env emptyUnscopedTyparEnv synType

if not (isAppTy g ty) then
errorR(Error(FSComp.SR.tcNamedTypeRequired("open type"), m))

if isByrefTy g ty then
errorR(Error(FSComp.SR.tcIllegalByrefsInOpenTypeDeclaration(), m))

let openDecl = OpenDeclaration.Create (SynOpenDeclTarget.Type (synType, m), [], [ty], scopem, false)
let env = OpenTypeContent cenv.tcSink g cenv.amap scopem env ty openDecl
env, [openDecl]

let TcOpenDecl (cenv: cenv) mOpenDecl scopem env target =
let g = cenv.g
match target with
| SynOpenDeclTarget.ModuleOrNamespace (longId, m) ->
TcOpenModuleOrNamespaceDecl cenv.tcSink g cenv.amap scopem env (longId.LongIdent, m)

| SynOpenDeclTarget.Type (synType, m) ->
TcOpenTypeDecl cenv mOpenDecl scopem env (synType, m)

CheckBasics.TcOpenModuleOrNamespaceDecl tcSink g amap scopem env (longId, m)

let MakeSafeInitField (cenv: cenv) env m isStatic =
let id =
// Ensure that we have an g.CompilerGlobalState
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -2242,6 +2242,10 @@ let rec TryTranslateComputationExpression

Some(translatedCtxt yieldOrReturnCall)

| SynExpr.Open(target, mOpen, m, body) ->
let body = TranslateComputationExpressionNoQueryOps ceenv body
Some(translatedCtxt (SynExpr.Open(target, mOpen, m, body)))

| _ -> None

and ConsumeCustomOpClauses
Expand Down
40 changes: 40 additions & 0 deletions src/Compiler/Checking/Expressions/CheckExpressions.fs
Original file line number Diff line number Diff line change
Expand Up @@ -4052,6 +4052,14 @@ type ImplicitlyBoundTyparsAllowed =
| NewTyparsOK
| NoNewTypars

/// Adjust the TcEnv to account for opening a type implied by an `open type` declaration
let OpenTypeContent tcSink g amap scopem env (ty: TType) openDeclaration =
let env =
{ env with eNameResEnv = AddTypeContentsToNameEnv g amap env.eAccessRights scopem env.eNameResEnv ty }
CallEnvSink tcSink (scopem, env.NameEnv, env.eAccessRights)
CallOpenDeclarationSink tcSink openDeclaration
env

//-------------------------------------------------------------------------
// Checking types and type constraints
//-------------------------------------------------------------------------
Expand Down Expand Up @@ -6083,6 +6091,11 @@ and TcExprUndelayed (cenv: cenv) (overallTy: OverallTy) env tpenv (synExpr: SynE
| SynExpr.IndexRange (range=m) ->
error(Error(FSComp.SR.tcInvalidIndexerExpression(), m))

| SynExpr.Open (target, mOpen, _m, body) ->
checkLanguageFeatureAndRecover g.langVersion LanguageFeature.OpensInExpressionScope mOpen
let env, _openDecls = TcOpenDecl cenv mOpen body.Range env target
TcExprThatCanBeCtorBody cenv overallTy env tpenv body

and TcExprMatch (cenv: cenv) overallTy env tpenv synInputExpr spMatch synClauses =
let inputExpr, inputTy, tpenv =
let env = { env with eIsControlFlow = false }
Expand Down Expand Up @@ -9205,6 +9218,7 @@ and TcImplicitOpItemThen (cenv: cenv) overallTy env id sln tpenv mItem delayed =
| SynExpr.TraitCall _
| SynExpr.IndexFromEnd _
| SynExpr.IndexRange _
| SynExpr.Open _
-> false

// Propagate the known application structure into function types
Expand Down Expand Up @@ -12840,6 +12854,32 @@ and TcLetrecBindings overridesOK (cenv: cenv) env tpenv (binds, bindsm, scopem)
let envbody = AddLocalVals g cenv.tcSink scopem prelimRecValues env
binds, envbody, tpenv

and TcOpenTypeDecl (cenv: cenv) mOpenDecl scopem env (synType: SynType, m) =
let g = cenv.g

checkLanguageFeatureError g.langVersion LanguageFeature.OpenTypeDeclaration mOpenDecl

let ty, _tpenv = TcType cenv NoNewTypars CheckCxs ItemOccurrence.Open WarnOnIWSAM.Yes env emptyUnscopedTyparEnv synType

if not (isAppTy g ty) then
errorR(Error(FSComp.SR.tcNamedTypeRequired("open type"), m))

if isByrefTy g ty then
errorR(Error(FSComp.SR.tcIllegalByrefsInOpenTypeDeclaration(), m))

let openDecl = OpenDeclaration.Create (SynOpenDeclTarget.Type (synType, m), [], [ty], scopem, false)
let env = OpenTypeContent cenv.tcSink g cenv.amap scopem env ty openDecl
env, [openDecl]

and TcOpenDecl (cenv: cenv) mOpenDecl scopem env target =
let g = cenv.g
match target with
| SynOpenDeclTarget.ModuleOrNamespace (longId, m) ->
TcOpenModuleOrNamespaceDecl cenv.tcSink g cenv.amap scopem env (longId.LongIdent, m)

| SynOpenDeclTarget.Type (synType, m) ->
TcOpenTypeDecl cenv mOpenDecl scopem env (synType, m)

//-------------------------------------------------------------------------
// Bind specifications of values
//-------------------------------------------------------------------------
Expand Down
8 changes: 8 additions & 0 deletions src/Compiler/Checking/Expressions/CheckExpressions.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -883,6 +883,14 @@ val TcRuntimeTypeTest:
srcTy: TType ->
unit

val TcOpenDecl:
cenv: TcFileState ->
mOpenDecl: range ->
scopem: range ->
env: TcEnv ->
target: SynOpenDeclTarget ->
TcEnv * OpenDeclaration list

/// Allow the inference of structness from the known type, e.g.
/// let (x: struct (int * int)) = (3,4)
val UnifyTupleTypeAndInferCharacteristics:
Expand Down
1 change: 1 addition & 0 deletions src/Compiler/Driver/GraphChecking/FileContentMapping.fs
Original file line number Diff line number Diff line change
Expand Up @@ -574,6 +574,7 @@ let visitSynExpr (e: SynExpr) : FileContentEntry list =
| SynExpr.Dynamic(funcExpr, _, argExpr, _) ->
let continuations = List.map visit [ funcExpr; argExpr ]
Continuation.concatenate continuations continuation
| SynExpr.Open(body = body) -> visit body continuation

visit e id

Expand Down
1 change: 1 addition & 0 deletions src/Compiler/FSComp.txt
Original file line number Diff line number Diff line change
Expand Up @@ -1809,3 +1809,4 @@ featureAllowLetOrUseBangTypeAnnotationWithoutParens,"Allow let! and use! type an
3877,lexLineDirectiveMappingIsNotUnique,"The file '%s' was also pointed to in a line directive in '%s'. Proper warn directive application may not be possible."
3878,tcAttributeIsNotValidForUnionCaseWithFields,"This attribute is not valid for use on union cases with fields."
featureReturnFromFinal,"Support for ReturnFromFinal/YieldFromFinal in computation expressions to enable tailcall optimization when available on the builder."
featureOpensInExpressionScope,"'open' declarations in expression scopes"
3 changes: 3 additions & 0 deletions src/Compiler/Facilities/LanguageFeatures.fs
Original file line number Diff line number Diff line change
Expand Up @@ -104,6 +104,7 @@ type LanguageFeature =
| ScopedNowarn
| AllowTypedLetUseAndBang
| ReturnFromFinal
| OpensInExpressionScope

/// LanguageVersion management
type LanguageVersion(versionText) =
Expand Down Expand Up @@ -243,6 +244,7 @@ type LanguageVersion(versionText) =

// F# preview (still preview in 10.0)
LanguageFeature.FromEndSlicing, previewVersion // Unfinished features --- needs work
LanguageFeature.OpensInExpressionScope, previewVersion
]

static let defaultLanguageVersion = LanguageVersion("default")
Expand Down Expand Up @@ -412,6 +414,7 @@ type LanguageVersion(versionText) =
| LanguageFeature.ScopedNowarn -> FSComp.SR.featureScopedNowarn ()
| LanguageFeature.AllowTypedLetUseAndBang -> FSComp.SR.featureAllowLetOrUseBangTypeAnnotationWithoutParens ()
| LanguageFeature.ReturnFromFinal -> FSComp.SR.featureReturnFromFinal ()
| LanguageFeature.OpensInExpressionScope -> FSComp.SR.featureOpensInExpressionScope ()

/// Get a version string associated with the given feature.
static member GetFeatureVersionString feature =
Expand Down
1 change: 1 addition & 0 deletions src/Compiler/Facilities/LanguageFeatures.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -95,6 +95,7 @@ type LanguageFeature =
| ScopedNowarn
| AllowTypedLetUseAndBang
| ReturnFromFinal
| OpensInExpressionScope

/// LanguageVersion management
type LanguageVersion =
Expand Down
1 change: 1 addition & 0 deletions src/Compiler/Service/FSharpParseFileResults.fs
Original file line number Diff line number Diff line change
Expand Up @@ -771,6 +771,7 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput,
yield! walkExpr true eAndBang

yield! walkExpr true bodyExpr
| SynExpr.Open(body = bodyExpr) -> yield! walkExpr true bodyExpr
]

// Process a class declaration or F# type declaration
Expand Down
3 changes: 2 additions & 1 deletion src/Compiler/Service/ServiceParseTreeWalk.fs
Original file line number Diff line number Diff line change
Expand Up @@ -423,7 +423,8 @@ module SyntaxTraversal =
| SynExpr.TypeApp(expr = synExpr)
| SynExpr.DotLambda(expr = synExpr)
| SynExpr.Quote(quotedExpr = synExpr)
| SynExpr.Paren(expr = synExpr) -> traverseSynExpr synExpr
| SynExpr.Paren(expr = synExpr)
| SynExpr.Open(body = synExpr) -> traverseSynExpr synExpr

| SynExpr.InterpolatedString(contents = parts) ->
[
Expand Down
Loading