-
Notifications
You must be signed in to change notification settings - Fork 301
/
FSharp2Fable.fs
2699 lines (2280 loc) · 113 KB
/
FSharp2Fable.fs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
module rec Fable.Transforms.FSharp2Fable.Compiler
open System
open System.Collections.Generic
open FSharp.Compiler.Symbols
open Fable
open Fable.AST
open Fable.Transforms
open MonadicTrampoline
open Patterns
open TypeHelpers
open Identifiers
open Helpers
open Util
let inline private transformExprList com ctx xs =
trampolineListMap (transformExpr com ctx []) xs
let inline private transformExprOpt com ctx opt =
trampolineOptionMap (transformExpr com ctx []) opt
let private transformBaseConsCall
com
ctx
r
(baseEnt: FSharpEntity)
(baseCons: FSharpMemberOrFunctionOrValue)
genArgs
baseArgs
=
let baseEntRef = FsEnt.Ref(baseEnt)
let argTypes = lazy getArgTypes com baseCons
let baseArgs = transformExprList com ctx baseArgs |> run
let genArgs = genArgs |> List.map (makeType ctx.GenericArgs)
match Replacements.Api.tryBaseConstructor com ctx baseEntRef argTypes genArgs baseArgs with
| Some(baseRef, args) ->
let callInfo =
Fable.CallInfo.Create(args = args, sigArgTypes = getArgTypes com baseCons)
makeCall r Fable.Unit callInfo baseRef
| None ->
if not baseCons.IsImplicitConstructor then
"Only inheriting from primary constructors is supported" |> addWarning com [] r
match makeCallFrom com ctx r Fable.Unit genArgs None baseArgs baseCons with
| Fable.Call(_baseExpr, info, t, r) ->
// The baseExpr will be the exposed constructor function,
// replace with a direct reference to the entity
let baseExpr =
match tryGlobalOrImportedFSharpEntity com baseEnt with
| Some baseExpr -> baseExpr
| None -> FsEnt.Ref baseEnt |> entityIdent com
Fable.Call(baseExpr, info, t, r)
// Other cases, like Emit will call directly the base expression
| e -> e
let private transformNewUnion com ctx r fsType (unionCase: FSharpUnionCase) (argExprs: Fable.Expr list) =
match getUnionPattern fsType unionCase with
| ErasedUnionCase -> makeTuple r false argExprs
| ErasedUnion(tdef, _genArgs, rule) ->
match argExprs with
| [] -> transformStringEnum rule unionCase
| [ argExpr ] -> argExpr
| _ when tdef.UnionCases.Count > 1 ->
"Erased unions with multiple cases must have one single field: "
+ (getFsTypeFullName fsType)
|> addErrorAndReturnNull com ctx.InlinePath r
| argExprs -> makeTuple r false argExprs
| TypeScriptTaggedUnion(_, _, tagName, rule) ->
match argExprs with
| [ argExpr ] when not (FsUnionCase.HasNamedFields unionCase) -> argExpr
| _ ->
let isCompiledValue, tagExpr =
match FsUnionCase.CompiledValue unionCase with
| None -> false, transformStringEnum rule unionCase
| Some(CompiledValue.Integer i) -> false, makeIntConst i
| Some(CompiledValue.Float f) -> false, makeFloatConst f
| Some(CompiledValue.Boolean b) -> false, makeBoolConst b
match isCompiledValue, com.Options.Language with
| true, TypeScript ->
"CompileValue attribute is not supported in TypeScript"
|> addErrorAndReturnNull com ctx.InlinePath r
| _ ->
let fieldNames, fieldTypes =
unionCase.Fields
|> Seq.map (fun fi -> fi.Name, fi.FieldType)
|> Seq.toArray
|> Array.unzip
let fieldTypes = makeTypeGenArgs ctx.GenericArgs fieldTypes
Fable.NewAnonymousRecord(
tagExpr :: argExprs,
Array.append [| tagName |] fieldNames,
tagExpr.Type :: fieldTypes,
false
)
|> makeValue r
| StringEnum(tdef, rule) ->
match argExprs with
| [] -> transformStringEnum rule unionCase
| _ ->
$"StringEnum types cannot have fields: {tdef.TryFullName}"
|> addErrorAndReturnNull com ctx.InlinePath r
| OptionUnion(typ, isStruct) ->
let typ = makeType ctx.GenericArgs typ
let expr =
match argExprs with
| [] -> None
| [ expr ] -> Some expr
| _ -> failwith "Unexpected args for Option constructor"
Fable.NewOption(expr, typ, isStruct) |> makeValue r
| ListUnion typ ->
let typ = makeType ctx.GenericArgs typ
let headAndTail =
match argExprs with
| [] -> None
| [ head; tail ] -> Some(head, tail)
| _ -> failwith "Unexpected args for List constructor"
Fable.NewList(headAndTail, typ) |> makeValue r
| DiscriminatedUnion(tdef, genArgs) ->
let genArgs = makeTypeGenArgs ctx.GenericArgs genArgs
let tag = unionCaseTag com tdef unionCase
Fable.NewUnion(argExprs, tag, FsEnt.Ref tdef, genArgs) |> makeValue r
let private transformTraitCall
com
(ctx: Context)
r
typ
(sourceTypes: Fable.Type list)
traitName
isInstance
(argTypes: Fable.Type list)
(argExprs: Fable.Expr list)
=
let makeCallInfo traitName entityFullName argTypes genArgs : Fable.ReplaceCallInfo =
{
SignatureArgTypes = argTypes
DeclaringEntityFullName = entityFullName
HasSpread = false
IsModuleValue = false
// We only need this for types with own entries in Fable AST
// (no interfaces, see below) so it's safe to set this to false
IsInterface = false
CompiledName = traitName
OverloadSuffix = ""
GenericArgs = genArgs
}
let thisArg, args, argTypes =
match argExprs, argTypes with
| thisArg :: args, _ :: argTypes when isInstance -> Some thisArg, args, argTypes
| args, argTypes -> None, args, argTypes
let rec matchGenericType (genArgs: Map<string, Fable.Type>) (signatureType: Fable.Type, concreteType: Fable.Type) =
match signatureType with
| Fable.GenericParam(name = name) when not (genArgs.ContainsKey(name)) -> Map.add name concreteType genArgs
| signatureType ->
let signatureTypeGenerics = signatureType.Generics
if List.isEmpty signatureTypeGenerics then
genArgs
else
let concreteTypeGenerics = concreteType.Generics
if List.sameLength signatureTypeGenerics concreteTypeGenerics then
(genArgs, List.zip signatureTypeGenerics concreteTypeGenerics)
||> List.fold matchGenericType
else
genArgs // Unexpected, error?
let resolveMemberCall
(entity: Fable.Entity)
(entGenArgs: Fable.Type list)
membCompiledName
isInstance
argTypes
thisArg
args
=
let entGenParamNames = entity.GenericParameters |> List.map (fun x -> x.Name)
let entGenArgsMap = List.zip entGenParamNames entGenArgs |> Map
tryFindMember entity entGenArgsMap membCompiledName isInstance argTypes
|> Option.map (fun memb ->
// Resolve method generic args before making the call, see #2135
let genArgsMap =
let membParamTypes =
memb.CurriedParameterGroups
|> Seq.collect (fun group -> group |> Seq.map (fun p -> p.Type))
|> Seq.toList
if List.sameLength argTypes membParamTypes then
let argTypes = argTypes @ [ typ ]
let membParamTypes = membParamTypes @ [ memb.ReturnParameter.Type ]
(entGenArgsMap, List.zip membParamTypes argTypes)
||> List.fold (fun genArgs (paramType, argType) ->
let paramType = makeType Map.empty paramType
matchGenericType genArgs (paramType, argType)
)
else
Map.empty // Unexpected, error?
let genArgs =
memb.GenericParameters
|> Seq.mapToList (fun p ->
let name = genParamName p
match Map.tryFind name genArgsMap with
| Some t -> t
| None ->
Fable.GenericParam(name, p.IsMeasure, p.Constraints |> Seq.chooseToList FsGenParam.Constraint)
)
makeCallFrom com ctx r typ (entGenArgs @ genArgs) thisArg args memb
)
sourceTypes
|> List.tryPick (fun t ->
let typeOpt = Replacements.Api.tryType com t
match typeOpt with
| Some(entityFullName, makeCall, genArgs) ->
let info = makeCallInfo traitName entityFullName argTypes genArgs
makeCall com ctx r typ info thisArg args
| None ->
match t with
| Fable.DeclaredType(entity, entGenArgs) ->
let entity = com.GetEntity(entity)
// SRTP only works for records if there are no arguments
if
isInstance
&& entity.IsFSharpRecord
&& List.isEmpty args
&& Option.isSome thisArg
then
let fieldName = Naming.removeGetSetPrefix traitName
entity.FSharpFields
|> List.tryPick (fun fi ->
if fi.Name = fieldName then
let kind =
Fable.FieldInfo.Create(fi.Name, fieldType = fi.FieldType, isMutable = fi.IsMutable)
Fable.Get(thisArg.Value, kind, typ, r) |> Some
else
None
)
|> Option.orElseWith (fun () ->
resolveMemberCall entity entGenArgs traitName isInstance argTypes thisArg args
)
else
resolveMemberCall entity entGenArgs traitName isInstance argTypes thisArg args
| Fable.AnonymousRecordType(sortedFieldNames, entGenArgs, _isStruct) when
isInstance && List.isEmpty args && Option.isSome thisArg
->
let fieldName = Naming.removeGetSetPrefix traitName
Seq.zip sortedFieldNames entGenArgs
|> Seq.tryPick (fun (fi, fiType) ->
if fi = fieldName then
Fable.Get(thisArg.Value, Fable.FieldInfo.Create(fi, fieldType = fiType), typ, r)
|> Some
else
None
)
| _ -> None
)
|> Option.defaultWith (fun () ->
"Cannot resolve trait call " + traitName
|> addErrorAndReturnNull com ctx.InlinePath r
)
let private transformCallee com ctx callee (calleeType: FSharpType) =
trampoline {
let! callee = transformExprOpt com ctx callee
let callee =
match callee with
| Some callee -> callee
| None -> FsEnt.Ref calleeType.TypeDefinition |> entityIdent com
return callee
}
let private resolveImportMemberBinding (ident: Fable.Ident) (info: Fable.ImportInfo) =
if info.Selector = Naming.placeholder then
{ info with Selector = ident.Name }
else
info
type private SignatureInfo =
{|
name: string
isMangled: bool
memberRef: Fable.MemberRef
|}
let private getImplementedSignatureInfo
com
ctx
r
nonMangledNameConflicts
(implementingEntity: FSharpEntity option)
(sign: FSharpAbstractSignature)
=
let implementingEntityFields = HashSet<_>()
let implementingEntityName =
match implementingEntity with
| Some e ->
e.FSharpFields
|> Seq.iter (fun x -> implementingEntityFields.Add(x.Name) |> ignore)
e.FullName
| None -> ""
// Don't use the type from the arguments as the override may come from another type, like ToString()
tryDefinition sign.DeclaringType
|> Option.bind (fun (ent, _entFullName) ->
// Only compare param types for overloads (single curried parameter group)
let paramTypes =
if sign.AbstractArguments.Count = 1 then
sign.AbstractArguments[0]
|> Seq.map (fun p -> makeType Map.empty p.Type)
|> Seq.toArray
|> Some
else
None
tryFindAbstractMember com ent sign.Name paramTypes
|> Option.map (fun m -> ent, m)
)
|> Option.map (fun (ent, memb) ->
let info = getAbstractMemberInfo com ent memb
// Setters can have same name as getters, assume there will always be a getter
if
not info.isMangled
&& not info.isSetter
&& (nonMangledNameConflicts implementingEntityName info.name
|| implementingEntityFields.Contains(info.name))
then
$"Member %s{info.name} is duplicated, use Mangle attribute to prevent conflicts with interfaces"
// TODO: Temporarily emitting a warning, because this errors in old libraries, like Fable.React.HookBindings
|> addWarning com ctx.InlinePath r
{|
name = info.name
isMangled = info.isMangled
memberRef = getFunctionMemberRef memb
|}
)
|> Option.defaultWith (fun () ->
let isGetter =
sign.Name.StartsWith("get_", StringComparison.Ordinal)
&& countNonCurriedParamsForSignature sign = 0
let isSetter =
not isGetter
&& sign.Name.StartsWith("set_", StringComparison.Ordinal)
&& countNonCurriedParamsForSignature sign = 1
let name =
if isGetter || isSetter then
Naming.removeGetSetPrefix sign.Name
else
sign.Name
let generatedMember =
if isGetter then
Fable.GeneratedMember.Getter(name, makeType Map.empty sign.AbstractReturnType)
elif isSetter then
Fable.GeneratedMember.Setter(name, makeType Map.empty (sign.AbstractArguments[0].[1].Type))
else
Fable.GeneratedMember.Function(
name,
sign.AbstractArguments
|> Seq.concat
|> Seq.mapToList (fun p -> makeType Map.empty p.Type),
makeType Map.empty sign.AbstractReturnType
)
{|
name = name
isMangled = false
memberRef = generatedMember
|}
)
let private transformObjExpr
(com: IFableCompiler)
(ctx: Context)
(objType: FSharpType)
baseCallExpr
(overrides: FSharpObjectExprOverride list)
otherOverrides
=
let nonMangledMemberNames = HashSet()
let nonMangledNameConflicts _ name = nonMangledMemberNames.Add(name) |> not
let mapOverride (over: FSharpObjectExprOverride) : Thunk<Fable.ObjectExprMember> =
trampoline {
let signature = over.Signature
let r = makeRangeFrom over.Body
let info =
getImplementedSignatureInfo com ctx r nonMangledNameConflicts None signature
let ctx, args = bindMemberArgs com ctx over.CurriedParameterGroups
let! body = transformExpr com ctx [] over.Body
return
{
Name = info.name
Args = args
Body = body
IsMangled = info.isMangled
MemberRef = info.memberRef
}
}
trampoline {
let! baseCall =
trampoline {
match baseCallExpr with
// TODO: For interface implementations this should be FSharpExprPatterns.NewObject
// but check the baseCall.DeclaringEntity name just in case
| FSharpExprPatterns.Call(None, baseCall, genArgs1, genArgs2, baseArgs) ->
match baseCall.DeclaringEntity with
| Some baseEnt when baseEnt.TryFullName <> Some Types.object ->
let r = makeRangeFrom baseCallExpr
let genArgs = genArgs1 @ genArgs2
return transformBaseConsCall com ctx r baseEnt baseCall genArgs baseArgs |> Some
| _ -> return None
| _ -> return None
}
let! members =
(objType, overrides) :: otherOverrides
|> trampolineListMap (fun (_typ, overrides) -> overrides |> trampolineListMap mapOverride)
return Fable.ObjectExpr(members |> List.concat, makeType ctx.GenericArgs objType, baseCall)
}
let private transformDelegate com ctx (delegateType: FSharpType) expr =
trampoline {
let! expr = transformExpr com ctx [] expr
// For some reason, when transforming to Func<'T> (no args) the F# compiler
// applies a unit arg to the expression, see #2400
let expr =
match tryDefinition delegateType with
| Some(_, Some "System.Func`1") ->
match expr with
| Fable.CurriedApply(expr, [ Fable.Value(Fable.UnitConstant, _) ], _, _) -> expr
| Fable.Call(expr, { Args = [ Fable.Value(Fable.UnitConstant, _) ] }, _, _) -> expr
| _ -> expr
| _ -> expr
match makeType ctx.GenericArgs delegateType with
| Fable.DelegateType(argTypes, _) ->
let arity = List.length argTypes |> max 1
match expr with
| LambdaUncurriedAtCompileTime (Some arity) lambda -> return lambda
| _ when arity > 1 -> return Replacements.Api.uncurryExprAtRuntime com arity expr
| _ -> return expr
| _ -> return expr
}
let private transformUnionCaseTest
(com: IFableCompiler)
(ctx: Context)
r
unionExpr
fsType
(unionCase: FSharpUnionCase)
=
trampoline {
let! unionExpr = transformExpr com ctx [] unionExpr
match getUnionPattern fsType unionCase with
| ErasedUnionCase -> return "Cannot test erased union cases" |> addErrorAndReturnNull com ctx.InlinePath r
| ErasedUnion(tdef, genArgs, rule) ->
match unionCase.Fields.Count with
| 0 -> return makeEqOp r unionExpr (transformStringEnum rule unionCase) BinaryEqual
| 1 ->
let fi = unionCase.Fields[0]
let typ =
if fi.FieldType.IsGenericParameter then
let name = genParamName fi.FieldType.GenericParameter
let index =
tdef.GenericParameters |> Seq.findIndex (fun arg -> genParamName arg = name)
genArgs[index]
else
fi.FieldType
let kind = makeType ctx.GenericArgs typ |> Fable.TypeTest
return Fable.Test(unionExpr, kind, r)
| _ ->
return
"Erased unions with multiple cases cannot have more than one field: "
+ (getFsTypeFullName fsType)
|> addErrorAndReturnNull com ctx.InlinePath r
| TypeScriptTaggedUnion(_, _, tagName, rule) ->
let isCompiledValue, value =
match FsUnionCase.CompiledValue unionCase with
| None -> false, transformStringEnum rule unionCase
| Some(CompiledValue.Integer i) -> true, makeIntConst i
| Some(CompiledValue.Float f) -> true, makeFloatConst f
| Some(CompiledValue.Boolean b) -> true, makeBoolConst b
match isCompiledValue, com.Options.Language with
| true, TypeScript ->
return
"CompileValue attribute is not supported in TypeScript"
|> addErrorAndReturnNull com ctx.InlinePath r
| _ ->
let getTag = Fable.Get(unionExpr, Fable.FieldInfo.Create(tagName), value.Type, r)
return makeEqOp r getTag value BinaryEqual
| OptionUnion _ ->
let kind =
Fable.OptionTest(unionCase.Name <> "None" && unionCase.Name <> "ValueNone")
return Fable.Test(unionExpr, kind, r)
| ListUnion _ ->
let kind = Fable.ListTest(unionCase.CompiledName <> "Empty")
return Fable.Test(unionExpr, kind, r)
| StringEnum(_, rule) -> return makeEqOp r unionExpr (transformStringEnum rule unionCase) BinaryEqual
| DiscriminatedUnion(tdef, _) ->
let tag = unionCaseTag com tdef unionCase
return Fable.Test(unionExpr, Fable.UnionCaseTest(tag), r)
}
let rec private transformDecisionTargets
(com: IFableCompiler)
(ctx: Context)
acc
(xs: (FSharpMemberOrFunctionOrValue list * FSharpExpr) list)
=
trampoline {
match xs with
| [] -> return List.rev acc
| (idents, expr) :: tail ->
let ctx, idents =
(idents, (ctx, []))
||> List.foldBack (fun ident (ctx, idents) ->
let ctx, ident = putIdentInScope com ctx ident None
ctx, ident :: idents
)
let! expr = transformExpr com ctx [] expr
return! transformDecisionTargets com ctx ((idents, expr) :: acc) tail
}
let private transformExpr (com: IFableCompiler) (ctx: Context) appliedGenArgs fsExpr =
trampoline {
match fsExpr with
// | ByrefArgToTuple (callee, memb, ownerGenArgs, membGenArgs, membArgs) ->
// let! callee = transformExprOpt com ctx callee
// let! args = transformExprList com ctx membArgs
// let genArgs = ownerGenArgs @ membGenArgs |> Seq.map (makeType ctx.GenericArgs)
// let typ = makeType ctx.GenericArgs fsExpr.Type
// return makeCallFrom com ctx (makeRangeFrom fsExpr) typ genArgs callee args memb
// | ByrefArgToTupleOptimizedIf (outArg, callee, memb, ownerGenArgs, membGenArgs, membArgs, thenExpr, elseExpr) ->
// let ctx, ident = putArgInScope com ctx outArg
// let! callee = transformExprOpt com ctx callee
// let! args = transformExprList com ctx membArgs
// let genArgs = ownerGenArgs @ membGenArgs |> Seq.map (makeType ctx.GenericArgs)
// let byrefType = makeType ctx.GenericArgs (List.last membArgs).Type
// let tupleType = [Fable.Boolean; byrefType] |> Fable.Tuple
// let tupleIdent = getIdentUniqueName ctx "tuple" |> makeIdent
// let tupleIdentExpr = Fable.IdentExpr tupleIdent
// let tupleExpr = makeCallFrom com ctx None tupleType genArgs callee args memb
// let identExpr = Fable.Get(tupleIdentExpr, Fable.TupleIndex 1, tupleType, None)
// let guardExpr = Fable.Get(tupleIdentExpr, Fable.TupleIndex 0, tupleType, None)
// let! thenExpr = transformExpr com ctx [] thenExpr
// let! elseExpr = transformExpr com ctx [] elseExpr
// let ifThenElse = Fable.IfThenElse(guardExpr, thenExpr, elseExpr, None)
// return Fable.Let([tupleIdent, tupleExpr], Fable.Let([ident, identExpr], ifThenElse))
// | ByrefArgToTupleOptimizedIf (outArg, callee, memb, ownerGenArgs, membGenArgs, membArgs, thenExpr, elseExpr) ->
// let ctx, ident = putArgInScope com ctx outArg
// let! callee = transformExprOpt com ctx callee
// let! args = transformExprList com ctx membArgs
// let genArgs = ownerGenArgs @ membGenArgs |> Seq.map (makeType ctx.GenericArgs)
// let byrefType = makeType ctx.GenericArgs (List.last membArgs).Type
// let tupleType = [Fable.Boolean; byrefType] |> Fable.Tuple
// let tupleIdent = getIdentUniqueName ctx "tuple" |> makeIdent
// let tupleIdentExpr = Fable.IdentExpr tupleIdent
// let tupleExpr = makeCallFrom com ctx None tupleType genArgs callee args memb
// let identExpr = Fable.Get(tupleIdentExpr, Fable.TupleIndex 1, tupleType, None)
// let guardExpr = Fable.Get(tupleIdentExpr, Fable.TupleIndex 0, tupleType, None)
// let! thenExpr = transformExpr com ctx [] thenExpr
// let! elseExpr = transformExpr com ctx [] elseExpr
// let ifThenElse = Fable.IfThenElse(guardExpr, thenExpr, elseExpr, None)
// return Fable.Let([tupleIdent, tupleExpr], Fable.Let([ident, identExpr], ifThenElse))
// | ByrefArgToTupleOptimizedTree (outArg, callee, memb, ownerGenArgs, membGenArgs, membArgs, thenExpr, elseExpr, targetsExpr) ->
// let ctx, ident = putArgInScope com ctx outArg
// let! callee = transformExprOpt com ctx callee
// let! args = transformExprList com ctx membArgs
// let genArgs = ownerGenArgs @ membGenArgs |> Seq.map (makeType ctx.GenericArgs)
// let byrefType = makeType ctx.GenericArgs (List.last membArgs).Type
// let tupleType = [Fable.Boolean; byrefType] |> Fable.Tuple
// let tupleIdentExpr = Fable.IdentExpr ident
// let tupleExpr = makeCallFrom com ctx None tupleType genArgs callee args memb
// let guardExpr = Fable.Get(tupleIdentExpr, Fable.TupleIndex 0, tupleType, None)
// let! thenExpr = transformExpr com ctx [] thenExpr
// let! elseExpr = transformExpr com ctx [] elseExpr
// let! targetsExpr = transformDecisionTargets com ctx [] targetsExpr
// let ifThenElse = Fable.IfThenElse(guardExpr, thenExpr, elseExpr, None)
// return Fable.Let([ident, tupleExpr], Fable.DecisionTree(ifThenElse, targetsExpr))
// | ByrefArgToTupleOptimizedLet (id1, id2, callee, memb, ownerGenArgs, membGenArgs, membArgs, restExpr) ->
// let ctx, ident1 = putArgInScope com ctx id1
// let ctx, ident2 = putArgInScope com ctx id2
// let! callee = transformExprOpt com ctx callee
// let! args = transformExprList com ctx membArgs
// let genArgs = ownerGenArgs @ membGenArgs |> Seq.map (makeType ctx.GenericArgs)
// let byrefType = makeType ctx.GenericArgs (List.last membArgs).Type
// let tupleType = [Fable.Boolean; byrefType] |> Fable.Tuple
// let tupleIdent = getIdentUniqueName ctx "tuple" |> makeIdent
// let tupleIdentExpr = Fable.IdentExpr tupleIdent
// let tupleExpr = makeCallFrom com ctx None tupleType genArgs callee args memb
// let id1Expr = Fable.Get(tupleIdentExpr, Fable.TupleIndex 0, tupleType, None)
// let id2Expr = Fable.Get(tupleIdentExpr, Fable.TupleIndex 1, tupleType, None)
// let! restExpr = transformExpr com ctx [] restExpr
// let body = Fable.Let([ident1, id1Expr], Fable.Let([ident2, id2Expr], restExpr))
// return Fable.Let([tupleIdent, tupleExpr], body)
// | ForOf (PutArgInScope com ctx (newContext, ident), value, body) ->
// let! value = transformExpr com ctx [] value
// let! body = transformExpr com newContext body
// return Replacements.iterate com (makeRangeFrom fsExpr) ident body value
// work-around for optimized "for x in list" (erases this sequential)
// | FSharpExprPatterns.Sequential (FSharpExprPatterns.ValueSet (current, FSharpExprPatterns.Value next1),
// (FSharpExprPatterns.ValueSet (next2, FSharpExprPatterns.UnionCaseGet
// (_value, typ, unionCase, field))))
// when next1.FullName = "next" && next2.FullName = "next"
// && current.FullName = "current" && (getFsTypeFullName typ) = Types.list
// && unionCase.Name = "op_ColonColon" && field.Name = "Tail" ->
// // replace with nothing
// return Fable.UnitConstant |> makeValue None
| OptimizedOperator com (memb, comp, opName, argTypes, argExprs) ->
let r, typ = makeRangeFrom fsExpr, makeType ctx.GenericArgs fsExpr.Type
let argTypes = argTypes |> List.map (makeType ctx.GenericArgs)
let! args = transformExprList com ctx argExprs
let entity: Fable.Entity =
match comp with
| Some comp -> upcast FsEnt comp.DeclaringEntity.Value
| None -> upcast FsEnt memb.DeclaringEntity.Value
let membOpt = tryFindMember entity ctx.GenericArgs opName false argTypes
return
(match membOpt with
| Some memb -> makeCallFrom com ctx r typ argTypes None args memb
| None -> failwith $"Cannot find member %s{entity.FullName}.%s{opName}")
| FSharpExprPatterns.Coerce(targetType, inpExpr) ->
let! (inpExpr: Fable.Expr) = transformExpr com ctx [] inpExpr
let t = makeType ctx.GenericArgs targetType
return Fable.TypeCast(inpExpr, t)
// TypeLambda is a local generic lambda
// e.g, member x.Test() = let typeLambda x = x in typeLambda 1, typeLambda "A"
// Sometimes these must be inlined, but that's resolved in FSharpExprPatterns.Let (see below)
| FSharpExprPatterns.TypeLambda(genArgs, lambda) ->
let ctx = resolveTypeLambdaGenArgs ctx genArgs lambda
let! lambda = transformExpr com ctx [] lambda
return lambda
| FSharpExprPatterns.FastIntegerForLoop(start, limit, body, isUp, _, _) ->
let r = makeRangeFrom fsExpr
match body with
| FSharpExprPatterns.Lambda(PutIdentInScope com ctx (newContext, ident), body) ->
let! start = transformExpr com ctx [] start
let! limit = transformExpr com ctx [] limit
let! body = transformExpr com newContext [] body
return makeForLoop r isUp ident start limit body
| _ -> return failwithf $"Unexpected loop {r}: %A{fsExpr}"
| FSharpExprPatterns.WhileLoop(guardExpr, bodyExpr, _) ->
let! guardExpr = transformExpr com ctx [] guardExpr
let! bodyExpr = transformExpr com ctx [] bodyExpr
return (guardExpr, bodyExpr) ||> makeWhileLoop (makeRangeFrom fsExpr)
| FSharpExprPatterns.Const(value, typ) ->
let typ = makeType ctx.GenericArgs typ
let expr = makeTypeConst (makeRangeFrom fsExpr) typ value
return expr
| FSharpExprPatterns.BaseValue typ ->
let r = makeRangeFrom fsExpr
let typ = makeType Map.empty typ
return Fable.Value(Fable.BaseValue(ctx.BoundMemberThis, typ), r)
// F# compiler doesn't represent `this` in non-constructors as FSharpExprPatterns.ThisValue (but FSharpExprPatterns.Value)
| FSharpExprPatterns.ThisValue typ ->
let r = makeRangeFrom fsExpr
return
match typ, ctx.BoundConstructorThis with
// When it's ref type, this is the x in `type C() as x =`
| RefType _, _ ->
tryGetIdentFromScopeIf ctx r None (fun fsRef -> fsRef.IsConstructorThisValue)
|> Option.defaultWith (fun () ->
"Cannot find ConstructorThisValue" |> addErrorAndReturnNull com ctx.InlinePath r
)
// Check if `this` has been bound previously to avoid conflicts with an object expression
| _, Some i -> identWithRange r i |> Fable.IdentExpr
| _, None -> Fable.Value(makeType Map.empty typ |> Fable.ThisValue, r)
| FSharpExprPatterns.Value var ->
let r = makeRangeFrom fsExpr
let ctx =
List.map (makeType ctx.GenericArgs) appliedGenArgs
|> addGenArgsToContext ctx var
if isInline var then
let r = makeRangeFrom fsExpr
match ctx.ScopeInlineValues |> List.tryFind (fun (v, _) -> obj.Equals(v, var)) with
| Some(_, fsExpr) -> return! transformExpr com ctx [] fsExpr
| None ->
return
"Cannot resolve locally inlined value: " + var.DisplayName
|> addErrorAndReturnNull com ctx.InlinePath r
else
let v = makeValueFrom com ctx r var
if
isByRefValue var
&&
// The replacement only needs to happen when var.FullType = byref<fsExpr.Type>
fsExpr.Type = var.FullType.GenericArguments.[0]
&& com.Options.Language <> Rust
then
// Getting byref value is compiled as FSharpRef op_Dereference
return Replacements.Api.getRefCell com r (List.head v.Type.Generics) v
else
return v
// This is usually used to fill missing [<Optional>] arguments.
// Unchecked.defaultof<'T> is resolved in Replacements instead.
| FSharpExprPatterns.DefaultValue(FableType com ctx typ) ->
let r = makeRangeFrom fsExpr
match Compiler.Language with
// In Dart we don't want the compiler to pass default values other than null to [<Optional>] args
| Dart -> return Fable.Value(Fable.Null typ, r)
| _ -> return Replacements.Api.defaultof com ctx r typ
| FSharpExprPatterns.Let((var, value, _), body) ->
match value with
| CreateEvent(value, event) as createEvent ->
let! value = transformExpr com ctx [] value
let typ = makeType ctx.GenericArgs createEvent.Type
let value =
makeCallFrom com ctx (makeRangeFrom createEvent) typ [] (Some value) [] event
let ctx, ident = putIdentInScope com ctx var (Some value)
let! body = transformExpr com ctx [] body
return Fable.Let(ident, value, body)
// Because in Dart we compile DefaultValue as null when it's passed to optional arguments,
// check if it's directly assigned in a binding and use the actual default value in that case
// (This is necessary to properly initialize the out arg in `TryParse` methods)
| FSharpExprPatterns.DefaultValue(FableType com ctx typ) ->
let r = makeRangeFrom fsExpr
let value = Replacements.Api.defaultof com ctx r typ
let ctx, ident = putIdentInScope com ctx var (Some value)
let! body = transformExpr com ctx [] body
return Fable.Let(ident, value, body)
// F# compiler generates a tuple when matching against multiple values,
// we replace with immutable bindings instead which generates better code
// and increases the chances of the tuple being removed in beta reduction
| FSharpExprPatterns.NewTuple(tupleType, tupleValues) as tupleExpr when
var.IsCompilerGenerated
&& (var.CompiledName = "matchValue" || var.CompiledName = "patternInput")
->
let! tupleValues = transformExprList com ctx tupleValues
let bindings, tupleValues =
(([], []), tupleValues)
||> List.fold (fun (bindings, tupleValues) value ->
match value with
| Fable.IdentExpr id ->
if not id.IsMutable then
bindings, value :: tupleValues
else
let i = getIdentUniqueName ctx id.Name |> makeTypedIdent id.Type
(i, value) :: bindings, (Fable.IdentExpr i) :: tupleValues
| value ->
let i = getIdentUniqueName ctx "matchValue" |> makeTypedIdent value.Type
(i, value) :: bindings, (Fable.IdentExpr i) :: tupleValues
)
let value =
Fable.NewTuple(List.rev tupleValues, tupleType.IsStructTupleType)
|> makeValue (makeRangeFrom tupleExpr)
let ctx, ident = putIdentInScope com ctx var (Some value)
let! body = transformExpr com ctx [] body
let expr = Fable.Let(ident, value, body)
return (expr, bindings) ||> List.fold (fun e (i, v) -> Fable.Let(i, v, e))
| _ when isInline var ->
let ctx = { ctx with ScopeInlineValues = (var, value) :: ctx.ScopeInlineValues }
return! transformExpr com ctx [] body
| _ ->
let ctx, value =
match value with
| FSharpExprPatterns.TypeLambda(genArgs, lambda) ->
let ctx = resolveTypeLambdaGenArgs ctx genArgs lambda
ctx, lambda
| _ -> ctx, value
let! value = transformExpr com ctx [] value
let ctx, ident = putIdentInScope com ctx var (Some value)
let! body = transformExpr com ctx [] body
match value with
| Fable.Import(info, t, r) when not info.IsCompilerGenerated ->
return Fable.Let(ident, Fable.Import(resolveImportMemberBinding ident info, t, r), body)
// Unwrap lambdas for user-generated imports, as in: `let add (x:int) (y:int): int = importMember "./util.js"`
| AST.NestedLambda(args, Fable.Import(info, _, r), _) when not info.IsCompilerGenerated ->
let t = value.Type
let info = resolveImportMemberBinding ident info
return
Fable.Let(
ident,
Fable.Extended(Fable.Curry(Fable.Import(info, t, r), List.length args), r),
body
)
| _ -> return Fable.Let(ident, value, body)
| FSharpExprPatterns.LetRec(recBindings, body) ->
// First get a context containing all idents and use it compile the values
let ctx, idents =
(recBindings, (ctx, []))
||> List.foldBack (fun (PutIdentInScope com ctx (newContext, ident), _, _) (ctx, idents) ->
(newContext, ident :: idents)
)
let _, bindingExprs, _ = List.unzip3 recBindings
let! exprs = transformExprList com ctx bindingExprs
let bindings = List.zip idents exprs
let! body = transformExpr com ctx [] body
match bindings with
// If there's only one binding compile as Let to play better with optimizations
| [ ident, value ] -> return Fable.Let(ident, value, body)
| bindings -> return Fable.LetRec(bindings, body)
// `argTypes2` is always empty
| FSharpExprPatterns.TraitCall(sourceTypes, traitName, flags, argTypes, _argTypes2, argExprs) ->
let r = makeRangeFrom fsExpr
let typ = makeType ctx.GenericArgs fsExpr.Type
let! argExprs = transformExprList com ctx argExprs
let argTypes = List.map (makeType ctx.GenericArgs) argTypes
match ctx.PrecompilingInlineFunction with
| Some _ ->
let sourceTypes = List.map (makeType ctx.GenericArgs) sourceTypes
let e =
Fable.UnresolvedTraitCall(sourceTypes, traitName, flags.IsInstance, argTypes, argExprs)
return Fable.Unresolved(e, typ, r)
| None ->
match tryFindWitness ctx argTypes flags.IsInstance traitName with
| None ->
let sourceTypes = List.map (makeType ctx.GenericArgs) sourceTypes
return transformTraitCall com ctx r typ sourceTypes traitName flags.IsInstance argTypes argExprs
| Some w ->
let callInfo = makeCallInfo None argExprs argTypes
return makeCall r typ callInfo w.Expr
| FSharpExprPatterns.CallWithWitnesses(callee, memb, ownerGenArgs, membGenArgs, witnesses, args) ->
let typ = makeType ctx.GenericArgs fsExpr.Type
let callGenArgs = ownerGenArgs @ membGenArgs |> List.map (makeType ctx.GenericArgs)
let! args = transformExprList com ctx args
// Sometimes args may include local generics (e.g. an identifier referencing a local generic function)
// so we try to match extract them by comparing the arg types with the expected types (from the member signature)
let args =
let expectedArgTypes =
let ctx = addGenArgsToContext ctx memb callGenArgs
Seq.concat memb.CurriedParameterGroups
|> Seq.map (fun x -> makeType ctx.GenericArgs x.Type)
|> Seq.toList
if List.sameLength args expectedArgTypes then
List.zip args expectedArgTypes
|> List.map (fun (argExpr, expectedArgType) ->
extractGenericArgs argExpr expectedArgType |> replaceGenericArgs argExpr
)
else
args
match callee with
| Some(CreateEvent(callee, event) as createEvent) ->
let! callee = transformExpr com ctx [] callee
let eventType = makeType ctx.GenericArgs createEvent.Type
let callee =
makeCallFrom com ctx (makeRangeFrom createEvent) eventType [] (Some callee) [] event
return makeCallFrom com ctx (makeRangeFrom fsExpr) typ callGenArgs (Some callee) args memb
| callee ->
let r = makeRangeFrom fsExpr
let! callee = transformExprOpt com ctx callee
let! ctx =
trampoline {
match witnesses with
| [] -> return ctx
| witnesses ->
let witnesses =
witnesses
|> List.choose (
function
// Index is not reliable, just append witnesses from parent call
| FSharpExprPatterns.WitnessArg _idx -> None
| NestedLambda(args, body) ->
match body with
| FSharpExprPatterns.Call(callee, memb, _, _, _args) ->
Some(memb.CompiledName, Option.isSome callee, args, body)
| FSharpExprPatterns.AnonRecordGet(_, calleeType, fieldIndex) ->
let fieldName =
calleeType.AnonRecordTypeDetails.SortedFieldNames[fieldIndex]
Some("get_" + fieldName, true, args, body)
| FSharpExprPatterns.FSharpFieldGet(_, _, field) ->
Some("get_" + field.Name, true, args, body)
| _ -> None
| _ -> None
)
// Seems witness act like a stack (that's why we reverse them)
// so a witness may need other witnesses to be resolved
return!