[WIP] Migrate to core library (4)

Author: cannorin

lib/DataTypes/Graph.fs

@@ -3,6 +3,22 @@ namespace DataTypes
 type Graph<'node when 'node: comparison> = Map<'node, 'node list>
 
 module Graph =
+  let empty : Graph<_> = Map.empty
+
+  let add origin target (graph: Graph<_>) : Graph<_> =
+    match graph |> Map.tryFind origin with
+    | None -> graph |> Map.add origin [target]
+    | Some targets -> graph |> Map.add origin (target :: targets |> List.distinct)
+
+  let addEdge (origin, target) (graph: Graph<_>) : Graph<_> = add origin target graph
+
+  let remove origin target (graph: Graph<_>) : Graph<_> =
+    match graph |> Map.tryFind origin with
+    | Some targets -> graph |> Map.add origin (targets |> List.except [target])
+    | None -> graph
+
+  let removeEdge (origin, target) (graph: Graph<_>) : Graph<_> = remove origin target graph
+
   let rec private dfsImpl' g (used, ordRev) v =
     let used = used |> Set.add v
     let used, ordRev =
@@ -19,11 +35,13 @@ module Graph =
 
   let ofEdges (edges: ('a * 'a) list) : Graph<_> =
     edges
+    |> List.distinct
     |> List.groupBy fst
     |> List.fold (fun state (k, xs) -> state |> Map.add k (xs |> List.map snd)) Map.empty
 
   let ofEdgesRev (edges: ('a * 'a) list) : Graph<_> =
     edges
+    |> List.distinct
     |> List.groupBy snd
     |> List.fold (fun state (k, xs) -> state |> Map.add k (xs |> List.map fst)) Map.empty
 

lib/Parser.fs

@@ -1037,6 +1037,53 @@ let private getAllLocalReferences (ctx: #IContext<#IOptions>) (sourceFiles: Ts.S
 
   sourceFilesMap.Values |> Seq.toArray |> Array.map (fun v -> v.fileName, v) |> Array.unzip
 
+open DataTypes
+
+let createDependencyGraph (sourceFiles: Ts.SourceFile seq) =
+  let sourceFiles = Array.ofSeq sourceFiles
+  let files = sourceFiles |> Array.map (fun sf -> sf.fileName, sf) |> Map.ofArray
+  let mutable graph = Graph.empty
+
+  let tryFindDefinitionFile (sourceFile: Ts.SourceFile) relativePath =
+    let tryGet name =
+      files |> Map.tryFind (Path.join [Path.dirname sourceFile.fileName; name])
+    tryGet $"{relativePath}.d.ts"
+    |> Option.orElseWith (fun () -> tryGet (Path.join [relativePath; "index.d.ts"]))
+
+  let handleModuleSpecifier (sourceFile: Ts.SourceFile) (e: Ts.Expression) =
+    if e.kind = Ts.SyntaxKind.StringLiteral then
+      let specifier = (!!e : Ts.StringLiteral).text
+      if specifier.StartsWith(".") then
+        tryFindDefinitionFile sourceFile specifier
+        |> Option.map (fun target ->
+          graph <- graph |> Graph.add sourceFile.fileName target.fileName
+          target)
+      else None
+    else None
+
+  let rec go (sourceFile: Ts.SourceFile) (n: Ts.Node) : unit option =
+    match n.kind with
+    | Ts.SyntaxKind.ImportEqualsDeclaration ->
+      let n = n :?> Ts.ImportEqualsDeclaration
+      if (!!n.moduleReference : Ts.Node).kind = Ts.SyntaxKind.ExternalModuleReference then
+        (!!n.moduleReference : Ts.ExternalModuleReference).expression
+        |> handleModuleSpecifier sourceFile
+        |> Option.iter goSourceFile
+    | Ts.SyntaxKind.ImportDeclaration ->
+      let n = n :?> Ts.ImportDeclaration
+      n.moduleSpecifier
+      |> handleModuleSpecifier sourceFile
+      |> Option.iter goSourceFile
+    | _ -> ()
+    n.forEachChild(go sourceFile)
+
+  and goSourceFile (sourceFile: Ts.SourceFile) =
+    for statement in sourceFile.statements do
+      go sourceFile statement |> ignore
+
+  for sourceFile in sourceFiles do goSourceFile sourceFile
+  graph
+
 let createContextFromFiles (ctx: #IContext<#IOptions>) compilerOptions (fileNames: string[]) : ParserContext =
   let fileNames, program =
     let fileNames =
@@ -1108,4 +1155,13 @@ let parse (ctx: ParserContext) : Input =
     | example :: _ -> JsHelper.getPackageInfo example.fileName
     | [] -> None
 
-  { sources = sources; info = info }
+  let dependencyGraph =
+    let g = createDependencyGraph srcs
+    Graph.stronglyConnectedComponents g (List.ofArray ctx.fileNames)
+
+  for group in dependencyGraph do
+    match group with
+    | [] | [_] -> ()
+    | _ -> ctx.logger.warnf "there are mutually-referencing source files: %s" (group |> String.concat ", ")
+
+  { sources = sources; info = info; dependencyGraph = dependencyGraph }

lib/Syntax.fs

@@ -488,6 +488,16 @@ and Module = {
     member this.getComments() = this.comments
     member this.mapComments f = { this with comments = f this.comments }
 
+and Export = {
+  comments: Comment list
+  clauses: ExportClause list
+  loc: Location
+  origText: string
+} with
+  interface ICommented<Export> with
+    member this.getComments() = this.comments
+    member this.mapComments f = { this with comments = f this.comments }
+
 and ExportClause =
   /// ```ts
   /// export = ident;
@@ -553,16 +563,6 @@ and ExportClause =
   /// ```
   | NamespaceExport of ns:string
 
-and Export = {
-  comments: Comment list
-  clauses: ExportClause list
-  loc: Location
-  origText: string
-} with
-  interface ICommented<Export> with
-    member this.getComments() = this.comments
-    member this.mapComments f = { this with comments = f this.comments }
-
 and [<RequireQualifiedAccess>] Exported =
   | No
   /// ```ts
@@ -688,6 +688,12 @@ type PackageInfo = {
 type Input = {
   sources: SourceFile list
   info: PackageInfo option
+  /// a list of groups of filenames.
+  ///
+  /// if a group has more than one filenames, the files are mutually-referencing.
+  ///
+  /// the files in later groups reference the files in former groups.
+  dependencyGraph: Path.Absolute list list
 }
 
 module Literal =