[plt-scheme] Macro techniques for implementing lexical scoped binding constructs

Jens Axel Søgaard skrev:

> For me, the tricky point is to get from "I want to change the
> value of env in the syntax environment" to "write a form, that
> changes env when it is expanded".
> 
> That is, instead of writing the correct:
> 
> (define-syntax (letn stx)
>   (syntax-case stx ()
>     [(_ ((name expr) ...) body ...)
>      #'(syntax-parameterize
>         ([env (append (list (cons #'name #'expr) ...)
>                       (get-env))])
>         body ...)]))
> 
> the impulse is to write:
> 
> (define-syntax (letn stx)
>   (syntax-case stx ()
>     [(_ ((name expr) ...) body ...)
>      (a-parameterize-variant
>        ([env (append (list (cons #'name #'expr) ...)
>                       (get-env))])
>         #'(body ...))]))
> 
> Hmm - what happens if we introduce the arbitrary restriction that we
> can have at most 5 active variables at a time?

Here is one solution, which uses two small utility functions
save and load to transfer the values.

(require (lib "stxparam.ss"))
(require-for-syntax (lib "stxparam.ss")
                     (prefix srfi: (lib "1.ss" "srfi")))

; The environment parameter
(define-syntax-parameter env-param '())
(begin-for-syntax
   (define (get-env)
     (syntax-parameter-value #'env-param)))

; Load and save - used to transfer values from the syntax
; environment to the syntax-parametrization.
; Example:  (eval #`(load #,(save 43))) ==> 43
(begin-for-syntax
   (define (save val)
     #`#'#,(syntax-property #''carrier 'info val))
   (define (load stx)
     (syntax-property stx 'info)))

(define-syntax (letn stx)
   (syntax-case stx ()
     [(_ ([name expr] ...) body ...)
      (let ([env (append (map syntax-e
                              (syntax->list #'((name . expr) ...)))
                         (get-env))])
        (if (> (length env) 5)
            (raise-syntax-error
                'letn "pay up to have more than 5 variables" stx))
        #`(syntax-parameterize
           [(env-param (load #,(save env)))]
           body ...))]))

(define-syntax (ref stx)
   (syntax-case stx ()
     [(_ name)
      (begin
        (display (get-env)) (newline)
        (cond
          [(srfi:assoc #'name (get-env) module-identifier=?)
           => cdr]
          [else
           (raise-syntax-error 'ref "unbound variable" #'name)]))]))


(letn ([x 1])
       (ref x))

(letn ([x 1] [y 2])
       (list (ref x) (ref y)))

(letn ([x 1] [y 2])
       (letn ([x 3])
             (list (ref x) (ref y))))

(letn ([x 1] [y 2])
       (letn ([x 3])
             'skip)
       (list (ref x) (ref y)))


-- 
Jens Axel Søgaard