diff --git a/.gitignore b/.gitignore index eb6372bb..4de5b3e7 100755 --- a/.gitignore +++ b/.gitignore @@ -300,6 +300,7 @@ _opam/ # Outputs output *.fs.js* +output*.txt # Test artifacts test/jsoo/src/*.mli diff --git a/build.fsx b/build.fsx index baa73468..5a0370cf 100644 --- a/build.fsx +++ b/build.fsx @@ -77,14 +77,19 @@ Target.create "YarnInstall" <| fun _ -> Target.create "Prepare" ignore -Target.create "BuildOnly" <| fun _ -> +Target.create "BuildForPublish" <| fun _ -> dotnetExec "fable" $"{srcDir} --sourceMaps --run webpack --mode=production" +Target.create "BuildForTest" <| fun _ -> + dotnetExec "fable" $"{srcDir} --sourceMaps --define DEBUG --run webpack --mode=development" + Target.create "Build" ignore Target.create "Watch" <| fun _ -> dotnetExec "fable" $"watch {srcDir} --sourceMaps --define DEBUG --run webpack -w --mode=development" +Target.create "TestComplete" ignore + "Clean" ==> "YarnInstall" ==> "Restore" @@ -92,7 +97,9 @@ Target.create "Watch" <| fun _ -> ==> "Build" "Prepare" - ?=> "BuildOnly" + ?=> "BuildForTest" + ?=> "TestComplete" + ?=> "BuildForPublish" ==> "Build" "Prepare" @@ -128,13 +135,13 @@ module Test = // "full" packages involving a lot of dependencies (which includes some "safe" packages) "safe", !! "node_modules/@types/scheduler/tracing.d.ts", []; "full", !! "node_modules/csstype/index.d.ts", []; - "safe", !! "node_modules/@types/prop-types/index.d.ts", []; + "safe", !! "node_modules/@types/prop-types/index.d.ts", ["--rec-module=off"]; "full", !! "node_modules/@types/react/index.d.ts" ++ "node_modules/@types/react/global.d.ts", []; "full", !! "node_modules/@types/react-modal/index.d.ts", []; // "safe" package which depends on another "safe" package "safe", !! "node_modules/@types/yargs-parser/index.d.ts", []; - "safe", !! "node_modules/@types/yargs/index.d.ts", []; + "safe", !! "node_modules/@types/yargs/index.d.ts", ["--rec-module=off"]; ] for preset, package, additionalOptions in packages do @@ -153,7 +160,7 @@ Target.create "TestJsooGenerateBindings" <| fun _ -> Test.Jsoo.generateBindings Target.create "TestJsooBuild" <| fun _ -> Test.Jsoo.build () Target.create "TestJsoo" ignore -"BuildOnly" +"BuildForTest" ==> "TestJsooClean" ==> "TestJsooGenerateBindings" ==> "TestJsooBuild" @@ -164,10 +171,9 @@ Target.create "TestOnly" ignore "TestJsoo" ==> "TestOnly" + ==> "TestComplete" ==> "Test" -"Build" ==> "Test" - // Publish targets module Publish = @@ -225,7 +231,7 @@ Target.create "PublishJsoo" <| fun _ -> Publish.Jsoo.updateVersion () Publish.Jsoo.testBuild () -"BuildOnly" +"BuildForPublish" ==> "PublishNpm" ==> "PublishJsoo" ==> "PublishOnly" @@ -233,7 +239,7 @@ Target.create "PublishJsoo" <| fun _ -> "TestJsoo" ==> "PublishJsoo" -"Build" ==> "Publish" +"Build" ?=> "Test" ?=> "Publish" Target.create "All" ignore diff --git a/docs/development.md b/docs/development.md index 356590f9..035d71e7 100644 --- a/docs/development.md +++ b/docs/development.md @@ -5,19 +5,24 @@ Overview for Developers Modules with **\[\\]** does not require `open` to use. -- `src/` - - `Bindings/` ... bindings to JS libraries +- `lib/` ... target-agnostic part of the tool (will be separated to a different repo in near future) + - `Bindings/` ... bindings to JS libraries (typescript, browser-or-node) - `Extensions.fs` ... **\[\\]** extensions for standard library and JS libraries - `DataTypes/` ... common data structures and algorithm - `Text.fs` ... efficient rope with `O(1)` concat & `O(n)` stringify - `Trie.fs` ... trie based on immutable map - `Graph.fs` ... graph based on immutable map & graph algorithms - - `Common.fs` ... **\[\\]** global command line options, types, and modules + - `Common.fs` ... global interfaces - `Syntax.fs` ... AST for parsed TypeScAript code - `Naming.fs` ... naming helpers - `JsHelper.fs` ... helper functions for JavaScript-related things e.g. NPM packages and ES6 module names. + - `TypeScriptHelper.fs` ... helper functions for using TypeScript Compiler API - `Typer.fs` ... functions for resolving and manipulating AST - `Parser.fs` ... functions for converting TS syntax tree to our AST +- `src/` ... target-dependent part of the tool + - `Bindings/` ... bindings to JS libraries (yargs) + - `Extensions.fs` ... **\[\\]** extensions for standard library and JS libraries + - `Common.fs` ... **\[\\]** global command line options, types, and modules - `Target.fs` ... generic definitions for each targets (`ITarget<_>`) - `Targets/` ... targets should be placed into here - `ParserTest.fs` ... debug target to test parser and typer diff --git a/lib/Bindings/BrowserOrNode.fs b/lib/Bindings/BrowserOrNode.fs new file mode 100644 index 00000000..918b21aa --- /dev/null +++ b/lib/Bindings/BrowserOrNode.fs @@ -0,0 +1,11 @@ +// ts2fable 0.7.1 +module rec BrowserOrNode +open System +open Fable.Core +open Fable.Core.JS + +let [] isBrowser: bool = jsNative +let [] isWebWorker: bool = jsNative +let [] isNode: bool = jsNative +let [] isJsDom: bool = jsNative +let [] isDeno: bool = jsNative diff --git a/src/Bindings/TypeScript.fs b/lib/Bindings/TypeScript.fs similarity index 100% rename from src/Bindings/TypeScript.fs rename to lib/Bindings/TypeScript.fs diff --git a/lib/Common.fs b/lib/Common.fs new file mode 100644 index 00000000..b39d6428 --- /dev/null +++ b/lib/Common.fs @@ -0,0 +1,46 @@ +module Ts2Ml.Common + +type ILogger = + abstract tracef: fmt:Printf.StringFormat<'T, unit> -> 'T + abstract warnf: fmt:Printf.StringFormat<'T, unit> -> 'T + abstract errorf: fmt:Printf.StringFormat<'T, 'Result> -> 'T + +type IOptions = + abstract followRelativeReferences: bool with get, set + +type IContext<'Options when 'Options :> IOptions> = + abstract options: 'Options + abstract logger: ILogger + +type IContext = + inherit IContext + +/// Stateful class to rename overloaded identifiers. +type OverloadRenamer(?rename: string -> int -> string, ?used: Set) = + let rename = + match rename with + | Some f -> f + | None -> (fun s i -> s + (String.replicate i "'")) + let m = new MutableMap() + do + match used with + | None -> () + | Some used -> + for name in used |> Set.toSeq do + m.[name] <- 0 + + /// If the `name` is already used in the same `category`, returns the new renamed name. + /// + /// Otherwise, (even if it is used in a different `category`), returns the original name. + /// + /// `category` can be arbitrary, but it is intended for something like `value`, `type`, `module`, etc. + member __.Rename (category: string) (name: string) = + match m.TryGetValue((category, name)) with + | true, i -> + m.[(category, name)] <- i + 1 + let name' = rename name (i+1) + m.[(category, name')] <- 0 + name' + | false, _ -> + m.[(category, name)] <- 0 + name diff --git a/src/DataTypes/Graph.fs b/lib/DataTypes/Graph.fs similarity index 83% rename from src/DataTypes/Graph.fs rename to lib/DataTypes/Graph.fs index 9f398b36..54e0da7f 100644 --- a/src/DataTypes/Graph.fs +++ b/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 diff --git a/src/DataTypes/Text.fs b/lib/DataTypes/Text.fs similarity index 99% rename from src/DataTypes/Text.fs rename to lib/DataTypes/Text.fs index 0ab6bcee..9571cf99 100644 --- a/src/DataTypes/Text.fs +++ b/lib/DataTypes/Text.fs @@ -1,5 +1,7 @@ namespace DataTypes +open Ts2Ml.Extensions + [] type text = private diff --git a/src/DataTypes/Trie.fs b/lib/DataTypes/Trie.fs similarity index 90% rename from src/DataTypes/Trie.fs rename to lib/DataTypes/Trie.fs index 7751db0e..0f51cd5c 100644 --- a/src/DataTypes/Trie.fs +++ b/lib/DataTypes/Trie.fs @@ -91,6 +91,28 @@ module Trie = | Some child -> { t with children = t.children |> Map.add k (setSubTrie ks subTrie child) } | None -> { t with children = t.children |> Map.add k (setSubTrie ks subTrie empty) } + let rec getLongestMatch (ks: 'k list) (trie: Trie<'k, 'v>) : {| value: 'v option; rest: 'k list |} = + match ks with + | [] -> {| value = trie.value; rest = [] |} + | k :: ks -> + match Map.tryFind k trie.children with + | Some child -> getLongestMatch ks child + | None -> {| value = trie.value; rest = k :: ks |} + + let collectPath (ks: 'k list) (collector: 'k list -> 'v option -> 'a option) (trie: Trie<'k, 'v>) : 'a list = + let rec go acc ks trie = + let acc = + match collector ks trie.value with + | Some a -> a :: acc + | None -> acc + match ks with + | [] -> List.rev acc + | k :: ks -> + match Map.tryFind k trie.children with + | Some child -> go acc ks child + | None -> List.rev acc + go [] ks trie + let fold (f: 'state -> 'k list -> 'v -> 'state) (s: 'state) (t: Trie<'k, 'v>) = let rec go ksRev state t = let state = diff --git a/lib/Extensions.fs b/lib/Extensions.fs new file mode 100644 index 00000000..99bdc02a --- /dev/null +++ b/lib/Extensions.fs @@ -0,0 +1,176 @@ +[] +module Ts2Ml.Extensions + +open System + +module Enum = + /// Get the name of an enum case + let inline pp (e: 'enum when 'enum: enum<_>) = + Enum.GetName(typeof<'enum>, e) + +module Char = + let inline isAlphabet c = + ('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z') + let inline isAlphabetOrDigit c = + ('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z') || ('0' <= c && c <= '9') + +module String = + let containsAny (a: string) (b: string list) = + b |> List.exists a.Contains + + let replace (pattern:string) (destPattern:string) (text: string) = + text.Replace(pattern,destPattern) + + let split (separator: string) (text: string) = + text.Split([|separator|], StringSplitOptions.None) + + let splitMany (separators: string list) (text: string) = + text.Split(Array.ofList separators, StringSplitOptions.None) + + let splitThenRemoveEmptyEntries (separator: string) (text: string) = + text.Split([|separator|], StringSplitOptions.RemoveEmptyEntries) + + let splitManyThenRemoveEmptyEntries (separators: string list) (text: string) = + text.Split(Array.ofList separators, StringSplitOptions.RemoveEmptyEntries) + + let toLines (s: string) : string[] = + s + |> replace "\r\n" "\n" + |> replace "\r" "\n" + |> split "\n" + + let escape (s: string) = + s + .Replace("\\", "\\\\") + .Replace("'", "\\'").Replace("\"", "\\\"") + .Replace("\b", "\\b").Replace("\n", "\\n").Replace("\r", "\\r") + .Replace("\t", "\\t") + + let escapeWith (escaped: string seq) (s: string) = + escaped |> Seq.fold (fun (state: string) e -> + state.Replace(e, "\\" + e) + ) s + +module Option = + let iterNone f = function + | Some x -> Some x + | None -> f (); None + +module Result = + let toOption result = + match result with Ok x -> Some x | Error _ -> None + +module List = + let splitChoice2 (xs: Choice<'t1, 't2> list) : 't1 list * 't2 list = + let xs1, xs2 = + xs |> List.fold (fun (xs1, xs2) -> function + | Choice1Of2 x -> x :: xs1, xs2 + | Choice2Of2 x -> xs1, x :: xs2 + ) ([], []) + List.rev xs1, List.rev xs2 + +module Map = + let addNoOverwrite k v m = + m |> Map.change k (function None -> Some v | Some v -> Some v) + +type MutableMap<'k, 'v> = Collections.Generic.Dictionary<'k, 'v> +type MutableSet<'v> = Collections.Generic.HashSet<'v> + +#if FABLE_COMPILER +type StringBuilder (s: string) = + let mutable s = s + new () = StringBuilder ("") + member __.Length = s.Length + member sb.Append (s': string) = s <- s + s'; sb + member inline sb.Append (c: char) = sb.Append (string c) + member inline sb.Append (num: ^n) = sb.Append (sprintf "%d" num) + member inline sb.Append (o: obj) = sb.Append (string o) + member inline sb.AppendLine () = sb.Append System.Environment.NewLine + member inline sb.AppendLine (s: string) = (sb.Append (s)).AppendLine() + member sb.Remove (startIndex: int, length: int) = + if startIndex + length >= s.Length + then s <- s.Substring (0, startIndex) + else s <- s.Substring (0, startIndex) + s.Substring (startIndex + length) + sb + member __.ToString (startIndex: int, length: int) = + s.Substring (startIndex, length) + member sb.Clear () = + s <- ""; sb + override __.ToString() = s +#else +type StringBuilder = System.Text.StringBuilder +#endif + +open Fable.Core +open Fable.Core.JsInterop + +type JS.ObjectConstructor with + [] + member __.entries (_: 'a) : (string * obj) [] = jsNative + +type JS.NumberConstructor with + [] + member __.isSafeInteger (_: float) : bool = jsNative + +type JSRecord<'TKey, 'TValue> = + [] + abstract member Item: 'TKey -> 'TValue option with get + [] + abstract member Item: 'TKey -> 'TValue with set + [] + abstract member keys: 'TKey[] + [] + abstract member values: 'TValue[] + [] + abstract member entries: ('TKey * 'TValue)[] + [] + abstract member hasKey: 'TKey -> bool + +module JS = + [] + let typeof (_: 'a) : string = jsNative + + let cloneWith (f: 'a -> unit) (x: 'a) = + let newX = JS.Constructors.Object.assign(!!{||}, x) :?> 'a + f newX + newX + + let stringify (x: obj) = + let objSet = JS.Constructors.Set.Create() + JS.JSON.stringify(x, space=2, replacer=(fun _key value -> + if not (isNullOrUndefined value) && typeof value = "object" then + if objSet.has(value) then box "" + else + objSet.add value |> ignore + value + else + value + )) + +module Path = + module Node = Node.Api + + type Absolute = string + type Difference = string + + let absolute (path: string) : Absolute = + if Node.path.isAbsolute(path) then path + else Node.path.resolve(path) + + let diff (fromPath: Absolute) (toPath: Absolute) : string = + let fromPath = + if Node.fs.lstatSync(!^fromPath).isDirectory() then fromPath + else Node.path.dirname(fromPath) + Node.path.relative(fromPath, toPath) + + let dirname (path: string) : string = + Node.path.dirname(path) + + let basename (path: string) : string = + Node.path.basename(path) + + let join (paths: string list) : string = + Node.path.join(Array.ofList paths) + + let separator = + Node.path.sep diff --git a/lib/JsHelper.fs b/lib/JsHelper.fs new file mode 100644 index 00000000..234bac67 --- /dev/null +++ b/lib/JsHelper.fs @@ -0,0 +1,250 @@ +module Ts2Ml.JsHelper + +open Fable.Core +open Fable.Core.JsInterop + +module Node = Node.Api + +let inline nodeOnly (f: unit -> 'a option) : 'a option = + if not BrowserOrNode.isNode then None + else f () + +let getPackageJsonPath (exampleFilePath: string) = + nodeOnly <| fun () -> + let parts = + exampleFilePath + |> String.split Path.separator + |> List.ofArray + match parts |> List.tryFindIndexBack ((=) "node_modules") with + | None -> None + | Some i -> + let prefix, rest = List.splitAt (i+1) parts + if rest = [] then None + else + let packageName = + match rest with + | userName :: packageName :: _ when userName.StartsWith("@") -> [userName; packageName] + | packageName :: _ -> [packageName] + | _ -> failwith "impossible_getPackageJsonPath_root" + let path = + prefix @ packageName @ ["package.json"] |> String.concat Path.separator + + if not <| Node.fs.existsSync(!^path) then None + else Some (Path.absolute path) + +type IPackageExportItemEntry = + inherit JSRecord + abstract ``default``: string option + +type IPackageExportItem = + inherit JSRecord> + abstract types: U2 option + +type IPackageJson = + abstract name: string + abstract version: string + abstract types: string option + abstract typings: string option + abstract exports: JSRecord> option + +let getPackageInfo (exampleFilePath: string) : Syntax.PackageInfo option = + nodeOnly <| fun () -> + match getPackageJsonPath exampleFilePath with + | None -> None + | Some path -> + let p = + let content = Node.fs.readFileSync(path, "utf-8") + !!JS.JSON.parse(content) : IPackageJson + + let rootPath = Path.dirname path + + let name = + if p.name.StartsWith("@types/") then + let tmp = p.name.Substring(7) + if tmp.Contains("__") then "@" + tmp.Replace("__", "/") + else tmp + else p.name + + let shortName = + p.name + |> String.splitThenRemoveEmptyEntries "/" + |> Array.skipWhile (fun s -> s.StartsWith("@")) + |> String.concat "/" + + let exports = + match p.exports with + | None -> [] + | Some exports -> + [ + for k, v in exports.entries do + if JS.typeof v = "string" then + let v = !!v : string + if v.EndsWith(".d.ts") then yield k, v + else + let v = !!v : IPackageExportItem + match v.types with + | None -> () + | Some types -> + if JS.typeof types = "string" then + yield k, !!types + else + let types = !!types : IPackageExportItemEntry + match types.``default`` with + | Some v -> yield k, v + | None -> + yield! + types.entries + |> Array.tryPick (fun (_, v) -> + if JS.typeof v = "string" && v.EndsWith(".d.ts") then Some v + else None) + |> Option.map (fun v -> k, v) + |> Option.toList + ] + + let indexFile = + match Option.orElse p.types p.typings, exports |> List.tryFind (fst >> (=) ".") with + | None, None -> + let index = Path.join [rootPath; "index.d.ts"] + if not <| Node.fs.existsSync(!^index) then None + else Some index + | Some typings, _ + | None, Some (_, typings) -> + Path.join [rootPath; typings] |> Some + + let exports = + exports + |> List.filter (fst >> (<>) ".") + |> List.map (fun (k, v) -> + {| submodule = k; + file = Path.join [rootPath; v] |}) + + Some { + name = name + shortName = shortName + isDefinitelyTyped = p.name.StartsWith("@types/") + version = p.version + rootPath = rootPath + indexFile = indexFile + exports = exports + } + +type InferenceResult = + | Valid of string + | Heuristic of string + | Unknown +module InferenceResult = + let unwrap defaultValue = function + | Valid s | Heuristic s -> s + | Unknown -> defaultValue + let tryUnwrap = function + | Valid s | Heuristic s -> Some s + | Unknown -> None + +let inferPackageInfoFromFileName (sourceFile: Path.Absolute) : {| name: string; isDefinitelyTyped: bool; rest: string list |} option = + let parts = + sourceFile + |> fun x -> + let inm = x.LastIndexOf "node_modules" + if inm = -1 then x + else x.Substring(inm) + |> String.split "/" + |> List.ofArray + match parts with + | "node_modules" :: "@types" :: name :: rest -> + let name = if name.Contains("__") then "@" + name.Replace("__", "/") else name + Some {| name = name; isDefinitelyTyped = true; rest = rest |} + | "node_modules" :: user :: name :: rest when user.StartsWith("@") -> + Some {| name = user + "/" + name; isDefinitelyTyped = false; rest = rest |} + | "node_modules" :: name :: rest -> + Some {| name = name; isDefinitelyTyped = false; rest = rest |} + | _ -> None + +let inline stripExtension path = + path |> String.replace ".ts" "" |> String.replace ".d" "" + +let getJsModuleName (info: Syntax.PackageInfo option) (sourceFile: Path.Absolute) = + let getSubmodule rest = + match List.rev rest with + | "index.d.ts" :: name :: _ -> name + | name :: _ -> stripExtension name + | [] -> failwith "impossible" + match info with + | Some info -> + if info.indexFile |> Option.exists ((=) sourceFile) then + info.name |> Valid + else + // make it relative to the package root directory + let relativePath = Path.diff info.rootPath sourceFile + if info.isDefinitelyTyped then + Path.join [info.name; stripExtension relativePath] |> Valid + else + match info.exports |> List.tryFind (fun x -> x.file = sourceFile) with + | Some export -> Path.join [info.name; export.submodule] |> Valid + | None -> // heuristic + let submodule = + relativePath + |> String.splitThenRemoveEmptyEntries "/" + |> List.ofArray + |> getSubmodule + Path.join [info.name; submodule] |> Heuristic + | None -> + match inferPackageInfoFromFileName sourceFile with + | None -> + Path.basename sourceFile |> stripExtension |> Heuristic + | Some info -> + if info.isDefinitelyTyped then + let rest = + match List.rev info.rest with + | "index.d.ts" :: rest -> List.rev rest + | other :: rest -> + stripExtension other :: rest |> List.rev + | [] -> [] + info.name :: rest |> String.concat "/" |> Valid + else + match info.rest with + | ["index.d.ts"] -> Valid info.name + | rest -> + info.name + "/" + getSubmodule rest + |> Heuristic + +let deriveModuleName (info: Syntax.PackageInfo option) (srcs: Path.Absolute list) = + match srcs with + | [] -> invalidArg "srcs" "source is empty" + | [src] -> getJsModuleName info src + | srcs -> + let fallback () = + let names = + srcs + |> List.choose inferPackageInfoFromFileName + |> List.map (fun info -> info.name) + |> List.groupBy id + |> List.map (fun (name, xs) -> name, List.length xs) + names |> List.maxBy (fun (_, count) -> count) |> fst |> Heuristic + match info with + | None -> fallback () + | Some info -> + if info.indexFile |> Option.exists (fun index -> srcs |> List.exists ((=) index)) then + Valid info.name + else + fallback () + +let tryGetActualFileNameFromRelativeImportPath (currentFile: Path.Absolute) (allFiles: Path.Absolute list) (path: string) = + let path = Path.join [Path.dirname currentFile; path] + if not <| path.EndsWith(".ts") then + let tryFind p = if allFiles |> List.contains p then Some p else None + tryFind $"{path}.d.ts" + |> Option.orElseWith (fun () -> tryFind (Path.join [path; "index.d.ts"])) + |> Option.orElseWith (fun () -> allFiles |> List.tryFind (fun p -> p.StartsWith(path))) + else + if allFiles |> List.contains path then Some path + else None + +let resolveRelativeImportPath (info: Syntax.PackageInfo option) (currentFile: Path.Absolute) (allFiles: Path.Absolute list) (path: string) = + if path.StartsWith(".") then + let targetPath = + match tryGetActualFileNameFromRelativeImportPath currentFile allFiles path with + | Some path -> path + | None -> Path.join [Path.dirname currentFile; path; "index.d.ts"] + getJsModuleName info targetPath + else + Valid path diff --git a/src/Naming.fs b/lib/Naming.fs old mode 100755 new mode 100644 similarity index 99% rename from src/Naming.fs rename to lib/Naming.fs index 8cd8bf60..e26902f5 --- a/src/Naming.fs +++ b/lib/Naming.fs @@ -1,6 +1,7 @@ // partly borrowed from https://github.com/fable-compiler/ts2fable/ -module Naming +module Ts2Ml.Naming +open Ts2Ml.Extensions open System type Case = diff --git a/lib/Parser.fs b/lib/Parser.fs new file mode 100644 index 00000000..3df38c56 --- /dev/null +++ b/lib/Parser.fs @@ -0,0 +1,1193 @@ +// partly borrowed from https://github.com/fable-compiler/ts2fable/ +module Ts2Ml.Parser + +open Ts2Ml.Common +open Ts2Ml.Syntax +open Ts2Ml.Naming + +open Fable.Core +open Fable.Core.JsInterop +open TypeScript + +type Node = Ts.Node +type TypeChecker = Ts.TypeChecker +type Kind = Ts.SyntaxKind + +type ParserContext = + inherit IContext + abstract checker: TypeChecker + abstract currentSource: Ts.SourceFile with get, set + abstract program: Ts.Program + abstract fileNames: Path.Absolute[] + +module private ParserImpl = + module Node = + let location (n: Node) = + let src = n.getSourceFile() + let pos = src.getLineAndCharacterOfPosition (n.getStart()) + LocationTs (src, pos) + + let ppLocation (n: Node) = + let src = n.getSourceFile() + let pos = src.getLineAndCharacterOfPosition (n.getStart()) + sprintf "line %i, col %i of %s" (int pos.line + 1) (int pos.character + 1) src.fileName + + let ppLine (n: Node) = + let src = n.getSourceFile() + let pos = src.getLineAndCharacterOfPosition (n.getStart()) + let startPos = int <| src.getPositionOfLineAndCharacter(pos.line, 0.) + let endPos = int <| src.getLineEndOfPosition(n.getEnd()) + let lines = + src.text.Substring(startPos, endPos - startPos) |> String.toLines + lines |> Array.map (sprintf "> %s") |> String.concat System.Environment.NewLine + + let nodeWarn (ctx: ParserContext) (node: Node) format = + Printf.kprintf (fun s -> + ctx.logger.warnf "%s at %s\n%s" s (Node.ppLocation node) (Node.ppLine node) + ) format + + let nodeError (ctx: ParserContext) node format = + Printf.kprintf (fun s -> + ctx.logger.errorf "%s at %s\n%s" s (Node.ppLocation node) (Node.ppLine node) + ) format + + let hasModifier (kind: Ts.SyntaxKind) (modifiers: Ts.ModifiersArray option) = + match modifiers with + | None -> false + | Some mds -> mds |> Seq.exists (fun md -> md.kind = kind) + + let getAccessibility (modifiersOpt: Ts.ModifiersArray option) : Accessibility option = + if modifiersOpt |> hasModifier Kind.PublicKeyword then + Some Public + else if modifiersOpt |> hasModifier Kind.ProtectedKeyword then + Some Protected + else if modifiersOpt |> hasModifier Kind.PrivateKeyword then + Some Private + else + None + + let getExported (modifiersOpt: Ts.ModifiersArray option) : Exported = + if modifiersOpt |> hasModifier Kind.DeclareKeyword then + Exported.Declared + else if modifiersOpt |> hasModifier Kind.ExportKeyword |> not then + Exported.No + else if modifiersOpt |> hasModifier Kind.DefaultKeyword then + Exported.Default + else + Exported.Yes + + let isReadOnly (m: Ts.ModifiersArray option) : bool = + m |> hasModifier Kind.ReadonlyKeyword + + let getText (x: 'a) : string = + (!!x : Ts.Node).getText() |> removeQuotesAndTrim + + let getPropertyName (pn: Ts.PropertyName) : string option = + let node : Node = !!pn + match node.kind with + | Kind.Identifier -> Some (!!pn : Ts.Identifier).text + | Kind.PrivateIdentifier -> Some (!!pn : Ts.PrivateIdentifier).text + | Kind.StringLiteral -> Some (!!pn : Ts.StringLiteral).text + | Kind.NumericLiteral -> Some (!!pn : Ts.NumericLiteral).text + | _ -> None + + let getPropertyExpression (pn: Ts.PropertyName) : Ts.Expression option = + let node : Node = !!pn + match node.kind with + | Kind.ComputedPropertyName -> Some (!!pn : Ts.ComputedPropertyName).expression + | _ -> None + + let getBindingName ctx (bn: Ts.BindingName): string option = + let syntaxNode : Node = !! bn + match syntaxNode.kind with + | Kind.Identifier -> + let id : Ts.Identifier = !! bn + Some id.text + | Kind.ObjectBindingPattern + | Kind.ArrayBindingPattern -> None + | _ -> nodeError ctx syntaxNode "unknown Binding Name kind: %s" (Enum.pp syntaxNode.kind) + + let rec extractNestedName (node: Node) = + seq { + if ts.isIdentifier node then + yield (node :?> Ts.Identifier).text + else if ts.isQualifiedName node then + let node = node :?> Ts.QualifiedName + yield! extractNestedName (box node.left :?> Node) + yield node.right.text + else + for child in node.getChildren() do + yield! extractNestedName child + } + + let getKindFromName (ctx: ParserContext) (i: Ts.Node) : Set option = + match ctx.checker.getSymbolAtLocation i with + | None -> None + | Some s -> + let inline check (superset: Ts.SymbolFlags) (subset: Ts.SymbolFlags) = int (subset &&& superset) > 0 + let rec go (symbol: Ts.Symbol) = + let flags = symbol.getFlags() + if flags = Ts.SymbolFlags.Alias then + try + let symbol = ctx.checker.getAliasedSymbol symbol + if isNullOrUndefined symbol then None + else + go symbol + with _ -> None + else + Set.ofList [ + if flags |> check Ts.SymbolFlags.Value then Kind.Value + if flags |> check Ts.SymbolFlags.Type then Kind.Type + if flags |> check Ts.SymbolFlags.TypeAlias then Kind.TypeAlias + if flags |> check (Ts.SymbolFlags.Class ||| Ts.SymbolFlags.Interface) then Kind.ClassLike + if flags |> check Ts.SymbolFlags.ClassMember then Kind.Member + if flags |> check Ts.SymbolFlags.Module then Kind.Module + if flags |> check Ts.SymbolFlags.ModuleMember then Kind.Statement + if flags |> check Ts.SymbolFlags.Enum then Kind.Enum + if flags |> check Ts.SymbolFlags.EnumMember then Kind.EnumCase + ] |> Some + go s + + let normalizeQualifiedName (fileNames: string list) (s: string) = + s + |> String.split "." + |> List.ofArray + |> function + | x :: xs when x.StartsWith("\"") -> + let basenames = fileNames |> List.map JsHelper.stripExtension + if basenames |> List.exists (fun basename -> x.EndsWith(basename + "\"")) then xs + else x.Trim('"') :: xs + | xs -> xs + + let getFullName (ctx: ParserContext) (nd: Node) = + match ctx.checker.getSymbolAtLocation nd with + | None -> None + | Some s -> + let source = ctx.currentSource.fileName + let fullName = + ctx.checker.getFullyQualifiedName s |> normalizeQualifiedName [source] + Some { source = source; name = fullName } + + let getFullNames (ctx: ParserContext) (nd: Node) = + let getSources (s: Ts.Symbol) = + s.declarations + |> Option.toList + |> List.collect (fun decs -> + decs |> Seq.map (fun dec -> dec.getSourceFile()) |> List.ofSeq) + |> List.map (fun x -> x.fileName) + |> List.distinct + + let getRootAndAliasedSymbols (s: Ts.Symbol) = + let roots = ctx.checker.getRootSymbols(s) + try + let s = ctx.checker.getAliasedSymbol(s) + if not (ctx.checker.isUnknownSymbol s || ctx.checker.isUndefinedSymbol s) then + roots.Add(s) + with + _ -> () + roots.ToArray() + + match ctx.checker.getSymbolAtLocation nd with + | None -> [] + | Some s -> + let rec go (acc: Set<_>) (s: Ts.Symbol) = + let sources = getSources s + let fullName = + ctx.checker.getFullyQualifiedName s + |> normalizeQualifiedName sources + let newItems = + sources + |> List.map (fun source -> { source = source; name = fullName }) + |> Set.ofList + if Set.isSubset newItems acc then acc + else + getRootAndAliasedSymbols(s) + |> Array.fold go (Set.union acc newItems) + go Set.empty s + |> Set.toList + |> List.sortBy (fun fn -> + if ctx.currentSource.fileName = fn.source then 0 + else if ctx.fileNames |> Array.contains fn.source then 1 + else 2) + + let rec readIdent (ctx: ParserContext) (nd: Ts.Node) : Ident = + let createIdent name parent (nd: Ts.Node) = + let kind = getKindFromName ctx nd + let loc = Node.location nd + let fullName = getFullNames ctx nd + { name = name; kind = kind; fullName = fullName; loc = loc; parent = parent } + match nd.kind with + | Kind.Identifier | Kind.PrivateIdentifier -> + let i = nd :?> Ts.Identifier + createIdent [i.text] None i + | Kind.QualifiedName -> + let q = nd :?> Ts.QualifiedName + let parent = readIdent ctx !!q.left + createIdent (parent.name @ [q.right.text]) (Some parent) q + | Kind.PropertyAccessExpression -> + let p = nd :?> Ts.PropertyAccessExpression + let parent = readIdent ctx p.expression + createIdent (parent.name @ [p.name?text]) (Some parent) p + | _ -> + nodeError ctx nd "cannot parse '%s' as an identifier (kind: %s)" (nd.getText()) (Enum.pp nd.kind) + + let readIdentOrTypeVar (ctx: ParserContext) (typrms: Set) (nd: Node) : Choice = + if nd.kind = Kind.Identifier && typrms |> Set.contains (nd :?> Ts.Identifier).text then + (nd :?> Ts.Identifier).text |> Choice2Of2 + else + readIdent ctx nd |> Choice1Of2 + + let sanitizeCommentText str : string list = + str |> String.toLines |> List.ofArray + + let readCommentText (comment: U2>) : string list = + let str = + if JS.typeof comment = "string" then + box comment :?> string + else + let texts = box comment :?> ResizeArray // TODO: do not ignore links + texts |> Seq.map (fun x -> x.text) |> String.concat "" + sanitizeCommentText str + + let readNonJSDocComments (ctx: ParserContext) (node: Node) : Comment list = + let fullText = ctx.currentSource.getFullText() + let ranges = ts.getLeadingCommentRanges(fullText, node.getFullStart()) + match ranges with + | None -> [] + | Some ranges -> + ranges + |> Seq.map (fun range -> + fullText.[int range.pos .. int range.``end``] + |> sanitizeCommentText |> Summary) + |> Seq.toList + + let readJSDocTag (tag: Ts.JSDocTag) : Comment = + let text = tag.comment |> Option.map readCommentText |> Option.defaultValue [] + match tag.kind with + | Kind.JSDocParameterTag -> + let tag = tag :?> Ts.JSDocParameterTag + Param ((box tag.name :?> Node) |> extractNestedName |> String.concat ".", text) + | Kind.JSDocReturnTag -> Return text + | Kind.JSDocDeprecatedTag -> Deprecated text + | Kind.JSDocSeeTag -> + let tag = tag :?> Ts.JSDocSeeTag + See ((box tag.name :?> Node option) |> Option.map (extractNestedName >> String.concat "."), text) + | _ -> + match tag.tagName.text with + | "description" | "desc" -> Description text + | "summary" -> Summary text + | "example" -> Example text + | tagName -> + Other (tagName, text, tag) + + let readJSDocComments (docComment: ResizeArray) (tags: Ts.JSDocTag seq) : Comment list = + let desc = + let text = + docComment + |> List.ofSeq + |> List.collect (fun sdp -> sdp.text |> sanitizeCommentText) + if List.isEmpty text then [] + else [Description text] + let tags = + tags + |> Seq.map readJSDocTag + |> List.ofSeq + desc @ tags + + let readCommentsForNamedDeclaration (ctx: ParserContext) (nd: Ts.NamedDeclaration) : Comment list = + let fallback () = + match nd.name with + | None -> + readNonJSDocComments ctx nd + | Some name -> + match ctx.checker.getSymbolAtLocation !!name with + | None -> + readNonJSDocComments ctx nd + | Some symbol -> + readJSDocComments (symbol.getDocumentationComment (Some ctx.checker)) (ts.getJSDocTags nd) + + match nd.kind with + // check if it is a SignatureDeclaration + | Kind.CallSignature | Kind.ConstructSignature | Kind.MethodSignature | Kind.IndexSignature + | Kind.FunctionType | Kind.ConstructorType | Kind.JSDocFunctionType | Kind.FunctionDeclaration + | Kind.MethodDeclaration | Kind.Constructor | Kind.GetAccessor | Kind.SetAccessor + | Kind.FunctionExpression | Kind.ArrowFunction -> + try + match ctx.checker.getSignatureFromDeclaration nd with + | None -> + fallback () + | Some signature -> + match readJSDocComments (signature.getDocumentationComment (Some ctx.checker)) (ts.getJSDocTags nd) with + | [] -> + fallback () + | xs -> xs + with e -> + nodeWarn ctx nd "exception while trying to read comments from a signature declaration" + eprintfn "%s" (e.StackTrace) + fallback () + | _ -> + fallback () + + let readLiteral (node: Node) : Literal option = + match node.kind with + | Kind.StringLiteral -> + Some (LString ((node :?> Ts.StringLiteral).text)) + | Kind.TrueKeyword -> Some (LBool true) + | Kind.FalseKeyword -> Some (LBool false) + | _ -> + let text = node.getText() + let parsedAsInt, intValue = System.Int32.TryParse text + let parsedAsFloat, floatValue = System.Double.TryParse text + if parsedAsInt then Some (LInt intValue) + else if parsedAsFloat then Some (LFloat floatValue) + else None + + let rec readTypeNode (typrm: Set) (ctx: ParserContext) (t: Ts.TypeNode) : Type = + match t.kind with + // primitives + | Kind.StringKeyword -> Prim String + | Kind.BooleanKeyword -> Prim Bool + | Kind.NumberKeyword -> Prim Number + | Kind.AnyKeyword -> Prim Any + | Kind.VoidKeyword -> Prim Void + | Kind.UnknownKeyword -> Prim Unknown + | Kind.NullKeyword -> Prim Null + | Kind.NeverKeyword -> Prim Never + | Kind.UndefinedKeyword -> Prim Undefined + | Kind.ObjectKeyword -> Prim Object + | Kind.SymbolKeyword -> Prim (PrimType.Symbol false) + | Kind.BigIntKeyword -> Prim BigInt + | Kind.ArrayType -> + let t = t :?> Ts.ArrayTypeNode + let elem = readTypeNode typrm ctx t.elementType + if isReadOnly t.modifiers then + App (APrim ReadonlyArray, [elem], Node.location t) + else + App (APrim Array, [elem], Node.location t) + | Kind.TupleType -> + let t = t :?> Ts.TupleTypeNode + readTupleTypeNode typrm ctx t (isReadOnly t.modifiers) + // complex types + | Kind.IntrinsicKeyword -> Intrinsic + | Kind.ThisType -> PolymorphicThis + | Kind.UnionType -> + let t = t :?> Ts.UnionTypeNode + Union { types = t.types |> Seq.map (readTypeNode typrm ctx) |> List.ofSeq } + | Kind.IntersectionType -> + let t = t :?> Ts.IntersectionTypeNode + Intersection { types = t.types |> Seq.map (readTypeNode typrm ctx) |> List.ofSeq } + | Kind.ParenthesizedType -> + readTypeNode typrm ctx ((t :?> Ts.ParenthesizedTypeNode).``type``) + // ident, possibly tyapp + | Kind.TypeReference + // ident, possibly tyapp, appearing in extends / implements + | Kind.ExpressionWithTypeArguments -> + let t = t :?> Ts.NodeWithTypeArguments + let lhs : Node = + match t.kind with + | Kind.TypeReference -> !!(t :?> Ts.TypeReferenceNode).typeName + | Kind.ExpressionWithTypeArguments -> !!(t :?> Ts.ExpressionWithTypeArguments).expression + | _ -> failwith "impossible" + match readIdentOrTypeVar ctx typrm lhs with + | Choice1Of2 lt -> + match t.typeArguments with + | None -> Ident lt + | Some args -> App (AIdent lt, args |> Seq.map (readTypeNode typrm ctx) |> List.ofSeq, Node.location t) + | Choice2Of2 x -> TypeVar x + | Kind.FunctionType -> + let t = t :?> Ts.FunctionTypeNode + let typrms = readTypeParameters typrm ctx t.typeParameters + let typrm' = Set.union typrm (typrms |> List.map (fun x -> x.name) |> Set.ofList) + let retTy = readTypeNode typrm' ctx t.``type`` + Func (readParameters typrm' ctx t.parameters t retTy, typrms, Node.location t) + | Kind.ConstructorType -> + let t = t :?> Ts.ConstructorTypeNode + let typrms = readTypeParameters typrm ctx t.typeParameters + let typrm' = Set.union typrm (typrms |> List.map (fun x -> x.name) |> Set.ofList) + let retTy = readTypeNode typrm' ctx t.``type`` + NewableFunc (readParameters typrm' ctx t.parameters t retTy, typrms, Node.location t) + | Kind.LiteralType -> + let t = t :?> Ts.LiteralTypeNode + if t.getText() = "null" then Prim Null // handle NullLiteral + else + match readLiteral (!!t.literal) with + | Some l -> TypeLiteral l + | None -> + nodeWarn ctx t "unsupported literal type '%s'" (t.getText()); + UnknownType (Some (t.getText())) + // anonymous interface + | Kind.TypeLiteral -> + let t = t :?> Ts.TypeLiteralNode + let members = t.members |> List.ofSeq |> List.map (readNamedDeclaration typrm ctx) + let temp = + { name = Anonymous; isInterface = true; isExported = Exported.No + comments = []; implements = []; typeParams = []; accessibility = Public + members = members; loc = Node.location t } + let freeTypeVars = Typer.Type.getFreeTypeVars (AnonymousInterface temp) + let usedTyprms = Set.intersect typrm freeTypeVars + if Set.isEmpty usedTyprms then AnonymousInterface temp + else + let usedTyprms = usedTyprms |> Set.toList + let typeParams = usedTyprms |> List.map (fun name -> { name = name; extends = None; defaultType = None }) + let typeArgs = usedTyprms |> List.map TypeVar + let ai = { temp with typeParams = typeParams } + App (AAnonymousInterface ai, typeArgs, Node.location t) + // readonly types + | Kind.TypeOperator -> + let t = t :?> Ts.TypeOperatorNode + match t.operator with + | Kind.ReadonlyKeyword -> + let t' = t.``type`` + match t'.kind with + | Kind.ArrayType -> + let t' = t' :?> Ts.ArrayTypeNode + let elem = readTypeNode typrm ctx t'.elementType + App (APrim ReadonlyArray, [elem], Node.location t') + | Kind.TupleType -> + let t' = t' :?> Ts.TupleTypeNode + readTupleTypeNode typrm ctx t' true + | _ -> + nodeWarn ctx t "unsupported 'readonly' modifier for type '%s'" (t.getText()) + UnknownType (Some (t.getText())) + | Kind.KeyOfKeyword -> + Erased (Keyof (readTypeNode typrm ctx t.``type``), Node.location t, t.getText()) + | Kind.UniqueKeyword -> + let t' = t.``type`` + match t'.kind with + | Kind.SymbolKeyword -> Prim (PrimType.Symbol true) + | _ -> + nodeWarn ctx t "unsupported 'unique' modifier for type '%s'" (t.getText()) + UnknownType (Some (t.getText())) + | _ -> + nodeWarn ctx t "unsupported type operator '%s'" (Enum.pp t.operator) + UnknownType (Some (t.getText())) + | Kind.IndexedAccessType -> + let t = t :?> Ts.IndexedAccessTypeNode + let lhs = readTypeNode typrm ctx t.objectType + let rhs = readTypeNode typrm ctx t.indexType + Erased (IndexedAccess (lhs, rhs), Node.location t, t.getText()) + | Kind.TypeQuery -> + let t = t :?> Ts.TypeQueryNode + Erased (TypeQuery (readIdent ctx !!t.exprName), Node.location t, t.getText()) + // fallbacks + | Kind.TypePredicate -> + nodeWarn ctx t "type predicate is not supported and treated as boolean" + Prim Bool + | _ -> + nodeWarn ctx t "unsupported TypeNode kind: %s" (Enum.pp t.kind); + UnknownType (Some (t.getText())) + + and readTupleTypeNode (typrm: Set) (ctx: ParserContext) (tuple: Ts.TupleTypeNode) isReadOnly : Type = + let f (x: U2) = + let xNode = box x :?> Ts.Node + match xNode.kind with + | Kind.NamedTupleMember -> + let x = xNode :?> Ts.NamedTupleMember + {| value = readTypeNode typrm ctx x.``type``; name = Some x.name.text |} + | _ -> + {| value = readTypeNode typrm ctx (xNode :?> Ts.TypeNode); name = None |} + Tuple { types = Seq.map f tuple.elements |> List.ofSeq; isReadOnly = isReadOnly } + + and readParameters<'retType> (typrm: Set) (ctx: ParserContext) (ps: Ts.ParameterDeclaration seq) (parent: Ts.Node) (retType: 'retType) : FuncType<'retType> = + let isVariadic = + ps |> Seq.exists (fun p -> p.dotDotDotToken |> Option.isSome) + let args = + ps + |> Seq.mapi (fun i p -> + let isOptional = p.questionToken |> Option.isSome + let nameOpt = p.name |> getBindingName ctx + let ty = + match p.``type`` with + | Some t -> readTypeNode typrm ctx t + | None -> + match nameOpt with + | Some name -> + nodeWarn ctx p "type not specified for param '%s'" name + | None -> + nodeWarn ctx p "type not specified for param %i" i + UnknownType None + match nameOpt with + | Some name -> + Choice1Of2 { name = name; isOptional = isOptional; value = ty } + | None -> + assert (not isOptional); + Choice2Of2 ty + ) + |> Seq.toList + { args = args; isVariadic = isVariadic; returnType = retType; loc = Node.location parent } + + and readMemberAttribute (ctx: ParserContext) (nd: Ts.NamedDeclaration) : MemberAttribute = + let accessibility = getAccessibility nd.modifiers |> Option.defaultValue Public + let isStatic = hasModifier Kind.StaticKeyword nd.modifiers + let comments = readCommentsForNamedDeclaration ctx nd + { accessibility = accessibility; isStatic = isStatic; comments = comments; loc = Node.location nd } + + and readNamedDeclaration (typrm: Set) (ctx: ParserContext) (nd: Ts.NamedDeclaration) : MemberAttribute * Member = + let attr = readMemberAttribute ctx nd + let extractType (sdb: Ts.SignatureDeclarationBase) = + let localTyprm = readTypeParameters typrm ctx sdb.typeParameters + match sdb.``type`` with + | Some t -> + localTyprm, + readTypeNode (Set.union typrm (localTyprm |> List.map (fun x -> x.name) |> Set.ofList)) ctx t + | None -> + if nd.kind <> Kind.Constructor && nd.kind <> Kind.SetAccessor then + match sdb.name with + | Some name -> + nodeWarn ctx sdb "type not specified for '%s' (%s)" (getText name) (Enum.pp nd.kind) + | None -> + nodeWarn ctx sdb "type not specified (%s)" (Enum.pp nd.kind) + localTyprm, UnknownType None + + let readSymbolIndexer (e: Ts.Expression) (ty: Choice>) (fail: unit -> _) = + match e.kind with + | Kind.PropertyAccessExpression -> + let e = !!e : Ts.PropertyAccessExpression + let name = e.getText() |> String.split "." |> List.ofArray + match name with + | ["Symbol"; symbolName] -> + let ft = + match ty with + | Choice1Of2 t -> { args = []; isVariadic = false; returnType = t; loc = Node.location nd } + | Choice2Of2 ft -> ft + attr, SymbolIndexer (symbolName, ft, if isReadOnly nd.modifiers then ReadOnly else Mutable) + | _ -> fail () + | _ -> fail () + + match nd.kind with + | Kind.PropertySignature -> + let fail () = + nodeWarn ctx nd "unsupported property name '%s' in PropertySignature" (getText nd.name); (attr, UnknownMember (Some (getText nd))) + let nd = nd :?> Ts.PropertySignature + let ty = + match nd.``type`` with + | Some t -> readTypeNode typrm ctx t + | None -> UnknownType None + match getPropertyName nd.name with + | Some name -> + match ty with + | UnknownType None -> + nodeWarn ctx nd "type not specified for field '%s'" (getText nd.name) + | _ -> () + let fl = { name = name; isOptional = false; value = ty } + attr, Field (fl, (if isReadOnly nd.modifiers then ReadOnly else Mutable)) + | None -> + match getPropertyExpression nd.name with + | Some expr -> readSymbolIndexer expr (Choice1Of2 ty) fail + | None -> fail () + | Kind.PropertyDeclaration -> + let nd = nd :?> Ts.PropertyDeclaration + match getPropertyName nd.name with + | Some name -> + let ty = + match nd.``type`` with + | Some t -> readTypeNode typrm ctx t + | None -> + UnknownType None + match ty with + | UnknownType None -> + nodeWarn ctx nd "type not specified for field '%s'" (getText nd.name) + | _ -> () + let fl = { name = name; isOptional = false; value = ty } + attr, Field (fl, (if isReadOnly nd.modifiers then ReadOnly else Mutable)) + | None -> nodeWarn ctx nd "unsupported property name '%s' in PropertyDeclaration" (getText nd.name); (attr, UnknownMember (Some (getText nd))) + | Kind.CallSignature -> + let nd = nd :?> Ts.CallSignatureDeclaration + let localTyprm, ty = extractType nd + let typrm = Set.union typrm (localTyprm |> List.map (fun x -> x.name) |> Set.ofList) + (attr, Callable (readParameters typrm ctx nd.parameters nd ty, localTyprm)) + | Kind.MethodSignature | Kind.MethodDeclaration -> + let sdb = nd :?> Ts.SignatureDeclarationBase + let fail () = + nodeWarn ctx sdb "unsupported method name '%s' in %s" (getText sdb.name) (Enum.pp nd.kind); (attr, UnknownMember (Some (getText sdb))) + let localTyprm, retTy = extractType sdb + let typrm = Set.union typrm (localTyprm |> List.map (fun x -> x.name) |> Set.ofList) + let func = readParameters typrm ctx sdb.parameters sdb retTy + match sdb.name |> Option.bind getPropertyName with + | Some name -> + attr, Method (name, func, localTyprm) + | None -> + match sdb.name |> Option.bind getPropertyExpression with + | Some expr -> readSymbolIndexer expr (Choice2Of2 func) fail + | None -> fail () + | Kind.IndexSignature -> + let nd = nd :?> Ts.IndexSignatureDeclaration + let localTyprm, ty = extractType nd + if not (List.isEmpty localTyprm) then nodeWarn ctx nd "indexer with type argument is not supported" + (attr, + Indexer (readParameters typrm ctx nd.parameters nd ty, + if isReadOnly nd.modifiers then ReadOnly else Mutable)) + | Kind.ConstructSignature -> + let nd = nd :?> Ts.ConstructSignatureDeclaration + let localTyprm, retTy = extractType nd + let typrm = Set.union typrm (localTyprm |> List.map (fun x -> x.name) |> Set.ofList) + let ty = readParameters typrm ctx nd.parameters nd retTy + { attr with isStatic = false }, Newable (ty, localTyprm) + | Kind.Constructor -> + let nd = nd :?> Ts.ConstructorDeclaration + let localTyprm, retTy = extractType nd + assert (match retTy with UnknownType _ -> true | _ -> false) + let typrm = Set.union typrm (localTyprm |> List.map (fun x -> x.name) |> Set.ofList) + let ty = readParameters typrm ctx nd.parameters nd () + { attr with isStatic = true }, Constructor (ty, localTyprm) + | Kind.GetAccessor -> + let nd = nd :?> Ts.GetAccessorDeclaration + match getPropertyName nd.name with + | Some name -> + let localTyprm, ty = extractType nd + if not (List.isEmpty localTyprm) then nodeWarn ctx nd "getter with type argument is not supported" + let fl = { name = name; isOptional = false; value = ty } + attr, Getter fl + | None -> nodeWarn ctx nd "unsupported property name '%s' in GetAccessor" (getText nd.name); (attr, UnknownMember (Some (getText nd))) + | Kind.SetAccessor -> + let nd = nd :?> Ts.SetAccessorDeclaration + match getPropertyName nd.name with + | Some name -> + let localTyprm, retTy = extractType nd + assert (match retTy with UnknownType _ -> true | _ -> false) + if not (List.isEmpty localTyprm) then nodeWarn ctx nd "setter with type argument is not supported" + match readParameters typrm ctx nd.parameters nd () with + | { args = [ty]; isVariadic = false } -> + match ty with + | Choice1Of2 named -> + attr, Setter { named with name = name } + | Choice2Of2 ty -> + attr, Setter { name = name; isOptional = false; value = ty } + | _ -> + nodeWarn ctx nd "invalid setter for '%s'" (getText nd.name) + attr, UnknownMember (Some (getText nd)) + | None -> nodeWarn ctx nd "unsupported property name '%s' in SetAccessor" (getText nd.name); (attr, UnknownMember (Some (getText nd))) + | _ -> + nodeWarn ctx nd "unsupported NamedDeclaration kind: '%s'" (Enum.pp nd.kind) + attr, UnknownMember (Some (getText nd)) + + and readTypeParameters (typrm: Set) (ctx: ParserContext) (tps: Ts.TypeParameterDeclaration ResizeArray option) : TypeParam list = + match tps with + | None -> [] + | Some tps -> + let names = tps |> Seq.map (fun tp -> tp.name.text) |> Set.ofSeq |> Set.union typrm + tps + |> Seq.map (fun tp -> + let dt = tp.``default`` |> Option.map (readTypeNode names ctx) + let et = tp.``constraint`` |> Option.map (readTypeNode names ctx) + { name = tp.name.text; extends = et; defaultType = dt } + ) + |> Seq.toList + + let readInherits (typrm: Set) (ctx: ParserContext) (hcs: Ts.HeritageClause ResizeArray option) : Type list = + match hcs with + | None -> [] + | Some hcs -> + hcs |> Seq.collect (fun hc -> hc.types |> Seq.map (readTypeNode typrm ctx)) + |> Seq.toList + + let readInterface (ctx: ParserContext) (i: Ts.InterfaceDeclaration) : Class = + let name = i.name.getText() + let typrms = readTypeParameters Set.empty ctx i.typeParameters + let typrmsSet = typrms |> List.map (fun tp -> tp.name) |> Set.ofList + { + comments = readCommentsForNamedDeclaration ctx i + name = Name name + accessibility = getAccessibility i.modifiers |> Option.defaultValue Public + typeParams = typrms + implements = readInherits typrmsSet ctx i.heritageClauses + isInterface = true + isExported = getExported i.modifiers + members = i.members |> List.ofSeq |> List.map (readNamedDeclaration typrmsSet ctx) + loc = Node.location i + } + + let readClass (ctx: ParserContext) (i: Ts.ClassDeclaration) : Class = + let typrms = readTypeParameters Set.empty ctx i.typeParameters + let typrmsSet = typrms |> List.map (fun tp -> tp.name) |> Set.ofList + { + comments = readCommentsForNamedDeclaration ctx i + name = i.name |> Option.map (fun id -> Name id.text) |> Option.defaultValue ExportDefaultUnnamedClass + accessibility = getAccessibility i.modifiers |> Option.defaultValue Public + typeParams = typrms + implements = readInherits typrmsSet ctx i.heritageClauses + isInterface = false + isExported = getExported i.modifiers + members = i.members |> List.ofSeq |> List.map (readNamedDeclaration typrmsSet ctx) + loc = Node.location i + } + + let readEnumCase (ctx: ParserContext) (em: Ts.EnumMember) : EnumCase option = + match getPropertyName em.name with + | Some name -> + let value = + let inline fallback () = + match ctx.checker.getConstantValue(!^em) with + | None -> None + | Some (U2.Case1 str) -> Some (LString str) + | Some (U2.Case2 num) -> + if Fable.Core.JS.Constructors.Number.isSafeInteger(num) then Some (LInt (int num)) + else Some (LFloat num) + match em.initializer with + | None -> fallback () + | Some ep -> + match readLiteral ep with + | Some ((LInt _ | LFloat _ | LString _) as l) -> Some l + | _ -> + fallback () |> Option.iterNone (fun () -> + nodeWarn ctx ep "enum value '%s' for case '%s' not supported" (ep.getText()) name) + let comments = readCommentsForNamedDeclaration ctx em + Some { comments = comments; loc = Node.location em; name = name; value = value } + | None -> nodeWarn ctx em "unsupported enum case name '%s'" (getText em.name); None + + let readEnum (ctx: ParserContext) (ed: Ts.EnumDeclaration) : Enum = + { + name = ed.name.text + comments = readCommentsForNamedDeclaration ctx ed + cases = ed.members |> List.ofSeq |> List.choose (readEnumCase ctx) + isExported = getExported ed.modifiers + loc = Node.location ed + } + + let readTypeAlias (ctx: ParserContext) (a: Ts.TypeAliasDeclaration) : TypeAlias = + let typrm = readTypeParameters Set.empty ctx a.typeParameters + let ty = readTypeNode (typrm |> List.map (fun x -> x.name) |> Set.ofList) ctx a.``type`` + let comments = readCommentsForNamedDeclaration ctx a + { name = a.name.text; typeParams = typrm; target = ty; comments = comments; isExported = getExported a.modifiers; loc = Node.location a } + + let readVariable (ctx: ParserContext) (v: Ts.VariableStatement) : Statement list = + v.declarationList.declarations |> List.ofSeq |> List.map (fun vd -> + let comments = readCommentsForNamedDeclaration ctx vd + match getBindingName ctx vd.name with + | None -> + nodeWarn ctx vd "name is not defined for variable" + UnknownStatement {| origText = Some (vd.getText()); loc = Node.location vd; comments = comments |} + | Some name -> + let ty = + match vd.``type`` with + | Some tn -> readTypeNode Set.empty ctx tn + | None -> + match vd.initializer with + | Some e -> + match e.kind with + | Kind.StringLiteral -> Prim String + | Kind.RegularExpressionLiteral -> Prim RegExp + | Kind.NumericLiteral | Kind.BigIntLiteral -> Prim Number + | Kind.TrueKeyword | Kind.FalseKeyword -> Prim Bool + | _ -> + nodeWarn ctx vd "type missing for variable '%s'" name + UnknownType None + | None -> + nodeWarn ctx vd "type missing for variable '%s'" name + UnknownType None + let isConst = (int vd.flags) ||| (int Ts.NodeFlags.Const) <> 0 + let isExported = getExported vd.modifiers + let accessibility = getAccessibility vd.modifiers + Variable { comments = comments; loc = Node.location vd; name = name; typ = ty; isConst = isConst; isExported = isExported; accessibility = accessibility } + ) + + let readFunction (ctx: ParserContext) (f: Ts.FunctionDeclaration) : Function option = + match f.name with + | None -> + nodeWarn ctx f "name is not defined for function"; None + | Some name -> + let name = name.text + let comments = readCommentsForNamedDeclaration ctx f + let isExported = getExported f.modifiers + let accessibility = getAccessibility f.modifiers + let typrm = readTypeParameters Set.empty ctx f.typeParameters + let ty = + let typrm = typrm |> List.map (fun x -> x.name) |> Set.ofList + let retTy = + match f.``type`` with + | Some tn -> readTypeNode typrm ctx tn + | None -> + nodeWarn ctx f "return type missing for function '%s'" name + UnknownType None + readParameters typrm ctx f.parameters f retTy + Some { comments = comments; loc = Node.location f; name = name; typ = ty; typeParams = typrm; isExported = isExported; accessibility = accessibility } + + let readExportAssignment (ctx: ParserContext) (e: Ts.ExportAssignment) : Statement option = + let comments = readCommentsForNamedDeclaration ctx e + match e.expression.kind with + | Kind.Identifier | Kind.QualifiedName -> + let ident = readIdent ctx e.expression + match e.isExportEquals with + | Some true -> Export { clauses = [CommonJsExport ident]; loc = Node.location e; comments = comments; origText = e.getText() } |> Some + | _ -> Export { clauses = [ES6DefaultExport ident]; loc = Node.location e; comments = comments; origText = e.getText() } |> Some + | _ -> + nodeWarn ctx e.expression "default export of a value '%s' is not supported" (e.expression.getText()) + None + + let readExportDeclaration (ctx: ParserContext) (e: Ts.ExportDeclaration) : Statement list option = + let comments = readCommentsForNamedDeclaration ctx e + match e.exportClause, e.moduleSpecifier with + | None, _ + | _, Some _ -> + nodeWarn ctx e "re-exporting an external module is not supported."; None + | Some bindings, None -> + let kind = (bindings |> box :?> Ts.Node).kind + match kind with + | Kind.NamespaceExport -> + let ne = bindings |> box :?> Ts.NamespaceExport + Some [Export { clauses = [NamespaceExport ne.name.text]; loc = Node.location ne; comments = comments; origText = e.getText() }] + | Kind.NamedExports -> + let nes = bindings |> box :?> Ts.NamedExports + let clauses = + nes.elements + |> Seq.map (fun x -> + let inline ident (name: Ts.Identifier) = readIdent ctx name + match x.propertyName with + | None -> ES6Export {| target = ident x.name; renameAs = None |} + | Some propertyName -> ES6Export {| target = ident propertyName; renameAs = Some x.name.text |}) + |> Seq.toList + Some [Export { clauses = clauses; loc = Node.location nes; comments = comments; origText = e.getText() }] + | _ -> + nodeWarn ctx e "invalid syntax kind '%s' for an export declaration" (Enum.pp kind); None + + let readNamespaceExportDeclaration (ctx: ParserContext) (e: Ts.NamespaceExportDeclaration) : Statement = + Export { clauses = [NamespaceExport e.name.text]; loc = Node.location e; comments = readCommentsForNamedDeclaration ctx e; origText = e.getText() } + + let readImportEqualsDeclaration (ctx: ParserContext) (i: Ts.ImportEqualsDeclaration) : Statement option = + let comments = readCommentsForNamedDeclaration ctx i + let moduleReference = !!i.moduleReference : Ts.Node + match moduleReference.kind with + | Kind.Identifier | Kind.QualifiedName -> + let kind = getKindFromName ctx moduleReference + Import { + comments = comments; + loc = Node.location i; + isTypeOnly = i.isTypeOnly; + isExported = getExported i.modifiers; + clauses = [LocalImport {| name = i.name.text; kind = kind; target = readIdent ctx moduleReference |}] + origText = i.getText() + } |> Some + | Kind.ExternalModuleReference -> + let m : Ts.ExternalModuleReference = !!i.moduleReference + match (!!m.expression : Ts.Node).kind with + | Kind.StringLiteral -> + let moduleSpecifier = (!!m.expression : Ts.StringLiteral).text + let kind = getKindFromName ctx i.name + Import { + comments = comments; + loc = Node.location i; + isTypeOnly = i.isTypeOnly; + isExported = getExported i.modifiers; + clauses = [NamespaceImport {| name = i.name.text; isES6Import = false; kind = kind; specifier = moduleSpecifier |}] + origText = i.getText() + } |> Some + | kind -> + nodeWarn ctx i "invalid kind '%s' for module specifier" (Enum.pp kind); None + | kind -> + nodeWarn ctx i "invalid kind '%s' for import" (Enum.pp kind); None + + let readImportDeclaration (ctx: ParserContext) (i: Ts.ImportDeclaration) : Statement option = + match i.importClause with + | None -> nodeWarn ctx i "side-effect only import will be ignored"; None + | Some c -> + match i.moduleSpecifier.kind with + | Kind.StringLiteral -> + let comments = readCommentsForNamedDeclaration ctx c + let moduleSpecifier = (!!i.moduleSpecifier : Ts.StringLiteral).text + let inline create clauses = + Some (Import { comments = comments; loc = Node.location i; isTypeOnly = c.isTypeOnly; isExported = getExported i.modifiers; clauses = clauses; origText = i.getText() }) + match c.name, c.namedBindings with + | None, None -> create [ES6WildcardImport moduleSpecifier] + | None, Some b when (!!b : Ts.Node).kind = Kind.NamespaceImport -> + let n = (!!b : Ts.NamespaceImport) + let kind = getKindFromName ctx n.name + create [NamespaceImport {| name = n.name.text; kind = kind; isES6Import = true; specifier = moduleSpecifier |}] + | _, Some b when (!!b : Ts.Node).kind = Kind.NamedImports -> + let n = (!!b : Ts.NamedImports) + let spec = {| specifier = moduleSpecifier |} + let defaultImport = c.name |> Option.map (fun i -> ES6DefaultImport {| spec with name = i.text; kind = getKindFromName ctx i |}) + let bindings = + n.elements + |> Seq.toList + |> List.map (fun e -> + let kind = getKindFromName ctx e.name + let name, renameAs = + match e.propertyName with + | Some i -> i.text, Some e.name.text + | None -> e.name.text, None + ES6Import {| spec with name = name; kind = kind; renameAs = renameAs |}) + create (Option.toList defaultImport @ bindings) + | Some i, None -> + create [ES6DefaultImport {| name = i.text; kind = getKindFromName ctx i; specifier = moduleSpecifier |}] + | _, _ -> + nodeWarn ctx i "invalid import statement"; None + | kind -> + nodeWarn ctx i "invalid kind '%s' for module specifier" (Enum.pp kind); None + + let readJSDocImpl (ctx: ParserContext) (doc: Ts.JSDoc) : Comment list = + let desc = + doc.comment + |> Option.map (readCommentText >> Description >> List.singleton) + |> Option.defaultValue [] + let tags = + doc.tags + |> Option.map (Seq.map readJSDocTag >> List.ofSeq) + |> Option.defaultValue [] + desc @ tags + + let readJSDoc (ctx: ParserContext) (doc: Ts.JSDoc) : Statement option = + match readJSDocImpl ctx doc with + | [] -> None + | xs -> FloatingComment {| comments = xs; loc = Node.location doc |} |> Some + + let rec readModule (ctx: ParserContext) (md: Ts.ModuleDeclaration) : Statement = + let name = + match (!!md.name : Ts.Node).kind with + | Kind.GlobalKeyword -> None + | Kind.Identifier -> + match (!!md.name : Ts.Identifier).text with + | "global" -> None + | name -> Some name + | Kind.StringLiteral -> (!!md.name : Ts.StringLiteral).text |> Some + | _ -> nodeError ctx !!md.name "unsupported module name '%s'" (getText md.name) + let check kind = + md.getChildren() |> Seq.exists (fun nd -> nd.kind = kind) + let isNamespace = check Kind.NamespaceKeyword + let isExported = getExported md.modifiers + let statements = + md.getChildren() + |> Seq.toList + |> List.collect (fun nd -> + match nd.kind with + | Kind.ModuleBlock -> + let mb = nd :?> Ts.ModuleBlock + mb.statements |> List.ofSeq |> List.collect (readStatement ctx) + | Kind.NamespaceKeyword | Kind.ExportKeyword | Kind.Identifier + | Kind.DeclareKeyword | Kind.StringLiteral | Kind.DotToken | Kind.SyntaxList | Kind.ModuleKeyword -> [] + | Kind.JSDocComment -> [] + | Kind.ModuleDeclaration -> + [ readModule ctx (nd :?> Ts.ModuleDeclaration) ] + | _ -> + nodeWarn ctx nd "unknown kind in ModuleDeclaration: %s" (Enum.pp nd.kind) + []) + let comments = + md.getChildren() + |> Seq.filter (fun nd -> nd.kind = Kind.JSDocComment) + |> List.ofSeq + |> List.collect (fun nd -> nd :?> Ts.JSDoc |> readJSDocImpl ctx) + match name with + | Some name -> + Module { isExported = isExported; isNamespace = isNamespace; name = name; statements = statements; comments = comments; loc = Node.location md } + | None -> + Global { isExported = isExported; isNamespace = isNamespace; name = (); statements = statements; comments = comments; loc = Node.location md } + + and readStatement (ctx: ParserContext) (stmt: Ts.Statement) : Statement list = + let onError () = + let comments = readCommentsForNamedDeclaration ctx (stmt :?> Ts.DeclarationStatement) + UnknownStatement {| origText = Some (stmt.getText()); loc = Node.location stmt; comments = comments |} + try + match stmt.kind with + | Kind.TypeAliasDeclaration -> [readTypeAlias ctx (stmt :?> _) |> TypeAlias] + | Kind.InterfaceDeclaration -> [readInterface ctx (stmt :?> _) |> Class] + | Kind.ClassDeclaration -> [readClass ctx (stmt :?> _) |> Class] + | Kind.EnumDeclaration -> [readEnum ctx (stmt :?> _) |> Enum] + | Kind.ModuleDeclaration -> [readModule ctx (stmt :?> _)] + | Kind.VariableStatement -> readVariable ctx (stmt :?> _) + | Kind.FunctionDeclaration -> [readFunction ctx (stmt :?> _) |> Option.map Function |> Option.defaultWith onError] + | Kind.ExportAssignment -> [readExportAssignment ctx (stmt :?> _) |> Option.defaultWith onError] + | Kind.ExportDeclaration -> readExportDeclaration ctx (stmt :?> _) |> Option.defaultWith (onError >> List.singleton) + | Kind.NamespaceExportDeclaration -> [readNamespaceExportDeclaration ctx (stmt :?> _)] + | Kind.ImportEqualsDeclaration -> [readImportEqualsDeclaration ctx (stmt :?> _) |> Option.defaultWith onError] + | Kind.ImportDeclaration -> [readImportDeclaration ctx (stmt :?> _) |> Option.defaultWith onError] + | _ -> + nodeWarn ctx stmt "skipping unsupported Statement kind: %s" (Enum.pp stmt.kind) + [onError ()] + with + | _ -> + eprintfn "%s" (Node.ppLine stmt) + reraise () + +module Node = Node.Api + +/// works on NodeJS only. +let private getAllLocalReferences (ctx: #IContext<#IOptions>) (sourceFiles: Ts.SourceFile seq) = + let sourceFilesMap = new MutableMap<_, _>() + for sourceFile in sourceFiles do + sourceFilesMap.Add(Path.absolute sourceFile.fileName, sourceFile) + + let createSourceFile path = + ts.createSourceFile(path, Node.fs.readFileSync(path, "utf-8"), Ts.ScriptTarget.Latest, setParentNodes=true, scriptKind=Ts.ScriptKind.TS) + + let tryAdd (from: Ts.SourceFile) path = + let path = Path.absolute path + if not (sourceFilesMap.ContainsKey(path)) then + ctx.logger.tracef "* found '%s' referenced by '%s'" path from.fileName + let sourceFile = createSourceFile path + sourceFilesMap.Add(path, sourceFile) + Some sourceFile + else None + + for sourceFile in sourceFiles do + for file in sourceFile.referencedFiles do + Path.join [Path.dirname sourceFile.fileName; file.fileName] + |> tryAdd sourceFile |> ignore + + let tryFindDefinitionFile (sourceFile: Ts.SourceFile) relativePath = + let tryGet name = + let p = Path.join [Path.dirname sourceFile.fileName; name] + if Node.fs.existsSync(!^p) then Some p else None + 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 + match tryFindDefinitionFile sourceFile specifier with + | None -> None + | Some path -> tryAdd sourceFile path + 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 = + for statement in sourceFile.statements do + go sourceFile statement |> ignore + + for sourceFile in sourceFiles do goSourceFile sourceFile + + 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 = + if not ctx.options.followRelativeReferences then + fileNames |> Array.map Path.absolute + else + fileNames + |> Seq.map Path.absolute + |> Seq.map (fun a -> a, Node.fs.readFileSync(a, "utf-8")) + |> Seq.map (fun (a, i) -> + ts.createSourceFile (a, i, Ts.ScriptTarget.Latest, setParentNodes=true, scriptKind=Ts.ScriptKind.TS)) + |> fun srcs -> + ctx.logger.tracef "* following relative references..." + getAllLocalReferences ctx srcs |> fst + fileNames, TypeScriptHelper.createProgramForNode fileNames compilerOptions + !!{| + logger = ctx.logger + options = ctx.options + program = program + checker = program.getTypeChecker() + fileNames = fileNames + currentSource = (null : Ts.SourceFile) + |} + +let createSourceFileFromString (ctx: #IContext<#IOptions>) compilerOptions (files: {| fileName: string; text: string |} seq) : ParserContext = + let sourceFiles = + files + |> Seq.map (fun x -> ts.createSourceFile (x.fileName, x.text, Ts.ScriptTarget.Latest, setParentNodes=true, scriptKind=Ts.ScriptKind.TS)) + |> Seq.toArray + let program = TypeScriptHelper.createProgramForBrowser sourceFiles compilerOptions + !!{| + logger = ctx.logger + options = ctx.options + program = program + checker = program.getTypeChecker() + fileNames = files |> Seq.map (fun x -> x.fileName) |> Seq.toArray + currentSource = (null : Ts.SourceFile) + |} + +let parse (ctx: ParserContext) : Input = + let srcs = + let targets = ctx.fileNames |> Set.ofArray + ctx.program.getSourceFiles() + |> Seq.filter (fun sf -> targets |> Set.contains sf.fileName) + let sources = + srcs + |> Seq.toList + |> List.map (fun src -> + ctx.logger.tracef "* parsing %s..." src.fileName + let references = + Seq.concat [ + src.referencedFiles |> Seq.map (fun x -> FileReference x.fileName) + src.typeReferenceDirectives |> Seq.map (fun x -> TypeReference x.fileName) + src.libReferenceDirectives |> Seq.map (fun x -> LibReference x.fileName) + ] |> Seq.toList + let statements = + src.statements + |> Seq.collect ( + ParserImpl.readStatement + (ctx |> JS.cloneWith (fun ctx -> ctx.currentSource <- src))) + |> Seq.toList + { statements = statements + fileName = src.fileName + hasNoDefaultLib = src.hasNoDefaultLib + references = references }) + + let info = + match sources with + | example :: _ -> JsHelper.getPackageInfo example.fileName + | [] -> None + + 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 } \ No newline at end of file diff --git a/src/Syntax.fs b/lib/Syntax.fs old mode 100755 new mode 100644 similarity index 66% rename from src/Syntax.fs rename to lib/Syntax.fs index 9dc85c47..c1058f71 --- a/src/Syntax.fs +++ b/lib/Syntax.fs @@ -1,6 +1,31 @@ -module Syntax +module Ts2Ml.Syntax + open TypeScript +type [] Kind = + /// variable or member. + | Value + | Type + | TypeAlias + /// class or interface. + | ClassLike + | Member + | Module + | Enum + | EnumCase + /// child of a module. + | Statement +with + static member OfTypeAlias = [Type; TypeAlias; Statement] + static member OfInterface = [Type; ClassLike; Statement] + static member OfClass = [Value; Type; ClassLike; Statement] + static member OfEnum = [Value; Type; Enum; Statement] + static member OfEnumCase = [Value; Type; EnumCase] + static member OfNamespace = [Module; Statement] + static member OfModule = [Value; Module; Statement] + static member OfValue = [Value; Statement] + static member OfMember = [Value; Member] + [] type Location = | LocationTs of Ts.SourceFile * Ts.LineAndCharacter @@ -81,18 +106,12 @@ and ICommented<'a> = abstract getComments: unit -> Comment list abstract mapComments: (Comment list -> Comment list) -> 'a -and [] Kind = - | Value - | Type - | ClassLike - | Module - | Enum - and PrimType = | String | Bool | Number | Any | Void | Unknown | Null | Never | Undefined | Object | UntypedFunction + /// `unique symbol` if `isUnique = true`. | Symbol of isUnique:bool | RegExp | Array | ReadonlyArray @@ -148,46 +167,49 @@ and EnumCase = { and Type = | Intrinsic | PolymorphicThis - | Ident of IdentType + | Ident of Ident | TypeVar of string | Prim of PrimType | TypeLiteral of Literal - | AnonymousInterface of Class + | AnonymousInterface of AnonymousInterface | Union of UnionType | Intersection of IntersectionType | Tuple of TupleType - | Function of FuncType + | Func of FuncType * TypeParam list * Location + | NewableFunc of FuncType * TypeParam list * Location | App of AppLeftHandSide * Type list * Location | Erased of ErasedType * Location * origText:string | UnknownType of string option and AppLeftHandSide = - | AIdent of IdentType + | AIdent of Ident | APrim of PrimType - | AAnonymousInterface of Class + | AAnonymousInterface of AnonymousInterface and ErasedType = | IndexedAccess of Type * Type - | TypeQuery of IdentType + | TypeQuery of Ident | Keyof of Type - | NewableFunction of FuncType * TypeParam list -and UnionType = { - types: Type list -} +and UnionType = { types: Type list } -and IntersectionType = { - types: Type list -} +and IntersectionType = { types: Type list } and TupleType = { types: {| value: Type; name: string option |} list isReadOnly: bool } -and IdentType = { +and Ident = { name: string list - fullName: string list option + kind: Set option + fullName: FullName list loc: Location + parent: Ident option +} + +and [] FullName = { + source: Path.Absolute + name: string list } and FieldLike = { name:string; isOptional:bool; value:Type } @@ -203,8 +225,8 @@ and TypeParam = { defaultType: Type option } -and Class = { - name: string option +and Class<'name> = { + name: 'name accessibility: Accessibility isInterface: bool isExported: Exported @@ -214,20 +236,60 @@ and Class = { comments: Comment list loc: Location } with - interface ICommented with + member this.MapName f = + { name = f this.name; accessibility = this.accessibility; isInterface = this.isInterface; isExported = this.isExported; + implements = this.implements; typeParams = this.typeParams; members = this.members; comments = this.comments; loc = this.loc } + interface ICommented> with member this.getComments() = this.comments member this.mapComments f = { this with comments = f this.comments } +and ClassName = Name of string | ExportDefaultUnnamedClass +and Class = Class +and Anonymous = Anonymous +and AnonymousInterface = Class +and ClassOrAnonymousInterface = Class> + and Member = - | Field of FieldLike * Mutability * TypeParam list + /// ```ts + /// class { name: Type } + /// ``` + | Field of FieldLike * Mutability + /// ```ts + /// class { name(...): Type } + /// ``` | Method of string * FuncType * TypeParam list - | FunctionInterface of FuncType * TypeParam list + /// ```ts + /// interface { (...): Type } + /// ``` + /// Never static. + | Callable of FuncType * TypeParam list + /// ```ts + /// interface { new (...): Type } + /// ``` + /// Never static. + | Newable of FuncType * TypeParam list + /// ```ts + /// class { [key: string]: number } + /// ``` | Indexer of FuncType * Mutability - | Getter of FieldLike | Setter of FieldLike + /// ```ts + /// class { get name(): Type } + /// ``` + | Getter of FieldLike + /// ```ts + /// class { set name(value: Type) } + /// ``` + | Setter of FieldLike + /// ```ts + /// class { constructor (...) } + /// ``` + /// Always static. | Constructor of FuncType * TypeParam list - | New of FuncType * TypeParam list + /// ```ts + /// class { [Symbol.symbolName](...): Type } + /// ``` | SymbolIndexer of symbolName:string * FuncType * Mutability - | UnknownMember of string option + | UnknownMember of origText:string option and MemberAttribute = { comments: Comment list @@ -239,17 +301,29 @@ and MemberAttribute = { member this.getComments() = this.comments member this.mapComments f = { this with comments = f this.comments } -and Value = { +and Variable = { name: string typ: Type - typeParams: TypeParam list isConst: bool isExported: Exported accessibility : Accessibility option comments: Comment list loc: Location } with - interface ICommented with + interface ICommented with + member this.getComments() = this.comments + member this.mapComments f = { this with comments = f this.comments } + +and Function = { + name: string + typ: FuncType + typeParams: TypeParam list + isExported: Exported + accessibility : Accessibility option + comments: Comment list + loc: Location +} with + interface ICommented with member this.getComments() = this.comments member this.mapComments f = { this with comments = f this.comments } @@ -266,37 +340,82 @@ and TypeAlias = { member this.mapComments f = { this with comments = f this.comments } and Statement = + /// ```ts + /// type Name = ... + /// ``` | TypeAlias of TypeAlias - | ClassDef of Class - | EnumDef of Enum + /// ```ts + /// class Name { ... } + /// ``` + /// or + /// ```ts + /// interface Name { ... } + /// ``` + | Class of Class + /// ```ts + /// enum Name { ... } + /// ``` + | Enum of Enum + /// ```ts + /// module Name { ... } + /// ``` + /// or + /// ```ts + /// namespace Name { ... } + /// ``` | Module of Module - | Value of Value + /// ```ts + /// namespace global { ... } + /// ``` + | Global of Global + /// ```ts + /// var name: Type + /// ``` + /// or + /// ```ts + /// const name: Type + /// ``` + | Variable of Variable + /// ```ts + /// function name(..): Type + /// ``` + | Function of Function + /// ```ts + /// import ... + /// ``` | Import of Import + /// ```ts + /// export ... + /// ``` | Export of Export | Pattern of Pattern - | UnknownStatement of {| msg: string option; comments: Comment list; loc: Location |} + | UnknownStatement of {| origText: string option; comments: Comment list; loc: Location |} + /// ```ts + /// /// some floating comment + /// ``` | FloatingComment of {| comments: Comment list; loc: Location |} with member this.loc = match this with - | TypeAlias ta -> ta.loc | ClassDef c -> c.loc | EnumDef e -> e.loc - | Module m -> m.loc | Value v -> v.loc + | TypeAlias ta -> ta.loc | Class c -> c.loc | Enum e -> e.loc + | Module m -> m.loc | Global m -> m.loc | Variable v -> v.loc | Function f -> f.loc | Import i -> i.loc | Export e -> e.loc | Pattern p -> p.loc | UnknownStatement u -> u.loc | FloatingComment c -> c.loc member this.isExported = match this with - | TypeAlias { isExported = i } | ClassDef { isExported = i } - | EnumDef { isExported = i } | Module { isExported = i } - | Value { isExported = i } | Import { isExported = i } -> i + | TypeAlias { isExported = i } | Class { isExported = i } + | Enum { isExported = i } | Module { isExported = i } + | Variable { isExported = i } | Function { isExported = i } + | Import { isExported = i } -> i | Pattern p -> p.isExported - | Export _ | UnknownStatement _ | FloatingComment _ -> Exported.No + | Export _ | UnknownStatement _ | FloatingComment _ | Global _ -> Exported.No interface ICommented with member this.getComments() = match this with - | TypeAlias ta -> ta.comments | ClassDef c -> c.comments - | EnumDef e -> e.comments | Module m -> m.comments - | Value v -> v.comments + | TypeAlias ta -> ta.comments | Class c -> c.comments + | Enum e -> e.comments | Module m -> m.comments | Global m -> m.comments + | Variable v -> v.comments | Function f -> f.comments | Import i -> i.comments | Export e -> e.comments | UnknownStatement s -> s.comments @@ -306,10 +425,12 @@ and Statement = let inline map f (x: #ICommented<'a>) = x.mapComments f match this with | TypeAlias ta -> TypeAlias (map f ta) - | ClassDef c -> ClassDef (map f c) - | EnumDef e -> EnumDef (map f e) + | Class c -> Class (map f c) + | Enum e -> Enum (map f e) | Module m -> Module (map f m) - | Value v -> Value (map f v) + | Global m -> Global (map f m) + | Variable v -> Variable (map f v) + | Function g -> Function (map f g) | Import i -> Import (map f i) | Export e -> Export (map f e) | Pattern p -> Pattern ((p :> ICommented<_>).mapComments f) @@ -323,7 +444,7 @@ and Pattern = /// } /// declare var Foo: Foo; /// ``` - | ImmediateInstance of intf:Class * value:Value + | ImmediateInstance of intf:Class * var:Variable /// ```typescript /// interface Foo { /// ... @@ -334,7 +455,7 @@ and Pattern = /// } /// declare var Foo: FooConstructor; /// ``` - | ImmediateConstructor of baseIntf:Class * ctorIntf:Class * ctorValue:Value + | ImmediateConstructor of baseIntf:Class * ctorIntf:Class * ctorVar:Variable with member this.loc = match this with @@ -346,8 +467,8 @@ and Pattern = | ImmediateConstructor (_, _, value) -> value.isExported member this.underlyingStatements = match this with - | ImmediateInstance (intf, value) -> [ClassDef intf; Value value] - | ImmediateConstructor (bi, ci, v) -> [ClassDef bi; ClassDef ci; Value v] + | ImmediateInstance (intf, value) -> [Class intf; Variable value] + | ImmediateConstructor (bi, ci, v) -> [Class bi; Class ci; Variable v] interface ICommented with member this.getComments() = match this with @@ -360,15 +481,28 @@ and Pattern = | ImmediateConstructor (bi, ci, v) -> ImmediateConstructor ((bi :> ICommented<_>).mapComments f, (ci :> ICommented<_>).mapComments f, (v :> ICommented<_>).mapComments f) -and Module = { - name: string +and Module<'name> = { + name: 'name isExported: Exported isNamespace: bool statements: Statement list comments: Comment list loc: Location } with - interface ICommented with + interface ICommented> with + member this.getComments() = this.comments + member this.mapComments f = { this with comments = f this.comments } + +and Module = Module +and Global = Module + +and Export = { + comments: Comment list + clauses: ExportClause list + loc: Location + origText: string +} with + interface ICommented with member this.getComments() = this.comments member this.mapComments f = { this with comments = f this.comments } @@ -387,7 +521,7 @@ and ExportClause = /// ```js /// const whatever = require("path"); /// ``` - | CommonJsExport of IdentType + | CommonJsExport of Ident /// ```ts /// export default ident; /// ``` @@ -402,7 +536,7 @@ and ExportClause = /// ```js /// const whatever = require("path").default; /// ``` - | ES6DefaultExport of IdentType + | ES6DefaultExport of Ident /// ```ts /// export { target }; // name = target, when renameAs = None /// export { target as name }; // when renameAs = Some name @@ -418,7 +552,7 @@ and ExportClause = /// ```js /// const whatever = require("path").name; /// ``` - | ES6Export of {| target: IdentType; renameAs: string option |} + | ES6Export of {| target: Ident; renameAs: string option |} /// ```ts /// export as namespace ns; /// ``` @@ -437,16 +571,6 @@ and ExportClause = /// ``` | NamespaceExport of ns:string -and Export = { - comments: Comment list - clause: ExportClause - loc: Location - origText: string -} with - interface ICommented with - member this.getComments() = this.comments - member this.mapComments f = { this with comments = f this.comments } - and [] Exported = | No /// ```ts @@ -456,13 +580,14 @@ and [] Exported = /// ```ts /// export default class Foo { .. } /// ``` + /// This class might not have a name. | Default /// ```ts /// declare class Foo { .. } /// ``` | Declared with - member this.AsExport(ident: IdentType) = + member this.AsExport(ident: Ident) = match this with | No | Declared -> None | Yes -> ES6Export {| target = ident; renameAs = None |} |> Some @@ -472,8 +597,7 @@ and Import = { comments: Comment list isTypeOnly: bool isExported: Exported - moduleSpecifier: string - clause: ImportClause + clauses: ImportClause list loc: Location origText: string } with @@ -481,14 +605,14 @@ and Import = { member this.getComments() = this.comments member this.mapComments f = { this with comments = f this.comments } member this.Identifiers = - match this.clause with - | NamespaceImport i -> [{| name = i.name; kind = i.kind |}] - | ES6WildcardImport -> [] - | ES6Import i -> - let xs = i.bindings |> List.map (fun x -> {| name = (match x.renameAs with Some name -> name | None -> x.name); kind = x.kind |}) - match i.defaultImport with - | None -> xs - | Some x -> x :: xs + this.clauses + |> List.collect (function + | NamespaceImport i -> [{| name = i.name; kind = i.kind |}] + | ES6WildcardImport _ -> [] + | ES6Import i -> [{| name = i.name; kind = i.kind |}] + | ES6DefaultImport i -> [{| name = i.name; kind = i.kind |}] + | LocalImport i -> [{| name = i.name; kind = i.kind |}] + ) and ImportClause = /// one of: @@ -497,32 +621,61 @@ and ImportClause = /// /// import * as name from 'moduleSpecifier' /// ``` - | NamespaceImport of {| name: string; kind: Set option; isES6Import: bool |} + | NamespaceImport of {| name: string; kind: Set option; isES6Import: bool; specifier: string |} /// ES6 namespace import but without a name. /// ```ts /// import * from 'moduleSpecifier' /// ``` - | ES6WildcardImport + | ES6WildcardImport of specifier:string /// ```ts - /// import defaultImport, { name1, name2 as renameAs, .. } from 'moduleSpecifier' + /// import { name as renameAs } from 'moduleSpecifier' /// ``` - | ES6Import of - {| - defaultImport: {| name: string; kind: Set option |} option - bindings: {| name: string; kind: Set option; renameAs: string option |} list - |} + | ES6Import of {| name: string; kind: Set option; renameAs: string option; specifier: string |} + /// ```ts + /// import defaultImport from 'moduleSpecifier' + /// ``` + | ES6DefaultImport of {| name: string; kind: Set option; specifier: string |} + /// ```ts + /// import name = identifier + /// ``` + | LocalImport of {| name: string; kind: Set option; target: Ident |} + member this.kind = + match this with + | NamespaceImport i -> i.kind + | ES6WildcardImport _ -> None + | ES6Import i -> i.kind + | ES6DefaultImport i -> i.kind + | LocalImport i -> i.kind + member this.moduleSpecifier = + match this with + | NamespaceImport i -> Some i.specifier + | ES6WildcardImport s -> Some s + | ES6Import i -> Some i.specifier + | ES6DefaultImport i -> Some i.specifier + | LocalImport _ -> None and Reference = + /// ```ts + /// /// + /// ``` | FileReference of string + /// ```ts + /// /// + /// ``` | TypeReference of string + /// ```ts + /// /// + /// ``` | LibReference of string and SourceFile = { - fileName: Path.Relative + fileName: Path.Absolute statements: Statement list references: Reference list + /// ```ts + /// /// + /// ``` hasNoDefaultLib: bool - moduleName: string option } type PackageInfo = { @@ -536,13 +689,19 @@ type PackageInfo = { /// absolute path rootPath: Path.Absolute /// `index.d.ts` or the one specified in `package.json`. - indexFile: Path.Relative option - exports: {| submodule: string; file: Path.Relative |} list + indexFile: Path.Absolute option + exports: {| submodule: string; file: Path.Absolute |} list } 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 = @@ -574,7 +733,7 @@ module Type = let rec pp = function | Intrinsic -> "intrinsic" | PolymorphicThis -> "this" - | Ident i -> (if Option.isNone i.fullName then "?" else "") + (i.name |> String.concat ".") + | Ident i -> i.name |> String.concat "." | TypeVar v -> "'" + v | Prim p -> sprintf "%A" p | TypeLiteral l -> Literal.toString l @@ -587,27 +746,27 @@ module Type = |> List.map (fun t -> (match t.name with Some n -> n + ":" | None -> "") + pp t.value) |> String.concat ", " ) + ")" - | Function f -> + | Func (f, typrms, _) -> + let typrms = + if List.isEmpty typrms then "" + else + let args = + typrms |> List.map (fun x -> sprintf "'%s" x.name) + sprintf "<%s>" (args |> String.concat ", ") let args = f.args |> List.map (function | Choice1Of2 a -> sprintf "%s%s:%s" (if a.isOptional then "?" else "~") a.name (pp a.value) | Choice2Of2 t -> pp t) - "(" + (args @ [pp f.returnType] |> String.concat " -> ") + ")" + typrms + "(" + (args @ [pp f.returnType] |> String.concat " -> ") + ")" + | NewableFunc (f, typrms, loc) -> + "new " + (pp (Func (f, typrms, loc))) | App (t, ts, _) -> pp (ofAppLeftHandSide t) + "<" + (ts |> List.map pp |> String.concat ", ") + ">" | Erased (e, _, _) -> match e with | IndexedAccess (t, u) -> sprintf "%s[%s]" (pp t) (pp u) | TypeQuery i -> sprintf "typeof %s" (String.concat "." i.name) | Keyof t -> sprintf "keyof %s" (pp t) - | NewableFunction (f, typrms) -> - let typrms = - if List.isEmpty typrms then "" - else - let args = - typrms |> List.map (fun x -> sprintf "'%s" x.name) - sprintf "<%s>" (args |> String.concat ", ") - sprintf "new %s%s" typrms (pp (Function f)) | UnknownType None -> "?" | UnknownType (Some msg) -> sprintf "?(%s)" msg diff --git a/lib/TypeScriptHelper.fs b/lib/TypeScriptHelper.fs new file mode 100644 index 00000000..87fd4895 --- /dev/null +++ b/lib/TypeScriptHelper.fs @@ -0,0 +1,54 @@ +module Ts2Ml.TypeScriptHelper + +open TypeScript +open Fable.Core.JsInterop + +let defaultCompilerOptions = + jsOptions(fun o -> + o.target <- Some Ts.ScriptTarget.Latest + o.noEmit <- Some true + o.moduleResolution <- Some Ts.ModuleResolutionKind.Node12 + ) + +type IDummyCompilerHost = + abstract getSourceFile: fileName: string * languageVersion: Ts.ScriptTarget * ?onError: (string -> unit) * ?shouldCreateNewSourceFile: bool -> Ts.SourceFile option + abstract getSourceFileByPath: fileName: string * path: Ts.Path * languageVersion: Ts.ScriptTarget * ?onError: (string -> unit) * ?shouldCreateNewSourceFile: bool -> Ts.SourceFile option + abstract getDefaultLibFileName: options: Ts.CompilerOptions -> string + abstract useCaseSensitiveFileNames: unit -> bool + abstract getCanonicalFileName: fileName: string -> string + abstract getCurrentDirectory: unit -> string + abstract getNewLine: unit -> string + abstract fileExists: fileName: string -> bool + abstract readFile: fileName: string -> string option + abstract directoryExists: directoryName: string -> bool + abstract getDirectories: path: string -> ResizeArray + +let createDummyCompilerHost (fileNames: string[]) (sourceFiles: Ts.SourceFile[]) : Ts.CompilerHost = + let host = + { new IDummyCompilerHost with + member _.getSourceFile(fileName, _, ?__, ?___) = + sourceFiles |> Array.tryFind (fun sf -> sf.fileName = fileName) + member _.getSourceFileByPath(fileName, _, _, ?__, ?___) = + sourceFiles |> Array.tryFind (fun sf -> sf.fileName = fileName) + member _.getDefaultLibFileName(_) = "lib.d.ts" + member _.useCaseSensitiveFileNames() = false + member _.getCanonicalFileName(s) = s + member _.getCurrentDirectory() = "" + member _.getNewLine() = "\r\n" + member _.fileExists(fileName) = Array.contains fileName fileNames + member _.readFile(fileName) = sourceFiles |> Array.tryPick (fun sf -> if sf.fileName = fileName then Some (sf.getFullText()) else None) + member _.directoryExists(_) = true + member _.getDirectories(_) = ResizeArray [] + } + !!host + +let createProgramForNode (fileNames: string[]) (options: Ts.CompilerOptions) = + ts.createProgram(ResizeArray fileNames, options, ts.createCompilerHost(options, true)) + +let createProgramForBrowser (sourceFiles: Ts.SourceFile[]) (options: Ts.CompilerOptions) = + let fileNames = sourceFiles |> Array.map (fun s -> s.fileName) + ts.createProgram( + ResizeArray (sourceFiles |> Array.map (fun s -> s.fileName)), + options, + createDummyCompilerHost fileNames sourceFiles + ) diff --git a/lib/Typer.fs b/lib/Typer.fs new file mode 100644 index 00000000..0d931096 --- /dev/null +++ b/lib/Typer.fs @@ -0,0 +1,1827 @@ +module Ts2Ml.Typer + +open Ts2Ml.Common +open Ts2Ml.Syntax +open DataTypes + +type TyperOptions = + inherit IOptions + + /// Make class inherit `Iterable` when it has `[Symbol.iterator]: Iterator`. + abstract inheritIterable: bool with get,set + + /// Make class inherit `ArrayLike` when it has `[index: number]: T`. + abstract inheritArraylike: bool with get,set + + /// Make class inherit `PromiseLike` when it has `then(onfulfilled: T => _, onrejected: _)`. + abstract inheritPromiselike: bool with get,set + + /// Replaces alias to function type with named interface. + /// ```ts + /// type F = (...) => T // before + /// interface F { (...): T } // after + /// ``` + abstract replaceAliasToFunction: bool with get,set + + /// **Strongly recommended unless the target language supports rank-N polymorphism.** + /// + /// Replaces rank-2 or higher function type with anonymous interface. + /// ```ts + /// declare var f: (...) => T; // before + /// declare var f: { (...): T }; // after + /// ``` + abstract replaceRankNFunction: bool with get,set + + /// Replaces newable function type with anonymous interface. + /// ```ts + /// declare var F: new (...) => T; // before + /// declare var F: { new (): T }; // after + /// ``` + abstract replaceNewableFunction: bool with get,set + +type [] Definition = + | TypeAlias of TypeAlias + | Class of Class + | Enum of Enum + | EnumCase of EnumCase * Enum + | Module of Module + | Variable of Variable + | Function of Function + | Import of ImportClause * Import + | Member of MemberAttribute * Member * Class + +type [] InheritingType = + | KnownIdent of {| fullName: FullName; tyargs: Type list |} + | Prim of PrimType * tyargs:Type list + | Other of Type + | UnknownIdent of {| name: string list; tyargs: Type list |} + +type AnonymousInterfaceInfo = { + /// A unique number assigned to the anonymous interface + id: int + /// The namespace in which the anonymous interface appears + path: string list +} + +type SourceFileInfo = { + sourceFile: SourceFile + definitionsMap: Trie + typeLiteralsMap: Map + anonymousInterfacesMap: Map, AnonymousInterfaceInfo> + unknownIdentTypes: Trie> +} + +type TyperCache = { + inheritCache: MutableMap + hasNoInherits: MutableSet +} + +type TyperContext<'Options, 'State when 'Options :> IOptions> = private { + _currentSourceFile: Path.Absolute + _currentNamespace: string list + _info: Map + _state: 'State + _cache: TyperCache + _options: 'Options + _logger: ILogger +} with + member this.currentSourceFile = this._currentSourceFile + member this.currentNamespace = List.rev this._currentNamespace + member this.info = this._info + member this.state = this._state + member this.options = this._options + member this.logger = this._logger + interface IContext<'Options> with + member this.options = this.options + member this.logger = this.logger + +let inline private warn (ctx: IContext<_>) (loc: Location) fmt = + Printf.kprintf (fun s -> ctx.logger.warnf "%s at %s" s loc.AsString) fmt + +module TyperContext = + type private Anonoymous<'Options, 'State when 'Options :> IOptions> = {| + _currentSourceFile: Path.Absolute + _currentNamespace: string list + _info: Map + _state: 'State + _cache: TyperCache + _options: 'Options + _logger: ILogger + |} + + let inline private ofAnonymous (x: Anonoymous<'a, 's>) : TyperContext<'a, 's> = + { _currentSourceFile = x._currentSourceFile; _currentNamespace = x._currentNamespace + _info = x._info + _state = x._state + _cache = x._cache + _options = x._options; _logger = x._logger } + + let mapOptions (f: 'a -> 'b) (ctx: TyperContext<'a, 's>) : TyperContext<'b, 's> = + ofAnonymous {| ctx with _options = f ctx._options |} + + let mapState (f: 's -> 't) (ctx: TyperContext<'a, 's>) : TyperContext<'a, 't> = + ofAnonymous {| ctx with _state = f ctx._state |} + + let ofSourceFileRoot source (ctx: TyperContext<'a, 's>) : TyperContext<'a, 's> = + { ctx with _currentSourceFile = source; _currentNamespace = [] } + + let ofRoot (ctx: TyperContext<'a, 's>) : TyperContext<'a, 's> = + { ctx with _currentNamespace = [] } + + let ofLocation (fullName: FullName) (ctx: TyperContext<'a, 's>) : TyperContext<'a, 's> = + { ctx with _currentSourceFile = fullName.source; _currentNamespace = List.rev fullName.name } + + let ofParentNamespace (ctx: TyperContext<'a, 's>) : TyperContext<'a, 's> option = + match ctx._currentNamespace with + | [] -> None + | _ :: ns -> Some { ctx with _currentNamespace = ns } + + let ofChildNamespace childName (ctx: TyperContext<'a, 's>) : TyperContext<'a, 's> = + { ctx with _currentNamespace = childName :: ctx._currentNamespace } + + let getFullName (name: string list) (ctx: TyperContext<'a, 's>) : FullName = + let name = + match name with + | [] -> List.rev ctx._currentNamespace + | n :: [] -> List.rev (n :: ctx._currentNamespace) + | _ -> List.rev ctx._currentNamespace @ name + { name = name; source = ctx._currentSourceFile } + + let getFullNameString (name: string list) (ctx: TyperContext<'a, 's>) = + (getFullName name ctx).name |> String.concat "." + + /// `Error subName` when `fullName` is a parent of current namespace. + /// `Ok name` otherwise. + let getRelativeNameTo (fullName: string list) (ctx: TyperContext<'a, 's>) = + let rec go name selfPos = + match name, selfPos with + | x :: [], y :: ys when x = y -> Error ys + | x :: xs, y :: ys when x = y -> go xs ys + | xs, _ -> Ok xs + go fullName (List.rev ctx._currentNamespace) + + let tryCurrentSourceInfo (f: SourceFileInfo -> 't) (ctx: TyperContext<'a, 's>) = + ctx._info |> Map.tryFind ctx._currentSourceFile |> Option.map f + + let bindCurrentSourceInfo (f: SourceFileInfo -> _ option) (ctx: TyperContext<'a, 's>) = + if ctx._info |> Map.containsKey ctx._currentSourceFile |> not then + ctx.logger.errorf "%s not in [%s]" ctx._currentSourceFile (ctx._info |> Map.toSeq |> Seq.map fst |> String.concat ", ") + ctx._info |> Map.tryFind ctx._currentSourceFile |> Option.bind f + +module FullName = + let getDefinitions (ctx: TyperContext<_, _>) (fullName: FullName) : Definition list = + match ctx.info |> Map.tryFind fullName.source with + | None -> [] + | Some info -> + info.definitionsMap + |> Trie.tryFind fullName.name + |> Option.defaultValue [] + + let private classify = function + | Definition.TypeAlias _ -> Kind.OfTypeAlias + | Definition.Class c -> if c.isInterface then Kind.OfInterface else Kind.OfClass + | Definition.Enum _ -> Kind.OfEnum + | Definition.EnumCase _ -> Kind.OfEnumCase + | Definition.Module m -> if m.isNamespace then Kind.OfNamespace else Kind.OfModule + | Definition.Variable _ | Definition.Function _ -> Kind.OfValue + | Definition.Import (c, _) -> c.kind |> Option.map Set.toList |> Option.defaultValue [] + | Definition.Member _ -> Kind.OfMember + + let hasKind (ctx: TyperContext<_, _>) (kind: Kind) (fullName: FullName) = + getDefinitions ctx fullName + |> List.exists (fun d -> classify d |> List.contains kind) + + let getKind (ctx: TyperContext<_, _>) (fullName: FullName) : Set = + getDefinitions ctx fullName + |> List.collect classify + |> Set.ofList + + let isDefinedInCurrentSource (ctx: TyperContext<_, _>) (fullName: FullName) : bool = + fullName.source = ctx.currentSourceFile + + let mapSource f (fullName: FullName) = { fullName with source = f fullName.source } + +module Ident = + let getDefinitions (ctx: TyperContext<_, _>) (ident: Ident) = + ident.fullName |> List.collect (FullName.getDefinitions ctx) + + let getDefinitionsWithFullName (ctx: TyperContext<_, _>) (ident: Ident) = + ident.fullName |> List.collect (fun fn -> + FullName.getDefinitions ctx fn |> List.map (fun d -> {| definition = d; fullName = fn |})) + + let pickDefinition ctx ident picker = + getDefinitions ctx ident |> List.tryPick picker + + let pickDefinitionWithFullName ctx ident (picker: FullName -> Definition -> _ option) = + getDefinitionsWithFullName ctx ident |> List.tryPick (fun x -> picker x.fullName x.definition) + + let hasKind (ctx: TyperContext<_, _>) (kind: Kind) (ident: Ident) = + match ident.kind with + | Some kinds -> kinds |> Set.contains kind + | None -> ident.fullName |> List.exists (FullName.hasKind ctx kind) + + let getKind (ctx: TyperContext<_, _>) (ident: Ident) = + match ident.kind with + | Some kind -> kind + | None -> ident.fullName |> List.map (FullName.getKind ctx) |> Set.unionMany + + let isType ctx ident = hasKind ctx Kind.Type ident + + let isDefinedInCurrentSource (ctx: TyperContext<_, _>) (ident: Ident) = + ident.fullName |> List.exists (FullName.isDefinedInCurrentSource ctx) + + let mapSource f (ident: Ident) = + { ident with fullName = ident.fullName |> List.map (FullName.mapSource f) } + +module Type = + let rec mapInTypeParam mapping (ctx: 'Context) (tp: TypeParam) = + { tp with + extends = Option.map (mapping ctx) tp.extends + defaultType = Option.map (mapping ctx) tp.defaultType } + + and private mapInArg mapping ctx (arg: Choice) = + match arg with + | Choice1Of2 a -> mapInFieldLike mapping ctx a |> Choice1Of2 + | Choice2Of2 t -> mapping ctx t |> Choice2Of2 + + and mapInFuncType mapping (ctx: 'Context) f = + { f with + returnType = mapping ctx f.returnType + args = List.map (mapInArg mapping ctx) f.args } + + and mapInClass mapping (ctx: 'Context) (c: Class<'a>) : Class<'a> = + let mapMember = function + | Field (f, m) -> Field (mapInFieldLike mapping ctx f, m) + | Callable (f, tps) -> Callable (mapInFuncType mapping ctx f, List.map (mapInTypeParam mapping ctx) tps) + | Indexer (f, m) -> Indexer (mapInFuncType mapping ctx f, m) + | Constructor (c, tps) -> Constructor ({ c with args = List.map (mapInArg mapping ctx) c.args }, List.map (mapInTypeParam mapping ctx) tps) + | Getter f -> Getter (mapInFieldLike mapping ctx f) + | Setter f -> Setter (mapInFieldLike mapping ctx f) + | Newable (f, tps) -> Newable (mapInFuncType mapping ctx f, List.map (mapInTypeParam mapping ctx) tps) + | Method (name, f, tps) -> Method (name, mapInFuncType mapping ctx f, List.map (mapInTypeParam mapping ctx) tps) + | SymbolIndexer (sn, ft, m) -> SymbolIndexer (sn, mapInFuncType mapping ctx ft, m) + | UnknownMember msgo -> UnknownMember msgo + { c with + implements = c.implements |> List.map (mapping ctx) + members = c.members |> List.map (fun (a, m) -> a, mapMember m) + typeParams = c.typeParams |> List.map (mapInTypeParam mapping ctx) } + + and mapInFieldLike mapping (ctx: 'Context) (fl: FieldLike) : FieldLike = + { fl with value = mapping ctx fl.value } + + let mapInTupleType mapping (ctx: 'Context) (ts: TupleType) = + { ts with types = ts.types |> List.map (fun t -> {| t with value = mapping ctx t.value|})} + + let mapInUnion mapping ctx (u: UnionType) : UnionType = + { types = u.types |> List.map (mapping ctx) } + + let mapInIntersection mapping ctx (i: IntersectionType) : IntersectionType = + { types = i.types |> List.map (mapping ctx) } + + let rec mapIdent f = function + | Intrinsic -> Intrinsic | PolymorphicThis -> PolymorphicThis + | Ident i -> Ident (f i) + | TypeVar v -> TypeVar v | Prim p -> Prim p | TypeLiteral l -> TypeLiteral l + | AnonymousInterface i -> AnonymousInterface (i |> mapInClass (fun () -> mapIdent f) ()) + | Union u -> Union (mapInUnion (fun () -> mapIdent f) () u) + | Intersection i -> Intersection (mapInIntersection (fun () -> mapIdent f) () i) + | Tuple t -> Tuple (mapInTupleType (fun () -> mapIdent f) () t) + | Func (ft, ts, loc) -> + Func ( + ft |> mapInFuncType (fun () -> mapIdent f) (), + ts |> List.map (mapInTypeParam (fun () -> mapIdent f) ()), + loc + ) + | NewableFunc (ft, ts, loc) -> + NewableFunc ( + ft |> mapInFuncType (fun () -> mapIdent f) (), + ts |> List.map (mapInTypeParam (fun () -> mapIdent f) ()), + loc + ) + | App (AIdent i, ts, loc) -> App (AIdent (f i), ts |> List.map (mapIdent f), loc) + | App (APrim p, ts, loc) -> App (APrim p, ts |> List.map (mapIdent f), loc) + | App (AAnonymousInterface i, ts, loc) -> + App ( + AAnonymousInterface (i |> mapInClass (fun () -> mapIdent f) ()), + ts |> List.map (mapIdent f), + loc + ) + | Erased (e, loc, origText) -> + let e = + match e with + | IndexedAccess (t1, t2) -> IndexedAccess (mapIdent f t1, mapIdent f t2) + | TypeQuery i -> TypeQuery (f i) + | Keyof t -> Keyof (mapIdent f t) + Erased (e, loc, origText) + | UnknownType msg -> UnknownType msg + + let rec substTypeVar (subst: Map) _ctx = function + | TypeVar v -> + match subst |> Map.tryFind v with + | Some t -> t + | None -> TypeVar v + | Union u -> Union (mapInUnion (substTypeVar subst) _ctx u) + | Intersection i -> Intersection (mapInIntersection (substTypeVar subst) _ctx i) + | Tuple ts -> Tuple (ts |> mapInTupleType (substTypeVar subst) _ctx) + | AnonymousInterface c -> AnonymousInterface (mapInClass (substTypeVar subst) _ctx c) + | Func (f, typrms, loc) -> + Func (substTypeVarInFunction subst _ctx f, List.map (substTypeVarInTypeParam subst _ctx) typrms, loc) + | NewableFunc (f, typrms, loc) -> + NewableFunc (substTypeVarInFunction subst _ctx f, List.map (substTypeVarInTypeParam subst _ctx) typrms, loc) + | App (t, ts, loc) -> + let t = + match t with + | AAnonymousInterface i -> AAnonymousInterface (mapInClass (substTypeVar subst) _ctx i) + | _ -> t + App (t, ts |> List.map (substTypeVar subst _ctx), loc) + | Ident i -> Ident i | Prim p -> Prim p | TypeLiteral l -> TypeLiteral l + | PolymorphicThis -> PolymorphicThis | Intrinsic -> Intrinsic + | Erased (e, loc, origText) -> + let e' = + match e with + | IndexedAccess (t1, t2) -> IndexedAccess (substTypeVar subst _ctx t1, substTypeVar subst _ctx t2) + | TypeQuery i -> TypeQuery i + | Keyof t -> Keyof (substTypeVar subst _ctx t) + Erased (e', loc, origText) + | UnknownType msgo -> UnknownType msgo + + and substTypeVarInTypeParam subst _ctx (tp: TypeParam) = + { tp with + extends = Option.map (substTypeVar subst _ctx) tp.extends + defaultType = Option.map (substTypeVar subst _ctx) tp.defaultType } + + and substTypeVarInFunction subst _ctx f = + { f with + returnType = substTypeVar subst _ctx f.returnType; + args = List.map (mapInArg (substTypeVar subst) _ctx) f.args } + + let rec findTypesInFieldLike pred (fl: FieldLike) = findTypes pred fl.value + and findTypesInTypeParam pred (tp: TypeParam) = + seq { + yield! tp.extends |> Option.map (findTypes pred) |> Option.defaultValue Seq.empty + yield! tp.defaultType |> Option.map (findTypes pred) |> Option.defaultValue Seq.empty + } + and findTypesInFuncType pred (ft: FuncType) = + seq { + for arg in ft.args do + match arg with + | Choice1Of2 fl -> yield! findTypesInFieldLike pred fl + | Choice2Of2 t -> yield! findTypes pred t + yield! findTypes pred ft.returnType + } + and findTypesInClassMember pred (m: Member) : 'a seq = + match m with + | Field (fl, _) -> findTypesInFieldLike pred fl + | Method (_, ft, tps) + | Callable (ft, tps) + | Newable (ft, tps) -> + seq { yield! findTypesInFuncType pred ft; for tp in tps do yield! findTypesInTypeParam pred tp } + | Indexer (ft, _) | SymbolIndexer (_, ft, _) -> + seq { yield! findTypesInFuncType pred ft } + | Getter fl | Setter fl -> seq { yield! findTypesInFieldLike pred fl } + | Constructor (ft, tps) -> + seq { + for arg in ft.args do + match arg with + | Choice1Of2 fl -> yield! findTypesInFieldLike pred fl + | Choice2Of2 t -> yield! findTypes pred t + for tp in tps do yield! findTypesInTypeParam pred tp + } + | UnknownMember _ -> Seq.empty + and findTypes (pred: Type -> Choice * 'a option) (t: Type) : 'a seq = + let rec go_t x = + seq { + let cont, y = pred x + match y with Some v -> yield v | None -> () + match cont with + | Choice1Of2 false -> () + | Choice2Of2 ts -> for t in ts do yield! go_t t + | Choice1Of2 true -> + match x with + | App (t, ts, _) -> + yield! go_t (Type.ofAppLeftHandSide t) + for t in ts do yield! go_t t + | Union { types = ts } | Intersection { types = ts } -> + for t in ts do yield! go_t t + | Tuple { types = ts } -> + for t in ts do yield! go_t t.value + | Func (f, tps, _) | NewableFunc (f, tps, _) -> + yield! findTypesInFuncType pred f + for tp in tps do + yield! findTypesInTypeParam pred tp + | Erased (e, _, _) -> + match e with + | IndexedAccess (t1, t2) -> + yield! go_t t1 + yield! go_t t2 + | TypeQuery i -> + yield! findTypes pred (Ident i) + | Keyof t -> + yield! findTypes pred t + | AnonymousInterface c -> + for impl in c.implements do yield! findTypes pred impl + for tp in c.typeParams do yield! findTypesInTypeParam pred tp + for _, m in c.members do yield! findTypesInClassMember pred m + | Intrinsic | PolymorphicThis | Ident _ | TypeVar _ | Prim _ | TypeLiteral _ | UnknownType _ -> () + } + go_t t + + let getTypeVars ty = + findTypes (function + | TypeVar s -> Choice1Of2 false, Some s + | _ -> Choice1Of2 true, None + ) ty + + let rec getFreeTypeVarsPredicate t = + match t with + | TypeVar s -> Choice1Of2 true, Some (Set.singleton s) + | Func (ft, tps, _) | NewableFunc (ft, tps, _) -> + let fvs = Set.difference (findTypesInFuncType getFreeTypeVarsPredicate ft |> Set.unionMany) (tps |> List.map (fun tp -> tp.name) |> Set.ofList) + Choice1Of2 false, Some fvs + | AnonymousInterface a -> + let memberFvs = + a.members |> List.map (fun (_, m) -> + match m with + | Field (fl, _) -> findTypesInFieldLike getFreeTypeVarsPredicate fl |> Set.unionMany + | Method (_, ft, tps) | Callable (ft, tps) | Newable (ft, tps) -> + Set.difference (findTypesInFuncType getFreeTypeVarsPredicate ft |> Set.unionMany) (tps |> List.map (fun tp -> tp.name) |> Set.ofList) + | Constructor (ft, tps) -> + let ft = ft |> FuncType.map (fun _ -> PolymorphicThis) + Set.difference (findTypesInFuncType getFreeTypeVarsPredicate ft |> Set.unionMany) (tps |> List.map (fun tp -> tp.name) |> Set.ofList) + | Indexer (ft, _) | SymbolIndexer (_, ft, _) -> findTypesInFuncType getFreeTypeVarsPredicate ft |> Set.unionMany + | Getter fl | Setter fl -> findTypesInFieldLike getFreeTypeVarsPredicate fl |> Set.unionMany + | UnknownMember _ -> Set.empty + ) |> Set.unionMany + let fvs = Set.difference memberFvs (a.typeParams |> List.map (fun tp -> tp.name) |> Set.ofList) + Choice1Of2 false, Some fvs + | _ -> Choice1Of2 true, None + + let getFreeTypeVars ty = findTypes getFreeTypeVarsPredicate ty |> Set.unionMany + + let rec assignTypeParams (name: string list) (loc: Location) (typrms: TypeParam list) (xs: 'a list) (f: TypeParam -> 'a -> 'b) (g: TypeParam -> 'b) : 'b list = + match typrms, xs with + | typrm :: typrms, x :: xs -> + f typrm x :: assignTypeParams name loc typrms xs f g + | typrm :: typrms, [] -> + g typrm :: assignTypeParams name loc typrms [] f g + | [], [] -> [] + | [], _ :: _ -> + failwithf "assignTypeParams: too many type arguments for type '%s' at %s" (String.concat "." name) (loc.AsString) + + let createBindings name loc typrms ts = + assignTypeParams name loc typrms ts + (fun tv ty -> tv.name, ty) + (fun tv -> + match tv.defaultType with + | Some ty -> tv.name, ty + | None -> + failwithf "createBindings: insufficient type arguments for type '%s' at %s" (String.concat "." name) (loc.AsString)) + |> Map.ofList + + let getPossibleArity (typrms: TypeParam list) : Set = + let maxArity = List.length typrms + let rec go i = function + | { defaultType = Some _ } :: rest -> (i-1) :: go (i-1) rest + | { defaultType = None } :: rest -> go i rest + | [] -> [] + maxArity :: go maxArity typrms |> Set.ofList + + let createFunctionInterface (funcs: {| ty: FuncType; typrms: TypeParam list; comments: Comment list; loc: Location; isNewable: bool |} list) = + let usedTyprms = + funcs |> Seq.collect (fun f -> getTypeVars (Func (f.ty, f.typrms, f.loc))) |> Set.ofSeq + let boundTyprms = + let typrms = funcs |> List.collect (fun f -> f.typrms) |> List.map (fun x -> x.name) |> Set.ofList + Set.difference usedTyprms typrms + |> Set.toList + |> List.map (fun name -> { name = name; extends = None; defaultType = None }) + let ai = + { + comments = [] + name = Anonymous + accessibility = Public + isInterface = true + isExported = Exported.No + implements = [] + typeParams = boundTyprms + members = [ + for f in funcs do + { comments = f.comments; loc = f.loc; isStatic = false; accessibility = Public }, + if f.isNewable then Newable (f.ty, f.typrms) + else Callable (f.ty, f.typrms) + ] + loc = MultipleLocation (funcs |> List.map (fun f -> f.loc)) + } + if List.isEmpty boundTyprms then AnonymousInterface ai + else + App ( + AAnonymousInterface ai, + boundTyprms |> List.map (fun x -> TypeVar x.name), + MultipleLocation (funcs |> List.map (fun f -> f.loc)) + ) + + // TODO: more optimization + let createUnion (_ctx: TyperContext<_, _>) (types: Type list) = + match types with + | [] -> Prim Never + | [x] -> x + | _ -> Union { types = types } + + // TODO: more optimization + let createIntersection (_ctx: TyperContext<_, _>) (types: Type list) = + match types with + | [] -> Prim Any + | [x] -> x + | _ -> Intersection { types = types } + + let substTypeVarInInheritingType subst ctx = function + | InheritingType.KnownIdent x -> + InheritingType.KnownIdent {| x with tyargs = x.tyargs |> List.map (substTypeVar subst ctx) |} + | InheritingType.UnknownIdent x -> + InheritingType.UnknownIdent {| x with tyargs = x.tyargs |> List.map (substTypeVar subst ctx) |} + | InheritingType.Prim (p, ts) -> + InheritingType.Prim (p, ts |> List.map (substTypeVar subst ctx)) + | InheritingType.Other t -> + InheritingType.Other (substTypeVar subst ctx t) + + let inline private (|Dummy|) _ = [] + + let rec private getAllInheritancesImpl (depth: int) (includeSelf: bool) (ctx: TyperContext<'a, 's>) (ty: Type) : (InheritingType * int) seq = + let treatPrimTypeInterfaces (name: string list) (ts: Type list) = + match name with + | [name] -> + match PrimType.FromJSClassName name with + | None -> None + | Some p -> + Some (InheritingType.Prim (p, ts), depth) + | _ -> None + + seq { + match ty with + | Ident ({ name = name; loc = loc } & i) & Dummy ts + | App (AIdent ({ name = name } & i), ts, loc) when i.fullName <> [] -> + yield! treatPrimTypeInterfaces name ts |> Option.toList + yield! + Ident.getDefinitionsWithFullName ctx i + |> List.choose (fun x -> + match x.definition with + | Definition.TypeAlias { typeParams = typrms } | Definition.Class { typeParams = typrms } -> + let subst = createBindings i.name i.loc typrms ts + getAllInheritancesFromNameImpl (depth+1) includeSelf ctx x.fullName + |> Seq.map (fun (t, d) -> substTypeVarInInheritingType subst ctx t, d) |> Some + | _ -> None + ) |> Seq.concat + | Ident { name = name } & Dummy ts | App (AIdent { name = name }, ts, _) -> + yield! treatPrimTypeInterfaces name ts |> Option.toList + if includeSelf then + yield InheritingType.UnknownIdent {| name = name; tyargs = ts |}, depth + | Prim p & Dummy ts + | App (APrim p, ts, _) -> + if includeSelf then + yield InheritingType.Prim (p, ts), depth + | _ -> + if includeSelf then + yield InheritingType.Other ty, depth + } + + and private getAllInheritancesFromNameImpl (depth: int) (includeSelf: bool) (ctx: TyperContext<'a, 's>) (fn: FullName) : (InheritingType * int) list = + if ctx._cache.hasNoInherits.Contains fn then List.empty + else + match ctx._cache.inheritCache.TryGetValue fn with + | true, (s, self) -> + let ret = + if includeSelf then + (List.map (fun x -> x, 0) self) @ s + else s + ret |> List.map (fun (t, d) -> t, d + depth) + | _ -> + let result, self = + FullName.getDefinitions ctx fn + |> List.choose (function + | Definition.Class c -> + let self = + InheritingType.KnownIdent {| fullName = fn; tyargs = c.typeParams |> List.map (fun tp -> TypeVar tp.name) |} + let s = c.implements |> Seq.collect (getAllInheritancesImpl (depth+1) true ctx) + Some (s, Some self) + | Definition.TypeAlias a -> + let tyargs = + a.typeParams |> List.map (fun tp -> TypeVar tp.name) + let s = + let subst = createBindings fn.name a.loc a.typeParams tyargs + getAllInheritancesImpl (depth+1) true ctx a.target + |> Seq.map (fun (t, d) -> substTypeVarInInheritingType subst ctx t, d) + Some (s, None) + | _ -> None) + |> List.unzip + |> fun (result, self) -> + Seq.concat result |> List.ofSeq, List.choose id self + if List.isEmpty result && List.isEmpty self then + ctx._cache.hasNoInherits.Add(fn) |> ignore + List.empty + else + ctx._cache.inheritCache[fn] <- (result |> List.map (fun (t, d) -> t, d - depth), self) + if includeSelf then + (List.map (fun x -> x, depth) self) @ result + else result + + and private removeDuplicatesFromInheritingTypes (xs: (InheritingType * int) seq) : Set = + xs + |> Seq.groupBy (fun (t, _) -> + match t with + | InheritingType.KnownIdent i -> Choice1Of4 i.fullName + | InheritingType.UnknownIdent i -> Choice2Of4 i.name + | InheritingType.Prim (p, _) -> Choice3Of4 p + | InheritingType.Other ty -> Choice4Of4 ty) + |> Seq.map (fun (_, xs) -> + xs |> Seq.sortBy (fun (_, depth) -> depth) |> Seq.head |> fst) + |> Set.ofSeq + + let getAllInheritances ctx ty = getAllInheritancesImpl 0 false ctx ty |> removeDuplicatesFromInheritingTypes + let getAllInheritancesFromName ctx fn = getAllInheritancesFromNameImpl 0 false ctx fn |> removeDuplicatesFromInheritingTypes + let getAllInheritancesAndSelf ctx ty = getAllInheritancesImpl 0 true ctx ty |> removeDuplicatesFromInheritingTypes + let getAllInheritancesAndSelfFromName ctx fn = getAllInheritancesFromNameImpl 0 true ctx fn |> removeDuplicatesFromInheritingTypes + + let rec resolveErasedTypeImpl typeQueries ctx = function + | PolymorphicThis -> PolymorphicThis | Intrinsic -> Intrinsic + | Ident i -> Ident i | TypeVar v -> TypeVar v | Prim p -> Prim p | TypeLiteral l -> TypeLiteral l + | AnonymousInterface c -> mapInClass (resolveErasedTypeImpl typeQueries) ctx c |> AnonymousInterface + | Union { types = types } -> Union { types = List.map (resolveErasedTypeImpl typeQueries ctx) types } + | Intersection { types = types } -> Intersection { types = List.map (resolveErasedTypeImpl typeQueries ctx) types } + | Tuple ts -> Tuple (mapInTupleType (resolveErasedTypeImpl typeQueries) ctx ts) + | Func (f, tyargs, loc) -> + Func ( + mapInFuncType (resolveErasedTypeImpl typeQueries) ctx f, + tyargs |> List.map (mapInTypeParam (resolveErasedTypeImpl typeQueries) ctx), + loc + ) + | NewableFunc (f, tyargs, loc) -> + NewableFunc ( + mapInFuncType (resolveErasedTypeImpl typeQueries) ctx f, + tyargs |> List.map (mapInTypeParam (resolveErasedTypeImpl typeQueries) ctx), + loc + ) + | App (t, ts, loc) -> + let t = + match t with + | AAnonymousInterface i -> AAnonymousInterface (mapInClass (resolveErasedTypeImpl typeQueries) ctx i) + | _ -> t + App (t, List.map (resolveErasedTypeImpl typeQueries ctx) ts, loc) + | Erased (e, loc, origText) -> + let comments = [Description [origText]] + match e with + | IndexedAccess (tobj, tindex) -> + let resolveIndexedAccessOfClass (c: Class<_>) (indexTy: Type) : Type option = + let members = c.members |> List.map snd + let intersection = function + | [] -> None + | ts -> createIntersection ctx ts |> Some + let rec go = function + | TypeLiteral (LString name) -> + let funcs, others = + members + |> List.choose (function + | Field (fl, _) | Getter fl | Setter fl when fl.name = name -> + if fl.isOptional then Some (Choice2Of2 (Union { types = [fl.value; Prim Undefined] })) + else Some (Choice2Of2 fl.value) + | Method (name', ft, typrms) when name = name' -> + Some (Choice1Of2 {| ty = ft; typrms = typrms; comments = comments; loc = loc; isNewable = false |}) + | Constructor (_, _) when name = "constructor" -> Some (Choice2Of2 (Prim UntypedFunction)) + | _ -> None) + |> List.splitChoice2 + let funcs = + match funcs with + | [] -> [] + | [f] -> [Func (f.ty, f.typrms, f.loc)] + | _ -> [createFunctionInterface funcs] + funcs @ others |> intersection + | TypeLiteral (LInt _) | Prim Number -> + members + |> List.choose (function Indexer (ft, _) -> Some ft.returnType | _ -> None) + |> intersection + | Prim Never -> Some (Prim Never) + | Union { types = ts } -> + match List.choose go ts with + | [] -> None + | [t] -> Some t + | ts -> Some (Union { types = ts }) + | _ -> None + go indexTy + + let rec memberChooser m t2 = + match m, t2 with + | (Field (fl, _) | Getter fl | Setter fl), + TypeLiteral (LString name) when fl.name = name -> + if fl.isOptional then Some (Union { types = [fl.value; Prim Undefined] }) + else Some fl.value + | Constructor (_, _), TypeLiteral (LString name) when name = "constructor" -> + Some (Prim UntypedFunction) + | Indexer (ft, _), (Prim Number | TypeLiteral (LInt _)) -> Some ft.returnType + | Method (name', ft, typrms), TypeLiteral (LString name) when name = name' -> + Some (createFunctionInterface [{| ty = ft; typrms = typrms; comments = comments; loc = loc; isNewable = false |}]) + | _, Union { types = ts } -> + match ts |> List.choose (memberChooser m) with + | [] -> None + | [t] -> Some t + | ts -> Some (Union { types = ts }) + | _, _ -> None + + let rec goOrFail t1 t2 : Type = + match go t1 t2 with + | Some t -> t + | None -> + let part = sprintf "%s[%s]" (Type.pp t1) (Type.pp t2) + warn ctx loc "cannot resolve a part '%s' of an indexed access type '%s'" part origText + UnknownType (Some part) + + and go t1 t2 : Type option = + match t1, t2 with + | Union { types = ts }, _ -> Union { types = List.map (fun t1 -> goOrFail t1 t2) ts } |> Some + | Intersection { types = ts }, _ -> Intersection { types = List.map (fun t1 -> goOrFail t1 t2) ts } |> Some + | AnonymousInterface c, _ -> + resolveIndexedAccessOfClass c t2 + | App ((APrim Array | APrim ReadonlyArray), [t], _), Prim (Number | Any) -> Some t + | Tuple ts, TypeLiteral (LInt i) -> + match ts.types |> List.tryItem i with + | Some t -> Some t.value + | None -> None + | Tuple ts, Prim (Number | Any) -> Union { types = ts.types |> List.map (fun x -> x.value) } |> Some + | (App (AIdent i, ts, loc) | (Ident ({ loc = loc } & i) & Dummy ts)), _ -> + Ident.pickDefinition ctx i (function + | Definition.TypeAlias ta -> + let subst = createBindings i.name loc ta.typeParams ts + let target = + ta.target |> substTypeVar subst ctx |> resolveErasedTypeImpl typeQueries ctx + go target t2 + | Definition.Class c -> + let subst = createBindings i.name loc c.typeParams ts + let c = c |> mapInClass (fun ctx -> substTypeVar subst ctx >> resolveErasedTypeImpl typeQueries ctx) ctx + resolveIndexedAccessOfClass c t2 + | _ -> None + ) + | _, _ -> None + match go (resolveErasedTypeImpl typeQueries ctx tobj) (resolveErasedTypeImpl typeQueries ctx tindex) with + | Some t -> t + | None -> + warn ctx loc "cannot resolve an indexed access type '%s'" origText + UnknownType (Some origText) + + | TypeQuery i -> + let onFail () = + warn ctx loc "cannot resolve a type query '%s'" origText + UnknownType (Some origText) + match i.fullName with + | [] -> onFail () + | fn when Set.isSubset (Set.ofList fn) typeQueries -> + warn ctx loc "a recursive type query '%s' is detected and is ignored" origText + UnknownType (Some origText) + | fn -> + let result ty = + let typeQueries = Set.union (Set.ofList fn) typeQueries + resolveErasedTypeImpl typeQueries ctx ty + let types = + Ident.getDefinitions ctx i + |> List.choose (function + | Definition.Variable v -> result v.typ |> Some + | Definition.Function f -> result (Func (f.typ, f.typeParams, f.loc)) |> Some + | Definition.Member (ma, m, _) -> + match m with + | Field (fl, _) | Getter fl | Setter fl -> + match fl.isOptional, result fl.value with + | true, UnknownType msgo -> UnknownType msgo |> Some + | true, t -> Union { types = [t; Prim Undefined] } |> Some + | false, t -> Some t + | Method (_, ft, typrms) -> result (Func (ft, typrms, ma.loc)) |> Some + | _ -> None + | _ -> None) + match types with + | [] -> onFail () + | _ -> createIntersection ctx types + + | Keyof t -> + let t = resolveErasedTypeImpl typeQueries ctx t + let onFail () = + let tyText = Type.pp t + warn ctx loc "cannot resolve a type operator 'keyof %s'" tyText + UnknownType (Some tyText) + let memberChooser = function + | Field (fl, _) | Getter fl | Setter fl -> Set.singleton (TypeLiteral (LString fl.name)) + | Method (name, _, _) -> Set.singleton (TypeLiteral (LString name)) + | _ -> Set.empty + let rec go t = + match t with + | Union { types = ts } -> ts |> List.map go |> Set.intersectMany + | Intersection { types = ts } -> ts |> List.map go |> Set.unionMany + | AnonymousInterface i -> + i.members |> List.map (snd >> memberChooser) |> Set.unionMany + | App ((APrim Array | APrim ReadonlyArray), [_], _) | Tuple _ -> Set.singleton (Prim Number) + | (App (AIdent i, ts, loc) | (Ident ({ loc = loc } & i) & Dummy ts)) -> + Ident.getDefinitions ctx i + |> List.choose (function + | Definition.TypeAlias ta -> + let subst = createBindings i.name loc ta.typeParams ts + ta.target |> substTypeVar subst ctx |> resolveErasedTypeImpl typeQueries ctx |> go |> Some + | Definition.Class c -> + let subst = createBindings i.name loc c.typeParams ts + let c = c |> mapInClass (fun ctx -> substTypeVar subst ctx >> resolveErasedTypeImpl typeQueries ctx) ctx + c.members |> List.map (snd >> memberChooser) |> Set.unionMany |> Some + | _ -> None + ) |> Set.unionMany + | _ -> Set.empty + match Set.toList (go t) with + | [] -> onFail () + | [t] -> t + | types -> Union { types = types } + | UnknownType msgo -> UnknownType msgo + + let resolveErasedType ctx ty = resolveErasedTypeImpl Set.empty ctx ty + + /// intended to be used as an identifier. + /// * can be any case. + /// * can be a reserved name (e.g. `this`). + /// * can start with a digit. + let rec getHumanReadableName (ctx: TyperContext<_, _>) = function + | Intrinsic -> "intrinsic" + | PolymorphicThis -> "this" + | Ident i -> i.name |> List.last + | TypeVar v -> v + | Prim p -> + match p with + | String -> "string" | Bool -> "boolean" | Number -> "number" + | Any -> "any" | Void -> "void" | Unknown -> "unknown" + | Null -> "null" | Never -> "never" | Undefined -> "undefined" + | Symbol _ -> "symbol" | RegExp -> "RegExp" + | BigInt -> "BigInt" | Array -> "Array" + | ReadonlyArray -> "ReadonlyArray" + | Object -> "Object" | UntypedFunction -> "Function" + | TypeLiteral l -> + let formatString (s: string) = + (s :> char seq) + |> Seq.map (fun c -> + if Char.isAlphabetOrDigit c then c + else '_') + |> Seq.toArray |> System.String + let inline formatNumber (x: 'a) = + string x + |> String.replace "+" "" + |> String.replace "-" "minus" + |> String.replace "." "_" + match l with + | LString s -> formatString s + | LInt i -> formatNumber i + | LFloat f -> formatNumber f + | LBool true -> "true" | LBool false -> "false" + | AnonymousInterface c -> + match ctx |> TyperContext.bindCurrentSourceInfo (fun info -> info.anonymousInterfacesMap |> Map.tryFind c) with + | Some x -> sprintf "AnonymousInterface%d" x.id + | None -> "AnonymousInterface" + | Union _ -> "union" | Intersection _ -> "intersection" | Tuple _ -> "tuple" + | Func _ -> "function" + | NewableFunc _ -> "constructor" + | App (lhs, rhs, _) -> + match lhs with + | AIdent i -> getHumanReadableName ctx (Ident i) + | AAnonymousInterface c -> getHumanReadableName ctx (AnonymousInterface c) + | APrim Array -> + match rhs with + | [t] -> + let elemType = getHumanReadableName ctx t + Naming.toCase Naming.Case.PascalCase elemType + "Array" + | _ -> "Array" + | APrim p -> getHumanReadableName ctx (Prim p) + | Erased (et, _, _) -> + match et with + | Keyof t -> + let targetType = getHumanReadableName ctx t + "Keyof" + Naming.toCase Naming.Case.PascalCase targetType + | TypeQuery i -> + "Typeof" + Naming.toCase Naming.Case.PascalCase (List.last i.name) + | IndexedAccess (t1, t2) -> + let s1 = getHumanReadableName ctx t1 |> Naming.toCase Naming.Case.PascalCase + let s2 = getHumanReadableName ctx t2 |> Naming.toCase Naming.Case.PascalCase + s1 + s2 + | UnknownType _ -> "unknown" + +type [] KnownType = + | Ident of fullName:FullName + | AnonymousInterface of AnonymousInterface * AnonymousInterfaceInfo + +module Statement = + open Type + + let createDefinitionsMap (stmts: Statement list) : Trie = + let add ns name x trie = + trie |> Trie.addOrUpdate (List.rev (name :: ns)) [x] List.append + let rec go (ns: string list) trie s = + match s with + | Export _ + | UnknownStatement _ + | FloatingComment _ -> trie + | Import import -> + import.clauses + |> List.fold (fun trie c -> + match c with + | NamespaceImport i -> trie |> add ns i.name (Definition.Import (c, import)) + | ES6WildcardImport _ -> trie + | ES6Import i -> trie |> add ns i.name (Definition.Import (c, import)) + | ES6DefaultImport i -> trie |> add ns i.name (Definition.Import (c, import)) + | LocalImport i -> trie |> add ns i.name (Definition.Import (c, import)) + ) trie + | TypeAlias a -> trie |> add ns a.name (Definition.TypeAlias a) + | Class c -> + match c.name with + | Name name -> + c.members + |> List.fold (fun trie (ma, m) -> + let ns = name :: ns + let d = Definition.Member (ma, m, c) + match m with + | Field (fl, _) | Getter fl | Setter fl -> trie |> add ns fl.name d + | Method (n, _, _) -> trie |> add ns n d + | _ -> trie + ) trie + |> add ns name (Definition.Class c) + | ExportDefaultUnnamedClass -> trie + | Enum e -> + e.cases + |> List.fold (fun trie c -> trie |> add (e.name :: ns) c.name (Definition.EnumCase (c, e))) trie + |> add ns e.name (Definition.Enum e) + | Variable v -> trie |> add ns v.name (Definition.Variable v) + | Function f -> trie |> add ns f.name (Definition.Function f) + | Pattern p -> p.underlyingStatements |> List.fold (go ns) trie + | Module m -> + m.statements + |> List.fold (go (m.name :: ns)) trie + |> add ns m.name (Definition.Module m) + | Global m -> + m.statements |> List.fold (go []) trie + stmts |> List.fold (go []) Trie.empty + + let findTypesInStatements pred (stmts: Statement list) : 'a seq = + let rec go ns = function + | TypeAlias ta -> + seq { + yield! findTypes (pred (List.rev ns)) ta.target; + for tp in ta.typeParams do + yield! findTypesInTypeParam (pred (List.rev ns)) tp + } + | Class c -> + seq { + for impl in c.implements do + yield! findTypes (pred (List.rev ns)) impl + for tp in c.typeParams do + yield! findTypesInTypeParam (pred (List.rev ns)) tp + for _, m in c.members do + yield! findTypesInClassMember (pred (List.rev ns)) m + } + | Module m -> m.statements |> Seq.collect (go (m.name :: ns)) + | Global m -> m.statements |> Seq.collect (go []) + | Variable v -> findTypes (pred (List.rev ns)) v.typ + | Function f -> + seq { + yield! findTypesInFuncType (pred (List.rev ns)) f.typ + for tp in f.typeParams do + yield! findTypesInTypeParam (pred (List.rev ns)) tp + } + | Enum e -> + e.cases |> Seq.choose (fun c -> c.value) + |> Seq.collect (fun l -> findTypes (pred (List.rev ns)) (TypeLiteral l)) + | Import _ | Export _ | UnknownStatement _ | FloatingComment _ -> Seq.empty + | Pattern p -> + seq { + for stmt in p.underlyingStatements do + yield! go ns stmt + } + stmts |> Seq.collect (go []) + + let getTypeLiterals stmts = + findTypesInStatements (fun _ -> function TypeLiteral l -> Choice1Of2 true, Some l | _ -> Choice1Of2 true, None) stmts |> Set.ofSeq + + let getAnonymousInterfaces stmts = + findTypesInStatements (fun ns -> function + | AnonymousInterface c -> Choice1Of2 true, Some (c, ns) + | _ -> Choice1Of2 true, None + ) stmts |> Set.ofSeq + + let getUnknownIdentTypes ctx stmts = + let (|Dummy|) _ = [] + findTypesInStatements (fun _ -> function + | App (AIdent { name = name; fullName = [] }, ts, _) + | (Ident { name = name; fullName = [] } & Dummy ts) -> + Choice2Of2 ts, Some (name, Set.singleton (List.length ts)) + | App (AIdent i, ts, _) + | (Ident i & Dummy ts) when not (Ident.isType ctx i) -> + Choice2Of2 ts, Some (i.name, Set.singleton (List.length ts)) + | _ -> Choice1Of2 true, None + ) stmts |> Seq.fold (fun state (k, v) -> Trie.addOrUpdate k v Set.union state) Trie.empty + + let getKnownTypes (ctx: TyperContext<_, _>) stmts = + let (|Dummy|) _ = [] + findTypesInStatements (fun _ -> function + | Ident { fullName = fns } -> + Choice1Of2 true, Some (fns |> List.map KnownType.Ident) + | AnonymousInterface a -> + let info = + ctx |> TyperContext.bindCurrentSourceInfo (fun info -> info.anonymousInterfacesMap |> Map.tryFind a) + Choice1Of2 true, + match info with + | None -> None + | Some info -> Some [KnownType.AnonymousInterface (a, info)] + | _ -> + Choice1Of2 true, None + ) stmts |> Seq.concat |> Set.ofSeq + + let rec mapTypeWith overrideFunc mapping ctxOfChildNamespace ctxOfRoot ctx stmts = + let mapVariable (v: Variable) = { v with typ = mapping ctx v.typ } + let mapFunction f = + { f with + typ = mapInFuncType mapping ctx f.typ + typeParams = f.typeParams |> List.map (mapInTypeParam mapping ctx) } + let f = function + | TypeAlias a -> + TypeAlias { + a with + target = mapping ctx a.target + typeParams = a.typeParams |> List.map (mapInTypeParam mapping ctx) + } + | Class c -> + let ctx = + match c.name with + | Name name -> ctx |> ctxOfChildNamespace name + | ExportDefaultUnnamedClass -> ctx + Class (mapInClass mapping ctx c) + | Enum e -> Enum e + | Import i -> Import i + | Export e -> Export e + | Variable v -> Variable (mapVariable v) + | Function f -> Function (mapFunction f) + | Module m -> + Module { + m with + statements = + mapTypeWith + overrideFunc + mapping + ctxOfChildNamespace + ctxOfRoot + (ctx |> ctxOfChildNamespace m.name) + m.statements + } + | Global m -> + Global { + m with + statements = + mapTypeWith + overrideFunc + mapping + ctxOfChildNamespace + ctxOfRoot + (ctx |> ctxOfRoot) + m.statements + } + | UnknownStatement u -> UnknownStatement u + | FloatingComment c -> FloatingComment c + | Pattern (ImmediateInstance (i, v)) -> Pattern (ImmediateInstance (mapInClass mapping ctx i, mapVariable v)) + | Pattern (ImmediateConstructor (bi, ci, v)) -> + Pattern (ImmediateConstructor (mapInClass mapping ctx bi, mapInClass mapping ctx ci, mapVariable v)) + + stmts |> List.map (fun stmt -> + match overrideFunc ctx stmt with + | Some stmt -> stmt + | None -> f stmt + ) + + let rec mapType mapping ctxOfChildNamespace ctx stmts = + mapTypeWith (fun _ _ -> None) mapping ctxOfChildNamespace ctx stmts + + let resolveErasedTypes (ctx: TyperContext<#TyperOptions, _>) (stmts: Statement list) = + mapType resolveErasedType TyperContext.ofChildNamespace TyperContext.ofRoot ctx stmts + + let mapIdent f stmts = + let orf _ = function + | Export e -> + let g = function + | CommonJsExport i -> CommonJsExport (f i) + | ES6DefaultExport i -> ES6DefaultExport (f i) + | ES6Export e -> ES6Export {| e with target = f e.target |} + | NamespaceExport ns -> NamespaceExport ns + Export { e with clauses = e.clauses |> List.map g } |> Some + | Import i -> + let g = function + | LocalImport l -> LocalImport {| l with target = f l.target |} + | x -> x + Import { i with clauses = i.clauses |> List.map g } |> Some + | _ -> None + mapTypeWith orf (fun () -> mapIdent f) (fun _ -> id) id () stmts + +type [] Typeofable = Number | String | Boolean | Symbol | BigInt +module TypeofableType = + let toType = function + | Typeofable.Number -> Prim Number + | Typeofable.String -> Prim String + | Typeofable.Boolean -> Prim Bool + | Typeofable.Symbol -> Prim (Symbol false) + | Typeofable.BigInt -> Prim BigInt + +type ResolvedUnion = { + caseNull: bool + caseUndefined: bool + typeofableTypes: Set + caseArray: Set option + caseEnum: Set> + discriminatedUnions: Map> + otherTypes: Set +} + +module ResolvedUnion = + let rec pp (ru: ResolvedUnion) = + let cases = [ + if ru.caseNull then yield "null" + if ru.caseUndefined then yield "undefined" + for x in ru.typeofableTypes do + yield + match x with + | Typeofable.Number -> "number" | Typeofable.String -> "string" + | Typeofable.Boolean -> "boolean" | Typeofable.Symbol -> "symbol" | Typeofable.BigInt -> "bigint" + match ru.caseArray with + | Some t -> yield sprintf "array<%s>" (t |> Set.toSeq |> Seq.map Type.pp |> String.concat " | ") + | None -> () + if not (Set.isEmpty ru.caseEnum) then + let cases = + ru.caseEnum + |> Set.toSeq + |> Seq.map (function + | Choice1Of2 ({ name = ty }, { name = name; value = Some value }) -> sprintf "%s.%s=%s" ty name (Literal.toString value) + | Choice1Of2 ({ name = ty }, { name = name; value = None }) -> sprintf "%s.%s=?" ty name + | Choice2Of2 l -> Literal.toString l) + yield sprintf "enum<%s>" (cases |> String.concat " | ") + for k, m in ru.discriminatedUnions |> Map.toSeq do + yield sprintf "du[%s]<%s>" k (m |> Map.toSeq |> Seq.map (snd >> Type.pp) |> String.concat ", ") + for t in ru.otherTypes |> Set.toSeq do yield Type.pp t + ] + cases |> String.concat " | " + + let rec private getEnumFromUnion ctx (u: UnionType) : Set> * UnionType = + let (|Dummy|) _ = [] + + let rec go t = + seq { + match t with + | Union { types = types } -> yield! Seq.collect go types + | Intersection { types = types } -> yield! types |> List.map (go >> Set.ofSeq) |> Set.intersectMany |> Set.toSeq + | (Ident ({ loc = loc } & i) & Dummy tyargs) + | App (AIdent i, tyargs, loc) -> + for x in i |> Ident.getDefinitions ctx do + match x with + | Definition.TypeAlias a -> + let bindings = Type.createBindings i.name loc a.typeParams tyargs + yield! go (a.target |> Type.substTypeVar bindings ()) + | Definition.Enum e -> + for c in e.cases do yield Choice1Of2 (Choice1Of2 (e, c)) + | Definition.EnumCase (c, e) -> + yield Choice1Of2 (Choice1Of2 (e, c)) + | Definition.Class _ -> yield Choice2Of2 t + | _ -> () + | TypeLiteral l -> yield Choice1Of2 (Choice2Of2 l) + | _ -> yield Choice2Of2 t + } + + let f (cases, types) ty = + let c, rest = go ty |> Seq.fold (fun (e, rest) -> function Choice1Of2 x -> Set.add x e, rest | Choice2Of2 x -> e, x::rest) (Set.empty, []) + match Set.isEmpty c, rest with + | true, [] -> cases, types + | true, _ -> cases, ty :: types // preserve the original type as much as possible + | false, [] -> Set.union c cases, types + | false, ts -> Set.union c cases, ts @ types + + let cases, types = u.types |> List.fold f (Set.empty, []) + cases, { types = types } + + let private getDiscriminatedFromUnion (ctx: TyperContext<'a, 's>) (u: UnionType) : Map> * UnionType = + let (|Dummy|) _ = [] + + let getLiteralFieldsFromClass getLiteralFieldsFromType (c: Class<_>) : Map> = + let inherited = + c.implements + |> List.map getLiteralFieldsFromType + |> List.fold (fun state fields -> + fields |> Map.fold (fun state k v -> + match state |> Map.tryFind k with + | None -> state |> Map.add k v + | Some v' -> state |> Map.add k (Set.intersect v v') + ) state + ) Map.empty |> Map.filter (fun _ v -> Set.isEmpty v |> not) + + let fields = + c.members + |> List.collect (fun (_, m) -> + match m with + | Field (fl, _) -> + let rec go t = + match t with + | TypeLiteral l -> [fl.name, l] + | Union u -> List.collect go u.types + | (Ident ({ loc = loc } & i) & Dummy ts) + | App (AIdent i, ts, loc) -> + Ident.getDefinitions ctx i + |> List.collect (function + | Definition.Enum e -> + e.cases |> List.choose (function { value = Some v } -> Some (fl.name, v) | _ -> None) + | Definition.EnumCase ({ value = Some v }, _) -> [fl.name, v] + | Definition.TypeAlias a -> + let bindings = Type.createBindings i.name loc a.typeParams ts + go (a.target |> Type.substTypeVar bindings ()) + | _ -> [] + ) + | _ -> [] + go fl.value + | _ -> [] + ) + |> List.distinct + |> List.groupBy fst + |> List.map (fun (k, v) -> k, v |> List.map snd |> Set.ofList) + |> Map.ofList + + Map.foldBack Map.add fields inherited // overwrite inherited fields overloaded by the class + + let rec getLiteralFieldsFromType (ty: Type) : Map> = + let inline getLiteralFieldsFromClass c = getLiteralFieldsFromClass getLiteralFieldsFromType c + match ty with + | Intrinsic | PolymorphicThis | TypeVar _ | Prim _ | TypeLiteral _ | Tuple _ | Func _ | NewableFunc _ -> Map.empty + | Erased _ -> failwith "impossible_getDiscriminatedFromUnion_getLiteralFieldsFromType_Erased" + | Union u -> + let result = u.types |> List.map getLiteralFieldsFromType + result |> List.fold (fun state fields -> + fields |> Map.fold (fun state k v -> + match state |> Map.tryFind k with + | None -> state |> Map.add k v + | Some v' -> state |> Map.add k (Set.union v v') + ) state + ) Map.empty + | Intersection i -> + let result = i.types |> List.map getLiteralFieldsFromType + result |> List.fold (fun state fields -> + fields |> Map.fold (fun state k v -> + match state |> Map.tryFind k with + | None -> state |> Map.add k v + | Some v' -> state |> Map.add k (Set.intersect v v') + ) state + ) Map.empty |> Map.filter (fun _ v -> Set.isEmpty v |> not) + | AnonymousInterface c -> getLiteralFieldsFromClass c + | App (AAnonymousInterface c, ts, loc) -> + let bindings = Type.createBindings ["(anonymous interface)"] loc c.typeParams ts + getLiteralFieldsFromClass (c |> Type.mapInClass (Type.substTypeVar bindings) ()) + | (Ident ({ loc = loc } & i) & Dummy ts) | App (AIdent i, ts, loc) -> + let go = function + | Definition.TypeAlias a -> + let m = + if List.isEmpty ts then getLiteralFieldsFromType a.target + else + let bindings = Type.createBindings i.name loc a.typeParams ts + getLiteralFieldsFromType (a.target |> Type.substTypeVar bindings ()) + if Map.isEmpty m then None else Some m + | Definition.Class c -> + let m = + if List.isEmpty ts then getLiteralFieldsFromClass c + else + let bindings = Type.createBindings i.name loc c.typeParams ts + getLiteralFieldsFromClass (c |> Type.mapInClass (Type.substTypeVar bindings) ()) + if Map.isEmpty m then None else Some m + | _ -> None + match Ident.getDefinitions ctx i |> List.tryPick go with + | Some t -> t + | None -> Map.empty + | Ident _ | App _ | UnknownType _ -> Map.empty + + let discriminatables, rest = + List.foldBack (fun ty (discriminatables, rest) -> + let fields = getLiteralFieldsFromType ty + if Map.isEmpty fields then discriminatables, ty :: rest + else (ty, fields) :: discriminatables, rest + ) u.types ([], []) + + let tagDict = new MutableMap>() + for (_, fields) in discriminatables do + for (name, values) in fields |> Map.toSeq do + match tagDict.TryGetValue(name) with + | true, (i, values') -> tagDict.[name] <- (i + 1u, Set.intersect values values') + | false, _ -> tagDict.[name] <- (1u, values) + + let getBestTag (fields: Map>) = + let xs = + fields + |> Map.toList + |> List.choose (fun (name, values) -> + match tagDict.TryGetValue(name) with + | true, (i, commonValues) -> + let intersect = Set.intersect values commonValues + Some ((-(Set.count intersect), i), (name, values)) // prefer the tag with the least intersections + | false, _ -> None) + if List.isEmpty xs then None + else Some (xs |> List.maxBy fst |> snd) + + let discriminatables, rest = + List.foldBack (fun (ty, fields) (discriminatables, rest) -> + match getBestTag fields with + | Some (name, values) -> (name, values, ty) :: discriminatables, rest + | None -> discriminatables, ty :: rest + ) discriminatables ([], rest) + + if List.length discriminatables < 2 then + Map.empty, { u with types = List.distinct u.types } + else + let dus = + discriminatables + |> List.collect (fun (name, values, ty) -> + values |> Set.toList |> List.map (fun value -> name, (value, ty))) + |> List.groupBy fst + |> List.map (fun (name, xs) -> + name, + xs |> List.map snd + |> List.groupBy fst + |> List.map (fun (k, xs) -> + match List.map snd xs |> List.distinct with + | [x] -> k, x + | xs -> k, Union { types = xs }) + |> Map.ofList) + |> Map.ofList + dus, { types = List.distinct rest } + + let mutable private resolveUnionMap: Map = Map.empty + + let rec resolve (ctx: TyperContext<'a, 's>) (u: UnionType) : ResolvedUnion = + match resolveUnionMap |> Map.tryFind u with + | Some t -> t + | None -> + let nullOrUndefined, rest = + u.types |> List.partition (function Prim (Null | Undefined) -> true | _ -> false) + let caseNull = nullOrUndefined |> List.contains (Prim Null) + let caseUndefined = nullOrUndefined |> List.contains (Prim Undefined) + let prims, arrayTypes, rest = + rest |> List.fold (fun (prims, ats, rest) -> + function + | Prim Number -> Typeofable.Number :: prims, ats, rest + | Prim String -> Typeofable.String :: prims, ats, rest + | Prim Bool -> Typeofable.Boolean :: prims, ats, rest + | Prim (Symbol _) -> Typeofable.Symbol :: prims, ats, rest + | Prim BigInt -> Typeofable.BigInt :: prims, ats, rest + | App (APrim Array, [t], _) -> prims, t :: ats, rest + | t -> prims, ats, t :: rest + ) ([], [], []) + let typeofableTypes = Set.ofList prims + let caseArray = + if List.isEmpty arrayTypes then None + else Some (Set.ofList arrayTypes) + let caseEnum, rest = + match rest with + | _ :: _ :: _ -> getEnumFromUnion ctx { types = rest } + | _ -> Set.empty, { types = rest } + let discriminatedUnions, rest = + match rest.types with + | _ :: _ :: _ -> getDiscriminatedFromUnion ctx rest + | _ -> Map.empty, rest + let otherTypes = Set.ofList rest.types + + let result = + { caseNull = caseNull + caseUndefined = caseUndefined + typeofableTypes = typeofableTypes + caseArray = caseArray + caseEnum = caseEnum + discriminatedUnions = discriminatedUnions + otherTypes = otherTypes } + + resolveUnionMap <- resolveUnionMap |> Map.add u result + result + +let inferEnumCaseValue (stmts: Statement list) : Statement list = + let rec go = function + | Enum e -> + let f (state: Literal option) (c: EnumCase) : EnumCase * Literal option = + match c.value with + | Some v -> c, Some v + | None -> + let v = + match state with + | None -> Some (LInt 0) + | Some (LInt n) -> Some (LInt (n+1)) + | Some (LFloat f) -> Some (LFloat (f+1.0)) + | Some _ -> None + { c with value = v }, v + Enum { e with cases = e.cases |> List.mapFold f None |> fst } + | Module m -> Module { m with statements = m.statements |> List.map go } + | s -> s + stmts |> List.map go + +let rec mergeStatements (stmts: Statement list) = + let mutable result : Choice list = [] + + let mutable intfMap = Map.empty + let mutable nsMap = Map.empty + let mutable otherStmtSet = Set.empty + let mergeTypeParams tps1 tps2 = + let rec go acc = function + | [], [] -> List.rev acc + | tp1 :: rest1, tp2 :: rest2 -> + let inline check t1 t2 = + match t1, t2 with + | Some t, None | None, Some t -> Some t + | None, None -> None + | Some t1, Some t2 -> + assert (t1 = t2) + Some t1 + let extends = check tp1.extends tp2.extends + let defaultType = check tp1.defaultType tp2.defaultType + assert (tp1.name = tp2.name) + let tp = { name = tp1.name; extends = extends; defaultType = defaultType } + go (tp :: acc) (rest1, rest2) + | tp :: rest1, rest2 + | rest1, tp :: rest2 -> + let tp = + match tp.defaultType with + | Some _ -> tp + | None -> { tp with defaultType = Some (Prim Any) } + go (tp :: acc) (rest1, rest2) + go [] (tps1, tps2) + + for stmt in stmts do + match stmt with + | Class i (* when i.isInterface *) -> + match intfMap |> Map.tryFind i.name with + | None -> + let iref = ref i + intfMap <- (intfMap |> Map.add i.name iref) + result <- Choice2Of3 iref :: result + | Some iref' -> + let i' = iref'.Value + assert (i.accessibility = i'.accessibility) + let i = + { i with + isInterface = i.isInterface && i'.isInterface + comments = i.comments @ i'.comments |> List.distinct + loc = i.loc ++ i'.loc + typeParams = mergeTypeParams i.typeParams i'.typeParams + implements = List.distinct (i.implements @ i'.implements) + members = i.members @ i'.members } + iref'.Value <- i + | Module n (* when n.isNamespace *) -> + match nsMap |> Map.tryFind n.name with + | None -> + let nref = ref n + nsMap <- (nsMap |> Map.add n.name nref) + result <- Choice3Of3 nref :: result + | Some nref' -> + let n' = nref'.Value + nref'.Value <- + { n with + loc = n.loc ++ n'.loc + comments = n.comments @ n'.comments |> List.distinct + statements = n'.statements @ n.statements } + | stmt -> + if otherStmtSet |> Set.contains stmt |> not then + otherStmtSet <- otherStmtSet |> Set.add stmt + result <- Choice1Of3 stmt :: result + result + |> List.rev + |> List.map (function + | Choice1Of3 s -> s + | Choice2Of3 i -> Class i.Value + | Choice3Of3 n -> + Module { n.Value with statements = mergeStatements n.Value.statements } + ) + +let mergeSources newFileName (srcs: SourceFile list) = + let sourceMapping = + srcs |> List.map (fun src -> src.fileName, newFileName) |> Map.ofList + let f (i: Ident) = + i |> Ident.mapSource (fun path -> + sourceMapping |> Map.tryFind path |> Option.defaultValue path + ) + let statements = + srcs + |> List.collect (fun src -> src.statements |> Statement.mapIdent f) + |> mergeStatements + { fileName = newFileName + statements = statements + references = srcs |> List.collect (fun src -> src.references) |> List.distinct + hasNoDefaultLib = srcs |> List.exists (fun src -> src.hasNoDefaultLib) } + +let introduceAdditionalInheritance (ctx: IContext<#TyperOptions>) (stmts: Statement list) : Statement list = + let opts = ctx.options + let rec go stmts = + stmts |> List.map (function + | Class (c & { name = Name name }) -> + let inherits = ResizeArray(c.implements) + + let has tyName = + name = tyName || inherits.Exists(fun t -> + match t with + | Ident { name = [name'] } + | App (AIdent { name = [name'] }, _, _) -> tyName = name' + | _ -> false + ) + + let inline app t ts loc = + App (AIdent { name = [t]; kind = Some (Set.ofList [Kind.Type; Kind.ClassLike; Kind.Statement]); fullName = []; loc = loc; parent = None}, ts, loc) + + for ma, m in c.members do + match m with + // iterator & iterable iterator + | SymbolIndexer ("iterator", { returnType = ty }, _) when opts.inheritIterable -> + match ty with + | App (AIdent { name = ["Iterator"] }, [argTy], _) when not (has "Iterable") -> + inherits.Add(app "Iterable" [argTy] ma.loc) + | App (AIdent { name = ["IterableIterator"] }, [argTy], _) when not (has "IterableIterator") -> + inherits.Add(app "IterableIterator" [argTy] ma.loc) + | _ -> () + + // async iterator & iterable iterator + | SymbolIndexer ("asyncIterator", { returnType = ty }, _) when opts.inheritIterable -> + match ty with + | App (AIdent { name = ["AsyncIterator"] }, [argTy], _) when not (has "AsyncIterable") -> + inherits.Add(app "AsyncIterable" [argTy] ma.loc) + | App (AIdent { name = ["AsyncIterableIterator"] }, [argTy], _) when not (has "AsyncIterableIterator") -> + inherits.Add(app "AsyncIterableIterator" [argTy] ma.loc) + | _ -> () + + // ArrayLike + | Indexer ({ args = [Choice1Of2 { value = Prim Number } | Choice2Of2 (Prim Number)]; returnType = retTy }, _) + when opts.inheritArraylike && not (has "ArrayLike") -> inherits.Add(app "ArrayLike" [retTy] ma.loc) + + // PromiseLike + | Method ("then", { args = [Choice1Of2 { name = "onfulfilled"; value = onfulfilled }; Choice1Of2 { name = "onrejected" }] }, _) + when opts.inheritPromiselike && not (has "PromiseLike") -> + match onfulfilled with + | Func ({ args = [Choice1Of2 { value = t } | Choice2Of2 t] }, _, _) -> + inherits.Add(app "PromiseLike" [t] ma.loc) + | Union { types = ts } -> + for t in ts do + match t with + | Func ({ args = [Choice1Of2 { value = t } | Choice2Of2 t] }, _, _) -> + inherits.Add(app "PromiseLike" [t] ma.loc) + | _ -> () + | _ -> () + + | _ -> () + + Class { c with implements = List.ofSeq inherits |> List.distinct } + | x -> x + ) + go stmts + +let detectPatterns (stmts: Statement list) : Statement list = + let rec go stmts = + // declare var Foo: Foo + let valDict = new MutableMap() + // interface Foo { .. } + let intfDict = new MutableMap() + // declare var Foo: FooConstructor + let ctorValDict = new MutableMap() + // interface FooConstructor { .. } + let ctorIntfDict = new MutableMap() + + for stmt in stmts do + match stmt with + | Variable (v & { name = name; typ = Ident { name = [intfName] } }) -> + if name = intfName then valDict[name] <- v + else if (name + "Constructor") = intfName then ctorValDict[name] <- v + | Class (intf & { name = Name name; isInterface = true }) -> + if name <> "Constructor" && name.EndsWith("Constructor") then + let origName = name.Substring(0, name.Length - "Constructor".Length) + ctorIntfDict[origName] <- intf + else + intfDict[name] <- intf + | _ -> () + + let intersect (other: string seq) (set: MutableSet) = + let otherSet = new MutableSet(other) + for s in set do + if not <| otherSet.Contains(s) then + set.Remove(s) |> ignore + set + + let immediateInstances = + new MutableSet(valDict.Keys) + |> intersect intfDict.Keys + let immediateCtors = + new MutableSet(intfDict.Keys) + |> intersect ctorValDict.Keys + |> intersect ctorIntfDict.Keys + + stmts |> List.choose (function + | Variable (v & { name = name; typ = Ident { name = [intfName] } }) -> + if name = intfName && immediateInstances.Contains name && valDict.[name] = v then + let intf = intfDict.[name] + Some (Pattern (ImmediateInstance (intf, v))) + else if name + "Constructor" = intfName && immediateCtors.Contains name && ctorValDict.[name] = v then + let baseIntf = intfDict.[name] + let ctorIntf = ctorIntfDict.[name] + Some (Pattern (ImmediateConstructor (baseIntf, ctorIntf, v))) + else + Some (Variable v) + | Class (intf & { name = Name name; isInterface = true }) -> + if (immediateInstances.Contains name || immediateCtors.Contains name) then None + else if name <> "Constructor" && name.EndsWith("Constructor") then + let origName = name.Substring(0, name.Length - "Constructor".Length) + if immediateCtors.Contains origName then None + else Some (Class intf) + else Some (Class intf) + | Module m -> Some (Module { m with statements = go m.statements }) + | x -> Some x + ) + go stmts + +let replaceAliasToFunction (ctx: #IContext<#TyperOptions>) stmts = + let rec go = function + | Module m -> + Module { m with statements = List.map go m.statements } + | TypeAlias ta -> + match ta.target with + | Func (f, typrms, loc) -> + Class { + name = Name ta.name + isInterface = true + comments = ta.comments + accessibility = Protected + isExported = Exported.No + implements = [] + typeParams = ta.typeParams + members = [ + { comments = []; loc = loc; accessibility = Public; isStatic = false }, + Callable (f, typrms) + ] + loc = loc + } + | _ -> TypeAlias ta + | x -> x + if ctx.options.replaceAliasToFunction then + List.map go stmts + else + stmts + +let replaceFunctions (ctx: #IContext<#TyperOptions>) (stmts: Statement list) = + let rec goType (ctx: #IContext<#TyperOptions>) = function + | Func (f, [], loc) -> Func (Type.mapInFuncType goType ctx f, [], loc) + | Func (f, typrms, loc) -> + let f = Type.mapInFuncType goType ctx f + let typrms = typrms |> List.map (Type.mapInTypeParam goType ctx) + if ctx.options.replaceRankNFunction then + Type.createFunctionInterface [{| ty = f; typrms = typrms; loc = loc; isNewable = false; comments = [] |}] + else + Func (f, typrms, loc) + | NewableFunc (f, [], loc) when not ctx.options.replaceNewableFunction -> + NewableFunc (Type.mapInFuncType goType ctx f, [], loc) + | NewableFunc (f, typrms, loc) -> + let f = Type.mapInFuncType goType ctx f + let typrms = typrms |> List.map (Type.mapInTypeParam goType ctx) + if ctx.options.replaceRankNFunction || ctx.options.replaceNewableFunction then + Type.createFunctionInterface [{| ty = f; typrms = typrms; loc = loc; isNewable = true; comments = [] |}] + else + NewableFunc (f, typrms, loc) + | TypeVar v -> TypeVar v + | Union u -> Union (u |> Type.mapInUnion goType ctx) + | Intersection i -> Intersection (i |> Type.mapInIntersection goType ctx) + | Tuple t -> Tuple (Type.mapInTupleType goType ctx t) + | AnonymousInterface c -> AnonymousInterface (Type.mapInClass goType ctx c) + | App (t, ts, loc) -> + let t = + match t with + | AAnonymousInterface i -> AAnonymousInterface (Type.mapInClass goType ctx i) + | _ -> t + App (t, ts |> List.map (goType ctx), loc) + | Ident i -> Ident i | Prim p -> Prim p | TypeLiteral l -> TypeLiteral l + | PolymorphicThis -> PolymorphicThis | Intrinsic -> Intrinsic + | Erased (e, loc, origText) -> + let e' = + match e with + | IndexedAccess (t1, t2) -> IndexedAccess (goType ctx t1, goType ctx t2) + | TypeQuery i -> TypeQuery i + | Keyof t -> Keyof (goType ctx t) + Erased (e', loc, origText) + | UnknownType msgo -> UnknownType msgo + let rec goStatement (ctx: #IContext<#TyperOptions>) = function + | Variable { name = name; typ = Func (f, typrms, _); isConst = true; isExported = isExported; + accessibility = accessibility; comments = comments; loc = loc } + when List.length typrms > 0 && ctx.options.replaceRankNFunction -> + let typ = Type.mapInFuncType goType ctx f + let typrms = typrms |> List.map (Type.mapInTypeParam goType ctx) + Function { name = name; typ = typ; typeParams = typrms; + isExported = isExported; accessibility = accessibility; comments = comments; loc = loc } |> Some + | _ -> None + Statement.mapTypeWith goStatement goType (fun _ x -> x) id ctx stmts + +let private createRootContextForTyper (srcs: SourceFile list) (baseCtx: IContext<'Options>) : TyperContext<'Options, unit> = + let info = + srcs + |> List.map (fun sf -> + sf.fileName, + { sourceFile = sf + definitionsMap = Statement.createDefinitionsMap sf.statements + typeLiteralsMap = Map.empty + anonymousInterfacesMap = Map.empty + unknownIdentTypes = Trie.empty }) + |> Map.ofList + { _currentSourceFile = ""; _currentNamespace = []; + _info = info; _state = () + _cache = { inheritCache = new MutableMap<_, _>(); hasNoInherits = new MutableSet<_>() } + _options = baseCtx.options; _logger = baseCtx.logger } + +let createRootContext (srcs: SourceFile list) (baseCtx: IContext<'Options>) : TyperContext<'Options, unit> = + let ctx = createRootContextForTyper srcs baseCtx + { ctx with + _info = + ctx._info |> Map.map (fun _ v -> + let stmts = v.sourceFile.statements + let tlm = Statement.getTypeLiterals stmts |> Seq.mapi (fun i l -> l, i) |> Map.ofSeq + let aim = + Statement.getAnonymousInterfaces stmts + |> Seq.mapi (fun i (c, ns) -> c, { id = i; path = ns }) |> Map.ofSeq + let uit = Statement.getUnknownIdentTypes ctx stmts + { v with + typeLiteralsMap = tlm + anonymousInterfacesMap = aim + unknownIdentTypes = uit } + ) } + +module Ts = TypeScript.Ts + +/// Merges `node_modules/typescript/lib/lib.es*.d.ts` to one source file. +/// +/// Intended to be used for generating standard bindings for JS APIs. +/// +/// Run this before `Typer.runAll`. +let mergeESLibDefinitions (srcs: SourceFile list) = + let getESVersionFromFileName (s: string) = + let es = s.Split '.' |> Array.tryFind (fun s -> s.StartsWith "es") + match es with + | None -> Ts.ScriptTarget.ESNext + | Some "es3" -> Ts.ScriptTarget.ES3 + | Some "es5" -> Ts.ScriptTarget.ES5 + | Some "es6" | Some "es2015" -> Ts.ScriptTarget.ES2015 + | Some "es2016" -> Ts.ScriptTarget.ES2016 + | Some "es2017" -> Ts.ScriptTarget.ES2017 + | Some "es2018" -> Ts.ScriptTarget.ES2018 + | Some "es2019" -> Ts.ScriptTarget.ES2019 + | Some "es2020" -> Ts.ScriptTarget.ES2020 + | Some _ -> Ts.ScriptTarget.ESNext + + let map (parentVersion: Ts.ScriptTarget option) (loc: Location) (x: ICommented<_>) = + let esVersion = + let rec go = function + | UnknownLocation -> None + | LocationTs (sf, _) -> getESVersionFromFileName sf.fileName |> Some + | Location x -> getESVersionFromFileName x.src.fileName |> Some + | MultipleLocation ls -> + match ls |> List.choose go with + | [] -> None + | xs -> List.min xs |> Some + go loc + match esVersion with + | None -> + None, x.mapComments id + | Some v -> + match parentVersion with + | Some v' when v = v' -> Some v, x.mapComments id + | _ -> Some v, x.mapComments (fun cs -> ESVersion v :: cs) + + let rec mapStmt (s: Statement) = + let vo, s = map None s.loc s + match s with + | Module m -> Module { m with statements = List.map mapStmt m.statements } + | Enum e -> Enum { e with cases = e.cases |> List.map (fun c -> map vo c.loc c |> snd) } + | Class c -> Class { c with members = c.members |> List.map (fun (a, m) -> map vo a.loc a |> snd, m) } + | _ -> s + + let newSrc = srcs |> mergeSources "lib.es.d.ts" + { newSrc with statements = newSrc.statements |> List.map mapStmt } + +let runAll (srcs: SourceFile list) (baseCtx: IContext<#TyperOptions>) = + let inline mapStatements f (src: SourceFile) = + { src with statements = f src.statements } + + let inline withSourceFileContext ctx f (src: SourceFile) = + f (ctx |> TyperContext.ofSourceFileRoot src.fileName) src + + let result = srcs |> List.map (mapStatements (inferEnumCaseValue >> mergeStatements)) + + // build a context + let ctx = createRootContextForTyper result baseCtx + + let result = + result |> List.map ( + withSourceFileContext ctx (fun ctx src -> + src |> mapStatements (fun stmts -> + stmts + |> Statement.resolveErasedTypes ctx + // add common inheritances which tends not to be defined by `extends` or `implements` + |> introduceAdditionalInheritance ctx + // group statements with pattern + |> detectPatterns + // replace alias to function type with a function interface + |> replaceAliasToFunction ctx + // replace N-rank and/or newable function type with an interface + |> replaceFunctions ctx + ))) + + // rebuild the context because resolveErasedTypes may introduce additional anonymous interfaces + let ctx = createRootContext result ctx + + ctx, result \ No newline at end of file diff --git a/lib/ts2ml.fsproj b/lib/ts2ml.fsproj new file mode 100644 index 00000000..018e8cf7 --- /dev/null +++ b/lib/ts2ml.fsproj @@ -0,0 +1,24 @@ + + + netstandard2.0 + + + + + + + + + + + + + + + + + + + + + diff --git a/package.json b/package.json index 342f78ce..94221070 100644 --- a/package.json +++ b/package.json @@ -28,7 +28,8 @@ }, "dependencies": { "typescript": "4.5.4", - "yargs": "17.3.1" + "yargs": "17.3.1", + "browser-or-node": "^2.0.0" }, "devDependencies": { "@babel/core": "7.16.7", @@ -36,6 +37,8 @@ "@types/semver": "7.3.9", "@types/yargs": "17.0.8", "monaco-editor": "0.31.1", + "@angular/common": "^13.0.3", + "cassandra-driver": "^4.6.3", "react-player": "2.9.0", "webpack": "5.65.0", "webpack-cli": "4.9.1", diff --git a/src/Common.fs b/src/Common.fs index 1cfb6f99..8d18701a 100644 --- a/src/Common.fs +++ b/src/Common.fs @@ -1,11 +1,37 @@ [] module Common +open Ts2Ml.Common + type GlobalOptions = + inherit IOptions abstract verbose: bool with get abstract nowarn: bool with get abstract merge: bool with get, set - abstract followRelativeReferences: bool with get, set + +module Log = + let tracef (opt: 'Options) fmt : _ when 'Options :> GlobalOptions = + Printf.ksprintf (fun str -> + if opt.verbose then + printfn "%s" str + ) fmt + + let warnf (opt: 'Options) fmt : _ when 'Options :> GlobalOptions = + Printf.ksprintf (fun str -> + if not opt.nowarn then + eprintfn "warn: %s" str + ) fmt + +let createBaseContext (opts: #GlobalOptions) : IContext<_> = + let logger = + { new ILogger with + member _.tracef fmt = Log.tracef opts fmt + member _.warnf fmt = Log.warnf opts fmt + member _.errorf fmt = failwithf fmt + } + { new IContext<_> with + member _.options = opts + member _.logger = logger } module GlobalOptions = open Fable.Core.JsInterop @@ -22,46 +48,5 @@ module GlobalOptions = .addFlag("verbose", (fun (o: GlobalOptions) -> o.verbose), descr="Show verbose log") .addFlag("nowarn", (fun (o: GlobalOptions) -> o.nowarn), descr="Do not show warnings") - -module Log = - let tracef (opt: 'Options) fmt : _ when 'Options :> GlobalOptions = - Printf.ksprintf (fun str -> - if opt.verbose then - printfn "%s" str - ) fmt - - let warnf (opt: 'Options) fmt : _ when 'Options :> GlobalOptions = - Printf.ksprintf (fun str -> - if not opt.nowarn then - eprintfn "warn: %s" str - ) fmt - -/// Stateful class to rename overloaded identifiers. -type OverloadRenamer(?rename: string -> int -> string, ?used: Set) = - let rename = - match rename with - | Some f -> f - | None -> (fun s i -> s + (String.replicate i "'")) - let m = new MutableMap() - do - match used with - | None -> () - | Some used -> - for name in used |> Set.toSeq do - m.[name] <- 0 - - /// If the `name` is already used in the same `category`, returns the new renamed name. - /// - /// Otherwise, (even if it is used in a different `category`), returns the original name. - /// - /// `category` can be arbitrary, but it is intended for something like `value`, `type`, `module`, etc. - member __.Rename (category: string) (name: string) = - match m.TryGetValue((category, name)) with - | true, i -> - m.[(category, name)] <- i + 1 - let name' = rename name (i+1) - m.[(category, name')] <- 0 - name' - | false, _ -> - m.[(category, name)] <- 0 - name +type IContext<'Options when 'Options :> IOptions> = Ts2Ml.Common.IContext<'Options> +type OverloadRenamer = Ts2Ml.Common.OverloadRenamer \ No newline at end of file diff --git a/src/Extensions.fs b/src/Extensions.fs index 3eaee5ff..f7c8c4ea 100644 --- a/src/Extensions.fs +++ b/src/Extensions.fs @@ -1,160 +1,15 @@ [] module Extensions +open Ts2Ml open System - -module Enum = - /// Get the name of an enum case - let inline pp (e: 'enum when 'enum: enum<_>) = - Enum.GetName(typeof<'enum>, e) - -module Char = - let inline isAlphabet c = - ('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z') - let inline isAlphabetOrDigit c = - ('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z') || ('0' <= c && c <= '9') - -module String = - let containsAny (a: string) (b: string list) = - b |> List.exists a.Contains - - let replace (pattern:string) (destPattern:string) (text: string) = - text.Replace(pattern,destPattern) - - let split (separator: string) (text: string) = - text.Split([|separator|], StringSplitOptions.None) - - let splitMany (separators: string list) (text: string) = - text.Split(Array.ofList separators, StringSplitOptions.None) - - let splitThenRemoveEmptyEntries (separator: string) (text: string) = - text.Split([|separator|], StringSplitOptions.RemoveEmptyEntries) - - let splitManyThenRemoveEmptyEntries (separators: string list) (text: string) = - text.Split(Array.ofList separators, StringSplitOptions.RemoveEmptyEntries) - - let toLines (s: string) : string[] = - s - |> replace "\r\n" "\n" - |> replace "\r" "\n" - |> split "\n" - - let escape (s: string) = - s - .Replace("\\", "\\\\") - .Replace("'", "\\'").Replace("\"", "\\\"") - .Replace("\b", "\\b").Replace("\n", "\\n").Replace("\r", "\\r") - .Replace("\t", "\\t") - - let escapeWith (escaped: string seq) (s: string) = - escaped |> Seq.fold (fun (state: string) e -> - state.Replace(e, "\\" + e) - ) s - -module Result = - let toOption result = - match result with Ok x -> Some x | Error _ -> None - -module List = - let splitChoice2 (xs: Choice<'t1, 't2> list) : 't1 list * 't2 list = - let xs1, xs2 = - xs |> List.fold (fun (xs1, xs2) -> function - | Choice1Of2 x -> x :: xs1, xs2 - | Choice2Of2 x -> xs1, x :: xs2 - ) ([], []) - List.rev xs1, List.rev xs2 - -type MutableMap<'k, 'v> = Collections.Generic.Dictionary<'k, 'v> -type MutableSet<'v> = Collections.Generic.HashSet<'v> - -#if FABLE_COMPILER -type StringBuilder (s: string) = - let mutable s = s - new () = StringBuilder ("") - member __.Length = s.Length - member sb.Append (s': string) = s <- s + s'; sb - member inline sb.Append (c: char) = sb.Append (string c) - member inline sb.Append (num: ^n) = sb.Append (sprintf "%d" num) - member inline sb.Append (o: obj) = sb.Append (string o) - member inline sb.AppendLine () = sb.Append System.Environment.NewLine - member inline sb.AppendLine (s: string) = (sb.Append (s)).AppendLine() - member sb.Remove (startIndex: int, length: int) = - if startIndex + length >= s.Length - then s <- s.Substring (0, startIndex) - else s <- s.Substring (0, startIndex) + s.Substring (startIndex + length) - sb - member __.ToString (startIndex: int, length: int) = - s.Substring (startIndex, length) - member sb.Clear () = - s <- ""; sb - override __.ToString() = s -#else -type StringBuilder = System.Text.StringBuilder -#endif - open Fable.Core open Fable.Core.JsInterop - -module JS = - [] - let jsTypeof (_: 'a) : string = jsNative - - let cloneWith (f: 'a -> unit) (x: 'a) = - let newX = JS.Constructors.Object.assign(!!{||}, x) :?> 'a - f newX - newX - - let stringify (x: obj) = - let objSet = JS.Constructors.Set.Create() - JS.JSON.stringify(x, space=2, replacer=(fun _key value -> - if not (isNullOrUndefined value) && jsTypeof value = "object" then - if objSet.has(value) then box "" - else - objSet.add value |> ignore - value - else - value - )) - -type JS.ObjectConstructor with - [] - member __.entries (x: 'a) : (string * obj) [] = jsNative - -module Path = - module Node = Node.Api - - type Absolute = string - /// relative to current directory - type Relative = string - type Difference = string - - let relative (path: string) : Relative = - Node.path.relative(Node.``process``.cwd(), path) - - let absolute (path: string) : Absolute = - if Node.path.isAbsolute(path) then path - else Node.path.resolve(path) - - let diff (fromPath: string) (toPath: string) : Difference = - let fromPath = - if Node.fs.lstatSync(!^fromPath).isDirectory() then fromPath - else Node.path.dirname(fromPath) - Node.path.relative(fromPath, toPath) - - let dirname (path: string) : string = - Node.path.dirname(path) - - let basename (path: string) : string = - Node.path.basename(path) - - let join (paths: string list) : string = - Node.path.join(Array.ofList paths) - - let separator = - Node.path.sep - open Yargs +[] +let inline TODO (msg: string) = failwithf "TODO: %s" msg + type Argv<'T> with member private argv.addImpl<'a> (key: string, descr: string option, ?demand: bool, ?missingMsg: string, ?dv:'a, ?dd:string, ?alias:string) = let argv = match descr with None -> argv | Some d -> argv.describe(!^key, d) @@ -218,7 +73,7 @@ type Argv<'T> with | None -> [] | Some s -> let s = - if JS.jsTypeof s = "string" then s :?> string + if JS.typeof s = "string" then s :?> string else s.ToString() s.Split([|','|], StringSplitOptions.RemoveEmptyEntries) |> Array.map (fun s -> diff --git a/src/JsHelper.fs b/src/JsHelper.fs deleted file mode 100644 index 2bf3b76a..00000000 --- a/src/JsHelper.fs +++ /dev/null @@ -1,243 +0,0 @@ -module JsHelper -open Fable.Core -open Fable.Core.JsInterop - -module Node = Node.Api - -let getPackageJsonPath (exampleFilePath: string) = - let parts = - exampleFilePath - |> String.split Path.separator - |> List.ofArray - match parts |> List.tryFindIndexBack ((=) "node_modules") with - | None -> None - | Some i -> - let prefix, rest = List.splitAt (i+1) parts - if rest = [] then None - else - let packageName = - match rest with - | userName :: packageName :: _ when userName.StartsWith("@") -> [userName; packageName] - | packageName :: _ -> [packageName] - | _ -> failwith "impossible_getPackageJsonPath_root" - let path = - prefix @ packageName @ ["package.json"] |> String.concat Path.separator - - if not <| Node.fs.existsSync(!^path) then None - else Some (Path.absolute path) - -type IPackageExportTypesEntry = - abstract ``default``: string option - -type IPackageExportItem = - [] - abstract Item: string -> string with get - -type IPackageJson = - abstract name: string - abstract version: string - abstract types: string option - abstract typings: string option - abstract exports: obj option - -let getPackageJson (path: string) : IPackageJson = - let content = Node.fs.readFileSync(path, "utf-8") - !!JS.JSON.parse(content) - -let getPackageInfo (exampleFilePath: string) : Syntax.PackageInfo option = - match getPackageJsonPath exampleFilePath with - | None -> None - | Some path -> - let p = getPackageJson path - - let rootPath = Path.dirname path - - let name = - if p.name.StartsWith("@types/") then - let tmp = p.name.Substring(7) - if tmp.Contains("__") then "@" + tmp.Replace("__", "/") - else tmp - else p.name - - let shortName = - p.name - |> String.splitThenRemoveEmptyEntries "/" - |> Array.skipWhile (fun s -> s.StartsWith("@")) - |> String.concat "/" - - let exports = - match p.exports with - | None -> [] - | Some exports -> - [ - for k, v in JS.Constructors.Object.entries exports do - if JS.jsTypeof v = "string" then - let v = !!v : string - if v.EndsWith(".d.ts") then yield k, v - else if isIn "types" v then - if JS.jsTypeof v?types = "string" then - yield k, v?types - else if isIn "default" v?types then - yield k, v?types?``default`` - else - yield! - JS.Constructors.Object.entries v?types - |> Array.tryPick (fun (_, v) -> - if JS.jsTypeof v = "string" && (!!v : string).EndsWith(".d.ts") then Some (!!v : string) - else None) - |> Option.map (fun v -> k, v) - |> Option.toList - ] - - let indexFile = - match Option.orElse p.types p.typings, exports |> List.tryFind (fst >> (=) ".") with - | None, None -> - let index = Path.join [rootPath; "index.d.ts"] - if not <| Node.fs.existsSync(!^index) then None - else - Path.relative index |> Node.path.normalize |> Some - | Some typings, _ - | None, Some (_, typings) -> - Path.join [rootPath; typings] |> Path.relative |> Node.path.normalize |> Some - - let exports = - exports - |> List.filter (fst >> (<>) ".") - |> List.map (fun (k, v) -> - {| submodule = k; - file = Path.join [rootPath; v] |> Path.relative |> Node.path.normalize |}) - - Some { - name = name - shortName = shortName - isDefinitelyTyped = p.name.StartsWith("@types/") - version = p.version - rootPath = rootPath - indexFile = indexFile - exports = exports - } - -type InferenceResult = - | Valid of string - | Heuristic of string - | Unknown -module InferenceResult = - let unwrap defaultValue = function - | Valid s | Heuristic s -> s - | Unknown -> defaultValue - let tryUnwrap = function - | Valid s | Heuristic s -> Some s - | Unknown -> None - -let inferPackageInfoFromFileName (sourceFile: Path.Relative) : {| name: string; isDefinitelyTyped: bool; rest: string list |} option = - let parts = - sourceFile - |> fun x -> - let inm = x.LastIndexOf "node_modules" - if inm = -1 then x - else x.Substring(inm) - |> String.split "/" - |> List.ofArray - match parts with - | "node_modules" :: "@types" :: name :: rest -> - let name = if name.Contains("__") then "@" + name.Replace("__", "/") else name - Some {| name = name; isDefinitelyTyped = true; rest = rest |} - | "node_modules" :: user :: name :: rest when user.StartsWith("@") -> - Some {| name = user + "/" + name; isDefinitelyTyped = false; rest = rest |} - | "node_modules" :: name :: rest -> - Some {| name = name; isDefinitelyTyped = false; rest = rest |} - | _ -> None - -let inline stripExtension path = - path |> String.replace ".ts" "" |> String.replace ".d" "" - -let getJsModuleName (info: Syntax.PackageInfo option) (sourceFile: Path.Relative) = - let getSubmodule rest = - match List.rev rest with - | "index.d.ts" :: name :: _ -> name - | name :: _ -> stripExtension name - | [] -> failwith "impossible" - match info with - | Some info -> - if info.indexFile |> Option.exists ((=) sourceFile) then - info.name |> Valid - else - // make it relative to the package root directory - let relativePath = Path.diff info.rootPath (Path.absolute sourceFile) - if info.isDefinitelyTyped then - Path.join [info.name; stripExtension relativePath] |> Valid - else - match info.exports |> List.tryFind (fun x -> x.file = sourceFile) with - | Some export -> Path.join [info.name; export.submodule] |> Valid - | None -> // heuristic - let submodule = - relativePath - |> String.splitThenRemoveEmptyEntries "/" - |> List.ofArray - |> getSubmodule - Path.join [info.name; submodule] |> Heuristic - | None -> - match inferPackageInfoFromFileName sourceFile with - | None -> - Path.basename sourceFile - |> stripExtension - |> Heuristic - | Some info -> - if info.isDefinitelyTyped then - let rest = - match List.rev info.rest with - | "index.d.ts" :: rest -> List.rev rest - | other :: rest -> - stripExtension other :: rest |> List.rev - | [] -> [] - info.name :: rest |> String.concat "/" |> Valid - else - match info.rest with - | ["index.d.ts"] -> Valid info.name - | rest -> - info.name + "/" + getSubmodule rest - |> Heuristic - -let deriveModuleName (info: Syntax.PackageInfo option) (srcs: Path.Relative list) = - match srcs with - | [] -> failwith "impossible_deriveModuleName" - | [src] -> getJsModuleName info src - | srcs -> - let fallback () = - let names = - srcs - |> List.choose inferPackageInfoFromFileName - |> List.map (fun info -> info.name) - |> List.groupBy id - |> List.map (fun (name, xs) -> name, List.length xs) - names |> List.maxBy (fun (_, count) -> count) |> fst |> Heuristic - match info with - | None -> fallback () - | Some info -> - if info.indexFile |> Option.exists (fun index -> srcs |> List.exists ((=) index)) then - Valid info.name - else - fallback () - -let deriveOutputFileName - (opts: #GlobalOptions) (info: Syntax.PackageInfo option) (srcs: Path.Relative list) - (moduleNameToFileName: string -> string) (whenUnknown: string) = - let inline log x = - Log.tracef opts "* the inferred output file name is '%s'" x - x - match deriveModuleName info srcs with - | Valid moduleName -> moduleNameToFileName moduleName |> log - | Heuristic best -> moduleNameToFileName best |> log - | Unknown -> - Log.warnf opts "* the output file name cannot be inferred. '%s' is used instead." whenUnknown - whenUnknown - -let resolveRelativeImportPath (info: Syntax.PackageInfo option) (currentFile: Path.Relative) (path: string) = - if path.StartsWith(".") then - let targetPath = - let path = Path.join [Path.dirname currentFile; path] - if not <| path.EndsWith(".ts") then Path.join [path; "index.d.ts"] - else path - getJsModuleName info targetPath - else - Valid path diff --git a/src/Main.fs b/src/Main.fs index e9c5c551..dffd60ab 100644 --- a/src/Main.fs +++ b/src/Main.fs @@ -1,158 +1,23 @@ module Main +open Ts2Ml open Fable.Core.JsInterop open TypeScript open Syntax -module Node = Node.Api - -type ICompilerHost = - abstract getSourceFile: fileName: string * languageVersion: Ts.ScriptTarget * ?onError: (string -> unit) * ?shouldCreateNewSourceFile: bool -> Ts.SourceFile option - abstract getSourceFileByPath: fileName: string * path: Ts.Path * languageVersion: Ts.ScriptTarget * ?onError: (string -> unit) * ?shouldCreateNewSourceFile: bool -> Ts.SourceFile option - abstract getDefaultLibFileName: options: Ts.CompilerOptions -> string - abstract useCaseSensitiveFileNames: unit -> bool - abstract getCanonicalFileName: fileName: string -> string - abstract getCurrentDirectory: unit -> string - abstract getNewLine: unit -> string - abstract fileExists: fileName: string -> bool - abstract readFile: fileName: string -> string option - abstract directoryExists: directoryName: string -> bool - abstract getDirectories: path: string -> ResizeArray - let options = jsOptions(fun o -> o.target <- Some Ts.ScriptTarget.Latest o.noEmit <- Some true + o.moduleResolution <- Some Ts.ModuleResolutionKind.Node12 + //o.traceResolution <- Some true ) -let createProgram (tsPaths: string[]) (sourceFiles: Ts.SourceFile[]) = - let host = - { new ICompilerHost with - member _.getSourceFile(fileName, _, ?__, ?___) = - sourceFiles |> Array.tryFind (fun sf -> sf.fileName = fileName) - member _.getSourceFileByPath(fileName, _, _, ?__, ?___) = - sourceFiles |> Array.tryFind (fun sf -> sf.fileName = fileName) - member _.getDefaultLibFileName(_) = "lib.d.ts" - member _.useCaseSensitiveFileNames() = false - member _.getCanonicalFileName(s) = s - member _.getCurrentDirectory() = "" - member _.getNewLine() = "\r\n" - member _.fileExists(fileName) = Array.contains fileName tsPaths - member _.readFile(fileName) = sourceFiles |> Array.tryPick (fun sf -> if sf.fileName = fileName then Some (sf.getFullText()) else None) - member _.directoryExists(_) = true - member _.getDirectories(_) = ResizeArray [] - } - ts.createProgram(ResizeArray tsPaths, options, !!host) - -/// works on NodeJS only. -let getAllLocalReferences (opts: GlobalOptions) (sourceFiles: Ts.SourceFile seq) = - let sourceFilesMap = new MutableMap<_, _>() - for sourceFile in sourceFiles do - sourceFilesMap.Add(Path.absolute sourceFile.fileName, sourceFile) - - let createSourceFile path = - ts.createSourceFile(path, Node.fs.readFileSync(path, "utf-8"), Ts.ScriptTarget.Latest, setParentNodes=true, scriptKind=Ts.ScriptKind.TS) - - let tryAdd (from: Ts.SourceFile) path = - let key = Path.absolute path - if not (sourceFilesMap.ContainsKey(key)) then - Log.tracef opts "* found '%s' referenced by '%s'" path from.fileName - let sourceFile = createSourceFile path - sourceFilesMap.Add(key, sourceFile) - Some sourceFile - else None - - for sourceFile in sourceFiles do - for file in sourceFile.referencedFiles do - Path.join [Path.dirname sourceFile.fileName; file.fileName] - |> tryAdd sourceFile |> ignore - - let tryFindDefinitionFile (sourceFile: Ts.SourceFile) relativePath = - let tryGet name = - let p = Path.join [Path.dirname sourceFile.fileName; name] - if Node.fs.existsSync(!^p) then Some p else None - tryGet $"{relativePath}.d.ts" - |> Option.orElseWith (fun () -> tryGet $"{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 - match tryFindDefinitionFile sourceFile specifier with - | None -> None - | Some path -> tryAdd sourceFile path - 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 = - for statement in sourceFile.statements do - go sourceFile statement |> ignore - - for sourceFile in sourceFiles do goSourceFile sourceFile - - sourceFilesMap.Values |> Seq.toArray |> Array.map (fun v -> v.fileName, v) |> Array.unzip +open Yargs let parse (opts: GlobalOptions) (argv: string[]) : Input = - let program = - let inputs = argv |> Seq.map (fun a -> a, Node.fs.readFileSync(a, "utf-8")) - let argv, srcs = - inputs - |> Seq.map (fun (a, i) -> - ts.createSourceFile (a, i, Ts.ScriptTarget.Latest, setParentNodes=true, scriptKind=Ts.ScriptKind.TS)) - |> fun srcs -> - if not opts.followRelativeReferences then argv, Array.ofSeq srcs - else - Log.tracef opts "* following relative references..." - getAllLocalReferences opts srcs - createProgram argv srcs - - let srcs = program.getSourceFiles() - let checker = program.getTypeChecker() - - let sources = - srcs - |> Seq.toList - |> List.map (fun src -> - Log.tracef opts "* parsing %s..." src.fileName - let references = - Seq.concat [ - src.referencedFiles |> Seq.map (fun x -> FileReference x.fileName) - src.typeReferenceDirectives |> Seq.map (fun x -> TypeReference x.fileName) - src.libReferenceDirectives |> Seq.map (fun x -> LibReference x.fileName) - ] |> Seq.toList - let statements = - src.statements - |> Seq.collect (Parser.readStatement !!{| verbose = opts.verbose; checker = checker; sourceFile = src; nowarn = opts.nowarn; followRelativeReferences = false; merge = false |}) - |> Seq.toList - { statements = statements - fileName = Path.relative src.fileName - moduleName = src.moduleName - hasNoDefaultLib = src.hasNoDefaultLib - references = references }) - - let info = - match sources with - | example :: _ -> JsHelper.getPackageInfo example.fileName - | [] -> None - - { sources = sources; info = info } -open Yargs + let ctx = createBaseContext opts + Parser.createContextFromFiles ctx options argv |> Parser.parse [] let main argv = @@ -163,7 +28,6 @@ let main argv = .parserConfiguration({| ``parse-positional-numbers`` = false |}) .config() |> GlobalOptions.register - |> Typer.TyperOptions.register |> Target.register parse Targets.JsOfOCaml.Target.target |> Target.register parse Targets.ParserTest.target yargs.demandCommand(1.0).scriptName("ts2ocaml").help().argv |> ignore diff --git a/src/Parser.fs b/src/Parser.fs index 3ca5722d..59a1fe05 100755 --- a/src/Parser.fs +++ b/src/Parser.fs @@ -117,33 +117,90 @@ let rec extractNestedName (node: Node) = yield! extractNestedName child } +let getKindFromSymbol (ctx: ParserContext) (s: Ts.Symbol) = + let inline check (superset: Ts.SymbolFlags) (subset: Ts.SymbolFlags) = int (subset &&& superset) > 0 + let rec go (symbol: Ts.Symbol) = + let flags = symbol.getFlags() + if flags = Ts.SymbolFlags.Alias then + try + let symbol = ctx.checker.getAliasedSymbol symbol + if isNullOrUndefined symbol then None + else + go symbol + with _ -> None + else if check Ts.SymbolFlags.Transient flags then None + else + let kinds = [ + if flags |> check Ts.SymbolFlags.Type then Kind.Type + if flags |> check Ts.SymbolFlags.Value then Kind.Value + if flags |> check (Ts.SymbolFlags.Class ||| Ts.SymbolFlags.Interface) then Kind.ClassLike + if flags |> check Ts.SymbolFlags.ClassMember then Kind.ClassLikeMember + if flags |> check Ts.SymbolFlags.Enum then Kind.Enum + if flags |> check Ts.SymbolFlags.Module then Kind.Module + if flags |> check Ts.SymbolFlags.EnumMember then Kind.EnumCase + ] + Some (Set.ofList kinds) + go s + +let getFullName (ctx: ParserContext) (nd: Node) = + match ctx.checker.getSymbolAtLocation nd with + | None -> + printfn " x %s" (nd.getText()) + None + | Some s -> + let normalizeQualifiedName (fileNames: string list) (s: string) = + s + |> String.split "." + |> List.ofArray + |> function + | x :: xs when x.StartsWith("\"") -> + let basenames = fileNames |> List.map JsHelper.stripExtension + if basenames |> List.exists (fun basename -> x.EndsWith(basename + "\"")) then xs + else x.Trim('"') :: xs + | xs -> xs + let rec go indent (s: Ts.Symbol) = + let getSources (s: Ts.Symbol) = + s.declarations + |> Option.toList + |> List.collect (fun decs -> + decs |> Seq.map (fun dec -> dec.getSourceFile()) |> List.ofSeq) + |> List.map (fun x -> Path.relative x.fileName) + |> List.distinct + let sources = getSources s + let fullName = + ctx.checker.getFullyQualifiedName s + |> normalizeQualifiedName sources + let kinds = getKindFromSymbol ctx s + let kindText = + match kinds with + | None -> "unknown" + | Some xs -> xs |> Set.toList |> List.map Enum.pp |> String.concat ", " + if sources = [Path.relative ctx.sourceFile.fileName] then + printfn "%s- %s (%s)" (String.replicate indent " ") (fullName |> String.concat ".") kindText + else + printfn "%s- %s (%s) from %A" (String.replicate indent " ") (fullName |> String.concat ".") kindText sources + let roots = ctx.checker.getRootSymbols(s) + try + let s = ctx.checker.getAliasedSymbol(s) + if not (ctx.checker.isUnknownSymbol s || ctx.checker.isUndefinedSymbol s) then + roots.Add(s) + with + _ -> () + for s' in roots do + if getSources s' <> sources then + go (indent+1) s' |> ignore + fullName + + let s = ctx.checker.getExportSymbolOfSymbol s + let fullName = go 1 s + Some fullName + let getKindFromIdentifier (ctx: ParserContext) (i: Ts.Identifier) : Set option = match ctx.checker.getSymbolAtLocation i with | None -> nodeWarn ctx i "failed to get the kind of an imported identifier '%s'" i.text None - | Some s -> - let inline check (superset: Ts.SymbolFlags) (subset: Ts.SymbolFlags) = int (subset &&& superset) > 0 - let rec go (symbol: Ts.Symbol) = - let flags = symbol.getFlags() - if flags = Ts.SymbolFlags.Alias then - try - let symbol = ctx.checker.getAliasedSymbol symbol - if isNullOrUndefined symbol then None - else - go symbol - with _ -> None - else if check Ts.SymbolFlags.Transient flags then None - else - let kinds = [ - if flags |> check Ts.SymbolFlags.Type then Kind.Type - if flags |> check Ts.SymbolFlags.Value then Kind.Value - if flags |> check (Ts.SymbolFlags.Class ||| Ts.SymbolFlags.Interface) then Kind.ClassLike - if flags |> check Ts.SymbolFlags.Enum then Kind.Enum - if flags |> check Ts.SymbolFlags.Module then Kind.Module - ] - Some (Set.ofList kinds) - go s + | Some s -> getKindFromSymbol ctx s let sanitizeCommentText str : string list = str |> String.toLines |> List.ofArray @@ -306,7 +363,7 @@ let rec readTypeNode (typrm: Set) (ctx: ParserContext) (t: Ts.TypeNode) | [] -> nodeError lhs "cannot parse node '%s' as identifier" (lhs.getText()) | ts -> let loc = Node.location lhs - let lt = { name = ts; fullName = None; loc = loc } + let lt = { name = ts; fullName = getFullName ctx lhs; loc = loc } match t.typeArguments with | None -> Ident lt | Some args -> App (AIdent lt, args |> Seq.map (readTypeNode typrm ctx) |> List.ofSeq, Node.location t) @@ -386,7 +443,7 @@ let rec readTypeNode (typrm: Set) (ctx: ParserContext) (t: Ts.TypeNode) let t = t :?> Ts.TypeQueryNode let nameNode = box t.exprName :?> Node let name = extractNestedName nameNode - Erased (TypeQuery ({ name = List.ofSeq name; fullName = None; loc = Node.location nameNode }), Node.location t, t.getText()) + Erased (TypeQuery ({ name = List.ofSeq name; fullName = getFullName ctx nameNode; loc = Node.location nameNode }), Node.location t, t.getText()) // fallbacks | Kind.TypePredicate -> nodeWarn ctx t "type predicate is not supported and treated as boolean" @@ -672,7 +729,7 @@ let readVariable (ctx: ParserContext) (v: Ts.VariableStatement) : Statement list match getBindingName vd.name with | None -> nodeWarn ctx vd "name is not defined for variable" - UnknownStatement {| msg = Some (vd.getText()); loc = Node.location vd; comments = comments |} + UnknownStatement {| origText = Some (vd.getText()); loc = Node.location vd; comments = comments |} | Some name -> let ty = match vd.``type`` with @@ -723,7 +780,7 @@ let readExportAssignment (ctx: ParserContext) (e: Ts.ExportAssignment) : Stateme match extractNestedName e.expression |> Seq.toList with | [] -> nodeWarn ctx e.expression "cannot parse node '%s' as identifier" (e.expression.getText()); None | ts -> - let ident = { name = ts; fullName = None; loc = Node.location e.expression } + let ident = { name = ts; fullName = getFullName ctx e.expression; loc = Node.location e.expression } match e.isExportEquals with | Some true -> Export { clause = CommonJsExport ident; loc = Node.location e; comments = comments; origText = e.getText() } |> Some | _ -> Export { clause = ES6DefaultExport ident; loc = Node.location e; comments = comments; origText = e.getText() } |> Some @@ -744,7 +801,7 @@ let readExportDeclaration (ctx: ParserContext) (e: Ts.ExportDeclaration) : State let nes = bindings |> box :?> Ts.NamedExports nes.elements |> Seq.map (fun x -> - let ident (name: Ts.Identifier) = { name = [name.text]; fullName = None; loc = Node.location name } + let ident (name: Ts.Identifier) = { name = [name.text]; fullName = getFullName ctx name; loc = Node.location name } match x.propertyName with | None -> {| target = ident x.name; renameAs = None |} | Some propertyName -> {| target = ident propertyName; renameAs = Some x.name.text |}) @@ -872,7 +929,7 @@ let rec readModule (ctx: ParserContext) (md: Ts.ModuleDeclaration) : Module = and readStatement (ctx: ParserContext) (stmt: Ts.Statement) : Statement list = let onError () = let comments = readCommentsForNamedDeclaration ctx (stmt :?> Ts.DeclarationStatement) - UnknownStatement {| msg = Some (stmt.getText()); loc = Node.location stmt; comments = comments |} + UnknownStatement {| origText = Some (stmt.getText()); loc = Node.location stmt; comments = comments |} try match stmt.kind with | Kind.TypeAliasDeclaration -> [readTypeAlias ctx (stmt :?> _) |> TypeAlias] diff --git a/src/Target.fs b/src/Target.fs index 616665c4..13974ce5 100644 --- a/src/Target.fs +++ b/src/Target.fs @@ -1,5 +1,7 @@ module Target +open Ts2Ml +open Common open Syntax open Yargs @@ -7,11 +9,14 @@ type ITarget<'Options when 'Options :> GlobalOptions> = abstract Command: string abstract Description: string abstract Builder: (Argv<'Options> -> Argv<'Options>) - abstract Run: input: Input * options:'Options -> unit + abstract Run: input: Input * baseCtx:IContext<'Options> -> unit open Fable.Core open Fable.Core.JsInterop +let inline has name value = + isIn name value + let register (parse: GlobalOptions -> string[] -> Input) (target: ITarget<'TargetOptions>) (argv: Argv<'Options>) : Argv<'Options> when 'Options :> GlobalOptions and 'TargetOptions :> GlobalOptions = @@ -25,7 +30,8 @@ let register (parse: GlobalOptions -> string[] -> Input) (target: ITarget<'Targe let inputs = argv.["inputs"] :?> string[] try let input = parse !!argv.Options inputs - target.Run(input, !!argv.Options) + let baseCtx = createBaseContext !!argv.Options + target.Run(input, baseCtx) with e -> eprintfn "%s" e.StackTrace diff --git a/src/Targets/JsOfOCaml/Common.fs b/src/Targets/JsOfOCaml/Common.fs index 2dd5dedb..b39b096f 100644 --- a/src/Targets/JsOfOCaml/Common.fs +++ b/src/Targets/JsOfOCaml/Common.fs @@ -1,6 +1,7 @@ module Targets.JsOfOCaml.Common open Fable.Core +open Ts2Ml open DataTypes [] @@ -116,12 +117,12 @@ module Options = | Some p -> Log.tracef opts "* using the preset '%s'." !!p - if opts.simplify = [] then - opts.simplify <- [Simplify.All] let subtypingIsDefault = opts.subtyping = [] - if p = Preset.Minimal || p = Preset.Full then + if p = Preset.Minimal || p = Preset.Safe || p = Preset.Full then + if opts.simplify = [] then + opts.simplify <- [Simplify.All] if opts.recModule = RecModule.Default then opts.recModule <- RecModule.Optimized diff --git a/src/Targets/JsOfOCaml/OCamlHelper.fs b/src/Targets/JsOfOCaml/OCamlHelper.fs index ca708b48..4e49de06 100644 --- a/src/Targets/JsOfOCaml/OCamlHelper.fs +++ b/src/Targets/JsOfOCaml/OCamlHelper.fs @@ -1,6 +1,7 @@ module Targets.JsOfOCaml.OCamlHelper open System +open Ts2Ml open Syntax open Targets.JsOfOCaml.Common open DataTypes @@ -25,9 +26,6 @@ let docCommentStr text =tprintf "(** %s *)" text let [] pv_head = "`" -[] -let inline TODO<'a> = failwith "TODO" - [] module Attr = type Category = Normal | Block | Floating @@ -270,6 +268,10 @@ let typeAlias name tyargs ty = + (if List.isEmpty tyargs then str name else Type.app (str name) tyargs) +@ " = " + ty +let moduleAlias name target = + let text = tprintf "module %s = %s" name target + Attr.js_stop_start_implem_oneliner text text + let val_ name ty = tprintf "val %s: " name + ty @@ -327,14 +329,16 @@ module Naming = "Export"; "Default" ] |> Set.union Naming.Keywords.keywords - let moduleName (name: string) = + let moduleNameReserved (name: string) = let name = removeInvalidChars name - let result = - if Char.IsLower name.[0] then - sprintf "%c%s" (Char.ToUpper name.[0]) name.[1..] - else if name.[0] = '_' then - "M" + name - else name + if Char.IsLower name.[0] then + sprintf "%c%s" (Char.ToUpper name.[0]) name.[1..] + else if name.[0] = '_' then + "M" + name + else name + + let moduleName (name: string) = + let result = moduleNameReserved name if reservedModuleNames |> Set.contains result then result + "_" else result let constructorName (name: string list) = @@ -382,4 +386,10 @@ module Naming = let jsModuleNameToOCamlModuleName (jsModuleName: string) = jsModuleName |> jsModuleNameToOCamlName - |> moduleName \ No newline at end of file + |> moduleName + + let exportDefaultClassStubName = "__export_default_class__" + +module Kind = + let generatesOCamlModule kind = + Set.intersect kind (Set.ofList [Kind.Type; Kind.ClassLike; Kind.Module]) |> Set.isEmpty |> not \ No newline at end of file diff --git a/src/Targets/JsOfOCaml/Target.fs b/src/Targets/JsOfOCaml/Target.fs index ec8c0f88..329b578d 100644 --- a/src/Targets/JsOfOCaml/Target.fs +++ b/src/Targets/JsOfOCaml/Target.fs @@ -1,5 +1,6 @@ module Targets.JsOfOCaml.Target +open Ts2Ml open Syntax open DataTypes @@ -11,10 +12,10 @@ open Fable.Core.JsInterop let private builder (argv: Yargs.Argv) : Yargs.Argv = argv |> Options.register -let private run (input: Input) (options: Options) = +let private run (input: Input) (ctx: IContext) = let outputDir = let curdir = Node.Api.``process``.cwd() - match options.outputDir with + match ctx.options.outputDir with | None -> curdir | Some dir -> let path = @@ -30,28 +31,28 @@ let private run (input: Input) (options: Options) = let results = let result = - if options.createMinimalStdlib then + if ctx.options.createMinimalStdlib then [{ fileName = "ts2ocaml_min.mli"; content = Text.str stdlib; stubLines = [] }] else [] if List.isEmpty input.sources then result - else if options.stdlib then - result @ emitStdlib input options + else if ctx.options.stdlib then + result @ emitStdlib input ctx else - result @ emit input options + result @ emit input ctx if results = [] then - Log.warnf options "no input files are given." + ctx.logger.warnf "no input files are given." for result in results do let fullPath = Node.Api.path.join[|outputDir; result.fileName|] - Log.tracef options "* writing the binding to '%s'..." fullPath + ctx.logger.tracef "* writing the binding to '%s'..." fullPath Node.Api.fs.writeFileSync(fullPath, Text.toString 2 result.content) let newStubLines = results |> List.collect (fun result -> result.stubLines) |> Set.ofList if not (Set.isEmpty newStubLines) then - let stubFile = Node.Api.path.join [|outputDir; options.stubFile|] + let stubFile = Node.Api.path.join [|outputDir; ctx.options.stubFile|] let existingStubLines = if not (Node.Api.fs.existsSync(!^stubFile)) then Set.empty else if Node.Api.fs.lstatSync(!^stubFile).isFile() then @@ -62,7 +63,7 @@ let private run (input: Input) (options: Options) = failwithf "The path '%s' is not a file." stubFile let stubLines = Set.union existingStubLines newStubLines if stubLines <> existingStubLines then - Log.tracef options "* writing the stub file to '%s'..." stubFile + ctx.logger.tracef "* writing the stub file to '%s'..." stubFile let stub = stubLines |> String.concat Node.Api.os.EOL Node.Api.fs.writeFileSync(stubFile, stub) diff --git a/src/Targets/JsOfOCaml/Writer.fs b/src/Targets/JsOfOCaml/Writer.fs index 9f23b845..591660f0 100644 --- a/src/Targets/JsOfOCaml/Writer.fs +++ b/src/Targets/JsOfOCaml/Writer.fs @@ -1,5 +1,6 @@ module Targets.JsOfOCaml.Writer +open Ts2Ml open Syntax open Typer open Typer.Type @@ -15,16 +16,15 @@ type State = {| fileNames: string list info: Result referencesCache: MutableMap> - usedAnonymousInterfacesCache: MutableMap> |} module State = let create fileNames info : State = {| fileNames = fileNames info = info - referencesCache = new MutableMap<_, _>(); - usedAnonymousInterfacesCache = new MutableMap<_, _>() |} + referencesCache = new MutableMap<_, _>() |} -type Context = Context +type Context = TyperContext +module Context = TyperContext let emitCommentBody (c: Comment) : text = // https://github.com/ocaml/ocaml/issues/5745 @@ -77,7 +77,7 @@ let literalToIdentifier (ctx: Context) (l: Literal) : text = |> String.replace "." "_" match l with | LString s -> - match ctx.typeLiteralsMap |> Map.tryFind l with + match ctx |> Context.bindCurrentSourceInfo (fun i -> i.typeLiteralsMap |> Map.tryFind l) with | Some i -> if String.forall (Char.isAlphabetOrDigit >> not) s then tprintf "s%i" i else tprintf "s%i_%s" i (formatString s) @@ -88,15 +88,14 @@ let literalToIdentifier (ctx: Context) (l: Literal) : text = let anonymousInterfaceModuleName (index: int) = sprintf "AnonymousInterface%d" index -let anonymousInterfaceToIdentifier (ctx: Context) (c: Class) : text = - match ctx.anonymousInterfacesMap |> Map.tryFind c, c.name with - | Some i, None -> +let anonymousInterfaceToIdentifier (ctx: Context) (a: AnonymousInterface) : text = + match ctx |> Context.bindCurrentSourceInfo (fun i -> i.anonymousInterfacesMap |> Map.tryFind a) with + | Some i -> if not ctx.options.recModule.IsOffOrDefault then - tprintf "%s.t" (anonymousInterfaceModuleName i) + tprintf "%s.t" (anonymousInterfaceModuleName i.id) else - tprintf "anonymous_interface_%d" i - | None, None -> failwithf "the anonymous interface '%A' is not found in the context" c - | _, Some n -> failwithf "the class or interface '%s' is not anonymous" n + tprintf "anonymous_interface_%d" i.id + | None -> failwithf "impossible_anonymousInterfaceToIdentifier(%s)" a.loc.AsString let enumCaseToIdentifier (e: Enum) (c: EnumCase) = let duplicateCases = @@ -183,11 +182,20 @@ let rec emitTypeImpl (flags: EmitTypeFlags) (overrideFunc: OverrideFunc) (ctx: C yield pv_head @+ name + attr ]) + forceSkipAttr (str " [@js.enum]") |> between "(" ")" - let treatIdent { name = name; fullName = fno; loc = identLoc } (tyargs: Type list) (loc: Location) = + let treatIdent (i: Ident) (tyargs: Type list) (loc: Location) = let arity = List.length tyargs let withTyargs ty = Type.appOpt ty (tyargs |> List.map (emitTypeImpl { flags with needParen = true; forceVariadic = false } overrideFunc ctx)) - match fno with + let origin = + Ident.pickDefinitionWithFullName ctx i (fun fn -> function + | _ when fn.source <> ctx.currentSourceFile -> None + | Definition.Class { typeParams = tps; loc = loc } + | Definition.TypeAlias { typeParams = tps; loc = loc } -> Some (fn, tps, loc) + | Definition.Enum { loc = loc } + | Definition.EnumCase ({ loc = loc }, _) -> Some (fn, [], loc) + | _ -> None + ) + match origin with | None -> let tyName = let fallback () = @@ -196,38 +204,43 @@ let rec emitTypeImpl (flags: EmitTypeFlags) (overrideFunc: OverrideFunc) (ctx: C | FeatureFlag.Full | FeatureFlag.Consume -> Naming.createTypeNameOfArity arity None "t" | _ -> "t" - Naming.structured Naming.moduleName name + "." + tyName |> str - match name with + Naming.structured Naming.moduleName i.name + "." + tyName |> str + match i.name with | [name] -> match PrimType.FromJSClassName name with | Some p -> emitTypeImpl flags overrideFunc ctx (Prim p) | None -> fallback () | _ -> fallback () tyName |> withTyargs - | Some fn -> - if not ctx.options.recModule.IsOffOrDefault then - let maxArity = - FullName.tryLookupWith ctx fn (function - | AliasName { typeParams = tps } - | ClassName { typeParams = tps } -> List.length tps |> Some - | _ -> None - ) - let tyName = Naming.createTypeNameOfArity arity maxArity "t" - match ctx |> Context.getRelativeNameTo fn with - | Ok relativeName -> - assert (relativeName = name) - Naming.structured Naming.moduleName relativeName + "." + tyName |> str |> withTyargs - | Error diff -> - if List.isEmpty diff then - // the type is the current namespace + | Some (fn, typrms, origLoc) -> + if ctx.options.recModule.IsOffOrDefault then + let name = Naming.flattenedTypeName fn.name + let ts = + assignTypeParams fn.name (origLoc ++ loc) typrms tyargs + (fun _ t -> t) + (fun tv -> + match tv.defaultType with + | Some t -> t + | None -> failwithf "error: insufficient type params for type '%s' at %s" (String.concat "." fn.name) loc.AsString) + Type.appOpt (str name) (ts |> List.map (emitTypeImpl { flags with needParen = true; forceVariadic = false } overrideFunc ctx)) + else + let maxArity = List.length typrms + let tyName = Naming.createTypeNameOfArity arity (Some maxArity) "t" + let simple name = + Naming.structured Naming.moduleName name + "." + tyName |> str |> withTyargs + if fn.source <> ctx.currentSourceFile then simple fn.name + else + match ctx |> Context.getRelativeNameTo fn.name with + | Ok relativeName -> simple relativeName + | Error [] -> // the type is the current namespace tyName |> str |> withTyargs - else + | Error diff -> if ctx.options.subtyping |> List.contains Subtyping.Tag then // the type is a parent of the current namespace. // we expand the identifier to `[ .. ] intf` let ty = - if List.isEmpty tyargs then Ident { name = name; fullName = fno; loc = loc } - else App (AIdent { name = name; fullName = fno; loc = identLoc }, tyargs, loc) + if List.isEmpty tyargs then Ident i + else App (AIdent i, tyargs, loc) let labels = getAllInheritancesAndSelf ctx ty |> getLabelsFromInheritingTypes (emitTypeImpl flags overrideFunc) ctx @@ -235,27 +248,11 @@ let rec emitTypeImpl (flags: EmitTypeFlags) (overrideFunc: OverrideFunc) (ctx: C |> List.singleton |> Type.app Type.intf else - let fn = String.concat "." fn + let fn = String.concat "." fn.name let selfName = String.concat "." diff let warnText = $"cannot reference a type {fn} from its sub-namespace {selfName}" Log.warnf ctx.options "%s at %s" warnText loc.AsString commentStr warnText + Type.any - else - let name = Naming.flattenedTypeName fn - let ts = - FullName.tryLookupWith ctx fn (function - | AliasName { typeParams = tps; loc = origLoc } - | ClassName { typeParams = tps; loc = origLoc } -> - assignTypeParams fn (origLoc ++ loc) tps tyargs - (fun _ t -> t) - (fun tv -> - match tv.defaultType with - | Some t -> t - | None -> failwithf "error: insufficient type params for type '%s' at %s" (String.concat "." fn) loc.AsString) - |> Some - | _ -> None - ) |> Option.defaultValue tyargs - Type.appOpt (str name) (ts |> List.map (emitTypeImpl { flags with needParen = true; forceVariadic = false } overrideFunc ctx)) match overrideFunc (emitTypeImpl flags overrideFunc) ctx ty with | Some t -> t @@ -314,14 +311,14 @@ let rec emitTypeImpl (flags: EmitTypeFlags) (overrideFunc: OverrideFunc) (ctx: C | true, false -> Type.app Type.null_ [t] | false, true -> Type.app Type.undefined [t] | false, false -> t - let treatTypeofableTypes (ts: Set) t = + let treatTypeofableTypes (ts: Set) t = let emitOr tt t = match tt with - | TNumber -> Type.number_or t - | TString -> Type.string_or t - | TBoolean -> Type.boolean_or t - | TSymbol -> Type.symbol_or t - | TBigInt -> Type.bigint_or t + | Typeofable.Number -> Type.number_or t + | Typeofable.String -> Type.string_or t + | Typeofable.Boolean -> Type.boolean_or t + | Typeofable.Symbol -> Type.symbol_or t + | Typeofable.BigInt -> Type.bigint_or t let rec go = function | [] -> t | [x] -> @@ -383,7 +380,7 @@ let rec emitTypeImpl (flags: EmitTypeFlags) (overrideFunc: OverrideFunc) (ctx: C | AnonymousInterface a -> anonymousInterfaceToIdentifier ctx a | PolymorphicThis -> commentStr "FIXME: polymorphic this" + Type.any | Intrinsic -> Type.ojs_t - | Function f -> + | Func (f, [], _) -> let renamer = new OverloadRenamer(used=(flags.avoidTheseArgumentNames |> Set.map (fun s -> "value", s))) let inline rename x = renamer.Rename "value" x // warning 16 (this optional argument cannot be erased) is widened since OCaml 4.12: @@ -424,7 +421,7 @@ let rec emitTypeImpl (flags: EmitTypeFlags) (overrideFunc: OverrideFunc) (ctx: C f.args |> List.choose (function Choice1Of2 x -> Some x.name | Choice2Of2 _ -> None) |> Set.ofList let x = emitTypeImpl { flags with needParen = false; avoidTheseArgumentNames = argNames } overrideFunc ctx f.returnType match f.returnType with - | Function _ -> between "(" ")" (x + forceSkipAttr (str " [@js.dummy]")) + | Func _ -> between "(" ")" (x + forceSkipAttr (str " [@js.dummy]")) | _ -> x let result = lhs +@ " -> " + rhs if flags.needParen then result |> between "(" ")" else result @@ -435,6 +432,8 @@ let rec emitTypeImpl (flags: EmitTypeFlags) (overrideFunc: OverrideFunc) (ctx: C | [t] -> emitTypeImpl flags overrideFunc ctx t.value | ts -> Type.tuple (ts |> List.map (fun x -> emitTypeImpl flags overrideFunc ctx x.value)) | Erased (_, loc, origText) -> failwithf "impossible_emitTypeImpl_erased: %s (%s)" loc.AsString origText + | Func (_, _ :: _, loc) -> failwithf "impossible_emitTypeImpl_Func_poly: %s (%s)" loc.AsString (Type.pp ty) + | NewableFunc (_, _, loc) -> failwithf "impossible_emitTypeImpl_NewableFunc: %s (%s)" loc.AsString (Type.pp ty) | UnknownType msgo -> match msgo with None -> commentStr "FIXME: unknown type" + Type.any | Some msg -> commentStr (sprintf "FIXME: unknown type '%s'" msg) + Type.any @@ -480,9 +479,7 @@ and getLabelsFromInheritingTypes (emitType_: TypeEmitter) (ctx: Context) (inheri for e in inheritingTypes do match e with | InheritingType.KnownIdent i -> - yield str pv_head + emitCase i.fullName (i.tyargs |> List.map (emitType_ ctx)) |> Case - | InheritingType.ImportedIdent i -> - yield emitTagType i.name i.tyargs |> TagType + yield str pv_head + emitCase i.fullName.name (i.tyargs |> List.map (emitType_ ctx)) |> Case | InheritingType.UnknownIdent i -> yield emitTagType i.name i.tyargs |> TagType | InheritingType.Prim (p, ts) -> @@ -494,16 +491,16 @@ and getLabelsFromInheritingTypes (emitType_: TypeEmitter) (ctx: Context) (inheri ] /// `Choice2Of2` when it is an alias to a non-JSable prim type. -and getLabelsOfFullName emitType_ (ctx: Context) (fullName: string list) (typeParams: TypeParam list) = +and getLabelsOfFullName emitType_ (ctx: Context) (fullName: FullName) (typeParams: TypeParam list) = let normalClass () = getAllInheritancesAndSelfFromName ctx fullName |> getLabelsFromInheritingTypes emitType_ ctx - match fullName with + match fullName.name with | [name] when ctx.options.stdlib && Map.containsKey name Type.nonJsablePrimTypeInterfaces && typeParams |> List.isEmpty -> let prim = Type.nonJsablePrimTypeInterfaces |> Map.find name Choice2Of2 (prim, Case (tprintf "%s%s" pv_head name)) | _ -> Choice1Of2 (normalClass () |> List.sort) -and getLabelOfFullName emitType_ (ctx: Context) fullName (typeParams: TypeParam list) = - match fullName with +and getLabelOfFullName emitType_ (ctx: Context) (fullName: FullName) (typeParams: TypeParam list) = + match fullName.name with | [name] when ctx.options.stdlib && Map.containsKey name Type.nonJsablePrimTypeInterfaces && typeParams |> List.isEmpty -> let prim = Type.nonJsablePrimTypeInterfaces |> Map.find name Choice2Of2 (prim, Case (tprintf "%s%s" pv_head name)) @@ -517,15 +514,11 @@ type StructuredTextItem = | ScopeIndependent of text | OverloadedText of (OverloadRenamer -> text list) -type ExportWithKind = {| - comments: Comment list - clause: ExportClause - loc: Location - origText: string - kind: Set -|} +type [] ExportItem = + | Statement of {| comments: Comment list; clauses: (ExportClause * Set) list; loc: Location; origText: string |} + | DefaultUnnamedClass of StructuredTextNode -type [] Scoped = +and [] Scoped = | Force of string | Yes | No @@ -538,22 +531,24 @@ with | Force s, _ | _, Force s -> Force s | Yes, _ | _, Yes -> Yes -type StructuredTextNode = {| +and StructuredTextNode = {| scoped: Scoped items: StructuredTextItem list docCommentLines: text list - exports: ExportWithKind list + exports: ExportItem list knownTypes: Set + anonymousInterfaces: Set |} module StructuredTextNode = let empty : StructuredTextNode = - {| scoped = Scoped.No; items = []; docCommentLines = []; exports = []; knownTypes = Set.empty |} + {| scoped = Scoped.No; items = []; docCommentLines = []; exports = []; knownTypes = Set.empty; anonymousInterfaces = Set.empty |} let union (a: StructuredTextNode) (b: StructuredTextNode) : StructuredTextNode = {| scoped = Scoped.union a.scoped b.scoped items = List.append a.items b.items docCommentLines = List.append a.docCommentLines b.docCommentLines exports = List.append a.exports b.exports - knownTypes = Set.union a.knownTypes b.knownTypes |} + knownTypes = Set.union a.knownTypes b.knownTypes + anonymousInterfaces = Set.union a.anonymousInterfaces b.anonymousInterfaces |} type StructuredText = Trie @@ -571,15 +566,16 @@ module StructuredText = match ctx.state.referencesCache.TryGetValue(ctx.currentNamespace) with | true, ts -> ts | false, _ -> - let fn = List.rev ctx.currentNamespace + let fn = ctx.currentNamespace let trie = x.value |> Option.map (fun v -> v.knownTypes |> Set.fold (fun state -> function - | KnownType.Ident ks -> state |> WeakTrie.add ks - | KnownType.AnonymousInterface i -> - state |> WeakTrie.add [anonymousInterfaceModuleName i] + | KnownType.Ident fn when fn.source = ctx.currentSourceFile -> state |> WeakTrie.add fn.name + | KnownType.AnonymousInterface (_, i) -> + state |> WeakTrie.add (i.path @ [anonymousInterfaceModuleName i.id]) + | _ -> state ) WeakTrie.empty) |> Option.defaultValue WeakTrie.empty let trie = @@ -591,7 +587,7 @@ module StructuredText = trie let getDependenciesOfChildren (ctx: Context) (x: StructuredText) : (string * string) list = - let parent = List.rev ctx.currentNamespace + let parent = ctx.currentNamespace x.children |> Map.fold (fun state k child -> let refs = @@ -602,7 +598,7 @@ module StructuredText = |> WeakTrie.toList |> List.map (function | [x] -> k, x - | xs -> failwithf "impossible_StructuredText_getDependencyGraphOfChildren_refs(%s): %A" (k :: ctx.currentNamespace |> List.rev |> String.concat ".") xs) + | xs -> failwithf "impossible_StructuredText_getDependencyGraphOfChildren_refs(%s): %A" (ctx |> Context.getFullNameString [k]) xs) refs :: state) [] |> List.rev |> List.concat @@ -616,7 +612,9 @@ module StructuredText = let removeLabels (xs: Choice list) = xs |> List.map (function Choice2Of2 t -> Choice2Of2 t | Choice1Of2 fl -> Choice2Of2 fl.value) -let rec emitMembers (emitType_: TypeEmitter) ctx (name: string) (selfTy: Type) (ma: MemberAttribute) m = [ +let inline func ft = Func (ft, [], ft.loc) + +let rec emitMembers (emitType_: TypeEmitter) ctx (selfTy: Type) (ma: MemberAttribute) m = [ let inline comments () = match ma.comments with | [] -> Seq.empty @@ -630,29 +628,29 @@ let rec emitMembers (emitType_: TypeEmitter) ctx (name: string) (selfTy: Type) ( OverloadedText (fun renamer -> f (renamer.Rename "value")) match m with - | Constructor (ft, typrm) -> - let ty = Function { args = ft.args; isVariadic = ft.isVariadic; returnType = selfTy; loc = ft.loc } |> emitType_ ctx + | Constructor (ft, _typrm) -> + let ty = func { args = ft.args; isVariadic = ft.isVariadic; returnType = selfTy; loc = ft.loc } |> emitType_ ctx yield! comments () yield overloaded (fun rename -> [val_ (rename "create") ty + str " " + Attr.js_create]) - | New (ft, typrm) -> - let ft = Function { ft with args = Choice2Of2 selfTy :: ft.args } |> emitType_ ctx + | Newable (ft, _typrm) -> + let ft = func { ft with args = Choice2Of2 selfTy :: ft.args } |> emitType_ ctx yield! comments () yield overloaded (fun rename -> [val_ (rename "create") ft + str " " + Attr.js_apply true]) - | Field ({ name = name; value = Function ft }, _, typrm) - | Method (name, ft, typrm) -> + | Field ({ name = name; value = Func (ft, _typrm, _) }, _) + | Method (name, ft, _typrm) -> let ty, attr = - if ma.isStatic then Function ft, Attr.js_global name + if ma.isStatic then func ft, Attr.js_global name else let ft = { ft with args = Choice2Of2 PolymorphicThis :: ft.args } - Function ft, Attr.js_call name + func ft, Attr.js_call name let ty = emitType_ ctx ty yield! comments () yield overloaded (fun rename -> [val_ (Naming.valueName name |> rename) ty + str " " + attr]) - | Getter fl | Field (fl, ReadOnly, _) -> + | Getter fl | Field (fl, ReadOnly) -> let fl = if fl.value <> Prim Void then fl else - Log.warnf ctx.options "the field/getter '%s' of type '%s' has type 'void' and treated as 'unknown'" fl.name name + ctx.logger.warnf "the field/getter '%s' at %s has type 'void' and treated as 'unknown'" fl.name ma.loc.AsString { fl with value = Prim Unknown } let ty = let args = @@ -661,36 +659,36 @@ let rec emitMembers (emitType_: TypeEmitter) ctx (name: string) (selfTy: Type) ( let ret = if fl.isOptional then Union { types = [fl.value; Prim Undefined] } else fl.value - Function { isVariadic = false; args = args; returnType = ret; loc = ma.loc } |> emitType_ ctx + func { isVariadic = false; args = args; returnType = ret; loc = ma.loc } |> emitType_ ctx yield! comments () yield overloaded (fun rename -> [val_ ("get_" + Naming.removeInvalidChars fl.name |> rename) ty + str " " + Attr.js_get fl.name]) - | Setter fl | Field (fl, WriteOnly, _) -> + | Setter fl | Field (fl, WriteOnly) -> let fl = if fl.value <> Prim Void then fl else - Log.warnf ctx.options "the field/setter '%s' of type '%s' has type 'void' and treated as 'unknown'" fl.name name + ctx.logger.warnf "the field/setter '%s' at '%s' has type 'void' and treated as 'unknown'" fl.name ma.loc.AsString { fl with value = Prim Unknown } let ty = let args = if ma.isStatic then [Choice2Of2 fl.value] else [Choice2Of2 PolymorphicThis; Choice2Of2 fl.value] - Function { isVariadic = false; args = args; returnType = Prim Void; loc = ma.loc } |> emitType_ ctx + func { isVariadic = false; args = args; returnType = Prim Void; loc = ma.loc } |> emitType_ ctx yield! comments () yield overloaded (fun rename -> [val_ ("set_" + Naming.removeInvalidChars fl.name |> rename) ty + str " " + Attr.js_set fl.name]) - | Field (fl, Mutable, _) -> - yield! emitMembers emitType_ ctx name selfTy ma (Getter fl) - yield! emitMembers emitType_ ctx name selfTy ma (Setter fl) - | FunctionInterface (ft, _) -> - let ft = Function { ft with args = Choice2Of2 PolymorphicThis :: ft.args } |> emitType_ ctx + | Field (fl, Mutable) -> + yield! emitMembers emitType_ ctx selfTy ma (Getter fl) + yield! emitMembers emitType_ ctx selfTy ma (Setter fl) + | Callable (ft, _typrm) -> + let ft = func { ft with args = Choice2Of2 PolymorphicThis :: ft.args } |> emitType_ ctx yield! comments () yield overloaded (fun rename -> [val_ (rename "apply") ft + str " " + Attr.js_apply false]) | Indexer (ft, ReadOnly) -> - let ft = Function { ft with args = Choice2Of2 PolymorphicThis :: removeLabels ft.args } |> emitType_ ctx + let ft = Func ({ ft with args = Choice2Of2 PolymorphicThis :: removeLabels ft.args }, [], ft.loc) |> emitType_ ctx yield! comments () yield overloaded (fun rename -> [val_ (rename "get") ft + str " " + Attr.js_index_get]) | Indexer (ft, WriteOnly) -> let ft = - Function { + func { args = Choice2Of2 PolymorphicThis :: removeLabels ft.args @ [ Choice2Of2 ft.returnType ] isVariadic = false; returnType = Prim Void; @@ -699,8 +697,8 @@ let rec emitMembers (emitType_: TypeEmitter) ctx (name: string) (selfTy: Type) ( yield! comments () yield overloaded (fun rename -> [val_ (rename "set") ft + str " " + Attr.js_index_set]) | Indexer (ft, Mutable) -> - yield! emitMembers emitType_ ctx name selfTy ma (Indexer (ft, ReadOnly)) - yield! emitMembers emitType_ ctx name selfTy ma (Indexer (ft, WriteOnly)) + yield! emitMembers emitType_ ctx selfTy ma (Indexer (ft, ReadOnly)) + yield! emitMembers emitType_ ctx selfTy ma (Indexer (ft, WriteOnly)) | SymbolIndexer _ -> () | UnknownMember msgo -> yield! comments () @@ -710,18 +708,19 @@ let rec emitMembers (emitType_: TypeEmitter) ctx (name: string) (selfTy: Type) ( | None -> () ] -let emitMappers ctx emitType tName (typrms: TypeParam list) = - let t_ident = - { name = [tName]; fullName = Some [tName]; loc = UnknownLocation } +let emitMappers (ctx: Context) emitType tName (typrms: TypeParam list) = + let t = + { name = [tName]; fullName = []; kind = None; loc = UnknownLocation; parent = None } let t_ty = - if List.isEmpty typrms then Ident t_ident - else App (AIdent t_ident, typrms |> List.map (fun typrm -> TypeVar typrm.name), UnknownLocation) - let ojs_t_ty = Ident { name = ["Ojs"; "t"]; fullName = Some ["Ojs"; "t"]; loc = UnknownLocation } + if List.isEmpty typrms then Ident t + else App (AIdent t, typrms |> List.map (fun typrm -> TypeVar typrm.name), UnknownLocation) + let ojs_t = { name = ["Ojs"; "t"]; fullName = []; kind = None; loc = UnknownLocation; parent = None } + let ojs_t_ty = Ident ojs_t let orf _emitType _ctx ty = match ty with - | Ident { name = ["Ojs"; "t"] } -> Some (str "Ojs.t") - | Ident i when i = t_ident -> Some (str tName) - | App (AIdent i, ts, _) when i = t_ident -> + | Ident i when i = ojs_t -> Some (str "Ojs.t") + | Ident i when i = t -> Some (str tName) + | App (AIdent i, ts, _) when i = t -> Type.app (str tName) (ts |> List.map (_emitType _ctx)) |> Some | _ -> None let emitType_ = emitType orf @@ -729,14 +728,14 @@ let emitMappers ctx emitType tName (typrms: TypeParam list) = let mapperArgs = typrms |> List.map (fun typrm -> if toJs then - Function { args = [Choice2Of2 (TypeVar typrm.name)]; returnType = ojs_t_ty; isVariadic = false; loc = UnknownLocation } |> Choice2Of2 + func { args = [Choice2Of2 (TypeVar typrm.name)]; returnType = ojs_t_ty; isVariadic = false; loc = UnknownLocation } |> Choice2Of2 else - Function { args = [Choice2Of2 ojs_t_ty]; returnType = TypeVar typrm.name; isVariadic = false; loc = UnknownLocation } |> Choice2Of2 + func { args = [Choice2Of2 ojs_t_ty]; returnType = TypeVar typrm.name; isVariadic = false; loc = UnknownLocation } |> Choice2Of2 ) if toJs then - Function { args = mapperArgs @ [Choice2Of2 t_ty]; returnType = ojs_t_ty; isVariadic = false; loc = UnknownLocation } + func { args = mapperArgs @ [Choice2Of2 t_ty]; returnType = ojs_t_ty; isVariadic = false; loc = UnknownLocation } else - Function { args = mapperArgs @ [Choice2Of2 ojs_t_ty]; returnType = t_ty; isVariadic = false; loc = UnknownLocation } + func { args = mapperArgs @ [Choice2Of2 ojs_t_ty]; returnType = t_ty; isVariadic = false; loc = UnknownLocation } [ val_ (sprintf "%s_to_js" tName) (emitType_ ctx (funTy true)) |> ScopeIndependent val_ (sprintf "%s_of_js" tName) (emitType_ ctx (funTy false)) |> ScopeIndependent @@ -801,18 +800,24 @@ module GetSelfTyText = let emitType_ = emitType overrideFunc let fallback = str "private Ojs.t" match c.name with - | Some name -> - assert (name = List.head ctx.currentNamespace) - + | Name name -> + assert (name = List.last ctx.currentNamespace) if ctx.options.subtyping |> List.contains Subtyping.Tag then let labels = - getLabelsOfFullName emitType_ ctx (List.rev ctx.currentNamespace) c.typeParams + getLabelsOfFullName emitType_ ctx (ctx |> Context.getFullName []) c.typeParams |> function Choice1Of2 xs -> xs | Choice2Of2 (_, x) -> [x] if List.isEmpty labels then fallback else Type.appOpt Type.intf [emitLabels ctx labels] + str " " + Attr.js_custom_typ (genJsCustomMapper c.typeParams) else fallback - | None -> fallback + | ExportDefaultUnnamedClass -> + let labels = + c.implements + |> List.map (getAllInheritancesAndSelf ctx) |> Set.unionMany + |> getLabelsFromInheritingTypes emitType_ ctx + if List.isEmpty labels then fallback + else + Type.appOpt Type.intf [emitLabels ctx labels] + str " " + Attr.js_custom_typ (genJsCustomMapper c.typeParams) let enumCases (e: Enum) (cases: EnumCase list) = let cases = @@ -828,9 +833,9 @@ module GetSelfTyText = yield pv_head @+ name @+ attr ]) +@ " [@js.enum]" -let getExportFromStatement (ctx: Context) (name: string) (kind: Kind list) (kindString: string) (s: Statement) : ExportWithKind option = +let getExportFromStatement (ctx: Context) (name: string) (kind: Kind list) (kindString: string) (s: Statement) : ExportItem option = let fn = ctx |> Context.getFullName [name] - let ident = { name = [name]; fullName = Some fn; loc = s.loc } + let ident = { name = [name]; fullName = [fn]; kind = Some (Set.ofList kind); parent = None; loc = s.loc } match s.isExported.AsExport ident with | None -> None | Some clause -> @@ -838,17 +843,22 @@ let getExportFromStatement (ctx: Context) (name: string) (kind: Kind list) (kind match clause with | ES6DefaultExport _ -> "export default" | _ -> "export" - Some {| comments = []; clause = clause; loc = s.loc; origText = sprintf "%s %s %s" prefix kindString name; kind = Set.ofList kind |} + Some (ExportItem.Statement {| comments = []; clauses = [clause, Set.ofList kind]; loc = s.loc; origText = sprintf "%s %s %s" prefix kindString name |}) + +type [] ClassKind<'a, 'b, 'c> = + | NormalClass of 'a + | ExportDefaultClass of 'b + | AnonymousInterface of 'c -let emitClass flags overrideFunc (ctx: Context) (current: StructuredText) (c: Class) (additionalMembers: Context -> EmitTypeFlags -> OverrideFunc -> list, additionalKnownTypes: Set, forceScoped: Scoped option) = +let emitClass flags overrideFunc (ctx: Context) (current: StructuredText) (c: ClassOrAnonymousInterface) (additionalMembers: Context -> EmitTypeFlags -> OverrideFunc -> list, additionalKnownTypes: Set, forceScoped: Scoped option) = let emitType orf ctx ty = emitTypeImpl flags orf ctx ty let typrms = List.map (fun (tp: TypeParam) -> TypeVar tp.name) c.typeParams - let name, isAnonymous, selfTy, overrideFunc = + let kind, selfTy, overrideFunc = match c.name with - | Some n -> - let k = List.rev (n :: ctx.currentNamespace) - let ident = { name = [n]; fullName = Some k; loc = UnknownLocation } + | Choice1Of2 (Name n) -> + let k = { name = (ctx |> Context.getFullName [n]).name; source = ctx.currentSourceFile } + let ident = { name = [n]; fullName = [k]; kind = Some (Set.ofList Kind.OfClass); parent = None; loc = UnknownLocation } let selfTy = if List.isEmpty c.typeParams then Ident ident else App (AIdent ident, typrms, UnknownLocation) @@ -856,47 +866,74 @@ let emitClass flags overrideFunc (ctx: Context) (current: StructuredText) (c: Cl if not ctx.options.recModule.IsOffOrDefault then overrideFunc else let orf _emitType _ctx = function - | Ident { name = [n']; fullName = Some k' } when n = n' && k = k' -> Some (str "t") - | App (AIdent { name = [n']; fullName = Some k' }, ts, _) when n = n' && k = k' -> + | Ident { name = [n']; fullName = fns } when n = n' && fns |> List.contains k -> Some (str "t") + | App (AIdent { name = [n']; fullName = fns }, ts, _) when n = n' && fns |> List.contains k -> Some (Type.appOpt (str "t") (List.map (_emitType _ctx) ts)) | _ -> None OverrideFunc.combine overrideFunc orf - n, false, selfTy, overrideFunc - | None -> - match ctx.anonymousInterfacesMap |> Map.tryFind c with + ClassKind.NormalClass {| name = n; orig = c.MapName(fun _ -> Name n) |}, + selfTy, + overrideFunc + | Choice1Of2 ExportDefaultUnnamedClass -> + ClassKind.ExportDefaultClass {| orig = c.MapName(fun _ -> ExportDefaultUnnamedClass) |}, + PolymorphicThis, + overrideFunc + | Choice2Of2 Anonymous -> + let ai = c.MapName (fun _ -> Anonymous) + match ctx |> Context.bindCurrentSourceInfo (fun info -> info.anonymousInterfacesMap |> Map.tryFind ai) with | None -> failwith "impossible_emitClass_unknown_anonymousInterface" | Some i -> let selfTy = - if List.isEmpty c.typeParams then AnonymousInterface c - else App (AAnonymousInterface c, typrms, UnknownLocation) + if List.isEmpty c.typeParams then AnonymousInterface ai + else App (AAnonymousInterface ai, typrms, UnknownLocation) let orf _emitType _ctx = function - | AnonymousInterface a when a = c -> Some (str "t") - | App (AAnonymousInterface a, ts, _) when a = c -> + | AnonymousInterface a when a = ai -> Some (str "t") + | App (AAnonymousInterface a, ts, _) when a = ai -> Some (Type.appOpt (str "t") (ts |> List.map (_emitType _ctx))) | _ -> None - anonymousInterfaceModuleName i, - true, + ClassKind.AnonymousInterface {| + name = anonymousInterfaceModuleName i.id + orig = c.MapName(fun _ -> Anonymous) + |}, selfTy, OverrideFunc.combine overrideFunc orf - let knownTypes = Statement.getKnownTypes ctx [ClassDef c] |> Set.union additionalKnownTypes + let knownTypes = + let dummy = c.MapName(fun _ -> ExportDefaultUnnamedClass) + Statement.getKnownTypes ctx [Class dummy] |> Set.union additionalKnownTypes + + let isAnonymous = + match kind with + | ClassKind.AnonymousInterface _ -> true + | _ -> false let node = let ctx, innerCtx = (), - {| (ctx |> Context.ofChildNamespace name) with - options = - if not isAnonymous then ctx.options - else - // no need to generate t_n types for anonymous interfaces - ctx.options |> JS.cloneWith (fun o -> o.safeArity <- o.safeArity.WithProvide(false)) |} - + ctx + |> (match kind with + | ClassKind.NormalClass x -> Context.ofChildNamespace x.name + | ClassKind.AnonymousInterface x -> Context.ofChildNamespace x.name + | ClassKind.ExportDefaultClass _ -> id) + |> Context.mapOptions (fun options -> + if not isAnonymous then options + else + // no need to generate t_n types for anonymous interfaces + ctx.options |> JS.cloneWith (fun o -> o.safeArity <- o.safeArity.WithProvide(false))) let typrms = List.map (fun (tp: TypeParam) -> tprintf "'%s" tp.name) c.typeParams + let currentNamespace = innerCtx |> Context.getFullName [] let labels = let emitType_ = emitType overrideFunc // labels should not have polymorphic this type - getLabelsOfFullName emitType_ innerCtx (List.rev innerCtx.currentNamespace) c.typeParams - |> function Choice1Of2 xs -> xs | Choice2Of2 (_, x) -> [x] + match kind with + | ClassKind.NormalClass _ -> + getLabelsOfFullName emitType_ innerCtx currentNamespace c.typeParams + |> function Choice1Of2 xs -> xs | Choice2Of2 (_, x) -> [x] + | ClassKind.ExportDefaultClass _ -> + c.implements + |> List.map (getAllInheritancesAndSelf innerCtx) |> Set.unionMany + |> getLabelsFromInheritingTypes emitType_ innerCtx + | ClassKind.AnonymousInterface _ -> [] let useTags = not isAnonymous @@ -919,19 +956,22 @@ let emitClass flags overrideFunc (ctx: Context) (current: StructuredText) (c: Cl let members = [ for ma, m in c.members do - yield! emitMembers emitType_ innerCtx name PolymorphicThis ma m + yield! emitMembers emitType_ innerCtx PolymorphicThis ma m yield! additionalMembers innerCtx flags overrideFunc ] let scoped = - let scoped = forceScoped |> Option.defaultValue Scoped.No - let shouldBeScoped = - c.members |> List.exists (fun (ma, m) -> - if ma.isStatic then true - else match m with Constructor _ -> true | _ -> false) // constructor generates global value - Scoped.union - scoped - (if shouldBeScoped then Scoped.Yes else Scoped.No) + match kind with + | ClassKind.ExportDefaultClass _ -> Scoped.No + | _ -> + let scoped = forceScoped |> Option.defaultValue Scoped.No + let shouldBeScoped = + c.members |> List.exists (fun (ma, m) -> + if ma.isStatic then true + else match m with Constructor _ -> true | _ -> false) // constructor generates global value + Scoped.union + scoped + (if shouldBeScoped then Scoped.Yes else Scoped.No) let docCommentLines = c.comments |> List.distinct |> List.map emitCommentBody @@ -949,7 +989,7 @@ let emitClass flags overrideFunc (ctx: Context) (current: StructuredText) (c: Cl let polymorphicThisDefinition = if useTags then let tags = - getLabelOfFullName emitType_ innerCtx (List.rev innerCtx.currentNamespace) c.typeParams + getLabelOfFullName emitType_ innerCtx currentNamespace c.typeParams |> function Choice1Of2 xs -> xs | Choice2Of2 (_, x) -> [x] |> emitLabelsBody innerCtx |> between "[> " " ]" @@ -964,12 +1004,15 @@ let emitClass flags overrideFunc (ctx: Context) (current: StructuredText) (c: Cl if innerCtx.options.recModule.IsOffOrDefault then let t = if isAnonymous then - anonymousInterfaceToIdentifier innerCtx c + anonymousInterfaceToIdentifier innerCtx (c.MapName(fun _ -> Anonymous)) else - Naming.flattenedTypeName (List.rev innerCtx.currentNamespace) |> str + (innerCtx |> Context.getFullName []).name |> Naming.flattenedTypeName |> str Type.appOpt t (c.typeParams |> List.map (fun tp -> TypeVar tp.name |> emitType_ innerCtx)) else - GetSelfTyText.class_ { flags with failContravariantTypeVar = true } overrideFunc innerCtx c + match kind with + | ClassKind.NormalClass x -> GetSelfTyText.class_ { flags with failContravariantTypeVar = true } overrideFunc innerCtx x.orig + | ClassKind.ExportDefaultClass x -> GetSelfTyText.class_ { flags with failContravariantTypeVar = true } overrideFunc innerCtx x.orig + | ClassKind.AnonymousInterface _ -> str "private Ojs.t" emitTypeAliases flags overrideFunc innerCtx c.typeParams selfTyText let castFunctions = [ @@ -984,27 +1027,27 @@ let emitClass flags overrideFunc (ctx: Context) (current: StructuredText) (c: Cl if innerCtx.options.subtyping |> List.contains Subtyping.CastFunction then for parent in c.implements do - let ty = Function { isVariadic = false; args = [Choice2Of2 selfTy]; returnType = parent; loc = UnknownLocation } |> emitType_ innerCtx + let ty = func { isVariadic = false; args = [Choice2Of2 selfTy]; returnType = parent; loc = UnknownLocation } |> emitType_ innerCtx let parentName = getHumanReadableName innerCtx parent yield overloaded (fun rename -> [val_ (rename $"cast_to_{parentName}") ty + str " " + Attr.attr Attr.Category.Block "js.cast" empty]) - // add `to_ml` and `of_ml` if the type is primitive and has an OCaml equivalent (e.g. number, boolean, string, array) - match c.name with - | None -> () - | Some name -> - match Type.jsablePrimTypeInterfaces |> Map.tryFind name with + match kind with + | ClassKind.NormalClass x -> + // add `to_ml` and `of_ml` if the type is primitive and has an OCaml equivalent (e.g. number, boolean, string, array) + match Type.jsablePrimTypeInterfaces |> Map.tryFind x.name with | None -> () | Some prim -> let targetTy = if List.isEmpty c.typeParams then Prim prim else App (APrim prim, c.typeParams |> List.map (fun tp -> TypeVar tp.name), UnknownLocation) - let toMlTy = Function { isVariadic = false; args = [Choice2Of2 selfTy]; returnType = targetTy; loc = UnknownLocation } |> emitType_ innerCtx - let ofMlTy = Function { isVariadic = false; args = [Choice2Of2 targetTy]; returnType = selfTy; loc = UnknownLocation } |> emitType_ innerCtx + let toMlTy = func { isVariadic = false; args = [Choice2Of2 selfTy]; returnType = targetTy; loc = UnknownLocation } |> emitType_ innerCtx + let ofMlTy = func { isVariadic = false; args = [Choice2Of2 targetTy]; returnType = selfTy; loc = UnknownLocation } |> emitType_ innerCtx yield overloaded (fun rename -> [ val_ (rename "to_ml") toMlTy + str " " + Attr.attr Attr.Category.Block "js.cast" empty val_ (rename "of_ml") ofMlTy + str " " + Attr.attr Attr.Category.Block "js.cast" empty ]) + | _ -> () ] let items = [ @@ -1018,27 +1061,40 @@ let emitClass flags overrideFunc (ctx: Context) (current: StructuredText) (c: Cl {| StructuredTextNode.empty with items = items; docCommentLines = docCommentLines; knownTypes = knownTypes; scoped = scoped |} let export = - match c.name with - | None -> None - | Some name -> + match kind with + | ClassKind.NormalClass x -> let kind = - if not c.isInterface || node.scoped <> Scoped.No then [Kind.Type; Kind.ClassLike; Kind.Value] - else [Kind.Type; Kind.ClassLike] - getExportFromStatement ctx name kind (if c.isInterface then "interface" else "class") (ClassDef c) - current - |> Trie.addOrUpdate [name] node StructuredTextNode.union - |> Trie.setOrUpdate {| StructuredTextNode.empty with scoped = (if node.scoped <> Scoped.No then Scoped.Yes else Scoped.No); exports = Option.toList export |} StructuredTextNode.union - -let emitValue flags overrideFunc ctx v = + if not c.isInterface || node.scoped <> Scoped.No then Kind.OfClass + else Kind.OfInterface + getExportFromStatement ctx x.name kind (if c.isInterface then "interface" else "class") (Class x.orig) + | _ -> None + + let addAsNode (name: string) = + current + |> Trie.addOrUpdate [name] node StructuredTextNode.union + |> Trie.setOrUpdate {| StructuredTextNode.empty with scoped = (if node.scoped <> Scoped.No then Scoped.Yes else Scoped.No); exports = Option.toList export |} StructuredTextNode.union + + match kind with + | ClassKind.NormalClass x -> addAsNode x.name + | ClassKind.AnonymousInterface x -> addAsNode x.name + | ClassKind.ExportDefaultClass _ -> + current + |> Trie.setOrUpdate {| + StructuredTextNode.empty with + scoped = Scoped.Force Naming.exportDefaultClassStubName + exports = [ExportItem.DefaultUnnamedClass node] + |} StructuredTextNode.union + +let emitVariable flags overrideFunc ctx (v: Variable) = let emitType = emitTypeImpl flags let emitType_ = emitType overrideFunc let ty, attr = match v.typ with - | Function _ -> - v.typ, Attr.js_global v.name + | Func (ft, _, loc) -> + Func (ft, [], loc), Attr.js_global v.name | _ -> - let tyAsGetter = Function { args = [Choice2Of2 (Prim Void)]; isVariadic = false; returnType = v.typ; loc = v.loc } + let tyAsGetter = func { args = [Choice2Of2 (Prim Void)]; isVariadic = false; returnType = v.typ; loc = v.loc } tyAsGetter, Attr.js_get v.name let comments = if List.isEmpty v.comments then [] @@ -1050,6 +1106,84 @@ let emitValue flags overrideFunc ctx v = ]) comments @ [item] +let emitFunction flags overrideFunc ctx (f: Function) = + let emitType = emitTypeImpl flags + let emitType_ = emitType overrideFunc + + let ty, attr = + Func (f.typ, [], f.loc), Attr.js_global f.name + + let comments = + if List.isEmpty f.comments then [] + else ScopeIndependent empty :: [f.comments |> List.map emitCommentBody |> concat newline |> docComment |> ScopeIndependent] + let item = + let ty = emitType_ ctx ty + overloaded (fun rename -> [ + val_ (Naming.valueName f.name |> rename) ty + str " " + attr + ]) + comments @ [item] + +let emitImport (ctx: Context) (i: Import) : StructuredTextItem list = + let emitImportClause (c: ImportClause) = + let getModuleName (specifier: string) = + if specifier.StartsWith(".") |> not then Naming.jsModuleNameToOCamlModuleName specifier |> Some + else + match JsHelper.tryGetActualFileNameFromRelativeImportPath ctx.currentSourceFile ctx.state.fileNames specifier with + | Some _ -> None // if the imported file is included in the input files, skip emitting it + | None -> + JsHelper.resolveRelativeImportPath (ctx.state.info |> Result.toOption) ctx.currentSourceFile ctx.state.fileNames specifier + |> JsHelper.InferenceResult.tryUnwrap + |> Option.defaultValue specifier + |> Naming.jsModuleNameToOCamlModuleName + |> Some + + let isModule (name: string) (kind: Set option) = + i.isTypeOnly + || kind |> Option.map Kind.generatesOCamlModule + |> Option.defaultValue false + || ctx |> Context.tryCurrentSourceInfo (fun i -> i.unknownIdentTypes |> Trie.containsKey [name]) + |> Option.defaultValue false + || name |> Naming.isCase Naming.PascalCase + + match c with + | LocalImport x -> + let shouldEmit = + match x.kind with + | Some kind -> kind |> Kind.generatesOCamlModule + | None -> x.target |> Ident.getKind ctx |> Kind.generatesOCamlModule + if shouldEmit then + [moduleAlias (Naming.moduleName x.name) (x.target.name |> Naming.structured Naming.moduleName) |> ImportText] + else [] + | NamespaceImport x when isModule x.name x.kind -> + getModuleName x.specifier + |> Option.map (fun moduleName -> + [moduleAlias (Naming.moduleName x.name) (sprintf "%s.Export" moduleName) |> ImportText]) + |> Option.defaultValue [] + | ES6WildcardImport s -> + getModuleName s + |> Option.map (fun moduleName -> [open_ [sprintf "%s.Export" moduleName] |> ImportText]) + |> Option.defaultValue [] + | ES6DefaultImport x when isModule x.name x.kind -> + getModuleName x.specifier + |> Option.map (fun moduleName -> + [moduleAlias (Naming.moduleName x.name) (sprintf "%s.Export.Default" moduleName) |> ImportText]) + |> Option.defaultValue [] + | ES6Import x when isModule x.name x.kind -> + let name = + match x.renameAs with + | Some name -> Naming.moduleName name + | None -> Naming.moduleName x.name + getModuleName x.specifier + |> Option.map (fun moduleName -> + [moduleAlias name (sprintf "%s.Export.%s" moduleName (Naming.moduleName x.name)) |> ImportText]) + |> Option.defaultValue [] + | NamespaceImport _ | ES6DefaultImport _ | ES6Import _ -> [] + + [ yield! i.comments |> List.map (emitCommentBody >> comment >> ImportText) + yield commentStr i.origText |> ImportText + for c in i.clauses do + yield! emitImportClause c] + let createStructuredText (rootCtx: Context) (stmts: Statement list) : StructuredText = let emitTypeFlags = { EmitTypeFlags.defaultValue with skipAttributesOnContravariantPosition = true } let overrideFunc = OverrideFunc.noOverride @@ -1058,45 +1192,58 @@ let createStructuredText (rootCtx: Context) (stmts: Statement list) : Structured let emitSelfType = emitTypeImpl { emitTypeFlags with failContravariantTypeVar = true } overrideFunc /// convert interface members to appropriate statements - let intfToStmts (moduleIntf: Class) ctx flags overrideFunc = - let emitAsValue name typ typrms isConst (memberAttr: MemberAttribute) = + let intfToStmts (moduleIntf: Class<_>) ctx flags overrideFunc = + let emitAsVariable name typ isConst (memberAttr: MemberAttribute) = let v = - { name = name; typ = typ; typeParams = typrms; + { name = name; typ = typ; isConst = isConst; isExported = Exported.No; accessibility = Some memberAttr.accessibility; comments = memberAttr.comments; loc = memberAttr.loc } - emitValue flags overrideFunc ctx v + emitVariable flags overrideFunc ctx v + let emitAsFunction name typ typrms (memberAttr: MemberAttribute) = + let f = + { name = name; typ = typ; typeParams = typrms; + isExported = Exported.No; accessibility = Some memberAttr.accessibility; + comments = memberAttr.comments; loc = memberAttr.loc } + emitFunction flags overrideFunc ctx f [ for ma, m in moduleIntf.members do let cmt = if List.isEmpty ma.comments then [] else ScopeIndependent empty :: [ma.comments |> List.map emitCommentBody |> concat newline |> docComment |> ScopeIndependent] match m with - | Field (fl, mt, tps) -> - yield! emitAsValue fl.name fl.value tps (mt = ReadOnly) ma + | Field (fl, mt) -> + yield! emitAsVariable fl.name fl.value (mt = ReadOnly) ma | Getter fl -> - yield! emitAsValue fl.name fl.value [] true ma + yield! emitAsVariable fl.name fl.value true ma | Setter _ -> () | Method (name, ft, tps) -> - yield! emitAsValue name (Function ft) tps true ma - | New (ft, _tps) -> - let ty = emitType_ ctx (Function ft) + yield! emitAsFunction name ft tps ma + | Newable (ft, _tps) -> + let ty = emitType_ ctx (func ft) yield! cmt yield overloaded (fun rename -> [val_ (rename "create") ty + str " " + Attr.js_create]) - | FunctionInterface (ft, _tps) -> - let ty = emitType_ ctx (Function ft) + | Callable (ft, _tps) -> + let ty = emitType_ ctx (func ft) yield! cmt yield overloaded (fun rename -> [val_ (rename "invoke") ty + str " " + Attr.js_invoke]) | Constructor _ -> failwith "impossible_emitStructuredDefinition_Pattern_intfToModule_Constructor" // because interface! - | Indexer (ft, _) -> yield ScopeIndependent (comment (tprintf "unsupported indexer of type: %s" (Type.pp (Function ft)))) + | Indexer (ft, _) -> yield ScopeIndependent (comment (tprintf "unsupported indexer of type: %s" (Type.pp (func ft)))) | UnknownMember (Some msg) -> yield ScopeIndependent (commentStr msg) | SymbolIndexer _ | UnknownMember None -> () ] let rec folder ctx (current: StructuredText) (s: Statement) : StructuredText = - let getModule name = - match current |> Trie.getSubTrie [name] with - | Some t -> t - | None -> Trie.empty - let setModule name trie = current |> Trie.setSubTrie [name] trie - let setNode node = current |> Trie.setOrUpdate node StructuredTextNode.union + let getTrie name current = + current |> Trie.getSubTrie name |> Option.defaultValue Trie.empty + let setTrie name trie current = + current |> Trie.setSubTrie name trie + let inTrie name f current = + let m = + current + |> Trie.getSubTrie name + |> Option.defaultValue Trie.empty + |> f + current |> Trie.setSubTrie name m + let set node current = current |> Trie.setOrUpdate node StructuredTextNode.union + let add name node current = current |> Trie.addOrUpdate name node StructuredTextNode.union let comments = match (s :> ICommented<_>).getComments() with @@ -1107,139 +1254,173 @@ let createStructuredText (rootCtx: Context) (stmts: Statement list) : Structured let addExport name kind kindString current = match getExportFromStatement ctx name kind kindString s with | None -> current - | Some e -> current |> Trie.setOrUpdate {| StructuredTextNode.empty with exports = [e] |} StructuredTextNode.union + | Some e -> current |> set {| StructuredTextNode.empty with exports = [e] |} + let addAnonymousInterfaceExcluding ais current = + knownTypes () + |> Seq.choose (function KnownType.AnonymousInterface (a, info) -> Some (a, info) | _ -> None) + |> Seq.filter (fun (_, info) -> info.path = ctx.currentNamespace) + |> Seq.filter (fun (a, _) -> ais |> List.contains a |> not) + |> Seq.fold (fun (current: StructuredText) (a, _) -> + let shouldSkip = + current.value + |> Option.map (fun v -> v.anonymousInterfaces |> Set.contains a) + |> Option.defaultValue false + if shouldSkip then current + else + emitClass emitTypeFlags OverrideFunc.noOverride ctx current (a.MapName Choice2Of2) ((fun _ _ _ -> []), Set.empty, None) + |> set {| StructuredTextNode.empty with anonymousInterfaces = Set.singleton a |} + ) current + let addAnonymousInterface current = addAnonymousInterfaceExcluding [] current match s with | Module m -> let module' = let node = {| StructuredTextNode.empty with docCommentLines = comments; knownTypes = knownTypes () |} - let module' = getModule m.name |> Trie.setOrUpdate node StructuredTextNode.union + let module' = current |> getTrie [m.name] |> set node let ctx = ctx |> Context.ofChildNamespace m.name m.statements |> List.fold (folder ctx) module' - let result = setModule m.name module' + let current = + current |> setTrie [m.name] module' match module'.value with - | None -> result + | None -> current | Some v -> let kind = - if v.scoped <> Scoped.No then [Kind.Module; Kind.Value] - else [Kind.Module] - result |> addExport m.name kind (if m.isNamespace then "namespace" else "module") - | ClassDef c -> - emitClass emitTypeFlags OverrideFunc.noOverride ctx current c ((fun _ _ _ -> []), Set.empty, None) - | EnumDef e -> - let module' = + if v.scoped <> Scoped.No then Kind.OfModule + else Kind.OfNamespace + current |> addExport m.name kind (if m.isNamespace then "namespace" else "module") + | Global m -> m.statements |> List.fold (folder ctx) current + | Class c -> + emitClass emitTypeFlags OverrideFunc.noOverride ctx current (c.MapName Choice1Of2) ((fun _ _ _ -> []), Set.empty, None) + |> addAnonymousInterface + | Enum e -> + current + |> inTrie [e.name] (fun module' -> let ctx = ctx |> Context.ofChildNamespace e.name let items = emitTypeAliases emitTypeFlags OverrideFunc.noOverride ctx [] (GetSelfTyText.enumCases e e.cases) - let node = {| StructuredTextNode.empty with items = items; docCommentLines = comments; knownTypes = knownTypes () |} let module' = - getModule e.name |> Trie.setOrUpdate node StructuredTextNode.union + let node = {| StructuredTextNode.empty with items = items; docCommentLines = comments; knownTypes = knownTypes () |} + module' |> set node e.cases |> List.fold (fun state c -> let ctx = ctx |> Context.ofChildNamespace c.name let comments = List.map emitCommentBody c.comments let items = emitTypeAliases emitTypeFlags OverrideFunc.noOverride ctx [] (GetSelfTyText.enumCases e [c]) let node = {| StructuredTextNode.empty with items = items; docCommentLines = comments; knownTypes = knownTypes () |} - state |> Trie.addOrUpdate [c.name] node StructuredTextNode.union - ) module' - setModule e.name module' |> addExport e.name [Kind.Type; Kind.Enum] "enum" + state |> add [c.name] node + ) module') + |> addExport e.name Kind.OfEnum "enum" | TypeAlias ta -> let ctx = ctx |> Context.ofChildNamespace ta.name let items = emitTypeAliases emitTypeFlags OverrideFunc.noOverride ctx ta.typeParams (emitSelfType ctx ta.target) let node = {| StructuredTextNode.empty with items = items; docCommentLines = comments; knownTypes = knownTypes () |} - let module' = - getModule ta.name |> Trie.setOrUpdate node StructuredTextNode.union - setModule ta.name module' |> addExport ta.name [Kind.Type] "type" + current + |> inTrie [ta.name] (set node) + |> addExport ta.name Kind.OfTypeAlias "type" + |> addAnonymousInterface | Pattern p -> let fallback current = - p.underlyingStatements |> List.fold (folder ctx) current + p.underlyingStatements + |> List.fold (folder ctx) current + |> addAnonymousInterface match p with - | ImmediateInstance (intf & { name = Some intfName }, value) when Simplify.Has(ctx.options.simplify, Simplify.ImmediateInstance) -> - let knownTypesInMembers = Statement.getKnownTypes ctx [ClassDef intf] + | ImmediateInstance (intf & { name = Name intfName }, value) when Simplify.Has(ctx.options.simplify, Simplify.ImmediateInstance) -> + let knownTypesInMembers = Statement.getKnownTypes ctx [Class intf] let createModule () = let items = intfToStmts intf (ctx |> Context.ofChildNamespace value.name) emitTypeFlags overrideFunc {| StructuredTextNode.empty with items = items; knownTypes = knownTypesInMembers; scoped = Scoped.Force value.name |} if knownTypesInMembers |> Set.contains (KnownType.Ident (ctx |> Context.getFullName [intfName])) then fallback current else - getModule value.name - |> Trie.setOrUpdate (createModule ()) StructuredTextNode.union - |> setModule value.name - |> Trie.setOrUpdate {| StructuredTextNode.empty with scoped = Scoped.Yes |} StructuredTextNode.union - |> addExport value.name [Kind.Type; Kind.ClassLike; Kind.Value] "interface" + current + |> inTrie [value.name] (set (createModule ())) + |> set {| StructuredTextNode.empty with scoped = Scoped.Yes |} + |> addExport value.name Kind.OfClass "interface" + |> addAnonymousInterface | ImmediateConstructor (baseIntf, ctorIntf, ctorValue) when Simplify.Has(ctx.options.simplify, Simplify.ImmediateConstructor) -> - emitClass emitTypeFlags OverrideFunc.noOverride ctx current baseIntf (intfToStmts ctorIntf, Statement.getKnownTypes ctx [ClassDef ctorIntf], Some (Scoped.Force ctorValue.name)) + emitClass emitTypeFlags OverrideFunc.noOverride ctx current (baseIntf.MapName Choice1Of2) (intfToStmts ctorIntf, Statement.getKnownTypes ctx [Class ctorIntf], Some (Scoped.Force ctorValue.name)) + |> addAnonymousInterface | _ -> fallback current - | Value value -> + | Function func -> + let node = + {| StructuredTextNode.empty with + items = emitFunction emitTypeFlags overrideFunc ctx func + knownTypes = knownTypes () + scoped = Scoped.Yes |} + current + |> set node + |> addExport func.name Kind.OfValue "function" + |> addAnonymousInterface + | Variable value -> let fallback current = let node = {| StructuredTextNode.empty with - items = emitValue emitTypeFlags overrideFunc ctx value + items = emitVariable emitTypeFlags overrideFunc ctx value knownTypes = knownTypes () scoped = Scoped.Yes |} current - |> Trie.setOrUpdate node StructuredTextNode.union - |> addExport value.name [Kind.Value] (if value.isConst then "const" else "let") - + |> set node + |> addExport value.name Kind.OfValue (if value.isConst then "const" else "let") + |> addAnonymousInterface let inline (|Dummy|) _ = [] match value.typ with | AnonymousInterface intf when Simplify.Has(ctx.options.simplify, Simplify.AnonymousInterfaceValue) -> let knownTypes = knownTypes () let items = intfToStmts intf (ctx |> Context.ofChildNamespace value.name) emitTypeFlags overrideFunc - getModule value.name - |> Trie.setOrUpdate {| StructuredTextNode.empty with items = items; knownTypes = knownTypes; scoped = Scoped.Force value.name |} StructuredTextNode.union - |> setModule value.name - |> Trie.setOrUpdate + current + |> inTrie [value.name] + (set + {| StructuredTextNode.empty with + items = items; knownTypes = knownTypes; scoped = Scoped.Force value.name |}) + |> set {| StructuredTextNode.empty with - items = emitValue emitTypeFlags overrideFunc ctx value + items = emitVariable emitTypeFlags overrideFunc ctx value knownTypes = knownTypes - scoped = Scoped.Yes |} StructuredTextNode.union - |> addExport value.name [Kind.Value] (if value.isConst then "const" else "let") - | Ident { fullName = Some fn; loc = loc } & Dummy tyargs - | App (AIdent { fullName = Some fn }, tyargs, loc) when Simplify.Has(ctx.options.simplify, Simplify.NamedInterfaceValue) -> + scoped = Scoped.Yes |} + |> addExport value.name Kind.OfValue (if value.isConst then "const" else "let") + |> addAnonymousInterface + | Ident (i & { loc = loc }) & Dummy tyargs + | App (AIdent i, tyargs, loc) when Simplify.Has(ctx.options.simplify, Simplify.NamedInterfaceValue) -> let intf = - FullName.tryLookupWith ctx fn (function ClassName c when c.isInterface -> Some c | _ -> None) + Ident.pickDefinition ctx i (function Definition.Class c when c.isInterface -> Some c | _ -> None) match intf with | None -> fallback current | Some intf -> - let bindings = createBindings fn loc intf.typeParams tyargs + let bindings = createBindings i.name loc intf.typeParams tyargs let intf = intf |> mapInClass (substTypeVar bindings) ctx let name = value.name + "Static" - let knownTypesInMembers = Statement.getKnownTypes ctx [ClassDef intf] + let knownTypesInMembers = Statement.getKnownTypes ctx [Class intf] let createModule () = let items = intfToStmts intf ctx emitTypeFlags overrideFunc {| StructuredTextNode.empty with items = items; knownTypes = knownTypesInMembers; scoped = Scoped.Force value.name |} - getModule name - |> Trie.setOrUpdate (createModule ()) StructuredTextNode.union - |> setModule name - |> Trie.setOrUpdate {| StructuredTextNode.empty with scoped = Scoped.Yes |} StructuredTextNode.union - |> addExport name [Kind.Value] (if value.isConst then "const" else "let") + current + |> inTrie [name] (set (createModule ())) + |> set {| StructuredTextNode.empty with scoped = Scoped.Yes |} + |> addExport name Kind.OfValue (if value.isConst then "const" else "let") |> fallback | _ -> fallback current - | Import _ -> current // nop + | Import i -> + current |> set {| StructuredTextNode.empty with items = emitImport ctx i |} | Export e -> - let kind = - match e.clause with + let getKind = function | CommonJsExport i | ES6DefaultExport i -> i |> Ident.getKind ctx | ES6Export x -> x.target |> Ident.getKind ctx | NamespaceExport _ -> Set.empty - setNode {| StructuredTextNode.empty with exports = [{| e with kind = kind |}] |} + current + |> set + {| StructuredTextNode.empty with + exports = [ExportItem.Statement {| e with clauses = e.clauses |> List.map (fun c -> c, getKind c) |}] |} | UnknownStatement u -> let cmt = - match u.msg with + match u.origText with | Some s -> commentStr s | None -> commentStr "unknown statement" - setNode {| StructuredTextNode.empty with items = [ScopeIndependent cmt] |} + current |> set {| StructuredTextNode.empty with items = [ScopeIndependent cmt] |} | FloatingComment c -> let cmt = ScopeIndependent empty :: (c.comments |> List.map (emitCommentBody >> comment >> ScopeIndependent)) - setNode {| StructuredTextNode.empty with items = ScopeIndependent empty :: cmt |} + current |> set {| StructuredTextNode.empty with items = ScopeIndependent empty :: cmt |} and folder' ctx stmt node = folder ctx node stmt - let anonymousInterfaces = - rootCtx.anonymousInterfacesMap - |> Map.toList - |> List.map (fst >> ClassDef) - - (anonymousInterfaces @ stmts) |> List.fold (folder rootCtx) Trie.empty + stmts |> List.fold (folder rootCtx) Trie.empty type ModuleEmitter = Context -> StructuredText -> (TextModuleSig list -> text list) module ModuleEmitter = @@ -1262,75 +1443,77 @@ module ModuleEmitter = | RecModule.Naive -> recAll | RecModule.Optimized -> recOptimized -let emitExportModule (ctx: Context) (exports: ExportWithKind list) : text list = - let stopStartImplem text = - Attr.js_stop_start_implem_oneliner text text +type ExportWithKind = {| comments: Comment list; clauses: (ExportClause * Set) list; loc: Location; origText: string |} - let getComments isFirst commentOut (e: ExportWithKind) = [ +let rec emitExportModule (moduleEmitter: ModuleEmitter) (ctx: Context) (exports: ExportItem list) : text list = + let emitComment isFirst (e: ExportWithKind) = [ let hasDocComment = not (List.isEmpty e.comments) - if not isFirst && hasDocComment then yield empty - yield commentStr e.origText + if not isFirst && hasDocComment then yield ScopeIndependent empty + yield commentStr e.origText |> ScopeIndependent if hasDocComment then - yield e.comments |> List.map emitCommentBody |> concat newline |> commentOut + yield e.comments |> List.map emitCommentBody |> concat newline |> comment |> ScopeIndependent ] - let fail isFirst (e: ExportWithKind) = getComments isFirst comment e + let emitModuleAlias name (i: Ident) = + if i.kind |> Option.map Kind.generatesOCamlModule |> Option.defaultValue false then + [ moduleAlias + (name |> Naming.moduleNameReserved) + (i.name |> Naming.structured Naming.moduleName) |> ScopeIndependent] + else [] - let isModule fn = - Set.intersect (FullName.getKind ctx fn) (Set.ofList [Kind.Type; Kind.ClassLike; Kind.Module]) |> Set.isEmpty |> not + let addItems items (acc: StructuredText) = + acc |> Trie.setOrUpdate {| StructuredTextNode.empty with items = items |} StructuredTextNode.union - let emitModuleAlias isFirst name (i: IdentType) (e: ExportWithKind) = - match i.fullName with - | Some fn -> - if isModule fn then - [ yield! getComments isFirst docComment e - yield tprintf "module %s = %s" name (i.name |> Naming.structured Naming.moduleName) |> stopStartImplem ] - else fail isFirst e - | None -> fail isFirst e + let setItems path items (acc: StructuredText) = + acc |> Trie.addOrUpdate path {| StructuredTextNode.empty with items = items |} StructuredTextNode.union - let rec go isFirst acc (exports: ExportWithKind list) = + let rec go isFirst (acc: StructuredText) (exports: ExportItem list) = match exports with | [] -> acc - | export :: rest -> - match export.clause with - | NamespaceExport _ -> go false (acc @ fail isFirst export) rest - | CommonJsExport i -> // CommonJS export - let body = emitModuleAlias true "Export" i export - [ yield! acc - yield! body - for e in rest do yield! fail false e ] - | _ -> // ES6 exports - let emit isFirst (e: ExportWithKind) = - match e.clause with - | CommonJsExport _ // `export = something;` should not appear with other export elements - | NamespaceExport _ -> fail isFirst e - | ES6DefaultExport i -> - emitModuleAlias isFirst "Default" i e - | ES6Export x -> - let name = - match x.renameAs with - | Some name -> name |> Naming.moduleName - | None -> x.target.name |> List.last |> Naming.moduleName - emitModuleAlias isFirst name x.target e - let content = - emit isFirst export @ List.collect (emit false) rest - let m : TextModuleSig = {| name = "Export"; origName = "Export"; scope = None; content = content; docCommentBody = [] |} - [ yield! acc - yield moduleSig m ] - - let moduleGeneratingExports = - exports |> List.filter (fun e -> Set.intersect e.kind (Set.ofList [Kind.Type; Kind.Module]) |> Set.isEmpty |> not) - go true [] moduleGeneratingExports - -let rec private emitStructuredText (moduleEmitter: ModuleEmitter) (ctx: Context) (st: StructuredText) : {| scoped: Scoped; content: text list; docCommentBody: text list |} = + | ExportItem.DefaultUnnamedClass node :: rest -> + go false (acc |> Trie.addOrUpdate ["Export"; "Default"] node StructuredTextNode.union) rest + | ExportItem.Statement export :: rest -> + let clauses = export.clauses |> List.map fst + let rec go' acc = function + | [] -> acc + | NamespaceExport _ :: rest -> go' acc rest + | CommonJsExport i :: rest -> // CommonJS export + go' (acc |> addItems (emitModuleAlias "Export" i)) rest + | ES6DefaultExport e :: rest -> + go' (acc |> setItems ["Export"] (emitModuleAlias "Default" e)) rest + | ES6Export e :: rest -> + let name = e.renameAs |> Option.defaultValue (e.target.name |> List.last) + go' (acc |> setItems ["Export"] (emitModuleAlias name e.target)) rest + let acc = + let generatesExportModule = + clauses |> List.exists (function ES6Export _ | ES6DefaultExport _ -> true | _ -> false) + if generatesExportModule then + acc |> setItems ["Export"] (emitComment isFirst export) + else + acc |> addItems (emitComment isFirst export) + go false (go' acc clauses) rest + + let st = go true Trie.empty exports + let emitted = st |> emitStructuredText true moduleEmitter ctx + // add newline if not empty + if not (List.isEmpty emitted.content) then + empty :: emitted.content + else + [] + +and private emitStructuredText (reserved: bool) (moduleEmitter: ModuleEmitter) (ctx: Context) (st: StructuredText) : {| scoped: Scoped; imports: text list; content: text list; docCommentBody: text list |} = let renamer = new OverloadRenamer() let modules : TextModuleSig list = st.children |> Map.toList |> List.map (fun (k, v) -> - let name = Naming.moduleName k |> renamer.Rename "module" + let name = + let name = + if reserved then Naming.moduleNameReserved k + else Naming.moduleName k + name |> renamer.Rename "module" let ctx = ctx |> Context.ofChildNamespace k - let result = emitStructuredText moduleEmitter ctx v + let result = emitStructuredText reserved moduleEmitter ctx v {| name = name origName = k @@ -1339,7 +1522,7 @@ let rec private emitStructuredText (moduleEmitter: ModuleEmitter) (ctx: Context) | Scoped.Force s -> Some s | Scoped.Yes -> Some k | Scoped.No -> None - content = result.content + content = result.imports @ result.content docCommentBody = result.docCommentBody |} ) @@ -1362,7 +1545,6 @@ let rec private emitStructuredText (moduleEmitter: ModuleEmitter) (ctx: Context) | None -> Scoped.No let content = [ - yield! imports yield! emitModules modules yield! typedefs for item in items do @@ -1371,9 +1553,10 @@ let rec private emitStructuredText (moduleEmitter: ModuleEmitter) (ctx: Context) | Choice2Of2 overloaded -> yield! overloaded renamer match st.value with | None -> () - | Some v -> yield! emitExportModule ctx v.exports + | Some v -> + yield! emitExportModule moduleEmitter ctx v.exports ] - {| scoped = scoped; content = content; docCommentBody = docCommentBody |} + {| scoped = scoped; imports = imports; content = content; docCommentBody = docCommentBody |} let emitFlattenedDefinitions (ctx: Context) (stmts: Statement list) : text list = let flags = { EmitTypeFlags.defaultValue with failContravariantTypeVar = true } @@ -1384,18 +1567,18 @@ let emitFlattenedDefinitions (ctx: Context) (stmts: Statement list) : text list let rec go prefix (ctx: Context) (v: Statement) = match v with - | EnumDef e -> - let fn = List.rev (e.name :: ctx.currentNamespace) + | Enum e -> + let fn = ctx |> Context.getFullName [e.name] [ - yield tprintf "%s %s = " prefix (Naming.flattenedTypeName fn) + GetSelfTyText.enumCases e e.cases + yield tprintf "%s %s = " prefix (Naming.flattenedTypeName fn.name) + GetSelfTyText.enumCases e e.cases for c in e.cases do - yield tprintf "and %s = " (Naming.flattenedTypeName (fn @ [c.name])) + GetSelfTyText.enumCases e [c] + yield tprintf "and %s = " (Naming.flattenedTypeName (fn.name @ [c.name])) + GetSelfTyText.enumCases e [c] ] - | ClassDef c -> + | Class c -> match c.name with - | None -> [] // anonymous interfaces are treated separately - | Some name -> - let fn = List.rev (name :: ctx.currentNamespace) + | ExportDefaultUnnamedClass -> [] + | Name name -> + let fn = ctx |> Context.getFullName [name] let typrm = c.typeParams |> List.map (fun x -> tprintf "'%s" x.name) let selfTyText = let ctx = ctx |> Context.ofChildNamespace name @@ -1408,38 +1591,40 @@ let emitFlattenedDefinitions (ctx: Context) (stmts: Statement list) : text list | [] -> Prim prim | _ -> App (APrim prim, c.typeParams |> List.map (fun tp -> TypeVar tp.name), UnknownLocation) emitType_ ctx target - [prefix @+ " " @+ emitTypeName fn typrm +@ " = " + selfTyText] + [prefix @+ " " @+ emitTypeName fn.name typrm +@ " = " + selfTyText] | TypeAlias { name = name; typeParams = typeParams; target = target } -> - let fn = List.rev (name :: ctx.currentNamespace) + let fn = ctx |> Context.getFullName [name] let typrm = typeParams |> List.map (fun x -> tprintf "'%s" x.name) let selfTyText = emitType_ ctx target - [prefix @+ " " @+ emitTypeName fn typrm +@ " = " + selfTyText] + [prefix @+ " " @+ emitTypeName fn.name typrm +@ " = " + selfTyText] // TODO: emit extends of type parameters | Module m -> m.statements |> List.collect (go prefix (ctx |> Context.ofChildNamespace m.name)) + | Global m -> m.statements |> List.collect (go prefix (ctx |> Context.ofRoot)) | Pattern p -> match p with - | ImmediateInstance (intf & { name = Some intfName }, value) when Simplify.Has(ctx.options.simplify, Simplify.ImmediateInstance) -> - let knownTypesInMembers = Statement.getKnownTypes ctx [ClassDef intf] + | ImmediateInstance (intf & { name = Name intfName }, value) when Simplify.Has(ctx.options.simplify, Simplify.ImmediateInstance) -> + let knownTypesInMembers = Statement.getKnownTypes ctx [Class intf] if intfName <> value.name || knownTypesInMembers |> Set.contains (KnownType.Ident (ctx |> Context.getFullName [intfName])) then p.underlyingStatements |> List.collect (go prefix ctx) else [] // no type is generated for immediate instance | ImmediateConstructor (baseIntf, _, _) when Simplify.Has(ctx.options.simplify, Simplify.ImmediateConstructor) -> - go prefix ctx (ClassDef baseIntf) // only the base interface is used as a type + go prefix ctx (Class baseIntf) // only the base interface is used as a type | _ -> p.underlyingStatements |> List.collect (go prefix ctx) | Import _ - | Value _ + | Variable _ + | Function _ | Module _ | Export _ | UnknownStatement _ | FloatingComment _ -> [] - let genAnonymousInterface prefix (c: Class) = + let genAnonymousInterface prefix (a: AnonymousInterface) = let typeName = Type.appOpt - (anonymousInterfaceToIdentifier ctx c) - (c.typeParams |> List.map (fun x -> tprintf "'%s" x.name)) + (anonymousInterfaceToIdentifier ctx a) + (a.typeParams |> List.map (fun x -> tprintf "'%s" x.name)) let selfTyText = str "private Ojs.t" prefix @+ " " @+ typeName +@ " = " + selfTyText @@ -1451,21 +1636,28 @@ let emitFlattenedDefinitions (ctx: Context) (stmts: Statement list) : text list "type" else "and" + let aim = + ctx |> Context.tryCurrentSourceInfo (fun info -> info.anonymousInterfacesMap) |> Option.defaultValue Map.empty + List.distinct [ - for c in ctx.anonymousInterfacesMap |> Map.toList |> List.map fst do - yield genAnonymousInterface (getPrefix()) c + for a in aim |> Map.toList |> List.map fst do + yield genAnonymousInterface (getPrefix()) a for stmt in stmts do yield! go (getPrefix()) ctx stmt ] let emitStatementsWithStructuredText (ctx: Context) (stmts: Statement list) (st: StructuredText) = let moduleEmitter = ModuleEmitter.fromOption ctx.options - let result = st |> emitStructuredText moduleEmitter ctx + let result = st |> emitStructuredText false moduleEmitter ctx + let imports = + if List.isEmpty result.imports then [] + else result.imports @ [empty] let content = if List.isEmpty result.docCommentBody then result.content else docComment (concat newline result.docCommentBody) :: result.content [ + yield! imports if ctx.options.recModule.IsOffOrDefault then yield! emitFlattenedDefinitions ctx stmts yield empty @@ -1479,53 +1671,62 @@ let header = [ str "[@@@ocaml.warning \"-7-11-32-33-39\"]" Attr.js_implem_floating (str "[@@@ocaml.warning \"-7-11-32-33-39\"]") ] -let emitStdlib (input: Input) (opts: Options) : Output list = +let setTyperOptions (ctx: IContext) = + ctx.options.inheritArraylike <- true + ctx.options.inheritIterable <- true + ctx.options.inheritPromiselike <- true + ctx.options.replaceAliasToFunction <- true + ctx.options.replaceNewableFunction <- true + ctx.options.replaceRankNFunction <- true + +let emitStdlib (input: Input) (ctx: IContext) : Output list = let srcs = input.sources - Log.tracef opts "* looking up the minimal supported ES version for each definition..." + ctx.logger.tracef "* looking up the minimal supported ES version for each definition..." let esSrc = srcs |> List.filter (fun src -> src.fileName.Contains("lib.es") && src.fileName.EndsWith(".d.ts")) - |> mergeLibESDefinitions + |> mergeESLibDefinitions let domSrc = - let stmts = - srcs - |> List.filter (fun src -> src.fileName.Contains("lib.dom") && src.fileName.EndsWith(".d.ts")) - |> List.collect (fun src -> src.statements) - |> Statement.merge - { fileName = "lib.dom.d.ts"; statements = stmts; references = []; hasNoDefaultLib = false; moduleName = None } + srcs + |> List.filter (fun src -> src.fileName.Contains("lib.dom") && src.fileName.EndsWith(".d.ts")) + |> mergeSources "lib.dom.d.ts" let webworkerSrc = - let stmts = - srcs - |> List.filter (fun src -> src.fileName.Contains("lib.webworker") && src.fileName.EndsWith(".d.ts")) - |> List.collect (fun src -> src.statements) - |> Statement.merge - { fileName = "lib.webworker.d.ts"; statements = stmts; references = []; hasNoDefaultLib = false; moduleName = None } - - Log.tracef opts "* running typer..." + srcs + |> List.filter (fun src -> src.fileName.Contains("lib.webworker") && src.fileName.EndsWith(".d.ts")) + |> mergeSources "lib.webworker.d.ts" + |> fun src -> + let statements = + src.statements |> Statement.mapIdent (fun i -> + i |> Ident.mapSource (fun path -> + // webworker does not depend on DOM but fullnames can still refer to it + if path.Contains("lib.dom") && src.fileName.EndsWith(".d.ts") then "lib.webworker.d.ts" + else path + ) + ) + { src with statements = statements } + + ctx.logger.tracef "* running typer..." + + setTyperOptions ctx + let opts = ctx.options opts.simplify <- [Simplify.All] opts.inheritWithTags <- FeatureFlag.Full opts.safeArity <- FeatureFlag.Full opts.recModule <- RecModule.Optimized opts.subtyping <- [Subtyping.Tag] - opts.inheritArraylike <- true - opts.inheritIterable <- true - opts.inheritPromiselike <- true - - let esCtx, esSrc = runAll [esSrc] opts - let domCtx, domSrc = runAll [domSrc] opts - let webworkerCtx, webworkerSrc = runAll [webworkerSrc] opts - assert (esCtx.unknownIdentTypes |> Trie.isEmpty) - assert (domCtx.unknownIdentTypes |> Trie.keys |> Seq.forall (fun fn -> Trie.containsKey fn esCtx.definitionsMap)) - assert (webworkerCtx.unknownIdentTypes |> Trie.keys |> Seq.forall (fun fn -> Trie.containsKey fn esCtx.definitionsMap || Trie.containsKey fn domCtx.definitionsMap)) - - let writerCtx ctx = + + let esCtx, esSrc = runAll [esSrc] ctx + let domCtx, domSrc = runAll [domSrc] ctx + let webworkerCtx, webworkerSrc = runAll [webworkerSrc] ctx + + let writerCtx (srcs: SourceFile list) ctx = ctx |> Context.mapOptions (fun _ -> opts) - |> Context.mapState (fun _ -> State.create [] (Error None)) + |> Context.mapState (fun _ -> State.create (srcs |> List.map (fun src -> src.fileName)) (Error None)) - Log.tracef opts "* emitting stdlib..." + ctx.logger.tracef "* emitting stdlib..." let createOutput (fileNameSuffix: string) (opens: string list) ctx (src: SourceFile list) = let content = @@ -1533,7 +1734,8 @@ let emitStdlib (input: Input) (opts: Options) : Output list = yield! header yield open_ opens yield empty - yield! emitStatements (writerCtx ctx) (src |> List.collect (fun s -> s.statements)) + for s in src do + yield! emitStatements (writerCtx src ctx |> Context.ofSourceFileRoot s.fileName) s.statements ] { fileName = sprintf "ts2ocaml_%s.mli" fileNameSuffix; content = content; stubLines = []} @@ -1541,107 +1743,51 @@ let emitStdlib (input: Input) (opts: Options) : Output list = { fileName = "ts2ocaml_min.mli"; content = str stdlib; stubLines = []} [ ts2ocamlMin - createOutput "es" ["Ts2ocaml_min"] esCtx esSrc + createOutput "es" ["Ts2ocaml_min"] esCtx esSrc createOutput "dom" ["Ts2ocaml_min"; "Ts2ocaml_es"] domCtx domSrc createOutput "webworker" ["Ts2ocaml_min"; "Ts2ocaml_es"] webworkerCtx webworkerSrc ] -let emitImports (ctx: Context) (sourceFile: SourceFile) : text list = - let emitImport (i: Import) = - // if the imported file is included in the input files, skip emitting it - let shouldBeSkipped = - if i.moduleSpecifier.StartsWith(".") |> not then false - else - let relativePath = Path.join [Path.dirname sourceFile.fileName; i.moduleSpecifier] - let test path = ctx.state.fileNames |> List.contains path - test (relativePath + ".d.ts") || test (Path.join [relativePath; "index.d.ts"]) - - if shouldBeSkipped then [] - else - let moduleSpecifier = - match JsHelper.resolveRelativeImportPath (ctx.state.info |> Result.toOption) sourceFile.fileName i.moduleSpecifier with - | JsHelper.Valid s | JsHelper.Heuristic s -> s - | JsHelper.Unknown -> i.moduleSpecifier - let theirModuleName = moduleSpecifier |> Naming.jsModuleNameToOCamlModuleName - - let isModule (name: string) (kind: Set option) = - i.isTypeOnly - || kind |> Option.map (fun k -> Set.intersect k (Set.ofList [Kind.Type; Kind.ClassLike; Kind.Module]) |> Set.isEmpty |> not) - |> Option.defaultValue false - || ctx.unknownIdentTypes |> Trie.containsKey [name] - || name |> Naming.isCase Naming.PascalCase - - let emitES6Import (b: {| name: string; kind: Set option; renameAs: string option |}) = - if isModule b.name b.kind then - let theirName = b.name |> Naming.moduleName - let ourName = - match b.renameAs with - | Some name -> name |> Naming.moduleName - | None -> theirName - tprintf "module %s = %s.Export.%s " ourName theirModuleName theirName |> Some - else - None - - let stopStartImplem text = - Attr.js_stop_start_implem_oneliner text text - - [ yield empty - yield commentStr i.origText - match i.clause with - | ES6WildcardImport -> - yield open_ [ sprintf "%s.Export" theirModuleName ] - | NamespaceImport x -> - yield tprintf "module %s = %s.Export" (Naming.moduleName x.name) theirModuleName |> stopStartImplem - | ES6Import x -> - match x.defaultImport with - | None -> () - | Some b -> - if isModule b.name b.kind then - let ourName = b.name |> Naming.moduleName - yield tprintf "module %s = %s.Export.Default" ourName theirModuleName |> stopStartImplem - for b in x.bindings do - match emitES6Import b with Some t -> yield stopStartImplem t | None -> () ] - - sourceFile.statements |> List.collect (function Import i -> emitImport i | _ -> []) - let handleExports moduleName (ctx: Context) (str: StructuredText) : {| stubLines: string list; topLevelScope: string option |} = let stubBinding xs expr = let specifier = xs |> List.map (fun n -> sprintf "[\"%s\"]" (String.escape n)) |> String.concat "" sprintf "joo_global_object%s = %s" specifier expr - let createStubLine prefix (x: {| expr: string; needBabel: bool; target: IdentType |}) = - match x.target.fullName with + let createStubLine prefix (x: {| expr: string; needBabel: bool; target: Ident |}) = + match x.target.fullName |> List.tryFind (fun fn -> fn.source = ctx.currentSourceFile) with | None -> - Log.warnf ctx.options "cannot generate stub for importing '%s' at %s" (x.target.name |> String.concat ".") (x.target.loc.AsString) + ctx.logger.warnf "cannot generate stub for importing '%s' at %s" (x.target.name |> String.concat ".") (x.target.loc.AsString) None - | Some fn -> Some (stubBinding (prefix @ fn) x.expr) + | Some fn -> Some (stubBinding (prefix @ fn.name) x.expr) match str.value with | None -> {| stubLines = []; topLevelScope = None |} | Some v -> let stubLines, topLevelScope = - match v.exports |> List.tryFind (fun e -> match e.clause with CommonJsExport _ -> true | _ -> false) with - | Some commonJsExport -> - ExportClause.require moduleName commonJsExport.clause |> List.choose (createStubLine []), None - | None -> - let boundExports = - v.exports |> List.filter (fun e -> e.kind |> Set.contains Kind.Value) - let es6Exports = boundExports |> List.filter (fun e -> match e.clause with ES6Export _ | ES6DefaultExport _ -> true | _ -> false) - if List.isEmpty es6Exports then [], None - else - let defaultExport = - es6Exports |> List.tryFind (fun e -> match e.clause with ES6DefaultExport _ -> true | _ -> false) - let stubLines = [ - yield stubBinding [moduleName] (sprintf "require('%s') /* need Babel */" moduleName) - match defaultExport with - | None -> () - | Some e -> - yield! - e.clause - |> ExportClause.require moduleName - |> List.choose (createStubLine [moduleName]) - ] - stubLines, Some moduleName - {| stubLines = stubLines; topLevelScope = topLevelScope |} + v.exports |> List.fold (fun (stubLines, topLevelScope) export -> + match export with + | ExportItem.DefaultUnnamedClass _ -> + stubBinding [moduleName; Naming.exportDefaultClassStubName] (sprintf "require('%s').default /* need Babel */" moduleName) :: stubLines, + Some moduleName + | ExportItem.Statement e -> + e.clauses |> List.fold (fun (stubLines, topLevelScope) -> function + | (CommonJsExport _ as clause, _) -> + let stub = + ExportClause.require moduleName clause + |> List.choose (fun x -> createStubLine [] {| x with needBabel = false |}) + List.rev stub @ stubLines, topLevelScope + | (ES6DefaultExport _ as clause, kind) when kind |> Set.contains Kind.Value -> + let stub = + ExportClause.require moduleName clause + |> List.choose (fun x -> createStubLine [moduleName] {| x with needBabel = true |}) + List.rev stub @ stubLines, Some moduleName + | (ES6Export _, kind) when kind |> Set.contains Kind.Value -> + let stub = + stubBinding [moduleName] (sprintf "require('%s') /* need Babel */" moduleName) + stub :: stubLines, Some moduleName + | _ -> stubLines, topLevelScope + ) (stubLines, topLevelScope) + ) ([], None) + {| stubLines = stubLines |> List.rev |> List.distinct; topLevelScope = topLevelScope |} let emitReferenceTypeDirectives (ctx: Context) (src: SourceFile) : text list = let refs = @@ -1655,11 +1801,7 @@ let emitReferenceTypeDirectives (ctx: Context) (src: SourceFile) : text list = |> List.map commentStr let openRefs = refs - |> List.map (fun x -> - x - |> JsHelper.resolveRelativeImportPath (Result.toOption ctx.state.info) src.fileName - |> JsHelper.InferenceResult.unwrap x - |> Naming.jsModuleNameToOCamlModuleName) + |> List.map Naming.jsModuleNameToOCamlModuleName |> open_ empty :: comments @ [openRefs] @@ -1690,32 +1832,48 @@ let emitReferenceFileDirectives (ctx: Context) (src: SourceFile) : text list = |> open_ empty :: comments @ [openRefs] -let private emitImpl (sources: SourceFile list) (info: PackageInfo option) (opts: Options) = +let private emitImpl (sources: SourceFile list) (info: PackageInfo option) (ctx: IContext) = let derivedOutputFileName = - JsHelper.deriveOutputFileName - opts info (sources |> List.map (fun s -> s.fileName)) - Naming.jsModuleNameToFileName "output.mli" + let inline log x = + ctx.logger.tracef "* the inferred output file name is '%s'" x + x + JsHelper.deriveModuleName info (sources |> List.map (fun s -> s.fileName)) + |> JsHelper.InferenceResult.tryUnwrap + |> Option.map (Naming.jsModuleNameToFileName >> log) + |> Option.defaultWith (fun () -> + ctx.logger.warnf "* the output file name cannot be inferred. 'output.mli' is used instead." + "output.mli") let derivedModuleName = JsHelper.deriveModuleName info (sources |> List.map (fun s -> s.fileName)) |> JsHelper.InferenceResult.unwrap "package" + let fileNames = sources |> List.map (fun s -> s.fileName) + let info = match info with | Some info -> Ok info | None -> Error (Some derivedModuleName) - Log.tracef opts "* running typer..." - let ctx, srcs = runAll sources opts + let sources, mergedFileName = + match sources with + | [] -> failwith "impossible_emitImpl (empty sources)" + | [src] -> [src], src.fileName + | _ -> [mergeSources "input.d.ts" sources], "input.d.ts" + + ctx.logger.tracef "* running typer..." + setTyperOptions ctx + let ctx, sources = runAll sources ctx + let ctx = - ctx |> Context.mapOptions (fun _ -> opts) - |> Context.mapState (fun _ -> State.create (srcs |> List.map (fun s -> s.fileName)) info) - let stmts = srcs |> List.collect (fun x -> x.statements) + ctx + |> Context.mapState (fun _ -> State.create fileNames info) + |> Context.ofSourceFileRoot mergedFileName + let stmts = sources |> List.collect (fun x -> x.statements) let structuredText = createStructuredText ctx stmts - let exported = handleExports derivedModuleName ctx structuredText - Log.tracef opts "* emitting a binding to '%s' for js_of_ocaml..." derivedModuleName + ctx.logger.tracef "* emitting a binding to '%s' for js_of_ocaml..." derivedModuleName let content = concat newline [ yield! header @@ -1725,8 +1883,7 @@ let private emitImpl (sources: SourceFile list) (info: PackageInfo option) (opts yield tprintf "[@@@js.scope \"%s\"]" scope yield open_ [ "Ts2ocaml"; "Ts2ocaml.Dom"; "Ts2ocaml.WebWorker" ] - for src in srcs do - yield! emitImports ctx src + for src in sources do yield! emitReferenceTypeDirectives ctx src yield! emitReferenceFileDirectives ctx src @@ -1736,9 +1893,9 @@ let private emitImpl (sources: SourceFile list) (info: PackageInfo option) (opts { fileName = derivedOutputFileName; content = content; stubLines = exported.stubLines } -let emit (input: Input) (opts: Options) : Output list = - if opts.merge then - [emitImpl input.sources input.info opts] +let emit (input: Input) (ctx: IContext) : Output list = + if ctx.options.merge then + [emitImpl input.sources input.info ctx] else input.sources - |> List.map (fun source -> emitImpl [source] input.info opts) + |> List.map (fun source -> emitImpl [source] input.info ctx) diff --git a/src/Targets/ParserTest.fs b/src/Targets/ParserTest.fs index a5ddfc91..2b7daba9 100644 --- a/src/Targets/ParserTest.fs +++ b/src/Targets/ParserTest.fs @@ -1,5 +1,6 @@ module Targets.ParserTest +open Ts2Ml open Syntax open Target @@ -7,14 +8,46 @@ type Options = inherit GlobalOptions inherit Typer.TyperOptions abstract typing: bool with get + abstract dumpAst: string option with get let private builder (argv: Yargs.Argv) : Yargs.Argv = argv.addFlag("typing", (fun (o: Options) -> o.typing), descr="Apply typer") + .addOption("dump-ast", (fun (o: Options) -> o.dumpAst), descr="Dump AST as JSON") + +open Fable.Core +open Fable.Core.JsInterop + +let stringify (x: obj) = + let objSet = JS.Constructors.Set.Create() + JS.JSON.stringify(x, space=2, replacer=(fun _key value -> + if JS.Constructors.Array.isArray value then + let xs = value :?> obj[] + if xs.Length > 0 then + if xs[0] = "LocationTs" then + {| source=xs[1]?fileName; line=xs[2]?line; character=xs[2]?character |} + else if xs[0] = "Location" && xs.Length = 2 && xs[1] |> has "src" then + {| source=xs[1]?src?fileName; line=xs[1]?line; character=xs[1]?character |} + else if xs[0] = "Other" && xs.Length = 4 && xs[3]?kind = TypeScript.Ts.SyntaxKind.JSDocTag then + {| tag=xs[1]; text=xs[2] |} + else value + else value + else if not (isNullOrUndefined value) && JS.typeof value = "object" then + if objSet.has(value) then box "" + else + objSet.add value |> ignore + value + else + value + )) + +let private run (input: Input) (baseCtx: IContext) = + baseCtx.options.replaceAliasToFunction <- true + baseCtx.options.replaceNewableFunction <- true + baseCtx.options.replaceRankNFunction <- true -let private run (input: Input) (options: Options) = let srcs = - if options.typing then - Typer.runAll input.sources options |> snd + if baseCtx.options.typing then + Typer.runAll input.sources baseCtx |> snd else input.sources let moduleName = @@ -22,6 +55,16 @@ let private run (input: Input) (options: Options) = printfn "package info: %A" (JS.stringify input.info) printfn "sources: %A" (srcs |> List.map (fun src -> src.fileName)) printfn "derived module name: %A" moduleName + match baseCtx.options.dumpAst with + | None -> () + | Some output -> + let o = [| + for src in input.sources do + yield + {| file = src.fileName; + statements = src.statements |> List.toArray |} + |] + Node.Api.fs.writeFileSync(output, stringify o) let target = { new ITarget with diff --git a/src/Typer.fs b/src/Typer.fs deleted file mode 100644 index 4ceb5440..00000000 --- a/src/Typer.fs +++ /dev/null @@ -1,1733 +0,0 @@ -module Typer - -open Syntax -open DataTypes - -type TyperOptions = - inherit GlobalOptions - abstract inheritIterable: bool with get,set - abstract inheritArraylike: bool with get,set - abstract inheritPromiselike: bool with get,set - -module TyperOptions = - open Fable.Core.JsInterop - - let register (yargs: Yargs.Argv) = - yargs - .group( - !^ResizeArray[ - "inherit-iterable" - "inherit-arraylike" - "inherit-promiselike" - ], - "Typer Options:") - .addFlag( - "inherit-iterable", - (fun (o: TyperOptions) -> o.inheritIterable), - descr="Treat a type as inheriting Iterable if it has an iterator as a member.", - defaultValue = false - ) - .addFlag( - "inherit-arraylike", - (fun (o: TyperOptions) -> o.inheritArraylike), - descr="Treat a type as inheriting ArrayLike if it has a number-indexed indexer.", - defaultValue = false - ) - .addFlag( - "inherit-promiselike", - (fun (o: TyperOptions) -> o.inheritPromiselike), - descr="Treat a type as inheriting PromiseLike if it has `then` as a member.", - defaultValue = false - ) - -type Context<'Options, 'State> = {| - currentNamespace: string list - definitionsMap: Trie - typeLiteralsMap: Map - anonymousInterfacesMap: Map - unknownIdentTypes: Trie> - options: 'Options - state: 'State -|} - -let inline private warn (ctx: Context) (loc: Location) fmt = - Printf.kprintf (fun s -> - Log.warnf ctx.options "%s at %s" s loc.AsString - ) fmt - -module Context = - let mapOptions (f: 'a -> 'b) (ctx: Context<'a, 's>) : Context<'b, 's> = - {| ctx with options = f ctx.options |} - - let mapState (f: 's -> 't) (ctx: Context<'a, 's>) : Context<'a, 't> = - {| ctx with state = f ctx.state |} - - let ofParentNamespace (ctx: Context<'a, 's>) : Context<'a, 's> option = - match ctx.currentNamespace with - | [] -> None - | _ :: ns -> Some {| ctx with currentNamespace = ns |} - - let ofChildNamespace childName (ctx: Context<'a, 's>) : Context<'a, 's> = - {| ctx with currentNamespace = childName :: ctx.currentNamespace |} - - let getFullName (name: string list) (ctx: Context<'a, 's>) = - match name with - | [] -> List.rev ctx.currentNamespace - | n :: [] -> List.rev (n :: ctx.currentNamespace) - | _ -> List.rev ctx.currentNamespace @ name - - let getFullNameString (name: string list) (ctx: Context<'a, 's>) = - getFullName name ctx |> String.concat "." - - /// `Error relativeNameOfCurrentNamespace` when `fullName` is a parent of current namespace. - /// `Ok name` otherwise. - let getRelativeNameTo (fullName: string list) (ctx: Context<'a, 's>) = - let rec go name selfPos = - match name, selfPos with - | x :: [], y :: ys when x = y -> Error ys - | x :: xs, y :: ys when x = y -> go xs ys - | xs, _ -> Ok xs - go fullName (List.rev ctx.currentNamespace) - -type FullNameLookupResult = - | AliasName of TypeAlias - | ClassName of Class - | EnumName of Enum - | EnumCaseName of string * Enum - | ModuleName of Module - | ValueName of Value - | MemberName of MemberAttribute * Member - | ImportedName of string * Set option * Import - | NotFound of string option - -module FullName = - let rec resolve (ctx: Context<'a, 's>) (name: string list) : string list option = - let nsRev = List.rev ctx.currentNamespace - let fullName = nsRev @ name - let onFail () = - match Context.ofParentNamespace ctx with Some ctx -> resolve ctx name | None -> None - match ctx.definitionsMap |> Trie.tryFind fullName with - | Some ((TypeAlias _ | ClassDef _ | EnumDef _ | Module _ | Value _ | Import _) :: _) -> Some fullName - | None when List.length name > 1 -> - let possibleEnumName = nsRev @ (name |> List.take (List.length name - 1)) - let possibleEnumCaseName = name |> List.last - let rec find = function - | EnumDef e :: _ when e.cases |> List.exists (fun c -> c.name = possibleEnumCaseName) -> - Some (possibleEnumName @ [possibleEnumCaseName]) - | _ :: xs -> find xs - | [] -> onFail () - match ctx.definitionsMap |> Trie.tryFind possibleEnumName with - | Some xs -> find xs - | _ -> onFail () - | _ -> onFail () - - let lookup (ctx: Context<'a, 's>) (fullName: string list) : FullNameLookupResult list = - let conv name = function - | TypeAlias a -> AliasName a |> Some - | ClassDef c -> ClassName c |> Some - | EnumDef e -> EnumName e |> Some - | Module m -> ModuleName m |> Some - | Value v -> ValueName v |> Some - | Import i -> - match i.clause with - | NamespaceImport ni when ni.name = name -> ImportedName (ni.name, ni.kind, i) |> Some - | ES6Import x -> - match x.defaultImport with - | Some di when di.name = name -> ImportedName (name, di.kind, i) |> Some - | _ -> - x.bindings - |> List.tryFind (fun b -> - match b.renameAs with - | Some renamed -> renamed = name - | None -> b.name = name) - |> Option.map (fun b -> ImportedName (name, b.kind, i)) - | _ -> None - | _ -> None - let result = ctx.definitionsMap |> Trie.tryFind fullName - [ - let itemName = List.last fullName - match result with - | Some xs -> yield! List.choose (conv itemName) xs - | None -> () - let containerName = fullName |> List.take (List.length fullName - 1) - let containerResult = ctx.definitionsMap |> Trie.tryFind containerName - let notFound fmt = - Printf.ksprintf (fun s -> NotFound (Some s)) fmt - let rec find = function - | EnumDef e :: rest -> - match e.cases |> List.tryFind (fun c -> c.name = itemName) with - | Some _ -> EnumCaseName (itemName, e) :: find rest - | None -> - notFound "The enum '%s' does not have a case '%s" (containerName |> String.concat ".") itemName :: find rest - | ClassDef c :: rest -> - let result = - c.members |> List.tryPick (fun (ma, m) -> - match m with - | Field (fl, _, _) | Getter fl | Setter fl when fl.name = itemName -> MemberName (ma, m) |> Some - | Method (name, _, _) when name = itemName -> MemberName (ma, m) |> Some - | _ -> None - ) - match result with - | None -> - match c.name with - | Some name -> - notFound "The class '%s' does not have a member '%s'" name itemName :: find rest - | None -> - notFound "The anonymous interface '%s' does not have a member '%s'" (Type.pp (AnonymousInterface c)) itemName :: find rest - | Some x -> x :: find rest - | _ :: rest -> find rest - | [] -> [notFound "Current context doesn't contain '%s'" (fullName |> String.concat ".")] - match containerResult with - | Some xs -> yield! find xs - | None -> () - ] - - let lookupWith ctx fullName picker = - let result = lookup ctx fullName - match List.tryPick picker result with - | Some x -> x - | None -> - match List.choose (function NotFound msg -> msg | _ -> None) result with - | [] -> - failwithf "error: failed to find '%s' from the context. current context doesn't contain it." - (String.concat "." fullName) - | errors -> - failwithf "error: failed to find '%s' from the context. %s" - (errors |> List.map (fun s -> " " + s) |> String.concat System.Environment.NewLine) - - let tryLookupWith ctx fullName picker = - lookup ctx fullName |> List.tryPick picker - - let hasKind ctx kind fullName = - lookup ctx fullName - |> List.exists (function - | AliasName _ -> kind = Kind.Type - | EnumName _ | EnumCaseName _ -> kind = Kind.Type || kind = Kind.Enum - | ClassName c -> kind = Kind.Type || kind = Kind.ClassLike || (not c.isInterface && kind = Kind.Value) - | ModuleName _ -> kind = Kind.Module - | ValueName _ | MemberName _ -> kind = Kind.Value - | NotFound _ -> false - | ImportedName (_, kinds, i) -> - if i.isTypeOnly then kind = Kind.Type - else - match kinds with - | None -> false - | Some kinds -> kinds |> Set.contains kind) - - let getKind ctx fullName = - lookup ctx fullName - |> List.map (function - | AliasName _ -> Set.singleton Kind.Type - | EnumName _ | EnumCaseName _ -> Set.ofList [Kind.Type; Kind.Enum] - | ClassName c -> - if c.isInterface then Set.ofList [Kind.Type; Kind.ClassLike] - else Set.ofList [Kind.Type; Kind.ClassLike; Kind.Value] - | ModuleName _ -> Set.singleton Kind.Module - | ValueName _ | MemberName _ -> Set.singleton Kind.Value - | NotFound _ -> Set.empty - | ImportedName (_, kind, i) -> - let dv = if i.isTypeOnly then Set.singleton Kind.Type else Set.empty - kind |> Option.defaultValue dv) - |> Set.unionMany - -module Type = - let rec mapInTypeParam mapping (ctx: 'Context) (tp: TypeParam) = - { tp with - extends = Option.map (mapping ctx) tp.extends - defaultType = Option.map (mapping ctx) tp.defaultType } - - and mapInArg mapping ctx (arg: Choice) = - match arg with - | Choice1Of2 a -> mapInFieldLike mapping ctx a |> Choice1Of2 - | Choice2Of2 t -> mapping ctx t |> Choice2Of2 - - and mapInFuncType mapping (ctx: 'Context) f = - { f with - returnType = mapping ctx f.returnType - args = List.map (mapInArg mapping ctx) f.args } - - and mapInClass mapping (ctx: 'Context) (c: Class) : Class = - let mapMember = function - | Field (f, m, tps) -> Field (mapInFieldLike mapping ctx f, m, List.map (mapInTypeParam mapping ctx) tps) - | FunctionInterface (f, tps) -> FunctionInterface (mapInFuncType mapping ctx f, List.map (mapInTypeParam mapping ctx) tps) - | Indexer (f, m) -> Indexer (mapInFuncType mapping ctx f, m) - | Constructor (c, tps) -> Constructor ({ c with args = List.map (mapInArg mapping ctx) c.args }, List.map (mapInTypeParam mapping ctx) tps) - | Getter f -> Getter (mapInFieldLike mapping ctx f) - | Setter f -> Setter (mapInFieldLike mapping ctx f) - | New (f, tps) -> New (mapInFuncType mapping ctx f, List.map (mapInTypeParam mapping ctx) tps) - | Method (name, f, tps) -> Method (name, mapInFuncType mapping ctx f, List.map (mapInTypeParam mapping ctx) tps) - | SymbolIndexer (sn, ft, m) -> SymbolIndexer (sn, mapInFuncType mapping ctx ft, m) - | UnknownMember msgo -> UnknownMember msgo - { c with - implements = c.implements |> List.map (mapping ctx) - members = c.members |> List.map (fun (a, m) -> a, mapMember m) - typeParams = c.typeParams |> List.map (mapInTypeParam mapping ctx) } - - and mapInFieldLike mapping (ctx: 'Context) (fl: FieldLike) : FieldLike = - { fl with value = mapping ctx fl.value } - - let mapInTupleType (f: Type -> Type) (ts: TupleType) = - { ts with types = ts.types |> List.map (fun t -> {| t with value = f t.value|})} - - let rec substTypeVar (subst: Map) _ctx = function - | TypeVar v -> - match subst |> Map.tryFind v with - | Some t -> t - | None -> TypeVar v - | Union u -> - Union { - types = u.types |> List.map (substTypeVar subst _ctx); - } - | Intersection i -> - Intersection { - types = i.types |> List.map (substTypeVar subst _ctx); - } - | Tuple ts -> Tuple (ts |> mapInTupleType (substTypeVar subst _ctx)) - | AnonymousInterface c -> AnonymousInterface (mapInClass (substTypeVar subst) _ctx c) - | Function f -> Function (substTypeVarInFunction subst _ctx f) - | App (t, ts, loc) -> App (t, ts |> List.map (substTypeVar subst _ctx), loc) - | Ident i -> Ident i | Prim p -> Prim p | TypeLiteral l -> TypeLiteral l - | PolymorphicThis -> PolymorphicThis | Intrinsic -> Intrinsic - | Erased (e, loc, origText) -> - let e' = - match e with - | IndexedAccess (t1, t2) -> IndexedAccess (substTypeVar subst _ctx t1, substTypeVar subst _ctx t2) - | TypeQuery i -> TypeQuery i - | Keyof t -> Keyof (substTypeVar subst _ctx t) - | NewableFunction (f, typrms) -> - let mapTyprm (tp: TypeParam) = - { tp with - extends = Option.map (substTypeVar subst _ctx) tp.extends - defaultType = Option.map (substTypeVar subst _ctx) tp.defaultType } - NewableFunction (substTypeVarInFunction subst _ctx f, List.map mapTyprm typrms) - Erased (e', loc, origText) - | UnknownType msgo -> UnknownType msgo - - and substTypeVarInFunction subst _ctx f = - { f with - returnType = substTypeVar subst _ctx f.returnType; - args = List.map (mapInArg (substTypeVar subst) _ctx) f.args } - - let rec findTypesInFieldLike pred (fl: FieldLike) = findTypes pred fl.value - and findTypesInTypeParam pred (tp: TypeParam) = - seq { - yield! tp.extends |> Option.map (findTypes pred) |> Option.defaultValue Seq.empty - yield! tp.defaultType |> Option.map (findTypes pred) |> Option.defaultValue Seq.empty - } - and findTypesInFuncType pred (ft: FuncType) = - seq { - for arg in ft.args do - match arg with - | Choice1Of2 fl -> yield! findTypesInFieldLike pred fl - | Choice2Of2 t -> yield! findTypes pred t - yield! findTypes pred ft.returnType - } - and findTypesInClassMember pred (m: Member) : 'a seq = - match m with - | Field (fl, _, tps) -> - seq { yield! findTypesInFieldLike pred fl; for tp in tps do yield! findTypesInTypeParam pred tp } - | Method (_, ft, tps) - | FunctionInterface (ft, tps) - | New (ft, tps) -> - seq { yield! findTypesInFuncType pred ft; for tp in tps do yield! findTypesInTypeParam pred tp } - | Indexer (ft, _) | SymbolIndexer (_, ft, _) -> - seq { yield! findTypesInFuncType pred ft } - | Getter fl | Setter fl -> seq { yield! findTypesInFieldLike pred fl } - | Constructor (ft, tps) -> - seq { - for arg in ft.args do - match arg with - | Choice1Of2 fl -> yield! findTypesInFieldLike pred fl - | Choice2Of2 t -> yield! findTypes pred t - for tp in tps do yield! findTypesInTypeParam pred tp - } - | UnknownMember _ -> Seq.empty - and findTypes (pred: Type -> Choice * 'a option) (t: Type) : 'a seq = - let rec go_t x = - seq { - let cont, y = pred x - match y with Some v -> yield v | None -> () - match cont with - | Choice1Of2 false -> () - | Choice2Of2 ts -> for t in ts do yield! go_t t - | Choice1Of2 true -> - match x with - | App (t, ts, _) -> - yield! go_t (Type.ofAppLeftHandSide t) - for t in ts do yield! go_t t - | Union { types = ts } | Intersection { types = ts } -> - for t in ts do yield! go_t t - | Tuple { types = ts } -> - for t in ts do yield! go_t t.value - | Function f -> yield! findTypesInFuncType pred f - | Erased (e, _, _) -> - match e with - | IndexedAccess (t1, t2) -> - yield! go_t t1 - yield! go_t t2 - | TypeQuery i -> - yield! findTypes pred (Ident i) - | Keyof t -> - yield! findTypes pred t - | NewableFunction (ft, tps) -> - yield! findTypesInFuncType pred ft - for tp in tps do - yield! findTypesInTypeParam pred tp - | AnonymousInterface c -> - for impl in c.implements do yield! findTypes pred impl - for tp in c.typeParams do yield! findTypesInTypeParam pred tp - for _, m in c.members do yield! findTypesInClassMember pred m - | Intrinsic | PolymorphicThis | Ident _ | TypeVar _ | Prim _ | TypeLiteral _ | UnknownType _ -> () - } - go_t t - - let getTypeVars ty = - findTypes (function - | TypeVar s -> Choice1Of2 false, Some s - | _ -> Choice1Of2 true, None - ) ty - - let rec getFreeTypeVarsPredicate t = - match t with - | TypeVar s -> Choice1Of2 true, Some (Set.singleton s) - | AnonymousInterface a -> - let memberFvs = - a.members |> List.map (fun (_, m) -> - match m with - | Field (fl, _, tps) -> - Set.difference (findTypesInFieldLike getFreeTypeVarsPredicate fl |> Set.unionMany) (tps |> List.map (fun tp -> tp.name) |> Set.ofList) - | Method (_, ft, tps) | FunctionInterface (ft, tps) | New (ft, tps) -> - Set.difference (findTypesInFuncType getFreeTypeVarsPredicate ft |> Set.unionMany) (tps |> List.map (fun tp -> tp.name) |> Set.ofList) - | Constructor (ft, tps) -> - let ft = ft |> FuncType.map (fun _ -> PolymorphicThis) - Set.difference (findTypesInFuncType getFreeTypeVarsPredicate ft |> Set.unionMany) (tps |> List.map (fun tp -> tp.name) |> Set.ofList) - | Indexer (ft, _) | SymbolIndexer (_, ft, _) -> findTypesInFuncType getFreeTypeVarsPredicate ft |> Set.unionMany - | Getter fl | Setter fl -> findTypesInFieldLike getFreeTypeVarsPredicate fl |> Set.unionMany - | UnknownMember _ -> Set.empty - ) |> Set.unionMany - let fvs = Set.difference memberFvs (a.typeParams |> List.map (fun tp -> tp.name) |> Set.ofList) - Choice1Of2 false, Some fvs - | _ -> Choice1Of2 true, None - - let getFreeTypeVars ty = findTypes getFreeTypeVarsPredicate ty |> Set.unionMany - - let rec assignTypeParams fn (loc: Location) (typrms: TypeParam list) (xs: 'a list) (f: TypeParam -> 'a -> 'b) (g: TypeParam -> 'b) : 'b list = - match typrms, xs with - | typrm :: typrms, x :: xs -> - f typrm x :: assignTypeParams fn loc typrms xs f g - | typrm :: typrms, [] -> - g typrm :: assignTypeParams fn loc typrms [] f g - | [], [] -> [] - | [], _ :: _ -> - failwithf "assignTypeParams: too many type arguments for type '%s' at %s" (String.concat "." fn) (loc.AsString) - - let createBindings fn (loc: Location) typrms ts = - assignTypeParams fn loc typrms ts - (fun tv ty -> tv.name, ty) - (fun tv -> - match tv.defaultType with - | Some ty -> tv.name, ty - | None -> - failwithf "createBindings: insufficient type arguments for type '%s' at %s" (String.concat "." fn) (loc.AsString)) - |> Map.ofList - - let getPossibleArity (typrms: TypeParam list) : Set = - let maxArity = List.length typrms - let rec go i = function - | { defaultType = Some _ } :: rest -> (i-1) :: go (i-1) rest - | { defaultType = None } :: rest -> go i rest - | [] -> [] - maxArity :: go maxArity typrms |> Set.ofList - - type [] InheritingType = - | KnownIdent of {| fullName: string list; tyargs: Type list |} - | Prim of PrimType * tyargs:Type list - | Other of Type - | ImportedIdent of {| name: string list; fullName: string list; tyargs: Type list |} - | UnknownIdent of {| name: string list; tyargs: Type list |} - - let substTypeVarInInheritingType subst ctx = function - | InheritingType.KnownIdent x -> - InheritingType.KnownIdent {| x with tyargs = x.tyargs |> List.map (substTypeVar subst ctx) |} - | InheritingType.ImportedIdent x -> - InheritingType.ImportedIdent {| x with tyargs = x.tyargs |> List.map (substTypeVar subst ctx) |} - | InheritingType.UnknownIdent x -> - InheritingType.UnknownIdent {| x with tyargs = x.tyargs |> List.map (substTypeVar subst ctx) |} - | InheritingType.Prim (p, ts) -> - InheritingType.Prim (p, ts |> List.map (substTypeVar subst ctx)) - | InheritingType.Other t -> - InheritingType.Other (substTypeVar subst ctx t) - - let inline private (|Dummy|) _ = [] - let mutable private inheritCache: Map = Map.empty - let mutable private hasNoInherits: Set = Set.empty - - let rec private getAllInheritancesImpl (depth: int) (includeSelf: bool) (ctx: Context<'a, 's>) (ty: Type) : (InheritingType * int) seq = - let treatPrimTypeInterfaces (name: string list) (ts: Type list) = - match name with - | [name] -> - match PrimType.FromJSClassName name with - | None -> None - | Some p -> - Some (InheritingType.Prim (p, ts), depth) - | _ -> None - - seq { - match ty with - | Ident { name = name; fullName = Some fn; loc = loc } & Dummy ts - | App (AIdent { name = name; fullName = Some fn }, ts, loc) -> - yield! treatPrimTypeInterfaces name ts |> Option.toList - yield! - FullName.lookup ctx fn - |> List.tryPick (function - | AliasName { typeParams = typrms } | ClassName { typeParams = typrms } -> - let subst = createBindings fn loc typrms ts - getAllInheritancesFromNameImpl (depth+1) includeSelf ctx fn - |> Seq.map (fun (t, d) -> substTypeVarInInheritingType subst ctx t, d) |> Some - | ImportedName _ -> - if includeSelf then - Some (Seq.singleton (InheritingType.ImportedIdent {| name = name; fullName = fn; tyargs = ts |}, depth)) - else None - | _ -> None - ) |> Option.defaultValue Seq.empty - | Ident { name = name; fullName = None } & Dummy ts - | App (AIdent { name = name; fullName = None }, ts, _) -> - yield! treatPrimTypeInterfaces name ts |> Option.toList - if includeSelf then - yield InheritingType.UnknownIdent {| name = name; tyargs = ts |}, depth - | Prim p & Dummy ts - | App (APrim p, ts, _) -> - if includeSelf then - yield InheritingType.Prim (p, ts), depth - | _ -> - if includeSelf then - yield InheritingType.Other ty, depth - } - - and private getAllInheritancesFromNameImpl (depth: int) (includeSelf: bool) (ctx: Context<'a, 's>) (fn: string list) : (InheritingType * int) list = - if hasNoInherits |> Set.contains fn then List.empty - else - match inheritCache |> Map.tryFind fn with - | Some (s, selfo) -> - let ret = - if includeSelf then - match selfo with - | None -> s - | Some self -> (self, 0) :: s - else s - ret |> List.map (fun (t, d) -> t, d + depth) - | None -> - let result = - FullName.lookup ctx fn |> Seq.tryPick (function - | ClassName c -> - let self = - InheritingType.KnownIdent {| fullName = fn; tyargs = c.typeParams |> List.map (fun tp -> TypeVar tp.name) |} - let s = c.implements |> Seq.collect (getAllInheritancesImpl (depth+1) true ctx) - Some (s, Some self) - | AliasName a -> - let tyargs = - a.typeParams |> List.map (fun tp -> TypeVar tp.name) - let s = - let subst = createBindings fn a.loc a.typeParams tyargs - getAllInheritancesImpl (depth+1) true ctx a.target - |> Seq.map (fun (t, d) -> substTypeVarInInheritingType subst ctx t, d) - Some (s, None) - | _ -> None - ) - match result with - | None -> - hasNoInherits <- hasNoInherits |> Set.add fn - List.empty - | Some (s, selfo) -> - let s = Seq.toList s - inheritCache <- inheritCache |> Map.add fn (s |> List.map (fun (t, d) -> t, d - depth), selfo) - if includeSelf then - match selfo with - | None -> s - | Some self -> (self, depth) :: s - else s - - and private removeDuplicatesFromInheritingTypes (xs: (InheritingType * int) seq) : Set = - xs - |> Seq.groupBy (fun (t, _) -> - match t with - | InheritingType.KnownIdent i -> Choice1Of5 i.fullName - | InheritingType.UnknownIdent i -> Choice2Of5 i.name - | InheritingType.ImportedIdent i -> Choice3Of5 i.name - | InheritingType.Prim (p, _) -> Choice4Of5 p - | InheritingType.Other ty -> Choice5Of5 ty) - |> Seq.map (fun (_, xs) -> - xs |> Seq.sortBy (fun (_, depth) -> depth) |> Seq.head |> fst) - |> Set.ofSeq - - let getAllInheritances ctx ty = getAllInheritancesImpl 0 false ctx ty |> removeDuplicatesFromInheritingTypes - let getAllInheritancesFromName ctx fn = getAllInheritancesFromNameImpl 0 false ctx fn |> removeDuplicatesFromInheritingTypes - let getAllInheritancesAndSelf ctx ty = getAllInheritancesImpl 0 true ctx ty |> removeDuplicatesFromInheritingTypes - let getAllInheritancesAndSelfFromName ctx fn = getAllInheritancesFromNameImpl 0 true ctx fn |> removeDuplicatesFromInheritingTypes - - let createFunctionInterface (funcs: {| ty: FuncType; typrms: TypeParam list; comments: Comment list; loc: Location; isNewable: bool |} list) = - let usedTyprms = - funcs |> Seq.collect (fun f -> getTypeVars (Function f.ty)) |> Set.ofSeq - let boundTyprms = - let typrms = funcs |> List.collect (fun f -> f.typrms) |> List.map (fun x -> x.name) |> Set.ofList - Set.difference usedTyprms typrms - |> Set.toList - |> List.map (fun name -> { name = name; extends = None; defaultType = None }) - let ai = - { - comments = [] - name = None - accessibility = Public - isInterface = true - isExported = Exported.No - implements = [] - typeParams = boundTyprms - members = [ - for f in funcs do - { comments = f.comments; loc = f.loc; isStatic = false; accessibility = Public }, - if f.isNewable then New (f.ty, f.typrms) - else FunctionInterface (f.ty, f.typrms) - ] - loc = MultipleLocation (funcs |> List.map (fun f -> f.loc)) - } - if List.isEmpty boundTyprms then AnonymousInterface ai - else - App ( - AAnonymousInterface ai, - boundTyprms |> List.map (fun x -> TypeVar x.name), - MultipleLocation (funcs |> List.map (fun f -> f.loc)) - ) - - /// needs to resolve identifiers before using this - let rec resolveErasedTypeImpl typeQueries ctx = function - | PolymorphicThis -> PolymorphicThis | Intrinsic -> Intrinsic - | Ident i -> Ident i | TypeVar v -> TypeVar v | Prim p -> Prim p | TypeLiteral l -> TypeLiteral l - | AnonymousInterface c -> mapInClass (resolveErasedTypeImpl typeQueries) ctx c |> AnonymousInterface - | Union { types = types } -> Union { types = List.map (resolveErasedTypeImpl typeQueries ctx) types } - | Intersection { types = types } -> Intersection { types = List.map (resolveErasedTypeImpl typeQueries ctx) types } - | Tuple ts -> Tuple (mapInTupleType (resolveErasedTypeImpl typeQueries ctx) ts) - | Function ft -> mapInFuncType (resolveErasedTypeImpl typeQueries) ctx ft |> Function - | App (t, ts, loc) -> App (t, List.map (resolveErasedTypeImpl typeQueries ctx) ts, loc) - | Erased (e, loc, origText) -> - let comments = [Description [origText]] - match e with - | IndexedAccess (tobj, tindex) -> - let onFail () = - warn ctx loc "cannot resolve an indexed access type '%s'" origText - UnknownType (Some origText) - - let resolveIndexedAccessOfClass (c: Class) (indexTy: Type) : Type option = - let members = c.members |> List.map snd - let intersection = function - | [] -> None - | [t] -> Some t - | ts -> Some (Intersection { types = ts }) - let rec go = function - | TypeLiteral (LString name) -> - let funcs, others = - members - |> List.choose (function - | Field (fl, _, []) | Getter fl | Setter fl when fl.name = name -> - if fl.isOptional then Some (Choice2Of2 (Union { types = [fl.value; Prim Undefined]})) - else Some (Choice2Of2 fl.value) - | Method (name', ft, typrms) when name = name' -> - Some (Choice1Of2 {| ty = ft; typrms = typrms; comments = comments; loc = loc; isNewable = false |}) - | Constructor (_, _) when name = "constructor" -> Some (Choice2Of2 (Prim UntypedFunction)) - | _ -> None) - |> List.splitChoice2 - match funcs, others with - | [], [] -> None - | _, [] -> createFunctionInterface funcs |> Some - | [], _ -> Union { types = others } |> Some - | _, _ -> Union { types = createFunctionInterface funcs :: others } |> Some - | TypeLiteral (LInt _) | Prim Number -> - members - |> List.choose (function Indexer (ft, _) -> Some ft.returnType | _ -> None) - |> intersection - | Prim Never -> Some (Prim Never) - | Union { types = ts } -> - match List.choose go ts with - | [] -> None - | [t] -> Some t - | ts -> Some (Union { types = ts }) - | _ -> None - go indexTy - - let rec memberChooser m t2 = - match m, t2 with - | (Field (fl, _, []) | Getter fl | Setter fl), - TypeLiteral (LString name) when fl.name = name -> - if fl.isOptional then Some (Union { types = [fl.value; Prim Undefined] }) - else Some fl.value - | Constructor (_, _), TypeLiteral (LString name) when name = "constructor" -> - Some (Prim UntypedFunction) - | Indexer (ft, _), (Prim Number | TypeLiteral (LInt _)) -> Some ft.returnType - | Method (name', ft, typrms), TypeLiteral (LString name) when name = name' -> - Some (createFunctionInterface [{| ty = ft; typrms = typrms; comments = comments; loc = loc; isNewable = false |}]) - | _, Union { types = ts } -> - match ts |> List.choose (memberChooser m) with - | [] -> None - | [t] -> Some t - | ts -> Some (Union { types = ts }) - | _, _ -> None - - let rec go t1 t2 = - match t1, t2 with - | Union { types = ts }, _ -> Union { types = List.map (fun t1 -> go t1 t2) ts } - | Intersection { types = ts }, _ -> Intersection { types = List.map (fun t1 -> go t1 t2) ts } - | AnonymousInterface c, _ -> - resolveIndexedAccessOfClass c t2 |> Option.defaultWith onFail - | App ((APrim Array | APrim ReadonlyArray), [t], _), Prim (Number | Any) -> t - | Tuple ts, TypeLiteral (LInt i) -> - match ts.types |> List.tryItem i with - | Some t -> t.value - | None -> onFail () - | Tuple ts, Prim (Number | Any) -> Union { types = ts.types |> List.map (fun x -> x.value) } - | (App (AIdent { fullName = Some fn }, ts, loc) | (Ident { fullName = Some fn; loc = loc } & Dummy ts)), _ -> - FullName.tryLookupWith ctx fn (function - | AliasName ta -> - let subst = createBindings fn loc ta.typeParams ts - let target = - ta.target |> substTypeVar subst ctx |> resolveErasedTypeImpl typeQueries ctx - go target t2 |> Some - | ClassName c -> - let subst = createBindings fn loc c.typeParams ts - let c = c |> mapInClass (fun ctx -> substTypeVar subst ctx >> resolveErasedTypeImpl typeQueries ctx) ctx - resolveIndexedAccessOfClass c t2 - | _ -> None - ) |> Option.defaultWith onFail - | _, _ -> onFail () - go (resolveErasedTypeImpl typeQueries ctx tobj) (resolveErasedTypeImpl typeQueries ctx tindex) - | TypeQuery i -> - let onFail () = - warn ctx loc "cannot resolve a type query '%s'" origText - UnknownType (Some origText) - match i.fullName with - | None -> onFail () - | Some fn when typeQueries |> Set.contains fn -> - warn ctx loc "a recursive type query '%s' is detected and is ignored" origText - UnknownType (Some origText) - | Some fn -> - let result typrms ty = - let typeQueries = Set.add fn typeQueries - let typrms = List.map (mapInTypeParam (resolveErasedTypeImpl typeQueries) ctx) typrms - let ty = resolveErasedTypeImpl typeQueries ctx ty - match typrms, ty with - | _ :: _, Function ft -> - createFunctionInterface [{| ty = ft; typrms = typrms; comments = comments; loc = loc; isNewable = false |}] - | _ :: _, _ -> onFail () - | [], _ -> ty - FullName.tryLookupWith ctx fn (function - | ValueName v -> result v.typeParams v.typ |> Some - | MemberName (_, m) -> - match m with - | Field (ft, _, typrms) | (Getter ft & Dummy typrms) | (Setter ft & Dummy typrms) -> - match ft.isOptional, result typrms ft.value with - | true, UnknownType msgo -> UnknownType msgo |> Some - | true, t -> Union { types = [t; Prim Undefined] } |> Some - | false, t -> Some t - | Method (_, ft, typrms) -> result typrms (Function ft) |> Some - | _ -> None - | _ -> None - ) |> Option.defaultWith onFail - | Keyof t -> - let t = resolveErasedTypeImpl typeQueries ctx t - let onFail () = - let tyText = Type.pp t - warn ctx loc "cannot resolve a type operator 'keyof %s'" tyText - UnknownType (Some tyText) - let memberChooser = function - | Field (fl, _, _) | Getter fl | Setter fl -> Set.singleton (TypeLiteral (LString fl.name)) - | Method (name, _, _) -> Set.singleton (TypeLiteral (LString name)) - | _ -> Set.empty - let rec go t = - match t with - | Union { types = ts } -> ts |> List.map go |> Set.intersectMany - | Intersection { types = ts } -> ts |> List.map go |> Set.unionMany - | AnonymousInterface i -> - i.members |> List.map (snd >> memberChooser) |> Set.unionMany - | App ((APrim Array | APrim ReadonlyArray), [_], _) | Tuple _ -> Set.singleton (Prim Number) - | (App (AIdent { fullName = Some fn }, ts, loc) | (Ident { fullName = Some fn; loc = loc } & Dummy ts)) -> - FullName.tryLookupWith ctx fn (function - | AliasName ta -> - let subst = createBindings fn loc ta.typeParams ts - ta.target |> substTypeVar subst ctx |> resolveErasedTypeImpl typeQueries ctx |> go |> Some - | ClassName c -> - let subst = createBindings fn loc c.typeParams ts - let c = c |> mapInClass (fun ctx -> substTypeVar subst ctx >> resolveErasedTypeImpl typeQueries ctx) ctx - c.members |> List.map (snd >> memberChooser) |> Set.unionMany |> Some - | _ -> None - ) |> Option.defaultValue Set.empty - | _ -> Set.empty - match Set.toList (go t) with - | [] -> onFail () - | [t] -> t - | types -> Union { types = types } - | NewableFunction (f, tyargs) -> - let f = mapInFuncType (resolveErasedTypeImpl typeQueries) ctx f - let tyargs = List.map (mapInTypeParam (resolveErasedTypeImpl typeQueries) ctx) tyargs - createFunctionInterface [{| ty = f; typrms = tyargs; comments = comments; loc = loc; isNewable = true |}] - | UnknownType msgo -> UnknownType msgo - - let resolveErasedType ctx ty = resolveErasedTypeImpl Set.empty ctx ty - - /// intended to be used as an identifier. - /// * can be any case. - /// * can be a reserved name (e.g. `this`). - /// * can start with a digit. - let rec getHumanReadableName (ctx: Context<_, _>) = function - | Intrinsic -> "intrinsic" - | PolymorphicThis -> "this" - | Ident i -> i.name |> List.last - | TypeVar v -> v - | Prim p -> - match p with - | String -> "string" | Bool -> "boolean" | Number -> "number" - | Any -> "any" | Void -> "void" | Unknown -> "unknown" - | Null -> "null" | Never -> "never" | Undefined -> "undefined" - | Symbol _ -> "symbol" | RegExp -> "RegExp" - | BigInt -> "BigInt" | Array -> "Array" - | ReadonlyArray -> "ReadonlyArray" - | Object -> "Object" | UntypedFunction -> "Function" - | TypeLiteral l -> - let formatString (s: string) = - (s :> char seq) - |> Seq.map (fun c -> - if Char.isAlphabetOrDigit c then c - else '_') - |> Seq.toArray |> System.String - let inline formatNumber (x: 'a) = - string x - |> String.replace "+" "plus" - |> String.replace "-" "minus" - |> String.replace "." "_" - match l with - | LString s -> formatString s - | LInt i -> formatNumber i - | LFloat f -> formatNumber f - | LBool true -> "true" | LBool false -> "false" - | AnonymousInterface c -> - match ctx.anonymousInterfacesMap |> Map.tryFind c, c.name with - | Some i, None -> sprintf "AnonymousInterface%d" i - | None, Some s -> s - | _ -> "AnonymousInterface" - | Union _ -> "union" | Intersection _ -> "intersection" | Tuple _ -> "tuple" - | Function _ -> "function" - | App (lhs, rhs, _) -> - match lhs with - | AIdent i -> getHumanReadableName ctx (Ident i) - | AAnonymousInterface c -> getHumanReadableName ctx (AnonymousInterface c) - | APrim Array -> - match rhs with - | [t] -> - let elemType = getHumanReadableName ctx t - Naming.toCase Naming.Case.PascalCase elemType + "Array" - | _ -> "Array" - | APrim p -> getHumanReadableName ctx (Prim p) - | Erased (et, _, _) -> - match et with - | Keyof t -> - let targetType = getHumanReadableName ctx t - "Keyof" + Naming.toCase Naming.Case.PascalCase targetType - | TypeQuery i -> - "Typeof" + Naming.toCase Naming.Case.PascalCase (List.last i.name) - | IndexedAccess (t1, t2) -> - let s1 = getHumanReadableName ctx t1 |> Naming.toCase Naming.Case.PascalCase - let s2 = getHumanReadableName ctx t2 |> Naming.toCase Naming.Case.PascalCase - s1 + s2 - | NewableFunction _ -> "constructor" - | UnknownType _ -> "unknown" - -type [] KnownType = - | Ident of fullName:string list - | AnonymousInterface of int - -module Statement = - let replaceAliasToFunctionWithInterface stmts = - let rec go = function - | Module m -> - Module { m with statements = List.map go m.statements } - | TypeAlias ta -> - match ta.target with - | Function f -> - ClassDef { - name = Some ta.name - isInterface = true - comments = ta.comments - accessibility = Protected - isExported = Exported.No - implements = [] - typeParams = ta.typeParams - members = [ - { comments = []; loc = f.loc; accessibility = Public; isStatic = false }, - FunctionInterface (f, []) - ] - loc = f.loc - } - | _ -> TypeAlias ta - | x -> x - List.map go stmts - - let rec merge (stmts: Statement list) = - let mutable result : Choice list = [] - - let mutable intfMap = Map.empty - let mutable nsMap = Map.empty - let mutable otherStmtSet = Set.empty - let mergeTypeParams tps1 tps2 = - let rec go acc = function - | [], [] -> List.rev acc - | tp1 :: rest1, tp2 :: rest2 -> - let inline check t1 t2 = - match t1, t2 with - | Some t, None | None, Some t -> Some t - | None, None -> None - | Some t1, Some t2 -> - assert (t1 = t2) - Some t1 - let extends = check tp1.extends tp2.extends - let defaultType = check tp1.defaultType tp2.defaultType - assert (tp1.name = tp2.name) - let tp = { name = tp1.name; extends = extends; defaultType = defaultType } - go (tp :: acc) (rest1, rest2) - | tp :: rest1, rest2 - | rest1, tp :: rest2 -> - let tp = - match tp.defaultType with - | Some _ -> tp - | None -> { tp with defaultType = Some (Prim Any) } - go (tp :: acc) (rest1, rest2) - go [] (tps1, tps2) - - for stmt in stmts do - match stmt with - | ClassDef i (* when i.isInterface *) -> - match intfMap |> Map.tryFind i.name with - | None -> - let iref = ref i - intfMap <- (intfMap |> Map.add i.name iref) - result <- Choice2Of3 iref :: result - | Some iref' -> - let i' = !iref' - assert (i.accessibility = i'.accessibility) - let i = - { i with - isInterface = i.isInterface && i'.isInterface - comments = i.comments @ i'.comments |> List.distinct - loc = i.loc ++ i'.loc - typeParams = mergeTypeParams i.typeParams i'.typeParams - implements = List.distinct (i.implements @ i'.implements) - members = i.members @ i'.members } - iref' := i - | Module n (* when n.isNamespace *) -> - match nsMap |> Map.tryFind n.name with - | None -> - let nref = ref n - nsMap <- (nsMap |> Map.add n.name nref) - result <- Choice3Of3 nref :: result - | Some nref' -> - let n' = !nref' - nref' := - { n with - loc = n.loc ++ n'.loc - comments = n.comments @ n'.comments |> List.distinct - statements = n'.statements @ n.statements } - | stmt -> - if otherStmtSet |> Set.contains stmt |> not then - otherStmtSet <- otherStmtSet |> Set.add stmt - result <- Choice1Of3 stmt :: result - result - |> List.rev - |> List.map (function - | Choice1Of3 s -> s - | Choice2Of3 i -> ClassDef !i - | Choice3Of3 n -> - Module { !n with statements = merge (!n).statements } - ) - - let inferEnumCaseValue (stmts: Statement list) : Statement list = - let rec go = function - | EnumDef e -> - let f (state: Literal option) (c: EnumCase) : EnumCase * Literal option = - match c.value with - | Some v -> c, Some v - | None -> - let v = - match state with - | None -> Some (LInt 0) - | Some (LInt n) -> Some (LInt (n+1)) - | Some (LFloat f) -> Some (LFloat (f+1.0)) - | Some _ -> None - { c with value = v }, v - EnumDef { e with cases = e.cases |> List.mapFold f None |> fst } - | Module m -> Module { m with statements = m.statements |> List.map go } - | s -> s - stmts |> List.map go - - let extractNamedDefinitions (stmts: Statement list) : Trie = - let rec go (ns: string list) trie s = - match s with - | Export _ - | UnknownStatement _ - | FloatingComment _ -> trie - | TypeAlias { name = name } - | ClassDef { name = Some name } - | EnumDef { name = name } - | Value { name = name } -> - trie |> Trie.addOrUpdate (ns @ [name]) [s] List.append - | ClassDef { name = None } -> failwith "impossible_extractNamedDefinitions" - | Import i -> - (* - match i.clause with - | NamespaceImport i -> trie |> Trie.addOrUpdate (ns @ [i.name]) [s] List.append - | ES6WildcardImport -> trie - | ES6Import i -> - let trie = - match i.defaultImport with - | Some x -> trie |> Trie.addOrUpdate (ns @ [x.name]) [s] List.append - | None -> trie - i.bindings |> List.fold (fun state b -> - match b.renameAs with - | Some name -> state |> Trie.addOrUpdate (ns @ [name]) [s] List.append - | None -> state |> Trie.addOrUpdate (ns @ [b.name]) [s] List.append - ) trie - *) - trie - | Pattern p -> p.underlyingStatements |> List.fold (go ns) trie - | Module m -> - let ns' = ns @ [m.name] - m.statements |> List.fold (go ns') trie |> Trie.addOrUpdate ns' [Module m] List.append - stmts |> List.fold (go []) Trie.empty - - open Type - - let findTypesInStatements pred (stmts: Statement list) : 'a seq = - let rec go = function - | TypeAlias ta -> - seq { - yield! findTypes pred ta.target; - for tp in ta.typeParams do - yield! findTypesInTypeParam pred tp - } - | ClassDef c -> - seq { - for impl in c.implements do - yield! findTypes pred impl - for tp in c.typeParams do - yield! findTypesInTypeParam pred tp - for _, m in c.members do - yield! findTypesInClassMember pred m - } - | Module m -> - m.statements |> Seq.collect go - | Value v -> - seq { - yield! findTypes pred v.typ - for tp in v.typeParams do - yield! findTypesInTypeParam pred tp - } - | EnumDef e -> - e.cases |> Seq.choose (fun c -> c.value) - |> Seq.collect (fun l -> findTypes pred (TypeLiteral l)) - | Import _ | Export _ | UnknownStatement _ | FloatingComment _ -> Seq.empty - | Pattern p -> - seq { - for stmt in p.underlyingStatements do - yield! go stmt - } - stmts |> Seq.collect go - - let getTypeLiterals stmts = - findTypesInStatements (function TypeLiteral l -> Choice1Of2 true, Some l | _ -> Choice1Of2 true, None) stmts |> Set.ofSeq - - let getAnonymousInterfaces stmts = - findTypesInStatements (function - | AnonymousInterface c when Option.isNone c.name -> Choice1Of2 true, Some c - | _ -> Choice1Of2 true, None - ) stmts |> Set.ofSeq - - let getUnknownIdentTypes ctx stmts = - let (|Dummy|) _ = [] - findTypesInStatements (function - | App (AIdent {name = name; fullName = None}, ts, _) - | (Ident { name = name; fullName = None } & Dummy ts) -> - Choice2Of2 ts, Some (name, Set.singleton (List.length ts)) - | App (AIdent {name = name; fullName = Some fn}, ts, _) - | (Ident { name = name; fullName = Some fn} & Dummy ts) when not (FullName.hasKind ctx Kind.Type fn) -> - Choice2Of2 ts, Some (name, Set.singleton (List.length ts)) - | _ -> Choice1Of2 true, None - ) stmts |> Seq.fold (fun state (k, v) -> Trie.addOrUpdate k v Set.union state) Trie.empty - - let getKnownTypes (ctx: Context<_, _>) stmts = - let (|Dummy|) _ = [] - findTypesInStatements (function - | App (AIdent { fullName = Some fn }, ts, _) -> - Choice2Of2 ts, Some (KnownType.Ident fn) - | Ident { fullName = Some fn } -> - Choice1Of2 true, Some (KnownType.Ident fn) - | AnonymousInterface a -> - let index = ctx.anonymousInterfacesMap |> Map.tryFind a - Choice1Of2 true, Option.map KnownType.AnonymousInterface index - | _ -> - Choice1Of2 true, None - ) stmts |> Set.ofSeq - - let rec mapType mapping (ctx: Context<_, _>) stmts = - let mapValue v = - { v with - typ = mapping ctx v.typ - typeParams = v.typeParams |> List.map (Type.mapInTypeParam mapping ctx) } - let f = function - | TypeAlias a -> - TypeAlias { - a with - target = mapping ctx a.target - typeParams = a.typeParams |> List.map (Type.mapInTypeParam mapping ctx) - } - | ClassDef c -> ClassDef (Type.mapInClass mapping ctx c) - | EnumDef e -> EnumDef e - | Import i -> Import i - | Export e -> Export e - | Value v -> Value (mapValue v) - | Module m -> - Module { - m with - statements = - mapType - mapping - {| ctx with currentNamespace = m.name :: ctx.currentNamespace |} - m.statements - } - | UnknownStatement u -> UnknownStatement u - | FloatingComment c -> FloatingComment c - | Pattern (ImmediateInstance (i, v)) -> Pattern (ImmediateInstance (Type.mapInClass mapping ctx i, mapValue v)) - | Pattern (ImmediateConstructor (bi, ci, v)) -> - Pattern (ImmediateConstructor (Type.mapInClass mapping ctx bi, Type.mapInClass mapping ctx ci, mapValue v)) - stmts |> List.map f - - let resolveErasedTypes (ctx: Context) (stmts: Statement list) = - mapType Type.resolveErasedType ctx stmts - - let introduceAdditionalInheritance (opts: TyperOptions) (stmts: Statement list) : Statement list = - let rec go stmts = - stmts |> List.map (function - | ClassDef (c & { name = Some name }) -> - let inherits = ResizeArray(c.implements) - - let has tyName = - name = tyName || inherits.Exists(fun t -> - match t with - | Ident { name = [name'] } - | App (AIdent { name = [name'] }, _, _) -> tyName = name' - | _ -> false - ) - - let inline app t ts loc = - App (AIdent { name = [t]; fullName = None; loc = loc}, ts, loc) - - for ma, m in c.members do - match m with - // iterator & iterable iterator - | SymbolIndexer ("iterator", { returnType = ty }, _) when opts.inheritIterable -> - match ty with - | App (AIdent { name = ["Iterator"] }, [argTy], _) when not (has "Iterable") -> - inherits.Add(app "Iterable" [argTy] ma.loc) - | App (AIdent { name = ["IterableIterator"] }, [argTy], _) when not (has "IterableIterator") -> - inherits.Add(app "IterableIterator" [argTy] ma.loc) - | _ -> () - - // async iterator & iterable iterator - | SymbolIndexer ("asyncIterator", { returnType = ty }, _) when opts.inheritIterable -> - match ty with - | App (AIdent { name = ["AsyncIterator"] }, [argTy], _) when not (has "AsyncIterable") -> - inherits.Add(app "AsyncIterable" [argTy] ma.loc) - | App (AIdent { name = ["AsyncIterableIterator"] }, [argTy], _) when not (has "AsyncIterableIterator") -> - inherits.Add(app "AsyncIterableIterator" [argTy] ma.loc) - | _ -> () - - // ArrayLike - | Indexer ({ args = [Choice1Of2 { value = Prim Number } | Choice2Of2 (Prim Number)]; returnType = retTy }, _) - when opts.inheritArraylike && not (has "ArrayLike") -> inherits.Add(app "ArrayLike" [retTy] ma.loc) - - // PromiseLike - | Method ("then", { args = [Choice1Of2 { name = "onfulfilled"; value = onfulfilled }; Choice1Of2 { name = "onrejected" }] }, _) - when opts.inheritPromiselike && not (has "PromiseLike") -> - match onfulfilled with - | Function { args = [Choice1Of2 { value = t } | Choice2Of2 t] } -> - inherits.Add(app "PromiseLike" [t] ma.loc) - | Union { types = ts } -> - for t in ts do - match t with - | Function { args = [Choice1Of2 { value = t } | Choice2Of2 t] } -> - inherits.Add(app "PromiseLike" [t] ma.loc) - | _ -> () - | _ -> () - - | _ -> () - - ClassDef { c with implements = List.ofSeq inherits |> List.distinct } - | x -> x - ) - go stmts - - let detectPatterns (stmts: Statement list) : Statement list = - let rec go stmts = - // declare var Foo: Foo - let valDict = new MutableMap() - // interface Foo { .. } - let intfDict = new MutableMap() - // declare var Foo: FooConstructor - let ctorValDict = new MutableMap() - // interface FooConstructor { .. } - let ctorIntfDict = new MutableMap() - - for stmt in stmts do - match stmt with - | Value (v & { name = name; typ = Ident { name = [intfName] } }) -> - if name = intfName then valDict.Add(name, v) - else if (name + "Constructor") = intfName then ctorValDict.Add(name, v) - | ClassDef (intf & { name = Some name; isInterface = true }) -> - if name <> "Constructor" && name.EndsWith("Constructor") then - let origName = name.Substring(0, name.Length - "Constructor".Length) - ctorIntfDict.Add(origName, intf) - else - intfDict.Add(name, intf) - | _ -> () - - let intersect (other: string seq) (set: MutableSet) = - let otherSet = new MutableSet(other) - for s in set do - if not <| otherSet.Contains(s) then - set.Remove(s) |> ignore - set - - let immediateInstances = - new MutableSet(valDict.Keys) - |> intersect intfDict.Keys - let immediateCtors = - new MutableSet(intfDict.Keys) - |> intersect ctorValDict.Keys - |> intersect ctorIntfDict.Keys - - stmts |> List.choose (function - | Value (v & { name = name; typ = Ident { name = [intfName] } }) -> - if name = intfName && immediateInstances.Contains name && valDict.[name] = v then - let intf = intfDict.[name] - Some (Pattern (ImmediateInstance (intf, v))) - else if name + "Constructor" = intfName && immediateCtors.Contains name && ctorValDict.[name] = v then - let baseIntf = intfDict.[name] - let ctorIntf = ctorIntfDict.[name] - Some (Pattern (ImmediateConstructor (baseIntf, ctorIntf, v))) - else - Some (Value v) - | ClassDef (intf & { name = Some name; isInterface = true }) -> - if (immediateInstances.Contains name || immediateCtors.Contains name) then None - else if name <> "Constructor" && name.EndsWith("Constructor") then - let origName = name.Substring(0, name.Length - "Constructor".Length) - if immediateCtors.Contains origName then None - else Some (ClassDef intf) - else Some (ClassDef intf) - | Module m -> Some (Module { m with statements = go m.statements }) - | x -> Some x - ) - go stmts - -module Ident = - let rec mapInType (mapping: Context<'a, 's> -> IdentType -> IdentType) (ctx: Context<'a, 's>) = function - | Ident i -> Ident (mapping ctx i) - | Union u -> Union { types = u.types |> List.map (mapInType mapping ctx) } - | Intersection i -> Intersection { types = i.types |> List.map (mapInType mapping ctx) } - | Tuple ts -> Tuple (Type.mapInTupleType (mapInType mapping ctx) ts) - | AnonymousInterface c -> AnonymousInterface (Type.mapInClass (mapInType mapping) ctx c) - | Function f -> Function (mapInFunction mapping ctx f) - | App (t, ts, loc) -> App (mapInAppLHS mapping ctx t, ts |> List.map (mapInType mapping ctx), loc) - | Prim p -> Prim p | TypeLiteral l -> TypeLiteral l | TypeVar v -> TypeVar v - | PolymorphicThis -> PolymorphicThis | Intrinsic -> Intrinsic - | Erased (e, loc, origText) -> - let e' = - match e with - | IndexedAccess (t1, t2) -> IndexedAccess (mapInType mapping ctx t1, mapInType mapping ctx t2) - | TypeQuery i -> TypeQuery (mapping ctx i) - | Keyof t -> Keyof (mapInType mapping ctx t) - | NewableFunction (f, typrms) -> - let mapTyprm (tp: TypeParam) = - { tp with - extends = Option.map (mapInType mapping ctx) tp.extends - defaultType = Option.map (mapInType mapping ctx) tp.defaultType } - NewableFunction (mapInFunction mapping ctx f, List.map mapTyprm typrms) - Erased (e', loc, origText) - | UnknownType msg -> UnknownType msg - - and mapInFunction mapping ctx f = - { f with - returnType = mapInType mapping ctx f.returnType; - args = List.map (Type.mapInArg (mapInType mapping) ctx) f.args } - - and mapInAppLHS mapping ctx = function - | APrim p -> APrim p - | AIdent i -> AIdent (mapping ctx i) - | AAnonymousInterface i -> AAnonymousInterface (Type.mapInClass (mapInType mapping) ctx i) - - let rec mapInStatements mapType mapExport (ctx: Context<'a, 's>) (stmts: Statement list) : Statement list = - let mapValue v = - { v with - typ = mapInType mapType ctx v.typ - typeParams = v.typeParams |> List.map (Type.mapInTypeParam (mapInType mapType) ctx) } - let f = function - | TypeAlias a -> - TypeAlias { - a with - target = mapInType mapType ctx a.target - typeParams = a.typeParams |> List.map (Type.mapInTypeParam (mapInType mapType) ctx) - } - | ClassDef c -> - ClassDef (Type.mapInClass (mapInType mapType) ctx c) - | EnumDef e -> EnumDef e - | Import i -> Import i - | Export e -> Export (mapExport ctx e) - | Value v -> Value (mapValue v) - | Module m -> - Module { - m with - statements = - mapInStatements - mapType mapExport - (ctx |> Context.ofChildNamespace m.name) - m.statements - } - | UnknownStatement u -> UnknownStatement u | FloatingComment c -> FloatingComment c - | Pattern (ImmediateInstance (i, v)) -> Pattern (ImmediateInstance (Type.mapInClass (mapInType mapType) ctx i, mapValue v)) - | Pattern (ImmediateConstructor (bi, ci, v)) -> - Pattern (ImmediateConstructor (Type.mapInClass (mapInType mapType) ctx bi, Type.mapInClass (mapInType mapType) ctx ci, mapValue v)) - stmts |> List.map f - - let resolve (ctx: Context<'a, 's>) (i: IdentType) : IdentType = - match i.fullName with - | Some _ -> i - | None -> - match FullName.resolve ctx i.name with - | Some fn -> { i with fullName = Some fn } - | None -> i - - let resolveInStatements (ctx: Context<'a, 's>) (stmts: Statement list) : Statement list = - mapInStatements - (fun ctx i -> resolve ctx i) - (fun ctx e -> - let clause = - match e.clause with - | CommonJsExport i -> CommonJsExport (resolve ctx i) - | ES6DefaultExport i -> ES6DefaultExport (resolve ctx i) - | ES6Export x -> ES6Export {| x with target = resolve ctx x.target |} - | NamespaceExport ns -> NamespaceExport ns - { e with clause = clause } - ) ctx stmts - - let getKind (ctx: Context<'a, 's>) (i: IdentType) = - match i.fullName with - | None -> Set.empty - | Some fn -> FullName.getKind ctx fn - - let hasKind (ctx: Context<'a, 's>) kind (i: IdentType) = - i.fullName |> Option.map (FullName.hasKind ctx kind) - -type TypeofableType = TNumber | TString | TBoolean | TSymbol | TBigInt - -type ResolvedUnion = { - caseNull: bool - caseUndefined: bool - typeofableTypes: Set - caseArray: Set option - caseEnum: Set> - discriminatedUnions: Map> - otherTypes: Set -} - -module TypeofableType = - let toType = function - | TNumber -> Prim Number - | TString -> Prim String - | TBoolean -> Prim Bool - | TSymbol -> Prim (Symbol false) - | TBigInt -> Prim BigInt - -module ResolvedUnion = - let rec pp (ru: ResolvedUnion) = - let cases = [ - if ru.caseNull then yield "null" - if ru.caseUndefined then yield "undefined" - for x in ru.typeofableTypes do - yield - match x with TNumber -> "number" | TString -> "string" | TBoolean -> "boolean" | TSymbol -> "symbol" | TBigInt -> "bigint" - match ru.caseArray with - | Some t -> yield sprintf "array<%s>" (t |> Set.toSeq |> Seq.map Type.pp |> String.concat " | ") - | None -> () - if not (Set.isEmpty ru.caseEnum) then - let cases = - ru.caseEnum - |> Set.toSeq - |> Seq.map (function - | Choice1Of2 ({ name = ty }, { name = name; value = Some value }) -> sprintf "%s.%s=%s" ty name (Literal.toString value) - | Choice1Of2 ({ name = ty }, { name = name; value = None }) -> sprintf "%s.%s=?" ty name - | Choice2Of2 l -> Literal.toString l) - yield sprintf "enum<%s>" (cases |> String.concat " | ") - for k, m in ru.discriminatedUnions |> Map.toSeq do - yield sprintf "du[%s]<%s>" k (m |> Map.toSeq |> Seq.map (snd >> Type.pp) |> String.concat ", ") - for t in ru.otherTypes |> Set.toSeq do yield Type.pp t - ] - cases |> String.concat " | " - - let rec private getEnumFromUnion ctx (u: UnionType) : Set> * UnionType = - let (|Dummy|) _ = [] - - let rec go t = - seq { - match t with - | Union { types = types } -> yield! Seq.collect go types - | Intersection { types = types } -> yield! types |> List.map (go >> Set.ofSeq) |> Set.intersectMany |> Set.toSeq - | (Ident { fullName = Some fn; loc = loc } & Dummy tyargs) - | App (AIdent { fullName = Some fn }, tyargs, loc) -> - for x in fn |> FullName.lookup ctx do - match x with - | AliasName a -> - let bindings = Type.createBindings fn loc a.typeParams tyargs - yield! go (a.target |> Type.substTypeVar bindings ()) - | EnumName e -> - for c in e.cases do yield Choice1Of2 (Choice1Of2 (e, c)) - | EnumCaseName (name, e) -> - match e.cases |> List.tryFind (fun c -> c.name = name) with - | Some c -> yield Choice1Of2 (Choice1Of2 (e, c)) - | None -> yield Choice2Of2 t - | ClassName _ -> yield Choice2Of2 t - | _ -> () - | TypeLiteral l -> yield Choice1Of2 (Choice2Of2 l) - | _ -> yield Choice2Of2 t - } - - let f (cases, types) ty = - let c, rest = go ty |> Seq.fold (fun (e, rest) -> function Choice1Of2 x -> Set.add x e, rest | Choice2Of2 x -> e, x::rest) (Set.empty, []) - match Set.isEmpty c, rest with - | true, [] -> cases, types - | true, _ -> cases, ty :: types // preserve the original type as much as possible - | false, [] -> Set.union c cases, types - | false, ts -> Set.union c cases, ts @ types - - let cases, types = u.types |> List.fold f (Set.empty, []) - cases, { types = types } - - let private getDiscriminatedFromUnion (ctx: Context<'a, 's>) (u: UnionType) : Map> * UnionType = - let (|Dummy|) _ = [] - - let rec getLiteralFieldsFromType (ty: Type) : Map> = - match ty with - | Intrinsic | PolymorphicThis | TypeVar _ | Prim _ | TypeLiteral _ | Tuple _ | Function _ -> Map.empty - | Erased _ -> failwith "impossible_getDiscriminatedFromUnion_getLiteralFieldsFromType_Erased" - | Union u -> - let result = u.types |> List.map getLiteralFieldsFromType - result |> List.fold (fun state fields -> - fields |> Map.fold (fun state k v -> - match state |> Map.tryFind k with - | None -> state |> Map.add k v - | Some v' -> state |> Map.add k (Set.union v v') - ) state - ) Map.empty - | Intersection i -> - let result = i.types |> List.map getLiteralFieldsFromType - result |> List.fold (fun state fields -> - fields |> Map.fold (fun state k v -> - match state |> Map.tryFind k with - | None -> state |> Map.add k v - | Some v' -> state |> Map.add k (Set.intersect v v') - ) state - ) Map.empty |> Map.filter (fun _ v -> Set.isEmpty v |> not) - | AnonymousInterface c -> getLiteralFieldsFromClass c - | App (AAnonymousInterface c, ts, loc) -> - let name = sprintf "anonymous interface %d" (ctx.anonymousInterfacesMap |> Map.find c) - let bindings = Type.createBindings [name] loc c.typeParams ts - getLiteralFieldsFromClass (c |> Type.mapInClass (Type.substTypeVar bindings) ()) - | (Ident { fullName = Some fn; loc = loc } & Dummy ts) | App (AIdent { fullName = Some fn }, ts, loc) -> - let go = function - | AliasName a -> - if List.isEmpty ts then Some (getLiteralFieldsFromType a.target) - else - let bindings = Type.createBindings fn loc a.typeParams ts - Some (getLiteralFieldsFromType (a.target |> Type.substTypeVar bindings ())) - | ClassName c -> - if List.isEmpty ts then Some (getLiteralFieldsFromClass c) - else - let bindings = Type.createBindings fn loc c.typeParams ts - Some (getLiteralFieldsFromClass (c |> Type.mapInClass (Type.substTypeVar bindings) ())) - | _ -> None - match FullName.lookup ctx fn |> List.tryPick go with - | Some t -> t - | None -> Map.empty - | Prim _ | App (APrim _, _, _) -> Map.empty - | Ident { fullName = None } | App (AIdent { fullName = None }, _, _) -> Map.empty - | Ident { fullName = Some _ } -> failwith "impossible_getDiscriminatedFromUnion_getLiteralFieldsFromType_Ident" - | UnknownType _ -> Map.empty - - and getLiteralFieldsFromClass (c: Class) : Map> = - let inherited = - c.implements - |> List.map getLiteralFieldsFromType - |> List.fold (fun state fields -> - fields |> Map.fold (fun state k v -> - match state |> Map.tryFind k with - | None -> state |> Map.add k v - | Some v' -> state |> Map.add k (Set.intersect v v') - ) state - ) Map.empty |> Map.filter (fun _ v -> Set.isEmpty v |> not) - - let fields = - c.members - |> List.collect (fun (_, m) -> - match m with - | Field (fl, _, []) -> - let rec go t = - match t with - | TypeLiteral l -> [fl.name, l] - | Union u -> List.collect go u.types - | (Ident { fullName = Some fn; loc = loc } & Dummy ts) | App (AIdent { fullName = Some fn }, ts, loc) -> - FullName.tryLookupWith ctx fn (function - | EnumName e -> - e.cases |> List.choose (function { value = Some v } -> Some (fl.name, v) | _ -> None) |> Some - | EnumCaseName (cn, e) -> - match e.cases |> List.tryFind (fun c -> c.name = cn) with - | Some { value = Some v } -> Some [fl.name, v] - | _ -> None - | AliasName a -> - let bindings = Type.createBindings fn loc a.typeParams ts - go (a.target |> Type.substTypeVar bindings ()) |> Some - | _ -> None - ) |> Option.defaultValue [] - | _ -> [] - go fl.value - | _ -> [] - ) - |> List.distinct - |> List.groupBy fst - |> List.map (fun (k, v) -> k, v |> List.map snd |> Set.ofList) - |> Map.ofList - - Map.foldBack Map.add fields inherited // overwrite inherited fields overloaded by the class - - let discriminatables, rest = - List.foldBack (fun ty (discriminatables, rest) -> - let fields = getLiteralFieldsFromType ty - if Map.isEmpty fields then discriminatables, ty :: rest - else (ty, fields) :: discriminatables, rest - ) u.types ([], []) - - let tagDict = new System.Collections.Generic.Dictionary>() - for (_, fields) in discriminatables do - for (name, values) in fields |> Map.toSeq do - match tagDict.TryGetValue(name) with - | true, (i, values') -> tagDict.[name] <- (i + 1u, Set.intersect values values') - | false, _ -> tagDict.[name] <- (1u, values) - - let getBestTag (fields: Map>) = - let xs = - fields - |> Map.toList - |> List.choose (fun (name, values) -> - match tagDict.TryGetValue(name) with - | true, (i, commonValues) -> - let intersect = Set.intersect values commonValues - Some ((-(Set.count intersect), i), (name, values)) // prefer the tag with the least intersections - | false, _ -> None) - if List.isEmpty xs then None - else Some (xs |> List.maxBy fst |> snd) - - let discriminatables, rest = - List.foldBack (fun (ty, fields) (discriminatables, rest) -> - match getBestTag fields with - | Some (name, values) -> (name, values, ty) :: discriminatables, rest - | None -> discriminatables, ty :: rest - ) discriminatables ([], rest) - - if List.length discriminatables < 2 then - Map.empty, { u with types = List.distinct u.types } - else - let dus = - discriminatables - |> List.collect (fun (name, values, ty) -> - values |> Set.toList |> List.map (fun value -> name, (value, ty))) - |> List.groupBy fst - |> List.map (fun (name, xs) -> - name, - xs |> List.map snd - |> List.groupBy fst - |> List.map (fun (k, xs) -> - match List.map snd xs |> List.distinct with - | [x] -> k, x - | xs -> k, Union { types = xs }) - |> Map.ofList) - |> Map.ofList - dus, { types = List.distinct rest } - - let mutable private resolveUnionMap: Map = Map.empty - - let rec resolve (ctx: Context<'a, 's>) (u: UnionType) : ResolvedUnion = - match resolveUnionMap |> Map.tryFind u with - | Some t -> t - | None -> - let nullOrUndefined, rest = - u.types |> List.partition (function Prim (Null | Undefined) -> true | _ -> false) - let caseNull = nullOrUndefined |> List.contains (Prim Null) - let caseUndefined = nullOrUndefined |> List.contains (Prim Undefined) - let prims, arrayTypes, rest = - rest |> List.fold (fun (prims, ats, rest) -> - function - | Prim Number -> TNumber :: prims, ats, rest - | Prim String -> TString :: prims, ats, rest - | Prim Bool -> TBoolean :: prims, ats, rest - | Prim (Symbol _) -> TSymbol :: prims, ats, rest - | Prim BigInt -> TBigInt :: prims, ats, rest - | App (APrim Array, [t], _) -> prims, t :: ats, rest - | t -> prims, ats, t :: rest - ) ([], [], []) - let typeofableTypes = Set.ofList prims - let caseArray = - if List.isEmpty arrayTypes then None - else Some (Set.ofList arrayTypes) - let caseEnum, rest = - match rest with - | _ :: _ :: _ -> getEnumFromUnion ctx { types = rest } - | _ -> Set.empty, { types = rest } - let discriminatedUnions, rest = - match rest.types with - | _ :: _ :: _ -> getDiscriminatedFromUnion ctx rest - | _ -> Map.empty, rest - let otherTypes = Set.ofList rest.types - - let result = - { caseNull = caseNull - caseUndefined = caseUndefined - typeofableTypes = typeofableTypes - caseArray = caseArray - caseEnum = caseEnum - discriminatedUnions = discriminatedUnions - otherTypes = otherTypes } - - resolveUnionMap <- resolveUnionMap |> Map.add u result - result - -let createRootContextForTyper (srcs: SourceFile list) (opts: TyperOptions) : Context = - // TODO: handle SourceFile-specific things - let m = - srcs - |> List.collect (fun src -> src.statements) - |> Statement.extractNamedDefinitions - {| - currentNamespace = [] - definitionsMap = m - typeLiteralsMap = Map.empty - anonymousInterfacesMap = Map.empty - unknownIdentTypes = Trie.empty - options = opts - state = () - |} - -let createRootContext (srcs: SourceFile list) (opts: TyperOptions) : Context = - // TODO: handle SourceFile-specific things - let ctx = createRootContextForTyper srcs opts - let stmts = srcs |> List.collect (fun src -> src.statements) - let tlm = Statement.getTypeLiterals stmts |> Seq.mapi (fun i l -> l, i) |> Map.ofSeq - let aim = Statement.getAnonymousInterfaces stmts |> Seq.mapi (fun i c -> c, i) |> Map.ofSeq - let uit = Statement.getUnknownIdentTypes ctx stmts - {| ctx with - typeLiteralsMap = tlm - anonymousInterfacesMap = aim - unknownIdentTypes = uit |} - -open TypeScript -let mergeLibESDefinitions (srcs: SourceFile list) = - let getESVersionFromFileName (s: string) = - let es = s.Split '.' |> Array.tryFind (fun s -> s.StartsWith "es") - match es with - | None -> Ts.ScriptTarget.ESNext - | Some "es3" -> Ts.ScriptTarget.ES3 - | Some "es5" -> Ts.ScriptTarget.ES5 - | Some "es6" | Some "es2015" -> Ts.ScriptTarget.ES2015 - | Some "es2016" -> Ts.ScriptTarget.ES2016 - | Some "es2017" -> Ts.ScriptTarget.ES2017 - | Some "es2018" -> Ts.ScriptTarget.ES2018 - | Some "es2019" -> Ts.ScriptTarget.ES2019 - | Some "es2020" -> Ts.ScriptTarget.ES2020 - | Some _ -> Ts.ScriptTarget.ESNext - - let map (parentVersion: Ts.ScriptTarget option) (loc: Location) (x: ICommented<_>) = - let esVersion = - let rec go = function - | UnknownLocation -> None - | LocationTs (sf, _) -> getESVersionFromFileName sf.fileName |> Some - | Location x -> getESVersionFromFileName x.src.fileName |> Some - | MultipleLocation ls -> - match ls |> List.choose go with - | [] -> None - | xs -> List.min xs |> Some - go loc - match esVersion with - | None -> - None, x.mapComments id - | Some v -> - match parentVersion with - | Some v' when v = v' -> Some v, x.mapComments id - | _ -> Some v, x.mapComments (fun cs -> ESVersion v :: cs) - - let rec mapStmt (s: Statement) = - let vo, s = map None s.loc s - match s with - | Module m -> Module { m with statements = List.map mapStmt m.statements } - | EnumDef e -> EnumDef { e with cases = e.cases |> List.map (fun c -> map vo c.loc c |> snd) } - | ClassDef c -> ClassDef { c with members = c.members |> List.map (fun (a, m) -> map vo a.loc a |> snd, m) } - | _ -> s - - let stmts = - srcs - |> List.collect (fun src -> src.statements) - |> Statement.merge - |> List.map mapStmt - - { fileName = "lib.es.d.ts" - statements = stmts - references = [] - hasNoDefaultLib = true - moduleName = None } - -let runAll (srcs: SourceFile list) (opts: TyperOptions) = - // TODO: handle SourceFile-specific things - - let inline mapStatements f (src: SourceFile) = - { src with statements = f src.statements } - - Log.tracef opts "* normalizing syntax trees..." - let result = - srcs - |> List.map ( - mapStatements (fun stmts -> - stmts - |> Statement.inferEnumCaseValue // infer enum case values when not specified - |> Statement.merge // merge modules, interfaces, etc - |> Statement.introduceAdditionalInheritance opts // add common inheritances which tends not to be defined by `extends` or `implements` - |> Statement.detectPatterns // group statements with pattern - |> Statement.replaceAliasToFunctionWithInterface // replace alias to function type with a function interface - ) - ) - // build a context - - let ctx = createRootContextForTyper result opts - - // resolve every identifier into its full name - Log.tracef opts "* resolving identifiers..." - let result = - result |> List.map (mapStatements (Ident.resolveInStatements ctx)) - // rebuild the context with the identifiers resolved to full name - let ctx = createRootContextForTyper result opts - - // resolve every erased types - Log.tracef opts "* evaluating type expressions..." - let result = result |> List.map (mapStatements (Statement.resolveErasedTypes ctx)) - // rebuild the context because resolveErasedTypes may introduce additional anonymous function interfaces - let ctx = createRootContext result opts - - ctx, result \ No newline at end of file diff --git a/src/ts2ocaml.fsproj b/src/ts2ocaml.fsproj index e8c59407..4bb7f2ab 100644 --- a/src/ts2ocaml.fsproj +++ b/src/ts2ocaml.fsproj @@ -3,19 +3,10 @@ netstandard2.0 - - - - - - - - - @@ -26,7 +17,10 @@ - + + + + \ No newline at end of file diff --git a/ts2ocaml.sln b/ts2ocaml.sln index f88170f7..b0e4d9a9 100644 --- a/ts2ocaml.sln +++ b/ts2ocaml.sln @@ -5,6 +5,8 @@ VisualStudioVersion = 16.6.30114.105 MinimumVisualStudioVersion = 10.0.40219.1 Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "ts2ocaml", "src\ts2ocaml.fsproj", "{F9ECC86F-B4DA-4173-9EF6-32B230083625}" EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "ts2ml", "lib\ts2ml.fsproj", "{EAC815EE-8CCA-4E25-A82D-F9F2D46D9CC9}" +EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Any CPU = Debug|Any CPU @@ -30,5 +32,17 @@ Global {F9ECC86F-B4DA-4173-9EF6-32B230083625}.Release|x64.Build.0 = Release|Any CPU {F9ECC86F-B4DA-4173-9EF6-32B230083625}.Release|x86.ActiveCfg = Release|Any CPU {F9ECC86F-B4DA-4173-9EF6-32B230083625}.Release|x86.Build.0 = Release|Any CPU + {EAC815EE-8CCA-4E25-A82D-F9F2D46D9CC9}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {EAC815EE-8CCA-4E25-A82D-F9F2D46D9CC9}.Debug|Any CPU.Build.0 = Debug|Any CPU + {EAC815EE-8CCA-4E25-A82D-F9F2D46D9CC9}.Debug|x64.ActiveCfg = Debug|Any CPU + {EAC815EE-8CCA-4E25-A82D-F9F2D46D9CC9}.Debug|x64.Build.0 = Debug|Any CPU + {EAC815EE-8CCA-4E25-A82D-F9F2D46D9CC9}.Debug|x86.ActiveCfg = Debug|Any CPU + {EAC815EE-8CCA-4E25-A82D-F9F2D46D9CC9}.Debug|x86.Build.0 = Debug|Any CPU + {EAC815EE-8CCA-4E25-A82D-F9F2D46D9CC9}.Release|Any CPU.ActiveCfg = Release|Any CPU + {EAC815EE-8CCA-4E25-A82D-F9F2D46D9CC9}.Release|Any CPU.Build.0 = Release|Any CPU + {EAC815EE-8CCA-4E25-A82D-F9F2D46D9CC9}.Release|x64.ActiveCfg = Release|Any CPU + {EAC815EE-8CCA-4E25-A82D-F9F2D46D9CC9}.Release|x64.Build.0 = Release|Any CPU + {EAC815EE-8CCA-4E25-A82D-F9F2D46D9CC9}.Release|x86.ActiveCfg = Release|Any CPU + {EAC815EE-8CCA-4E25-A82D-F9F2D46D9CC9}.Release|x86.Build.0 = Release|Any CPU EndGlobalSection EndGlobal diff --git a/yarn.lock b/yarn.lock index ba0b1d6d..bad7198e 100644 --- a/yarn.lock +++ b/yarn.lock @@ -2,6 +2,13 @@ # yarn lockfile v1 +"@angular/common@^13.0.3": + version "13.0.3" + resolved "https://registry.yarnpkg.com/@angular/common/-/common-13.0.3.tgz#b76b82433b765cd61c2b0fd51798eeb5c8b18640" + integrity sha512-xxQIQD5rWWHafKRPCgvkWvy53b+QkbJ9yAf3qYTp0gXZJMg/Cx3Ylc8LA2o1kyVJxCI/amXf5k4rr1S9yU7zxw== + dependencies: + tslib "^2.3.0" + "@babel/code-frame@^7.16.7": version "7.16.7" resolved "https://registry.yarnpkg.com/@babel/code-frame/-/code-frame-7.16.7.tgz#44416b6bd7624b998f5b1af5d470856c40138789" @@ -293,12 +300,17 @@ resolved "https://registry.yarnpkg.com/@types/json-schema/-/json-schema-7.0.9.tgz#97edc9037ea0c38585320b28964dde3b39e4660d" integrity sha512-qcUXuemtEu+E5wZSJHNxUXeCZhAfXKQ41D+duX+VYPde7xyEVZci+/oXKJL13tnRs9lR2pr4fod59GT6/X1/yQ== +"@types/long@^4.0.0": + version "4.0.1" + resolved "https://registry.yarnpkg.com/@types/long/-/long-4.0.1.tgz#459c65fa1867dafe6a8f322c4c51695663cc55e9" + integrity sha512-5tXH6Bx/kNGd3MgffdmP4dy2Z+G4eaXw0SE81Tq3BNadtnMR5/ySMzX4SLEzHJzSmPNn4HIdpQsBvXMUykr58w== + "@types/mime@^1": version "1.3.2" resolved "https://registry.yarnpkg.com/@types/mime/-/mime-1.3.2.tgz#93e25bf9ee75fe0fd80b594bc4feb0e862111b5a" integrity sha512-YATxVxgRqNH6nHEIsvg6k2Boc1JHI9ZbH5iWFFv/MTkchz3b1ieGDa5T0a9RznNdI0KhVbdbWSN+KWWrQZRxTw== -"@types/node@*": +"@types/node@*", "@types/node@>=8": version "16.11.11" resolved "https://registry.yarnpkg.com/@types/node/-/node-16.11.11.tgz#6ea7342dfb379ea1210835bada87b3c512120234" integrity sha512-KB0sixD67CeecHC33MYn+eYARkqTheIRNuu97y2XMjR7Wu3XibO1vaY6VBV6O/a89SPI81cEUIYT87UqUWlZNw== @@ -556,6 +568,11 @@ acorn@^8.4.1: resolved "https://registry.yarnpkg.com/acorn/-/acorn-8.6.0.tgz#e3692ba0eb1a0c83eaa4f37f5fa7368dd7142895" integrity sha512-U1riIR+lBSNi3IbxtaHOIKdH8sLFv3NYfNv8sg7ZsNhcfl4HF2++BfqqrNAxoCLQW1iiylOj76ecnaUxz+z9yw== +adm-zip@^0.5.3: + version "0.5.9" + resolved "https://registry.yarnpkg.com/adm-zip/-/adm-zip-0.5.9.tgz#b33691028333821c0cf95c31374c5462f2905a83" + integrity sha512-s+3fXLkeeLjZ2kLjCBwQufpI5fuN+kIGBxu6530nVQZGVol0d7Y/M88/xw9HGGUcJjKf8LutN3VPRUBq6N7Ajg== + aggregate-error@^3.0.0: version "3.1.0" resolved "https://registry.yarnpkg.com/aggregate-error/-/aggregate-error-3.1.0.tgz#92670ff50f5359bdb7a3e0d40d0ec30c5737687a" @@ -720,7 +737,23 @@ braces@^3.0.1, braces@~3.0.2: dependencies: fill-range "^7.0.1" -browserslist@^4.14.5, browserslist@^4.17.5: +browser-or-node@^2.0.0: + version "2.0.0" + resolved "https://registry.yarnpkg.com/browser-or-node/-/browser-or-node-2.0.0.tgz#808ea90282a670931cdc0ea98166538a50dd0d89" + integrity sha512-3Lrks/Okgof+/cRguUNG+qRXSeq79SO3hY4QrXJayJofwJwHiGC0qi99uDjsfTwULUFSr1OGVsBkdIkygKjTUA== + +browserslist@^4.14.5: + version "4.17.0" + resolved "https://registry.yarnpkg.com/browserslist/-/browserslist-4.17.0.tgz#1fcd81ec75b41d6d4994fb0831b92ac18c01649c" + integrity sha512-g2BJ2a0nEYvEFQC208q8mVAhfNwpZ5Mu8BwgtCdZKO3qx98HChmeg448fPdUzld8aFmfLgVh7yymqV+q1lJZ5g== + dependencies: + caniuse-lite "^1.0.30001254" + colorette "^1.3.0" + electron-to-chromium "^1.3.830" + escalade "^3.1.1" + node-releases "^1.1.75" + +browserslist@^4.17.5: version "4.18.1" resolved "https://registry.yarnpkg.com/browserslist/-/browserslist-4.18.1.tgz#60d3920f25b6860eb917c6c7b185576f4d8b017f" integrity sha512-8ScCzdpPwR2wQh8IT82CA2VgDwjHyqMovPBZSNH54+tm4Jk2pCuv90gmAdH6J84OCRWi0b4gMe6O6XPXuJnjgQ== @@ -759,11 +792,26 @@ call-bind@^1.0.2: function-bind "^1.1.1" get-intrinsic "^1.0.2" +caniuse-lite@^1.0.30001254: + version "1.0.30001285" + resolved "https://registry.yarnpkg.com/caniuse-lite/-/caniuse-lite-1.0.30001285.tgz#fe1e52229187e11d6670590790d669b9e03315b7" + integrity sha512-KAOkuUtcQ901MtmvxfKD+ODHH9YVDYnBt+TGYSz2KIfnq22CiArbUxXPN9067gNbgMlnNYRSwho8OPXZPALB9Q== + caniuse-lite@^1.0.30001280: version "1.0.30001283" resolved "https://registry.yarnpkg.com/caniuse-lite/-/caniuse-lite-1.0.30001283.tgz#8573685bdae4d733ef18f78d44ba0ca5fe9e896b" integrity sha512-9RoKo841j1GQFSJz/nCXOj0sD7tHBtlowjYlrqIUS812x9/emfBLBt6IyMz1zIaYc/eRL8Cs6HPUVi2Hzq4sIg== +cassandra-driver@^4.6.3: + version "4.6.3" + resolved "https://registry.yarnpkg.com/cassandra-driver/-/cassandra-driver-4.6.3.tgz#134cd797ad11c8a51da153db3aa5917589e17088" + integrity sha512-npW670TXjTHrdb15LUFN01wssb9vvz6SuNYcppesoKcUXx3Q29nXVhRtnvsnkG0BaSnDGvCCR4udrzYLsbh+sg== + dependencies: + "@types/long" "^4.0.0" + "@types/node" ">=8" + adm-zip "^0.5.3" + long "^2.2.0" + chalk@^2.0.0: version "2.4.2" resolved "https://registry.yarnpkg.com/chalk/-/chalk-2.4.2.tgz#cd42541677a54333cf541a49108c1432b44c9424" @@ -840,6 +888,11 @@ color-name@~1.1.4: resolved "https://registry.yarnpkg.com/color-name/-/color-name-1.1.4.tgz#c2a09a87acbde69543de6f63fa3995c826c536a2" integrity sha512-dOy+3AuW3a2wNbZHIuMZpTcgjGuLU/uBL/ubcZF9OXbDo8ff4O8yVp5Bf0efS8uEoYo5q4Fx7dY9OgQGXgAsQA== +colorette@^1.3.0: + version "1.4.0" + resolved "https://registry.yarnpkg.com/colorette/-/colorette-1.4.0.tgz#5190fbb87276259a86ad700bff2c6d6faa3fca40" + integrity sha512-Y2oEozpomLn7Q3HFP7dpww7AtMJplbM9lGZP6RDfHqmbeRjiwRg4n6VM6j4KLmRke85uWEI7JqF17f3pqdRA0g== + colorette@^2.0.10, colorette@^2.0.14: version "2.0.16" resolved "https://registry.yarnpkg.com/colorette/-/colorette-2.0.16.tgz#713b9af84fdb000139f04546bd4a93f62a5085da" @@ -1051,6 +1104,11 @@ ee-first@1.1.1: resolved "https://registry.yarnpkg.com/ee-first/-/ee-first-1.1.1.tgz#590c61156b0ae2f4f0255732a158b266bc56b21d" integrity sha1-WQxhFWsK4vTwJVcyoViyZrxWsh0= +electron-to-chromium@^1.3.830: + version "1.4.11" + resolved "https://registry.yarnpkg.com/electron-to-chromium/-/electron-to-chromium-1.4.11.tgz#303c9deebbe90c68bf5c2c81a88a3bf4522c8810" + integrity sha512-2OhsaYgsWGhWjx2et8kaUcdktPbBGjKM2X0BReUCKcSCPttEY+hz2zie820JLbttU8jwL92+JJysWwkut3wZgA== + electron-to-chromium@^1.3.896: version "1.4.8" resolved "https://registry.yarnpkg.com/electron-to-chromium/-/electron-to-chromium-1.4.8.tgz#e1b7752ac1a75e39b5dd90cc7e29ea08b351c484" @@ -1723,6 +1781,11 @@ lodash@^4.17.14: resolved "https://registry.yarnpkg.com/lodash/-/lodash-4.17.21.tgz#679591c564c3bffaae8454cf0b3df370c3d6911c" integrity sha512-v2kDEe57lecTulaDIuNTPy3Ry4gLGJ6Z1O3vE1krgXZNrsQ+LFTGHVxVjcXPs17LhbZVGedAJv8XZ1tvj5FvSg== +long@^2.2.0: + version "2.4.0" + resolved "https://registry.yarnpkg.com/long/-/long-2.4.0.tgz#9fa180bb1d9500cdc29c4156766a1995e1f4524f" + integrity sha1-n6GAux2VAM3CnEFWdmoZleH0Uk8= + loose-envify@^1.4.0: version "1.4.0" resolved "https://registry.yarnpkg.com/loose-envify/-/loose-envify-1.4.0.tgz#71ee51fa7be4caec1a63839f7e682d8132d30caf" @@ -1874,6 +1937,11 @@ node-forge@^0.10.0: resolved "https://registry.yarnpkg.com/node-forge/-/node-forge-0.10.0.tgz#32dea2afb3e9926f02ee5ce8794902691a676bf3" integrity sha512-PPmu8eEeG9saEUvI97fm4OYxXVB6bFvyNTyiUOBichBpFG8A1Ljw3bY62+5oOjDEMHRnd0Y7HQ+x7uzxOzC6JA== +node-releases@^1.1.75: + version "1.1.77" + resolved "https://registry.yarnpkg.com/node-releases/-/node-releases-1.1.77.tgz#50b0cfede855dd374e7585bf228ff34e57c1c32e" + integrity sha512-rB1DUFUNAN4Gn9keO2K1efO35IDK7yKHCdCaIMvFO7yUYmmZYeDjnGKle26G4rwj+LKRQpjyUUvMkPglwGCYNQ== + node-releases@^2.0.1: version "2.0.1" resolved "https://registry.yarnpkg.com/node-releases/-/node-releases-2.0.1.tgz#3d1d395f204f1f2f29a54358b9fb678765ad2fc5" @@ -2529,6 +2597,11 @@ toidentifier@1.0.0: resolved "https://registry.yarnpkg.com/toidentifier/-/toidentifier-1.0.0.tgz#7e1be3470f1e77948bc43d94a3c8f4d7752ba553" integrity sha512-yaOH/Pk/VEhBWWTlhI+qXxDFXlejDGcQipMlyxda9nthulaxLZUNcUqFxokp0vcYnvteJln5FNQDRrxj3YcbVw== +tslib@^2.3.0: + version "2.3.1" + resolved "https://registry.yarnpkg.com/tslib/-/tslib-2.3.1.tgz#e8a335add5ceae51aa261d32a490158ef042ef01" + integrity sha512-77EbyPPpMz+FRFRuAFlWMtmgUWGe9UOG2Z25NqCwiIjRhOf5iKGuzSe5P2w1laq+FkRy4p+PCuVkJSGkzTEKVw== + type-is@~1.6.17, type-is@~1.6.18: version "1.6.18" resolved "https://registry.yarnpkg.com/type-is/-/type-is-1.6.18.tgz#4e552cd05df09467dcbc4ef739de89f2cf37c131"