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 #lang scheme/base
(require (prefix doc: scribble/doc/reader)) (require (prefix-in doc: scribble/doc/reader))
(provide (rename doc:read read) (provide (rename-out [doc:read read] [doc:read-syntax read-syntax]))
(rename doc:read-syntax read-syntax)))

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

@ -1,6 +1,5 @@
(module main scheme/base #lang scheme/base
(define-syntax-rule (out) (define-syntax-rule (out)
(begin (require scribble/doclang) (begin (require scribble/doclang)
(provide (all-from-out scribble/doclang)))) (provide (all-from-out scribble/doclang))))
(out)) (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]) (provide (rename-out [*read read])
(rename-out [*read-syntax read-syntax])) (rename-out [*read-syntax read-syntax]))
(define (*read [inp (current-input-port)]) (define (*read [inp (current-input-port)])
(wrap inp (scribble:read-inside inp))) (wrap inp (scribble:read-inside inp)))
(define (*read-syntax [src #f] [port (current-input-port)]) (define (*read-syntax [src #f] [port (current-input-port)])
(wrap port (scribble:read-syntax-inside src port))) (wrap port (scribble:read-syntax-inside src port)))
(define (wrap port body) (define (wrap port body)
(let* ([p-name (object-name port)] (let* ([p-name (object-name port)]
[name (if (path? p-name) [name (if (path? p-name)
(let-values ([(base name dir?) (split-path p-name)]) (let-values ([(base name dir?) (split-path p-name)])
(string->symbol (path->string (path-replace-suffix name #"")))) (string->symbol (path->string (path-replace-suffix name #""))))
'page)] 'page)]
[id 'doc]) [id 'doc])
`(module ,name scribble/doclang `(module ,name scribble/doclang
(#%module-begin (#%module-begin ,id () . ,body))))
,id ()
. ,body)))))

115
collects/scribble/doclang.ss
View File

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