Essence of Adapton

adapton.rkt

#lang racket
(require (prefix-in r: (only-in racket delay force)))

(define *memo-tables* 
  (make-hasheq))

(struct matt (f table)
  #:property
  prop:procedure 
  (λ (m . xs) (apply memo m xs)))

(define (make-memo f)
  (let ((mt (hash-ref! *memo-tables* f make-hash)))
    (matt f mt)))

(define-syntax-rule
  (define/memo (f x ...) e ...)
  (define f
    (make-memo (λ (x ...) e ...))))
  
(define (memo m . xs)
  (force (apply delay m xs)))

(define (delay m . xs)
  (match m
    [(matt f mt)
     (hash-ref! mt xs (λ () (r:delay (apply f xs))))]))

(define (force m) (r:force m))

(define/memo (fib n)
    (displayln n)
    (match n
      [0 0]
      [1 1]
      [n (+ (fib (- n 1))
            (fib (- n 2)))]))

(fib 60)

(define/memo (make-ones)
  (cons 1 (delay make-ones)))

(define/memo (map f xs)
  (match xs
    ['() '()]
    [(cons x d)
     (cons (f x)
           (delay map f d))]))

Nice!