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

61
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] (let ([expanded
[else (local-expand #'expr
(let ([expanded 'module
(local-expand (car exprs) (append (kernel-form-identifier-list)
'module (syntax->list #'(provide
(append (kernel-form-identifier-list) require
(syntax->list #'(provide chunk
require #%provide
#%provide #%require))))])
#%require))))]) (syntax-case expanded (begin chunk require/chunk)
(syntax-case expanded (begin) [(begin rest ...)
[(begin rest ...) (loop (datum->syntax
(append (loop (syntax->list #'(rest ...))) expanded
(loop (cdr exprs)))] (append
[(id . rest) (syntax->list #'(rest ...))
(ormap (lambda (kw) (free-identifier=? #'id kw)) #'exprs)))]
(syntax->list #'(require [(id . _)
provide (ormap (lambda (kw) (free-identifier=? #'id kw))
chunk (syntax->list #'(require
#%require provide
#%provide))) chunk
(cons expanded (loop (cdr exprs)))] #%require
[else (loop (cdr exprs))]))]))]) #%provide)))
#'(begin #`(begin #,expanded (literate-begin . exprs))]
body-code ... [else (loop #'exprs)]))]))]))
(tangle)))]))
(define-syntax (module-begin stx) (define-syntax (module-begin stx)
(syntax-case stx () (syntax-case stx ()