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

another scribble/lp/lang/lang repair

Browse Source 
svn: r13767

original commit: 327fa47487930554e1dd2537a8fcb9ab5793f67b
This commit is contained in:
Matthew Flatt 2009-02-21 14:15:29 +00:00
parent d33566e09f
commit a6002db1ec
1 changed files with 30 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
collects/scribble/lp/lang/lang.ss
View File

@ -70,37 +70,36 @@
(define-syntax (literate-begin stx) (define-syntax (literate-begin stx)
(syntax-case stx () (syntax-case stx ()
[(module-begin expr ...) [(_ . exprs)
(with-syntax (let loop ([exprs #'exprs])
([(body-code ...) (syntax-case exprs ()
(let loop ([exprs (syntax->list #'(expr ...))]) [() #'(tangle)]
(cond [(expr . exprs)
[(null? exprs) null]
[else
(let ([expanded (let ([expanded
(local-expand (car exprs) (local-expand #'expr
'module 'module
(append (kernel-form-identifier-list) (append (kernel-form-identifier-list)
(syntax->list #'(provide (syntax->list #'(provide
require require
chunk
#%provide #%provide
#%require))))]) #%require))))])
(syntax-case expanded (begin) (syntax-case expanded (begin chunk require/chunk)
[(begin rest ...) [(begin rest ...)
(append (loop (syntax->list #'(rest ...))) (loop (datum->syntax
(loop (cdr exprs)))] expanded
[(id . rest) (append
(syntax->list #'(rest ...))
#'exprs)))]
[(id . _)
(ormap (lambda (kw) (free-identifier=? #'id kw)) (ormap (lambda (kw) (free-identifier=? #'id kw))
(syntax->list #'(require (syntax->list #'(require
provide provide
chunk chunk
#%require #%require
#%provide))) #%provide)))
(cons expanded (loop (cdr exprs)))] #`(begin #,expanded (literate-begin . exprs))]
[else (loop (cdr exprs))]))]))]) [else (loop #'exprs)]))]))]))
#'(begin
body-code ...
(tangle)))]))
(define-syntax (module-begin stx) (define-syntax (module-begin stx)
(syntax-case stx () (syntax-case stx ()