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

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))]
+                       [attrs (listof (cons/c symbol? outputable/c))]
-                       [content any/c])
+                       [content outputable/c])
-         procedure?]{
+         (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)]
+@defproc[(file-writer [content-writer (outputable/c output-port? . -> . any)]
-                      [content any/c])
+                      [content outputable/c])
          (path-string? . -> . any)]{
 
 Produces a function that is useful as a @racket[_writer] argument to

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[(disable-prefix [v outputable/c] ...) outputable/c]
-@defproc[(restore-prefix [v any/c] ...) any/c]
+@defproc[(restore-prefix [v outputable/c] ...) outputable/c]
-@defproc[(add-prefix [pfx (or/c string? exact-nonnegative-integer?)] [v any/c] ...) any/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 any/c] ...) any/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?]{

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

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
-
+ outputable/c
-(provide output)
+ (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 ...))
+    [(_ (name [x ctc] ...))
-     (begin (provide name)
+     (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 (add-prefix [pfx (or/c string? exact-nonnegative-integer?)]))
-(define/provide-special (set-prefix pfx))
+(define/provide-special (set-prefix [pfx (or/c string? exact-nonnegative-integer?)]))
-(define/provide-special (with-writer writer))
+(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?)))