wrapping define-syntax added by dzoe on Thu Jul 6 18:51:11 2023
(module
duck
(
module*
duck-extract-defines
duck-extract-doc
)
(import scheme
(chicken base)
(chicken syntax))
(define-syntax duck-extract-defines
(syntax-rules
(define define/doc
make-parameter
define* define*/doc
define-syntax define-syntax/doc)
((_ (define-syntax id transformer))
(define-syntax id transformer))
((_ (define-syntax/doc id doc transformer))
(define-syntax id transformer))
((_ (define var val))
(define var val))
((_ (define/doc var doc val))
(define var val))
((_ (define/doc var doc arg (make-parameter val)))
(define var val))
((_ (define* var val))
(define* var val))
((_ (define*/doc var doc val))
(define* var val))
((_ (define (proc . args) expr ...))
(define (proc . args) expr ...))
((_ (define/doc (proc . args) doc expr ...))
(define (proc . args) expr ...))
((_ (define* (proc . args) expr ...))
(define* (proc . args) expr ...))
((_ (define*/doc (proc . args) doc expr ...))
(define* (proc . args) expr ...))
((_ expr)
expr)))
(define-syntax duck-extract-doc
(syntax-rules (define/doc make-parameter define*/doc define-syntax/doc)
((_ (define-syntax/doc id doc transformer))
(list 'STX 'id `doc))
((_ (define/doc (proc . args) doc expr ...))
(list 'FUN 'proc `doc 'args))
((_ (define*/doc (proc . args) doc expr ...))
(list 'FUN 'proc `doc 'args))
((_ (define/doc var doc arg (make-parameter val)))
(list 'PAR 'var `doc 'arg 'val))
((_ (define*/doc var doc arg (make-parameter val)))
(list 'PAR 'var `doc 'arg 'val))
((_ (define/doc var doc val))
(list 'VAR 'var `doc 'val))
((_ (define*/doc var doc val))
(list 'VAR 'var `doc 'val))
((_ expr)
#f)))
(define-syntax module*
(syntax-rules (#:doc)
((_ modname #:doc (doc ...) exports expr ...)
(module
modname
exports
(import (only scheme define set! quote reverse list quasiquote)
(only (chicken module) export)
(chicken base)
duck
)
(export modname)
(duck-extract-defines expr) ...
(define modname
(list (list 'MOD 'modname `(doc ...))
(duck-extract-doc expr) ...))))
((_ modname expr ...)
(module* modname #:doc () expr ...))))
)