Lightweight Staged Numeric code

Lightweight Staged Numeric code.

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38: 
39: 
40:

// Lightweight Staged Numeric code

#r "packages/FSharp.Compiler.Service.1.3.1.0/lib/net45/FSharp.Compiler.Service.dll"
#r "packages/QuotationCompiler.0.0.7-alpha/lib/net45/QuotationCompiler.dll"

open System
open QuotationCompiler
open Microsoft.FSharp.Quotations

// <@ fun x -> (% <@ x @> ) @> ~ lambda (fun x -> x)
let lambda (f : Expr<'T> -> Expr<'R>) : Expr<'T -> 'R> =
    let var = new Var("__temp__", typeof<'T>)
    Expr.Cast<_>(Expr.Lambda(var,  f (Expr.Cast<_>(Expr.Var var))))


type ExprPlus = ExprPlus with
    static member inline (?<-) (a, ExprPlus, b) = <@ %a + %b @>
    static member inline (?<-) (a, ExprPlus, b) = a + b

let inline (+) a b =  a ? (ExprPlus) <- b

type ExprTimes = ExprTimes with
    static member inline (?<-) (a : Expr<_>, ExprTimes, b : Expr<_>) = <@ %a * %b @>
    static member inline (?<-) (a, ExprTimes, b) = a * b

let inline (*) a b =  a ? (ExprTimes) <- b

module NumericLiteralG = 
    let inline FromZero() = let zero = LanguagePrimitives.GenericZero in <@ zero @>
    let inline FromOne() = let one = LanguagePrimitives.GenericOne in <@ one @>
    let inline FromInt32 (n : int) = <@ n @>

let compile (f : Expr<'T> -> Expr<'R>) : 'T -> 'R = QuotationCompiler.ToFunc(lambda f) ()

// Example
let f : Expr<int> -> Expr<int> = 
    (fun x -> x * 2G) << (fun x -> x + 1G)

compile f 2 // 6

namespace System

namespace Microsoft

namespace Microsoft.FSharp

namespace Microsoft.FSharp.Quotations

val lambda : f:(Expr<'T> -> Expr<'R>) -> Expr<('T -> 'R)>

Full name: Script.lambda

val f : (Expr<'T> -> Expr<'R>)

Multiple items
type Expr =
  override Equals : obj:obj -> bool
  member GetFreeVars : unit -> seq<Var>
  member Substitute : substitution:(Var -> Expr option) -> Expr
  member ToString : full:bool -> string
  member CustomAttributes : Expr list
  member Type : Type
  static member AddressOf : target:Expr -> Expr
  static member AddressSet : target:Expr * value:Expr -> Expr
  static member Application : functionExpr:Expr * argument:Expr -> Expr
  static member Applications : functionExpr:Expr * arguments:Expr list list -> Expr
  ...

Full name: Microsoft.FSharp.Quotations.Expr

--------------------
type Expr<'T> =
  inherit Expr
  member Raw : Expr

Full name: Microsoft.FSharp.Quotations.Expr<_>

val var : Var

Multiple items
type Var =
  interface IComparable
  new : name:string * typ:Type * ?isMutable:bool -> Var
  member IsMutable : bool
  member Name : string
  member Type : Type
  static member Global : name:string * typ:Type -> Var

Full name: Microsoft.FSharp.Quotations.Var

--------------------
new : name:string * typ:Type * ?isMutable:bool -> Var

val typeof<'T> : Type

Full name: Microsoft.FSharp.Core.Operators.typeof

static member Expr.Cast : source:Expr -> Expr<'T>

static member Expr.Lambda : parameter:Var * body:Expr -> Expr

static member Expr.Var : variable:Var -> Expr

Multiple items
union case ExprPlus.ExprPlus: ExprPlus

--------------------
type ExprPlus =
  | ExprPlus
  static member ( ?<- ) : a:Expr<'a> * ExprPlus:ExprPlus * b:Expr<'b> -> Expr<'c> (requires member ( + ))
  static member ( ?<- ) : a:'a * ExprPlus:ExprPlus * b:'b -> 'c (requires member ( + ))

Full name: Script.ExprPlus

val a : Expr<'a> (requires member ( + ))

val b : Expr<'b> (requires member ( + ))

val a : 'a (requires member ( + ))

val b : 'b (requires member ( + ))

val a : 'a (requires member ( ?<- ))

val b : 'b (requires member ( ?<- ))

Multiple items
union case ExprTimes.ExprTimes: ExprTimes

--------------------
type ExprTimes =
  | ExprTimes
  static member ( ?<- ) : a:Expr<'a> * ExprTimes:ExprTimes * b:Expr<'b> -> Expr<'c> (requires member ( * ))
  static member ( ?<- ) : a:'a * ExprTimes:ExprTimes * b:'b -> 'c (requires member ( * ))

Full name: Script.ExprTimes

val a : Expr<'a> (requires member ( * ))

val b : Expr<'b> (requires member ( * ))

val a : 'a (requires member ( * ))

val b : 'b (requires member ( * ))

val FromZero : unit -> Expr<'a> (requires member get_Zero)

Full name: Script.NumericLiteralG.FromZero

val zero : 'a (requires member get_Zero)

module LanguagePrimitives

from Microsoft.FSharp.Core

val GenericZero<'T (requires member get_Zero)> : 'T (requires member get_Zero)

Full name: Microsoft.FSharp.Core.LanguagePrimitives.GenericZero

val FromOne : unit -> Expr<'a> (requires member get_One)

Full name: Script.NumericLiteralG.FromOne

val one : 'a (requires member get_One)

val GenericOne<'T (requires member get_One)> : 'T (requires member get_One)

Full name: Microsoft.FSharp.Core.LanguagePrimitives.GenericOne

val FromInt32 : n:int -> Expr<int>

Full name: Script.NumericLiteralG.FromInt32

val n : int

Multiple items
val int : value:'T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>

val compile : f:(Expr<'T> -> Expr<'R>) -> ('T -> 'R)

Full name: Script.compile

val f : (Expr<int> -> Expr<int>)

Full name: Script.f

val x : Expr<int>

Next Version Raw view Test code New version

More information

Link:	http://fssnip.net/7Rt
Posted:	7 years ago
Author:	Nick Palladinos
Tags:	staging