http://higherkindedtripe.wordpress.com/2011/08/10/impredicative-polymorphism-nah-macros/

gistfile1.fs

// http://higherkindedtripe.wordpress.com/2011/08/10/impredicative-polymorphism-nah-macros/

type Program = Program // dummy

type ProgramState = { 
    Exec : Program list
    Integer : int list
    Float : float list
    Code : Program list
    Boolean : bool list 
}

let dup =
    function
    | [] -> []
    | x::xs -> x::x::xs

let swap =
    function
    | a::b::rest -> b::a::rest
    | x -> x

let rot =
    function
    | a::b::c::rest -> c::a::b::rest
    | x -> x

type ListFunction =
    abstract Invoke: 'a list -> 'a list

let DUP = { new ListFunction with member this.Invoke a = dup a }
let SWAP = { new ListFunction with member this.Invoke a = swap a }
let ROT = { new ListFunction with member this.Invoke a = rot a }

// this doesn't compile:
//let make_instructions (func : 'a list -> 'a list) =
//    [
//        fun ps -> { ps with Integer = func ps.Integer };
//        fun ps -> { ps with Boolean = func ps.Boolean };
//        fun ps -> { ps with Exec = func ps.Exec };
//        fun ps -> { ps with Float = func ps.Float };
//        fun ps -> { ps with Code = func ps.Code };
//    ]

// but this does:
let make_instructions (func : ListFunction) =
    [
        fun ps -> { ps with Integer = func.Invoke ps.Integer };
        fun ps -> { ps with Boolean = func.Invoke ps.Boolean };
        fun ps -> { ps with Exec = func.Invoke ps.Exec };
        fun ps -> { ps with Float = func.Invoke ps.Float };
        fun ps -> { ps with Code = func.Invoke ps.Code };
    ]

let eval f s = List.fold (|>) s f

[<EntryPoint>]
let main argv = 
    let duplication = make_instructions DUP
    let state = 
        { Exec = []
          Integer = [1]
          Float = []
          Code = []
          Boolean = [true; true; false] }
    let newState = eval duplication state
    let expected = 
        { Exec = []
          Integer = [1; 1]
          Float = []
          Code = []
          Boolean = [true; true; true; false] }
    if newState <> expected
        then failwith "nooooooooooooo"
        else printfn "success!"
    0