Ну и наворотил! :) Вот так работает?

(with-template 
 ([src dst]
  [define-gi define-gi*]
  [define-gtk define-gtk*])
(define-syntax (dst stx)
  (syntax-case stx ()
    [(dst id params (... ...))
     (let ([new-id (string->symbol (string-replace (symbol->string (syntax-e #'id)) "-" "_"))])
       #`(src id params (... ...) #:c-id #,new-id))])))

Да. Спасибо!

Значит он "..." пытался отнести к with-tenplate, несмотря на то, что тот не является define-syntax. Всё равно ощущение магии от схемовских макросов остаётся.

Я так понимаю, на самом деле он ругается потому, что with-template превращается в inner в теле которого (body) встречается "...". Но всё равно очень загадочное сообщение об ошибке.

Можно как-то сделать поведение with-template более предсказуемым? Засунуть в него code-walker, чтобы заменял всюду в body '... на '(... ...) ?

Кажется нашёл решение:

(define-syntax-rule (with-template ([var ...] [form ...] ...) (... body) ...)
  (begin (define-syntax-rule (inner var ...) (begin ((... ...) body) ...))
         (inner form ...) ...))

Можно как-то сделать поведение with-template более предсказуемым? Засунуть в него code-walker, чтобы заменял всюду в body '... на '(... ...) ?

Надо проще все делать, тогда таких проблем не будет возникать. А проще - написать какой нибудь так:

(define-syntax (define-gtk-definer-2 stx) ...)
(define-gtk-definer-2 define-gi define-gi*)
(define-gtk-definer-2 define-gtk define-gtk*)

(... body)
((... ...) body)

Уверен? :)

А проще - написать какой нибудь так

Не люблю давать имена одноразовым макросам. К тому же define-gtk-definer-2 будет иметь ровно те же проблемы, что и тело with-template: придётся тсавить (... ...)

Кстати, в чём смысл (provide (protect-out ...))? В Racket Reference написано только, что если особо хитро извратиться, то eval с этими символами не работает. А на самом деле? Какую ситуацию protect-out предотвращает?

Уверен? :)

Tested.

На самом деле работает даже так:

(define-syntax-rule (with-template ([var ...] [form ...] ...) body ...)
  (begin (define-syntax-rule (inner var ...) (begin ((... ...) body) ...))
         (inner form ...) ...))

и никакой магии!

Ещё вопрос в тему: а можно как-то сделать шаблон с проверкой keyword'а. Сейчас работает так:

(define-syntax (dst stx)
   (syntax-case stx ()
     [(dst id params ...)
      (if (memq '#:c-id (syntax->datum #'(params ...)))
            #'(src id params ...)
          (let ([new-id (string->symbol (string-replace (symbol->string (syntax-e #'id)) "-" "_"))])
            #`(src id params ... #:c-id #,new-id)))]))

Но может можно вместо if'а pattern сделать?

придётся тсавить (... ...)

Это не проблема вовсе, так и задумано.

Кстати, в чём смысл (provide (protect-out ...))?

Вот эту кухню я вообще не знаю, к сожалению. Есть глава в документации - Code Inspectors, но я не разбирался с этим.

Но может можно вместо if'а pattern сделать?

Средствами syntax-case можно сделать только так, как у тебя. А вообще есть syntax-parse, но по нему ничего не подскажу, к сожалению.

Есть глава в документации - Code Inspectors,

До неё я тоже дошёл. Общую мысль уловил: надо, чтобы клиенты кода не могли его неправильно использовать (чтобы как в CL не лазили в обход декларированного API) + разрешить ходить в обход дебаггерам. Но вот конкретно protect-out — какая-то сильно нетипичная ситуация

А вообще есть syntax-parse

Не. Там такие крокодилы, что пусть уж лучше if memq остаётся.

Слепил, глядя на примеры. Проверь, пожалуйста:

#lang racket/base

(require (for-syntax racket/base syntax/parse racket/string))

(define-for-syntax (make-new-id id-stx)
  (define id-symbol (syntax-e id-stx))
  (define new-id-symbol (string->symbol (string-replace (symbol->string id-symbol) "-" "_")))
  (datum->syntax id-stx new-id-symbol id-stx))

(define-syntax (dst stx)
   (syntax-parse stx
     [(_ id:id (~optional (~seq #:c-id c-id) #:defaults ([c-id (make-new-id #'id)])) (~seq param:expr  ...))
      #`(src id #:c-id c-id param ...)]))

Проверь, пожалуйста:

Не работает

> (expand-once '(dst id b c #:c-id cc))
dst: expected expression in: #:c-id

Именно то, что ты записал можно и стандартно сделать

(define-syntax (dst stx)
   (syntax-case stx ()
     [(dst id #:c-id c-id params ...) 
        #'(src d #:c-id c-id params ...)]
     [(dst id params ...)
        #`(src id params ... #:c-id #,(make-new-id id))]))

Не работает

Есть такое... Надо как-то так:

(define-syntax (dst stx)
   (syntax-parse stx
     [(_ id:id 
         (~seq param1:expr ...)
         (~optional (~seq #:c-id c-id) #:defaults ([c-id (make-new-id #'id)]))
         (~seq param2:expr ...))
      #`(src id #:c-id c-id param1 ... param2 ...)]))

Именно то, что ты записал можно и стандартно сделать

Ну да, как я до этого записал - ключ должен быть первым всегда.

Надо как-то так:

Теперь вроде работает. Но «крокодил». if memq гораздо лаконичней.

if memq гораздо лаконичней.

Тут, как я понимаю, вся фишка в декларативности. Но, согласен, не очень компактно.

Юзай syntax-parse

по идее достаточно вот так:

(define-syntax (dst stx)
   (syntax-parse stx
     [(_ id:id 
         (~or (~optional (~seq #:c-id c-id) #:defaults ([c-id (make-new-id #'id)]))
              param:expr) ...)
      #`(src id #:c-id c-id param ...)]))

Да, действительно. Спасибо за замечание.

по идее достаточно вот так:

Да. Так красиво. Большое спасибо!

Но вообще если писать на syntax-parse, то хорошим стилем считается выносить все хоть сколько-нибудь нетривиальные подпаттерны в отдельный syntax-class. Еще, кстати, вместо define-syntax+syntax-parse можно делать define-simple-macro (а лучше еще быстро накидать свой макрос, аналогичный define-simple-macro, но с использованием template вместо syntax)

(define-simple-macro (dst id:id
                          (~or (~optional (~seq #:c-id c-id) #:defaults ([c-id (new-id #'id)]))
                               param:expr) ...)
  (src id #:c-id c-id param ...))

(define-template-macro (dst id:id (~or (~optional (~seq #:c-id c-id:id)) param:expr) ...)
  (src id #:c-id (?? c-id (new-id id)) param ...))

Я как понял, вы биндинги для gtk пишете? В свободный доступ выкладывать будете?

Вы биндинги для gtk пишете? В свободный доступ выкладывать будете?

G-Object-Introspection. Буду на http://github.com/Kalimehtar/. Когда хоть что-то работать будет (расчётно к концу месяца).

Сейчас думаю над правильным API. Пока получается что-то вроде

(define gtk (gi-ffi "Gtk")) ; загрузили репозиторий

(define main-win (gtk 'Window (gtk 'WINDOW-TOPLEVEL)))
(main-win 'show)
(gtk 'main)

Если удобней как-то по-другому, пишите.

Всё таки не работает

(dst id #:wrap 'ok) не матчится

И не должно. Тут же ошибка. И ее вполне корректно показывает. В чем проблема?

Оригинальный вариант работает правильно:

(define-syntax (dst stx)
   (syntax-case stx ()
     [(dst id params ...)
      (if (memq '#:c-id (syntax->datum #'(params ...)))
            #'(src id params ...)
          (let ([new-id (string->symbol (string-replace (symbol->string (syntax-e #'id)) "-" "_"))])
            #`(src id params ... #:c-id #,new-id)))]))

«Аналог» на syntax-parse выдаёт ошибку.

Оригинальный вариант работает правильно:

Нет, он как раз работает не правильно :) А вариант с syntax-parse - правильно :)

Если вы хотите, чтобы вариант с syntax-parse работал неправильно, то достаточно сделать param вместо param:expr. Но мне неясно, зачем нужен заведомо неправильно работающий макрос.

Постановка задачи

Создать синтаксис dst, который преобразуется в вызов функции src с параметрами, переданными в dst, но если ключевой параметр #:с-id в src не задан, то он должен быть сформирован из первого позиционного параметра. Количество позиционных параметров — не меньше одного, ключевые параметры произвольные.

Мой вариант работает почти всегда. Почти, так как синтаксис Racket позволяет указывать ключевые параметры перед позиционными. Кстати, на syntax-parse можно сделать полностью правильное решение?

Количество позиционных параметров — не меньше одного, ключевые параметры произвольные.

Так сразу надо было об этом говорить.

Кстати, на syntax-parse можно сделать полностью правильное решение?

Конечно. На syntax-parse можно сделать все, что и на syntax-case. Как сделать - я уже сказал, заменить param:expr на param (keyword не является expr, по-этому любой не #:c-id кейворд исходный вариант не матчит).

Оригинальный вариант (который у тебя написан), все равно с ошибкой - он матчит что-нибудь вроде (dst x #:c-id), что неверно. Так что вообще надо сделать (~and param (~not #:c-id)), твой оригинальный вариант же в этом случае будет вовсе неудобоварим.

Почти, так как синтаксис Racket позволяет указывать ключевые параметры перед позиционными.

Можно сделать на syntax-parse и так, чтобы матчило не почти, а всегда. Вообще, в документации по syntax-parse как раз есть исчерпывающие примеры по матчингу ключевых параметров и там рассматриваются даже значительно более нетривиальные случаи.

Вообще, в документации по syntax-parse как раз есть исчерпывающие примеры

Пытался. Парсер-то сделал. А вот как «первый позиционный параметр» сказать так и не понял.

Вот пример:

(syntax->datum
   (syntax-parse #'(p1 #:key1 var1 p2 #:key2 var2)
     [((~or
        pos:expr
        (~optional (~seq #:c-id c-id:id) #:defaults ([c-id #'pos]))
        (~and (~seq (~seq kw:keyword arg:expr)) (~seq kwd ...))) ...)
      #'(pos ... kwd ... ... #:c-id c-id)]))
   
'(p1 p2 #:key1 var1 #:key2 var2 #:c-id pos)

Должно бы возвращать '(p1 p2 #:key1 var1 #:key2 var2 #:c-id p1)

Начал на досуге использовать syntax-parse ...

Впечатления сугубо положительные. Несколько относительно больших макросов с syntax-case после переписывания на syntax-parse уменьшились значительно. На мой взгляд, изучать лучше по книжке Rening Syntactic Sugar: Tools for Supporting Macro Development (в стандартной документации довольно кратко описаны некоторые места).

s/Rening/Refining

(dst #:key1 var1 p1 p2 #:key2 var2)

. dst: expected identifier in: #:key1

А то, что ты написал можно гораздо проще

(define-syntax (dst2 stx)
  (syntax-parse stx
     [(dst2 id:id 
         (~or
          pos:expr
          (~optional (~seq #:c-id c-id:id) #:defaults ([c-id (make-new-id #'id)]))
          (~and (~seq (~seq kw:keyword arg:expr)) (~seq kwd ...))) ...)
      #'(src id pos ... kwd ... ... #:c-id c-id)]))

Разве что ошибки чуть другие.

У меня:

> (dst p1-ok #:key1 var #:key2)
. dst: bad syntax in: (dst p1-ok #:key1 var #:key2)

у тебя

> (dst p1-ok #:key1 var #:key2)
. dst: expected dst parameter declaration in: ()

Хотя не сказал бы, что сильно понятней.

если ключевой параметр #:с-id в src не задан, то он должен быть сформирован из первого позиционного параметра

Тоесть первый позиционный параметр, не обязательно вообще первый? Чтобы враг запутался? :)

Количество позиционных параметров — не меньше одного, ключевые параметры произвольные.

Ок, ладно. Получается, неправильно понял, что требуется.

А так?

(begin-for-syntax
  (define-splicing-syntax-class kw-param
    #:description "keyword parameter declaration"
    #:attributes ((e 1))
    (pattern (~seq kw:keyword p:expr) #:with (e ...) #'(kw p)))
  (define-splicing-syntax-class param
    #:description "parameter declaration"
    #:attributes ((e 1))
    (pattern id:id #:with (e ...) #'(id))
    (pattern p:expr #:with (e ...) #'(p))))

(define-syntax (dst stx)
  (syntax-parse stx
    [(_ (~or (~optional (~seq #:c-id ~! c-id:id) #:defaults ([c-id #'#f]))
             p:param
             kwp:kw-param) ...)
     (cond
       [(syntax-e #'c-id)
        #'(src p.e ... ... kwp.e ... ... #:c-id c-id)]
       [else
        (define first-param (car (syntax-e #'(p.e ... ...))))
        (unless (identifier? first-param)
          (raise-syntax-error 'dst "expected identifier" first-param))
        #`(src p.e ... ... kwp.e ... ... #:c-id #,first-param)])
     ]))

В связи с тем, что нужно первый позиционный аргумент выделить и проверить, что это идентификатор, приходится дополнительно извращаться.

Хотя не сказал бы, что сильно понятней.

Я тоже заметил. Когда используешь syntax-class-ы, то информативность сообщений об ошибке падает. А как решать - я пока не допетрил :)

(define-syntax-class not-keyword
    #:description "not a keyword"
    (pattern x #:fail-when (keyword? (syntax-e #'x)) "keyword not expected"))

зачем так странно, если можно просто x:expr?

А вот как «первый позиционный параметр» сказать так и не понял.

А в чем проблема-то?

(define-syntax (dst stx) 
  (syntax-parse stx
    [(_ id:id
        (~or (~optional (~seq #:c-id c-id:id) #:defaults ([c-id #'id]))
             (~seq (~and k (~not #:c-id)) e:expr)
             p:expr) ...)
     (template (src id p ... (?@ k e) ... #:c-id c-id))]))

(~seq (~and k (~not #:c-id)) e:expr)

(~seq (~and k:keyword (~not #:c-id)) e:expr), конечно же

Вот:

(define-syntax (dst stx)
  (syntax-parse stx
    [(_ (~or (~optional (~seq #:c-id c-id:id) #:defaults ([c-id #'p1]))
             (~seq (~and k:keyword (~not #:c-id)) e:expr)
             (~once p1:expr)
             p:expr) ...)
     #:when (identifier? p1)
     (template (src p1 p ... (?@ k e) ... #:c-id c-id))]))

Или так еще:

(define-syntax (dst stx)
  (syntax-parse stx
    [(_ (~or (~optional (~seq #:c-id c-id:id) #:defaults ([c-id #'p1]))
             (~seq (~and k:keyword (~not #:c-id)) e:expr)
             p:expr) ...)
     #:with (p1:id pp ...) #'(p ...)
     #:when (identifier? #'p1)
     (template (src p1 pp ... (?@ k e) ... #:c-id c-id))]))

Незачем, уже убрал далее.

#:when (identifier? #'p1)
     (template #'(src p1 p ... (?@ k e) ... #:c-id c-id))]))

Последние строчки вот так. Ну а в целом - круто :).

Мне надо зарабатывать скор, а то без правки своих сообщений тяжковато :)

#:when (identifier? #'p1)
     (template (src p1 p ... (?@ k e) ... #:c-id c-id))]))

больше одного сообщения в день на скор не считают

Да это шутка. Надо внимательней проверять все перед подтверждением.

Только всё равно не работает

> (syntax->datum (dst #:key1 var1 pos1 pos2 #:key2 var2))
'(src pos1 pos2 #:key1 var1 #:key2 var2 #:c-id p1)

В #:с-id вместо первого позиционного аргумента p1 попадает.

Кстати, ещё вопрос. Если мне нужна функция и в for-syntax и в фазе 0, мне только дважды копировать тело функции: define + define-for-syntax ? Нет аналога Common Lisp'ового (eval-when (:execute :load-toplevel :compile-toplevel) ...) ?

(begin-for-syntax
  (define-splicing-syntax-class kw-param
    #:description "keyword parameter declaration"
    #:attributes ((e 1))
    (pattern (~seq kw:keyword p:expr) #:with (e ...) #'(kw p)))
  (define-splicing-syntax-class param
    #:description "parameter declaration"
    #:attributes ((e 1))
    (pattern id:id #:with (e ...) #'(id))
    (pattern p:expr #:with (e ...) #'(p))))

Выдаёт ошибку: . ...: ellipses not allowed as an expression in: ... Помечает многоточие в (e ...)