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

Bug #1402 on phc-adt/test/test-structure-low-level.rkt 43fd1bad4173baad0ede84e8ed88f917eec7b327

Browse Source
This commit is contained in:
Georges Dupéron 2016-07-29 17:12:57 +02:00
parent d949cf9606
commit 213253f531
3 changed files with 67 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
main.rkt
View File

@ -2,11 +2,16 @@
(require (for-syntax racket/base (require (for-syntax racket/base
racket/syntax) racket/syntax)
scribble/lp2) (except-in scribble/lp2 chunk CHUNK))
(provide ck defck repeat-chunk) (require (only-in hyper-literate/private/lp
chunk
CHUNK))
(define-syntax-rule (ck e) e) (provide defck
repeat-chunk
chunk
CHUNK)
(define-syntax (defck stx) (define-syntax (defck stx)
(syntax-case stx () (syntax-case stx ()

42
private/common.rkt
View File

@ -6,7 +6,8 @@
module-begin/doc) module-begin/doc)
(require (for-syntax racket/base syntax/boundmap racket/list (require (for-syntax racket/base syntax/boundmap racket/list
syntax/strip-context)) syntax/strip-context
syntax/srcloc))
(begin-for-syntax (begin-for-syntax
(define first-id #f) (define first-id #f)
@ -185,10 +186,25 @@
tngl tngl
#,@(if submod? #,@(if submod?
(list (list
(let ([submod (with-syntax*
([ctx #'body0 #;(syntax-local-introduce #'body0)]
;; TODO: this is a hack, it would be nice to get
;; the actual source location of the lang.
[bd1 (update-source-location #'body0
#:line #f
#:column #f
#:position 7
#:span 14)]
[lng (datum->syntax #'ctx 'scribble/doclang2 #'bd1 #'bd1)]
[begn (datum->syntax #'ctx 'begin)])
#`(module* doc lng ;module doc scribble/doclang2
#,@(syntax-local-introduce
;; TODO: instead use:
;; (begin-for-syntax (set! preexpanding #f))
;; and make these identifiers exported by
;; hyper-literate
(strip-context (strip-context
#`(module doc scribble/doclang2 #'((define-syntax-rule (if-preexpanding a b)
(define-syntax-rule (if-preexpanding a b)
b) b)
(define-syntax-rule (when-preexpanding . b) (define-syntax-rule (when-preexpanding . b)
(begin)) (begin))
@ -196,14 +212,16 @@
(unless-preexpanding . b) (unless-preexpanding . b)
(begin . b)) (begin . b))
(require scribble/manual (require scribble/manual
(only-in hyper-literate/private/lp hyper-literate))))
chunk #,(datum->syntax #'ctx
CHUNK) `(require ,(datum->syntax #'bd1 'scribble/manual #'bd1 #'bd1)
(for-label #,lang-sym)) ,(datum->syntax #'bd1 'hyper-literate #'bd1 #'bd1)
(begin body0 . body)))]) #;(only-in scribble/private/lp chunk CHUNK)))
(syntax-case submod () (begn body0 . body))
[(_ . rest) ;(strip-context
(datum->syntax #'here (cons #'module* #'rest))]))) #;#`(modl doc lng ;module doc scribble/doclang2
(begn body0 . body))))
'())))])))])) '())))])))]))
(define-syntax module-begin/plain (make-module-begin #f)) (define-syntax module-begin/plain (make-module-begin #f))

31
private/lp.rkt
View File

@ -1,7 +1,10 @@
#lang scheme/base #lang scheme/base
;; Forked from scribble-lib/scribble/private/lp.rkt ;; Forked from scribble-lib/scribble/private/lp.rkt
(require (for-syntax scheme/base syntax/boundmap) (require (for-syntax scheme/base
syntax/boundmap
syntax/parse
racket/syntax)
scribble/scheme scribble/decode scribble/manual scribble/struct) scribble/scheme scribble/decode scribble/manual scribble/struct)
(begin-for-syntax (begin-for-syntax
@ -16,8 +19,8 @@
(free-identifier-mapping-put! chunk-numbers id 2))) (free-identifier-mapping-put! chunk-numbers id 2)))
(define-for-syntax ((make-chunk racketblock) stx) (define-for-syntax ((make-chunk racketblock) stx)
(syntax-case stx () (syntax-parse stx
[(_ name expr ...) [(_ (~optional (~seq #:save-as save-as)) name expr ...)
;; no need for more error checking, using chunk for the code will do that ;; no need for more error checking, using chunk for the code will do that
(identifier? #'name) (identifier? #'name)
(let* ([n (get-chunk-number (syntax-local-introduce #'name))] (let* ([n (get-chunk-number (syntax-local-introduce #'name))]
@ -58,14 +61,8 @@
[(rest ...) (if n [(rest ...) (if n
#`((subscript #,(format "~a" n))) #`((subscript #,(format "~a" n)))
#`())]) #`())])
#`(begin (define/with-syntax pre-content
(require (for-label for-label-mod ... ...)) #`(make-splice
#,@(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 (list (make-toc-element
#f #f
(list (elemtag '(prefixable tag) (list (elemtag '(prefixable tag)
@ -73,7 +70,17 @@
(list (smaller (elemref '(prefixable tag) #:underline? #f (list (smaller (elemref '(prefixable tag) #:underline? #f
str str
rest ...)))) rest ...))))
(#,racketblock expr ...))))))])) (#,racketblock expr ...))))
#`(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))))
#,(if (attribute save-as)
#'(define-syntax (save-as s) (syntax pre-content))
#'pre-content))))]))
(define-syntax chunk (make-chunk #'racketblock)) (define-syntax chunk (make-chunk #'racketblock))
(define-syntax CHUNK (make-chunk #'RACKETBLOCK)) (define-syntax CHUNK (make-chunk #'RACKETBLOCK))