suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

fix scribble/text with syntax-local-identifier-as-binding

Browse Source
This commit is contained in:
Matthew Flatt 2015-03-08 16:23:08 -06:00
parent 6d440f5a6b
commit 76a1fdf04f
1 changed files with 12 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
scribble-text-lib/scribble/text/syntax-utils.rkt
View File

@ -123,6 +123,16 @@
(if (null? exprs) (if (null? exprs)
(values (reverse ds) (reverse es) '()) (values (reverse ds) (reverse es) '())
(let ([expr* (local-expand (car exprs) ctx stoplist (car ctx))]) (let ([expr* (local-expand (car exprs) ctx stoplist (car ctx))])
(define (rebuild-bindings)
(syntax-case expr* ()
[(def ids rhs)
(datum->syntax expr*
(list #'def
(map syntax-local-identifier-as-binding
(syntax->list #'ids))
#'rhs)
expr*
expr*)]))
(syntax-case expr* (begin define-syntaxes define-values) (syntax-case expr* (begin define-syntaxes define-values)
[(begin x ...) [(begin x ...)
(loop (append (syntax->list #'(x ...)) (cdr exprs)) ds es)] (loop (append (syntax->list #'(x ...)) (cdr exprs)) ds es)]
@ -132,7 +142,7 @@
(let ([ids (syntax->list #'(id ...))]) (let ([ids (syntax->list #'(id ...))])
(syntax-local-bind-syntaxes (syntax-local-bind-syntaxes
ids (local-transformer-expand #'rhs 'expression '()) (car ctx)) ids (local-transformer-expand #'rhs 'expression '()) (car ctx))
(loop (cdr exprs) (cons expr* ds) es)) (loop (cdr exprs) (cons (rebuild-bindings) ds) es))
;; return the unexpanded expr, to be re-expanded later, in the ;; return the unexpanded expr, to be re-expanded later, in the
;; right contexts ;; right contexts
(values (reverse ds) (reverse es) exprs))] (values (reverse ds) (reverse es) exprs))]
@ -141,7 +151,7 @@
(if (null? es) (if (null? es)
(begin (syntax-local-bind-syntaxes (begin (syntax-local-bind-syntaxes
(syntax->list #'(id ...)) #f (car ctx)) (syntax->list #'(id ...)) #f (car ctx))
(loop (cdr exprs) (cons expr* ds) es)) (loop (cdr exprs) (cons (rebuild-bindings) ds) es))
;; same note here ;; same note here
(values (reverse ds) (reverse es) exprs))] (values (reverse ds) (reverse es) exprs))]
[_ (loop (cdr exprs) ds (cons expr* es))]))))) [_ (loop (cdr exprs) ds (cons expr* es))])))))