Skip to content

Commit

Permalink
Remove conversion for variants.
Browse files Browse the repository at this point in the history
  • Loading branch information
@cristianoc
cristianoc committed Mar 27, 2023
1 parent 6681a16 commit 7812e1c
Show file tree
Hide file tree
Showing 24 changed files with 101 additions and 747 deletions.
230 changes: 2 additions & 228 deletions jscomp/gentype/Converter.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,6 @@ type t =
| OptionC of t
| PromiseC of t
| TupleC of t list
| VariantC of variantC

and groupedArgConverter =
| ArgConverter of t
Expand All @@ -23,17 +22,6 @@ and functionC = {
uncurried: bool;
}

and variantC = {
hash: int;
noPayloads: case list;
withPayloads: withPayload list;
polymorphic: bool;
unboxed: bool;
useVariantTables: bool;
}

and withPayload = {case: case; inlineRecord: bool; argConverters: t list}

let rec toString converter =
match converter with
| ArrayC c -> "array(" ^ toString c ^ ")"
Expand Down Expand Up @@ -66,32 +54,10 @@ let rec toString converter =
| PromiseC c -> "promise(" ^ toString c ^ ")"
| TupleC innerTypesC ->
"[" ^ (innerTypesC |> List.map toString |> String.concat ", ") ^ "]"
| VariantC {noPayloads; withPayloads} ->
"variant("
^ ((noPayloads |> List.map labelJSToString)
@ (withPayloads
|> List.map (fun {case; inlineRecord; argConverters} ->
(case |> labelJSToString)
^ (match inlineRecord with
| true -> " inlineRecord "
| false -> "")
^ ":" ^ "{"
^ (argConverters |> List.map toString |> String.concat ", ")
^ "}"))
|> String.concat ", ")
^ ")"

let typeGetConverterNormalized ~config ~inline ~lookupId ~typeNameIsInterface
type0 =
let circular = ref "" in
let expandOneLevel type_ =
match type_ with
| Ident {builtin = false; name} -> (
match name |> lookupId with
| (t : CodeItem.exportTypeItem) -> t.type_
| exception Not_found -> type_)
| _ -> type_
in
let rec visit ~(visited : StringSet.t) type_ =
let normalized_ = type_ in
match type_ with
Expand Down Expand Up @@ -139,7 +105,7 @@ let typeGetConverterNormalized ~config ~inline ~lookupId ~typeNameIsInterface
else
let visited = visited |> StringSet.add name in
match name |> lookupId with
| {annotation = GenTypeOpaque} -> (IdentC, normalized_)
| {CodeItem.annotation = GenTypeOpaque} -> (IdentC, normalized_)
| {annotation = NoGenType} -> (IdentC, normalized_)
| {typeVars; type_} -> (
let pairs =
Expand Down Expand Up @@ -185,78 +151,7 @@ let typeGetConverterNormalized ~config ~inline ~lookupId ~typeNameIsInterface
in
(TupleC innerConversions, Tuple normalizedList)
| TypeVar _ -> (IdentC, normalized_)
| Variant variant ->
let allowUnboxed = not variant.polymorphic in
let withPayloads, normalized, unboxed =
match
variant.payloads
|> List.map (fun {case; inlineRecord; numArgs; t} ->
(case, inlineRecord, numArgs, t |> visit ~visited))
with
| [] when allowUnboxed -> ([], normalized_, variant.unboxed)
| [(case, inlineRecord, numArgs, (converter, tNormalized))]
when allowUnboxed ->
let unboxed = tNormalized |> expandOneLevel |> typeIsObject in
let normalized =
Variant
{
variant with
payloads = [{case; inlineRecord; numArgs; t = tNormalized}];
unboxed =
(match unboxed with
| true -> true
| false -> variant.unboxed);
}
in
let argConverters =
match converter with
| TupleC converters when numArgs > 1 -> converters
| _ -> [converter]
in
([{argConverters; case; inlineRecord}], normalized, unboxed)
| withPayloadConverted ->
let withPayloadNormalized =
withPayloadConverted
|> List.map (fun (case, inlineRecord, numArgs, (_, tNormalized)) ->
{case; inlineRecord; numArgs; t = tNormalized})
in
let normalized =
Variant {variant with payloads = withPayloadNormalized}
in
( withPayloadConverted
|> List.map (fun (case, inlineRecord, numArgs, (converter, _)) ->
let argConverters =
match converter with
| TupleC converters when numArgs > 1 -> converters
| _ -> [converter]
in
{argConverters; case; inlineRecord}),
normalized,
variant.unboxed )
in
let noPayloads = variant.noPayloads in
let useVariantTables =
if variant.bsStringOrInt then false
else if variant.polymorphic then
noPayloads
|> List.exists (fun {label; labelJS} -> labelJS <> StringLabel label)
|| withPayloads
|> List.exists (fun {case = {label; labelJS}} ->
labelJS <> StringLabel label)
else true
in
let converter =
VariantC
{
hash = variant.hash;
noPayloads;
withPayloads;
polymorphic = variant.polymorphic;
unboxed;
useVariantTables;
}
in
(converter, normalized)
| Variant _ -> (IdentC, normalized_)
and argTypeToGroupedArgConverter ~visited {aName; aType} =
match aType with
| GroupOfLabeledArgs fields ->
Expand Down Expand Up @@ -322,13 +217,6 @@ let rec converterIsIdentity ~config ~toJS converter =
| PromiseC c -> c |> converterIsIdentity ~config ~toJS
| TupleC innerTypesC ->
innerTypesC |> List.for_all (converterIsIdentity ~config ~toJS)
| VariantC {withPayloads; useVariantTables} ->
if not useVariantTables then
withPayloads
|> List.for_all (fun {argConverters} ->
argConverters
|> List.for_all (fun c -> c |> converterIsIdentity ~config ~toJS))
else false

let rec apply ~config ~converter ~indent ~nameGen ~toJS ~variantTables value =
match converter with
Expand Down Expand Up @@ -470,120 +358,6 @@ let rec apply ~config ~converter ~indent ~nameGen ~toJS ~variantTables value =
|> apply ~config ~converter:c ~indent ~nameGen ~toJS ~variantTables)
|> String.concat ", ")
^ "]"
| VariantC {noPayloads = [case]; withPayloads = []; polymorphic} -> (
match toJS with
| true -> case |> labelJSToString
| false -> case.label |> Runtime.emitVariantLabel ~polymorphic)
| VariantC variantC -> (
if variantC.noPayloads <> [] && variantC.useVariantTables then
Hashtbl.replace variantTables (variantC.hash, toJS) variantC;
let convertToString =
match
(not toJS)
&& variantC.noPayloads
|> List.exists (fun {labelJS} ->
labelJS = BoolLabel true || labelJS = BoolLabel false)
with
| true -> ".toString()"
| false -> ""
in
let table = variantC.hash |> variantTable ~toJS in
let accessTable v =
match not variantC.useVariantTables with
| true -> v
| false -> table ^ EmitText.array [v ^ convertToString]
in
let convertVariantPayloadToJS ~indent ~argConverters x =
match argConverters with
| [converter] ->
x |> apply ~config ~converter ~indent ~nameGen ~toJS ~variantTables
| _ ->
argConverters
|> List.mapi (fun i converter ->
x
|> Runtime.accessVariant ~index:i
|> apply ~config ~converter ~indent ~nameGen ~toJS ~variantTables)
|> EmitText.array
in
let convertVariantPayloadToRE ~indent ~argConverters x =
match argConverters with
| [converter] ->
[x |> apply ~config ~converter ~indent ~nameGen ~toJS ~variantTables]
| _ ->
argConverters
|> List.mapi (fun i converter ->
x
|> EmitText.arrayAccess ~index:i
|> apply ~config ~converter ~indent ~nameGen ~toJS ~variantTables)
in
match variantC.withPayloads with
| [] -> value |> accessTable
| [{case; inlineRecord; argConverters}] when variantC.unboxed -> (
let casesWithPayload ~indent =
if toJS then
value
|> Runtime.emitVariantGetPayload ~inlineRecord
~numArgs:(argConverters |> List.length)
~polymorphic:variantC.polymorphic
|> convertVariantPayloadToJS ~argConverters ~indent
else
value
|> convertVariantPayloadToRE ~argConverters ~indent
|> Runtime.emitVariantWithPayload ~inlineRecord ~label:case.label
~polymorphic:variantC.polymorphic
in
match variantC.noPayloads = [] with
| true -> casesWithPayload ~indent
| false ->
EmitText.ifThenElse ~indent
(fun ~indent:_ -> value |> EmitText.typeOfObject)
casesWithPayload
(fun ~indent:_ -> value |> accessTable))
| _ :: _ -> (
let convertCaseWithPayload ~indent ~inlineRecord ~argConverters case =
if toJS then
value
|> Runtime.emitVariantGetPayload ~inlineRecord
~numArgs:(argConverters |> List.length)
~polymorphic:variantC.polymorphic
|> convertVariantPayloadToJS ~argConverters ~indent
|> Runtime.emitJSVariantWithPayload ~label:(case |> labelJSToString)
~polymorphic:variantC.polymorphic
else
value
|> Runtime.emitJSVariantGetPayload ~polymorphic:variantC.polymorphic
|> convertVariantPayloadToRE ~argConverters ~indent
|> Runtime.emitVariantWithPayload ~inlineRecord ~label:case.label
~polymorphic:variantC.polymorphic
in
let switchCases ~indent =
variantC.withPayloads
|> List.map (fun {case; inlineRecord; argConverters} ->
( (match toJS with
| true ->
case.label
|> Runtime.emitVariantLabel ~polymorphic:variantC.polymorphic
| false -> case |> labelJSToString),
case
|> convertCaseWithPayload ~indent ~inlineRecord ~argConverters
))
in
let casesWithPayload ~indent =
value
|> (let open Runtime in
(match toJS with
| true -> emitVariantGetLabel
| false -> emitJSVariantGetLabel)
~polymorphic:variantC.polymorphic)
|> EmitText.switch ~indent ~cases:(switchCases ~indent)
in
match variantC.noPayloads = [] with
| true -> casesWithPayload ~indent
| false ->
EmitText.ifThenElse ~indent
(fun ~indent:_ -> value |> EmitText.typeOfObject)
casesWithPayload
(fun ~indent:_ -> value |> accessTable)))

let toJS ~config ~converter ~indent ~nameGen ~variantTables value =
value |> apply ~config ~converter ~indent ~nameGen ~variantTables ~toJS:true
Expand Down
35 changes: 0 additions & 35 deletions jscomp/gentype/EmitJs.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -433,40 +433,6 @@ let emitRequires ~importedValueOrComponent ~early ~config ~requires emitters =
~moduleName)
requires emitters

let emitVariantTables ~emitters variantTables =
let typeAnnotation = ": { [key: string]: any }" in
let emitTable ~table ~toJS (variantC : Converter.variantC) =
"const " ^ table ^ typeAnnotation ^ " = {"
^ (variantC.noPayloads
|> List.map (fun case ->
let js = case |> labelJSToString ~alwaysQuotes:(not toJS) in
let re =
case.label
|> Runtime.emitVariantLabel ~polymorphic:variantC.polymorphic
in
match toJS with
| true -> (re |> EmitText.quotesIfRequired) ^ ": " ^ js
| false -> js ^ ": " ^ re)
|> String.concat ", ")
^ "};"
in
Hashtbl.fold
(fun (_, toJS) variantC l -> (variantC, toJS) :: l)
variantTables []
|> List.sort (fun (variantC1, toJS1) (variantC2, toJS2) ->
let n = compare variantC1.Converter.hash variantC2.hash in
match n <> 0 with
| true -> n
| false -> compare toJS2 toJS1)
|> List.fold_left
(fun emitters (variantC, toJS) ->
variantC
|> emitTable
~table:(variantC.Converter.hash |> variantTable ~toJS)
~toJS
|> Emitters.requireEarly ~emitters)
emitters

let typeGetInlined ~config ~exportTypeMap type_ =
type_
|> Converter.typeGetNormalized ~config ~inline:true
Expand Down Expand Up @@ -762,7 +728,6 @@ let emitTranslationAsString ~config ~fileName ~inputCmtTranslateTypeDeclarations
| false -> env
in
let finalEnv = env in
let emitters = variantTables |> emitVariantTables ~emitters in
let emitters =
moduleItemsEmitter
|> ExportModule.emitAllModuleItems ~config ~emitters ~fileName
Expand Down
21 changes: 0 additions & 21 deletions jscomp/gentype/EmitText.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -40,32 +40,11 @@ let funDef ~bodyArgs ~functionName ~funParams ~indent ~mkBody ~typeVars =
^ genericsString ~typeVars ^ (funParams |> parens) ^ " {"
^ (bodyArgs |> mkBody) ^ Indent.break ~indent ^ "}"

let ifThenElse ~indent if_ then_ else_ =
let indent1 = indent |> Indent.more in
if_ ~indent:indent1 ^ Indent.break ~indent ^ "? " ^ then_ ~indent:indent1
^ Indent.break ~indent ^ ": " ^ else_ ~indent:indent1

let newNameGen () = Hashtbl.create 1
let quotes x = "\"" ^ x ^ "\""

let quotesIfRequired x =
match String.length x > 0 && (x.[0] [@doesNotRaise]) = '"' with
| true -> x
| false -> quotes x

let resultName ~nameGen = "result" |> name ~nameGen

let switch ~indent ~cases expr =
let lastCase = (cases |> List.length) - 1 in
cases
|> List.mapi (fun i (label, code) ->
if i = lastCase then code
else
expr ^ "===" ^ label ^ Indent.break ~indent ^ "? " ^ code
^ Indent.break ~indent ^ ": ")
|> String.concat ""

let typeOfObject x = "typeof(" ^ x ^ ")" ^ " === " ^ "'object'"
let addComment ~comment x = "\n/* " ^ comment ^ " */\n " ^ x
let arrayAccess ~index value = value ^ "[" ^ string_of_int index ^ "]"
let fieldAccess ~label value = value ^ "." ^ label

0 comments on commit 7812e1c

Please sign in to comment.