Skip to content

Commit 92617bd

Browse files
restart work on dotnet#4122
1 parent 8dfc02f commit 92617bd

File tree

7 files changed

+288
-5
lines changed

7 files changed

+288
-5
lines changed

fcs/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -72,6 +72,9 @@
7272
<Compile Include="$(FSharpSourcesRoot)\..\tests\service\TreeVisitorTests.fs">
7373
<Link>TreeVisitorTests.fs</Link>
7474
</Compile>
75+
<Compile Include="$(FSharpSourcesRoot)\..\tests\service\HashDirectiveInfoTests.fs">
76+
<Link>HashDirectiveInfoTests.fs</Link>
77+
</Compile>
7578
<Compile Include="$(FSharpSourcesRoot)\..\tests\service\Program.fs" Condition="'$(TargetFramework)' == 'netcoreapp2.0'">
7679
<Link>Program.fs</Link>
7780
</Compile>

fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
<Project Sdk="Microsoft.NET.Sdk">
1+
<Project Sdk="Microsoft.NET.Sdk">
22
<PropertyGroup>
33
<FSharpSourcesRoot>$(MSBuildProjectDirectory)\..\..\src</FSharpSourcesRoot>
44
</PropertyGroup>
@@ -627,6 +627,12 @@
627627
<Compile Include="$(FSharpSourcesRoot)\fsharp\service\ServiceAnalysis.fs">
628628
<Link>Service/ServiceAnalysis.fs</Link>
629629
</Compile>
630+
<Compile Include="$(FSharpSourcesRoot)\fsharp\service\HashDirectiveInfo.fsi">
631+
<Link>Service/HashDirectiveInfo.fsi</Link>
632+
</Compile>
633+
<Compile Include="$(FSharpSourcesRoot)\fsharp\service\HashDirectiveInfo.fs">
634+
<Link>Service/HashDirectiveInfo.fs</Link>
635+
</Compile>
630636
<Compile Include="$(FSharpSourcesRoot)\fsharp\fsi\fsi.fsi">
631637
<Link>Service/fsi.fsi</Link>
632638
</Compile>

src/absil/illib.fs

Lines changed: 27 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1299,6 +1299,12 @@ module Shim =
12991299
/// and '..' portions
13001300
abstract GetFullPathShim: fileName: string -> string
13011301

1302+
/// A shim over <see cref="System.IO.Path.GetFileName"/>
1303+
abstract GetFileNameShim: filename: string -> string
1304+
1305+
/// A shim over <see cref="System.IO.Path.GetDirectoryName"/>
1306+
abstract GetDirectoryNameShim: path: string -> string
1307+
13021308
/// A shim over Path.IsPathRooted
13031309
abstract IsPathRootedShim: path: string -> bool
13041310

@@ -1313,7 +1319,10 @@ module Shim =
13131319

13141320
/// A shim over File.Exists
13151321
abstract SafeExists: fileName: string -> bool
1316-
1322+
1323+
/// A shim over <see cref="System.IO.Directory.Exists"/>
1324+
abstract DirectoryExistsShim: path: string -> bool
1325+
13171326
/// A shim over File.Delete
13181327
abstract FileDelete: fileName: string -> unit
13191328

@@ -1325,8 +1334,7 @@ module Shim =
13251334

13261335
/// Used to determine if a file will not be subject to deletion during the lifetime of a typical client process.
13271336
abstract IsStableFileHeuristic: fileName: string -> bool
1328-
1329-
1337+
13301338
type DefaultFileSystem() =
13311339
interface IFileSystem with
13321340

@@ -1367,6 +1375,12 @@ module Shim =
13671375

13681376
member __.GetLastWriteTimeShim (fileName: string) = File.GetLastWriteTimeUtc fileName
13691377

1378+
member __.GetDirectoryNameShim (path: string) = Path.GetDirectoryName path
1379+
1380+
member __.GetFileNameShim (fileName: string) = Path.GetFileName fileName
1381+
1382+
member __.DirectoryExistsShim (path: string) = Directory.Exists path
1383+
13701384
member __.SafeExists (fileName: string) = File.Exists fileName
13711385

13721386
member __.FileDelete (fileName: string) = File.Delete fileName
@@ -1392,3 +1406,13 @@ module Shim =
13921406
n <- n + stream.Read(buffer, n, len-n)
13931407
buffer
13941408

1409+
[<AutoOpen>]
1410+
module Extensions =
1411+
type IFileSystem with
1412+
/// Equivalent to GetFullPathShim in a try catch, returns <see paramref="path"/> in case of an exception.
1413+
member x.GetFullPathSafe path = try x.GetFullPathShim path with _ -> path
1414+
1415+
/// Equivalent to GetFileNameShim in a try catch, returns <see paramref="path"/> in case of an exception.
1416+
member x.GetFileNameSafe path = try x.GetFileNameShim path with _ -> path
1417+
1418+

src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -650,7 +650,12 @@
650650
<Compile Include="..\service\ServiceAnalysis.fs">
651651
<Link>Service/ServiceAnalysis.fs</Link>
652652
</Compile>
653-
653+
<Compile Include="..\service\HashDirectiveInfo.fsi">
654+
<Link>Service/HashDirectiveInfo.fsi</Link>
655+
</Compile>
656+
<Compile Include="..\service\HashDirectiveInfo.fs">
657+
<Link>Service/HashDirectiveInfo.fs</Link>
658+
</Compile>
654659
<!-- the core of the F# Interactive fsi.exe implementation -->
655660
<EmbeddedText Include="..\fsi\FSIstrings.txt">
656661
<Link>FSIstrings.txt</Link>
Lines changed: 128 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,128 @@
1+
// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information.
2+
3+
namespace FSharp.Compiler.SourceCodeServices
4+
5+
open FSharp.Compiler.AbstractIL.Internal.Library
6+
7+
module PathUtils =
8+
open System.IO
9+
//[<Sealed>]
10+
//type Path =
11+
// static member GetFullPathSafe path =
12+
// try Path.GetFullPath path
13+
// with _ -> path
14+
//
15+
// static member GetFileNameSafe path =
16+
// try Path.GetFileName path
17+
// with _ -> path
18+
19+
let (</>) a b = Path.Combine(a, b)
20+
21+
module HashDirectiveInfo =
22+
open System.IO
23+
open PathUtils
24+
open FSharp.Compiler.Range
25+
open FSharp.Compiler.Ast
26+
27+
type IncludeDirective =
28+
| ResolvedDirectory of string
29+
30+
type CodeStringLiteral = string
31+
32+
type LoadFile =
33+
| Existing of CodeStringLiteral
34+
| Unresolvable of CodeStringLiteral
35+
36+
type LoadToken = CodeStringLiteral
37+
38+
type LoadDirective = { token: LoadToken ; files : LoadFile list }
39+
40+
[<NoComparison>]
41+
type Directive =
42+
| Include of IncludeDirective * range
43+
| Load of LoadDirective * range
44+
45+
// notes:
46+
// #I encountered in other loaded scripts may have an impact and this code may not resolve the same
47+
// /!\ @dsyme note https://github.com/Microsoft/visualfsharp/pull/4122#issuecomment-430983774 /!\
48+
// This looks like a partial reimplementation of aspects of the resolution logic done by the main F# compiler code.
49+
// The normal approach to this would be to record the resolutions in from the type-checking/analysis phase and report those resolutions here, rather than reimplementing the resolution logic.
50+
// In this case it's not a big problem. But there's a bit of trend toward reimplementing core compiler logic under src/fsharp/service and of course in the long term that will be a maintenance problem.
51+
52+
/// returns an array of LoadScriptResolutionEntries
53+
/// based on #I and #load directives
54+
let getIncludeAndLoadDirectives ast =
55+
// the Load items are resolved using fallback resolution relying on previously parsed #I directives
56+
// (this behaviour is undocumented in F# but it seems to be how it works).
57+
58+
// list of #I directives so far (populated while encountering those in order)
59+
let pushInclude, tryFindInPathsIncludedSoFar =
60+
let includesSoFar = ResizeArray<_>()
61+
62+
includesSoFar.Add,
63+
fun fileName ->
64+
includesSoFar
65+
|> Seq.tryPick (fun (ResolvedDirectory d) ->
66+
let filePath = d </> fileName
67+
if FileSystem.SafeExists filePath then
68+
Some filePath
69+
else
70+
None
71+
)
72+
73+
let getDirectoryOfFile = FileSystem.GetFullPathSafe >> FileSystem.GetDirectoryNameShim
74+
let makeRootedDirectoryIfNecessary baseDirectory directory =
75+
if not (FileSystem.IsPathRootedShim directory) then
76+
FileSystem.GetFullPathSafe (baseDirectory </> directory)
77+
else
78+
directory
79+
80+
let parseDirectives modules file = [|
81+
let baseDirectory = getDirectoryOfFile file
82+
for (SynModuleOrNamespace (_, _, _, declarations, _, _, _, _)) in modules do
83+
for decl in declarations do
84+
match decl with
85+
| SynModuleDecl.HashDirective (ParsedHashDirective("I",[directory],range),_) ->
86+
let directory = makeRootedDirectoryIfNecessary (getDirectoryOfFile file) directory
87+
88+
if FileSystem.DirectoryExistsShim directory then
89+
let includeDirective = ResolvedDirectory(directory)
90+
pushInclude includeDirective
91+
yield Include (includeDirective, range)
92+
93+
| SynModuleDecl.HashDirective (ParsedHashDirective ("load",files,range),_) ->
94+
for f in files do
95+
if FileSystem.IsPathRootedShim f && FileSystem.SafeExists f then
96+
// this is absolute reference to an existing script, easiest case
97+
yield Load ({token = ""; files = [Existing f]}, range)
98+
else
99+
// I'm not sure if the order is correct, first checking relative to file containing the #load directive
100+
// then checking for undocumented resolution using previously parsed #I directives
101+
let fileRelativeToCurrentFile = baseDirectory </> f
102+
if FileSystem.SafeExists fileRelativeToCurrentFile then
103+
// this is existing file relative to current file
104+
yield Load ({token = ""; files = [Existing fileRelativeToCurrentFile]}, range)
105+
else
106+
// match file against first include which seemingly have it found
107+
match tryFindInPathsIncludedSoFar f with
108+
| None -> () // can't load this file even using any of the #I directives...
109+
| Some f -> yield Load ({token = ""; files = [Existing f]},range)
110+
| _ -> ()
111+
|]
112+
113+
match ast with
114+
| ParsedInput.ImplFile (ParsedImplFileInput(fn,_,_,_,_,modules,_)) -> parseDirectives modules fn
115+
| _ -> [||]
116+
117+
/// returns the Some (complete file name of a resolved #load directive at position) or None
118+
let getHashLoadDirectiveResolvedPathAtPosition (pos: pos) (ast: ParsedInput) : string option =
119+
getIncludeAndLoadDirectives ast
120+
|> Array.tryPick (
121+
function
122+
| Load ({token = ""; files = [Existing f] }, range)
123+
// check the line is within the range
124+
// todo: doesn't work when there are multiple files given to a single #load directive
125+
when rangeContainsPos range pos
126+
-> Some f
127+
| _ -> None
128+
)
Lines changed: 46 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,46 @@
1+
// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information.
2+
3+
namespace FSharp.Compiler.SourceCodeServices
4+
5+
module PathUtils =
6+
[<Sealed>]
7+
type Path =
8+
/// Calls <see cref="System.IO.Path.GetFullPath"/> or returns <see paramref="path"/> in case of an exception.
9+
static member GetFullPathSafe : path: string -> string
10+
/// Calls <see cref="System.IO.Path.GetFileName"/> or returns <see paramref="path"/> in case of an exception.
11+
static member GetFileNameSafe : path: string -> string
12+
/// Operator calling <see cref="System.IO.Path.Combine" />
13+
val (</>) : string -> string -> string
14+
15+
module HashDirectiveInfo =
16+
open FSharp.Compiler.Range
17+
open FSharp.Compiler.Ast
18+
19+
/// IncludeDirective (#I) contains the pointed directory
20+
type IncludeDirective =
21+
| ResolvedDirectory of string
22+
23+
// todo: make this embed precise location / reuse ast stuff
24+
type CodeStringLiteral = string
25+
26+
type LoadFile =
27+
| Existing of CodeStringLiteral
28+
| Unresolvable of CodeStringLiteral
29+
30+
type LoadToken = CodeStringLiteral
31+
32+
type LoadDirective = { token: LoadToken ; files : LoadFile list }
33+
34+
/// represents #I and #load directive information along with range
35+
[<NoComparison>]
36+
type Directive =
37+
| Include of IncludeDirective * range
38+
| Load of LoadDirective * range
39+
40+
41+
/// returns an array of LoadScriptResolutionEntries
42+
/// based on #I and #load directives
43+
val getIncludeAndLoadDirectives : ParsedInput -> Directive array
44+
45+
/// returns Some (complete file name of a resolved #load directive at position) or None
46+
val getHashLoadDirectiveResolvedPathAtPosition : pos -> ParsedInput -> string option
Lines changed: 71 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,71 @@
1+
module Tests.Service.HashDirectiveInfoTests
2+
3+
open System.IO
4+
open Microsoft.FSharp.Compiler.Range
5+
open NUnit.Framework
6+
open Microsoft.FSharp.Compiler.SourceCodeServices.PathUtils
7+
open FSharp.Compiler.Service.Tests.Common
8+
open Microsoft.FSharp.Compiler.SourceCodeServices.HashDirectiveInfo
9+
10+
[<Literal>]
11+
let dataFolderName = __SOURCE_DIRECTORY__ + "/data/"
12+
13+
let getTestFilename filename =
14+
dataFolderName </> "ParsedLoadDirectives" </> filename
15+
16+
let canonicalizeFilename filename = Path.GetFullPathSafe filename
17+
18+
let getAst filename =
19+
let contents = File.ReadAllText(filename)
20+
match parseSourceCode (filename, contents) with
21+
| Some tree -> tree
22+
| None -> failwithf "Something went wrong during parsing %s!" filename
23+
24+
[<Test>]
25+
let ``test1.fsx: verify parsed #load directives``() =
26+
let ast = getAst (getTestFilename "test1.fsx")
27+
let directives = getIncludeAndLoadDirectives ast
28+
29+
let expectedMatches =
30+
[
31+
Some (FileInfo(getTestFilename "includes/a.fs").FullName)
32+
Some (FileInfo(getTestFilename "includes/b.fs").FullName)
33+
Some (FileInfo(getTestFilename "includes/b.fs").FullName)
34+
]
35+
36+
let results =
37+
directives
38+
|> Seq.map (function
39+
| Load(ExistingFile(filename), _) -> Some ((new FileInfo(filename)).FullName)
40+
| _ -> None
41+
)
42+
|> Seq.filter (Option.isSome)
43+
|> Seq.toList
44+
45+
Assert.AreEqual(expectedMatches, results)
46+
47+
[<Test>]
48+
let ``test1.fsx: verify parsed position lookup of individual #load directives``() =
49+
let ast = getAst (getTestFilename "test1.fsx")
50+
51+
let expectations = [
52+
(mkPos 1 1, Some (FileInfo(getTestFilename "includes/a.fs").FullName))
53+
(mkPos 1 5, Some (FileInfo(getTestFilename "includes/a.fs").FullName))
54+
(mkPos 2 1, Some (FileInfo(getTestFilename "includes/b.fs").FullName))
55+
(mkPos 2 5, Some (FileInfo(getTestFilename "includes/b.fs").FullName))
56+
(mkPos 3 1000, None)
57+
(mkPos 4 5, Some (FileInfo(getTestFilename "includes/b.fs").FullName))
58+
]
59+
60+
let results =
61+
expectations
62+
|> Seq.map fst
63+
|> Seq.map (fun pos ->
64+
let result = getHashLoadDirectiveResolvedPathAtPosition pos ast
65+
match result with
66+
| None -> pos, None
67+
| Some path -> pos, Some (canonicalizeFilename path)
68+
)
69+
|> Seq.toList
70+
71+
Assert.AreEqual(expectations, results)

0 commit comments

Comments
 (0)