I see that:

(import (rnrs))
(define-syntax doit
  (lambda (stx)
    (define def '(define a 123))
    (syntax-case stx ()
      ((k)
       (datum->syntax (syntax k) def)))))
(doit)
(write a)
(newline)

works; so, given:

(library (lib)
  (export
    alpha make-alpha alpha-a
    beta  make-beta  beta-b
    gamma make-gamma)
  (import (rnrs))
  (define-record-type alpha
    (fields (mutable a)))
  (define-record-type beta
    (parent alpha)
    (fields (mutable b)))
  (define-record-type gamma
    (parent beta)))

I want to automatically generate an equivalent of:

(import (rnrs)
  (lib))

(define gamma-a alpha-a)
(define gamma-b beta-b)

I do:

(import (rnrs)
  (for (lib) expand run))

(define-syntax make-record-accessor-aliases
  (syntax-rules ()
    ((_ ?record-name)
     (let-syntax
         ((A (lambda (stx)

               (define (make-record-accessor-aliases k rtd)
                 (let ((rtd-name (symbol->string (record-type-name rtd))))
                   (let process-parent ((parent-rtd (record-type-parent rtd))
                                        (result     '()))
                     (if parent-rtd
                         (let* ((slots  (record-type-field-names parent-rtd))
                                (len    (vector-length slots)))
                           (let make-def ((i    0)
                                          (defs '()))
                             (if (= i len)
                                 (process-parent (record-type-parent parent-rtd)
                                                 (append defs result))
                               (make-def (+ 1 i)
                                         (cons
                 (make-accessor k rtd-name
                 parent-rtd slots i)
                                               defs)))))
                       (begin
                         ;; (write result)
                         ;; (newline)
                         result)))))

               (define (make-accessor k rtd-name parent-rtd slots i)
                 (let ((accessor-name
                         (slot-name->accessor-name rtd-name
                                                   (vector-ref slots i)))
                       (accessor-proc
                         (record-accessor parent-rtd i)))
                   (datum->syntax k
                      `(define ,accessor-name ',accessor-proc))))

               (define (slot-name->accessor-name rtd-name slot-name)
                 (string->symbol (string-append rtd-name "-"
                                     (symbol->string slot-name))))

               (syntax-case stx ()
                 ((k)
                  (with-syntax (((B (... ...))
                                 (make-record-accessor-aliases
                                    (syntax k)
                                    (record-type-descriptor ?record-name))))
                    (syntax (begin B (... ...)))))))))
       (A)))))

(make-record-accessor-aliases gamma)
(define o (make-gamma 1 2))

which evaluates with no errors, but then:

(gamma-a o)

raises  a  "gamma-a unbound  identifier"  error.   I do  not
understand the difference between  the two cases; I tried to
structure the  second case as the  INCLUDE syntax example[1]
in the R6RS document, but I cannot spot the difference.

Suggestions?

[1] <http://www.r6rs.org/final/html/r6rs-lib/r6rs-lib-Z-H-13.html#node_sec...>
--
Marco Maggi

On Sep 12, 1:36 pm, Marco Maggi <mrc....@gmail.com> wrote:

You are using 'k' and that is not defined where gamma-a is defined.

Use ?record-name instead, or move k up to the capturing syntax-rules.

On Sep 12, 6:18 pm, leppie <xacc....@gmail.com> wrote:

IMHO it is the opposite, if I do:

(define-syntax make-record-accessor-aliases
  (syntax-rules ()
    ((k ?record-name)
     (let-syntax

and use either K or ?RECORD-NAME in:

(make-record-accessor-aliases (syntax k)

it does not work, because both are defined while computing the
expansion of the SYNTAX-RULES, and no more while computing the
expansion of A, which is the one that needs it.

The following program, which only make use of A with GAMMA hard-coded,
works perfectly, showing that using the identifier of the A macro use
is correct:

(import (rnrs)
  (for (lib) expand run))

(define-syntax A
  (lambda (stx)

    (define (make-record-accessor-aliases k rtd)
      (let ((rtd-name (symbol->string (record-type-name rtd))))
        (let process-parent ((parent-rtd (record-type-parent rtd))
                             (result     '()))
          (if parent-rtd
              (let* ((slots     (record-type-field-names parent-rtd))
                     (len       (vector-length slots)))
                (let make-def ((i    0)
                               (defs '()))
                  (if (= i len)
                      (process-parent (record-type-parent parent-rtd)
                                      (append defs result))
                    (make-def (+ 1 i)
                              (cons (make-accessor k rtd-name parent-rtd slots i)
                                    defs)))))
            (begin
              ;; (write result)
              ;; (newline)
              result)))))

    (define (make-accessor k rtd-name parent-rtd slots i)
      (let ((accessor-name (slot-name->accessor-name rtd-name (vector-
ref slots i)))
            (accessor-proc (record-accessor parent-rtd i)))
        (datum->syntax k `(define ,accessor-name ',accessor-proc))))

    (define (slot-name->accessor-name rtd-name slot-name)
      (string->symbol (string-append rtd-name "-" (symbol->string slot-
name))))

    (syntax-case stx ()
      ((k)
       (with-syntax (((B ...)
                      (make-record-accessor-aliases (syntax k)
                                                    (record-type-descriptor gamma))))
         (syntax (begin B ...)))))))

(A)
(define o (make-gamma 1 2))
(write (list (gamma-a o)
             (gamma-b o)))
(newline)

--
Marco Maggi
"Are you enjoying your time of EVE?"

On Sep 12, 8:31 pm, marcomaggi <mrc....@gmail.com> wrote:

Then do this (tested):

(define-syntax make-record-accessor-aliases
  (syntax-rules ()
    ((_ ?record-name)
     (let-syntax
         ((A (lambda (stx)
               (define (make-record-accessor-aliases k rtd)
                 (let ((rtd-name (symbol->string (record-type-name
rtd))))
                   (let process-parent ((parent-rtd (record-type-
parent rtd))
                                        (result     '()))
                     (if parent-rtd
                         (let* ((slots  (record-type-field-names
parent-rtd))
                                (len    (vector-length slots)))
                           (let make-def ((i    0)
                                          (defs '()))
                             (if (= i len)
                                 (process-parent (record-type-parent
parent-rtd)
                                                 (append defs result))
                               (make-def (+ 1 i)
                                         (cons
                 (make-accessor k rtd-name
                 parent-rtd slots i)
                                               defs)))))
                       (begin
                         ;; (write result)
                         ;; (newline)
                         result)))))
               (define (make-accessor k rtd-name parent-rtd slots i)
                 (let ((accessor-name
                         (slot-name->accessor-name rtd-name
                                                   (vector-ref slots
i)))
                       (accessor-proc
                         (record-accessor parent-rtd i)))
                   (datum->syntax k
                      `(define ,accessor-name ',accessor-proc))))
               (define (slot-name->accessor-name rtd-name slot-name)
                 (string->symbol (string-append rtd-name "-"
                                     (symbol->string slot-name))))
               (syntax-case stx ()
                 ((k kk)
                  (with-syntax (((B (... ...))
                                 (make-record-accessor-aliases
                                    (syntax kk)
                                    (record-type-descriptor ?record-
name))))
                    (syntax (begin B (... ...)))))))))
       (A ?record-name)))))

(make-record-accessor-aliases gamma)
(define o (make-gamma 1 2))

On Sep 12, 11:27 pm, leppie <xacc....@gmail.com> wrote:

Thanks, I understand why your revision works. I still do not get why
mine does not...
--
Marco Maggi

On Sep 13, 9:43 am, marcomaggi <mrc....@gmail.com> wrote:

Because you introduced the definitions where (A) was 'typed'. (A) does
not exist outside the macro in your first example. In your second
example it works, because (A) is defined where you 'need' it.

Cheers

leppie

On Sep 13, 11:36 am, leppie <xacc....@gmail.com> wrote:

You have to be right, because your code works and mine does not! :-)

I have to partially retract my claim of understanding because of the
following. Everything below is tested with Ikarus.

CASE 1: This is a short version which, according to my understanding,
is equivalent to my original code:

(import (rnrs))

(define-syntax a
  (syntax-rules ()
    ((a-use ?value)
     (let-syntax ((b (lambda (stx)
                       (define chunk '(define num ?value))
                       (syntax-case stx ()
                         ((b-use)
                          (with-syntax
                              ((c (datum->syntax (syntax b-use)
                                                 chunk)))
                            (syntax c)))))))
       (b)))))

(a 123)
(display num)
(newline)

IMO it should work because the macro use "(a 123)" expands to a LET-
SYNTAX form defining a new macro, which is immediately expanded by the
use "(b)"; the use "(b)" happens in the same context of the use "(a
123)". But my opinion is wrong, because I get the "unbound identifier
num" error.

CASE 2: This is a short version of leppie's code:

(import (rnrs))

(define-syntax a
  (syntax-rules ()
    ((a-use ?value)
     (let-syntax ((b (lambda (stx)
                       (define chunk
                         '(define num (quote ?value)))
                       (syntax-case stx ()
                         ((b-use context)
                          (with-syntax
                              ((c (datum->syntax (syntax context)
                                                 chunk)))
                            (syntax (begin c))))))))
       (b ?value)))))

(a alpha)
(display num)
(newline)

it works, and it is fine for me according to my model of how things
should work.

CASE 3: This is a short version of leppie's code in which the syntax
object representing the macro identifier is used to select the
context:

(import (rnrs))

(define-syntax a
  (syntax-rules ()
    ((a-use ?value)
     (let-syntax ((b (lambda (stx)
                       (define chunk
                         '(define num ?value))
                       (syntax-case stx ()
                         ((b-use context)
                          (with-syntax
                              ((c (datum->syntax (syntax context)
                                                 chunk)))
                            (syntax (begin c))))))))
       (b a-use)))))

(a 123)
(display num)
(newline)

I get the "unbound identifier num" error for no reason I can figure
out.
--
Marco Maggi

On Sep 13, 1:47 pm, marcomaggi <mrc....@gmail.com> wrote:

I think that is because syntax-rules ignores the first argument (iow
it is automatically replaced with _).

Cheers

leppie

On Sep 13, 2:41 pm, leppie <xacc....@gmail.com> wrote:

That's what it is! I found it in R6RS[1] in the description of SYNTAX-
RULES:

"While the first subform of <srpattern> may be an identifier, the
identifier is not involved in the matching and is not considered a
pattern variable or literal identifier."

if the same behaviour is adopted for SYNTAX-CASE patterns, it explains
also why my first revision of the code is not working: I was relying
on the K in:

(syntax-case stx ()
  ((k) ---))

to carry context informations. But I do not see any note in R6RS
saying that the first subpattern in a SYNTAX-CASE pattern obeys this
rule. Does it?

[1] <http://www.r6rs.org/final/html/r6rs/r6rs-Z-
H-14.html#node_sec_11.19>
--
Marco Maggi

On Sep 13, 10:35 am, marcomaggi <mrc....@gmail.com> wrote:

No.  The hygiene information in the keyword might be useful in syntax-
case.
You can also use it to self-recurse even in a `let-syntax' bound form.

Lynn