Re: "Magic" Variables?

[Maciej Stachowiak <mstachow@mit.edu>]

Well, if you are that, I can tell you that Guile already have that
functionality.  :)

> The code below causes
>
>   x --> Hi!
>        17
>
> (define-module (test)
>  :use-module (ice-9 syncase))
>
> ;;; The following line enables macro expansion of all forms
> (use-syntax syncase)
>
> (define x-val 17)
>
> (define-syntax x
>   (lambda (exp)
>     (syntax-case exp ()
>       (k (identifier? (syntax k)) (syntax (begin (display "Hi!\n")
>                                                  x-val))))))


OK, that's half the problem, but getting special things to happen when
you want to set! is more complicated. In fact, it is not entirely
clear to me how to shadow set! using define-syntax but still have the
original set! available to use in the expansion thereof of normal
variables.

In fact, last night, before I saw this message, I implemented
symbol-macrolet (using defmacro) and dealt with this issue by
implementing setf! (a la Common Lisp's setf) and translating all set!s
to setf!s within the scope of a symbol-macrolet. This does not seem
like either a complete solution or a schemey thing to do (although my
implementation of setf! is cleaner than Common Lisp's version, I think
-- setf! methods belong to procedure objects, not so symbols, so that,
for example, 

(define x car)
(setf! (x y) 7)

Will expand to (set-car! y 7) as expected).

In any case, here's my implementations of symbol-macrolet and setf!,
and maybe you can help me figure out a way to make assignments in your
more elegant define-syntax-based framework. I only implemented
setf!-methods for the R4RS-standard locations, although adding more
should be fairly trivial. I think I've had too much Common Lisp on the
brain lately from my thesis.


----------------

;;; symbol-macrolet ((var1 expression1) ...) . body
;;;
;;;  symbol-macrolet replaces each reference to any of the vars with
;;;  the corresponding expression in the lexical scope of the body. It 
;;;  also replaces set!s with setf!s so that if an expression is a 
;;;  setf!-able location, set!s to the var will work correctly.
;;;

(defmacro symbol-macrolet (bindings . body)
  (letrec ((recursive-subst
	    (lambda (l)
	      (if (pair? l)
		  (case (car l)
		    ((quote) l)
		    ((set!) 
		     (map recursive-subst `(setf! ,@(cdr l))))
		    (else (map recursive-subst (macroexpand l))))
		  (cond
		   ((and (symbol? l) (assq l bindings)) 
		    => cadr)
		   (else l))))))
    `(begin ,@(recursive-subst body))))
							

;;; setf! generalized-varibale value
;;;
;;;  setf! is a generalized setted. If generalized-variable is just a
;;;  variable, (setf! generalized-variable value) expands to 
;;;  (set! generalized-variable value). If it is a procdure call, however,
;;;  the setf! form retrieves the setf!-method associated with the 
;;;  procedure and uses it to set the correct location to value.
;;;  Sample expansions (assuming an appropriate set of default setf!
;;;  methods) :
;;;
;;;    (setf! (car x) 7) == (set-car! x 7)
;;;
;;;    (setf! (vector-ref foo 7) 'xyz) == (vector-set! foo 7 'xyz)
;;;
;;;    (setf! (car (cdr (list-ref z 42)) "abc") == 
;;;                (set-car! (cdr (list-ref z 42)) "abc")
;;;

(defmacro setf! (genvar value)
  (if (pair? genvar)
      `((procedure-property ,(car genvar) 'setf!-method) ,@(cdr genvar) ,value)
      `(set! ,genvar ,value)))


;;; set-setf!-method! proc setf!-method
;;;
;;;  sets the setf!-method for the procedure proc to setf!-method -
;;;  setf!-method should be a procedure whose arguments are the same
;;;  as those of proc with an additional argument at the end which 
;;;  is the value that should be set; it should set the same location
;;;  that proc would retrive from.

(define (set-setf!-method! proc setf!-method)
  (set-procedure-property! proc 'setf!-method setf!-method))

;;; setf! methods for R4RS standard procedures

(set-setf!-method! car set-car!)
(set-setf!-method! cdr set-cdr!)

;; omit caar - cddddr for purposes of this email

(set-setf!-method! vector-ref vector-set!)
(set-setf!-method! list-ref list-set!)

;; not sure if these DTRT
(set-setf!-method! assq assq-set!)
(set-setf!-method! assv assv-set!)
(set-setf!-method! assoc assoc-set!)

(set-setf!-method! string-ref string-set!)
(set-setf!-method! current-input-port set-current-input-port)
(set-setf!-method! current-output-port set-current-output-port)