Staged Fixed-point combinator

Staged Fixed-point combinator.

 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:

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))))


// fixed-point combinator
let rec fix : (('Τ -> 'R) -> ('Τ -> 'R)) -> 'Τ -> 'R = fun f x ->
    f (fix f) x

let power x f = 
    fun n -> 
        match n with 
        | 0 -> <@ 1 @> 
        | n -> <@ %x * (% f (n - 1) ) @> 

let power2 = fix (power <@ 2 @>)
power2 10 // loop unroll 10 times

// Staged fixed-point combinator
let fix' : (Expr<'T -> 'R> -> Expr<'T -> 'R>) -> Expr<'T -> 'R> = fun f ->
    <@ fun x -> let rec loop x = (% lambda (fun f' -> f f') ) loop x in loop x @>

let power' x f =
        <@ fun n ->
            match n with 
            | 0 -> 1  
            | n -> %x * (%f) (n - 1) @>

let power2' = fix' (power' <@ 2 @>)

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:System.Type * ?isMutable:bool -> Var

val typeof<'T> : System.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

val fix : f:(('Τ -> 'R) -> 'Τ -> 'R) -> x:'Τ -> 'R

Full name: Script.fix

val f : (('Τ -> 'R) -> 'Τ -> 'R)

val x : 'Τ

val power : x:Expr<int> -> f:(int -> Expr<int>) -> n:int -> Expr<int>

Full name: Script.power

val x : Expr<int>

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

val n : int

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

Full name: Script.power2

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

Full name: Script.fix'

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

val x : 'T

val loop : ('T -> 'R)

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

val power' : x:Expr<int> -> f:Expr<(int -> int)> -> Expr<(int -> int)>

Full name: Script.power'

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

val power2' : Expr<(int -> int)>

Full name: Script.power2'

Raw view Test code New version

More information

Link:	http://fssnip.net/sE
Posted:	9 years ago
Author:	Nick Palladinos
Tags:	fixed-point