Skip to content

Instantly share code, notes, and snippets.

@Kraks
Forked from palladin/stage-fix.fsx
Created January 23, 2018 18:39
Show Gist options
  • Save Kraks/05a4799dea5e812ad8ebba26d7b7a87d to your computer and use it in GitHub Desktop.
Save Kraks/05a4799dea5e812ad8ebba26d7b7a87d to your computer and use it in GitHub Desktop.
Staged Fixed-point combinator
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 @>)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment