(module cells (cells cell cell? cell-of? cell-ref cell-set! cell->closure)
(import scheme
        (only chicken define-record-type define-record-printer
              case-lambda getter-with-setter)
        (only extras fprintf))

(define-record-type cell
  (cell var)
  cell?
  (var cell-ref cell-set!))

(define cell-ref (getter-with-setter cell-ref cell-set!))

(define ((cell-of? type?) xpr)
  (and (cell? xpr)
       (type? (cell-ref xpr))))

(define (cell->closure cl)
  (case-lambda
    (() (cell-ref cl))
    ((val) (cell-set! cl val))))

(define-record-printer (cell var out)
  (fprintf out "!~s!" (cell-ref var)))

(define cells
  (let ((signatures '((cell init)
                      (cell? xpr)
                      (cell-of? ok?)
                      (cell-ref cl)
                      (cell-set! cl val)
                      (cell->closure cl))))
    (case-lambda
      (() (map car signatures))
      ((sym) (assq sym signatures)))))

) ; cells