Skip to content
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.

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

Fixed #3658 #3838

Merged
merged 3 commits into from
Jun 13, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
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
1 change: 1 addition & 0 deletions src/Fable.Cli/CHANGELOG.md
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0

### Fixed

* [All] Ignore testers for erased union cases (#3658) (by @ncave)
* [All] Fixed Fable compiler hanging on some errors (#3842) (by @ncave)
* [JS/TS] Fixed DateTime.MinValue, DateTime.MaxValue (#3836) (by @ncave)

Expand Down
11 changes: 11 additions & 0 deletions src/Fable.Transforms/FSharp2Fable.Util.fs
Original file line number Diff line number Diff line change
Expand Up @@ -1064,6 +1064,17 @@ module Patterns =

let (|MemberFullName|) (memb: FSharpMemberOrFunctionOrValue) = memb.FullName

let (|UnionCaseTesterFor|_|) (memb: FSharpMemberOrFunctionOrValue) =
match memb.DeclaringEntity with
| Some ent when ent.IsFSharpUnion ->
// if memb.IsUnionCaseTester then // TODO: this currently fails, use when fixed
if memb.IsPropertyGetterMethod && memb.LogicalName.StartsWith("get_Is") then
Dismissed Show dismissed Hide dismissed
let unionCaseName = memb.LogicalName |> Naming.replacePrefix "get_Is" ""
ent.UnionCases |> Seq.tryFind (fun uc -> uc.Name = unionCaseName)
else
None
| _ -> None

let (|RefType|_|) =
function
| TypeDefinition tdef as t when tdef.TryFullName = Some Types.refCell -> Some t
Expand Down
30 changes: 21 additions & 9 deletions src/Fable.Transforms/FSharp2Fable.fs
Original file line number Diff line number Diff line change
Expand Up @@ -955,8 +955,8 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) appliedGenArgs fs
else
args

match callee with
| Some(CreateEvent(callee, event) as createEvent) ->
match callee, memb with
| Some(CreateEvent(callee, event) as createEvent), _ ->
let! callee = transformExpr com ctx [] callee
let eventType = makeType ctx.GenericArgs createEvent.Type

Expand All @@ -965,7 +965,10 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) appliedGenArgs fs

return makeCallFrom com ctx (makeRangeFrom fsExpr) typ callGenArgs (Some callee) args memb

| callee ->
| Some unionExpr, UnionCaseTesterFor unionCase ->
return! transformUnionCaseTest com ctx (makeRangeFrom fsExpr) unionExpr unionExpr.Type unionCase

| callee, _ ->
let r = makeRangeFrom fsExpr
let! callee = transformExprOpt com ctx callee

Expand Down Expand Up @@ -1474,20 +1477,26 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) appliedGenArgs fs
|> addErrorAndReturnNull com ctx.InlinePath (makeRangeFrom fsExpr)
}

let private isIgnoredNonAttachedMember (meth: FSharpMemberOrFunctionOrValue) =
Option.isSome meth.LiteralValue
|| meth.Attributes
let private isIgnoredNonAttachedMember (memb: FSharpMemberOrFunctionOrValue) =
Option.isSome memb.LiteralValue
|| memb.Attributes
|> Seq.exists (fun att ->
match att.AttributeType.TryFullName with
| Some(Atts.global_ | Naming.StartsWith Atts.import _ | Naming.StartsWith Atts.emit _) -> true
| _ -> false
)
|| (
match meth.DeclaringEntity with
match memb.DeclaringEntity with
| Some ent -> isGlobalOrImportedFSharpEntity ent
| None -> false
)

let private isUnionCaseTester (memb: FSharpMemberOrFunctionOrValue) =
// memb.IsUnionCaseTester // TODO: this currently fails, use when fixed
match memb with
| UnionCaseTesterFor _ -> true
| _ -> false

let private isCompilerGenerated (memb: FSharpMemberOrFunctionOrValue) (args: FSharpMemberOrFunctionOrValue list list) =
memb.IsCompilerGenerated
&& memb.IsInstanceMember
Expand Down Expand Up @@ -1905,6 +1914,9 @@ let private transformMemberDecl
[]
elif memb.IsImplicitConstructor then
transformPrimaryConstructor com ctx memb args body
// ignore union case testers as they will be inlined
elif isUnionCaseTester memb then
[]
// Ignore members generated by the F# compiler (for comparison and equality)
elif isCompilerGenerated memb args then
[]
Expand Down Expand Up @@ -2047,8 +2059,8 @@ let rec private transformDeclarations (com: FableCompiler) ctx fsDecls =
}
]
| sub -> transformDeclarations com ctx sub
| FSharpImplementationFileDeclaration.MemberOrFunctionOrValue(meth, args, body) ->
transformMemberDecl com ctx meth args body
| FSharpImplementationFileDeclaration.MemberOrFunctionOrValue(memb, args, body) ->
transformMemberDecl com ctx memb args body
| FSharpImplementationFileDeclaration.InitAction fe ->
let ctx = { ctx with UsedNamesInDeclarationScope = HashSet() }
let e = transformExpr com ctx [] fe |> run
Expand Down
54 changes: 41 additions & 13 deletions src/Fable.Transforms/Rust/Fable2Rust.fs
Original file line number Diff line number Diff line change
Expand Up @@ -2732,6 +2732,7 @@ module Util =
let guardExpr =
match guard with
| Fable.Test(expr, Fable.TypeTest typ, r) -> transformTypeTest com ctx r true typ expr
| Fable.Test(expr, Fable.UnionCaseTest tag, r) -> transformUnionCaseTest com ctx r tag expr
| _ -> transformExpr com ctx guard

let thenExpr = transformLeaveContext com ctx None thenBody
Expand Down Expand Up @@ -2846,6 +2847,38 @@ module Util =
mkLetExpr pat downcastExpr
| _ -> makeLibCall com ctx genArgsOpt "Native" "type_test" [ expr ]

let transformUnionCaseTest (com: IRustCompiler) ctx range tag (fableExpr: Fable.Expr) : Rust.Expr =
match fableExpr.Type with
| Fable.DeclaredType(entRef, genArgs) ->
let ent = com.GetEntity(entRef)
assert (ent.IsFSharpUnion)
// let genArgsOpt = transformGenArgs com ctx genArgs // TODO:
let unionCase = ent.UnionCases |> List.item tag

let fields =
match fableExpr with
| Fable.IdentExpr ident ->
unionCase.UnionCaseFields
|> List.mapi (fun i _field ->
let fieldName = $"{ident.Name}_{tag}_{i}"
Dismissed Show dismissed Hide dismissed
Dismissed Show dismissed Hide dismissed
Dismissed Show dismissed Hide dismissed
makeFullNameIdentPat fieldName
)
| _ ->
if List.isEmpty unionCase.UnionCaseFields then
[]
else
[ WILD_PAT ]

let unionCaseName = getUnionCaseName com ctx entRef unionCase
let pat = makeUnionCasePat unionCaseName fields

let expr =
fableExpr
|> prepareRefForPatternMatch com ctx fableExpr.Type (tryGetIdentName fableExpr)

mkLetExpr pat expr
| _ -> failwith "Should not happen"

let transformTest (com: IRustCompiler) ctx range kind (fableExpr: Fable.Expr) : Rust.Expr =
match kind with
| Fable.TypeTest typ -> transformTypeTest com ctx range false typ fableExpr
Expand Down Expand Up @@ -2874,18 +2907,10 @@ module Util =
let unionCase = ent.UnionCases |> List.item tag

let fields =
match fableExpr with
| Fable.IdentExpr ident ->
unionCase.UnionCaseFields
|> List.mapi (fun i _field ->
let fieldName = $"{ident.Name}_{tag}_{i}"
makeFullNameIdentPat fieldName
)
| _ ->
if List.isEmpty unionCase.UnionCaseFields then
[]
else
[ WILD_PAT ]
if List.isEmpty unionCase.UnionCaseFields then
[]
else
[ WILD_PAT ]

let unionCaseName = getUnionCaseName com ctx entRef unionCase
let pat = makeUnionCasePat unionCaseName fields
Expand All @@ -2894,7 +2919,10 @@ module Util =
fableExpr
|> prepareRefForPatternMatch com ctx fableExpr.Type (tryGetIdentName fableExpr)

mkLetExpr pat expr
let guardExpr = mkLetExpr pat expr
let thenExpr = mkBoolLitExpr true
let elseExpr = mkBoolLitExpr false
mkIfThenElseExpr guardExpr thenExpr elseExpr
| _ -> failwith "Should not happen"

let transformSwitch (com: IRustCompiler) ctx (evalExpr: Fable.Expr) cases defaultCase targets : Rust.Expr =
Expand Down
Loading