bkyk8rc3zvpnsf5inmcqq4n3k98cv6hj-my-site-hyper-literate-git.test.suzanne.soy-0.0.1

commit 513a508dc4507d14ae099e3967cd9f8121e98ad9
parent de160f7842f6406f9b107bfbf749ae77f2320bbf
Author: Matthew Flatt <mflatt@racket-lang.org>
Date:   Thu, 26 Feb 2009 13:40:59 +0000

fix srcloc and binding tracking in scribble/lp

svn: r13849

original commit: 9df218784ad23abb98be72d2eef03d03ef2fa899

Diffstat:
M
collects/scribble/lp/lang/lang.ss
 | 
15
++++++++-------

1 file changed, 8 insertions(+), 7 deletions(-)
diff --git a/collects/scribble/lp/lang/lang.ss b/collects/scribble/lp/lang/lang.ss
@@ -3,7 +3,8 @@
 (provide (except-out (all-from-out scheme/base) #%module-begin)
          (rename-out [module-begin #%module-begin]))
 
-(require (for-syntax scheme/base syntax/boundmap scheme/list syntax/kerncase))
+(require (for-syntax scheme/base syntax/boundmap scheme/list syntax/kerncase
+                     syntax/strip-context))
 
 (begin-for-syntax
   (define first-id #f)
@@ -14,17 +15,16 @@
   (define chunks (make-free-identifier-mapping))
   ;; maps a chunk identifier to all identifiers that are used to define it
   (define chunk-groups (make-free-identifier-mapping))
-  (define (get-chunk id)
-    (map syntax-local-introduce (mapping-get chunks id)))
+  (define (get-chunk id) (mapping-get chunks id))
   (define (add-to-chunk! id exprs)
     (unless first-id (set! first-id id))
     (when (eq? (syntax-e id) '<*>) (set! main-id id))
     (free-identifier-mapping-put!
      chunk-groups id
-     (cons (syntax-local-introduce id) (mapping-get chunk-groups id)))
+     (cons id (mapping-get chunk-groups id)))
     (free-identifier-mapping-put!
      chunks id
-     `(,@(mapping-get chunks id) ,@(map syntax-local-introduce exprs)))))
+     `(,@(mapping-get chunks id) ,@exprs))))
 
 (define-syntax (tangle stx)
   (define chunk-mentions '())
@@ -53,7 +53,8 @@
                 [((b-use b-id) ...)
                  (append-map (lambda (m)
                                (map (lambda (u)
-                                      (list m (syntax-local-introduce u)))
+                                      (list (syntax-local-introduce m) 
+                                            (syntax-local-introduce u)))
                                     (mapping-get chunk-groups m)))
                              chunk-mentions)])
     #`(begin body ... (let ([b-id (void)]) b-use) ...)))
@@ -77,7 +78,7 @@
     [(_ id exprs . body)
      (let ([expanded 
             (expand `(,#'module scribble-lp-tmp-name scribble/private/lp
-                                ,@(syntax->datum #'(id exprs . body))))])
+                                ,@(strip-context #'(id exprs . body))))])
        (syntax-case expanded ()
          [(module name lang (mb . stuff))
           (begin (extract-chunks #'stuff)