Skip to content

Commit

Permalink
Simplified op_Range and op_RangeStep implementations
Browse files Browse the repository at this point in the history
  • Loading branch information
Paul Westcott committed Nov 14, 2014
1 parent 695ae47 commit 33b0f13
Show file tree
Hide file tree
Showing 2 changed files with 69 additions and 75 deletions.
119 changes: 49 additions & 70 deletions src/FSharp.Quotations.Evaluator/QuotationsEvaluator.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -980,71 +980,58 @@ module QuotationEvaluationTypes =
let inline IsType<'a,'b> = typeof<'a> = typeof<'b>

[<Sealed>]
type ``Custom Operators``<'a> private () =
static let one =
if IsType<'a, sbyte> then failwith "Not supported"
elif IsType<'a, byte> then failwith "Not supported"
elif IsType<'a, int16> then box 1s
elif IsType<'a, uint16> then box 1us
elif IsType<'a, int32> then box 1
elif IsType<'a, uint32> then box 1ul
elif IsType<'a, int64> then box 1L
elif IsType<'a, uint64> then box 1UL
elif IsType<'a, float32> then box 1.f
elif IsType<'a, float> then box 1.
elif IsType<'a, bigint> then box 1I
elif IsType<'a, decimal> then box 1M
else failwith <| sprintf "Don't support type %A" typeof<'a>

static let optionType = typeof<option<'a>>
static let optionConstructor = optionType.GetConstructor [| typeof<'a> |]

static let subtract =
let n = Expression.Parameter (typeof<'a>, "n")
let amount = Expression.Parameter (typeof<'a>, "amount")
let subtractOne = Expression.Lambda<Func<'a,'a,'a>>( Expression.Subtract(n, amount), n, amount)
subtractOne.Compile()

static let boundedIncrement =
let incr = Expression.Parameter (typeof<'a>, "incr")
let upper = Expression.Parameter (typeof<'a>, "upper")
let n = Expression.Parameter (typeof<'a>, "n")

let next = Expression.Variable (typeof<'a>)
let innerIncrement =
Expression.Lambda(
Expression.Block(
[next],
[ Expression.Assign (next, Expression.Add(n, incr)) :> Expression
Expression.Condition (
Expression.LessThanOrEqual (next, upper),
Expression.New (optionConstructor, next),
Expression.Property (null, optionType, "None")) :> Expression ]),
n)

let outerBounding =
Expression.Lambda<Func<'a, 'a, Func<'a, option<'a>>>> (innerIncrement, incr, upper)

outerBounding.Compile ()

static member (..) lower upper =
let one = one :?> 'a
let preStartState = subtract.Invoke (lower, one)
let moveNext = boundedIncrement.Invoke (one, upper)
``Custom Enumerables``.CurrentIsState preStartState moveNext

static member (.. ..) lower (incr:'a) upper =
let preStartState = subtract.Invoke (lower, incr)
let moveNext = boundedIncrement.Invoke (incr, upper)
``Custom Enumerables``.CurrentIsState preStartState moveNext
type OpRange() =
static let methods =
typeof<OpRange>.GetMethods (BindingFlags.Static ||| BindingFlags.NonPublic)
|> Array.filter (fun ``method`` -> ``method``.Name = "op_Range")
|> Array.map (fun ``method`` -> ``method``.ReturnType.GetGenericArguments().[0], ``method``)
|> dict

static member TypeProvided ``type`` = methods.ContainsKey ``type``
static member GetMethod ``type`` = methods.[``type``]

static member private (..) (lower, upper) : seq<byte> = { lower .. upper}
static member private (..) (lower, upper) : seq<sbyte> = { lower .. upper}
static member private (..) (lower, upper) : seq<int16> = { lower .. upper}
static member private (..) (lower, upper) : seq<uint16> = { lower .. upper}
static member private (..) (lower, upper) : seq<int32> = { lower .. upper}
static member private (..) (lower, upper) : seq<uint32> = { lower .. upper}
static member private (..) (lower, upper) : seq<int64> = { lower .. upper}
static member private (..) (lower, upper) : seq<uint64> = { lower .. upper}
static member private (..) (lower, upper) : seq<float32> = { lower .. upper}
static member private (..) (lower, upper) : seq<float> = { lower .. upper}
static member private (..) (lower, upper) : seq<bigint> = { lower .. upper}
static member private (..) (lower, upper) : seq<decimal> = { lower .. upper}

[<Sealed>]
type OpRangeStep() =
static let methods =
typeof<OpRangeStep>.GetMethods (BindingFlags.Static ||| BindingFlags.NonPublic)
|> Array.filter (fun ``method`` -> ``method``.Name = "op_RangeStep")
|> Array.map (fun ``method`` -> ``method``.ReturnType.GetGenericArguments().[0], ``method``)
|> dict

static member TypeProvided ``type`` = methods.ContainsKey ``type``
static member GetMethod ``type`` = methods.[``type``]

static member private (.. ..) (lower, incr, upper) : seq<byte> = { lower .. incr .. upper}
static member private (.. ..) (lower, incr, upper) : seq<sbyte> = { lower .. incr .. upper}
static member private (.. ..) (lower, incr, upper) : seq<int16> = { lower .. incr .. upper}
static member private (.. ..) (lower, incr, upper) : seq<uint16> = { lower .. incr .. upper}
static member private (.. ..) (lower, incr, upper) : seq<int32> = { lower .. incr .. upper}
static member private (.. ..) (lower, incr, upper) : seq<uint32> = { lower .. incr .. upper}
static member private (.. ..) (lower, incr, upper) : seq<int64> = { lower .. incr .. upper}
static member private (.. ..) (lower, incr, upper) : seq<uint64> = { lower .. incr .. upper}
static member private (.. ..) (lower, incr, upper) : seq<float32> = { lower .. incr .. upper}
static member private (.. ..) (lower, incr, upper) : seq<float> = { lower .. incr .. upper}
static member private (.. ..) (lower, incr, upper) : seq<bigint> = { lower .. incr .. upper}
static member private (.. ..) (lower, incr, upper) : seq<decimal> = { lower .. incr .. upper}

let ``-> id`` = getGenericMethodInfo <@ id @>
let ``-> |>`` = getGenericMethodInfo <@ (|>) @>
let ``-> <|`` = getGenericMethodInfo <@ (<|) @>
let ``-> ..`` = getGenericMethodInfo <@ (..) @>
let ``-> .. ..`` = getGenericMethodInfo <@ (.. ..) @>
let ``-> Custom ..`` = getGenericMethodInfo <@ ``Custom Operators``.op_Range @>
let ``-> Custom .. ..`` = getGenericMethodInfo <@ ``Custom Operators``.op_RangeStep @>

let (|TraverseExpr|_|) f = function
| ExprShape.ShapeCombination (o, exprlist) -> Some (ExprShape.RebuildShapeCombination (o, List.map f exprlist))
Expand All @@ -1061,19 +1048,11 @@ module QuotationEvaluationTypes =
match optimize binding with
| (Patterns.Value _) as value -> optimize <| constantReplacement var value body
| optimizedBinding -> Expr.Let (var, optimizedBinding, optimize body)
| Patterns.Application (Lambda(var, body), input) -> optimize <| Expr.Let (var, input, body)
| Λ ``-> ..`` (None, [|``type``|], args) when ``type`` <> typeof<byte> && ``type`` <> typeof<sbyte> ->
let customOperatorsType = typedefof<``Custom Operators``<_>>
let specificType = customOperatorsType.MakeGenericType ``type``
let ``method`` = specificType.GetMethod (``-> Custom ..``.Name, BindingFlags.NonPublic ||| BindingFlags.Static)
optimize <| Expr.Call (``method``, args)
| Λ ``-> .. ..`` (None, [|ty1;ty2|], args) when ty1 = ty2 && (ty1 <> typeof<byte> && ty1 <> typeof<sbyte>) ->
let customOperatorsType = typedefof<``Custom Operators``<_>>
let specificType = customOperatorsType.MakeGenericType ty1
let ``method`` = specificType.GetMethod (``-> Custom .. ..``.Name, BindingFlags.NonPublic ||| BindingFlags.Static)
optimize <| Expr.Call (``method``, args)
| Λ ``-> ..`` (None, [|``type``|], args) when OpRange.TypeProvided ``type`` -> optimize <| Expr.Call (OpRange.GetMethod ``type``, args)
| Λ ``-> .. ..`` (None, [|ty1;ty2|], args) when ty1 = ty2 && OpRangeStep.TypeProvided ty1 -> optimize <| Expr.Call (OpRangeStep.GetMethod ty1, args)
| Λ ``-> |>`` (None, _, [x1;x2]) -> optimize <| Expr.Application (x2, x1)
| Λ ``-> <|`` (None, _, [x1;x2]) -> optimize <| Expr.Application (x1, x2)
| Patterns.Application (Lambda(var, body), input) -> optimize <| Expr.Let (var, input, body)
| Λ ``-> +`` (None, [|t1;_;_|], [x1;x2]) when t1 = typeof<string> ->
let rec getStrings strings = function
| Λ ``-> +`` (None, [|t1;_;_|], [x1;x2]) when t1 = typeof<string> -> getStrings (x2::strings) (x1)
Expand Down
25 changes: 20 additions & 5 deletions tests/FSharp.Quotations.Evaluator.Tests/Performance.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -109,7 +109,7 @@ let timeFunction _ =
Assert.Ignore "Ignoring timing tests. Set INCLUDE_TIMING_TESTS"
#endif

[<ReflectedDefinition; TestIterations 1000; TimeAllowance 4.2>]
[<ReflectedDefinition; TestIterations 1000; TimeAllowance 1.25>]
let ``[answerDoors](http://rosettacode.org/wiki/100_doors#F.23)`` () =
let ToggleNth n (lst:bool array) = // Toggle every n'th door
[(n-1) .. n .. 99] // For each appropriate door
Expand All @@ -127,7 +127,7 @@ let ``Time [answerDoors](http://rosettacode.org/wiki/100_doors#F.23)`` () =
timeFunction <@ ``[answerDoors](http://rosettacode.org/wiki/100_doors#F.23)`` @>


[<ReflectedDefinition; TimeAllowance 1.6>]
[<ReflectedDefinition; TimeAllowance 1.25>]
let ``[answer2](http://rosettacode.org/wiki/100_doors#F.23)`` () =
let PerfectSquare n =
let sqrt = int(Math.Sqrt(float n))
Expand All @@ -143,7 +143,7 @@ let ``Time [answer2](http://rosettacode.org/wiki/100_doors#F.23)`` () =
timeFunction <@ ``[answer2](http://rosettacode.org/wiki/100_doors#F.23)`` @>


[<ReflectedDefinition; TimeAllowance 1.7>]
[<ReflectedDefinition; TimeAllowance 1.5>]
let ``[Euler_method](http://rosettacode.org/wiki/Euler_method#F.23)`` () =
let euler f (h : float) t0 y0 =
(t0, y0)
Expand Down Expand Up @@ -434,7 +434,7 @@ let ``Time id function`` () =
timeFunction <@ ``id function`` @>


[<ReflectedDefinition; TimeAllowance 1.1>]
[<ReflectedDefinition; TimeAllowance 1.2>]
let ``operator |>`` () =
let rand = Random 3141592
let mutable total = 0
Expand All @@ -451,7 +451,7 @@ let ``Time operator |>`` () =
timeFunction <@ ``operator |>`` @>


[<ReflectedDefinition; TimeAllowance 1.1>]
[<ReflectedDefinition; TimeAllowance 1.2>]
let ``operator <|`` () =
let rand = Random 3141592
let mutable total = 0
Expand All @@ -467,6 +467,21 @@ let ``Test operator <|`` () =
let ``Time operator <|`` () =
timeFunction <@ ``operator <|`` @>

[<ReflectedDefinition; TestIterations 1000; TimeAllowance 1.1>]
let ``operator .. ..`` () =
let mutable n = 0.0
for i in { 1 .. 3 .. 100000 } do
n <- float i
n

[<Test>]
let ``Test operator .. ..`` () =
testFunction <@ ``operator .. ..`` @>

[<Test>]
let ``Time operator .. ..`` () =
timeFunction <@ ``operator .. ..`` @>

(*
[<ReflectedDefinition>]
let ``[]()`` () =
Expand Down

0 comments on commit 33b0f13

Please sign in to comment.