Skip to content
Merged
Show file tree
Hide file tree
Changes from 6 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
4 changes: 2 additions & 2 deletions src/fsharp/CheckDeclarations.fs
Original file line number Diff line number Diff line change
Expand Up @@ -5959,7 +5959,7 @@ let TypeCheckOneImplFile
rootSigOpt: ModuleOrNamespaceType option,
synImplFile) =

let (ParsedImplFileInput (_, isScript, qualNameOfFile, scopedPragmas, _, implFileFrags, isLastCompiland)) = synImplFile
let (ParsedImplFileInput (_, isScript, qualNameOfFile, scopedPragmas, _, implFileFrags, isLastCompiland, _)) = synImplFile
let infoReader = InfoReader(g, amap)

cancellable {
Expand Down Expand Up @@ -6080,7 +6080,7 @@ let TypeCheckOneImplFile


/// Check an entire signature file
let TypeCheckOneSigFile (g, niceNameGen, amap, topCcu, checkForErrors, conditionalDefines, tcSink, isInternalTestSpanStackReferring) tcEnv (ParsedSigFileInput (_, qualNameOfFile, _, _, sigFileFrags)) =
let TypeCheckOneSigFile (g, niceNameGen, amap, topCcu, checkForErrors, conditionalDefines, tcSink, isInternalTestSpanStackReferring) tcEnv (ParsedSigFileInput (qualifiedNameOfFile = qualNameOfFile; modules = sigFileFrags)) =
cancellable {
let cenv =
cenv.Create
Expand Down
48 changes: 27 additions & 21 deletions src/fsharp/ParseAndCheckInputs.fs
Original file line number Diff line number Diff line change
Expand Up @@ -80,11 +80,11 @@ let PrependPathToSpec x (SynModuleOrNamespaceSig(p, b, c, d, e, f, g, h)) =

let PrependPathToInput x inp =
match inp with
| ParsedInput.ImplFile (ParsedImplFileInput (b, c, q, d, hd, impls, e)) ->
ParsedInput.ImplFile (ParsedImplFileInput (b, c, PrependPathToQualFileName x q, d, hd, List.map (PrependPathToImpl x) impls, e))
| ParsedInput.ImplFile (ParsedImplFileInput (b, c, q, d, hd, impls, e, trivia)) ->
ParsedInput.ImplFile (ParsedImplFileInput (b, c, PrependPathToQualFileName x q, d, hd, List.map (PrependPathToImpl x) impls, e, trivia))

| ParsedInput.SigFile (ParsedSigFileInput (b, q, d, hd, specs)) ->
ParsedInput.SigFile (ParsedSigFileInput (b, PrependPathToQualFileName x q, d, hd, List.map (PrependPathToSpec x) specs))
| ParsedInput.SigFile (ParsedSigFileInput (b, q, d, hd, specs, trivia)) ->
ParsedInput.SigFile (ParsedSigFileInput (b, PrependPathToQualFileName x q, d, hd, List.map (PrependPathToSpec x) specs, trivia))

let ComputeAnonModuleName check defaultNamespace filename (m: range) =
let modname = CanonicalizeFilename filename
Expand Down Expand Up @@ -178,7 +178,7 @@ let GetScopedPragmasForHashDirective hd =
| Some n -> yield ScopedPragma.WarningOff(m, n)
| _ -> () ]

let PostParseModuleImpls (defaultNamespace, filename, isLastCompiland, ParsedImplFile (hashDirectives, impls)) =
let PostParseModuleImpls (defaultNamespace, filename, isLastCompiland, ParsedImplFile (hashDirectives, impls), lexbuf: UnicodeLexing.Lexbuf) =
match impls |> List.rev |> List.tryPick (function ParsedImplFileFragment.NamedModule(SynModuleOrNamespace(lid, _, _, _, _, _, _, _)) -> Some lid | _ -> None) with
| Some lid when impls.Length > 1 ->
errorR(Error(FSComp.SR.buildMultipleToplevelModules(), rangeOfLid lid))
Expand All @@ -197,9 +197,11 @@ let PostParseModuleImpls (defaultNamespace, filename, isLastCompiland, ParsedImp
for hd in hashDirectives do
yield! GetScopedPragmasForHashDirective hd ]

ParsedInput.ImplFile (ParsedImplFileInput (filename, isScript, qualName, scopedPragmas, hashDirectives, impls, isLastCompiland))
let conditionalDirectives = LexbufIfdefStore.GetTrivia(lexbuf)

ParsedInput.ImplFile (ParsedImplFileInput (filename, isScript, qualName, scopedPragmas, hashDirectives, impls, isLastCompiland, { ConditionalDirectives = conditionalDirectives }))

let PostParseModuleSpecs (defaultNamespace, filename, isLastCompiland, ParsedSigFile (hashDirectives, specs)) =
let PostParseModuleSpecs (defaultNamespace, filename, isLastCompiland, ParsedSigFile (hashDirectives, specs), lexbuf: UnicodeLexing.Lexbuf) =
match specs |> List.rev |> List.tryPick (function ParsedSigFileFragment.NamedModule(SynModuleOrNamespaceSig(lid, _, _, _, _, _, _, _)) -> Some lid | _ -> None) with
| Some lid when specs.Length > 1 ->
errorR(Error(FSComp.SR.buildMultipleToplevelModules(), rangeOfLid lid))
Expand All @@ -217,7 +219,9 @@ let PostParseModuleSpecs (defaultNamespace, filename, isLastCompiland, ParsedSig
for hd in hashDirectives do
yield! GetScopedPragmasForHashDirective hd ]

ParsedInput.SigFile (ParsedSigFileInput (filename, qualName, scopedPragmas, hashDirectives, specs))
let conditionalDirectives = LexbufIfdefStore.GetTrivia(lexbuf)

ParsedInput.SigFile (ParsedSigFileInput (filename, qualName, scopedPragmas, hashDirectives, specs, { ConditionalDirectives = conditionalDirectives }))

type ModuleNamesDict = Map<string,Map<string,QualifiedNameOfFile>>

Expand All @@ -242,13 +246,13 @@ let DeduplicateModuleName (moduleNamesDict: ModuleNamesDict) fileName (qualNameO
/// Checks if a ParsedInput is using a module name that was already given and deduplicates the name if needed.
let DeduplicateParsedInputModuleName (moduleNamesDict: ModuleNamesDict) input =
match input with
| ParsedInput.ImplFile (ParsedImplFileInput.ParsedImplFileInput (fileName, isScript, qualNameOfFile, scopedPragmas, hashDirectives, modules, (isLastCompiland, isExe))) ->
| ParsedInput.ImplFile (ParsedImplFileInput.ParsedImplFileInput (fileName, isScript, qualNameOfFile, scopedPragmas, hashDirectives, modules, (isLastCompiland, isExe), trivia)) ->
let qualNameOfFileT, moduleNamesDictT = DeduplicateModuleName moduleNamesDict fileName qualNameOfFile
let inputT = ParsedInput.ImplFile (ParsedImplFileInput.ParsedImplFileInput (fileName, isScript, qualNameOfFileT, scopedPragmas, hashDirectives, modules, (isLastCompiland, isExe)))
let inputT = ParsedInput.ImplFile (ParsedImplFileInput.ParsedImplFileInput (fileName, isScript, qualNameOfFileT, scopedPragmas, hashDirectives, modules, (isLastCompiland, isExe), trivia))
inputT, moduleNamesDictT
| ParsedInput.SigFile (ParsedSigFileInput.ParsedSigFileInput (fileName, qualNameOfFile, scopedPragmas, hashDirectives, modules)) ->
| ParsedInput.SigFile (ParsedSigFileInput.ParsedSigFileInput (fileName, qualNameOfFile, scopedPragmas, hashDirectives, modules, trivia)) ->
let qualNameOfFileT, moduleNamesDictT = DeduplicateModuleName moduleNamesDict fileName qualNameOfFile
let inputT = ParsedInput.SigFile (ParsedSigFileInput.ParsedSigFileInput (fileName, qualNameOfFileT, scopedPragmas, hashDirectives, modules))
let inputT = ParsedInput.SigFile (ParsedSigFileInput.ParsedSigFileInput (fileName, qualNameOfFileT, scopedPragmas, hashDirectives, modules, trivia))
inputT, moduleNamesDictT

let ParseInput (lexer, diagnosticOptions:FSharpDiagnosticOptions, errorLogger: ErrorLogger, lexbuf: UnicodeLexing.Lexbuf, defaultNamespace, filename, isLastCompiland) =
Expand Down Expand Up @@ -279,11 +283,11 @@ let ParseInput (lexer, diagnosticOptions:FSharpDiagnosticOptions, errorLogger: E
if FSharpImplFileSuffixes |> List.exists (FileSystemUtils.checkSuffix lower) then
let impl = Parser.implementationFile lexer lexbuf
LexbufLocalXmlDocStore.ReportInvalidXmlDocPositions(lexbuf)
PostParseModuleImpls (defaultNamespace, filename, isLastCompiland, impl)
PostParseModuleImpls (defaultNamespace, filename, isLastCompiland, impl, lexbuf)
elif FSharpSigFileSuffixes |> List.exists (FileSystemUtils.checkSuffix lower) then
let intfs = Parser.signatureFile lexer lexbuf
LexbufLocalXmlDocStore.ReportInvalidXmlDocPositions(lexbuf)
PostParseModuleSpecs (defaultNamespace, filename, isLastCompiland, intfs)
PostParseModuleSpecs (defaultNamespace, filename, isLastCompiland, intfs, lexbuf)
else
if lexbuf.SupportsFeature LanguageFeature.MLCompatRevisions then
error(Error(FSComp.SR.buildInvalidSourceFileExtensionUpdated filename, rangeStartup))
Expand Down Expand Up @@ -329,7 +333,7 @@ let ReportParsingStatistics res =
let flattenModSpec (SynModuleOrNamespaceSig(_, _, _, decls, _, _, _, _)) = flattenSpecs decls
let flattenModImpl (SynModuleOrNamespace(_, _, _, decls, _, _, _, _)) = flattenDefns decls
match res with
| ParsedInput.SigFile (ParsedSigFileInput (_, _, _, _, specs)) ->
| ParsedInput.SigFile (ParsedSigFileInput (modules = specs)) ->
printfn "parsing yielded %d specs" (List.collect flattenModSpec specs).Length
| ParsedInput.ImplFile (ParsedImplFileInput (modules = impls)) ->
printfn "parsing yielded %d definitions" (List.collect flattenModImpl impls).Length
Expand All @@ -343,7 +347,8 @@ let EmptyParsedInput(filename, isLastCompiland) =
QualFileNameOfImpls filename [],
[],
[],
[]
[],
{ ConditionalDirectives = [] }
)
)
else
Expand All @@ -355,7 +360,8 @@ let EmptyParsedInput(filename, isLastCompiland) =
[],
[],
[],
isLastCompiland
isLastCompiland,
{ ConditionalDirectives = [] }
)
)

Expand Down Expand Up @@ -645,11 +651,11 @@ let ProcessMetaCommandsFromInput
decls

match inp with
| ParsedInput.SigFile (ParsedSigFileInput (_, _, _, hashDirectives, specs)) ->
| ParsedInput.SigFile (ParsedSigFileInput (hashDirectives = hashDirectives; modules = specs)) ->
let state = List.fold ProcessMetaCommand state0 hashDirectives
let state = List.fold ProcessMetaCommandsFromModuleSpec state specs
state
| ParsedInput.ImplFile (ParsedImplFileInput (_, _, _, _, hashDirectives, impls, _)) ->
| ParsedInput.ImplFile (ParsedImplFileInput (hashDirectives = hashDirectives; modules = impls)) ->
let state = List.fold ProcessMetaCommand state0 hashDirectives
let state = List.fold ProcessMetaCommandsFromModuleImpl state impls
state
Expand Down Expand Up @@ -832,7 +838,7 @@ let TypeCheckOneInput(checkForErrors,
let m = inp.Range
let amap = tcImports.GetImportMap()
match inp with
| ParsedInput.SigFile (ParsedSigFileInput (_, qualNameOfFile, _, _, _) as file) ->
| ParsedInput.SigFile (ParsedSigFileInput (qualifiedNameOfFile = qualNameOfFile) as file) ->

// Check if we've seen this top module signature before.
if Zmap.mem qualNameOfFile tcState.tcsRootSigs then
Expand Down Expand Up @@ -871,7 +877,7 @@ let TypeCheckOneInput(checkForErrors,

return (tcEnv, EmptyTopAttrs, None, ccuSigForFile), tcState

| ParsedInput.ImplFile (ParsedImplFileInput (_, _, qualNameOfFile, _, _, _, _) as file) ->
| ParsedInput.ImplFile (ParsedImplFileInput (qualifiedNameOfFile = qualNameOfFile) as file) ->

// Check if we've got an interface for this fragment
let rootSigOpt = tcState.tcsRootSigs.TryFind qualNameOfFile
Expand Down
52 changes: 51 additions & 1 deletion src/fsharp/ParseHelpers.fs
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,7 @@ open FSharp.Compiler.AbstractIL
open FSharp.Compiler.ErrorLogger
open FSharp.Compiler.Features
open FSharp.Compiler.Syntax
open FSharp.Compiler.SyntaxTrivia
open FSharp.Compiler.SyntaxTreeOps
open FSharp.Compiler.UnicodeLexing
open FSharp.Compiler.Text
Expand Down Expand Up @@ -87,7 +88,6 @@ type IParseState with
//------------------------------------------------------------------------

/// XmlDoc F# lexer/parser state, held in the BufferLocalStore for the lexer.
/// This is the only use of the lexer BufferLocalStore in the codebase.
module LexbufLocalXmlDocStore =
// The key into the BufferLocalStore used to hold the current accumulated XmlDoc lines
let private xmlDocKey = "XmlDoc"
Expand Down Expand Up @@ -177,6 +177,56 @@ let rec LexerIfdefEval (lookup: string -> bool) = function
| IfdefNot e -> not (LexerIfdefEval lookup e)
| IfdefId id -> lookup id

/// Ifdef F# lexer/parser state, held in the BufferLocalStore for the lexer.
/// Used to capture #if, #else and #endif as syntax trivia.
module LexbufIfdefStore =
// The key into the BufferLocalStore used to hold the compiler directives
let private ifDefKey = "Ifdef"

let private getStore (lexbuf: Lexbuf): ResizeArray<ConditionalDirectiveTrivia> =
match lexbuf.BufferLocalStore.TryGetValue ifDefKey with
| true, store -> store
| _ ->
let store = box (ResizeArray<ConditionalDirectiveTrivia>())
lexbuf.BufferLocalStore.[ifDefKey] <- store
store
|> unbox<ResizeArray<ConditionalDirectiveTrivia>>

let private mkRangeWithoutLeadingWhitespace (lexed:string) (m:range): range =
let startColumn = lexed.Length - lexed.TrimStart().Length
mkFileIndexRange m.FileIndex (mkPos m.StartLine startColumn) m.End

let SaveIfHash (lexbuf: Lexbuf, lexed:string, expr: LexerIfdefExpression, range: range) =
let store = getStore lexbuf

let expr =
let rec visit (expr: LexerIfdefExpression) : IfDirectiveExpression =
match expr with
| LexerIfdefExpression.IfdefAnd(l,r) -> IfDirectiveExpression.IfdefAnd(visit l, visit r)
| LexerIfdefExpression.IfdefOr(l, r) -> IfDirectiveExpression.IfdefOr(visit l, visit r)
| LexerIfdefExpression.IfdefNot e -> IfDirectiveExpression.IfdefNot(visit e)
| LexerIfdefExpression.IfdefId id -> IfDirectiveExpression.IfdefId id

visit expr

let m = mkRangeWithoutLeadingWhitespace lexed range

store.Add(ConditionalDirectiveTrivia.IfDirectiveTrivia(expr, m))

let SaveElseHash (lexbuf: Lexbuf, lexed:string, range: range) =
let store = getStore lexbuf
let m = mkRangeWithoutLeadingWhitespace lexed range
store.Add(ConditionalDirectiveTrivia.ElseDirectiveTrivia(m))

let SaveEndIfHash (lexbuf: Lexbuf, lexed:string, range: range) =
let store = getStore lexbuf
let m = mkRangeWithoutLeadingWhitespace lexed range
store.Add(ConditionalDirectiveTrivia.EndIfDirectiveTrivia(m))

let GetTrivia (lexbuf: Lexbuf): ConditionalDirectiveTrivia list =
let store = getStore lexbuf
Seq.toList store

//------------------------------------------------------------------------
// Parsing: continuations for whitespace tokens
//------------------------------------------------------------------------
Expand Down
10 changes: 10 additions & 0 deletions src/fsharp/ParseHelpers.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -74,6 +74,16 @@ type LexerIfdefExpression =

val LexerIfdefEval: lookup:(string -> bool) -> _arg1:LexerIfdefExpression -> bool

module LexbufIfdefStore =

val SaveIfHash: lexbuf:UnicodeLexing.Lexbuf * lexed:string * expr: LexerIfdefExpression * range: range -> unit

val SaveElseHash: lexbuf:UnicodeLexing.Lexbuf * lexed:string * range: range -> unit

val SaveEndIfHash: lexbuf:UnicodeLexing.Lexbuf * lexed:string * range: range -> unit

val GetTrivia: lexbuf:UnicodeLexing.Lexbuf -> SyntaxTrivia.ConditionalDirectiveTrivia list

[<RequireQualifiedAccess>]
type LexerStringStyle =
| Verbatim
Expand Down
4 changes: 2 additions & 2 deletions src/fsharp/ScriptClosure.fs
Original file line number Diff line number Diff line change
Expand Up @@ -355,13 +355,13 @@ module ScriptPreprocessClosure =
match List.frontAndBack closureFiles with
| rest, ClosureFile
(filename, m,
Some(ParsedInput.ImplFile (ParsedImplFileInput (name, isScript, qualNameOfFile, scopedPragmas, hashDirectives, implFileFlags, _))),
Some(ParsedInput.ImplFile (ParsedImplFileInput (name, isScript, qualNameOfFile, scopedPragmas, hashDirectives, implFileFlags, _, trivia))),
parseDiagnostics, metaDiagnostics, nowarns) ->

let isLastCompiland = (true, tcConfig.target.IsExe)
rest @ [ClosureFile
(filename, m,
Some(ParsedInput.ImplFile (ParsedImplFileInput (name, isScript, qualNameOfFile, scopedPragmas, hashDirectives, implFileFlags, isLastCompiland))),
Some(ParsedInput.ImplFile (ParsedImplFileInput (name, isScript, qualNameOfFile, scopedPragmas, hashDirectives, implFileFlags, isLastCompiland, trivia))),
parseDiagnostics, metaDiagnostics, nowarns)]

| _ -> closureFiles
Expand Down
6 changes: 4 additions & 2 deletions src/fsharp/SyntaxTree.fs
Original file line number Diff line number Diff line change
Expand Up @@ -2014,7 +2014,8 @@ type ParsedImplFileInput =
scopedPragmas: ScopedPragma list *
hashDirectives: ParsedHashDirective list *
modules: SynModuleOrNamespace list *
isLastCompiland: (bool * bool)
isLastCompiland: (bool * bool) *
trivia: ParsedImplFileInputTrivia

[<NoEquality; NoComparison>]
type ParsedSigFileInput =
Expand All @@ -2023,7 +2024,8 @@ type ParsedSigFileInput =
qualifiedNameOfFile: QualifiedNameOfFile *
scopedPragmas: ScopedPragma list *
hashDirectives: ParsedHashDirective list *
modules: SynModuleOrNamespaceSig list
modules: SynModuleOrNamespaceSig list *
trivia: ParsedSigFileInputTrivia

[<NoEquality; NoComparison; RequireQualifiedAccess>]
type ParsedInput =
Expand Down
6 changes: 4 additions & 2 deletions src/fsharp/SyntaxTree.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -2207,7 +2207,8 @@ type ParsedImplFileInput =
scopedPragmas: ScopedPragma list *
hashDirectives: ParsedHashDirective list *
modules: SynModuleOrNamespace list *
isLastCompiland: (bool * bool)
isLastCompiland: (bool * bool) *
trivia: ParsedImplFileInputTrivia

/// Represents the full syntax tree, file name and other parsing information for a signature file
[<NoEquality; NoComparison>]
Expand All @@ -2217,7 +2218,8 @@ type ParsedSigFileInput =
qualifiedNameOfFile: QualifiedNameOfFile *
scopedPragmas: ScopedPragma list *
hashDirectives: ParsedHashDirective list *
modules: SynModuleOrNamespaceSig list
modules: SynModuleOrNamespaceSig list *
trivia: ParsedSigFileInputTrivia

/// Represents the syntax tree for a parsed implementation or signature file
[<NoEquality; NoComparison; RequireQualifiedAccess>]
Expand Down
20 changes: 20 additions & 0 deletions src/fsharp/SyntaxTrivia.fs
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,26 @@ namespace FSharp.Compiler.SyntaxTrivia

open FSharp.Compiler.Text

[<RequireQualifiedAccess; NoEquality; NoComparison>]
type ConditionalDirectiveTrivia =
| IfDirectiveTrivia of expr:IfDirectiveExpression * range:range
| ElseDirectiveTrivia of range:range
| EndIfDirectiveTrivia of range:range

and [<RequireQualifiedAccess; NoEquality; NoComparison>] IfDirectiveExpression =
| IfdefAnd of IfDirectiveExpression * IfDirectiveExpression
| IfdefOr of IfDirectiveExpression * IfDirectiveExpression
| IfdefNot of IfDirectiveExpression
| IfdefId of string

[<NoEquality; NoComparison>]
type ParsedImplFileInputTrivia =
{ ConditionalDirectives: ConditionalDirectiveTrivia list }

[<NoEquality; NoComparison>]
type ParsedSigFileInputTrivia =
{ ConditionalDirectives: ConditionalDirectiveTrivia list }

[<NoEquality; NoComparison>]
type SynExprTryWithTrivia =
{ TryKeyword: range
Expand Down
Loading