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

use some #lang lines

Browse Source 
svn: r9173

original commit: 1a5cb7ed64be900f5f5073c5dc7429aaf232a656
This commit is contained in:
Eli Barzilay 2008-04-06 20:59:28 +00:00
parent 9f2c69105d
commit bc13980309
4 changed files with 82 additions and 87 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
collects/scribble/doc/lang/reader.ss
View File

@ -1,4 +1,3 @@
(module reader mzscheme
(require (prefix doc: scribble/doc/reader))
(provide (rename doc:read read)
(rename doc:read-syntax read-syntax)))
#lang scheme/base
(require (prefix-in doc: scribble/doc/reader))
(provide (rename-out [doc:read read] [doc:read-syntax read-syntax]))

11
collects/scribble/doc/main.ss
View File

@ -1,6 +1,5 @@
(module main scheme/base
(define-syntax-rule (out)
(begin (require scribble/doclang)
(provide (all-from-out scribble/doclang))))
(out))
#lang scheme/base
(define-syntax-rule (out)
(begin (require scribble/doclang)
(provide (all-from-out scribble/doclang))))
(out)

36
collects/scribble/doc/reader.ss
View File

@ -1,24 +1,22 @@
#lang scheme/base
(module reader scheme/base
(require (prefix-in scribble: "../reader.ss"))
(require (prefix-in scribble: "../reader.ss"))
(provide (rename-out [*read read])
(rename-out [*read-syntax read-syntax]))
(provide (rename-out [*read read])
(rename-out [*read-syntax read-syntax]))
(define (*read [inp (current-input-port)])
(wrap inp (scribble:read-inside inp)))
(define (*read [inp (current-input-port)])
(wrap inp (scribble:read-inside inp)))
(define (*read-syntax [src #f] [port (current-input-port)])
(wrap port (scribble:read-syntax-inside src port)))
(define (*read-syntax [src #f] [port (current-input-port)])
(wrap port (scribble:read-syntax-inside src port)))
(define (wrap port body)
(let* ([p-name (object-name port)]
[name (if (path? p-name)
(let-values ([(base name dir?) (split-path p-name)])
(string->symbol (path->string (path-replace-suffix name #""))))
'page)]
[id 'doc])
`(module ,name scribble/doclang
(#%module-begin
,id ()
. ,body)))))
(define (wrap port body)
(let* ([p-name (object-name port)]
[name (if (path? p-name)
(let-values ([(base name dir?) (split-path p-name)])
(string->symbol (path->string (path-replace-suffix name #""))))
'page)]
[id 'doc])
`(module ,name scribble/doclang
(#%module-begin ,id () . ,body))))

115
collects/scribble/doclang.ss
View File

@ -1,63 +1,62 @@
#lang scheme/base
(module doclang scheme/base
(require "struct.ss"
"decode.ss"
(for-syntax scheme/base
syntax/kerncase))
(require "struct.ss"
"decode.ss"
(for-syntax scheme/base
syntax/kerncase))
(provide (except-out (all-from-out scheme/base) #%module-begin)
(rename-out [*module-begin #%module-begin]))
(provide (except-out (all-from-out scheme/base) #%module-begin)
(rename-out [*module-begin #%module-begin]))
;; Module wrapper ----------------------------------------
;; Module wrapper ----------------------------------------
(define-syntax (*module-begin stx)
(syntax-case stx ()
[(_ id exprs . body)
#'(#%module-begin
(doc-begin id exprs . body))]))
(define-syntax (*module-begin stx)
(syntax-case stx ()
[(_ id exprs . body)
#'(#%module-begin
(doc-begin id exprs . body))]))
(define-syntax (doc-begin stx)
(syntax-case stx ()
[(_ m-id (expr ...))
#`(begin
(define m-id (decode (list . #,(reverse (syntax->list #'(expr ...))))))
(provide m-id))]
[(_ m-id exprs . body)
;; `body' probably starts with lots of string constants;
;; it's slow to trampoline on every string, so do them
;; in a batch here:
(let loop ([body #'body]
[accum null])
(syntax-case body ()
[(s . rest)
(string? (syntax-e #'s))
(loop #'rest (cons #'s accum))]
[()
(with-syntax ([(accum ...) accum])
#`(doc-begin m-id (accum ... . exprs)))]
[(body1 . body)
(with-syntax ([exprs (append accum #'exprs)])
(let ([expanded (local-expand #'body1
'module
(append
(kernel-form-identifier-list)
(syntax->list #'(provide
require
#%provide
#%require))))])
(syntax-case expanded (begin)
[(begin body1 ...)
#`(doc-begin m-id exprs body1 ... . body)]
[(id . rest)
(and (identifier? #'id)
(ormap (lambda (kw) (free-identifier=? #'id kw))
(syntax->list #'(require
provide
define-values
define-syntaxes
define-for-syntaxes
#%require
#%provide))))
#`(begin #,expanded (doc-begin m-id exprs . body))]
[_else
#`(doc-begin m-id (#,expanded . exprs) . body)])))]))])))
(define-syntax (doc-begin stx)
(syntax-case stx ()
[(_ m-id (expr ...))
#`(begin
(define m-id (decode (list . #,(reverse (syntax->list #'(expr ...))))))
(provide m-id))]
[(_ m-id exprs . body)
;; `body' probably starts with lots of string constants; it's
;; slow to trampoline on every string, so do them in a batch
;; here:
(let loop ([body #'body]
[accum null])
(syntax-case body ()
[(s . rest)
(string? (syntax-e #'s))
(loop #'rest (cons #'s accum))]
[()
(with-syntax ([(accum ...) accum])
#`(doc-begin m-id (accum ... . exprs)))]
[(body1 . body)
(with-syntax ([exprs (append accum #'exprs)])
(let ([expanded (local-expand
#'body1 'module
(append (kernel-form-identifier-list)
(syntax->list #'(provide
require
#%provide
#%require))))])
(syntax-case expanded (begin)
[(begin body1 ...)
#`(doc-begin m-id exprs body1 ... . body)]
[(id . rest)
(and (identifier? #'id)
(ormap (lambda (kw) (free-identifier=? #'id kw))
(syntax->list #'(require
provide
define-values
define-syntaxes
define-for-syntaxes
#%require
#%provide))))
#`(begin #,expanded (doc-begin m-id exprs . body))]
[_else
#`(doc-begin m-id (#,expanded . exprs) . body)])))]))]))