Skip to content

Commit c97d8ba

Browse files
ncavencave
committed
Minor Fable AST cleanup
1 parent d3d5499 commit c97d8ba

File tree

6 files changed

+58
-32
lines changed

6 files changed

+58
-32
lines changed

‎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: 8 additions & 1 deletion
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

@@ -1326,7 +1333,7 @@ module Util =
13261333
let t = memb.CurriedParameterGroups.[0].[0].Type |> makeType Map.empty
13271334
let arg = callInfo.Args |> List.tryHead |> Option.defaultWith makeNull
13281335
let key = makeFieldKey name true t
1329-
Fable.Set(callee, Some key, arg, r)
1336+
Fable.Set(callee, Fable.ByKeySet key, arg, r)
13301337
else
13311338
getSimple callee name |> makeCall r typ callInfo
13321339

‎src/Fable.Transforms/FSharp2Fable.fs‎

Lines changed: 9 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -690,8 +690,8 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr =
690690
let! callee = transformExpr com ctx callee
691691
let fieldName = calleeType.AnonRecordTypeDetails.SortedFieldNames.[fieldIndex]
692692
let typ = makeType ctx.GenericArgs fsExpr.Type
693-
let key = FsField(fieldName, lazy typ) :> Fable.Field |> Fable.FieldKey
694-
return Fable.Get(callee, Fable.ByKey key, typ, r)
693+
let field = FsField(fieldName, lazy typ) :> Fable.Field
694+
return Fable.Get(callee, Fable.FieldGet(field, fieldIndex), typ, r)
695695

696696
| BasicPatterns.FSharpFieldGet(callee, calleeType, field) ->
697697
let r = makeRangeFrom fsExpr
@@ -701,8 +701,9 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr =
701701
| Some callee -> callee
702702
| None -> entityRef com (FsEnt calleeType.TypeDefinition)
703703
let typ = makeType ctx.GenericArgs fsExpr.Type
704-
let key = FsField(field) :> Fable.Field |> Fable.FieldKey
705-
return Fable.Get(callee, Fable.ByKey key, typ, r)
704+
let index = calleeType.TypeDefinition.FSharpFields |> Seq.findIndex (fun x -> x.Name = field.Name)
705+
let field = FsField(field) :> Fable.Field
706+
return Fable.Get(callee, Fable.FieldGet(field, index), typ, r)
706707

707708
| BasicPatterns.TupleGet(tupleType, tupleElemIndex, tupleExpr) ->
708709
let! tupleExpr = transformExpr com ctx tupleExpr
@@ -753,8 +754,9 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr =
753754
match callee with
754755
| Some callee -> callee
755756
| None -> entityRef com (FsEnt calleeType.TypeDefinition)
756-
let field = FsField(field) :> Fable.Field |> Fable.FieldKey |> Some
757-
return Fable.Set(callee, field, value, r)
757+
let index = calleeType.TypeDefinition.FSharpFields |> Seq.findIndex (fun x -> x.Name = field.Name)
758+
let field = FsField(field) :> Fable.Field
759+
return Fable.Set(callee, Fable.FieldSet(field, index), value, r)
758760

759761
| BasicPatterns.UnionCaseTag(unionExpr, unionType) ->
760762
// TODO: This is an inconsistency. For new unions and union tests we calculate
@@ -780,7 +782,7 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr =
780782
return makeCall r Fable.Unit info valToSet
781783
| _ ->
782784
let valToSet = makeValueFrom com ctx r valToSet
783-
return Fable.Set(valToSet, None, valueExpr, r)
785+
return Fable.Set(valToSet, Fable.ValueSet, valueExpr, r)
784786

785787
| BasicPatterns.NewArray(FableType com ctx elTyp, argExprs) ->
786788
let! argExprs = transformExprList com ctx argExprs

‎src/Fable.Transforms/Fable2Babel.fs‎

Lines changed: 8 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1201,6 +1201,10 @@ module Util =
12011201
| Fable.ExprKey(TransformExpr com ctx prop) -> getExpr range expr prop
12021202
| Fable.FieldKey field -> get range expr field.Name
12031203

1204+
| Fable.FieldGet (field, index) ->
1205+
let expr = com.TransformAsExpr(ctx, fableExpr)
1206+
get range expr field.Name
1207+
12041208
| Fable.ListHead ->
12051209
// get range (com.TransformAsExpr(ctx, fableExpr)) "head"
12061210
libCall com ctx range "List" "head" [|com.TransformAsExpr(ctx, fableExpr)|]
@@ -1234,9 +1238,10 @@ module Util =
12341238
let value = com.TransformAsExpr(ctx, value) |> wrapIntExpression value.Type
12351239
let ret =
12361240
match kind with
1237-
| None -> expr
1238-
| Some(Fable.FieldKey fi) -> get None expr fi.Name
1239-
| Some(Fable.ExprKey(TransformExpr com ctx e)) -> getExpr None expr e
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
12401245
assign range ret value
12411246

12421247
let transformBindingExprBody (com: IBabelCompiler) (ctx: Context) (var: Fable.Ident) (value: Fable.Expr) =

‎src/Fable.Transforms/FableTransforms.fs‎

Lines changed: 14 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -60,7 +60,7 @@ let visit f e =
6060
| Get(e, kind, t, r) ->
6161
match kind with
6262
| ListHead | ListTail | OptionValue | TupleIndex _ | UnionTag
63-
| UnionField _ | ByKey(FieldKey _) -> Get(f e, kind, t, r)
63+
| UnionField _ | ByKey(FieldKey _) | FieldGet _ -> Get(f e, kind, t, r)
6464
| ByKey(ExprKey e2) -> Get(f e, ByKey(ExprKey(f e2)), t, r)
6565
| Sequential exprs -> Sequential(List.map f exprs)
6666
| Let(ident, value, body) -> Let(ident, f value, f body)
@@ -71,9 +71,10 @@ let visit f e =
7171
IfThenElse(f cond, f thenExpr, f elseExpr, r)
7272
| Set(e, kind, v, r) ->
7373
match kind with
74-
| Some(ExprKey e2) ->
75-
Set(f e, Some(ExprKey(f e2)), f v, r)
76-
| Some(FieldKey _) | None -> Set(f e, kind, f v, r)
74+
| ByKeySet(ExprKey e2) ->
75+
Set(f e, ByKeySet(ExprKey(f e2)), f v, r)
76+
| ByKeySet(FieldKey _) | FieldSet _ | ValueSet ->
77+
Set(f e, kind, f v, r)
7778
| WhileLoop(e1, e2, r) -> WhileLoop(f e1, f e2, r)
7879
| ForLoop(i, e1, e2, e3, up, r) -> ForLoop(i, f e1, f e2, f e3, up, r)
7980
| TryCatch(body, catch, finalizer, r) ->
@@ -132,16 +133,16 @@ let getSubExpressions = function
132133
| Get(e, kind, _, _) ->
133134
match kind with
134135
| ListHead | ListTail | OptionValue | TupleIndex _ | UnionTag
135-
| UnionField _ | ByKey(FieldKey _) -> [e]
136+
| UnionField _ | ByKey(FieldKey _) | FieldGet _ -> [e]
136137
| ByKey(ExprKey e2) -> [e; e2]
137138
| Sequential exprs -> exprs
138139
| Let(_, value, body) -> [value; body]
139140
| LetRec(bs, body) -> (List.map snd bs) @ [body]
140141
| IfThenElse(cond, thenExpr, elseExpr, _) -> [cond; thenExpr; elseExpr]
141142
| Set(e, kind, v, _) ->
142143
match kind with
143-
| Some(ExprKey e2) -> [e; e2; v]
144-
| Some(FieldKey _) | None -> [e; v]
144+
| ByKeySet(ExprKey e2) -> [e; e2; v]
145+
| ByKeySet(FieldKey _) | FieldSet _ | ValueSet -> [e; v]
145146
| WhileLoop(e1, e2, _) -> [e1; e2]
146147
| ForLoop(_, e1, e2, e3, _, _) -> [e1; e2; e3]
147148
| TryCatch(body, catch, finalizer, _) ->
@@ -521,7 +522,7 @@ module private Transforms =
521522
let body = uncurryIdentsAndReplaceInBody args body
522523
Delegate(args, body, name)
523524
// Uncurry also values received from getters
524-
| Get(callee, (ByKey(FieldKey(FieldType fieldType)) | UnionField(_,fieldType)), t, r) ->
525+
| Get(callee, (ByKey(FieldKey(FieldType fieldType)) | FieldGet(FieldType fieldType, _) | UnionField(_,fieldType)), t, r) ->
525526
match getLambdaTypeArity fieldType, callee.Type with
526527
// For anonymous records, if the lambda returns a generic the actual
527528
// arity may be higher than expected, so we need a runtime partial application
@@ -568,9 +569,12 @@ module private Transforms =
568569
let uci = com.GetEntity(ent).UnionCases.[tag]
569570
let args = uncurryConsArgs args uci.UnionCaseFields
570571
Value(NewUnion(args, tag, ent, genArgs), r)
571-
| Set(e, Some(FieldKey fi), value, r) ->
572+
| Set(e, ByKeySet(FieldKey fi), value, r) ->
572573
let value = uncurryArgs com false [fi.FieldType] [value]
573-
Set(e, Some(FieldKey fi), List.head value, r)
574+
Set(e, ByKeySet(FieldKey fi), List.head value, r)
575+
| Set(e, FieldSet(field, index), value, r) ->
576+
let value = uncurryArgs com false [field.FieldType] [value]
577+
Set(e, FieldSet(field, index), List.head value, r)
574578
| e -> e
575579

576580
let rec uncurryApplications (com: Compiler) e =

‎src/Fable.Transforms/Replacements.fs‎

Lines changed: 10 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -219,6 +219,7 @@ let (|Nameof|_|) com ctx = function
219219
| IdentExpr ident -> Some ident.DisplayName
220220
| Get(_, ByKey(ExprKey(StringConst prop)), _, _) -> Some prop
221221
| Get(_, ByKey(FieldKey fi), _, _) -> Some fi.Name
222+
| Get(_, FieldGet(field, _), _, _) -> Some field.Name
222223
| NestedLambda(args, Call(IdentExpr ident, info, _, _), None) ->
223224
if List.sameLength args info.Args && List.zip args info.Args |> List.forall (fun (a1, a2) ->
224225
match a2 with IdentExpr id2 -> a1.Name = id2.Name | _ -> false)
@@ -385,7 +386,7 @@ let makeRefFromMutableValue com ctx (value: Expr) =
385386
let getter = Delegate([], value, None)
386387
let setter =
387388
let v = makeUniqueIdent ctx Any "v"
388-
Delegate([v], Set(value, None, IdentExpr v, None), None)
389+
Delegate([v], Set(value, ValueSet, IdentExpr v, None), None)
389390
Helper.LibCall(com, "Types", "FSharpRef", t, [getter; setter], isJsConstructor=true)
390391

391392
let turnLastArgIntoRef com ctx args =
@@ -904,7 +905,7 @@ let makePojoFromLambda com arg =
904905
| Lambda(_, lambdaBody, _) ->
905906
(flattenSequential lambdaBody, Some []) ||> List.foldBack (fun statement acc ->
906907
match acc, statement with
907-
| Some acc, Set(_, Some(FieldKey fi), value, _) ->
908+
| Some acc, Set(_, ByKeySet(FieldKey fi), value, _) ->
908909
objValue (fi.Name, value)::acc |> Some
909910
| _ -> None)
910911
| _ -> None
@@ -1201,7 +1202,7 @@ let fableCoreLib (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Exp
12011202
| "op_Dynamic", [left; memb] ->
12021203
getExpr r t left memb |> Some
12031204
| "op_DynamicAssignment", [callee; prop; MaybeLambdaUncurriedAtCompileTime value] ->
1204-
Set(callee, Some(ExprKey prop), value, r) |> Some
1205+
Set(callee, ByKeySet(ExprKey prop), value, r) |> Some
12051206
| ("op_Dollar"|"createNew" as m), callee::args ->
12061207
let args = destructureTupleArgs args
12071208
if m = "createNew" then "new $0($1...)" else "$0($1...)"
@@ -1243,7 +1244,7 @@ let fableCoreLib (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Exp
12431244
| _ -> None
12441245

12451246
let getReference r t expr = get r t expr "contents"
1246-
let setReference r expr value = Set(expr, Some(ExprKey(makeStrConst "contents")), value, r)
1247+
let setReference r expr value = Set(expr, ByKeySet(ExprKey(makeStrConst "contents")), value, r)
12471248
let newReference com r t value = Helper.LibCall(com, "Types", "FSharpRef", t, [value], isJsConstructor=true, ?loc=r)
12481249

12491250
let references (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) =
@@ -1690,7 +1691,7 @@ let resizeArrays (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (this
16901691
|> asOptimizable "array"
16911692
|> Some
16921693
| "get_Item", Some ar, [idx] -> getExpr r t ar idx |> Some
1693-
| "set_Item", Some ar, [idx; value] -> Set(ar, Some(ExprKey idx), value, r) |> Some
1694+
| "set_Item", Some ar, [idx; value] -> Set(ar, ByKeySet(ExprKey idx), value, r) |> Some
16941695
| "Add", Some ar, [arg] ->
16951696
"void ($0)" |> emitJsExpr r t [Helper.InstanceCall(ar, "push", t, [arg])] |> Some
16961697
| "Remove", Some ar, [arg] ->
@@ -1785,7 +1786,7 @@ let arrays (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: E
17851786
match i.CompiledName, thisArg, args with
17861787
| "get_Length", Some arg, _ -> get r t arg "length" |> Some
17871788
| "get_Item", Some arg, [idx] -> getExpr r t arg idx |> Some
1788-
| "set_Item", Some arg, [idx; value] -> Set(arg, Some(ExprKey idx), value, r) |> Some
1789+
| "set_Item", Some arg, [idx; value] -> Set(arg, ByKeySet(ExprKey idx), value, r) |> Some
17891790
| "Copy", None, [_source; _sourceIndex; _target; _targetIndex; _count] -> copyToArray com r t i args
17901791
| "Copy", None, [source; target; count] -> copyToArray com r t i [source; makeIntConst 0; target; makeIntConst 0; count]
17911792
| "IndexOf", None, args ->
@@ -1815,7 +1816,7 @@ let arrayModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Ex
18151816
| ("Length" | "Count"), [arg] -> get r t arg "length" |> Some
18161817
| "Item", [idx; ar] -> getExpr r t ar idx |> Some
18171818
| "Get", [ar; idx] -> getExpr r t ar idx |> Some
1818-
| "Set", [ar; idx; value] -> Set(ar, Some(ExprKey idx), value, r) |> Some
1819+
| "Set", [ar; idx; value] -> Set(ar, ByKeySet(ExprKey idx), value, r) |> Some
18191820
| "ZeroCreate", [count] -> createArray count None |> Some
18201821
| "Create", [count; value] -> createArray count (Some value) |> Some
18211822
| "Empty", _ ->
@@ -2195,7 +2196,7 @@ let intrinsicFunctions (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisAr
21952196
| "MakeDecimal", _, _ -> decimals com ctx r t i thisArg args
21962197
| "GetString", _, [ar; idx]
21972198
| "GetArray", _, [ar; idx] -> getExpr r t ar idx |> Some
2198-
| "SetArray", _, [ar; idx; value] -> Set(ar, Some(ExprKey idx), value, r) |> Some
2199+
| "SetArray", _, [ar; idx; value] -> Set(ar, ByKeySet(ExprKey idx), value, r) |> Some
21992200
| ("GetArraySlice" | "GetStringSlice"), None, [ar; lower; upper] ->
22002201
let upper =
22012202
match upper with
@@ -2576,7 +2577,7 @@ let timers (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opti
25762577
match i.CompiledName, thisArg, args with
25772578
| ".ctor", _, _ -> Helper.LibCall(com, "Timer", "default", t, args, i.SignatureArgTypes, isJsConstructor=true, ?loc=r) |> Some
25782579
| Naming.StartsWith "get_" meth, Some x, _ -> get r t x meth |> Some
2579-
| Naming.StartsWith "set_" meth, Some x, [value] -> Set(x, Some(ExprKey(makeStrConst meth)), value, r) |> Some
2580+
| Naming.StartsWith "set_" meth, Some x, [value] -> Set(x, ByKeySet(ExprKey(makeStrConst meth)), value, r) |> Some
25802581
| meth, Some x, args -> Helper.InstanceCall(x, meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some
25812582
| _ -> None
25822583

0 commit comments

Comments
 (0)