changed the way the literate program setup works
svn: r13774
This commit is contained in:
parent
056e06cf84
commit
121764e7b5
|
@ -2,30 +2,14 @@ These are the files for the literate version of Chat Noir. The files
|
|||
not mentioned are actually in use for Chat Noir that you get via PLT
|
||||
Games.
|
||||
|
||||
- chat-noir-literate.ss: the actual file containing the literate
|
||||
description of the chat noir game, as well as the game itself, in
|
||||
the chunks.
|
||||
|
||||
- chat-noir-doc.ss: the wrapper file that you run via scribble to get
|
||||
the rendered output.
|
||||
|
||||
- literate-lang.ss: the language for running literate programs
|
||||
(contains the tangler).
|
||||
|
||||
- literate-reader.ss: the reader used for chat-noir-literate.ss to
|
||||
put it into the literate-lang.ss.
|
||||
|
||||
Files that begin with "literate" are the files that need to move to a
|
||||
scribble library, if this experiment is successful.
|
||||
|
||||
Problems:
|
||||
|
||||
- the code is not hyperlinked in the scribble output-- this is due to
|
||||
the confusion about how the requires should work in the two modes.
|
||||
- handling multiple chunks is broken right now, so the
|
||||
chunkref-introducting macro (in scribble/private/lp.ss)
|
||||
is disabled.
|
||||
|
||||
- The char-noir-doc.ss file should be built when setup-plt runs on
|
||||
this collection to build the documentation, ie, this file should
|
||||
eventually be merged together with ../scribblings/chat-noir.scrbl.
|
||||
- Need to make 'a-chunk' be a real macro, I expect. (used in
|
||||
scribble/private/lp.ss)
|
||||
|
||||
- hyperlink bound top-level identifiers to their bindings?
|
||||
|
||||
|
@ -33,13 +17,8 @@ Problems:
|
|||
|
||||
- toc entries should not be underlined.
|
||||
|
||||
- identifiers in @chunks[] that refer to other chunks
|
||||
should link to the (first) chunk definition.
|
||||
|
||||
Or maybe just have a @chunkref[]?
|
||||
|
||||
To document:
|
||||
|
||||
@chunk
|
||||
@chunkref
|
||||
scribble/lp (when it is added).
|
||||
scribble/lp (when it is added).
|
||||
scribble/lp-include
|
||||
|
|
|
@ -1,8 +0,0 @@
|
|||
#lang scribble/doc
|
||||
@(require scribble/lp-include scheme/include)
|
||||
;; HACK: use a fake `module', which makes it possible to include a module
|
||||
;; and get only its code in.
|
||||
@(define-syntax-rule (module name base body ...)
|
||||
(begin body ...))
|
||||
|
||||
@(include "chat-noir-literate.ss")
|
|
@ -4,13 +4,6 @@
|
|||
scheme/math
|
||||
games/scribblings/common)
|
||||
|
||||
@;{
|
||||
The command to build this:
|
||||
|
||||
mzc chat-noir-doc.ss && rm -rf chat-noir-doc && scribble ++xref-in setup/xref load-collections-xref --htmls chat-noir-doc.ss
|
||||
|
||||
}
|
||||
|
||||
@gametitle*["Chat Noir" "chat-noir" "Puzzle Game" #:style '(toc)]
|
||||
|
||||
@author[(link "http://www.eecs.northwestern.edu/~robby" "Robby Findler")
|
||||
|
@ -2213,5 +2206,6 @@ for the other functions in this document
|
|||
(world-width board-size)
|
||||
(world-height board-size))
|
||||
(on-key change)
|
||||
(on-mouse clack))
|
||||
(on-mouse clack)
|
||||
(name '|Chat Noir|))
|
||||
(void))]
|
||||
|
|
|
@ -1,7 +1,3 @@
|
|||
#lang scribble/doc
|
||||
@(require scribble/lp-include scheme/include)
|
||||
@;{ HACK: use a fake `module', which makes it possible to include a module and get only its code in.}
|
||||
@(define-syntax-rule (module name base body ...)
|
||||
(begin body ...))
|
||||
|
||||
@(include "../chat-noir/chat-noir-literate.ss")
|
||||
@(require scribble/lp-include)
|
||||
@(lp-include "../chat-noir/chat-noir-literate.ss")
|
||||
|
|
|
@ -1,61 +1,20 @@
|
|||
#lang scheme/base
|
||||
|
||||
;; Use this module to create literate doc wrappers -- files that require the
|
||||
;; literate code in a way that makes it a scribble file.
|
||||
(require scheme/include (for-syntax scheme/base)
|
||||
(only-in scribble/private/lp chunk)
|
||||
scribble/manual)
|
||||
|
||||
(provide chunk (all-from-out scribble/manual))
|
||||
(provide lp-include)
|
||||
|
||||
(require scribble/manual scribble/decode scribble/struct
|
||||
scribble/scheme
|
||||
(for-syntax scheme/base syntax/boundmap))
|
||||
|
||||
(begin-for-syntax
|
||||
;; maps chunk identifiers to a counter, so we can distinguish multiple uses
|
||||
;; of the same name
|
||||
(define chunk-numbers (make-free-identifier-mapping))
|
||||
(define (get-chunk-number id)
|
||||
(let ([n (add1 (free-identifier-mapping-get chunk-numbers id
|
||||
(lambda () 0)))])
|
||||
(free-identifier-mapping-put! chunk-numbers id n)
|
||||
n)))
|
||||
|
||||
;; This is the doc-view implementation of `chunk', see "literate-lang.ss" for
|
||||
;; the cide-view implementation. Defines `chunk' as a macro that typesets the
|
||||
;; contained code.
|
||||
(define-syntax (chunk stx)
|
||||
(define-syntax (module 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 #'name)]
|
||||
[str (symbol->string (syntax-e #'name))])
|
||||
(if (n . > . 1)
|
||||
#'(void)
|
||||
(with-syntax ([tag str]
|
||||
[str str]
|
||||
[((for-label-mod ...) ...)
|
||||
(map (lambda (expr)
|
||||
(syntax-case expr (require)
|
||||
[(require mod ...)
|
||||
#'(mod ...)]
|
||||
[else null]))
|
||||
(syntax->list #'(expr ...)))])
|
||||
#`(begin
|
||||
(define-syntax name (make-element-id-transformer
|
||||
(lambda (stx) #'(chunkref name))))
|
||||
(require (for-label for-label-mod ... ...))
|
||||
(make-splice
|
||||
(list (make-toc-element
|
||||
#f
|
||||
(list (elemtag '(chunk tag)
|
||||
(bold (italic (scheme name)) " ::=")))
|
||||
(list (smaller (elemref '(chunk tag) #:underline? #f
|
||||
str))))
|
||||
(schemeblock expr ...)))))))]))
|
||||
[(module name base body ...)
|
||||
(begin
|
||||
#'(begin body ...))]))
|
||||
|
||||
(define-syntax (chunkref stx)
|
||||
(define-syntax (lp-include stx)
|
||||
(syntax-case stx ()
|
||||
[(_ id)
|
||||
(identifier? #'id)
|
||||
(with-syntax ([str (format "~a" (syntax-e #'id))])
|
||||
#'(elemref '(chunk str) #:underline? #f str))]))
|
||||
[(_ name)
|
||||
(with-syntax ([there (datum->syntax stx 'there)])
|
||||
#'(include-at/relative-to here there name))]))
|
||||
|
||||
|
|
|
@ -1,8 +1,7 @@
|
|||
#lang scheme/base
|
||||
|
||||
(provide (except-out (all-from-out scheme/base) #%module-begin)
|
||||
(rename-out [module-begin #%module-begin])
|
||||
chunk)
|
||||
(rename-out [module-begin #%module-begin]))
|
||||
|
||||
(require (for-syntax scheme/base syntax/boundmap scheme/list syntax/kerncase))
|
||||
|
||||
|
@ -25,22 +24,6 @@
|
|||
chunks id
|
||||
`(,@(mapping-get chunks id) ,@(map syntax-local-introduce exprs)))))
|
||||
|
||||
;; This is the code-view implementation of `chunk', see
|
||||
;; "literate-doc-wrapper.ss" for the doc-view implementation. Defines
|
||||
;; `chunk' as a macro that collects the code to be later reassembled
|
||||
;; by `tangle'.
|
||||
(define-syntax (chunk stx)
|
||||
(syntax-case stx ()
|
||||
[(_ name expr ...)
|
||||
(cond [(not (identifier? #'name))
|
||||
(raise-syntax-error #f "expected a chunk name" stx #'name)]
|
||||
[(not (regexp-match? #rx"^<.*>$" (symbol->string (syntax-e #'name))))
|
||||
(raise-syntax-error
|
||||
#f "chunk names must begin and end with angle brackets, <...>"
|
||||
stx #'name)]
|
||||
[else (add-to-chunk! #'name (syntax->list #'(expr ...)))
|
||||
#'(void)])]))
|
||||
|
||||
(define-syntax (tangle stx)
|
||||
(define chunk-mentions '())
|
||||
(define body
|
||||
|
@ -68,41 +51,27 @@
|
|||
chunk-mentions)])
|
||||
#`(begin body ... (let ([b-id (void)]) b-use) ...)))
|
||||
|
||||
(define-syntax (literate-begin stx)
|
||||
(syntax-case stx ()
|
||||
[(_ . exprs)
|
||||
(let loop ([exprs #'exprs])
|
||||
(syntax-case exprs ()
|
||||
[() #'(tangle)]
|
||||
[(expr . exprs)
|
||||
(let ([expanded
|
||||
(local-expand #'expr
|
||||
'module
|
||||
(append (kernel-form-identifier-list)
|
||||
(syntax->list #'(provide
|
||||
require
|
||||
chunk
|
||||
#%provide
|
||||
#%require))))])
|
||||
(syntax-case expanded (begin chunk require/chunk)
|
||||
[(begin rest ...)
|
||||
(loop (datum->syntax
|
||||
expanded
|
||||
(append
|
||||
(syntax->list #'(rest ...))
|
||||
#'exprs)))]
|
||||
[(id . _)
|
||||
(ormap (lambda (kw) (free-identifier=? #'id kw))
|
||||
(syntax->list #'(require
|
||||
provide
|
||||
chunk
|
||||
#%require
|
||||
#%provide)))
|
||||
#`(begin #,expanded (literate-begin . exprs))]
|
||||
[else (loop #'exprs)]))]))]))
|
||||
(define-for-syntax (extract-chunks exprs)
|
||||
(let loop ([exprs exprs])
|
||||
(syntax-case exprs ()
|
||||
[() (void)]
|
||||
[(expr . exprs)
|
||||
(syntax-case #'expr (define-syntax quote-syntax)
|
||||
[(define-values (lifted) (quote-syntax (a-chunk id body ...)))
|
||||
(eq? (syntax-e #'a-chunk) 'a-chunk)
|
||||
(begin
|
||||
(add-to-chunk! #'id (syntax->list #'(body ...)))
|
||||
(loop #'exprs))]
|
||||
[_
|
||||
(loop #'exprs)])])))
|
||||
|
||||
(define-syntax (module-begin stx)
|
||||
(syntax-case stx ()
|
||||
[(_ id exprs . body)
|
||||
#'(#%module-begin
|
||||
(literate-begin id exprs . body))]))
|
||||
(let ([expanded
|
||||
(expand `(,#'module scribble-lp-tmp-name scribble/private/lp
|
||||
,@(syntax->datum #'(id exprs . body))))])
|
||||
(syntax-case expanded ()
|
||||
[(module name lang (mb . stuff))
|
||||
(begin (extract-chunks #'stuff)
|
||||
#'(#%module-begin (tangle)))]))]))
|
||||
|
|
68
collects/scribble/private/lp.ss
Normal file
68
collects/scribble/private/lp.ss
Normal file
|
@ -0,0 +1,68 @@
|
|||
#lang scheme/base
|
||||
|
||||
(require (for-syntax scheme/base syntax/boundmap scheme/list syntax/kerncase)
|
||||
scribble/scheme scribble/decode scribble/manual scribble/struct)
|
||||
|
||||
(begin-for-syntax
|
||||
;; maps chunk identifiers to a counter, so we can distinguish multiple uses
|
||||
;; of the same name
|
||||
(define chunk-numbers (make-free-identifier-mapping))
|
||||
(define (get-chunk-number id)
|
||||
(let ([n (add1 (free-identifier-mapping-get chunk-numbers id
|
||||
(lambda () 0)))])
|
||||
(free-identifier-mapping-put! chunk-numbers id n)
|
||||
n)))
|
||||
|
||||
(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 #'name)]
|
||||
[str (symbol->string (syntax-e #'name))])
|
||||
|
||||
(syntax-local-lift-expression #'(quote-syntax (a-chunk name expr ...)))
|
||||
|
||||
(if (n . > . 1)
|
||||
(let ([str
|
||||
(format
|
||||
"need to handle secondary tags: ~a ~a\n"
|
||||
n
|
||||
str)])
|
||||
#`(begin
|
||||
(italic #,str)))
|
||||
(with-syntax ([tag str]
|
||||
[str str]
|
||||
[((for-label-mod ...) ...)
|
||||
(map (lambda (expr)
|
||||
(syntax-case expr (require)
|
||||
[(require mod ...)
|
||||
#'(mod ...)]
|
||||
[else null]))
|
||||
(syntax->list #'(expr ...)))])
|
||||
#`(begin
|
||||
(require (for-label for-label-mod ... ...))
|
||||
;; why does this happen twice?
|
||||
#;
|
||||
(define-syntax name (make-element-id-transformer
|
||||
(lambda (stx) #'(chunkref name))))
|
||||
(make-splice
|
||||
(list (make-toc-element
|
||||
#f
|
||||
(list (elemtag '(chunk tag)
|
||||
(bold (italic (scheme name)) " ::=")))
|
||||
(list (smaller (elemref '(chunk tag) #:underline? #f
|
||||
str))))
|
||||
(schemeblock expr ...)))))))]))
|
||||
|
||||
(define-syntax (chunkref stx)
|
||||
(syntax-case stx ()
|
||||
[(_ id)
|
||||
(identifier? #'id)
|
||||
(with-syntax ([str (format "~a" (syntax-e #'id))])
|
||||
#'(elemref '(chunk str) #:underline? #f str))]))
|
||||
|
||||
|
||||
(provide (all-from-out scheme/base
|
||||
scribble/manual)
|
||||
chunk)
|
Loading…
Reference in New Issue
Block a user