Fixed potential conflicts with the injected (require lang).

info.rkt

@@ -17,5 +17,5 @@
                       ("test/test.hl.rkt" () (omit-start))
                       ("test/test2.hl.rkt" () (omit-start))))
 (define pkg-desc "Description Here")
-(define version "0.0")
+(define version "0.1")
 (define pkg-authors '(|Georges Dupéron|))

lang/first-line-utils.rkt

@@ -0,0 +1,23 @@
+#lang racket/base
+
+(require racket/port)
+
+(provide read-syntax-whole-first-line)
+
+(define (read-line-length port)
+  (let* ([peeking (peeking-input-port port)]
+         [start (file-position peeking)]
+         [_ (read-line peeking)]
+         [end (file-position peeking)])
+    (- end start)))
+
+(define (narrow-to-one-line port)
+  (make-limited-input-port port (read-line-length port)))
+
+(define (read-syntax-whole-first-line source-name in)
+  (define in1 (narrow-to-one-line in))
+  (let loop ([res '()])
+    (define res+ (read-syntax source-name in1))
+    (if (eof-object? res+)
+        (reverse res)
+        (loop (cons res+ res)))))

lang/meta-first-line.rkt

@@ -1,31 +1,19 @@
 #lang racket/base
 
 (require scribble/reader
-         racket/port)
+         racket/port
+         racket/syntax
+         syntax/strip-context
+         "first-line-utils.rkt")
 
 (provide meta-read-inside
          meta-read-syntax-inside)
 
-(define (read-line-length port)
-  (let* ([peeking (peeking-input-port port)]
-         [start (file-position peeking)]
-         [_ (read-line peeking)]
-         [end (file-position peeking)])
-    (- end start)))
-
-(define (narrow-to-one-line port)
-  (make-limited-input-port port (read-line-length port)))
-
 (define (meta-read-inside in . args)
   (displayln args)
   (apply read-inside args))
 
 (define (meta-read-syntax-inside source-name in . args)
-  (define in1 (narrow-to-one-line in))
+  (with-syntax* ([rd1 (read-syntax-whole-first-line source-name in)]
-  (with-syntax ([rd1 (let loop ([res '()])
+                 [rd (apply read-syntax-inside source-name in args)])
-                       (define res+ (read-syntax source-name in1))
-                       (if (eof-object? res+)
-                           (reverse res)
-                           (loop (cons res+ res))))]
-                [rd (apply read-syntax-inside source-name in args)])
     #'(rd1 . rd)))

lang/reader.rkt

@@ -9,8 +9,29 @@ hyper-literate/lang
 ;; don't use scribble-base-info for the #:info arg, since
 ;; scribble/lp files are not directly scribble'able.
 #:language-info (scribble-base-language-info)
-#:info (scribble-base-reader-info)
+#:info (wrapped-scribble-base-reader-info)
 (require "meta-first-line.rkt"
          (only-in scribble/base/reader
                   scribble-base-reader-info
-                  scribble-base-language-info))
+                  scribble-base-language-info)
+         "first-line-utils.rkt")
+
+(define orig-scribble-base-reader-info
+  (scribble-base-reader-info))
+ 
+(define (wrapped-scribble-base-reader-info)
+  (lambda (key defval default)
+    (case key
+      [(color-lexer)
+       (let ([lexr (orig-scribble-base-reader-info key defval default)])
+         (let ([first? #t])
+           (λ (in offset mode)
+             (when first?
+               (set! first? #f)
+               ;; TODO: should return (values "#:opt" 'hash-colon-keyword …) for
+               ;; the options
+               (read-syntax-whole-first-line (object-name in) in))
+             ;; Note that offset and mode are optional
+             (lexr in offset mode))))]
+      [else
+       (orig-scribble-base-reader-info key defval default)])))

private/common.rkt

@@ -7,6 +7,8 @@
 
 (require (for-syntax racket/base syntax/boundmap racket/list
                      syntax/strip-context
+                     syntax/srcloc
+                     racket/struct
                      syntax/srcloc))
 
 (begin-for-syntax
@@ -29,30 +31,14 @@
      chunks id
      `(,@(mapping-get chunks id) ,@exprs))))
 
-(define-for-syntax (tangle orig-stx req-lng)
+(define-for-syntax (tangle orig-stx)
   (define chunk-mentions '())
   (unless first-id
     (raise-syntax-error 'scribble/lp "no chunks"))
-  ;(define orig-stx (syntax-case stx () [(_ orig) #'orig]))
   (define (restore nstx d) (datum->syntax orig-stx d nstx nstx))
   (define (shift nstx) (replace-context orig-stx nstx))
   (define body
     (let ([main-id (or main-id first-id)])
-      ;; HACK to get arrows drawn for built-ins imported by the module language.
-      ;; TODO: it fails with type-expander.lp2.rkt, because it re-requires λ
-      ;;       (the new-λ) from 'main.
-      (when req-lng
-        (free-identifier-mapping-put!
-         chunk-groups main-id
-         (cons main-id (mapping-get chunk-groups main-id)))
-        (free-identifier-mapping-put!
-         chunks main-id
-         `(,#`(require #,(datum->syntax main-id
-                                        req-lng
-                                        req-lng
-                                        req-lng))
-           ,@(mapping-get chunks main-id))))
-      ;;;;;;;;;;;;;;
       (restore
        main-id
        (let loop ([block (get-chunk main-id)])
@@ -69,7 +55,7 @@
                       (list (restore expr (loop subs)))
                       (list (shift expr))))))
           block)))))
-  (with-syntax ([(body ...) (strip-comments body)]
+  (with-syntax ([(body0 body ...) (strip-comments body)]
                 ;; construct arrows manually
                 [((b-use b-id) ...)
                  (append-map (lambda (m)
@@ -78,12 +64,13 @@
                                             (syntax-local-introduce u)))
                                     (mapping-get chunk-groups m)))
                              chunk-mentions)])
-    ;(displayln (dynamic-require 'tyyyyyyyyyyyped/racket '#%module-begin))
     ;; TODO: use disappeared-use and disappeared-binding.
     ;; TODO: fix srcloc (already fixed?).
-    #`(begin (let ([b-id (void)]) b-use) ... body ...)
+    ;#`(#,(datum->syntax #'body0 'begin) (let ([b-id (void)]) b-use) ... body0 body ...)
-    #;(replace-context #'#%module-begin;modbeg-ty
+    (syntax-property
-                       #`(begin (let ([b-id (void)]) b-use) ... body ...))))
+     (syntax-property #`(#,(datum->syntax #'body0 'begin) body0 body ...)
+                      'disappeared-binding (syntax->list #'(b-id ...)))
+     'disappeared-use (syntax->list #'(b-use ...)))))
 
 (define-for-syntax (strip-comments body)
   (cond
@@ -144,26 +131,54 @@
 (require (for-syntax racket/syntax
                      syntax/parse))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(require (only-in typed/racket)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; WORKAROUND ;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (require (for-syntax racket/pretty
                      "no-auto-require.rkt"))
+
+(define-for-syntax (strip-source e)
+  (cond [(syntax? e)
+         (update-source-location
+          (datum->syntax e (strip-source (syntax-e e)) e e)
+          #:source #f)]
+        [(pair? e) (cons (strip-source (car e)) (strip-source (cdr e)))]
+        [(vector? e) (list->vector (strip-source (vector->list e)))]
+        [(prefab-struct-key e)
+         => (λ (k) (make-prefab-struct k (strip-source (struct->list e))))]
+        ;; TODO: hash tables
+        [else e]))
+
+;; Many thanks to Alex Knauth and Matthew Flatt for finding out how to make
+;; module meta-languages.
+(define-syntax (continue stx)
+  (syntax-case stx ()
+    [(_self lang-module-begin . body)
+     (let ([expanded (local-expand 
+                      #`(lang-module-begin . body) 
+                      'module-begin 
+                      (list))])
+       (syntax-case expanded (#%plain-module-begin)
+         [(#%plain-module-begin . expanded-body)
+          #`(begin 
+              . 
+              #,((make-syntax-introducer) #'expanded-body))]))]))
+
 (define-for-syntax ((make-module-begin submod?) stx)
   (syntax-parse stx
+    ;; #:no-require-lang is ignored, but still allowed for compatibility.
     [(_modbeg (lang:id (~optional (~and no-require-lang #:no-require-lang))
                        (~optional (~and no-auto-require #:no-auto-require)))
               body0 . body)
      (let ()
        (define lang-sym (syntax-e #'lang))
-       (let ([expanded 
+       (displayln (list (syntax-source #'lang) (syntax-line #'lang) (syntax-column #'lang) (syntax-position #'lang) (syntax-original? #'lang)))
+       (let ([expanded
               (expand `(,#'module
                         scribble-lp-tmp-name hyper-literate/private/lp
                         (require hyper-literate/private/chunks-toc-prefix
                                  (for-syntax racket/base
                                              hyper-literate/private/no-auto-require))
                         (begin-for-syntax (set-box! no-auto-require?
-                                                    ,(if (attribute no-auto-require) #t #f)))
+                                                    ,(if (attribute no-auto-require) #t #f))
+                                          (set-box! preexpanding? #t))
                         (define-syntax-rule (if-preexpanding a b) a)
                         (define-syntax-rule (when-preexpanding . b) (begin . b))
                         (define-syntax-rule (unless-preexpanding . b) (begin))
@@ -172,25 +187,20 @@
            [(module name elang (mb . stuff))
             (let ()
               (extract-chunks #'stuff)
-              (dynamic-require lang-sym #f)
-              (namespace-require `(for-meta -1 ,lang-sym))
-              #;(begin
-                  (define/with-syntax tngl (tangle #'body0))
-                  (define/with-syntax (tngl0 . tngl*) #'tngl)
-                  (define/with-syntax (ex-mod ex-nam ex-lng (ex-#%m . ex-rest))
-                    (expand-syntax
-                     #`(#,#'module hyper-literate-temp-expand #,lang-sym
-                                   #,(replace-context #'here #'tngl))))
-                  #`(ex-#%m #,(datum->syntax (syntax-local-introduce #'ex-rest)
-                                             '(#%require lang-sym))
-                            . ex-rest))
               (define/with-syntax tngl
-                (tangle #'body0 (if (attribute no-require-lang) #f #'lang)))
+                (tangle #'body0))
-              ;(replace-context
+              (define/with-syntax mb9 (datum->syntax #f '#%module-begin))
-              ;(namespace-symbol->identifier '#%module-begin)
+              (define/with-syntax lang-modbeg (datum->syntax #'lang '#%module-begin))
-              ;#`(#,(syntax/loc #'lang #%module-begin) …)
+              ; See http://stackoverflow.com/questions/37867859/module-meta-language-in-racket :
-              #`(#,(namespace-symbol->identifier '#%module-begin)
+              #;(define expanded-main-mod-stx
-                 tngl
+                  (local-expand
+                   (syntax-local-introduce
+                    (datum->syntax #f `(,#'module ignored ,(datum->syntax #f lang-sym #'lang #'lang) (,#'mb9 ,(syntax-local-introduce #'tngl)))))
+                   'top-level
+                   (list)))
+              ;(syntax-case expanded-main-mod-stx ();(module #%plain-module-begin)
+              ;[(module _ lng11 (#%plain-module-begin . mod-body11))
+              #`(#%plain-module-begin
                  #,@(if submod?
                         (list
                          (with-syntax*
@@ -204,32 +214,34 @@
                                                            #:span 14)]
                               [lng (datum->syntax #'ctx 'scribble/doclang2 #'bd1 #'bd1)]
                               [begn (datum->syntax #'ctx 'begin)])
-                           #`(module* doc lng ;module doc scribble/doclang2
+                           (strip-source
-                               #,@(syntax-local-introduce
+                            #`(module* doc lng ;module doc scribble/doclang2
-                                   ;; TODO: instead use:
+                                #,@(syntax-local-introduce
-                                   ;; (begin-for-syntax (set! preexpanding #f))
+                                    ;; TODO: instead use:
-                                   ;; and make these identifiers exported by
+                                    ;; (begin-for-syntax (set! preexpanding #f))
-                                   ;; hyper-literate
+                                    ;; and make these identifiers exported by
-                                   (strip-context
+                                    ;; hyper-literate
-                                    #`((require hyper-literate/private/chunks-toc-prefix
+                                    (strip-context
-                                                (for-syntax racket/base
+                                     #`((require hyper-literate/private/chunks-toc-prefix
-                                                            hyper-literate/private/no-auto-require))
+                                                 (for-syntax racket/base
-                                       (begin-for-syntax (set-box! no-auto-require?
+                                                             hyper-literate/private/no-auto-require))
-                                                                   #,(if (attribute no-auto-require) #t #f)))
+                                        (begin-for-syntax
-                                       (define-syntax-rule (if-preexpanding a b)
+                                          (set-box! no-auto-require?
-                                         b)
+                                                    #,(if (attribute no-auto-require) #t #f))
-                                       (define-syntax-rule (when-preexpanding . b)
+                                          (set-box! preexpanding? #f))
-                                         (begin))
+                                        (define-syntax-rule (if-preexpanding a b)
-                                       (define-syntax-rule (unless-preexpanding . b)
+                                          b)
-                                         (begin . b))
+                                        (define-syntax-rule (when-preexpanding . b)
-                                       (require scribble-enhanced/with-manual
+                                          (begin))
-                                                hyper-literate))))
+                                        (define-syntax-rule (unless-preexpanding . b)
-                               (begn body0 . body))
+                                          (begin . b))
-                           ;(strip-context
+                                        (require scribble-enhanced/with-manual
-                           #;#`(modl doc lng ;module doc scribble/doclang2
+                                                 hyper-literate))))
-                                     
+                                (begn body0 . body)))))
-                                     (begn body0 . body))))
+                        '())
-                        '())))])))]))
+                 (require lang)
+                 (continue lang-modbeg tngl)) ;; TODO: put . tngl and remove the (begin _)
+              )])))]))
 
 (define-syntax module-begin/plain (make-module-begin #f))
 (define-syntax module-begin/doc (make-module-begin #t))

private/lp.rkt

@@ -7,7 +7,9 @@
          (for-syntax scheme/base
                      syntax/boundmap
                      syntax/parse
-                     racket/syntax))
+                     racket/syntax
+                     racket/struct
+                     syntax/srcloc))
 
 (begin-for-syntax
   ;; maps chunk identifiers to a counter, so we can distinguish multiple uses
@@ -113,6 +115,18 @@
                   #'()
                   #'((require (for-label for-label-mod ... ...))))))]))
 
+(define-for-syntax (strip-source e)
+ (cond [(syntax? e)
+        (update-source-location
+         (datum->syntax e (strip-source (syntax-e e)) e e)
+         #:source #f)]
+       [(pair? e) (cons (strip-source (car e)) (strip-source (cdr e)))]
+       [(vector? e) (list->vector (strip-source (vector->list e)))]
+       [(prefab-struct-key e)
+        => (λ (k) (make-prefab-struct k (strip-source (struct->list e))))]
+       ;; TODO: hash tables
+       [else e]))
+
 (define-for-syntax ((make-chunk-display racketblock) stx)
   (syntax-parse stx
     ;; no need for more error checking, using chunk for the code will do that
@@ -153,7 +167,8 @@
                                           `(elem (prefixable
                                                   ,@(chunks-toc-prefix)
                                                   tag))))))
-               (#,racketblock expr ...))))]))
+               (#,racketblock . #,(strip-source #'(expr ...))
+                              ))))]))
 
 (define-for-syntax (make-chunk chunk-code chunk-display)
   (syntax-parser
@@ -175,7 +190,9 @@
      (define/with-syntax stx-chunk-display chunk-display)
      
      #`(begin
-         (stx-chunk-code name expr ...)
+         (stx-chunk-code name . #,(if preexpanding?
+                                      #'(expr ...)
+                                      #'(expr ...) #;(strip-source #'(expr ...))))
          #,@(if n
                 #'()
                 #'((define-syntax name (make-element-id-transformer
@@ -209,7 +226,7 @@
                                         (quote-syntax name))]
                                       [(local-expr (... ...))
                                        (syntax-local-introduce
-                                        (quote-syntax (expr ...)))])
+                                        (quote-syntax #,(strip-source #'(expr ...))))])
                           #`(stx-chunk-display
                              local-name
                              newname
@@ -217,7 +234,7 @@
                              local-expr (... ...)))])))
                ;; The (list) here could be important, to avoid the code being
                ;; executed multiple times in weird ways, when pre-expanding.
-               #`(list (stx-chunk-display name name stx-n expr ...))))]))
+               #`(list (stx-chunk-display name name stx-n . #,(strip-source #'(expr ...))))))]))
 
 (define-syntax chunk-code (make-chunk-code #t))
 (define-syntax CHUNK-code (make-chunk-code #f))

private/no-auto-require.rkt

@@ -1,4 +1,6 @@
 #lang racket/base
 
 (provide no-auto-require?)
-(define no-auto-require? (box #f))
+(define no-auto-require? (box #f))
+(provide preexpanding?)
+(define preexpanding? (box #f))

scribblings/hyper-literate.scrbl

@@ -52,14 +52,11 @@ The current implementation of hyper-literate needs to inject
 a @racket[(require _lang)] in the expanded module, in order
 to have the arrows properly working in DrRacket for
 "built-in" identifiers which are provided by the 
-@racket[_lang] itself. This extra @racket[require] statement
+@racket[_lang] itself. The @racket[require] statement is
-can however conflict with later user-provided 
+injected after the whole ``code'' module has been expanded.
-@racket[require] statements, which would otherwise shadow
+It is worth noting that an extra scope is added to the expanded
-the built-ins. The @racket[#:no-require-lang] option
+body of the module, in order to make any @racket[require] form
-disables that behaviour, and has the only drawback that
+within more specific than the @racket[(require _lang)].
-built-ins of the @racket[_lang] language do not have an
-arrow in DrRacket (but they still should be highlighted with
-a turquoise background when hovered over with the mouse).
 
 The current implementation of @racketmodname[scribble/lp2],
 on which @racketmodname[hyper-literate] relies (with a few
@@ -78,6 +75,24 @@ possible in this case to disable the feature using
 @racket[(require (for-label …))] and handle conflicting
 identifiers in a more fine-grained way.
 
+@deprecated[#:what @racket[#:no-require-lang] ""]{
+                                                  
+ The @racket[#:no-require-lang] is deprecated starting from version 0.1, and
+ is not needed anymore. It is still accepted for backwards compatibility. Note
+ that version 0.1 of this library requires a fairly recent Racket version to
+ work properly (it needs v.6.7.0.4 with the commit
+ @tt{8a7852ebbfeb85a8f860700ba5ae481ed7aa9b41}, or v.6.7.0.5 or later). By
+ default, raco will install v0.0 of hyper-literate on older Racket versions.
+
+ The extra @racket[require] statement injected by
+ @racketmodname[hyper-literate] could in previous versions conflict with
+ user-written @racket[require] statements. These @racket[require] statements
+ can shadow some built-ins, and this case would yield conflicts. The
+ @racket[#:no-require-lang] option disables that behaviour in versions < 0.1,
+ and has the only drawback that built-ins of the @racket[_lang] language do not
+ have an arrow in DrRacket (but they still should be highlighted with -a
+ turquoise background when hovered over with the mouse).}
+
 @section{What is hyper-literate programming?}
 
 Hyper-literate programming is to literate programming