;;;; latch.scm


(module latch (let-once let*-once)
  
(import scheme chicken)

(import-for-syntax matchable)

(define-syntax (let-once x r c)
  (let ((%let (r 'let))
	(%quote (r 'quote))
	(%tmp (r 'tmp))
	(%eq? (r 'eq?))
	(%if (r 'if)))
    (match (cdr x)
      (((bindings ...) body ...)
       (let ((tmps (map (lambda _ (gensym)) bindings)))
	 `(,%let
	   ,(map (lambda (t)
		   (list t (list %quote (vector '#%novalue))))
		 tmps)
	   (,%let 
	    ,(map (lambda (b t)
		    `(,(car b) 
		      (,%let ((,%tmp (##sys#slot ,t 0)))
			     (,%if (,%eq? (,%quote #%novalue) ,%tmp)
				   (,%let ((,%tmp ,(cadr b)))
					  (##sys#setslot ,t 0 ,%tmp)
					  ,%tmp)
				   ,%tmp))))
		  bindings tmps)
	    ,@body)))))))

(define-syntax let*-once
  (syntax-rules ()
    ((_ () body ...) 
     (let () body ...))
    ((_ (binding1 binding2 ...) body ...)
     (let-once (binding1) 
	       (let*-once (binding2 ...)
			  body ...)))))

)