Skip to content

Commit

Permalink
Allow ParsedHashDirectives to take non string arguments (dotnet#17206)
Browse files Browse the repository at this point in the history
* Enable extended ParsedHashDirectiveArgument

* no need for nowarn

* time

* String only directives

* disable #r

* comment +errors

* feedback

* null ref

* tests

* fantomas

* fsharpqa

* #help work with longidents and idents

---------

Co-authored-by: Petr <[email protected]>
  • Loading branch information
KevinRansom and psfinaki authored Jun 17, 2024
1 parent e8015d1 commit 836d4e0
Show file tree
Hide file tree
Showing 52 changed files with 955 additions and 311 deletions.
2 changes: 2 additions & 0 deletions docs/release-notes/.FSharp.Compiler.Service/8.0.400.md
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,8 @@
### Added

* Generate new `Equals` overload to avoid boxing for structural comparison ([PR #16857](https://github.com/dotnet/fsharp/pull/16857))
* Allow #nowarn to support the FS prefix on error codes to disable warnings ([Issue #17206](https://github.com/dotnet/fsharp/issues/16447), [PR #17209](https://github.com/dotnet/fsharp/pull/17209))
* Allow ParsedHashDirectives to have argument types other than strings ([Issue #17240](https://github.com/dotnet/fsharp/issues/16447), [PR #17209](https://github.com/dotnet/fsharp/pull/17209))
* Parser: better recovery for unfinished patterns ([PR #17231](https://github.com/dotnet/fsharp/pull/17231))
* Parser: recover on empty match clause ([PR #17233](https://github.com/dotnet/fsharp/pull/17233))

Expand Down
2 changes: 2 additions & 0 deletions docs/release-notes/.Language/preview.md
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,8 @@
* Bidirectional F#/C# interop for 'unmanaged' constraint. ([PR #12154](https://github.com/dotnet/fsharp/pull/12154))
* Make `.Is*` discriminated union properties visible. ([Language suggestion #222](https://github.com/fsharp/fslang-suggestions/issues/222), [PR #16341](https://github.com/dotnet/fsharp/pull/16341))
* Allow returning bool instead of unit option for partial active patterns. ([Language suggestion #1041](https://github.com/fsharp/fslang-suggestions/issues/1041), [PR #16473](https://github.com/dotnet/fsharp/pull/16473))
* Allow #nowarn to support the FS prefix on error codes to disable warnings ([Issue #17206](https://github.com/dotnet/fsharp/issues/16447), [PR #17209](https://github.com/dotnet/fsharp/pull/17209))
* Allow ParsedHashDirectives to have argument types other than strings ([Issue #17240](https://github.com/dotnet/fsharp/issues/16447), [PR #17209](https://github.com/dotnet/fsharp/pull/17209))

### Fixed

Expand Down
21 changes: 12 additions & 9 deletions src/Compiler/Driver/CompilerConfig.fs
Original file line number Diff line number Diff line change
Expand Up @@ -91,16 +91,19 @@ let ResolveFileUsingPaths (paths, m, fileName) =
let searchMessage = String.concat "\n " paths
raise (FileNameNotResolved(fileName, searchMessage, m))

let GetWarningNumber (m, warningNumber: string) =
let GetWarningNumber (m, warningNumber: string, prefixSupported) =
try
// Okay so ...
// #pragma strips FS of the #pragma "FS0004" and validates the warning number
// therefore if we have warning id that starts with a numeric digit we convert it to Some (int32)
// anything else is ignored None
let warningNumber =
if warningNumber.StartsWithOrdinal "FS" then
if prefixSupported then
warningNumber.Substring 2
else
raise (new ArgumentException())
else
warningNumber

if Char.IsDigit(warningNumber[0]) then
Some(int32 warningNumber)
elif warningNumber.StartsWithOrdinal "FS" then
raise (ArgumentException())
else
None
with _ ->
Expand Down Expand Up @@ -918,7 +921,7 @@ type TcConfigBuilder =
member tcConfigB.TurnWarningOff(m, s: string) =
use _ = UseBuildPhase BuildPhase.Parameter

match GetWarningNumber(m, s) with
match GetWarningNumber(m, s, tcConfigB.langVersion.SupportsFeature(LanguageFeature.ParsedHashDirectiveArgumentNonQuotes)) with
| None -> ()
| Some n ->
// nowarn:62 turns on mlCompatibility, e.g. shows ML compat items in intellisense menus
Expand All @@ -933,7 +936,7 @@ type TcConfigBuilder =
member tcConfigB.TurnWarningOn(m, s: string) =
use _ = UseBuildPhase BuildPhase.Parameter

match GetWarningNumber(m, s) with
match GetWarningNumber(m, s, tcConfigB.langVersion.SupportsFeature(LanguageFeature.ParsedHashDirectiveArgumentNonQuotes)) with
| None -> ()
| Some n ->
// warnon 62 turns on mlCompatibility, e.g. shows ML compat items in intellisense menus
Expand Down
2 changes: 1 addition & 1 deletion src/Compiler/Driver/CompilerConfig.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -916,7 +916,7 @@ val TryResolveFileUsingPaths: paths: string seq * m: range * fileName: string ->

val ResolveFileUsingPaths: paths: string seq * m: range * fileName: string -> string

val GetWarningNumber: m: range * warningNumber: string -> int option
val GetWarningNumber: m: range * warningNumber: string * prefixSupported: bool -> int option

/// Get the name used for FSharp.Core
val GetFSharpCoreLibraryName: unit -> string
Expand Down
122 changes: 83 additions & 39 deletions src/Compiler/Driver/ParseAndCheckInputs.fs
Original file line number Diff line number Diff line change
Expand Up @@ -216,17 +216,26 @@ let PostParseModuleSpec (_i, defaultNamespace, isLastCompiland, fileName, intf)

SynModuleOrNamespaceSig(lid, isRecursive, kind, decls, xmlDoc, attributes, None, range, trivia)

let GetScopedPragmasForHashDirective hd =
let GetScopedPragmasForHashDirective hd (langVersion: LanguageVersion) =
let supportsNonStringArguments =
langVersion.SupportsFeature(LanguageFeature.ParsedHashDirectiveArgumentNonQuotes)

[
match hd with
| ParsedHashDirective("nowarn", numbers, m) ->
for s in numbers do
match s with
| ParsedHashDirectiveArgument.SourceIdentifier _ -> ()
| ParsedHashDirectiveArgument.String(s, _, _) ->
match GetWarningNumber(m, s) with
| None -> ()
| Some n -> ScopedPragma.WarningOff(m, n)
let warningNumber =
match supportsNonStringArguments, s with
| _, ParsedHashDirectiveArgument.SourceIdentifier _ -> None
| true, ParsedHashDirectiveArgument.LongIdent _ -> None
| true, ParsedHashDirectiveArgument.Int32(n, _) -> GetWarningNumber(m, string n, true)
| true, ParsedHashDirectiveArgument.Ident(s, _) -> GetWarningNumber(m, s.idText, true)
| _, ParsedHashDirectiveArgument.String(s, _, _) -> GetWarningNumber(m, s, true)
| _ -> None

match warningNumber with
| None -> ()
| Some n -> ScopedPragma.WarningOff(m, n)
| _ -> ()
]

Expand Down Expand Up @@ -272,10 +281,10 @@ let PostParseModuleImpls
for SynModuleOrNamespace(decls = decls) in impls do
for d in decls do
match d with
| SynModuleDecl.HashDirective(hd, _) -> yield! GetScopedPragmasForHashDirective hd
| SynModuleDecl.HashDirective(hd, _) -> yield! GetScopedPragmasForHashDirective hd lexbuf.LanguageVersion
| _ -> ()
for hd in hashDirectives do
yield! GetScopedPragmasForHashDirective hd
yield! GetScopedPragmasForHashDirective hd lexbuf.LanguageVersion
]

let conditionalDirectives = LexbufIfdefStore.GetTrivia(lexbuf)
Expand Down Expand Up @@ -323,10 +332,10 @@ let PostParseModuleSpecs
for SynModuleOrNamespaceSig(decls = decls) in specs do
for d in decls do
match d with
| SynModuleSigDecl.HashDirective(hd, _) -> yield! GetScopedPragmasForHashDirective hd
| SynModuleSigDecl.HashDirective(hd, _) -> yield! GetScopedPragmasForHashDirective hd lexbuf.LanguageVersion
| _ -> ()
for hd in hashDirectives do
yield! GetScopedPragmasForHashDirective hd
yield! GetScopedPragmasForHashDirective hd lexbuf.LanguageVersion
]

let conditionalDirectives = LexbufIfdefStore.GetTrivia(lexbuf)
Expand Down Expand Up @@ -888,55 +897,90 @@ let ProcessMetaCommandsFromInput

try
match hash with
| ParsedHashDirective("I", ParsedHashDirectiveArguments args, m) ->
| ParsedHashDirective("I", [ path ], m) ->
if not canHaveScriptMetaCommands then
errorR (HashIncludeNotAllowedInNonScript m)
else
let arguments = parsedHashDirectiveStringArguments [ path ] tcConfig.langVersion

match args with
| [ path ] ->
matchedm <- m
tcConfig.AddIncludePath(m, path, pathOfMetaCommandSource)
state
| _ ->
errorR (Error(FSComp.SR.buildInvalidHashIDirective (), m))
state
| ParsedHashDirective("nowarn", ParsedHashDirectiveArguments numbers, m) ->
List.fold (fun state d -> nowarnF state (m, d)) state numbers
match arguments with
| [ path ] ->
matchedm <- m
tcConfig.AddIncludePath(m, path, pathOfMetaCommandSource)
| _ -> errorR (Error(FSComp.SR.buildInvalidHashIDirective (), m))

| ParsedHashDirective(("reference" | "r"), ParsedHashDirectiveArguments args, m) ->
matchedm <- m
ProcessDependencyManagerDirective Directive.Resolution args m state
state

| ParsedHashDirective("i", ParsedHashDirectiveArguments args, m) ->
matchedm <- m
ProcessDependencyManagerDirective Directive.Include args m state
| ParsedHashDirective("nowarn", hashArguments, m) ->
let arguments = parsedHashDirectiveArguments hashArguments tcConfig.langVersion
List.fold (fun state d -> nowarnF state (m, d)) state arguments

| ParsedHashDirective("load", ParsedHashDirectiveArguments args, m) ->
| ParsedHashDirective(("reference" | "r") as c, [], m) ->
if not canHaveScriptMetaCommands then
errorR (HashDirectiveNotAllowedInNonScript m)
else
let arg = (parsedHashDirectiveArguments [] tcConfig.langVersion)
warning (Error((FSComp.SR.fsiInvalidDirective (c, String.concat " " arg)), m))

state

| ParsedHashDirective(("reference" | "r"), [ reference ], m) ->
if not canHaveScriptMetaCommands then
errorR (HashDirectiveNotAllowedInNonScript m)
state
else
let arguments =
parsedHashDirectiveStringArguments [ reference ] tcConfig.langVersion

match arguments with
| [ reference ] ->
matchedm <- m
ProcessDependencyManagerDirective Directive.Resolution [ reference ] m state
| _ -> state

match args with
| _ :: _ ->
| ParsedHashDirective("i", [ path ], m) ->
if not canHaveScriptMetaCommands then
errorR (HashDirectiveNotAllowedInNonScript m)
state
else
matchedm <- m
args |> List.iter (fun path -> loadSourceF state (m, path))
| _ -> errorR (Error(FSComp.SR.buildInvalidHashloadDirective (), m))
let arguments = parsedHashDirectiveStringArguments [ path ] tcConfig.langVersion

match arguments with
| [ path ] -> ProcessDependencyManagerDirective Directive.Include [ path ] m state
| _ -> state

| ParsedHashDirective("load", paths, m) ->
if not canHaveScriptMetaCommands then
errorR (HashDirectiveNotAllowedInNonScript m)
else
let arguments = parsedHashDirectiveArguments paths tcConfig.langVersion

match arguments with
| _ :: _ ->
matchedm <- m
arguments |> List.iter (fun path -> loadSourceF state (m, path))
| _ -> errorR (Error(FSComp.SR.buildInvalidHashloadDirective (), m))

state
| ParsedHashDirective("time", ParsedHashDirectiveArguments args, m) ->

| ParsedHashDirective("time", switch, m) ->
if not canHaveScriptMetaCommands then
errorR (HashDirectiveNotAllowedInNonScript m)
else
let arguments = parsedHashDirectiveArguments switch tcConfig.langVersion

match args with
| [] -> ()
| [ "on" | "off" ] -> ()
| _ -> errorR (Error(FSComp.SR.buildInvalidHashtimeDirective (), m))
match arguments with
| [] -> matchedm <- m
| [ "on" | "off" ] -> matchedm <- m
| _ -> errorR (Error(FSComp.SR.buildInvalidHashtimeDirective (), m))

state

| _ ->

(* warning(Error("This meta-command has been ignored", m)) *)
state

with RecoverableException e ->
errorRecovery e matchedm
state
Expand Down
3 changes: 3 additions & 0 deletions src/Compiler/FSComp.txt
Original file line number Diff line number Diff line change
Expand Up @@ -1752,3 +1752,6 @@ featureReuseSameFieldsInStructUnions,"Share underlying fields in a [<Struct>] di
3868,tcActivePatternArgsCountNotMatchOnlyPat,"This active pattern expects exactly one pattern argument, e.g., '%s pat'."
3868,tcActivePatternArgsCountNotMatchArgs,"This active pattern expects %d expression argument(s), e.g., '%s%s'."
3868,tcActivePatternArgsCountNotMatchArgsAndPat,"This active pattern expects %d expression argument(s) and a pattern argument, e.g., '%s%s pat'."
featureParsedHashDirectiveArgumentNonString,"# directives with non-quoted string arguments"
3869,featureParsedHashDirectiveUnexpectedInteger,"Unexpected integer literal '%d'."
3869,featureParsedHashDirectiveUnexpectedIdentifier,"Unexpected identifier '%s'."
6 changes: 3 additions & 3 deletions src/Compiler/FSStrings.resx
Original file line number Diff line number Diff line change
Expand Up @@ -1051,7 +1051,7 @@
<value>Override implementations should be given as part of the initial declaration of a type.</value>
</data>
<data name="IntfImplInIntrinsicAugmentation" xml:space="preserve">
<value>Interface implementations should normally be given on the initial declaration of a type. Interface implementations in augmentations may lead to accessing static bindings before they are initialized, though only if the interface implementation is invoked during initialization of the static data, and in turn access the static data. You may remove this warning using #nowarn "69" if you have checked this is not the case.</value>
<value>Interface implementations should normally be given on the initial declaration of a type. Interface implementations in augmentations may lead to accessing static bindings before they are initialized, though only if the interface implementation is invoked during initialization of the static data, and in turn access the static data. You may remove this warning using '#nowarn "69"' if you have checked this is not the case.</value>
</data>
<data name="IntfImplInExtrinsicAugmentation" xml:space="preserve">
<value>Interface implementations should be given on the initial declaration of a type.</value>
Expand All @@ -1063,10 +1063,10 @@
<value>The type referenced through '{0}' is defined in an assembly that is not referenced. You must add a reference to assembly '{1}'.</value>
</data>
<data name="HashIncludeNotAllowedInNonScript" xml:space="preserve">
<value>#I directives may only occur in F# script files (extensions .fsx or .fsscript). Either move this code to a script file, add a '-I' compiler option for this reference or delimit the directive with delimit it with '#if INTERACTIVE'/'#endif'.</value>
<value>#I directives may only be used in F# script files (extensions .fsx or .fsscript). Either move this code to a script file, add a '-I' compiler option for this reference or delimit the directive with delimit it with '#if INTERACTIVE'/'#endif'.</value>
</data>
<data name="HashReferenceNotAllowedInNonScript" xml:space="preserve">
<value>#r directives may only occur in F# script files (extensions .fsx or .fsscript). Either move this code to a script file or replace this reference with the '-r' compiler option. If this directive is being executed as user input, you may delimit it with '#if INTERACTIVE'/'#endif'.</value>
<value>#r directives may only be used in F# script files (extensions .fsx or .fsscript). Either move this code to a script file or replace this reference with the '-r' compiler option. If this directive is being executed as user input, you may delimit it with '#if INTERACTIVE'/'#endif'.</value>
</data>
<data name="HashDirectiveNotAllowedInNonScript" xml:space="preserve">
<value>This directive may only be used in F# script files (extensions .fsx or .fsscript). Either remove the directive, move this code to a script file or delimit the directive with '#if INTERACTIVE'/'#endif'.</value>
Expand Down
18 changes: 10 additions & 8 deletions src/Compiler/Facilities/DiagnosticsLogger.fs
Original file line number Diff line number Diff line change
Expand Up @@ -832,24 +832,26 @@ let internal languageFeatureError (langVersion: LanguageVersion) (langFeature: L
let suggestedVersionStr = LanguageVersion.GetFeatureVersionString langFeature
Error(FSComp.SR.chkFeatureNotLanguageSupported (featureStr, currentVersionStr, suggestedVersionStr), m)

let private tryLanguageFeatureErrorAux (langVersion: LanguageVersion) (langFeature: LanguageFeature) (m: range) =
let internal tryLanguageFeatureErrorOption (langVersion: LanguageVersion) (langFeature: LanguageFeature) (m: range) =
if not (langVersion.SupportsFeature langFeature) then
Some(languageFeatureError langVersion langFeature m)
else
None

let internal checkLanguageFeatureError langVersion langFeature m =
match tryLanguageFeatureErrorAux langVersion langFeature m with
match tryLanguageFeatureErrorOption langVersion langFeature m with
| Some e -> error e
| None -> ()

let internal checkLanguageFeatureAndRecover langVersion langFeature m =
match tryLanguageFeatureErrorAux langVersion langFeature m with
| Some e -> errorR e
| None -> ()
let internal tryCheckLanguageFeatureAndRecover langVersion langFeature m =
match tryLanguageFeatureErrorOption langVersion langFeature m with
| Some e ->
errorR e
false
| None -> true

let internal tryLanguageFeatureErrorOption langVersion langFeature m =
tryLanguageFeatureErrorAux langVersion langFeature m
let internal checkLanguageFeatureAndRecover langVersion langFeature m =
tryCheckLanguageFeatureAndRecover langVersion langFeature m |> ignore

let internal languageFeatureNotSupportedInLibraryError (langFeature: LanguageFeature) (m: range) =
let featureStr = LanguageVersion.GetFeatureString langFeature
Expand Down
2 changes: 2 additions & 0 deletions src/Compiler/Facilities/DiagnosticsLogger.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -438,6 +438,8 @@ val languageFeatureError: langVersion: LanguageVersion -> langFeature: LanguageF

val checkLanguageFeatureError: langVersion: LanguageVersion -> langFeature: LanguageFeature -> m: range -> unit

val tryCheckLanguageFeatureAndRecover: langVersion: LanguageVersion -> langFeature: LanguageFeature -> m: range -> bool

val checkLanguageFeatureAndRecover: langVersion: LanguageVersion -> langFeature: LanguageFeature -> m: range -> unit

val tryLanguageFeatureErrorOption:
Expand Down
3 changes: 3 additions & 0 deletions src/Compiler/Facilities/LanguageFeatures.fs
Original file line number Diff line number Diff line change
Expand Up @@ -89,6 +89,7 @@ type LanguageFeature =
| LowerInterpolatedStringToConcat
| LowerIntegralRangesToFastLoops
| LowerSimpleMappingsInComprehensionsToDirectCallsToMap
| ParsedHashDirectiveArgumentNonQuotes

/// LanguageVersion management
type LanguageVersion(versionText) =
Expand Down Expand Up @@ -205,6 +206,7 @@ type LanguageVersion(versionText) =
LanguageFeature.LowerInterpolatedStringToConcat, previewVersion
LanguageFeature.LowerIntegralRangesToFastLoops, previewVersion
LanguageFeature.LowerSimpleMappingsInComprehensionsToDirectCallsToMap, previewVersion
LanguageFeature.ParsedHashDirectiveArgumentNonQuotes, previewVersion
]

static let defaultLanguageVersion = LanguageVersion("default")
Expand Down Expand Up @@ -353,6 +355,7 @@ type LanguageVersion(versionText) =
| LanguageFeature.LowerIntegralRangesToFastLoops -> FSComp.SR.featureLowerIntegralRangesToFastLoops ()
| LanguageFeature.LowerSimpleMappingsInComprehensionsToDirectCallsToMap ->
FSComp.SR.featureLowerSimpleMappingsInComprehensionsToDirectCallsToMap ()
| LanguageFeature.ParsedHashDirectiveArgumentNonQuotes -> FSComp.SR.featureParsedHashDirectiveArgumentNonString ()

/// Get a version string associated with the given feature.
static member GetFeatureVersionString feature =
Expand Down
Loading

0 comments on commit 836d4e0

Please sign in to comment.