state.scm

; debug
(define *state* #f)

(define (set-state state . ls)
  (let ((s (apply internal-set-state state ls)))
    (set! *state* s)
    s))

(define (internal-set-state state . ls)
  (if (or (null? ls) (null? (cdr ls)))
      state
      (let ((name (car ls))
	    (value (cadr ls)))
	(apply internal-set-state
	       (assoc-replace (list name value) state)
	       (cddr ls)))))

(define (modify-state state . ls)
  (if (or (null? ls) (null? (cdr ls)))
      state
      (let ((name (car ls))
	    (f (cadr ls)))
	(modify-state (set-state state name (f (get-state state name)))
		      (cddr ls)))))

(define (cons-state state . ls)
  (if (or (null? ls) (null? (cdr ls)))
      state
      (let ((name (car ls))
	    (value (cadr ls)))
	(cons-state (modify-state
		     state
		     name (lambda (ls)
			    (cons value (or ls '()))))
		    (cddr ls)))))
      

(define (get-state state name)
  (let ((w (assq name state)))
    (if #f;(not w)
	(begin (display "NO STATE: ")
	       (write name)
	       (newline)))
    (and w (cadr w))))

(define (has-state? state name) (assoc name state))

(define (delete-state state name)
  (let ((new (assoc-delete name state)))
    (set! *state* new)
    new))