サンク メモ2

type Thunk<'a> = T of (unit -> 'a) 

let eval (T x) = x ()
let apply f (x : Thunk<'a>) = T (fun _ -> (eval f) x)

let one = T (fun _ -> 1)
let two = T (fun _ -> 2)
let add = T (fun _ x  y -> eval x + eval y)

let three = apply (apply add one) two
printfn "%A" (eval three)

type TList<'a> =
    | Nil
    | Cons of Thunk<'a> * Thunk<TList<'a>>
let nil = T (fun _ -> Nil)
let cons = T (fun _ x xs -> Cons (x, xs))

let zero = T (fun _ -> 0)
let list1 = apply (apply cons zero) nil
printfn "%A" (eval list1)

let rec inf1 = T (fun _ -> Cons (zero, inf1))
printfn "%A" (eval inf1)

let rec map = T (fun _ f list ->
    match eval list with
    | Cons (x, xs) -> Cons ((apply f x), (apply (apply map f) xs))
    | Nil          -> Nil)

let rec take = T (fun _ n list ->
    match eval list with
    | Cons (x, xs) -> let n' = eval n
                      if n' <= 0
                          then Nil
                          else Cons (x, apply (apply take (T (fun _ -> n' - 1))) xs)
    | Nil          -> Nil)

let addOne = apply add one
let rec inf2 = T (fun _ -> Cons (zero, apply (apply map addOne) inf2))
let twenty = T (fun _ -> 20)
let list2 = apply (apply take twenty) inf2

let rec evalList list =
    match eval list with
    | Cons (x, xs) -> (eval x) :: (evalList xs)
    | Nil          -> []
printfn "%A" (evalList list2)