Skip to content

Commit

Permalink
#1314 #1315 Decimal updates
Browse files Browse the repository at this point in the history
  • Loading branch information
@Jooseppi12
Jooseppi12 committed Jan 12, 2023
1 parent e186e3b commit 3784546
Show file tree
Hide file tree
Showing 3 changed files with 134 additions and 50 deletions.
167 changes: 118 additions & 49 deletions src/compiler/WebSharper.Core/Macros.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -209,59 +209,128 @@ let toComparison = function
| BinaryOperator.``!=`` -> Comparison.``<>``
| _ -> failwith "Operation wasn't a comparison"

let translateComparison (c: M.ICompilation) t args leftNble rightNble cmp =
let tryFindMethodFromComparison (cI: Metadata.IClassInfo option) (t: Type) (cmp: Comparison) =
let methodInfoFromStr str =
let mi =
{
MethodName = str
Parameters = [t;t]
ReturnType =
{
Generics = []
Entity = AST.Definitions.Bool
} |> Type.ConcreteType
Generics = 0
} : MethodInfo
Hashed mi
match cI, cmp with
| Some cI, Comparison.``<`` ->
match cI.Methods.TryGetValue(methodInfoFromStr "op_LessThan") with
| true, mem -> Some <| methodInfoFromStr "op_LessThan"
| false, _ ->
match cI.Methods.TryGetValue(methodInfoFromStr "op_Less") with
| true, mem -> Some <| methodInfoFromStr "op_Less"
| false, _ -> None
| Some cI, Comparison.``>`` ->
match cI.Methods.TryGetValue(methodInfoFromStr "op_GreaterThan") with
| true, mem -> Some <| methodInfoFromStr "op_GreaterThan"
| false, _ ->
match cI.Methods.TryGetValue(methodInfoFromStr "op_Greater") with
| true, mem -> Some <| methodInfoFromStr "op_Greater"
| false, _ -> None
| Some cI, Comparison.``<=`` ->
match cI.Methods.TryGetValue(methodInfoFromStr "op_LessThanOrEqual") with
| true, mem -> Some <| methodInfoFromStr "op_LessThanOrEqual"
| false, _ ->
match cI.Methods.TryGetValue(methodInfoFromStr "op_LessEquals") with
| true, mem -> Some <| methodInfoFromStr "op_LessEquals"
| false, _ -> None
| Some cI, Comparison.``>=`` ->
match cI.Methods.TryGetValue(methodInfoFromStr "op_GreaterThanOrEqual") with
| true, mem -> Some <| methodInfoFromStr "op_GreaterThanOrEqual"
| false, _ ->
match cI.Methods.TryGetValue(methodInfoFromStr "op_GreaterEquals") with
| true, mem -> Some <| methodInfoFromStr "op_GreaterEquals"
| false, _ -> None
| Some cI, Comparison.``<>`` ->
match cI.Methods.TryGetValue(methodInfoFromStr "op_Inequality") with
| true, mem -> Some <| methodInfoFromStr "op_Inequality"
| false, _ ->
match cI.Methods.TryGetValue(methodInfoFromStr "op_LessGreater") with
| true, mem -> Some <| methodInfoFromStr "op_LessGreater"
| false, _ -> None
| Some cI, Comparison.``=`` ->
match cI.Methods.TryGetValue(methodInfoFromStr "op_Equality") with
| true, mem -> Some <| methodInfoFromStr "op_Equality"
| false, _ ->
match cI.Methods.TryGetValue(methodInfoFromStr "op_Equals") with
| true, mem -> Some <| methodInfoFromStr "op_Equals"
| false, _ -> None
| _ -> None

let translateComparison (c: M.ICompilation) (t: Type) args leftNble rightNble cmp =
let classInfo =
match t with
| Type.ConcreteType tdef ->
c.GetClassInfo t.TypeDefinition
| _ -> None
let compiledMember = tryFindMethodFromComparison classInfo t cmp
match args with
| [x; y] ->
let a, b, lambda =
if leftNble || rightNble then
let a = Id.New "a"
let b = Id.New "b"
Var a, Var b, fun res -> CurriedLambda([a; b], res)
else
x, y, id
let comp x y =
Binary (x, toBinaryOperator cmp, y)
let cti =
match t with
| Type.ConcreteType ct -> c.GetCustomTypeInfo ct.Entity
| _ -> M.NotCustomType
let t =
match cti with
| M.EnumInfo u -> NonGenericType u
| _ -> t
let res =
if isIn comparableTypes t then
comp a b
else
// optimization for checking against argumentless union cases
let tryGetSingletonUnionCaseTag (x: Expression) =
match x with
| I.NewUnionCase(_, case, []) ->
match cti with
| M.FSharpUnionInfo ui when not ui.HasNull ->
ui.Cases |> Seq.mapi (fun i c ->
if c.Name = case && c.Kind = M.SingletonFSharpUnionCase then Some i else None
) |> Seq.tryPick id
match compiledMember with
| None ->
let a, b, lambda =
if leftNble || rightNble then
let a = Id.New "a"
let b = Id.New "b"
Var a, Var b, fun res -> CurriedLambda([a; b], res)
else
x, y, id
let comp x y =
Binary (x, toBinaryOperator cmp, y)
let cti =
match t with
| Type.ConcreteType ct -> c.GetCustomTypeInfo ct.Entity
| _ -> M.NotCustomType
let t =
match cti with
| M.EnumInfo u -> NonGenericType u
| _ -> t
let res =
if isIn comparableTypes t then
comp a b
else
// optimization for checking against argumentless union cases
let tryGetSingletonUnionCaseTag (x: Expression) =
match x with
| I.NewUnionCase(_, case, []) ->
match cti with
| M.FSharpUnionInfo ui when not ui.HasNull ->
ui.Cases |> Seq.mapi (fun i c ->
if c.Name = case && c.Kind = M.SingletonFSharpUnionCase then Some i else None
) |> Seq.tryPick id
| _ -> None
| _ -> None
| _ -> None

match tryGetSingletonUnionCaseTag x, tryGetSingletonUnionCaseTag y with
| Some i, Some j -> comp (cInt i) (cInt j)
| Some i, _ -> comp (cInt i) (y.[cString "$"])
| _, Some j -> comp (x.[cString "$"]) (cInt j)
| _ -> makeComparison cmp a b
match leftNble, rightNble with
| false, false -> res
| true , false -> utils c "nullableCmpL" [ x; y; lambda res ]
| false, true -> utils c "nullableCmpR" [ x; y; lambda res ]
| true , true ->
match cmp with
| Comparison.``<=``
| Comparison.``>=``
| Comparison.``=``
-> utils c "nullableCmpE" [ x; y; lambda res ]
| _ -> utils c "nullableCmp" [ x; y; lambda res ]
|> MacroOk
match tryGetSingletonUnionCaseTag x, tryGetSingletonUnionCaseTag y with
| Some i, Some j -> comp (cInt i) (cInt j)
| Some i, _ -> comp (cInt i) (y.[cString "$"])
| _, Some j -> comp (x.[cString "$"]) (cInt j)
| _ -> makeComparison cmp a b
match leftNble, rightNble with
| false, false -> res
| true , false -> utils c "nullableCmpL" [ x; y; lambda res ]
| false, true -> utils c "nullableCmpR" [ x; y; lambda res ]
| true , true ->
match cmp with
| Comparison.``<=``
| Comparison.``>=``
| Comparison.``=``
-> utils c "nullableCmpE" [ x; y; lambda res ]
| _ -> utils c "nullableCmp" [ x; y; lambda res ]
|> MacroOk
| Some method ->
Call(None, t.TypeDefinition |> NonGeneric, method |> NonGeneric, [x; y]) |> MacroOk
| _ ->
MacroError "comparisonMacro error"

Expand Down
12 changes: 11 additions & 1 deletion src/stdlib/WebSharper.MathJS.Extensions/Decimal.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,6 +20,7 @@

namespace WebSharper

open System.Runtime.InteropServices
open WebSharper
open WebSharper.JavaScript
open WebSharper.MathJS
Expand All @@ -30,7 +31,7 @@ module M = WebSharper.Core.Macros
module internal Decimal =
[<JavaScript>]
let WSDecimalMath: MathJS.MathInstance =
MathJS.Math.Create(Config(Number = "BigNumber", Precision = 29., Predictable = true))
MathJS.Math.Create(Config(Number = "BigNumber", Precision = 29., Predictable = true, Epsilon = 1e-60))

[<JavaScript>]
let CreateDecimal(lo: int32, mid: int32, hi: int32, isNegative: bool, scale: byte) : decimal =
Expand Down Expand Up @@ -169,6 +170,15 @@ type internal DecimalProxy =
[<Inline>]
static member Parse(s : string) = WSDecimalMath.Bignumber(MathNumber(s)) |> As<decimal>

[<Inline>]
static member TryParse(s: string, [<Out>] v: decimal byref) =
try
let x = WSDecimalMath.Bignumber(MathNumber(s)) |> As<decimal>
v <- x
true
with _ ->
false

[<Inline>]
static member Remainder(n1 : decimal, n2 : decimal): decimal = DecimalProxy.bin WSDecimalMath.Mod n1 n2

Expand Down
5 changes: 5 additions & 0 deletions tests/WebSharper.Tests/MathJS.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -155,6 +155,11 @@ let Tests runServerSide =
isTrue (1m = 1m)
isTrue (1m < 2m)
isTrue (2m > 1m)
isTrue (
match System.Decimal.TryParse("1.23") with
| false, _ -> false
| true, v -> v = 1.23m
)
}

let createConstituentCtorDesc (low, mid, high, (isNeg: bool), (scale: byte)) (value: decimal) =
Expand Down

0 comments on commit 3784546

Please sign in to comment.