Skip to content

Enable erase unions with tags #3282

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Draft
alfonsogarciacaro wants to merge 5 commits into
base: main
Choose a base branch
from
Draft

Enable erase unions with tags #3282

Show file tree
Hide file tree
Changes from 1 commit
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
32e5bd6
Fix new records with Erase attribute
alfonsogarciacaro Nov 20, 2022
010c801
Add tag argument to Erase unions
alfonsogarciacaro Nov 20, 2022
7ba2271
Wrap erased unions with type cast
alfonsogarciacaro Nov 20, 2022
8e9602e
Fix #2915: Add test
alfonsogarciacaro Nov 20, 2022
de0eca8
Temp commit
alfonsogarciacaro Nov 23, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
Prev Previous commit
Next Next commit
Add tag argument to Erase unions
  • Loading branch information
@alfonsogarciacaro
alfonsogarciacaro committed Nov 23, 2022
commit 010c801cd0673b7395da8b311cf5435a347680de
1 change: 1 addition & 0 deletions src/Fable.Core/Fable.Core.Types.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -29,6 +29,7 @@ type AttachMembersAttribute() =
type EraseAttribute() =
inherit Attribute()
new (caseRules: CaseRules) = EraseAttribute()
new (tag: bool) = EraseAttribute()

/// Used for "tagged" union types, which is commonly used in TypeScript.
type TypeScriptTaggedUnionAttribute(tagName: string, caseRules: CaseRules) =
Expand Down
23 changes: 15 additions & 8 deletions src/Fable.Transforms/FSharp2Fable.Util.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -733,19 +733,14 @@ module Helpers =
type UnionPattern =
| OptionUnion of FSharpType * isStruct: bool
| ListUnion of FSharpType
| ErasedUnion of FSharpEntity * IList<FSharpType> * CaseRules
| ErasedUnion of FSharpEntity * IList<FSharpType> * CaseRules * tag: bool
| ErasedUnionCase
| TypeScriptTaggedUnion of FSharpEntity * IList<FSharpType> * tagName:string * CaseRules
| StringEnum of FSharpEntity * CaseRules
| DiscriminatedUnion of FSharpEntity * IList<FSharpType>

let getUnionPattern (typ: FSharpType) (unionCase: FSharpUnionCase) : UnionPattern =
let typ = nonAbbreviatedType typ
let getCaseRule (att: FSharpAttribute) =
match Seq.tryHead att.ConstructorArguments with
| Some(_, (:? int as rule)) -> enum<CaseRules>(rule)
| _ -> CaseRules.LowerFirst

unionCase.Attributes |> Seq.tryPick (fun att ->
match att.AttributeType.TryFullName with
| Some Atts.erase -> Some ErasedUnionCase
Expand All @@ -761,8 +756,20 @@ module Helpers =
| _ ->
tdef.Attributes |> Seq.tryPick (fun att ->
match att.AttributeType.TryFullName with
| Some Atts.erase -> Some (ErasedUnion(tdef, typ.GenericArguments, getCaseRule att))
| Some Atts.stringEnum -> Some (StringEnum(tdef, getCaseRule att))
| Some Atts.erase ->
let caseRule, tag =
match Seq.tryHead att.ConstructorArguments with
| Some(_, (:? int as rule)) -> enum<CaseRules>(rule), false
| Some(_, (:? bool as tag)) ->
if tag then CaseRules.None, true else CaseRules.LowerFirst, false
| _ -> CaseRules.LowerFirst, false
Some (ErasedUnion(tdef, typ.GenericArguments, caseRule, tag))
| Some Atts.stringEnum ->
let caseRule =
match Seq.tryHead att.ConstructorArguments with
| Some(_, (:? int as rule)) -> enum<CaseRules>(rule)
| _ -> CaseRules.LowerFirst
Some (StringEnum(tdef, caseRule))
| Some Atts.tsTaggedUnion ->
match Seq.tryItem 0 att.ConstructorArguments, Seq.tryItem 1 att.ConstructorArguments with
| Some (_, (:? string as name)), None ->
Expand Down
45 changes: 27 additions & 18 deletions src/Fable.Transforms/FSharp2Fable.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -46,14 +46,19 @@ let private transformNewUnion com ctx r fsType (unionCase: FSharpUnionCase) (arg
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
// TODO: Wrap erased unions in type cast so type info is not lost
| ErasedUnion(tdef, _genArgs, rule, tag) ->
if tag then
(transformStringEnum rule unionCase)::argExprs |> makeTuple r false
else
match argExprs with
| [] -> transformStringEnum rule unionCase
| [argExpr] -> argExpr
| _ when tdef.UnionCases.Count > 1 ->
$"Erased unions with multiple fields must have one single case: {getFsTypeFullName fsType}. " +
"To allow multiple cases pass tag argument, e.g.: [<Erase(tag=true)>]"
|> addErrorAndReturnNull com ctx.InlinePath r
| argExprs -> makeTuple r false argExprs
| TypeScriptTaggedUnion _ ->
match argExprs with
| [argExpr] -> argExpr
Expand Down Expand Up @@ -326,10 +331,14 @@ let private transformUnionCaseTest (com: IFableCompiler) (ctx: Context) r
| 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 ->
| ErasedUnion(tdef, genArgs, rule, tag) ->
match tag, unionCase.Fields.Count with
| true, _ ->
let tagName = transformStringEnum rule unionCase
let tagExpr = Fable.Get(unionExpr, Fable.TupleIndex 0, Fable.String, None)
return makeEqOp r tagExpr tagName BinaryEqual
| false, 0 -> return makeEqOp r unionExpr (transformStringEnum rule unionCase) BinaryEqual
| false, 1 ->
let fi = unionCase.Fields[0]
let typ =
if fi.FieldType.IsGenericParameter then
Expand All @@ -341,7 +350,7 @@ let private transformUnionCaseTest (com: IFableCompiler) (ctx: Context) r
else fi.FieldType
let kind = makeType ctx.GenericArgs typ |> Fable.TypeTest
return Fable.Test(unionExpr, kind, r)
| _ ->
| false, _ ->
return "Erased unions with multiple cases cannot have more than one field: " + (getFsTypeFullName fsType)
|> addErrorAndReturnNull com ctx.InlinePath r
| TypeScriptTaggedUnion (_, _, tagName, rule) ->
Expand Down Expand Up @@ -863,16 +872,16 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr =
return Fable.Get(tupleExpr, Fable.TupleIndex tupleElemIndex, typ, makeRangeFrom fsExpr)

| FSharpExprPatterns.UnionCaseGet (IgnoreAddressOf unionExpr, fsType, unionCase, field) ->
let getIndex() = unionCase.Fields |> Seq.findIndex (fun x -> x.Name = field.Name)
let r = makeRangeFrom fsExpr
let! unionExpr = transformExpr com ctx unionExpr
match getUnionPattern fsType unionCase with
| ErasedUnionCase ->
let index = unionCase.Fields |> Seq.findIndex (fun x -> x.Name = field.Name)
return Fable.Get(unionExpr, Fable.TupleIndex(index), makeType ctx.GenericArgs fsType, r)
| ErasedUnion _ ->
if unionCase.Fields.Count = 1 then return unionExpr
return Fable.Get(unionExpr, Fable.TupleIndex(getIndex()), makeType ctx.GenericArgs fsType, r)
| ErasedUnion(_tdef, _genArgs, _rule, tag) ->
if not tag && unionCase.Fields.Count = 1 then return unionExpr
else
let index = unionCase.Fields |> Seq.findIndex (fun x -> x.Name = field.Name)
let index = if tag then getIndex() + 1 else getIndex()
return Fable.Get(unionExpr, Fable.TupleIndex index, makeType ctx.GenericArgs fsType, r)
| TypeScriptTaggedUnion _ ->
if unionCase.Fields.Count = 1 then return unionExpr
Expand Down