suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Scribble: change handling of argumentd in defproc, etc., to use lexical bidning instead of parameters and symbols; fix some docs

Browse Source 
svn: r13688
This commit is contained in:
Matthew Flatt 2009-02-17 01:15:38 +00:00
parent 723dc26903
commit 0f18d68649
10 changed files with 120 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/browser/browser.scrbl
View File

@ -7,6 +7,8 @@
browser/htmltext
browser/external
browser/tool
scheme/base
scheme/class
scheme/gui/base
net/url
framework/framework))

3
collects/ffi/objc.scrbl
View File

@ -2,7 +2,8 @@
@(require scribble/manual
scribble/eval
(for-label scheme/base
scheme/foreign
scheme/contract
(except-in scheme/foreign ->)
"private/objc-doc-unsafe.ss"))
@(define objc-eval (make-base-eval))

5
collects/lazy/lazy.scrbl
View File

@ -1,6 +1,7 @@
#lang scribble/doc
@(require (for-label (except-in lazy delay force promise?)
(only-in lazy/force ! !! !list !!list)))
@(require (for-label (except-in lazy delay force)
(only-in lazy/force ! !! !list !!list)
scheme/contract))
@(define-syntax-rule (deflazy mod def id)
(begin

2
collects/scribble/private/manual-form.ss
View File

@ -153,7 +153,7 @@
(syntax->list #'(lit ...)))
#'(with-togetherable-scheme-variables
(lit ...)
([form spec])
([form/none spec])
(*defforms #f
'(spec) (list (lambda (ignored) (schemeblock0/form spec)))
null null

11
collects/scribble/private/manual-proc.ss
View File

@ -143,16 +143,17 @@
#f (list (schemeparenfont "[")
(schemeidfont (keyword->string (arg-kw arg)))
spacer
(to-element (arg-id arg))
(to-element (make-var-id (arg-id arg)))
(schemeparenfont "]")))
(make-element
#f (list (to-element (arg-kw arg))
spacer
(to-element (arg-id arg)))))
(to-element (arg-id arg)))]
(to-element (make-var-id (arg-id arg))))))
(to-element (make-var-id (arg-id arg))))]
[(eq? (arg-id arg) '...+) dots1]
[(eq? (arg-id arg) '...) dots0]
[else (to-element (arg-id arg))])]
[(eq? (arg-id arg) '_...superclass-args...) (to-element (arg-id arg))]
[else (to-element (make-var-id (arg-id arg)))])]
[e (if (arg-ends-optional? arg)
(make-element #f (list e "]"))
e)]
@ -425,7 +426,7 @@
[def-len (if (arg-optional? arg) (block-width arg-val) 0)]
[base-list
(list (to-flow (hspace 2))
(to-flow (to-element (arg-id arg)))
(to-flow (to-element (make-var-id (arg-id arg))))
flow-spacer
(to-flow ":")
flow-spacer

31
collects/scribble/private/manual-vars.ss
View File

@ -15,15 +15,23 @@
(define-struct (box-splice splice) ())
(begin-for-syntax (define-struct deftogether-tag () #:omit-define-syntaxes))
(define-syntax (with-togetherable-scheme-variables stx)
(syntax-case stx ()
[(_ . rest)
;; Make it transparent, so deftogether is allowed to pull it apart
(syntax-property
(syntax/loc stx
(with-togetherable-scheme-variables* . rest))
'certify-mode
'transparent)]))
(let ([result (syntax/loc stx
(with-togetherable-scheme-variables* . rest))]
[ctx (syntax-local-context)])
(if (and (pair? ctx) (deftogether-tag? (car ctx)))
;; Make it transparent, so deftogether is allowed to pull it apart
(syntax-property result
'certify-mode
'transparent)
;; Otherwise, don't make it transparent, because that
;; removes certificates that will be needed on the `letrec-syntaxes'
;; that we introduce later.
result))]))
(define-syntax-rule (with-togetherable-scheme-variables* . rest)
(with-scheme-variables . rest))
@ -41,6 +49,7 @@
(if (identifier? arg)
(unless (or (eq? (syntax-e arg) '...)
(eq? (syntax-e arg) '...+)
(eq? (syntax-e arg) '_...superclass-args...)
(memq (syntax-e arg) lits))
(bound-identifier-mapping-put! ht arg #t))
(syntax-case arg ()
@ -51,11 +60,12 @@
(identifier? #'arg)
(bound-identifier-mapping-put! ht #'arg #t)])))
(cdr (syntax->list s-exp)))]
[(form form/maybe non-term)
[(form form/none form/maybe non-term)
(let loop ([form (case (syntax-e kind)
[(form) (if (identifier? s-exp)
null
(cdr (syntax-e s-exp)))]
[(form/none) s-exp]
[(form/maybe)
(syntax-case s-exp ()
[(#f form) #'form]
@ -64,6 +74,9 @@
(if (identifier? form)
(unless (or (eq? (syntax-e form) '...)
(eq? (syntax-e form) '...+)
(eq? (syntax-e form) 'code:line)
(eq? (syntax-e form) 'code:blank)
(eq? (syntax-e form) 'code:comment)
(eq? (syntax-e form) '?)
(memq (syntax-e form) lits))
(bound-identifier-mapping-put! ht form #t))
@ -81,7 +94,7 @@
(syntax->list #'(kind ...))
(syntax->list #'(s-exp ...)))
(with-syntax ([(id ...) (bound-identifier-mapping-map ht (lambda (k v) k))])
#'(parameterize ([current-variable-list '(id ...)])
#'(letrec-syntaxes ([(id) (make-variable-id 'id)] ...)
body)))]))
@ -112,7 +125,7 @@
(map (lambda (def)
(let ([exp-def (local-expand
def
'expression
(list (make-deftogether-tag))
(cons
#'with-togetherable-scheme-variables*
(kernel-form-identifier-list)))])

124
collects/scribble/scheme.ss
View File

@ -20,9 +20,11 @@
current-variable-list
current-meta-list
(struct-out var-id)
(struct-out shaped-parens)
(struct-out just-context)
(struct-out literal-syntax))
(struct-out literal-syntax)
(for-syntax make-variable-id))
(define no-color "schemeplain")
(define reader-color "schemereader")
@ -118,57 +120,63 @@
(make-element style content)))
(define (typeset-atom c out color? quote-depth)
(let*-values ([(is-var?) (and (identifier? c)
(memq (syntax-e c) (current-variable-list)))]
[(s it? sub?)
(let ([sc (syntax-e c)])
(let ([s (format "~s" (if (literal-syntax? sc)
(literal-syntax-stx sc)
sc))])
(if (and (symbol? sc)
((string-length s) . > . 1)
(char=? (string-ref s 0) #\_)
(not (or (identifier-label-binding c)
is-var?)))
(values (substring s 1) #t #f)
(values s #f #f))))])
(if (or (element? (syntax-e c))
(delayed-element? (syntax-e c))
(part-relative-element? (syntax-e c)))
(out (syntax-e c) #f)
(out (if (and (identifier? c)
color?
(quote-depth . <= . 0)
(not (or it? is-var?)))
(if (pair? (identifier-label-binding c))
(make-id-element c s)
s)
(literalize-spaces s))
(cond
[(positive? quote-depth) value-color]
[(let ([v (syntax-e c)])
(or (number? v)
(string? v)
(bytes? v)
(char? v)
(regexp? v)
(byte-regexp? v)
(boolean? v)))
value-color]
[(identifier? c)
(cond
[is-var?
variable-color]
[(and (identifier? c)
(memq (syntax-e c) (current-keyword-list)))
keyword-color]
[(and (identifier? c)
(memq (syntax-e c) (current-meta-list)))
meta-color]
[it? variable-color]
[else symbol-color])]
[else paren-color])
(string-length s)))))
(if (var-id? (syntax-e c))
(out (format "~s" (let ([v (var-id-sym (syntax-e c))])
(if (syntax? v)
(syntax-e v)
v)))
variable-color)
(let*-values ([(is-var?) (and (identifier? c)
(memq (syntax-e c) (current-variable-list)))]
[(s it? sub?)
(let ([sc (syntax-e c)])
(let ([s (format "~s" (if (literal-syntax? sc)
(literal-syntax-stx sc)
sc))])
(if (and (symbol? sc)
((string-length s) . > . 1)
(char=? (string-ref s 0) #\_)
(not (or (identifier-label-binding c)
is-var?)))
(values (substring s 1) #t #f)
(values s #f #f))))])
(if (or (element? (syntax-e c))
(delayed-element? (syntax-e c))
(part-relative-element? (syntax-e c)))
(out (syntax-e c) #f)
(out (if (and (identifier? c)
color?
(quote-depth . <= . 0)
(not (or it? is-var?)))
(if (pair? (identifier-label-binding c))
(make-id-element c s)
s)
(literalize-spaces s))
(cond
[(positive? quote-depth) value-color]
[(let ([v (syntax-e c)])
(or (number? v)
(string? v)
(bytes? v)
(char? v)
(regexp? v)
(byte-regexp? v)
(boolean? v)))
value-color]
[(identifier? c)
(cond
[is-var?
variable-color]
[(and (identifier? c)
(memq (syntax-e c) (current-keyword-list)))
keyword-color]
[(and (identifier? c)
(memq (syntax-e c) (current-meta-list)))
meta-color]
[it? variable-color]
[else symbol-color])]
[else paren-color])
(string-length s))))))
(define (gen-typeset c multi-line? prefix1 prefix suffix color?)
(let* ([c (syntax-ize c 0)]
@ -590,6 +598,8 @@
(define ((to-paragraph/prefix pfx1 pfx sfx) c)
(typeset c #t pfx1 pfx sfx #t))
(begin-for-syntax (define-struct variable-id (sym) #:omit-define-syntaxes))
(define-syntax (define-code stx)
(syntax-case stx ()
[(_ code typeset-code uncode d->s stx-prop)
@ -597,6 +607,15 @@
(define-syntax (code stx)
(define (stx->loc-s-expr v)
(cond
[(and (identifier? v)
(variable-id? (syntax-local-value v (lambda () #f))))
`(,#'d->s #f
(,#'make-var-id ',(variable-id-sym (syntax-local-value v)))
#(code
,(syntax-line v)
,(syntax-column v)
,(syntax-position v)
,(syntax-span v)))]
[(syntax? v)
(let ([mk `(,#'d->s
(quote-syntax ,(datum->syntax v 'defcode))
@ -666,6 +685,7 @@
(loop (cons (car r) r) (sub1 i)))))
l))))
(define-struct var-id (sym))
(define-struct shaped-parens (val shape))
(define-struct just-context (val ctx))
(define-struct literal-syntax (stx))

6
collects/scribblings/reference/stx-patterns.scrbl
View File

@ -1,7 +1,7 @@
#lang scribble/doc
@(require "mz.ss")
@(define ellipses (scheme ...))
@(define lit-ellipses (scheme ...))
@title[#:tag "stx-patterns"]{Pattern-Based Syntax Matching}
@ -26,7 +26,7 @@
(stat-pattern ...+ . stat-pattern)
(code:line #,(tt "#")(stat-pattern ...))
const]
[ellipses #,ellipses])]{
[ellipses #,lit-ellipses])]{
Finds the first @scheme[pattern] that matches the syntax object
produced by @scheme[stx-expr], and for which the corresponding
@ -205,7 +205,7 @@ the individual @scheme[stx-expr].}
(code:line #,(tt "#")(stat-template ...))
(code:line #,(tt "#s")(key-datum stat-template ...))
const]
[ellipses #,ellipses])]{
[ellipses #,lit-ellipses])]{
Constructs a syntax object based on a @scheme[template],which can
inlude @tech{pattern variables} bound by @scheme[syntax-case] or

16
collects/scribblings/scribble/manual.scrbl
View File

@ -4,8 +4,8 @@
(for-syntax scheme/base)
(for-label scribble/manual-struct))
@(define ellipses (scheme ...))
@(define ellipses+ (scheme ...+))
@(define lit-ellipses (scheme ...))
@(define lit-ellipses+ (scheme ...+))
@title[#:tag "manual" #:style 'toc]{Manual Forms}
@ -357,8 +357,8 @@ sub-sections.}
(keyword arg-id contract-expr-datum default-expr)
ellipses
ellipses+]
[ellipses #, @ellipses]
[ellipses+ #, @ellipses+])]{
[ellipses #, @lit-ellipses]
[ellipses+ #, @lit-ellipses+])]{
Produces a sequence of flow elements (encapsulated in a
@scheme[splice]) to document a procedure named @scheme[id]. Nesting
@ -393,14 +393,14 @@ Each @scheme[arg-spec] must have one of the following forms:
Like the previous case, but with a default
value.}
@specsubform[#, @ellipses]{Any number of the preceding argument. This
@specsubform[#, @lit-ellipses]{Any number of the preceding argument. This
form is normally used at the end, but keyword-based arguments
can sensibly appear afterward. See also the documentation for
@scheme[append] for a use of @ellipses before the last
@scheme[append] for a use of @lit-ellipses before the last
argument.}
@specsubform[#, @ellipses+]{One or more of the preceding argument
(normally at the end, like @ellipses).}
@specsubform[#, @lit-ellipses+]{One or more of the preceding argument
(normally at the end, like @lit-ellipses).}
The @scheme[result-contract-expr-datum] is typeset via
@scheme[schemeblock0], and it represents a contract on the procedure's

1
collects/scribblings/scribble/reader.scrbl
View File

@ -926,4 +926,5 @@ line counting for the current input-port via @scheme[port-count-lines!].}
@; *** End reader-import section ***
))]))
@with-scribble-read[]