public
Created

  • Download Gist
gistfile1.fs
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 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76
// 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

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.