2 people like it.
Like the snippet!

streams, memoization, suspension

translation of http://www.cs.cmu.edu/~rwh/introsml/techniques/memoization.htm , no particular reason, just satisfying a tangent, read the cmu site for comments & insights.

 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:

let rec sum f n = 
  if n = 0 then 0 else f n + sum f (n-1)

let limit   = 100
let memopad : int option array = Array.init 100 (fun x -> None)

let rec p' n = 
  if n = 1 then 1 else sum (fun k -> (p k) * (p (n-k)) ) (n-1) 

and p n = 
  if n < limit then
    match memopad.[n] with
    | Some r -> r
    | None   -> let r = p' n in memopad.[n] <- Some r; r
  else p' n

module Susp =
  exception Impossible
  exception Circular

  type 'a susp = unit -> 'a
  let force t  = t ()
  let delay (t : 'a susp) = 
      
    let memo : 'a susp ref = ref (fun () -> raise Impossible)
    let t' () = 
      let r = t () in memo := (fun () -> r); r
    in memo := t'
    fun () -> (!memo)()

  (* implement loopback using 'backpatching' *)
  let loopback f = 
    let r = ref (fun () -> raise Circular)
    let t = fun () -> (!r)() in r := f t; t

let t = Susp.delay (fun () -> printfn "hello")
Susp.force t (* prints hello *)
Susp.force t (* silent *)

type 'a stream_ = Cons of 'a * 'a stream 
and 'a stream   = 'a stream_ Susp.susp

let ones_loop s = Susp.delay (fun () -> Cons (1, s))
let ones = Susp.loopback ones_loop

val sum : f:(int -> int) -> n:int -> int

Full name: Script.sum

val f : (int -> int)

val n : int

val limit : int

Full name: Script.limit

val memopad : int option array

Full name: Script.memopad

Multiple items
val int : value:'T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

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

type 'T option = Option<'T>

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

type 'T array = 'T []

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

module Array

from Microsoft.FSharp.Collections

val init : count:int -> initializer:(int -> 'T) -> 'T []

Full name: Microsoft.FSharp.Collections.Array.init

val x : int

union case Option.None: Option<'T>

val p' : n:int -> int

Full name: Script.p'

val k : int

val p : n:int -> int

Full name: Script.p

union case Option.Some: Value: 'T -> Option<'T>

val r : int

exception Impossible

Full name: Script.Susp.Impossible

exception Circular

Full name: Script.Susp.Circular

type 'a susp = unit -> 'a

Full name: Script.Susp.susp<_>

type unit = Unit

Full name: Microsoft.FSharp.Core.unit

val force : t:(unit -> 'a) -> 'a

Full name: Script.Susp.force

val t : (unit -> 'a)

val delay : t:'a susp -> (unit -> 'a)

Full name: Script.Susp.delay

val t : 'a susp

val memo : 'a susp ref

Multiple items
val ref : value:'T -> 'T ref

Full name: Microsoft.FSharp.Core.Operators.ref

--------------------
type 'T ref = Ref<'T>

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

val raise : exn:System.Exception -> 'T

Full name: Microsoft.FSharp.Core.Operators.raise

val t' : (unit -> 'a)

val r : 'a

val loopback : f:((unit -> 'a) -> unit -> 'a) -> (unit -> 'a)

Full name: Script.Susp.loopback

val f : ((unit -> 'a) -> unit -> 'a)

val r : (unit -> 'a) ref

val t : (unit -> unit)

Full name: Script.t

module Susp

from Script

val delay : t:'a Susp.susp -> (unit -> 'a)

Full name: Script.Susp.delay

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

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

type 'a stream_ = | Cons of 'a * 'a stream

Full name: Script.stream_<_>

union case stream_.Cons: 'a * 'a stream -> 'a stream_

type 'a stream = 'a stream_ Susp.susp

Full name: Script.stream<_>

val ones_loop : s:int stream -> (unit -> int stream_)

Full name: Script.ones_loop

val s : int stream

val ones : (unit -> int stream_)

Full name: Script.ones

Raw view Test code New version

More information

Link:	http://fssnip.net/ge
Posted:	12 years ago
Author:	David Klein
Tags:	lazy , memo , streams