Skip to content

Commit 1af40cc

Browse files
safesparrowsafesparrow
committed
Extract nested modules rather than just the top-level one as representatives of a file
1 parent cded6a0 commit 1af40cc

4 files changed

Lines changed: 162 additions & 26 deletions

File tree

‎tests/FSharp.Compiler.Service.Tests2/ASTVisit.fs‎

Lines changed: 119 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -1093,6 +1093,7 @@ and extractModuleRefs (input : ParsedInput) =
10931093
|> Seq.collect visitSynModuleOrNamespace
10941094
|> Seq.toArray
10951095

1096+
// TODO Improve detection mechanism
10961097
let mightHaveAutoOpen (synAttributeLists : SynAttributeList list) : bool =
10971098
let attributes =
10981099
synAttributeLists
@@ -1103,6 +1104,120 @@ let mightHaveAutoOpen (synAttributeLists : SynAttributeList list) : bool =
11031104
// Some attributes found - we can't know for sure if one of them is the AutoOpenAttribute (possibly hidden with a type alias), so we say 'yes'.
11041105
| _ -> true
11051106

1107+
type Eit =
1108+
| Nested of LongIdent[]
1109+
| SomeTypeLikeStuff
1110+
1111+
let combine (parent : LongIdent) (children : Eit) =
1112+
match children with
1113+
| Eit.Nested idents ->
1114+
idents
1115+
|> Array.map (fun child -> List.append parent child)
1116+
| Eit.SomeTypeLikeStuff ->
1117+
[|parent|]
1118+
1119+
let rec topStuffForSynModuleOrNamespace (x : SynModuleOrNamespace) : LongIdent[] =
1120+
match x with
1121+
| SynModuleOrNamespace(longId, isRecursive, synModuleOrNamespaceKind, synModuleDecls, preXmlDoc, synAttributeLists, synAccessOption, range, synModuleOrNamespaceTrivia) ->
1122+
if mightHaveAutoOpen synAttributeLists then
1123+
// Contents of a module that's potentially AutoOpen are available from its parent without a prefix.
1124+
// Treat it as a type - as soon as the parent module is reachable, consider the file being used
1125+
[|LongIdent.Empty|]
1126+
else
1127+
synModuleDecls
1128+
|> moduleDecls
1129+
|> combine longId
1130+
1131+
and moduleDecls (x : SynModuleDecl list) : Eit =
1132+
let emptyState = Eit.Nested [||]
1133+
x
1134+
|> List.toArray
1135+
|> Array.map moduleDecl
1136+
|> Array.fold (fun state item ->
1137+
match state, item with
1138+
| Eit.SomeTypeLikeStuff, _
1139+
| _, Eit.SomeTypeLikeStuff -> Eit.SomeTypeLikeStuff
1140+
| Eit.Nested old, Eit.Nested current -> Eit.Nested (Array.append old current)
1141+
) emptyState
1142+
1143+
and moduleDecl (x : SynModuleDecl) : Eit =
1144+
match x with
1145+
| SynModuleDecl.Attributes _
1146+
| SynModuleDecl.Exception _
1147+
| SynModuleDecl.Expr _
1148+
| SynModuleDecl.Let _
1149+
| SynModuleDecl.Types _
1150+
| SynModuleDecl.ModuleAbbrev _ ->
1151+
Eit.SomeTypeLikeStuff
1152+
| SynModuleDecl.HashDirective _
1153+
| SynModuleDecl.Open _ ->
1154+
Eit.Nested [||] // Elements can be ignored
1155+
| SynModuleDecl.NamespaceFragment synModuleOrNamespace ->
1156+
topStuffForSynModuleOrNamespace synModuleOrNamespace
1157+
|> Eit.Nested
1158+
| SynModuleDecl.NestedModule(synComponentInfo, isRecursive, synModuleDecls, isContinuing, range, synModuleDeclNestedModuleTrivia) ->
1159+
match synComponentInfo with
1160+
| SynComponentInfo(synAttributeLists, synTyparDeclsOption, synTypeConstraints, longId, preXmlDoc, preferPostfix, synAccessOption, range) ->
1161+
let idents =
1162+
if mightHaveAutoOpen synAttributeLists then
1163+
// Contents of a module that's potentially AutoOpen are available everywhere, so treat it as if it had no name ('root' module).
1164+
[|LongIdent.Empty|]
1165+
else
1166+
synModuleDecls
1167+
|> moduleDecls
1168+
|> combine longId
1169+
Eit.Nested idents
1170+
1171+
let rec topStuffForSynModuleOrNamespaceSig (x : SynModuleOrNamespaceSig) : LongIdent[] =
1172+
match x with
1173+
| SynModuleOrNamespaceSig(longId, isRecursive, synModuleOrNamespaceKind, synModuleDecls, preXmlDoc, synAttributeLists, synAccessOption, range, synModuleOrNamespaceTrivia) ->
1174+
if mightHaveAutoOpen synAttributeLists then
1175+
// Contents of a module that's potentially AutoOpen are available everywhere, so treat it as if it had no name ('root' module).
1176+
[|LongIdent.Empty|]
1177+
else
1178+
synModuleDecls
1179+
|> moduleSigDecls
1180+
|> combine longId
1181+
1182+
and moduleSigDecls (x : SynModuleSigDecl list) : Eit =
1183+
let emptyState = Eit.Nested [||]
1184+
x
1185+
|> List.toArray
1186+
|> Array.map moduleSigDecl
1187+
|> Array.fold (fun state item ->
1188+
match state, item with
1189+
| Eit.SomeTypeLikeStuff, _
1190+
| _, Eit.SomeTypeLikeStuff -> Eit.SomeTypeLikeStuff
1191+
| Eit.Nested old, Eit.Nested current -> Eit.Nested (Array.append old current)
1192+
) emptyState
1193+
1194+
and moduleSigDecl (x : SynModuleSigDecl) : Eit =
1195+
match x with
1196+
| SynModuleSigDecl.Val _
1197+
| SynModuleSigDecl.Exception _
1198+
| SynModuleSigDecl.Types _
1199+
| SynModuleSigDecl.ModuleAbbrev _ ->
1200+
Eit.SomeTypeLikeStuff
1201+
| SynModuleSigDecl.HashDirective _
1202+
| SynModuleSigDecl.Open _ ->
1203+
Eit.Nested [||] // Elements can be ignored
1204+
| SynModuleSigDecl.NamespaceFragment synModuleOrNamespace ->
1205+
topStuffForSynModuleOrNamespaceSig synModuleOrNamespace
1206+
|> Eit.Nested
1207+
| SynModuleSigDecl.NestedModule(synComponentInfo, isRecursive, synModuleSigDecls, range, synModuleSigDeclNestedModuleTrivia) ->
1208+
match synComponentInfo with
1209+
| SynComponentInfo(synAttributeLists, synTyparDeclsOption, synTypeConstraints, longId, preXmlDoc, preferPostfix, synAccessOption, range) ->
1210+
let idents =
1211+
if mightHaveAutoOpen synAttributeLists then
1212+
// Contents of a module that's potentially AutoOpen are available everywhere, so treat it as if it had no name ('root' module).
1213+
[|LongIdent.Empty|]
1214+
else
1215+
synModuleSigDecls
1216+
|> moduleSigDecls
1217+
|> combine longId
1218+
Eit.Nested idents
1219+
1220+
// TODO Handle 'global' namespace correctly
11061221
/// Extract the top-level module/namespaces from the AST
11071222
let topModuleOrNamespaces (input : ParsedInput) =
11081223
match input with
@@ -1111,29 +1226,12 @@ let topModuleOrNamespaces (input : ParsedInput) =
11111226
| [] -> failwith $"No modules or namespaces found in file '{f.FileName}'"
11121227
| items ->
11131228
items
1114-
|> List.map (fun item ->
1115-
match item with
1116-
| SynModuleOrNamespace(longId, isRecursive, synModuleOrNamespaceKind, synModuleDecls, preXmlDoc, synAttributeLists, synAccessOption, range, synModuleOrNamespaceTrivia) ->
1117-
if mightHaveAutoOpen synAttributeLists then
1118-
// Contents of a module that's potentially AutoOpen are available everywhere, so treat it as if it had no name ('root' module).
1119-
// This makes the dependency tracking algorithm detect it as a dependency for all further files.
1120-
LongIdent.Empty
1121-
else
1122-
longId
1123-
)
1229+
|> List.toArray
1230+
|> Array.collect topStuffForSynModuleOrNamespace
11241231
| ParsedInput.SigFile f ->
11251232
match f.Contents with
11261233
| [] -> failwith $"No modules or namespaces found in file '{f.FileName}'"
11271234
| items ->
11281235
items
1129-
|> List.map (fun item ->
1130-
match item with
1131-
| SynModuleOrNamespaceSig(longId, isRecursive, synModuleOrNamespaceKind, synModuleDecls, preXmlDoc, synAttributeLists, synAccessOption, range, synModuleOrNamespaceTrivia) ->
1132-
if mightHaveAutoOpen synAttributeLists then
1133-
// Contents of a module that's potentially AutoOpen are available everywhere, so treat it as if it had no name ('root' module).
1134-
// This makes the dependency tracking algorithm detect it as a dependency for all further files.
1135-
LongIdent.Empty
1136-
else
1137-
longId
1138-
)
1139-
|> List.toArray
1236+
|> List.toArray
1237+
|> Array.collect topStuffForSynModuleOrNamespaceSig

‎tests/FSharp.Compiler.Service.Tests2/Program.fs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -8,9 +8,9 @@ let runCompiler () =
88

99
[<EntryPoint>]
1010
let main _ =
11-
//TestDepResolving.TestProject(@"C:\projekty\fsharp\heuristic\tests\FSharp.Compiler.ComponentTests\FSharp.Compiler.ComponentTests.fsproj")
11+
TestDepResolving.TestProject(@"C:\projekty\fsharp\heuristic\tests\FSharp.Compiler.ComponentTests\FSharp.Compiler.ComponentTests.fsproj")
1212
//runCompiler ()
1313
//TestDepResolving.TestHardcodedFiles()
14-
//TestDepResolving.TestProject(@"C:\projekty\fsharp\fsharp_main\src\Compiler\FSharp.Compiler.Service.fsproj")
15-
RunCompiler.runGrapher()
14+
TestDepResolving.TestProject(@"C:\projekty\fsharp\fsharp_main\src\Compiler\FSharp.Compiler.Service.fsproj")
15+
//RunCompiler.runGrapher()
1616
0

‎tests/FSharp.Compiler.Service.Tests2/TestASTVisit.fs‎

Lines changed: 31 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -4,8 +4,38 @@ open NUnit.Framework
44
open FSharp.Compiler.Service.Tests
55
open FSharp.Compiler.Service.Tests2.ASTVisit
66

7+
8+
[<Test>]
9+
let ``Top level stuff extraction2`` () =
10+
let parseResults =
11+
getParseResults
12+
"""
13+
namespace A
14+
let x = 3
15+
16+
namespace B
17+
type X = int * int
18+
19+
namespace C
20+
module A =
21+
let x = 3
22+
23+
namespace D
24+
[<AutoOpen>]
25+
module D1 =
26+
module D2 =
27+
let x = 3
28+
29+
namespace D
30+
module D1 =
31+
module D2 =
32+
let x = 3
33+
"""
34+
let top = topModuleOrNamespaces parseResults
35+
printfn $"%+A{top}"
36+
737
[<Test>]
8-
let ``Single SynEnumCase contains range of constant`` () =
38+
let ``Top level stuff extraction`` () =
939
let parseResults =
1040
getParseResults
1141
"""

‎tests/FSharp.Compiler.Service.Tests2/TestDepResolving.fs‎

Lines changed: 9 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -66,7 +66,14 @@ type A = int
6666
let H =
6767
"""
6868
namespace GH
69-
type B = int
69+
module GH2 =
70+
type B = int
71+
"""
72+
let I =
73+
"""
74+
namespace GH
75+
module GH3 =
76+
type B = int
7077
"""
7178

7279
[
@@ -80,6 +87,7 @@ type B = int
8087
"F.fs", F
8188
"G.fs", G
8289
"H.fs", H
90+
"I.fs", I
8391
]
8492

8593
[<Test>]

0 commit comments

Comments
 (0)