From d75d01688f1df2082e23e42fe6056ff2bc7aa9f3 Mon Sep 17 00:00:00 2001 From: cannorin Date: Mon, 17 Jan 2022 20:30:07 +0900 Subject: [PATCH] Replace getAnonymousInterface and toCase with the new implementations --- lib/Naming.fs | 64 +++++++++++++++++--------------- lib/Typer.fs | 65 +++++++++++++++++++++------------ src/Targets/JsOfOCaml/Writer.fs | 9 +++-- src/Targets/ParserTest.fs | 2 +- 4 files changed, 81 insertions(+), 59 deletions(-) diff --git a/lib/Naming.fs b/lib/Naming.fs index e26902f5..3878d151 100644 --- a/lib/Naming.fs +++ b/lib/Naming.fs @@ -78,49 +78,53 @@ let isCase (case: Case) (str: string) = | OtherCase, _ -> true | _, _ -> false -let toCase (case: Case) (str: string) = +let getWords (str: string) = if String.IsNullOrWhiteSpace str then invalidArg "str" "string is null or whitespace" - let words = - str.Split('_', '-') - |> Array.collect (fun s -> - if s.Length = 0 then [||] - else if s.Length = 1 then [|s|] - else - let h, t = s.[0], s.[1..] - let sb = StringBuilder().Append(h) - let sb, words = - t |> Seq.fold (fun (sb: StringBuilder, words) c -> - if Char.IsUpper c then - let word = sb.ToString() - sb.Clear().Append(c), word :: words - else - sb.Append(c), words - ) (sb, []) - sb.ToString() :: words |> List.rev |> List.toArray - ) + let chars = str.ToCharArray() |> List.ofArray + let rec go words acc = function + | [] -> + acc :: words + |> List.filter (List.isEmpty >> not) + |> List.map (fun word -> new String(List.rev word |> Array.ofList)) + |> List.rev + |> Array.ofList + | c :: rest when not (Char.IsLetterOrDigit c) -> go (acc :: words) [] rest + | c1 :: c2 :: rest when Char.IsUpper c1 && Char.IsLower c2 -> + go (acc :: words) [c1] (c2 :: rest) + | c1 :: c2 :: rest when not (Char.IsUpper c1) && Char.IsUpper c2 -> + go ((c1 :: acc) :: words) [] (c2 :: rest) + | c :: rest -> go words (c :: acc) rest + go [] [] chars + +let wordsToCase (case: Case) (words: string[]) = let toLower (s: string) = s.ToLowerInvariant() let toUpper (s: string) = s.ToUpperInvariant() let toPascal (s: string) : string = s.ToCharArray() |> Array.mapi (fun i c -> if i = 0 then Char.ToUpperInvariant c else Char.ToLowerInvariant c) |> String + match case with + | LowerCase -> words |> String.concat "" |> toLower + | UpperCase -> words |> String.concat "" |> toUpper + | PascalCase -> words |> Array.map toPascal |> String.Concat + | DromedaryCase -> words |> Array.mapi (fun i s -> if i = 0 then toLower s else toPascal s) |> String.Concat + | LowerSnakeCase -> words |> Array.map toLower |> String.concat "_" + | UpperSnakeCase -> words |> Array.map toUpper |> String.concat "_" + | (PascalSnakeCase | MixedSnakeCase) -> words |> Array.map toPascal |> String.concat "_" + | KebabCase -> words |> Array.map toLower |> String.concat "-" + | UpperTrainCase -> words |> Array.map toUpper |> String.concat "-" + | (PascalTrainCase | MixedTrainCase) -> words |> Array.map toPascal |> String.concat "-" + | OtherCase -> words |> String.concat "" + +let toCase (case: Case) (str: string) = + let words = getWords str match case, getCase str with | c1, c2 when c1 = c2 -> str | (DromedaryCase | LowerSnakeCase | KebabCase), LowerCase -> str | (UpperSnakeCase | UpperTrainCase), UpperCase -> str | MixedSnakeCase, (LowerSnakeCase | UpperSnakeCase | PascalSnakeCase) -> str | MixedTrainCase, (KebabCase | UpperTrainCase | PascalTrainCase) -> str - | LowerCase, _ -> str.Replace("_","").Replace("-","") |> toLower - | UpperCase, _ -> str.Replace("_","").Replace("-","") |> toUpper - | PascalCase, _ -> words |> Array.map toPascal |> String.Concat - | DromedaryCase, _ -> words |> Array.mapi (fun i s -> if i = 0 then toLower s else toPascal s) |> String.Concat - | LowerSnakeCase, _ -> words |> Array.map toLower |> String.concat "_" - | UpperSnakeCase, _ -> words |> Array.map toUpper |> String.concat "_" - | (PascalSnakeCase | MixedSnakeCase), _ -> words |> Array.map toPascal |> String.concat "_" - | KebabCase, _ -> words |> Array.map toLower |> String.concat "-" - | UpperTrainCase, _ -> words |> Array.map toUpper |> String.concat "-" - | (PascalTrainCase | MixedTrainCase), _ -> words |> Array.map toPascal |> String.concat "-" - | OtherCase, _ -> str + | _, _ -> wordsToCase case words module Keywords = let keywords = diff --git a/lib/Typer.fs b/lib/Typer.fs index 66ea1d56..c56083b5 100644 --- a/lib/Typer.fs +++ b/lib/Typer.fs @@ -56,14 +56,29 @@ type [] InheritingType = | Other of Type | UnknownIdent of {| name: string list; tyargs: Type list |} -type AnonymousInterfaceOrigin = { valueName: string option; argName: string option } with - static member Empty = { valueName = None; argName = None } +type AnonymousInterfaceOrigin = { + // the name of the type containing the anonymous interface. + // + // will be `Some` only when it is used "directly"; will be `None` if it is in a tuple type, one of the arguments of a type application, etc. + typeName: string option; + + // the name of the value containing the anonymous interface. + // + // will be `Some` only when it is used "directly"; will be `None` if it is in a tuple type, one of the arguments of a type application, etc. + valueName: string option; + + // the name of the argument containing the anonymous interface. + // + // will be `Some` only when it is used "directly"; will be `None` if it is in a tuple type, one of the arguments of a type application, etc. + argName: string option +} with + static member Empty = { typeName = None; valueName = None; argName = None } type AnonymousInterfaceInfo = { /// a unique number assigned to the anonymous interface id: int /// the namespace in which the anonymous interface appears - path: string list + namespace_: string list /// where the anonymous interface is used in origin: AnonymousInterfaceOrigin } @@ -1033,8 +1048,8 @@ module Statement = (fun ctx -> function TypeLiteral l -> None, ctx, [l] | _ -> None, ctx, []) () stmts |> Set.ofSeq - let getAnonymousInterfaces' stmts : Set = - let rec treatFuncType (state: {| origin: AnonymousInterfaceOrigin; path: string list |}) (ft: FuncType) tps = + let getAnonymousInterfaces stmts : Set = + let rec treatFuncType (state: {| origin: AnonymousInterfaceOrigin; namespace_: string list |}) (ft: FuncType) tps = seq { for arg in ft.args do let ty, origin = @@ -1043,13 +1058,17 @@ module Statement = | Choice2Of2 t -> t, state.origin yield! findTypes typeFinder {| state with origin = origin |} ty yield! findTypes typeFinder state ft.returnType + yield! treatTypeParameters state tps + } + and treatTypeParameters (state: {| origin: AnonymousInterfaceOrigin; namespace_: string list |}) (tps: TypeParam list) = + seq { for tp in tps do yield! tp.extends |> Option.map (findTypes typeFinder state) |> Option.defaultValue Seq.empty yield! tp.defaultType |> Option.map (findTypes typeFinder state) |> Option.defaultValue Seq.empty } - and treatNamed (state: {| origin: AnonymousInterfaceOrigin; path: string list |}) name value = + and treatNamed (state: {| origin: AnonymousInterfaceOrigin; namespace_: string list |}) name value = findTypes typeFinder {| state with origin = { state.origin with valueName = Some name } |} value - and typeFinder (state: {| origin: AnonymousInterfaceOrigin; path: string list |}) ty = + and typeFinder (state: {| origin: AnonymousInterfaceOrigin; namespace_: string list |}) ty = let inline resultMany xs = Some [], state, xs match ty with | App (AAnonymousInterface i, _, _) -> @@ -1064,16 +1083,22 @@ module Statement = findStatements (fun currentNamespace state stmt -> let inline result_ x = Some [], state, x - let state' = {| origin = state; path = currentNamespace |} + let state = {| origin = state; namespace_ = currentNamespace |} match stmt with + | TypeAlias ta -> + let state = {| state with origin = { state.origin with typeName = Some ta.name } |} + seq { + yield! findTypes typeFinder state ta.target + yield! treatTypeParameters state ta.typeParams + } |> result_ | Variable v -> - treatNamed state' v.name v.typ |> result_ + treatNamed state v.name v.typ |> result_ | Function f -> - treatFuncType {| state' with origin = { state'.origin with valueName = Some f.name } |} f.typ f.typeParams |> result_ + treatFuncType {| state with origin = { state.origin with valueName = Some f.name } |} f.typ f.typeParams |> result_ | Class c -> - let path = - match c.name with Name n -> currentNamespace @ [n] | _ -> currentNamespace - let state = {| state' with path = path |} + let typeName = + match c.name with Name n -> Some n | _ -> None + let state = {| state with namespace_ = currentNamespace; origin = { state.origin with typeName = typeName } |} seq { for _, m in c.members do match m with @@ -1094,19 +1119,11 @@ module Statement = | UnknownMember _ -> () for t in c.implements do yield! findTypes typeFinder state t - for tp in c.typeParams do - yield! tp.extends |> Option.map (findTypes typeFinder state) |> Option.defaultValue Seq.empty - yield! tp.defaultType |> Option.map (findTypes typeFinder state) |> Option.defaultValue Seq.empty + yield! treatTypeParameters state c.typeParams } |> result_ - | _ -> None, state, Seq.empty + | _ -> None, state.origin, Seq.empty ) AnonymousInterfaceOrigin.Empty stmts |> Set.ofSeq - let getAnonymousInterfaces stmts : Set = - findTypesInStatements (fun state -> function - | AnonymousInterface c -> None, state, Seq.singleton (c, {| origin = AnonymousInterfaceOrigin.Empty; path = state.currentNamespace |}) - | _ -> None, state, Seq.empty - ) () stmts |> Set.ofSeq - let getUnknownIdentTypes ctx stmts = let (|Dummy|) _ = [] findTypesInStatements (fun state -> function @@ -1921,7 +1938,7 @@ let createRootContext (srcs: SourceFile list) (baseCtx: IContext<'Options>) : Ty let tlm = Statement.getTypeLiterals stmts |> Seq.mapi (fun i l -> l, i) |> Map.ofSeq let aim = Statement.getAnonymousInterfaces stmts - |> Seq.mapi (fun i (c, info) -> c, { id = i; path = info.path; origin = info.origin }) |> Map.ofSeq + |> Seq.mapi (fun i (c, info) -> c, { id = i; namespace_ = info.namespace_; origin = info.origin }) |> Map.ofSeq let uit = Statement.getUnknownIdentTypes ctx stmts { v with typeLiteralsMap = tlm diff --git a/src/Targets/JsOfOCaml/Writer.fs b/src/Targets/JsOfOCaml/Writer.fs index 84836987..d5be42d3 100644 --- a/src/Targets/JsOfOCaml/Writer.fs +++ b/src/Targets/JsOfOCaml/Writer.fs @@ -86,13 +86,14 @@ let literalToIdentifier (ctx: Context) (l: Literal) : text = | LFloat l -> tprintf "n_%s" (formatNumber l) | LBool true -> str "b_true" | LBool false -> str "b_false" -let anonymousInterfaceModuleName (index: int) = sprintf "AnonymousInterface%d" index +let anonymousInterfaceModuleName (info: AnonymousInterfaceInfo) = + sprintf "AnonymousInterface%d" info.id 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.id) + tprintf "%s.t" (anonymousInterfaceModuleName i) else tprintf "anonymous_interface_%d" i.id | None -> failwithf "impossible_anonymousInterfaceToIdentifier(%s)" a.loc.AsString @@ -575,7 +576,7 @@ module StructuredText = |> Set.fold (fun state -> function | 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.add (i.namespace_ @ [anonymousInterfaceModuleName i]) | _ -> state ) WeakTrie.empty) |> Option.defaultValue WeakTrie.empty @@ -907,7 +908,7 @@ let rec emitClass flags overrideFunc (ctx: Context) (current: StructuredText) (c Some (Type.appOpt (str "t") (ts |> List.map (_emitType _ctx))) | _ -> None ClassKind.AnonymousInterface {| - name = anonymousInterfaceModuleName i.id + name = anonymousInterfaceModuleName i orig = c.MapName(fun _ -> Anonymous) |}, selfTy, diff --git a/src/Targets/ParserTest.fs b/src/Targets/ParserTest.fs index 94aa8eb8..af84d7c2 100644 --- a/src/Targets/ParserTest.fs +++ b/src/Targets/ParserTest.fs @@ -83,7 +83,7 @@ let private run (input: Input) (baseCtx: IContext) = let ais = JSObj.empty for _, ai in info.anonymousInterfacesMap |> Map.toArray do ais.[string ai.id] <- - JSObj.box {| origin = ai.origin; path = ai.path |} + JSObj.box {| origin = ai.origin; path = ai.namespace_ |} yield {| file = src; trie = trie; anonymousInterfaces = ais |} |] let o = {| sources = sources; info = info |}