diff --git a/collects/scribble/html-render.ss b/collects/scribble/html-render.ss index f454eeb8ab..54d047d90f 100644 --- a/collects/scribble/html-render.ss +++ b/collects/scribble/html-render.ss @@ -279,7 +279,7 @@ (content->string (part-title-content d) this d ht)) "_"))]) - (when ((string-length fn) . >= . 100) + (when ((string-length fn) . >= . 48) (error "file name too long (need a tag):" fn)) fn)) diff --git a/collects/scribble/latex-render.ss b/collects/scribble/latex-render.ss index 00e7a5945c..af317dbd06 100644 --- a/collects/scribble/latex-render.ss +++ b/collects/scribble/latex-render.ss @@ -87,8 +87,9 @@ "")) (render-content (part-title-content d) d ht) (printf "}")) + #; (when (part-tag d) - (printf "\\label{section:~a}" (part-tag d))) + (printf "\\label{section:~a}" (protect-tag (part-tag d)))) (render-flow (part-flow d) d ht) (for-each (lambda (sec) (render-part sec ht)) (part-parts d)) diff --git a/collects/scribble/manual.ss b/collects/scribble/manual.ss index bf95ec17aa..b39e6a5c9f 100644 --- a/collects/scribble/manual.ss +++ b/collects/scribble/manual.ss @@ -374,7 +374,21 @@ dots1] [(eq? v '...) dots0] - [else v]))]) + [else v]))] + [prototype-size (lambda (s) + (let loop ([s s]) + (if (null? s) + 1 + (+ 1 (loop (cdr s)) + (cond + [(symbol? (car s)) (string-length (symbol->string (car s)))] + [(pair? (car s)) + (if (keyword? (caar s)) + (+ (string-length (keyword->string (caar s))) + 3 + (string-length (symbol->string (cadar s)))) + (string-length (symbol->string (caar s))))] + [else 0])))))]) (parameterize ([current-variable-list (map (lambda (i) (and (pair? i) @@ -393,43 +407,98 @@ (append (list (list (make-flow - (make-table-if-necessary - "prototype" - (list - (list - (to-flow - (let-values ([(required optional more-required) - (let loop ([a (cdr prototype)][r-accum null]) - (if (or (null? a) - (and (has-optional? (car a)))) - (let ([req (reverse r-accum)]) - (let loop ([a a][o-accum null]) - (if (or (null? a) - (not (has-optional? (car a)))) - (values req (reverse o-accum) a) - (loop (cdr a) (cons (car a) o-accum))))) - (loop (cdr a) (cons (car a) r-accum))))]) - (to-element (append - (list (if first? - (make-target-element - #f - (list (to-element (car prototype))) - (register-scheme-definition stx-id)) - (to-element (car prototype)))) - (map arg->elem required) - (if (null? optional) - null - (list - (to-element - (syntax-property - (syntax-ize (map arg->elem optional) 0) - 'paren-shape - #\?)))) - (map arg->elem more-required))))) - (to-flow spacer) - (to-flow 'rarr) - (to-flow spacer) - (make-flow (list (result-contract))))))))) + (let-values ([(required optional more-required) + (let loop ([a (cdr prototype)][r-accum null]) + (if (or (null? a) + (and (has-optional? (car a)))) + (let ([req (reverse r-accum)]) + (let loop ([a a][o-accum null]) + (if (or (null? a) + (not (has-optional? (car a)))) + (values req (reverse o-accum) a) + (loop (cdr a) (cons (car a) o-accum))))) + (loop (cdr a) (cons (car a) r-accum))))] + [(tagged) (if first? + (make-target-element + #f + (list (to-element (make-just-context (car prototype) + stx-id))) + (register-scheme-definition stx-id)) + (to-element (make-just-context (car prototype) + stx-id)))] + [(short?) (or ((prototype-size prototype) . < . 40) + ((length prototype) . < . 3))] + [(end) (list (to-flow spacer) + (to-flow 'rarr) + (to-flow spacer) + (make-flow (list (result-contract))))]) + (if short? + (make-table-if-necessary + "prototype" + (list + (cons + (to-flow + (to-element (append + (list tagged) + (map arg->elem required) + (if (null? optional) + null + (list + (to-element + (syntax-property + (syntax-ize (map arg->elem optional) 0) + 'paren-shape + #\?)))) + (map arg->elem more-required)))) + end))) + (let ([not-end + (list (to-flow spacer) + (to-flow spacer) + (to-flow spacer) + (to-flow spacer))]) + (list + (make-table + "prototype" + (cons + (list* (to-flow (make-element + #f + (list + (schemeparenfont "(") + tagged))) + (cond + [(null? required) + (to-flow (make-element #f (list spacer "[")))] + [else + (to-flow spacer)]) + (to-flow + (if (null? required) + (arg->elem (car optional)) + (arg->elem (car required)))) + not-end) + (let loop ([args (cdr (append required optional))] + [req (sub1 (length required))]) + (if (null? args) + null + (cons (list* (to-flow spacer) + (if (zero? req) + (to-flow (make-element #f (list spacer "["))) + (to-flow spacer)) + (let ([a (arg->elem (car args))]) + (to-flow + (cond + [(null? (cdr args)) + (if (null? optional) + (make-element + #f + (list a (schemeparenfont ")"))) + (make-element + #f + (list a "]" (schemeparenfont ")"))))] + [else a]))) + (if (null? (cdr args)) + end + not-end)) + (loop (cdr args) (sub1 req)))))))))))))) (apply append (map (lambda (v arg-contract) (cond diff --git a/collects/scribble/scribble.css b/collects/scribble/scribble.css index 77e65b9560..1e841947e3 100644 --- a/collects/scribble/scribble.css +++ b/collects/scribble/scribble.css @@ -154,6 +154,9 @@ .prototype td { vertical-align: top; } + .longprototype td { + vertical-align: bottom; + } .schemeblock td { vertical-align: baseline; diff --git a/collects/scribblings/reference/define-struct.scrbl b/collects/scribblings/reference/define-struct.scrbl index 39465f1c7a..f835c29910 100644 --- a/collects/scribblings/reference/define-struct.scrbl +++ b/collects/scribblings/reference/define-struct.scrbl @@ -1,7 +1,7 @@ #reader(lib "docreader.ss" "scribble") @require["mz.ss"] -@title{Structure Types: @scheme[define-struct]} +@title[#:tag "mz:define-struct"]{Structure Types: @scheme[define-struct]} @defform/subs[(define-struct id-maybe-super (field ...) struct-option ...) diff --git a/collects/scribblings/reference/derived.scrbl b/collects/scribblings/reference/derived.scrbl index 9ec95f486d..10b08980fe 100644 --- a/collects/scribblings/reference/derived.scrbl +++ b/collects/scribblings/reference/derived.scrbl @@ -66,7 +66,7 @@ returned as the result of the @scheme[cond] form. The ]} @;------------------------------------------------------------------------ -@section{Boolean Combination: @scheme[and] and @scheme[or]} +@section[#:tag "mz:and+or"]{Boolean Combination: @scheme[and] and @scheme[or]} @defform[(and expr ...)]{ @@ -114,7 +114,7 @@ position with respect to the original @scheme[or] form. @;------------------------------------------------------------------------ -@section{Guarded Evaluation: @scheme[when] and @scheme[unless]} +@section[#:tag "mz:when+unless"]{Guarded Evaluation: @scheme[when] and @scheme[unless]} @defform[(when test-expr expr ...)]{ diff --git a/collects/scribblings/reference/struct.scrbl b/collects/scribblings/reference/struct.scrbl index 6b77c1274d..f926822151 100644 --- a/collects/scribblings/reference/struct.scrbl +++ b/collects/scribblings/reference/struct.scrbl @@ -44,7 +44,16 @@ accessed with subtype-specific selectors. Subtype-specific @tech{accessors} and @tech{mutators} for the first @math{m} fields do not exist. -@section{Creating Structure Types} +@index['("structures" "equality")]{Two} structure values are +@scheme[eqv?] if and only if they are @scheme[eq?]. Two structure +values are @scheme[equal?] if they are @scheme[eq?], or if they are +instances of the same structure type, no fields are opaque, and the +results of applying @scheme[struct->vector] to the structs are +@scheme[equal?]. (Consequently, @scheme[equal?] testing for structures +depends on the current inspector.) + +@;------------------------------------------------------------------------ +@section[#:tag "mz:creatingmorestructs"]{Creating Structure Types} @defproc[(make-struct-type [name symbol?] [super-type (or/c struct-type? false/c)] @@ -63,7 +72,12 @@ not exist. [immutables (listof non-negative-exact-integer?) null] [guard (or/c procedure? false/c) #f]) - struct-type?]{ + (values + struct-type? + struct-constructor-procedure? + struct-predicate-procedure? + struct-accessor-procedure? + struct-mutator-procedure?)]{ Creates a new structure type. The @scheme[name] argument is used as the type name. If @scheme[super-type] is not @scheme[#f], the new type @@ -98,23 +112,23 @@ positions. Each element in the list must be unique, otherwise @scheme[0] (inclusive) to @scheme[init-field-k] (exclusive), otherwise @exnraise[exn:fail:contract]. -The @scheme[guard-proc] argument is either a procedure of @math{n} +The @scheme[guard] argument is either a procedure of @math{n} arguments or @scheme[#f], where @math{n} is the number of arguments for the new structure type's constructor (i.e., @scheme[init-field-k] plus constructor arguments implied by @scheme[super-type], if any). If -@scheme[guard-proc] is a procedure, then the procedure is called +@scheme[guard] is a procedure, then the procedure is called whenever an instance of the type is constructed, or whenever an instance of a subtype is created. The arguments to -@scheme[guard-proc] are the values provided for the structure's first +@scheme[guard] are the values provided for the structure's first @math{n} fields, followed by the name of the instantiated structure type (which is @scheme[name], unless a subtype is instantiated). The -@scheme[guard-proc] result must be @math{n} values, which become the -actual values for the structure's fields. The @scheme[guard-proc] can +@scheme[guard] result must be @math{n} values, which become the +actual values for the structure's fields. The @scheme[guard] can raise an exception to prevent creation of a structure with the given field values. If a structure subtype has its own guard, the subtype guard is applied first, and the first @math{n} values produced by the subtype's guard procedure become the first @math{n} arguments to -@scheme[guard-proc]. +@scheme[guard]. The result of @scheme[make-struct-type] is five values: % @@ -155,19 +169,20 @@ The result of @scheme[make-struct-type] is five values: (b-ref a-b 2) (define-values (struct:c make-c c? c-ref c-set!) - (make-struct-type 'c struct:b 0 0 #f null (make-inspector) #f null - (code:comment #,(t "guard checks for a number, and makes it inexact")) - (lambda (a1 a2 b1 name) - (unless (number? a2) - (error (string->symbol (format "make-~a" name)) - "second field must be a number")) - (values a1 (exact->inexact a2) b1)))) + (make-struct-type + 'c struct:b 0 0 #f null (make-inspector) #f null + (code:comment #,(t "guard checks for a number, and makes it inexact")) + (lambda (a1 a2 b1 name) + (unless (number? a2) + (error (string->symbol (format "make-~a" name)) + "second field must be a number")) + (values a1 (exact->inexact a2) b1)))) (make-c 'x 'y 'z) (define a-c (make-c 'x 2 'z)) (a-ref a-c 1) ]} -@defproc[(make-struct-field-accessor [accessor-proc procedure?] +@defproc[(make-struct-field-accessor [accessor-proc struct-accessot-procedure?] [field-pos-k exact-nonnegative-integer?] [field-name symbol?]) procedure?]{ @@ -181,7 +196,7 @@ structure type. For examples, see @scheme[make-struct-type].} -@defproc[(make-struct-field-mutator [mutator-proc procedure?] +@defproc[(make-struct-field-mutator [mutator-proc struct-mutator-procedure?] [field-pos-k exact-nonnegative-integer?] [field-name symbol?]) procedure?]{ @@ -194,3 +209,248 @@ resulting procedure for debugging purposes is derived from structure type. For examples, see @scheme[make-struct-type].} + + +@;------------------------------------------------------------------------ +@section[#:tag "mz:structprops"]{Structure Type Properties} + +A @index['("structure type properties")]{@defterm{structure type + property}} allows per-type information to be associated with a + structure type (as opposed to per-instance information associated + with a structure value). A property value is associated with a + structure type through the @scheme[make-struct-type] procedure (see + @secref["mz:creatingmorestructs"]) or through the @scheme[#:property] + option of @scheme[define-struct]. Subtypes inherit the property + values of their parent types, and subtypes can override an inherited + property value with a new value. + +@defproc[(make-struct-type-property [name symbol?] + [guard (or/c procedure? false/c) #f]) + (values + struct-type-property? + procedure? + procedure?)]{ + + Creates a new structure type property and returns three values: + +@itemize{ + + @item{a @deftech{structure property type descriptor}, for use with + @scheme[make-struct-type] and @scheme[define-struct];} + + @item{a @deftech{property predicate} procedure, which takes an + arbitrary value and returns @scheme[#t] if the value is a + descriptor or instance of a structure type that has a value for + the property, @scheme[#f] otherwise;} + + @item{an @deftech{property accessor} procedure, which returns the + value associated with structure type given its descriptor or + one of its instances; if the structure type does not have a + value for the property, or if any other kind of value is + provided, the @exnraise[exn:fail:contract].} + +} + +If the optional @scheme[guard] is supplied as a procedure, it is +called by @scheme[make-struct-type] before attaching the property to a +new structure type. The @scheme[guard-proc] must accept two arguments: +a value for the property supplied to @scheme[make-struct-type], and a +list containing information about the new structure type. The list +contains the values that @scheme[struct-type-info] would return for +the new structure type if it skipped the immediate current-inspector +control check (but not the check for exposing an ancestor structure +type, if any; see @secref["mz:inspectors"]). + +The result of calling @scheme[guard] is associated with the property +in the target structure type, instead of the value supplied to +@scheme[make-struct-type]. To reject a property association (e.g., +because the value supplied to @scheme[make-struct-type] is +inappropriate for the property), the @scheme[guard] can raise an +exception. Such an exception prevents @scheme[make-struct-type] from +returning a structure type descriptor. + +@examples[ +(define-values (prop:p p? p-ref) (make-struct-type-property 'p)) + +(define-values (struct:a make-a a? a-ref a-set!) + (make-struct-type 'a #f 2 1 'uninitialized + (list (cons prop:p 8)))) +(p? struct:a) +(p? 13) +(define an-a (make-a 'x 'y)) +(p? an-a) +(p-ref an-a) + +(define-values (struct:b make-b b? b-ref b-set!) + (make-struct-type 'b #f 0 0 #f)) +(p? struct:b) +]} + +@defproc[(struct-type-property? [v any/c]) boolean?]{ + +Returns @scheme[#t] if @scheme[v] is a @tech{structure type property +descriptor} value, @scheme[#f] otherwise. + +} + +@;------------------------------------------------------------------------ +@section[#:tag "mz:inspectors"]{Structure Inspectors} + +An @pidefterm{inspector} provides access to structure fields and +structure type information without the normal field accessors and +mutators. (Inspectors are also used to control access to module +bindings; see @secref["mz:modprotect"].) Inspectors are primarily +intended for use by debuggers. + +When a structure type is created, an inspector can be supplied. The +given inspector is not the one that will control the new structure +type; instead, the given inspector's parent will control the type. By +using the parent of the given inspector, the structure type remains +opaque to ``peer'' code that cannot access the parent inspector. + +The @scheme[current-inspector] @tech{parameter} determines a default +inspector argument for new structure types. An alternate inspector can +be provided though the @scheme[#:inspector] option of the +@scheme[define-struct] form (see @secref["mz:define-struct"]), or +through an optional @scheme[inspector] argument to +@scheme[make-struct-type] (see @secref["mz:creatingmorestructs"]). + +@defproc[(make-inspector [inspector inspector? (current-inspector)]) + inspector?]{ + +Returns a new inspector that is a subinspector of +@scheme[inspector]. Any structure type controlled by the new inspector +is also controlled by its ancestor inspectors, but no other +inspectors.} + +@defproc[(inspector? [v any/c]) boolean?]{Returns @scheme[#t] if +@scheme[v] is an inspector, @scheme[#f] otherwise.} + +@defproc[(struct-info [v any/c]) + (values (or/c struct-type? false/c) + boolean?)]{ + +Returns two values: + +@itemize{ + + @item{@scheme[struct-type]: a structure type descriptor or @scheme[#f]; + the result is a structure type descriptor of the most specific type + for which @scheme[v] is an instance, and for which the current + inspector has control, or the result is @scheme[#f] if the current + inspector does not control any structure type for which the + @scheme[struct] is an instance.} + + @item{@scheme[skipped?]: @scheme[#f] if the first result corresponds to + the most specific structure type of @scheme[v], @scheme[#t] otherwise.} + +}} + +@defproc[(struct-type-info [struct-type struct-type?]) + (values + symbol? + nonnegative-exact-integer? + nonnegative-exact-integer? + struct-accessor-procedure? + struct-mutator-procedure? + (listof nonnegative-exact-integer?) + (or/c struct-type? false/c) + boolean?)]{ + +Returns eight values that provide information about the structure type + descriptor @scheme[struct-type], assuming that the type is controlled + by the current inspector: + + @itemize{ + + @item{@scheme[name]: the structure type's name as a symbol;} + + @item{@scheme[init-field-k]: the number of fields defined by the + structure type provided to the constructor procedure (not counting + fields created by its ancestor types);} + + @item{@scheme[auto-field-k]: the number of fields defined by the + structure type without a counterpart in the constructor procedure + (not counting fields created by its ancestor types);} + + @item{@scheme[accessor-proc]: an accessor procedure for the structure + type, like the one returned by @scheme[make-struct-type];} + + @item{@scheme[mutator-proc]: a mutator procedure for the structure + type, like the one returned by @scheme[make-struct-type];} + + @item{@scheme[immutable-k-list]: an immutable list of exact + non-negative integers that correspond to immutable fields for the + structure type;} + + @item{@scheme[super-type]: a structure type descriptor for the + most specific ancestor of the type that is controlled by the + current inspector, or @scheme[#f] if no ancestor is controlled by + the current inspector;} + + @item{@scheme[skipped?]: @scheme[#f] if the seventh result is the + most specific ancestor type or if the type has no supertype, + @scheme[#t] otherwise.} + +} + +If the type for @scheme[struct-type] is not controlled by the current inspector, +the @exnraise[exn:fail:contract].} + +@defproc[(struct-type-make-constructor [struct-type struct-type?]) + struct-constructor-procedure?]{ + +Returns a @tech{constructor} procedure to create instances of the type +for @scheme[struct-type]. If the type for @scheme[struct-type] is not +controlled by the current inspector, the +@exnraise[exn:fail:contract].} + +@defproc[(struct-type-make-predicate [struct-type any/c]) any]{ + +Returns a @tech{predicate} procedure to recognize instances of the +type for @scheme[struct-type]. If the type for @scheme[struct-type] +is not controlled by the current inspector, the +@exnraise[exn:fail:contract].} + +@;------------------------------------------------------------------------ +@section[#:tag "mz:structutils"]{Structure Utilities} + +@defproc[(struct->vector [v any/c] [opaque-v any/c '...]) vector?]{ + +Creates a vector representing @scheme[v]. The first slot of the +result vector contains a symbol whose printed name has the form +@schemeidfont{struct:}@scheme[_id]. Each remaining slot contains +either the value of a field in @scheme[v], if it is accessible via the +current inspector, or @scheme[opaque-v] for a field that is not +accessible. A single @scheme[opaque-v] value is used in the vector for +contiguous inaccessible fields. (Consequently, the size of the vector +does not match the size of the @scheme[struct] if more than one field +is inaccessible.)} + +@defproc[(struct? [v any/c]) any]{ Returns @scheme[#t] if + @scheme[struct->vector] exposes any fields of @scheme[v] with the + current inspector, @scheme[#f] otherwise.} + +@defproc[(struct-type? [v any/c]) boolean?]{Returns @scheme[#t] if + @scheme[v] is a structure type descriptor value, @scheme[#f] + otherwise.} + +@defproc[(struct-constructor-procedure? [v any/c]) boolean?]{Returns + @scheme[#t] if @scheme[v] is a constructor procedure generated by + @scheme[define-struct] or @scheme[make-struct-type], @scheme[#f] + otherwise.} + +@defproc[(struct-predicate-procedure? [v any/c]) boolean?]{Returns + @scheme[#t] if @scheme[v] is a predicate procedure generated by + @scheme[define-struct] or @scheme[make-struct-type], @scheme[#f] + otherwise.} + +@defproc[(struct-accessor-procedure? [v any/c]) boolean?]{Returns + @scheme[#t] if @scheme[v] is an accessor procedure generated by + @scheme[define-struct], @scheme[make-struct-type], or + @scheme[make-struct-field-accessor], @scheme[#f] otherwise.} + +@defproc[(struct-mutator-procedure? [v any/c]) boolean?] {Returns + @scheme[#t] if @scheme[v] is a mutator procedure generated by + @scheme[define-struct], @scheme[make-struct-type], or + @scheme[make-struct-field-mutator], @scheme[#f] otherwise.} diff --git a/collects/scribblings/reference/syntax.scrbl b/collects/scribblings/reference/syntax.scrbl index 55f61c113e..fc20ead8e2 100644 --- a/collects/scribblings/reference/syntax.scrbl +++ b/collects/scribblings/reference/syntax.scrbl @@ -51,7 +51,7 @@ Within such specifications, }} } @;------------------------------------------------------------------------ -@section{Literals: @scheme[quote] and @scheme[#%datum]} +@section[#:tag "mz:quote"]{Literals: @scheme[quote] and @scheme[#%datum]} @defform[(quote datum)]{ @@ -79,7 +79,7 @@ identifiers. } @;------------------------------------------------------------------------ -@section{Expression Wrapper: @scheme[#%expression]} +@section[#:tag "mz:#%expression"]{Expression Wrapper: @scheme[#%expression]} @defform[(#%expression expr)]{ @@ -93,7 +93,7 @@ expression. ]} @;------------------------------------------------------------------------ -@section{Variable References and @scheme[#%top]} +@section[#:tag "mz:#%top"]{Variable References and @scheme[#%top]} @defform/none[id]{ @@ -546,7 +546,7 @@ z } @;------------------------------------------------------------------------ -@section{Sequencing: @scheme[begin] and @scheme[begin0]} +@section[#:tag "mz:begin"]{Sequencing: @scheme[begin] and @scheme[begin0]} @defform*[[(begin form ...) (begin expr ...+)]]{ @@ -590,7 +590,7 @@ in tail position only if no @scheme[body]s are present. ]} @;------------------------------------------------------------------------ -@section{Assignment: @scheme[set!] and @scheme[set!-values]} +@section[#:tag "mz:set!"]{Assignment: @scheme[set!] and @scheme[set!-values]} @defform[(set! id expr)]{ @@ -626,7 +626,7 @@ corresponding value from @scheme[expr] in the same way as for @;------------------------------------------------------------------------ -@section{Continuation Marks: @scheme[with-continuation-mark]} +@section[#:tag "mz:wcm"]{Continuation Marks: @scheme[with-continuation-mark]} @defform[(with-continuation-mark key-expr val-expr result-expr)]{ Evaluates @scheme[key-expr] and @scheme[val-expr] in order to obtain a key and @@ -766,7 +766,7 @@ and @secref["mz:mod-parse"]). } @;------------------------------------------------------------------------ -@section{Exporting: @scheme[provide] and @scheme[provide-for-syntax]} +@section[#:tag "mz:provide"]{Exporting: @scheme[provide] and @scheme[provide-for-syntax]} @defform/subs[#:literals (protect all-defined all-from rename except prefix) (provide protected-provide-spec ...)