[Chicken-users] hygienic named let

[Jim Ursetto]

There's a bit of a corner case I found with hygienic named let.

     #;3> (module foo (bar)
               (import scheme)
               (define-syntax bar (syntax-rules ()
                     ((_) (let loop ((x 3)) x)))))
     #;4> (module baz () (import foo) (bar))
     Warning: reference to possibly unbound identifier: loop
     Warning: reference to possibly unbound identifier: letrec

It seems that (in ##sys#expand-0, where LET is handled specially)
LETREC is not seen as a macro, and is renamed like a regular
identifier.  Yet this works perfectly for regular LET, direct LETREC,
and even the chained example below:

     #;10> (module foo (bar) (import scheme) (define-syntax bar
(syntax-rules () ((_) (let ((x 3)) x)))))
     #;12> (module baz (quux) (import foo) (define-syntax quux
(syntax-rules () ((_) (bar)))))
     #;13> (module xyzzy () (import baz) (quux))
     3


My guess was that since LET wasn't a real macro, it had no environment
in which to look up the LETREC.  I couldn't concoct one in
##sys#expand-0, so I commented out the special LET handling code there
and just rewrote it as a regular macro, below.  Afterward, regular let
continued to work fine, as did named let in normal circumstances.

Unfortunately, named let -still- didn't work in this corner case, even
though the LETREC is renamed.  Also, if you rename anything else, it
fails too --- for example, change ##core#app to ,(r 'apply), and you
will get an unbound identifier APPLY.

So, I am stumped for now.  Any ideas?

(##sys#extend-macro-environment
 'let
 '()
 (##sys#er-transformer
  (lambda (form r c)
    (##sys#check-syntax 'let form '(_ . #(_ 2)))
    (let* ([body (cdr form)]
           [bindings (car body)])
      (cond [(symbol? bindings)
             (##sys#check-syntax 'let body '(_ #((variable _) 0) . #(_ 1)))
             (let ([bs (cadr body)])
               `(##core#app
                 (,(r 'letrec)
                  ([,bindings (##core#loop-lambda ,(map (lambda (b)
(car b)) bs) ,@(cddr body))])
                  ,bindings)
                 ,@(##sys#map cadr bs)))]
            [else
             `(##core#let ,@body)])))))