commit 8a8a54fec9b90352266051dc8bdb5d09e0f4f8b5
parent 4448ccae6b6566657735e6f99ce4edef3d7efb61
Author: Jay McCarthy <jay@racket-lang.org>
Date: Mon, 22 Jul 2013 09:45:41 -0600
Add CHUNK
original commit: 05128592353ba81d378afb55ebb9724cfd8aecc4
Diffstat:
3 files changed, 53 insertions(+), 49 deletions(-)
diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/lp-include.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/lp-include.rkt
@@ -1,7 +1,7 @@
#lang scheme/base
(require scheme/include (for-syntax scheme/base)
- (only-in scribble/private/lp chunk)
+ (only-in scribble/private/lp chunk CHUNK)
scribble/manual)
(provide lp-include)
diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/lp.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/lp.rkt
@@ -1,3 +1,3 @@
#lang racket/base
(require scribble/private/lp)
-(provide chunk)
+(provide chunk CHUNK)
diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/private/lp.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/private/lp.rkt
@@ -14,58 +14,62 @@
(define (init-chunk-number id)
(free-identifier-mapping-put! chunk-numbers id 2)))
-(define-syntax (chunk stx)
- (syntax-case stx ()
- [(_ name expr ...)
- ;; no need for more error checking, using chunk for the code will do that
- (identifier? #'name)
- (let* ([n (get-chunk-number (syntax-local-introduce #'name))]
- [str (symbol->string (syntax-e #'name))]
- [tag (format "~a:~a" str (or n 1))])
-
- (when n
- (inc-chunk-number (syntax-local-introduce #'name)))
-
- (syntax-local-lift-expression #'(quote-syntax (a-chunk name expr ...)))
-
- (with-syntax ([tag tag]
- [str str]
- [((for-label-mod ...) ...)
- (map (lambda (expr)
- (syntax-case expr (require)
- [(require mod ...)
- (let loop ([mods (syntax->list #'(mod ...))])
- (cond
- [(null? mods) null]
- [else
- (syntax-case (car mods) (for-syntax)
- [(for-syntax x ...)
- (append (loop (syntax->list #'(x ...)))
- (loop (cdr mods)))]
- [x
- (cons #'x (loop (cdr mods)))])]))]
- [else null]))
- (syntax->list #'(expr ...)))]
-
- [(rest ...) (if n
+(define-syntax-rule (define-chunk chunk-id racketblock)
+ (define-syntax (chunk-id stx)
+ (syntax-case stx ()
+ [(_ name expr (... ...))
+ ;; no need for more error checking, using chunk for the code will do that
+ (identifier? #'name)
+ (let* ([n (get-chunk-number (syntax-local-introduce #'name))]
+ [str (symbol->string (syntax-e #'name))]
+ [tag (format "~a:~a" str (or n 1))])
+
+ (when n
+ (inc-chunk-number (syntax-local-introduce #'name)))
+
+ (syntax-local-lift-expression #'(quote-syntax (a-chunk name expr (... ...))))
+
+ (with-syntax ([tag tag]
+ [str str]
+ [((for-label-mod (... ...)) (... ...))
+ (map (lambda (expr)
+ (syntax-case expr (require)
+ [(require mod (... ...))
+ (let loop ([mods (syntax->list #'(mod (... ...)))])
+ (cond
+ [(null? mods) null]
+ [else
+ (syntax-case (car mods) (for-syntax)
+ [(for-syntax x (... ...))
+ (append (loop (syntax->list #'(x (... ...))))
+ (loop (cdr mods)))]
+ [x
+ (cons #'x (loop (cdr mods)))])]))]
+ [else null]))
+ (syntax->list #'(expr (... ...))))]
+
+ [(rest (... ...)) (if n
#`((subscript #,(format "~a" n)))
#`())])
- #`(begin
- (require (for-label for-label-mod ... ...))
- #,@(if n
+ #`(begin
+ (require (for-label for-label-mod (... ...) (... ...)))
+ #,@(if n
#'()
#'((define-syntax name (make-element-id-transformer
(lambda (stx) #'(chunkref name))))
(begin-for-syntax (init-chunk-number #'name))))
- (make-splice
- (list (make-toc-element
- #f
- (list (elemtag '(chunk tag)
- (bold (italic (racket name)) " ::=")))
- (list (smaller (elemref '(chunk tag) #:underline? #f
- str
- rest ...))))
- (racketblock expr ...))))))]))
+ (make-splice
+ (list (make-toc-element
+ #f
+ (list (elemtag '(chunk tag)
+ (bold (italic (racket name)) " ::=")))
+ (list (smaller (elemref '(chunk tag) #:underline? #f
+ str
+ rest (... ...)))))
+ (racketblock expr (... ...)))))))])))
+
+(define-chunk chunk racketblock)
+(define-chunk CHUNK RACKETBLOCK)
(define-syntax (chunkref stx)
(syntax-case stx ()
@@ -78,4 +82,4 @@
(provide (all-from-out scheme/base
scribble/manual)
- chunk)
+ chunk CHUNK)
