weeeeeeeeeeeeeeeeeeeee

miniadapton.scm

;; The mini-set implementation
(define empty-set '())
(define (set-mem e s)
  (memv e s))
(define (set-cons e s)
  (if (set-mem e s) s (cons e s)))
(define (set-rem e s)
  (filter (lambda (x) (not (eqv? e x))) s))
(define (set-union s1 s2)
  (fold-left set-cons s2 s1))
(define (set-intersect s1 s2)
  (fold-left set-rem s2 s1))
(define set-for-each for-each)
(define set->list (lambda (x) x))

(define-record-type
  (adapton adapton-cons adapton?)
  (fields
    thunk ;; computation
    (mutable result) ;; the result
    (mutable sub) ;; dependent computations
    (mutable super) ;; required computations
    (mutable clean?) ;; is current result valid?
  )
)

(define (make-athunk thunk)
  (adapton-cons thunk
    'empty
    empty-set
    empty-set
    #f))

;; Add this edge to the DCG
(define (adapton-add-dcg-edge! a-super a-sub)
  (adapton-sub-set!
    a-super
    (set-cons a-sub (adapton-sub a-super)))
  (adapton-super-set!
    a-sub
    (set-cons a-super (adapton-super a-sub))))

;; Remove this edge from the DCG
(define (adapton-del-dcg-edge! a-super a-sub)
  (adapton-sub-set!
    a-super
    (set-rem a-sub (adapton-sub a-super)))
  (adapton-super-set!
    a-sub
    (set-rem a-super (adapton-super a-sub))))

;; Compute the thunk, if required. Perform some 
;; maintenance and return the value of the result.
;; Ensures 'from-scratch' consistency.
(define (adapton-compute a)
  (if (adapton-clean? a)
    (adapton-result a)
    (begin
      (set-for-each
        (lambda (x)
          (adapton-del-dcg-edge! a x))
        (adapton-sub a))
      (adapton-clean?-set! a #t)
      (adapton-result-set! a
        ((adapton-thunk a)))
      (adapton-compute a))))

(define (adapton-dirty! a)
  (when (adapton-clean? a)
        (adapton-clean?-set! a #f)
        (set-for-each adapton-dirty! (adapton-super a))))

(define (adapton-ref val)
  (letrec ((a (adapton-cons
                (lambda () (adapton-result a))
                val
                empty-set
                empty-set
                #t)))
    a))

(define (adapton-ref-set! a val)
  (adapton-result-set! a val)
  (adapton-dirty! a))