Skip to content

Commit

Permalink
Replace getAnonymousInterface and toCase with the new implementations
Browse files Browse the repository at this point in the history
  • Loading branch information
@cannorin
cannorin committed Jan 17, 2022
1 parent f3664a4 commit d75d016
Show file tree
Hide file tree
Showing 4 changed files with 81 additions and 59 deletions.
64 changes: 34 additions & 30 deletions lib/Naming.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down
65 changes: 41 additions & 24 deletions lib/Typer.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -56,14 +56,29 @@ type [<RequireQualifiedAccess>] 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
}
Expand Down Expand Up @@ -1033,8 +1048,8 @@ module Statement =
(fun ctx -> function TypeLiteral l -> None, ctx, [l] | _ -> None, ctx, [])
() stmts |> Set.ofSeq

let getAnonymousInterfaces' stmts : Set<AnonymousInterface * {| origin: AnonymousInterfaceOrigin; path: string list |}> =
let rec treatFuncType (state: {| origin: AnonymousInterfaceOrigin; path: string list |}) (ft: FuncType<Type>) tps =
let getAnonymousInterfaces stmts : Set<AnonymousInterface * {| origin: AnonymousInterfaceOrigin; namespace_: string list |}> =
let rec treatFuncType (state: {| origin: AnonymousInterfaceOrigin; namespace_: string list |}) (ft: FuncType<Type>) tps =
seq {
for arg in ft.args do
let ty, origin =
Expand All @@ -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, _, _) ->
Expand All @@ -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
Expand All @@ -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<AnonymousInterface * {| origin: AnonymousInterfaceOrigin; path: string list |}> =
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
Expand Down Expand Up @@ -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
Expand Down
9 changes: 5 additions & 4 deletions src/Targets/JsOfOCaml/Writer.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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,
Expand Down
2 changes: 1 addition & 1 deletion src/Targets/ParserTest.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -83,7 +83,7 @@ let private run (input: Input) (baseCtx: IContext<Options>) =
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 |}
Expand Down

0 comments on commit d75d016

Please sign in to comment.