Skip to content

Commit 5968307

Browse files
ncavencave
committed
Minor Fable AST cleanup
1 parent 42be146 commit 5968307

File tree

13 files changed

+174
-175
lines changed

13 files changed

+174
-175
lines changed

‎.vscode/launch.json‎

Lines changed: 9 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -56,7 +56,13 @@
5656
{
5757
"type": "node",
5858
"request": "launch",
59-
"name": "Run bench-compiler tests",
59+
"name": "Run bench-compiler JS test",
60+
"program": "${workspaceFolder}/src/fable-standalone/test/bench-compiler/out-test/src/test.js"
61+
},
62+
{
63+
"type": "node",
64+
"request": "launch",
65+
"name": "Run bench-compiler JS tests",
6066
"program": "${workspaceFolder}/node_modules/mocha/bin/_mocha",
6167
"args": ["out-tests", "-r", "esm"],
6268
"cwd": "${workspaceRoot}/src/fable-standalone/test/bench-compiler"
@@ -67,7 +73,7 @@
6773
"name": "Run bench-compiler (Node)",
6874
"program": "${workspaceRoot}/src/fable-standalone/test/bench-compiler/out-node/app.js",
6975
// "args": ["${workspaceRoot}/tests/Main/Fable.Tests.fsproj", "out-tests"],
70-
"args": ["${workspaceRoot}/../fable-test/fable-test.fsproj", "out-test", "--typescript"],
76+
"args": ["${workspaceRoot}/../fable-test/fable-test.fsproj", "out-test"],
7177
"cwd": "${workspaceRoot}/src/fable-standalone/test/bench-compiler"
7278
},
7379
{
@@ -76,8 +82,7 @@
7682
"name": "Run bench-compiler (.NET)",
7783
"program": "${workspaceFolder}/src/fable-standalone/test/bench-compiler/bin/Debug/netcoreapp3.1/bench-compiler.dll",
7884
// "args": ["${workspaceRoot}/tests/Main/Fable.Tests.fsproj", "out-tests"],
79-
// "args": ["${workspaceRoot}/../fable-test/fable-test.fsproj", "out-test", "--typescript"],
80-
"args": ["${workspaceRoot}/src/fable-library/Fable.Library.fsproj", "out-lib", "--typescript"],
85+
"args": ["${workspaceRoot}/../fable-test/fable-test.fsproj", "out-test"],
8186
"cwd": "${workspaceFolder}/src/fable-standalone/test/bench-compiler"
8287
},
8388
{
@@ -89,11 +94,5 @@
8994
"args": ["${workspaceRoot}/tests/Main/Fable.Tests.fsproj", "build/tests-js"],
9095
"stopOnEntry": true
9196
},
92-
{
93-
"type": "node",
94-
"request": "launch",
95-
"name": "Run standalone test",
96-
"program": "${workspaceFolder}/src/fable-standalone/test/bench-compiler/out-test/src/test.js"
97-
},
9897
]
9998
}

‎src/Fable.AST/Fable.fs‎

Lines changed: 9 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -33,6 +33,7 @@ type Field =
3333

3434
type UnionCase =
3535
abstract Name: string
36+
abstract FullName: string
3637
abstract CompiledName: string option
3738
abstract UnionCaseFields: Field list
3839

@@ -266,12 +267,18 @@ type KeyKind =
266267
type GetKind =
267268
| ByKey of KeyKind
268269
| TupleIndex of int
270+
| FieldGet of Field * index: int
269271
| UnionField of index: int * fieldType: Type
270272
| UnionTag
271273
| ListHead
272274
| ListTail
273275
| OptionValue
274276

277+
type SetKind =
278+
| ByKeySet of KeyKind
279+
| FieldSet of Field * index: int
280+
| ValueSet
281+
275282
type TestKind =
276283
| TypeTest of Type
277284
| OptionTest of isSome: bool
@@ -311,8 +318,8 @@ type Expr =
311318
// Getters, setters and bindings
312319
| Let of Ident * Expr * body: Expr
313320
| LetRec of bindings: (Ident * Expr) list * body: Expr
314-
| Get of Expr * GetKind * typ: Type * range: SourceLocation option
315-
| Set of Expr * key: KeyKind option * value: Expr * range: SourceLocation option
321+
| Get of Expr * kind: GetKind * typ: Type * range: SourceLocation option
322+
| Set of Expr * kind: SetKind * value: Expr * range: SourceLocation option
316323

317324
// Control flow
318325
| Sequential of Expr list

‎src/Fable.Transforms/FSharp2Fable.Util.fs‎

Lines changed: 10 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -48,8 +48,15 @@ type FsUnionCase(uci: FSharpUnionCase) =
4848
|> Helpers.tryFindAtt Atts.compiledName
4949
|> Option.map (fun (att: FSharpAttribute) -> att.ConstructorArguments.[0] |> snd |> string)
5050

51+
static member FullName (uci: FSharpUnionCase) =
52+
// proper full compiled name (instead of uci.FullName)
53+
uci.XmlDocSig
54+
|> Naming.replacePrefix "T:Microsoft.FSharp." "FSharp."
55+
|> Naming.replacePrefix "T:" ""
56+
5157
interface Fable.UnionCase with
5258
member _.Name = uci.Name
59+
member _.FullName = FsUnionCase.FullName uci
5360
member _.CompiledName = FsUnionCase.CompiledName uci
5461
member _.UnionCaseFields = uci.UnionCaseFields |> Seq.mapToList (fun x -> upcast FsField(x))
5562

@@ -839,7 +846,8 @@ module TypeHelpers =
839846
Fable.LambdaType(argType, returnType)
840847
elif t.IsAnonRecordType then
841848
let genArgs = makeGenArgs ctxTypeArgs t.GenericArguments
842-
Fable.AnonymousRecordType(t.AnonRecordTypeDetails.SortedFieldNames, genArgs)
849+
let fields = t.AnonRecordTypeDetails.SortedFieldNames
850+
Fable.AnonymousRecordType(fields, genArgs)
843851
elif t.HasTypeDefinition then
844852
// No support for provided types when compiling FCS+Fable to JS
845853
#if !FABLE_COMPILER
@@ -1039,7 +1047,6 @@ module Util =
10391047
| None -> None
10401048
Fable.TryCatch(body, catchClause, finalizer, r)
10411049

1042-
10431050
let matchGenericParamsFrom (memb: FSharpMemberOrFunctionOrValue) (genArgs: Fable.Type seq) =
10441051
let matchGenericParams (genArgs: Fable.Type seq) (genParams: FSharpGenericParameter seq) =
10451052
Seq.zip (genParams |> Seq.map genParamName) genArgs
@@ -1322,7 +1329,7 @@ module Util =
13221329
let t = memb.CurriedParameterGroups.[0].[0].Type |> makeType Map.empty
13231330
let arg = callInfo.Args |> List.tryHead |> Option.defaultWith makeNull
13241331
let key = makeFieldKey name true t
1325-
Fable.Set(callee, Some key, arg, r)
1332+
Fable.Set(callee, Fable.ByKeySet key, arg, r)
13261333
else
13271334
getSimple callee name |> makeCall r typ callInfo
13281335

‎src/Fable.Transforms/FSharp2Fable.fs‎

Lines changed: 28 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -671,25 +671,33 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr =
671671

672672
// Getters and Setters
673673
| BasicPatterns.AnonRecordGet(callee, calleeType, fieldIndex) ->
674+
let r = makeRangeFrom fsExpr
674675
let! callee = transformExpr com ctx callee
675-
let fieldName = calleeType.AnonRecordTypeDetails.SortedFieldNames.[fieldIndex]
676676
let typ = makeType ctx.GenericArgs fsExpr.Type
677-
let key = FsField(fieldName, lazy typ) :> Fable.Field |> Fable.FieldKey
678-
return Fable.Get(callee, Fable.ByKey key, typ, makeRangeFrom fsExpr)
677+
let fieldName = calleeType.AnonRecordTypeDetails.SortedFieldNames.[fieldIndex]
678+
let field = FsField(fieldName, lazy typ) :> Fable.Field
679+
return Fable.Get(callee, Fable.FieldGet(field, fieldIndex), typ, r)
679680

680681
| BasicPatterns.FSharpFieldGet(callee, calleeType, field) ->
682+
let r = makeRangeFrom fsExpr
681683
let! callee = transformExprOpt com ctx callee
682684
let callee =
683685
match callee with
684686
| Some callee -> callee
685687
| None -> entityRef com (FsEnt calleeType.TypeDefinition)
686-
let key = FsField field :> Fable.Field |> Fable.FieldKey
687688
let typ = makeType ctx.GenericArgs fsExpr.Type
688-
return Fable.Get(callee, Fable.ByKey key, typ, makeRangeFrom fsExpr)
689+
let index = calleeType.TypeDefinition.FSharpFields |> Seq.findIndex (fun x -> x.Name = field.Name)
690+
let field = FsField(field) :> Fable.Field
691+
return Fable.Get(callee, Fable.FieldGet(field, index), typ, r)
689692

690-
| BasicPatterns.TupleGet(_tupleType, tupleElemIndex, tupleExpr) ->
693+
| BasicPatterns.TupleGet(tupleType, tupleElemIndex, tupleExpr) ->
691694
let! tupleExpr = transformExpr com ctx tupleExpr
692-
let typ = makeType ctx.GenericArgs fsExpr.Type
695+
let typ = makeType ctx.GenericArgs fsExpr.Type // doesn't work (Fable.Any)
696+
let typ2 = makeType ctx.GenericArgs tupleType
697+
let typ =
698+
match typ2 with
699+
| Fable.Tuple genArgs -> List.item tupleElemIndex genArgs
700+
| _ -> typ // Fable.Any (shoudn't happen)
693701
return Fable.Get(tupleExpr, Fable.TupleIndex tupleElemIndex, typ, makeRangeFrom fsExpr)
694702

695703
| BasicPatterns.UnionCaseGet (unionExpr, fsType, unionCase, field) ->
@@ -717,23 +725,23 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr =
717725
else Fable.ListTail, Fable.List t
718726
return Fable.Get(unionExpr, kind, t, r)
719727
| DiscriminatedUnion _ ->
720-
let t = makeType Map.empty field.FieldType
721-
let index =
722-
unionCase.UnionCaseFields
723-
|> Seq.findIndex (fun fi -> fi.Name = field.Name)
724-
let kind = Fable.UnionField(index, t)
725-
let typ = makeType ctx.GenericArgs fsExpr.Type
728+
let typ = makeType Map.empty field.FieldType
729+
let index = unionCase.UnionCaseFields |> Seq.findIndex (fun fi -> fi.Name = field.Name)
730+
let kind = Fable.UnionField(index, typ)
731+
// let typ = makeType ctx.GenericArgs fsExpr.Type // doesn't work (Fable.Any)
726732
return Fable.Get(unionExpr, kind, typ, r)
727733

728734
| BasicPatterns.FSharpFieldSet(callee, calleeType, field, value) ->
735+
let r = makeRangeFrom fsExpr
729736
let! callee = transformExprOpt com ctx callee
730737
let! value = transformExpr com ctx value
731738
let callee =
732739
match callee with
733740
| Some callee -> callee
734741
| None -> entityRef com (FsEnt calleeType.TypeDefinition)
735-
let field = FsField field :> Fable.Field |> Fable.FieldKey |> Some
736-
return Fable.Set(callee, field, value, makeRangeFrom fsExpr)
742+
let index = calleeType.TypeDefinition.FSharpFields |> Seq.findIndex (fun x -> x.Name = field.Name)
743+
let field = FsField(field) :> Fable.Field
744+
return Fable.Set(callee, Fable.FieldSet(field, index), value, r)
737745

738746
| BasicPatterns.UnionCaseTag(unionExpr, unionType) ->
739747
// TODO: This is an inconsistency. For new unions and union tests we calculate
@@ -759,7 +767,7 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr =
759767
return makeCall r Fable.Unit info valToSet
760768
| _ ->
761769
let valToSet = makeValueFrom com ctx r valToSet
762-
return Fable.Set(valToSet, None, valueExpr, r)
770+
return Fable.Set(valToSet, Fable.ValueSet, valueExpr, r)
763771

764772
| BasicPatterns.NewArray(FableType com ctx elTyp, argExprs) ->
765773
let! argExprs = transformExprList com ctx argExprs
@@ -806,15 +814,17 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr =
806814
return Fable.Sequential exprs
807815

808816
| BasicPatterns.NewRecord(fsType, argExprs) ->
817+
let r = makeRangeFrom fsExpr
809818
let! argExprs = transformExprList com ctx argExprs
810819
let genArgs = makeGenArgs ctx.GenericArgs (getGenericArguments fsType)
811-
return Fable.NewRecord(argExprs, FsEnt.Ref fsType.TypeDefinition, genArgs) |> makeValue (makeRangeFrom fsExpr)
820+
return Fable.NewRecord(argExprs, FsEnt.Ref fsType.TypeDefinition, genArgs) |> makeValue r
812821

813822
| BasicPatterns.NewAnonRecord(fsType, argExprs) ->
823+
let r = makeRangeFrom fsExpr
814824
let! argExprs = transformExprList com ctx argExprs
815825
let fieldNames = fsType.AnonRecordTypeDetails.SortedFieldNames
816826
let genArgs = makeGenArgs ctx.GenericArgs (getGenericArguments fsType)
817-
return Fable.NewAnonymousRecord(argExprs, fieldNames, genArgs) |> makeValue (makeRangeFrom fsExpr)
827+
return Fable.NewAnonymousRecord(argExprs, fieldNames, genArgs) |> makeValue r
818828

819829
| BasicPatterns.NewUnionCase(fsType, unionCase, argExprs) ->
820830
let! argExprs = transformExprList com ctx argExprs

‎src/Fable.Transforms/Fable2Babel.fs‎

Lines changed: 35 additions & 33 deletions
Original file line numberDiff line numberDiff line change
@@ -812,7 +812,8 @@ module Util =
812812
let getUnionCaseName (uci: Fable.UnionCase) =
813813
match uci.CompiledName with Some cname -> cname | None -> uci.Name
814814

815-
let getUnionExprTag r expr =
815+
let getUnionExprTag (com: IBabelCompiler) ctx r (fableExpr: Fable.Expr) =
816+
let expr = com.TransformAsExpr(ctx, fableExpr)
816817
getExpr r expr (Expression.stringLiteral("tag"))
817818

818819
/// Wrap int expressions with `| 0` to help optimization of JS VMs
@@ -958,20 +959,21 @@ module Util =
958959
| Fable.EnumConstant(x,_) ->
959960
com.TransformAsExpr(ctx, x)
960961
| Fable.NewRecord(values, ent, genArgs) ->
962+
let ent = com.GetEntity(ent)
961963
let values = List.mapToArray (fun x -> com.TransformAsExpr(ctx, x)) values
962-
let consRef = com.GetEntity(ent) |> jsConstructor com ctx
964+
let consRef = ent |> jsConstructor com ctx
963965
let typeParamInst =
964966
if com.Options.Typescript && (ent.FullName = Types.reference)
965967
then makeGenTypeParamInst com ctx genArgs
966968
else None
967969
Expression.newExpression(consRef, values, ?typeArguments=typeParamInst, ?loc=r)
968970
| Fable.NewAnonymousRecord(values, fieldNames, _genArgs) ->
969971
let values = List.mapToArray (fun x -> com.TransformAsExpr(ctx, x)) values
970-
Array.zip fieldNames values
971-
|> makeJsObject
972+
Array.zip fieldNames values |> makeJsObject
972973
| Fable.NewUnion(values, tag, ent, genArgs) ->
973-
let consRef = com.GetEntity(ent) |> jsConstructor com ctx
974+
let ent = com.GetEntity(ent)
974975
let values = List.map (fun x -> com.TransformAsExpr(ctx, x)) values
976+
let consRef = ent |> jsConstructor com ctx
975977
let typeParamInst =
976978
if com.Options.Typescript
977979
then makeGenTypeParamInst com ctx genArgs
@@ -1185,8 +1187,8 @@ module Util =
11851187
| statements -> Statement.ifStatement(guardExpr, thenStmnt, Statement.blockStatement(statements), ?loc=r)
11861188
|> Array.singleton
11871189

1188-
let transformGet (com: IBabelCompiler) ctx range typ fableExpr (getKind: Fable.GetKind) =
1189-
match getKind with
1190+
let transformGet (com: IBabelCompiler) ctx range typ fableExpr kind =
1191+
match kind with
11901192
| Fable.ByKey key ->
11911193
let fableExpr =
11921194
match fableExpr with
@@ -1199,6 +1201,10 @@ module Util =
11991201
| Fable.ExprKey(TransformExpr com ctx prop) -> getExpr range expr prop
12001202
| Fable.FieldKey field -> get range expr field.Name
12011203

1204+
| Fable.FieldGet (field, index) ->
1205+
let expr = com.TransformAsExpr(ctx, fableExpr)
1206+
get range expr field.Name
1207+
12021208
| Fable.ListHead ->
12031209
// get range (com.TransformAsExpr(ctx, fableExpr)) "head"
12041210
libCall com ctx range "List" "head" [|com.TransformAsExpr(ctx, fableExpr)|]
@@ -1221,21 +1227,22 @@ module Util =
12211227
else expr
12221228

12231229
| Fable.UnionTag ->
1224-
com.TransformAsExpr(ctx, fableExpr) |> getUnionExprTag range
1230+
getUnionExprTag com ctx range fableExpr
12251231

1226-
| Fable.UnionField(idx, _) ->
1232+
| Fable.UnionField(index, _) ->
12271233
let expr = com.TransformAsExpr(ctx, fableExpr)
1228-
getExpr range (getExpr None expr (Expression.stringLiteral("fields"))) (ofInt idx)
1234+
getExpr range (getExpr None expr (Expression.stringLiteral("fields"))) (ofInt index)
12291235

1230-
let transformSet (com: IBabelCompiler) ctx range var (value: Fable.Expr) setKind =
1231-
let var = com.TransformAsExpr(ctx, var)
1236+
let transformSet (com: IBabelCompiler) ctx range fableExpr (value: Fable.Expr) kind =
1237+
let expr = com.TransformAsExpr(ctx, fableExpr)
12321238
let value = com.TransformAsExpr(ctx, value) |> wrapIntExpression value.Type
1233-
let var =
1234-
match setKind with
1235-
| None -> var
1236-
| Some(Fable.FieldKey fi) -> get None var fi.Name
1237-
| Some(Fable.ExprKey(TransformExpr com ctx e)) -> getExpr None var e
1238-
assign range var value
1239+
let ret =
1240+
match kind with
1241+
| Fable.ValueSet -> expr
1242+
| Fable.ByKeySet(Fable.FieldKey fi) -> get None expr fi.Name
1243+
| Fable.ByKeySet(Fable.ExprKey(TransformExpr com ctx e)) -> getExpr None expr e
1244+
| Fable.FieldSet (field, index) -> get None expr field.Name
1245+
assign range ret value
12391246

12401247
let transformBindingExprBody (com: IBabelCompiler) (ctx: Context) (var: Fable.Ident) (value: Fable.Expr) =
12411248
match value with
@@ -1276,7 +1283,7 @@ module Util =
12761283
if nonEmpty then Expression.unaryExpression(UnaryNot, expr, ?loc=range) else expr
12771284
| Fable.UnionCaseTest tag ->
12781285
let expected = ofInt tag
1279-
let actual = com.TransformAsExpr(ctx, expr) |> getUnionExprTag None
1286+
let actual = getUnionExprTag com ctx None expr
12801287
Expression.binaryExpression(BinaryEqualStrict, actual, expected, ?loc=range)
12811288

12821289
let transformSwitch (com: IBabelCompiler) ctx useBlocks returnStrategy evalExpr cases defaultCase: Statement =
@@ -1541,8 +1548,8 @@ module Util =
15411548
| Fable.Operation(kind, _, range) ->
15421549
transformOperation com ctx range kind
15431550

1544-
| Fable.Get(expr, getKind, typ, range) ->
1545-
transformGet com ctx range typ expr getKind
1551+
| Fable.Get(expr, kind, typ, range) ->
1552+
transformGet com ctx range typ expr kind
15461553

15471554
| Fable.IfThenElse(TransformExpr com ctx guardExpr,
15481555
TransformExpr com ctx thenExpr,
@@ -1555,8 +1562,8 @@ module Util =
15551562
| Fable.DecisionTreeSuccess(idx, boundValues, _) ->
15561563
transformDecisionTreeSuccessAsExpr com ctx idx boundValues
15571564

1558-
| Fable.Set(var, setKind, value, range) ->
1559-
transformSet com ctx range var value setKind
1565+
| Fable.Set(expr, kind, value, range) ->
1566+
transformSet com ctx range expr value kind
15601567

15611568
| Fable.Let(ident, value, body) ->
15621569
if ctx.HoistVars [ident] then
@@ -1632,8 +1639,8 @@ module Util =
16321639
| Fable.Operation(kind, t, range) ->
16331640
[|transformOperation com ctx range kind |> resolveExpr t returnStrategy|]
16341641

1635-
| Fable.Get(expr, getKind, t, range) ->
1636-
[|transformGet com ctx range t expr getKind |> resolveExpr t returnStrategy|]
1642+
| Fable.Get(expr, kind, t, range) ->
1643+
[|transformGet com ctx range t expr kind |> resolveExpr t returnStrategy|]
16371644

16381645
| Fable.Let(ident, value, body) ->
16391646
let binding = transformBindingAsStatements com ctx ident value
@@ -1643,13 +1650,8 @@ module Util =
16431650
let bindings = bindings |> Seq.collect (fun (i, v) -> transformBindingAsStatements com ctx i v) |> Seq.toArray
16441651
Array.append bindings (transformAsStatements com ctx returnStrategy body)
16451652

1646-
| Fable.Set(TransformExpr com ctx expr, kind, value, _range) ->
1647-
let ret =
1648-
match kind with
1649-
| None -> Assign expr
1650-
| Some(Fable.ExprKey(TransformExpr com ctx prop)) -> getExpr None expr prop |> Assign
1651-
| Some(Fable.FieldKey fi) -> get None expr fi.Name |> Assign
1652-
com.TransformAsStatements(ctx, Some ret, value)
1653+
| Fable.Set(expr, kind, value, range) ->
1654+
[|transformSet com ctx range expr value kind |> resolveExpr expr.Type returnStrategy|]
16531655

16541656
| Fable.IfThenElse(guardExpr, thenExpr, elseExpr, r) ->
16551657
let asStatement =
@@ -1812,7 +1814,7 @@ module Util =
18121814
|> Seq.toArray
18131815

18141816
let getEntityFieldsAsProps (com: IBabelCompiler) ctx (ent: Fable.Entity) =
1815-
if (ent.IsFSharpUnion) then
1817+
if ent.IsFSharpUnion then
18161818
getUnionFieldsAsIdents com ctx ent
18171819
|> Array.map (fun id ->
18181820
let prop = identAsExpr id

0 commit comments

Comments
 (0)