R6RS docs, other misc clean-up

svn: r9349

original commit: 5aeaf7ea75b9cdee184c92f16d9b7a0d791ea134
This commit is contained in:
Matthew Flatt 2008-04-17 21:29:07 +00:00
parent f81149c127
commit 829f905ac9
3 changed files with 23 additions and 10 deletions

View File

@ -167,11 +167,16 @@
(define (section-index . elems) (define (section-index . elems)
(make-part-index-decl (map element->string elems) elems)) (make-part-index-decl (map element->string elems) elems))
(define (clean-up s)
;; Remove leading spaces, which might appear there due to images or something
;; else that gets dropped in string form.
(regexp-replace* #rx"^ +" s ""))
(define (record-index word-seq element-seq tag content) (define (record-index word-seq element-seq tag content)
(make-index-element #f (make-index-element #f
(list (make-target-element #f content `(idx ,tag))) (list (make-target-element #f content `(idx ,tag)))
`(idx ,tag) `(idx ,tag)
word-seq (map clean-up word-seq)
element-seq element-seq
#f)) #f))

View File

@ -1116,7 +1116,7 @@
0 0
(+ 1 (loop (car p))))))] (+ 1 (loop (car p))))))]
[prototype-args (lambda (p) [prototype-args (lambda (p)
(let ([parse-arg (lambda (v in-optional? depth next-optional? next-special?) (let ([parse-arg (lambda (v in-optional? depth next-optional? next-special-dots?)
(let* ([id (if (pair? v) (let* ([id (if (pair? v)
(if (keyword? (car v)) (if (keyword? (car v))
(cadr v) (cadr v)
@ -1141,7 +1141,7 @@
in-optional?) ; => must be special in-optional?) ; => must be special
(and default? (and default?
(not next-optional?) (not next-optional?)
(not next-special?))) (not next-special-dots?)))
depth)))]) depth)))])
(let loop ([p p][last-depth 0]) (let loop ([p p][last-depth 0])
(append (if (symbol? (car p)) (append (if (symbol? (car p))
@ -1168,12 +1168,13 @@
cdddr cdddr
cddr) cddr)
v))))) v)))))
(not (pair? (cadr p))))]) (and (not (pair? (cadr p)))
(not (eq? '_...superclass-args... (cadr p)))))])
(cons a (cons a
(loop (cdr p) (loop (cdr p)
(and (arg-optional? a) (and (arg-optional? a)
(not (arg-ends-optional? a))))))]))))))] (not (arg-ends-optional? a))))))]))))))]
[prototype-size (lambda (args first-combine next-combine) [prototype-size (lambda (args first-combine next-combine special-combine?)
(let loop ([s args][combine first-combine]) (let loop ([s args][combine first-combine])
(if (null? s) (if (null? s)
0 0
@ -1190,7 +1191,13 @@
(string-length (keyword->string (arg-kw a))) (string-length (keyword->string (arg-kw a)))
3 3
(string-length (symbol->string (arg-id a)))) (string-length (symbol->string (arg-id a))))
(string-length (symbol->string (arg-id a)))))])))))))] (string-length (symbol->string (arg-id a))))
(if (and special-combine?
(pair? (cdr s))
(arg-special? (cadr s))
(not (eq? '_...superclass-args... (arg-id (cadr s)))))
(+ 1 (string-length (symbol->string (arg-id (cadr s)))))
0))])))))))]
[extract-id (lambda (p) [extract-id (lambda (p)
(let loop ([p p]) (let loop ([p p])
(if (symbol? (car p)) (if (symbol? (car p))
@ -1282,7 +1289,7 @@
(*sig-elem (sig-id sig) (extract-id prototype)) (*sig-elem (sig-id sig) (extract-id prototype))
(to-element (make-just-context (extract-id prototype) (to-element (make-just-context (extract-id prototype)
stx-id))))))])] stx-id))))))])]
[(flat-size) (+ (prototype-size args + +) [(flat-size) (+ (prototype-size args + + #f)
(prototype-depth prototype) (prototype-depth prototype)
(element-width tagged))] (element-width tagged))]
[(short?) (or (flat-size . < . 40) [(short?) (or (flat-size . < . 40)
@ -1312,7 +1319,7 @@
res))] res))]
[(result-next-line?) ((+ (if short? [(result-next-line?) ((+ (if short?
flat-size flat-size
(+ (prototype-size args max max) (+ (prototype-size args max max #t)
(prototype-depth prototype) (prototype-depth prototype)
(element-width tagged))) (element-width tagged)))
(block-width res)) (block-width res))
@ -1379,7 +1386,8 @@
(if (null? args) (if (null? args)
null null
(let ([dots-next? (or (and (pair? (cdr args)) (let ([dots-next? (or (and (pair? (cdr args))
(arg-special? (cadr args))))]) (arg-special? (cadr args))
(not (eq? '_...superclass-args... (arg-id (cadr args))))))])
(cons (list* (to-flow spacer) (cons (list* (to-flow spacer)
(if (arg-starts-optional? (car args)) (if (arg-starts-optional? (car args))
(to-flow (make-element #f (list spacer "["))) (to-flow (make-element #f (list spacer "[")))

View File

@ -40,7 +40,7 @@
;; The phase-level argument is used only when `stx/binding' ;; The phase-level argument is used only when `stx/binding'
;; is an identifier. ;; is an identifier.
;; ;;
;; Note: documentation key currently don't distinguish different ;; Note: documentation keys currently don't distinguish different
;; phase definitions of an identifier from a source module. ;; phase definitions of an identifier from a source module.
;; That is, there's no way to document (define x ....) differently ;; That is, there's no way to document (define x ....) differently
;; from (define-for-syntax x ...). This isn't a problem in practice, ;; from (define-for-syntax x ...). This isn't a problem in practice,