; lexical.lisp   by Michael Thorpe   2011-05-24
; Provides "lexical scope" for a block of functions.  Used as follows:
;
;	(lexical-let ((a 123))
;		(define (getter) a)
;		(define (setter new) (set a new) new))
;
;	(getter) ; returns 123
;	(setter 432)
;	(getter) ; returns 432

(define (replace o from to)
	(ifelse (pair? o)
		(let ((a (replace (car o) from to))
		      (d (replace (cdr o) from to)))
			(ifelse (and (eq? a (car o)) (eq? d (cdr o)))
				o
				(cons a d)))
		(ifelse (eq? o from)
			to
			(ifelse (quoted? o)
				(let ((o2 (replace (unquote o) from to)))
					(ifelse (eq? o2 (unquote o))
						o
						(quote o2)))
				o))))

(macro-define (lexical-let o)
	(ifelse (pair? (cadr o))
		(list
			'#lexical-let
			(quote (car (caadr o)))
			(cons 'progn (cdr (caadr o)))
			(quote (macro-expand (cons 'lexical-let (cons (cdadr o) (cddr o))))))
		(cons 'progn (cddr o))))

(macro-define (#lexical-let o)
	(let ((new (unique-word))
	      (old (unquote (cadr o))))
		`(progn
			(define ,new ,(macro-expand (caddr o)))
			,(macro-expand (replace (unquote (cadddr o)) old new)))))