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)))

7
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)

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

@ -1,17 +1,17 @@
#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)])
@ -19,6 +19,4 @@
'page)] 'page)]
[id 'doc]) [id 'doc])
`(module ,name scribble/doclang `(module ,name scribble/doclang
(#%module-begin (#%module-begin ,id () . ,body))))
,id ()
. ,body)))))

27
collects/scribble/doclang.ss
View File

@ -1,31 +1,31 @@
#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 ()
@ -37,10 +37,9 @@
#`(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
@ -60,4 +59,4 @@
#%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)])))]))]))