brmlab/hackerbase
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Cleanup and expand * expansions.

Browse source
This commit is contained in:
Dominik Pantůček 2023-07-04 22:38:54 +02:00
parent 4d81684cff
commit 2fb41c172e
1 changed files with 18 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

25
src/duck.scm
View file

@ -35,7 +35,7 @@
(chicken syntax)) (chicken syntax))
(define-syntax duck-extract-defines (define-syntax duck-extract-defines
(syntax-rules (define define/doc make-parameter) (syntax-rules (define define/doc make-parameter define* define*/doc)
((_ (define var val)) ((_ (define var val))
(define var val)) (define var val))
((_ (define/doc var doc val)) ((_ (define/doc var doc val))
@ -54,18 +54,29 @@
((_ (define/doc (proc . args) doc expr ...)) ((_ (define/doc (proc . args) doc expr ...))
(define (proc . args) 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)
expr))) expr)))
(define-syntax duck-extract-doc (define-syntax duck-extract-doc
(syntax-rules (define/doc make-parameter) (syntax-rules (define/doc make-parameter define*/doc)
((_ mod (define/doc (proc . args) doc expr ...)) ((_ (define/doc (proc . args) doc expr ...))
(list 'FUN 'proc `doc 'args)) (list 'FUN 'proc `doc 'args))
((_ mod (define/doc var doc arg (make-parameter val))) ((_ (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)) (list 'PAR 'var `doc 'arg 'val))
((_ mod (define/doc var doc 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)) (list 'VAR 'var `doc 'val))
((_ mod expr) ((_ (define*/doc var doc val))
(list 'VAR 'var `doc 'val))
((_ expr)
#f))) #f)))
(define-syntax module* (define-syntax module*
@ -83,7 +94,7 @@
(duck-extract-defines expr) ... (duck-extract-defines expr) ...
(define modname (define modname
(list (list 'MOD 'modname `(doc ...)) (list (list 'MOD 'modname `(doc ...))
(duck-extract-doc modname expr) ...)))) (duck-extract-doc expr) ...))))
((_ modname expr ...) ((_ modname expr ...)
(module* modname #:doc () expr ...)))) (module* modname #:doc () expr ...))))