From 460c6323e068cb379c9f8c21cb5a4a98474cbe40 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 8 Feb 2014 09:46:44 -0700 Subject: [PATCH] scribble/text: add `outputable/c` and contract checks The `outputable/c` contract is currently just an alias for `any/c`, however, because checking the contract seems to be too expensive. original commit: 416b680d742afafe7f5632ca94cb36bac25534b8 --- .../scribblings/scribble/html.scrbl | 34 +++++++-------- .../scribblings/scribble/text.scrbl | 29 +++++++++---- pkgs/scribble-pkgs/scribble-text-lib/info.rkt | 2 + .../scribble/text/output.rkt | 43 +++++++++++++++---- 4 files changed, 73 insertions(+), 35 deletions(-) diff --git a/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/html.scrbl b/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/html.scrbl index a3465fea..2f756b05 100644 --- a/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/html.scrbl +++ b/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/html.scrbl @@ -67,7 +67,7 @@ Produces a value that @tech{XML-renders} as a DOCTYPE declaration. (xml->string (doctype 'xhtml)))]} -@defproc[(xhtml [content any/c] ...) procedure?]{ +@defproc[(xhtml [content outputable/c] ...) procedure?]{ Produces a value that @tech{XML-renders} as the given content wrapped as XHTML. @@ -78,7 +78,7 @@ as XHTML. @(define-syntax-rule (def-tags tag ...) @deftogether[( - @defproc[(tag [v any/c] (... ...)) procedure?] ... + @defproc[(tag [v outputable/c] (... ...)) procedure?] ... )]{ Like @racket[element/not-empty], but with the symbolic form of the function @@ -169,7 +169,7 @@ as XHTML. @(define-syntax-rule (def-tags/empty tag ...) @deftogether[( - @defproc[(tag [v any/c] (... ...)) procedure?] ... + @defproc[(tag [v outputable/c] (... ...)) procedure?] ... )]{ Like @racket[element], but with the symbolic form of the function @@ -196,7 +196,7 @@ as XHTML. lang rang dagger Dagger plusmn deg) -@defproc[(script/inline [v any/c] ...) procedure?]{ +@defproc[(script/inline [v outputable/c] ...) procedure?]{ Procedures a value that renders as an inline script. @@ -204,7 +204,7 @@ Procedures a value that renders as an inline script. (output-xml (script/inline type: "text/javascript" "var x = 5;"))]} -@defproc[(style/inline [v any/c] ...) procedure?]{ +@defproc[(style/inline [v outputable/c] ...) procedure?]{ Procedures a value that renders as an inline style sheet. @@ -222,7 +222,7 @@ provides functions for XML representations that @deftech{XML-render} to string f via @racket[output-xml] or @racket[xml->string].} -@defproc[(output-xml [content any/c] [port output-port? (current-output-port)]) +@defproc[(output-xml [content outputable/c] [port output-port? (current-output-port)]) void?]{ Renders @racket[content] in the same way as @racket[output], but using @@ -230,7 +230,7 @@ the value of @racket[xml-writer] as the @tech{current writer} so that special characters are escaped as needed.} -@defproc[(xml->string [content any/c]) string?]{ +@defproc[(xml->string [content outputable/c]) string?]{ Renders @racket[content] to a string via @racket[output-xml].} @@ -243,9 +243,9 @@ A parameter for a function that is used with @racket[with-writer] by @defproc[(make-element [tag symbol?] - [attrs (listof (cons/c symbol? any/c))] - [content any/c]) - procedure?]{ + [attrs (listof (cons/c symbol? outputable/c))] + [content outputable/c]) + (and/c procedure outputable/c?)]{ Produces a value that @tech{XML-renders} as XML for the given tag, attributes, and content. @@ -262,7 +262,7 @@ rendered as present, but without a value. @defproc[(element [tag symbol?] [attrs-and-content any/c] ...) - procedure?]{ + (and procedure outputable/c?)]{ Like @racket[make-element], but the list of @racket[attrs-and-content] is parsed via @racket[attributes+body] to separate the attributes and @@ -278,7 +278,7 @@ content. @defproc[(element/not-empty [tag symbol?] [attrs-and-content any/c] ...) - procedure?]{ + (and/c procedure? outputable/c)]{ Like @racket[element], but the result always renders with an separate closing tag. @@ -342,7 +342,7 @@ symbolic entity. (output-xml (entity 'gt))]} -@defproc[(comment [content any/c] ... [#:newlines? newlines? any/c #f]) +@defproc[(comment [content outputable/c] ... [#:newlines? newlines? any/c #f]) procedure?]{ Produces a value that @tech{XML-renders} as a comment with @@ -353,7 +353,7 @@ inserted before and after the content. (output-xml (comment "testing" 1 2 3))]} -@defproc[(cdata [content any/c] ... +@defproc[(cdata [content outputable/c] ... [#:newlines? newlines? any/c #t] [#:line-pfx line-pfx any/c #f]) procedure?]{ @@ -395,7 +395,7 @@ result of @racket[(entity '_entity-id)].} [renderer (or/c (path-string? . -> . any) #f)] [#:exists exists (or/c 'delete-file #f) 'delete-file]) (and/c resource? - (->* () (any/c) -> string?))]{ + (->* () (outputable/c) -> string?))]{ Creates and returns a new @deftech{resource} value. Creating a resource registers @racket[renderer] (if non-@racket[#f]) to be called when rendering is @@ -473,8 +473,8 @@ arguments) produced by @racket[resource].} Generates all resources registered via @racket[resource].} -@defproc[(file-writer [content-writer (any/c output-port? . -> . any)] - [content any/c]) +@defproc[(file-writer [content-writer (outputable/c output-port? . -> . any)] + [content outputable/c]) (path-string? . -> . any)]{ Produces a function that is useful as a @racket[_writer] argument to diff --git a/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/text.scrbl b/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/text.scrbl index 118ed0e9..546ac975 100644 --- a/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/text.scrbl +++ b/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/text.scrbl @@ -1220,7 +1220,15 @@ Racket-with-@"@"-expressions file as shown above.) @;-------------------------------------------------------------------- @section{Text Generation Functions} -@defproc[(output [v any/c] [port output-port? (current-output-port)]) void?]{ +@defthing[outputable/c contract?]{ + +A contract that (in principle) corresponds to value that can be output +by @racket[output]. Currently, however, this contract accepts all +values (to avoid the cost of checking at every boundary). + +@history[#:added "1.1"]} + +@defproc[(output [v outputable/c] [port output-port? (current-output-port)]) void?]{ Outputs values to @racket[port] as follows for each kind of @racket[v]: @@ -1283,19 +1291,19 @@ Outputs values to @racket[port] as follows for each kind of @racket[v]: Any other kind of @racket[v] triggers an exception.} -@defproc[(block [v any/c] ...) any/c]{ +@defproc[(block [v outputable/c] ...) outputable/c]{ Produces a value that outputs each @racket[v] in @tech{block mode}.} -@defproc[(splice [v any/c] ...) any/c]{ +@defproc[(splice [v outputable/c] ...) outputable/c]{ Produces a value that outputs each @racket[v] in @tech{splice mode}.} @deftogether[( -@defproc[(disable-prefix [v any/c] ...) any/c] -@defproc[(restore-prefix [v any/c] ...) any/c] -@defproc[(add-prefix [pfx (or/c string? exact-nonnegative-integer?)] [v any/c] ...) any/c] -@defproc[(set-prefix [pfx (or/c string? exact-nonnegative-integer?)] [v any/c] ...) any/c] +@defproc[(disable-prefix [v outputable/c] ...) outputable/c] +@defproc[(restore-prefix [v outputable/c] ...) outputable/c] +@defproc[(add-prefix [pfx (or/c string? exact-nonnegative-integer?)] [v outputable/c] ...) outputable/c] +@defproc[(set-prefix [pfx (or/c string? exact-nonnegative-integer?)] [v outputable/c] ...) outputable/c] )]{ Produces a value that outputs with an adjusted @tech{current prefix}. @@ -1308,9 +1316,12 @@ characters.} A value that outputs as the @tech{current indentation} plus @tech{current prefix}.} -@defproc[(with-writer [writer (string? . -> . any/c)] [v any/c] ...) any/c]{ +@defproc[(with-writer [writer (or/c (string? output-port? . -> . any/c) #f)] + [v outputable/c] ...) + outputable/c]{ -Produces a value that outputs with an adjusted @tech{current writer}.} +Produces a value that outputs with an adjusted @tech{current writer}, +where @racket[#f] indicates @racket[write-string].} @defproc[(add-newlines [items list?] [#:sep sep an/y "\n"]) list?]{ diff --git a/pkgs/scribble-pkgs/scribble-text-lib/info.rkt b/pkgs/scribble-pkgs/scribble-text-lib/info.rkt index e06f3d78..d75dabcc 100644 --- a/pkgs/scribble-pkgs/scribble-text-lib/info.rkt +++ b/pkgs/scribble-pkgs/scribble-text-lib/info.rkt @@ -8,3 +8,5 @@ (define pkg-desc "Language for text with embedded Racket code") (define pkg-authors '(mflatt eli)) + +(define version "1.1") diff --git a/pkgs/scribble-pkgs/scribble-text-lib/scribble/text/output.rkt b/pkgs/scribble-pkgs/scribble-text-lib/scribble/text/output.rkt index ce81e354..f01646d7 100644 --- a/pkgs/scribble-pkgs/scribble-text-lib/scribble/text/output.rkt +++ b/pkgs/scribble-pkgs/scribble-text-lib/scribble/text/output.rkt @@ -1,8 +1,12 @@ #lang racket/base +(require racket/promise + racket/contract/base) -(require racket/promise) - -(provide output) +(provide + outputable/c + (contract-out + [output (->* (outputable/c) (output-port?) void?)])) +;; See also `provide-special` below ;; Outputs values for the `scribble/text' language: ;; - several atomic values are printed as in `display', @@ -251,11 +255,11 @@ (define-syntax define/provide-special (syntax-rules () [(_ (name)) - (begin (provide name) + (begin (provide (contract-out [name (->* () () #:rest (listof outputable/c) any/c)])) (define (name . contents) (make-special 'name contents)))] - [(_ (name x ...)) - (begin (provide name) + [(_ (name [x ctc] ...)) + (begin (provide (contract-out [name (->* (ctc ...) () #:rest (listof outputable/c) any/c)])) (define (name x ... . contents) (make-special 'name (list* x ... contents))))] [(_ name) @@ -267,9 +271,9 @@ (define/provide-special flush) (define/provide-special (disable-prefix)) (define/provide-special (restore-prefix)) -(define/provide-special (add-prefix pfx)) -(define/provide-special (set-prefix pfx)) -(define/provide-special (with-writer writer)) +(define/provide-special (add-prefix [pfx (or/c string? exact-nonnegative-integer?)])) +(define/provide-special (set-prefix [pfx (or/c string? exact-nonnegative-integer?)])) +(define/provide-special (with-writer [writer (or/c #f (string? output-port? . -> . any/c))])) #; ; no need for this hack yet (define/provide-special (with-writer-change writer)) @@ -302,3 +306,24 @@ [(null? list) (reverse (cons (reverse cur) r))] [(equal? "\n" (car list)) (loop (cdr list) '() (cons (reverse cur) r))] [else (loop (cdr list) (cons (car list) cur) r)]))) + +(define outputable/c + (lambda (v) #t) + ;; too expensive: + #; + (recursive-contract + (or/c void? + #f + null? + (cons/c outputable/c outputable/c) + (-> outputable/c) + promise? + (box/c outputable/c) + special? + string? + bytes? + symbol? + path? + keyword? + number? + char?)))