;; lazy evaluation from TSPL
(define lazy
  (lambda (t)
    (let ((val #f) (flag #f))
      (lambda ()
        (if (not flag)
            (begin (set! val (t))
                   (set! flag #t)))
        val))))

(define p
  (lazy (lambda ()
          (display "Ouch!")
          (newline)
          "got me")))

;; lazy object collection loading example

;; real database layer
(define table
  '((1 . aap)
    (2 . noot)
    (3 . mies)
    (4 . zus)
    (5 . wim)))

(define (table-key-set)
  (map car table))

(define (table-retrieve key)
  (assoc key table))

;; data access layer with active lazy loading
(define (make-access-object)
  (let ((cache ()))
    (define (load key)
      (let1 item (assoc key cache)
        (format #t "(lazy-ref ~s) -> ~s\n" key item)
        (or item
            (let1 new-item (table-retrieve key)
              (format #t "(lazy-load ~s) -> ~s\n" key new-item)
              (set! cache (cons new-item cache))
              new-item))))
    (define (dump)
      (format #t "(cache ~s)\n" cache))
    (lambda args
      (apply
       (case (car args)
         ((load) load)
         ((dump) dump))
       (cdr args)))))

(let1 dao (make-access-object)
  (dao 'dump)
  (dao 'load 2)
  (dao 'dump)
  (dao 'load 1)
  (dao 'dump)
  (dao 'load 2)
  (dao 'dump))

;; now make a data access layer that returns an object with all lazy
;; loaders inplace
;; usage:
;; (define dao (make-access-object/2))
;; (dao 'get attr1) -> (attr1 . aap); lazy loaded
;; (dao 'get attr1) -> (attr1 . aap); from cache