Loop Unrolling

C++ style metaprogramming in F#

 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:

type Peano = interface end
and Zero = Zero with
    static member inline (|*|) (f, Zero) = f $ Zero
    interface Peano
and Succ<'a when 'a :> Peano> = Succ of 'a  with
    static member inline (|*|) (f, Succ(x)) = f $ Succ(x) 
    interface Peano


type PeanoToInt = PeanoToInt with
    static member inline ($) (PeanoToInt, Zero) = 0
    static member inline ($) (PeanoToInt, Succ (x)) = 1 + (PeanoToInt |*| x)

type Repeat = Repeat with
    static member inline ($) (Repeat, Zero) = fun f -> ()
    static member inline ($) (Repeat, (Succ (x) as p)) = fun f ->
        (Repeat |*| x) f
        f (PeanoToInt $ p) 

let four = Succ (Succ (Succ (Succ Zero)))
let inline repeat step f = (Repeat $ step) f

// Examples

repeat four (fun index -> printfn "index: %d" index)

// zero-out
let array = [|1..8|]
for i in 0 .. 4 .. array.Length - 1 do
    repeat four (fun index -> array.[i + (index - 1)] <- 0)

Multiple items
union case Zero.Zero: Zero

--------------------
type Zero =
  | Zero
  interface Peano
  static member ( |*| ) : f:'a * Zero:Zero -> '_arg5 (requires member ( $ ))

Full name: Script.Zero

val f : 'a (requires member ( $ ))

type Peano

Full name: Script.Peano

Multiple items
union case Succ.Succ: 'a -> Succ<'a>

--------------------
type Succ<'a (requires 'a :> Peano)> =
  | Succ of 'a
  interface Peano
  static member ( |*| ) : f:'a0 * Succ<'b> -> '_arg8 (requires member ( $ ) and 'b :> Peano)

Full name: Script.Succ<_>

val f : 'a (requires member ( $ ) and 'b :> Peano)

val x : #Peano

Multiple items
union case PeanoToInt.PeanoToInt: PeanoToInt

--------------------
type PeanoToInt =
  | PeanoToInt
  static member ( $ ) : PeanoToInt:PeanoToInt * Zero:Zero -> int
  static member ( $ ) : PeanoToInt:PeanoToInt * Succ<'a> -> int (requires 'a :> Peano and member ( |*| ))

Full name: Script.PeanoToInt

val x : 'a (requires 'a :> Peano and member ( |*| ))

Multiple items
union case Repeat.Repeat: Repeat

--------------------
type Repeat =
  | Repeat
  static member ( $ ) : Repeat:Repeat * Zero:Zero -> ('a -> unit)
  static member ( $ ) : Repeat:Repeat * Succ<'a> -> ((int -> 'b) -> 'b) (requires 'a :> Peano and member ( |*| ) and member ( |*| ))

Full name: Script.Repeat

val f : 'a

val x : 'a (requires 'a :> Peano and member ( |*| ) and member ( |*| ))

val p : Succ<'a> (requires 'a :> Peano and member ( |*| ) and member ( |*| ))

val f : (int -> 'b)

val four : Succ<Succ<Succ<Succ<Zero>>>>

Full name: Script.four

val repeat : step:'a -> f:'b -> 'c (requires member ( $ ))

Full name: Script.repeat

val step : 'a (requires member ( $ ))

val f : 'b

val index : int

val printfn : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn

Multiple items
val array : int []

Full name: Script.array

--------------------
type 'T array = 'T []

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

val i : int

property System.Array.Length: int

Raw view Test code New version

More information

Link:	http://fssnip.net/hW
Posted:	11 years ago
Author:	Nick Palladinos
Tags:	metaprogramming