;;;; variable-item.scm  -*- Hen -*-
;;;; Kon Lovett, Aug '10

(module variable-item

  (;export
    define-variable
    make-variable)

  (import
    scheme
    chicken
    (only type-checks check-procedure check-symbol)
    (only type-errors warning-argument-type))

  (require-library type-checks type-errors)

;;

; not too proud of the name `variable' but ...

; doesn't belong here
(define (make-variable init #!optional guard typnam)
  (if guard
    (begin
      (check-procedure 'make-variable guard 'guard)
      (let* ((typnam
              (if typnam (check-symbol 'make-variable typnam 'type-name)
                "acceptable object" ) )
             (warn (lambda (arg) (warning-argument-type #f arg typnam)) ) )
        (unless (guard init) (warn init))
        (let ((varval init))
          (lambda args
            (if (null? args) varval
              (let ((arg (car args)))
                (if (guard arg) (set! varval arg)
                  (warn arg) )
                (void) ) ) ) ) ) )
    (let ((varval init))
      (lambda args
        (if (null? args) varval
          (begin
            (set! varval (car args))
            (void) ) ) ) ) ) )

(define-syntax define-variable
  (syntax-rules ()

    ((_ name init)
      (define-variable name init #f #f) )

    ((_ name init guard typnam)
      (define name (make-variable init guard typnam)) ) ) )

) ;module variable-item