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
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)
(syntax-case stx ()

58
private/common.rkt
View File

@ -6,7 +6,8 @@
module-begin/doc)
(require (for-syntax racket/base syntax/boundmap racket/list
syntax/strip-context))
syntax/strip-context
syntax/srcloc))
(begin-for-syntax
(define first-id #f)
@ -185,25 +186,42 @@
tngl
#,@(if submod?
(list
(let ([submod
(strip-context
#`(module doc scribble/doclang2
(define-syntax-rule (if-preexpanding a b)
b)
(define-syntax-rule (when-preexpanding . b)
(begin))
(define-syntax-rule
(unless-preexpanding . b)
(begin . b))
(require scribble/manual
(only-in hyper-literate/private/lp
chunk
CHUNK)
(for-label #,lang-sym))
(begin body0 . body)))])
(syntax-case submod ()
[(_ . rest)
(datum->syntax #'here (cons #'module* #'rest))])))
(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
#'((define-syntax-rule (if-preexpanding a b)
b)
(define-syntax-rule (when-preexpanding . b)
(begin))
(define-syntax-rule
(unless-preexpanding . b)
(begin . b))
(require scribble/manual
hyper-literate))))
#,(datum->syntax #'ctx
`(require ,(datum->syntax #'bd1 'scribble/manual #'bd1 #'bd1)
,(datum->syntax #'bd1 'hyper-literate #'bd1 #'bd1)
#;(only-in scribble/private/lp chunk CHUNK)))
(begn body0 . body))
;(strip-context
#;#`(modl doc lng ;module doc scribble/doclang2
(begn body0 . body))))
'())))])))]))
(define-syntax module-begin/plain (make-module-begin #f))

35
private/lp.rkt
View File

@ -1,7 +1,10 @@
#lang scheme/base
;; 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)
(begin-for-syntax
@ -16,8 +19,8 @@
(free-identifier-mapping-put! chunk-numbers id 2)))
(define-for-syntax ((make-chunk racketblock) stx)
(syntax-case stx ()
[(_ name expr ...)
(syntax-parse stx
[(_ (~optional (~seq #:save-as save-as)) 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))]
@ -56,16 +59,10 @@
(syntax->list #'(expr ...)))]
[(rest ...) (if n
#`((subscript #,(format "~a" 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
#`((subscript #,(format "~a" n)))
#`())])
(define/with-syntax pre-content
#`(make-splice
(list (make-toc-element
#f
(list (elemtag '(prefixable tag)
@ -73,7 +70,17 @@
(list (smaller (elemref '(prefixable tag) #:underline? #f
str
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))