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.

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

Jump to bottom

[Rust] Support object expressions for System.Object #3913

Merged
merged 1 commit into from
Sep 30, 2024
Merged

[Rust] Support object expressions for System.Object #3913

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
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
170 changes: 96 additions & 74 deletions src/Fable.Transforms/Rust/Fable2Rust.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2134,6 +2134,17 @@ module Util =
memberDecl
)

let decl: Fable.ClassDecl =
{
Name = entName
Entity = entRef
Constructor = None
BaseCall = baseCall
AttachedMembers = members
XmlDoc = None
Tags = []
}

let fieldIdents =
fieldsMap.Values
|> Seq.map (fun ident -> { ident with Type = FableTransforms.uncurryType ident.Type })
Expand All @@ -2147,6 +2158,14 @@ module Util =
mkField [] fieldName fieldTy false
)

let exprFields =
fieldIdents
|> List.map (fun ident ->
let expr = transformIdent com ctx None ident |> makeClone
let fieldName = ident.Name |> sanitizeMember
mkExprField [] fieldName expr false false
)

let attrs = [ mkAttr "derive" (makeDerivedFrom com ent) ]
let generics = makeGenerics com ctx genArgs
let genParams = FSharp2Fable.Util.getGenParamTypes genArgs
Expand All @@ -2157,37 +2176,24 @@ module Util =
else
[ mkStructItem attrs entName fields generics ]

let ctx = { ctx with ScopedEntityGenArgs = getEntityGenParamNames ent }

let memberNames = getInterfaceMemberNames com entRef

let memberItems =
members
|> List.map (fun decl -> decl, getDeclMember com decl)
|> List.filter (fun (d, m) -> Set.contains m.FullName memberNames)
|> List.map (makeMemberItem com ctx false)
|> makeInterfaceTraitImpls com ctx entName genParams entRef genArgs

let exprFields =
fieldIdents
|> List.map (fun ident ->
let expr = transformIdent com ctx None ident |> makeClone
let fieldName = ident.Name |> sanitizeMember
mkExprField [] fieldName expr false false
)
let memberItems = transformClassMembers com ctx genArgs decl

let objExpr =
match baseCall with
| Some fableExpr -> com.TransformExpr(ctx, fableExpr)
| None ->
let genArgsOpt = transformGenArgs com ctx genParams
let path = makeFullNamePath entName genArgsOpt
let expr = mkStructExpr path exprFields |> makeLrcPtrValue com ctx
// match baseCall with
// | Some fableExpr -> com.TransformExpr(ctx, fableExpr) //TODO:
// | None ->
let genArgsOpt = transformGenArgs com ctx genParams
let path = makeFullNamePath entName genArgsOpt
let expr = mkStructExpr path exprFields |> makeLrcPtrValue com ctx

if ent.IsInterface then
makeInterfaceCast com ctx typ expr
else
expr

let objStmt = objExpr |> mkExprStmt
let declStmts = structItems @ memberItems |> List.map mkItemStmt
declStmts @ [ objStmt ] |> mkBlock |> mkBlockExpr
let objStmts = [ objExpr |> mkExprStmt ]
declStmts @ objStmts |> mkBlock |> mkBlockExpr

let maybeAddParens fableExpr (expr: Rust.Expr) : Rust.Expr =
match fableExpr with
Expand Down Expand Up @@ -4378,7 +4384,7 @@ module Util =
else
[]

let makeDisplayTraitImpls com ctx self_ty genArgs hasToString =
let makeDisplayTraitImpls com ctx entName genArgs hasToString =
// expected output:
// impl core::fmt::Display for {self_ty} {
// fn fmt(&self, f: &mut core::fmt::Formatter) -> core::fmt::Result {
Expand Down Expand Up @@ -4409,6 +4415,10 @@ module Util =

let fnKind = mkFnKind DEFAULT_FN_HEADER fnDecl NO_GENERICS fnBody
let fnItem = mkFnAssocItem [] "fmt" fnKind

let genArgsOpt = transformGenArgs com ctx genArgs
let traitBound = mkTypeTraitGenericBound [ entName ] genArgsOpt
let self_ty = mkTraitTy [ traitBound ]
let generics = makeGenerics com ctx genArgs

let implItemFor traitName =
Expand Down Expand Up @@ -4499,7 +4509,7 @@ module Util =
else
memberItem

let makePrimaryConstructorItems com ctx (ent: Fable.Entity) (decl: Fable.ClassDecl) =
let makePrimaryConstructorItems com ctx (ent: Fable.Entity) (declOpt: Fable.MemberDecl option) =
if
ent.IsFSharpUnion
|| ent.IsFSharpRecord
Expand All @@ -4509,7 +4519,7 @@ module Util =
[]
else
let ctorItem =
match decl.Constructor with
match declOpt with
| Some ctor ->
withCurrentScope ctx ctor.UsedNames
<| fun ctx -> transformPrimaryConstructor com ctx ent ctor
Expand All @@ -4520,15 +4530,15 @@ module Util =
let makeInterfaceTraitImpls (com: IRustCompiler) ctx entName genArgs ifcEntRef ifcGenArgs memberItems =
let genArgsOpt = transformGenArgs com ctx genArgs
let traitBound = mkTypeTraitGenericBound [ entName ] genArgsOpt
let ty = mkTraitTy [ traitBound ]
let self_ty = mkTraitTy [ traitBound ]
let generics = makeGenerics com ctx genArgs

let ifcFullName = ifcEntRef |> getEntityFullName com ctx
let ifcGenArgsOpt = ifcGenArgs |> transformGenArgs com ctx

let path = makeFullNamePath ifcFullName ifcGenArgsOpt
let ofTrait = mkTraitRef path |> Some
let implItem = mkImplItem [] "" ty generics memberItems ofTrait
let implItem = mkImplItem [] "" self_ty generics memberItems ofTrait
[ implItem ]

// let objectMemberNames =
Expand All @@ -4544,34 +4554,34 @@ module Util =

let ignoredInterfaceNames = set [ Types.ienumerable; Types.ienumerator ]

let getAllInterfaces (ent: Fable.Entity) : Fable.DeclaredType list =
ent.AllInterfaces
|> Seq.filter (fun ifc ->
// throws out anything on the ignored interfaces list
not (Set.contains ifc.Entity.FullName ignoredInterfaceNames)
)
|> Seq.toList
let getDeclaringEntities (members: Fable.MemberFunctionOrValue list) =
members
|> List.choose (fun memb -> memb.DeclaringEntity)
|> List.distinctBy (fun entRef -> entRef.FullName)

let transformClassMembers (com: IRustCompiler) ctx (classDecl: Fable.ClassDecl) =
let transformClassMembers (com: IRustCompiler) ctx genArgs (classDecl: Fable.ClassDecl) =
let entRef = classDecl.Entity
let ent = com.GetEntity(entRef)

let entName =
if ent.IsInterface then
classDecl.Name
let isObjectExpr = ent.IsInterface || ent.FullName = "System.Object"

let entName, self_ty =
if isObjectExpr then
let entName = classDecl.Name
let genArgsOpt = transformGenArgs com ctx genArgs
let self_ty = makeFullNamePathTy entName genArgsOpt
entName, self_ty
else
getEntityFullName com ctx entRef
|> Fable.Naming.splitLast
let entName = getEntityFullName com ctx entRef |> Fable.Naming.splitLast
let self_ty = transformEntityType com ctx entRef genArgs
entName, self_ty

let entType = FSharp2Fable.Util.getEntityType ent
let genArgs = FSharp2Fable.Util.getEntityGenArgs ent
let self_ty = transformEntityType com ctx entRef genArgs
let genArgTys = transformGenTypes com ctx genArgs
let genParams = FSharp2Fable.Util.getGenParamTypes genArgs

let ctx = { ctx with ScopedEntityGenArgs = getEntityGenParamNames ent }

// to filter out compiler-generated exception equality
let isNotExceptionMember (_memb: Fable.MemberFunctionOrValue) = not (ent.IsFSharpExceptionDeclaration)
let isIgnoredMember (memb: Fable.MemberFunctionOrValue) = ent.IsFSharpExceptionDeclaration // to filter out compiler-generated exception equality

let isInterfaceMember (memb: Fable.MemberFunctionOrValue) =
memb.IsDispatchSlot
Expand All @@ -4590,10 +4600,16 @@ module Util =
let nonInterfaceImpls =
let memberItems =
nonInterfaceMembers
|> List.filter (snd >> isNotExceptionMember)
|> List.filter (snd >> isIgnoredMember >> not)
|> List.map (makeMemberItem com ctx true)
|> List.append (makeFSharpExceptionItems com ctx ent)
|> List.append (makePrimaryConstructorItems com ctx ent classDecl)

let memberItems =
if isObjectExpr then
memberItems
else
memberItems
|> List.append (makeFSharpExceptionItems com ctx ent)
|> List.append (makePrimaryConstructorItems com ctx ent classDecl.Constructor)

if List.isEmpty memberItems then
[]
Expand All @@ -4603,36 +4619,41 @@ module Util =
[ implItem ]

let displayTraitImpls =
if ent.IsInterface then
[]
else
let hasToString =
nonInterfaceMembers |> List.exists (fun (d, m) -> m.CompiledName = "ToString")
let hasToString =
nonInterfaceMembers |> List.exists (fun (d, m) -> m.CompiledName = "ToString")

makeDisplayTraitImpls com ctx self_ty genArgs hasToString
makeDisplayTraitImpls com ctx entName genParams hasToString

let operatorTraitImpls =
nonInterfaceMembers
|> List.choose (makeOpTraitImpls com ctx ent entType self_ty genArgTys)

let interfaceTraitImpls =
if List.isEmpty interfaceMembers then
[]
else
getAllInterfaces ent
|> List.collect (fun ifc ->
let memberNames = getInterfaceMemberNames com ifc.Entity
interfaceMembers
|> List.map snd
|> getDeclaringEntities
|> List.filter (fun ifcEntRef ->
// throws out anything on the ignored interfaces list
not (ignoredInterfaceNames |> Set.contains ifcEntRef.FullName)
)
|> List.collect (fun ifcEntRef ->
let ifcEnt = com.GetEntity(ifcEntRef)
let ifcGenArgs = FSharp2Fable.Util.getEntityGenArgs ifcEnt

let memberItems =
interfaceMembers
|> List.filter (fun (d, m) -> Set.contains m.FullName memberNames)
|> List.map (makeMemberItem com ctx false)
let memberNames = getInterfaceMemberNames com ifcEntRef

if List.isEmpty memberItems then
[]
else
makeInterfaceTraitImpls com ctx entName genArgs ifc.Entity ifc.GenericArgs memberItems
)
let memberItems =
interfaceMembers
|> List.filter (fun (d, m) -> Set.contains m.FullName memberNames)
|> List.map (makeMemberItem com ctx false)

if ent.IsInterface then
memberItems
|> makeInterfaceTraitImpls com ctx entName genParams ifcEntRef genArgs
else
memberItems
|> makeInterfaceTraitImpls com ctx entName genParams ifcEntRef ifcGenArgs
)

nonInterfaceImpls @ displayTraitImpls @ operatorTraitImpls @ interfaceTraitImpls

Expand All @@ -4651,7 +4672,8 @@ module Util =
transformClass com ctx ent decl
|> entityItemWithVis com ctx ent

let memberItems = transformClassMembers com ctx decl
let genArgs = FSharp2Fable.Util.getEntityGenArgs ent
let memberItems = transformClassMembers com ctx genArgs decl
entityItem :: memberItems

let getVis (com: IRustCompiler) ctx declaringEntity isInternal isPrivate =
Expand Down
31 changes: 22 additions & 9 deletions tests/Rust/tests/src/ClassTests.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
module Fable.Tests.ClassTests

open Util.Testing
open Common.Imports

[<Struct>]
type Point(x: float, y: float) =
Expand Down Expand Up @@ -51,10 +52,10 @@
a

type WithCrossModuleInterface(m: int) =
interface Common.Imports.IHasAdd with
interface IHasAdd with
member this.Add x y = x + y + m

type AdderWrapper<'a when 'a :> Common.Imports.IHasAdd> (adder: 'a) =
type AdderWrapper<'a when 'a :> IHasAdd> (adder: 'a) =
member this.AddThroughCaptured x y = adder.Add x y

type TestClass(name: string) =
Expand All @@ -70,14 +71,26 @@
abstract Print2: unit -> string

[<Fact>]
let ``Object expressions work`` () =
let ``Object expression from interface works`` () =
let a = { new IPrintable with member x.Print() = "Hello" }
a.Print() |> equal "Hello"
let b = { new Common.Imports.IHasAdd with member _.Add x y = x + y }
let b = { new IHasAdd with member _.Add x y = x + y }
b.Add 2 3 |> equal 5

[<Fact>]
let ``Object expressions instance calls work`` () =
let ``Object expression from obj works`` () =
let a = { new obj() with
override _.ToString() = "Hello" }
a.ToString() |> equal "Hello"
let b = { new obj() with
override _.ToString() = "Adder"
interface IHasAdd with
member _.Add x y = x + y }
// b.ToString() |> equal "Adder"
(b :> IHasAdd).Add 2 3 |> equal 5

Check warning on line 90 in tests/Rust/tests/src/ClassTests.fs

View workflow job for this annotation

GitHub Actions / build-rust (no_std) 

This upcast is unnecessary - the types are identical

Check warning on line 90 in tests/Rust/tests/src/ClassTests.fs

View workflow job for this annotation

GitHub Actions / build-rust (threaded) 

This upcast is unnecessary - the types are identical

Check warning on line 90 in tests/Rust/tests/src/ClassTests.fs

View workflow job for this annotation

GitHub Actions / build-rust (default) 

This upcast is unnecessary - the types are identical

[<Fact>]
let ``Object expression instance calls works`` () =
let a = { new IPrintable2 with
member _.Print() = "Hello"
member x.Print2() = x.Print() }
Expand Down Expand Up @@ -168,7 +181,7 @@
[<Fact>]
let ``Class interface from another module works`` () =
let a = WithCrossModuleInterface(1)
let res = (a :> Common.Imports.IHasAdd).Add 2 1
let res = (a :> IHasAdd).Add 2 1
res |> equal 4

[<Fact>]
Expand All @@ -180,11 +193,11 @@

[<Fact>]
let ``Class methods imported from another file work`` () =
let a = Common.Imports.MyClass()
let res = (a :> Common.Imports.IHasAdd).Add 2 3
let a = MyClass()
let res = (a :> IHasAdd).Add 2 3
res |> equal 5
a.Sub 2 3 |> equal -1
Common.Imports.MyClass.Mul 2 3 |> equal 6
MyClass.Mul 2 3 |> equal 6

#if FABLE_COMPILER
open Fable.Core
Expand Down
Loading