8
8
| OptionC of t
9
9
| PromiseC of t
10
10
| TupleC of t list
11
- | VariantC of variantC
12
11
13
12
and groupedArgConverter =
14
13
| ArgConverter of t
@@ -23,17 +22,6 @@ and functionC = {
23
22
uncurried : bool ;
24
23
}
25
24
26
- and variantC = {
27
- hash : int ;
28
- noPayloads : case list ;
29
- withPayloads : withPayload list ;
30
- polymorphic : bool ;
31
- unboxed : bool ;
32
- useVariantTables : bool ;
33
- }
34
-
35
- and withPayload = {case : case ; inlineRecord : bool ; argConverters : t list }
36
-
37
25
let rec toString converter =
38
26
match converter with
39
27
| ArrayC c -> " array(" ^ toString c ^ " )"
@@ -66,32 +54,10 @@ let rec toString converter =
66
54
| PromiseC c -> " promise(" ^ toString c ^ " )"
67
55
| TupleC innerTypesC ->
68
56
" [" ^ (innerTypesC |> List. map toString |> String. concat " , " ) ^ " ]"
69
- | VariantC {noPayloads; withPayloads} ->
70
- " variant("
71
- ^ ((noPayloads |> List. map labelJSToString)
72
- @ (withPayloads
73
- |> List. map (fun {case; inlineRecord; argConverters} ->
74
- (case |> labelJSToString)
75
- ^ (match inlineRecord with
76
- | true -> " inlineRecord "
77
- | false -> " " )
78
- ^ " :" ^ " {"
79
- ^ (argConverters |> List. map toString |> String. concat " , " )
80
- ^ " }" ))
81
- |> String. concat " , " )
82
- ^ " )"
83
57
84
58
let typeGetConverterNormalized ~config ~inline ~lookupId ~typeNameIsInterface
85
59
type0 =
86
60
let circular = ref " " in
87
- let expandOneLevel type_ =
88
- match type_ with
89
- | Ident {builtin = false ; name} -> (
90
- match name |> lookupId with
91
- | (t : CodeItem.exportTypeItem ) -> t.type_
92
- | exception Not_found -> type_)
93
- | _ -> type_
94
- in
95
61
let rec visit ~(visited : StringSet.t ) type_ =
96
62
let normalized_ = type_ in
97
63
match type_ with
@@ -139,7 +105,7 @@ let typeGetConverterNormalized ~config ~inline ~lookupId ~typeNameIsInterface
139
105
else
140
106
let visited = visited |> StringSet. add name in
141
107
match name |> lookupId with
142
- | {annotation = GenTypeOpaque } -> (IdentC , normalized_)
108
+ | {CodeItem. annotation = GenTypeOpaque } -> (IdentC , normalized_)
143
109
| {annotation = NoGenType } -> (IdentC , normalized_)
144
110
| {typeVars; type_} -> (
145
111
let pairs =
@@ -185,78 +151,7 @@ let typeGetConverterNormalized ~config ~inline ~lookupId ~typeNameIsInterface
185
151
in
186
152
(TupleC innerConversions, Tuple normalizedList)
187
153
| TypeVar _ -> (IdentC , normalized_)
188
- | Variant variant ->
189
- let allowUnboxed = not variant.polymorphic in
190
- let withPayloads, normalized, unboxed =
191
- match
192
- variant.payloads
193
- |> List. map (fun {case; inlineRecord; numArgs; t} ->
194
- (case, inlineRecord, numArgs, t |> visit ~visited ))
195
- with
196
- | [] when allowUnboxed -> ([] , normalized_, variant.unboxed)
197
- | [(case, inlineRecord, numArgs, (converter, tNormalized))]
198
- when allowUnboxed ->
199
- let unboxed = tNormalized |> expandOneLevel |> typeIsObject in
200
- let normalized =
201
- Variant
202
- {
203
- variant with
204
- payloads = [{case; inlineRecord; numArgs; t = tNormalized}];
205
- unboxed =
206
- (match unboxed with
207
- | true -> true
208
- | false -> variant.unboxed);
209
- }
210
- in
211
- let argConverters =
212
- match converter with
213
- | TupleC converters when numArgs > 1 -> converters
214
- | _ -> [converter]
215
- in
216
- ([{argConverters; case; inlineRecord}], normalized, unboxed)
217
- | withPayloadConverted ->
218
- let withPayloadNormalized =
219
- withPayloadConverted
220
- |> List. map (fun (case , inlineRecord , numArgs , (_ , tNormalized )) ->
221
- {case; inlineRecord; numArgs; t = tNormalized})
222
- in
223
- let normalized =
224
- Variant {variant with payloads = withPayloadNormalized}
225
- in
226
- ( withPayloadConverted
227
- |> List. map (fun (case , inlineRecord , numArgs , (converter , _ )) ->
228
- let argConverters =
229
- match converter with
230
- | TupleC converters when numArgs > 1 -> converters
231
- | _ -> [converter]
232
- in
233
- {argConverters; case; inlineRecord}),
234
- normalized,
235
- variant.unboxed )
236
- in
237
- let noPayloads = variant.noPayloads in
238
- let useVariantTables =
239
- if variant.bsStringOrInt then false
240
- else if variant.polymorphic then
241
- noPayloads
242
- |> List. exists (fun {label; labelJS} -> labelJS <> StringLabel label)
243
- || withPayloads
244
- |> List. exists (fun {case = {label; labelJS} } ->
245
- labelJS <> StringLabel label)
246
- else true
247
- in
248
- let converter =
249
- VariantC
250
- {
251
- hash = variant.hash;
252
- noPayloads;
253
- withPayloads;
254
- polymorphic = variant.polymorphic;
255
- unboxed;
256
- useVariantTables;
257
- }
258
- in
259
- (converter, normalized)
154
+ | Variant _ -> (IdentC , normalized_)
260
155
and argTypeToGroupedArgConverter ~visited {aName; aType} =
261
156
match aType with
262
157
| GroupOfLabeledArgs fields ->
@@ -322,13 +217,6 @@ let rec converterIsIdentity ~config ~toJS converter =
322
217
| PromiseC c -> c |> converterIsIdentity ~config ~to JS
323
218
| TupleC innerTypesC ->
324
219
innerTypesC |> List. for_all (converterIsIdentity ~config ~to JS)
325
- | VariantC {withPayloads; useVariantTables} ->
326
- if not useVariantTables then
327
- withPayloads
328
- |> List. for_all (fun {argConverters} ->
329
- argConverters
330
- |> List. for_all (fun c -> c |> converterIsIdentity ~config ~to JS))
331
- else false
332
220
333
221
let rec apply ~config ~converter ~indent ~nameGen ~toJS ~variantTables value =
334
222
match converter with
@@ -470,120 +358,6 @@ let rec apply ~config ~converter ~indent ~nameGen ~toJS ~variantTables value =
470
358
|> apply ~config ~converter: c ~indent ~name Gen ~to JS ~variant Tables)
471
359
|> String. concat " , " )
472
360
^ " ]"
473
- | VariantC {noPayloads = [case]; withPayloads = [] ; polymorphic} -> (
474
- match toJS with
475
- | true -> case |> labelJSToString
476
- | false -> case.label |> Runtime. emitVariantLabel ~polymorphic )
477
- | VariantC variantC -> (
478
- if variantC.noPayloads <> [] && variantC.useVariantTables then
479
- Hashtbl. replace variantTables (variantC.hash, toJS) variantC;
480
- let convertToString =
481
- match
482
- (not toJS)
483
- && variantC.noPayloads
484
- |> List. exists (fun {labelJS} ->
485
- labelJS = BoolLabel true || labelJS = BoolLabel false )
486
- with
487
- | true -> " .toString()"
488
- | false -> " "
489
- in
490
- let table = variantC.hash |> variantTable ~to JS in
491
- let accessTable v =
492
- match not variantC.useVariantTables with
493
- | true -> v
494
- | false -> table ^ EmitText. array [v ^ convertToString]
495
- in
496
- let convertVariantPayloadToJS ~indent ~argConverters x =
497
- match argConverters with
498
- | [converter] ->
499
- x |> apply ~config ~converter ~indent ~name Gen ~to JS ~variant Tables
500
- | _ ->
501
- argConverters
502
- |> List. mapi (fun i converter ->
503
- x
504
- |> Runtime. accessVariant ~index: i
505
- |> apply ~config ~converter ~indent ~name Gen ~to JS ~variant Tables)
506
- |> EmitText. array
507
- in
508
- let convertVariantPayloadToRE ~indent ~argConverters x =
509
- match argConverters with
510
- | [converter] ->
511
- [x |> apply ~config ~converter ~indent ~name Gen ~to JS ~variant Tables]
512
- | _ ->
513
- argConverters
514
- |> List. mapi (fun i converter ->
515
- x
516
- |> EmitText. arrayAccess ~index: i
517
- |> apply ~config ~converter ~indent ~name Gen ~to JS ~variant Tables)
518
- in
519
- match variantC.withPayloads with
520
- | [] -> value |> accessTable
521
- | [{case; inlineRecord; argConverters}] when variantC.unboxed -> (
522
- let casesWithPayload ~indent =
523
- if toJS then
524
- value
525
- |> Runtime. emitVariantGetPayload ~inline Record
526
- ~num Args:(argConverters |> List. length)
527
- ~polymorphic: variantC.polymorphic
528
- |> convertVariantPayloadToJS ~arg Converters ~indent
529
- else
530
- value
531
- |> convertVariantPayloadToRE ~arg Converters ~indent
532
- |> Runtime. emitVariantWithPayload ~inline Record ~label: case.label
533
- ~polymorphic: variantC.polymorphic
534
- in
535
- match variantC.noPayloads = [] with
536
- | true -> casesWithPayload ~indent
537
- | false ->
538
- EmitText. ifThenElse ~indent
539
- (fun ~indent :_ -> value |> EmitText. typeOfObject)
540
- casesWithPayload
541
- (fun ~indent :_ -> value |> accessTable))
542
- | _ :: _ -> (
543
- let convertCaseWithPayload ~indent ~inlineRecord ~argConverters case =
544
- if toJS then
545
- value
546
- |> Runtime. emitVariantGetPayload ~inline Record
547
- ~num Args:(argConverters |> List. length)
548
- ~polymorphic: variantC.polymorphic
549
- |> convertVariantPayloadToJS ~arg Converters ~indent
550
- |> Runtime. emitJSVariantWithPayload ~label: (case |> labelJSToString)
551
- ~polymorphic: variantC.polymorphic
552
- else
553
- value
554
- |> Runtime. emitJSVariantGetPayload ~polymorphic: variantC.polymorphic
555
- |> convertVariantPayloadToRE ~arg Converters ~indent
556
- |> Runtime. emitVariantWithPayload ~inline Record ~label: case.label
557
- ~polymorphic: variantC.polymorphic
558
- in
559
- let switchCases ~indent =
560
- variantC.withPayloads
561
- |> List. map (fun {case; inlineRecord; argConverters} ->
562
- ( (match toJS with
563
- | true ->
564
- case.label
565
- |> Runtime. emitVariantLabel ~polymorphic: variantC.polymorphic
566
- | false -> case |> labelJSToString),
567
- case
568
- |> convertCaseWithPayload ~indent ~inline Record ~arg Converters
569
- ))
570
- in
571
- let casesWithPayload ~indent =
572
- value
573
- |> (let open Runtime in
574
- (match toJS with
575
- | true -> emitVariantGetLabel
576
- | false -> emitJSVariantGetLabel)
577
- ~polymorphic: variantC.polymorphic)
578
- |> EmitText. switch ~indent ~cases: (switchCases ~indent )
579
- in
580
- match variantC.noPayloads = [] with
581
- | true -> casesWithPayload ~indent
582
- | false ->
583
- EmitText. ifThenElse ~indent
584
- (fun ~indent :_ -> value |> EmitText. typeOfObject)
585
- casesWithPayload
586
- (fun ~indent :_ -> value |> accessTable)))
587
361
588
362
let toJS ~config ~converter ~indent ~nameGen ~variantTables value =
589
363
value |> apply ~config ~converter ~indent ~name Gen ~variant Tables ~to JS:true
0 commit comments