Skip to content

Commit

Permalink
#1317 F# operator overload fixes
Browse files Browse the repository at this point in the history
  • Loading branch information
@Jand42
Jand42 committed Jan 18, 2023
1 parent a93d116 commit 58f9fcd
Show file tree
Hide file tree
Showing 3 changed files with 107 additions and 32 deletions.
94 changes: 72 additions & 22 deletions src/compiler/WebSharper.Core/Macros.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -54,8 +54,31 @@ let isIn (s: string Set) (t: Type) =
| _ ->
false

let traitCallOp (c: MacroCall) args =
let traitCallOp (c: MacroCall) (args: Expression list) =
match c.Method.Generics with
| [ t ] ->
if t.IsParameter then
MacroNeedsResolvedTypeArg t
else
let ps =
match c.Method.Entity.Value.MethodName with
| "op_LeftShift"
| "op_RightShift" -> [ t; NonGenericType Definitions.Int ]
| _ -> List.replicate args.Length t
TraitCall(
None,
[ t ],
NonGeneric (
Method {
MethodName = c.Method.Entity.Value.MethodName
Parameters = ps
ReturnType = t
Generics = 0
}
),
args
)
|> MacroOk
| [t; u; v] ->
if t.IsParameter then
MacroNeedsResolvedTypeArg t
Expand All @@ -77,7 +100,7 @@ let traitCallOp (c: MacroCall) args =
)
|> MacroOk
| _ ->
failwith "F# Operator value expecting 3 type arguments"
failwith "F# Operator value expecting 1 or 3 type arguments"

let utilsModule =
TypeDefinition {
Expand Down Expand Up @@ -109,38 +132,65 @@ let translateOperation (c: MacroCall) (t: Type) args leftNble rightNble op =
else traitCallOp c [a; b]
else
if isIn scalarTypes t then
Binary(a, op, y) |> MacroOk
Binary(a, op, b) |> MacroOk
else traitCallOp c [a; b]
match leftNble, rightNble, resm with
| true , false, MacroOk res -> utils c.Compilation "nullableOpL" [ x; y; lambda res ] |> MacroOk
| false, true , MacroOk res -> utils c.Compilation "nullableOpR" [ x; y; lambda res ] |> MacroOk
| true , true , MacroOk res -> utils c.Compilation "nullableOp" [ x; y; lambda res ] |> MacroOk
| _ , _ , res -> res
| _ -> MacroError "arithmetic macro error"
| _ -> MacroError "Arith macro: expecting 2 args"

[<Sealed>]
type Arith() =
inherit Macro()
override this.TranslateCall(c) =
let opName = c.Method.Entity.Value.MethodName
let leftNble = opName.StartsWith "op_Qmark"
let rightNble = opName.EndsWith "Qmark"
let simpleOpName = if leftNble || rightNble then opName.Replace("Qmark", "") else opName
let op =
match simpleOpName with
| BinaryOpName op -> op
| "op_Plus" -> BinaryOperator.``+``
| "op_Minus" -> BinaryOperator.``-``
| "op_Divide" -> BinaryOperator.``/``
| "op_Percent" -> BinaryOperator.``%``
| n -> failwithf "unrecognized operator for Arith macro: %s" n
match c.Method.Generics with
| t1 :: t2 :: _ ->
if t1 = t2 then
translateOperation c t1 c.Arguments leftNble rightNble op
else
traitCallOp c c.Arguments
| _ -> MacroError "arithmetic macro error"
match c.Arguments with
| [ a ] ->
let op =
match opName with
| UnaryOpName op -> op
| n -> failwithf "Arith macro: unrecognized operator %s" n
match c.Method.Generics with
| t :: _ ->
if isIn scalarTypes t then
Unary(op, a) |> MacroOk
else traitCallOp c c.Arguments
| _ -> MacroError "Arith macro: expecting a type parameter"
| [ a; b ] ->
let leftNble = opName.StartsWith "op_Qmark"
let rightNble = opName.EndsWith "Qmark"
let simpleOpName = if leftNble || rightNble then opName.Replace("Qmark", "") else opName
let op =
match simpleOpName with
| BinaryOpName op -> op
| "op_Plus" -> BinaryOperator.``+``
| "op_Minus" -> BinaryOperator.``-``
| "op_Divide" -> BinaryOperator.``/``
| "op_Percent" -> BinaryOperator.``%``
| n -> failwithf "Arith macro: unrecognized operator %s" n
match c.Method.Generics with
| t1 :: t2 :: _ ->
if t1 = t2 then
translateOperation c t1 c.Arguments leftNble rightNble op
else
traitCallOp c c.Arguments
| t :: _ ->
let isEnum =
match t with
| ConcreteType { Entity = td; Generics = [] } ->
match c.Compilation.GetCustomTypeInfo td with
| M.EnumInfo _ -> true
| _ -> false
| _ -> false
// enums have underlying types supporting bitwise operations
if isEnum || isIn scalarTypes t then
Binary(a, op, b) |> MacroOk
else
traitCallOp c c.Arguments
| _ -> MacroError "Arith macro: expecting a type parameters"
| _ -> MacroError "Arith macro: expecting one or two arguments"

type Comparison =
| ``<`` = 0
Expand Down
18 changes: 9 additions & 9 deletions src/stdlib/WebSharper.Main.Proxies/Operators.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -52,7 +52,7 @@ let ( ! ) (r: ref<'T>) = X<'T>
[<Macro(typeof<M.Arith>)>]
let ( % ) (a: 'T1) (b: 'T2) = X<'T3>

[<Inline "$a & $b">]
[<Macro(typeof<M.Arith>)>]
let ( &&& ) (a: 'T1) (b: 'T1) = X<'T1>

[<Macro(typeof<M.Arith>)>]
Expand Down Expand Up @@ -82,7 +82,7 @@ let ( << ) (f: 'T1 -> 'T2) (g: 'T3 -> 'T1) : 'T3 -> 'T2 =
()
fun x -> f (g x)

[<Inline "$a << $b">]
[<Macro(typeof<M.Arith>)>]
let inline ( <<< ) (a: 'T) (b: int) = X<'T>

[<Inline>]
Expand Down Expand Up @@ -118,16 +118,16 @@ let ( >> ) (f: 'T1 -> 'T2) (g: 'T2 -> 'T3): 'T1->'T3 =
()
fun x -> g (f x)

[<Inline "$a >> $b">]
let inline ( >>> ) (a: 'T) (b: int) : 'T = a >>> b
[<Macro(typeof<M.Arith>)>]
let inline ( >>> ) (a: 'T) (b: int) : 'T = X<'T>

[<Inline>]
let ( @ ) a b = List.append a b

[<Inline "$a + $b">]
let ( ^ ) (a: string) (b: string) : string = a + b

[<Inline "$a ^ $b">]
[<Macro(typeof<M.Arith>)>]
let ( ^^^ ) (a: 'T) (b: 'T) = X<'T>

[<Inline>]
Expand All @@ -136,20 +136,20 @@ let ( |> ) (x: 'T1) (f: 'T1 -> 'T2) : 'T2 = f x
[<Inline>]
let ( ||> ) (x: 'T1, y: 'T2) (f: 'T1 -> 'T2 -> 'TR) : 'TR = f x y

[<Inline "$a | $b">]
[<Macro(typeof<M.Arith>)>]
let ( ||| ) (a: 'T) (b: 'T) = X<'T>

[<Inline>]
let ( |||> ) (x: 'T1, y: 'T2, z: 'T3)
(f: 'T1 -> 'T2 -> 'T3 -> 'TR) : 'TR = f x y z

[<Inline "+ $x">]
[<Macro(typeof<M.Arith>)>]
let ( ~+ ) (x: 'T) = X<'T>

[<Inline "- $x">]
[<Macro(typeof<M.Arith>)>]
let ( ~- ) (x: 'T) = X<'T>

[<Inline "~ $x">]
[<Macro(typeof<M.Arith>)>]
let ( ~~~ ) (x: 'T) = X<'T>

[<Macro(typeof<M.Abs>)>]
Expand Down
27 changes: 26 additions & 1 deletion tests/WebSharper.Tests/Operators.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -60,6 +60,15 @@ type IntWithAdd(x) =
static member Add (x: IntWithAdd, y) = x.Value + y
static member Add (x, y: IntWithAdd) = x + y.Value

static member (~-) (x: IntWithAdd) =
IntWithAdd(-x.Value * 2)

static member (|||) (x: IntWithAdd, y: IntWithAdd) =
IntWithAdd((x.Value ||| y.Value) + 1)

static member (<<<) (x: IntWithAdd, y: int) =
IntWithAdd((x.Value <<< y) + 1)

[<JavaScript; Inline>]
let inline ( ++ ) (a: ^x) (b: ^y) : ^a = ((^x or ^y): (static member Add: ^x * ^y -> ^a) (a, b))

Expand Down Expand Up @@ -250,7 +259,23 @@ let Tests =
Test "* op proxy" {
let u1 = CustomNumber(5)
let u2 = CustomNumber(6)
isTrue (u1*u2 = 55)
equal (u1*u2) 55
}

Test "custom unary op" {
let u1 = IntWithAdd(5)
equal (-u1).Value -10
}

Test "custom bitwise op" {
let u1 = IntWithAdd(5)
let u2 = IntWithAdd(6)
equal (u1 ||| u2).Value ((5 ||| 6) + 1)
}

Test "custom shift op" {
let u1 = IntWithAdd(5)
equal (u1 <<< 1).Value ((5 <<< 1) + 1)
}

Test "lock" {
Expand Down

0 comments on commit 58f9fcd

Please sign in to comment.