Added #:value keyword to defproc', defparam', `defthing' and related

Also fixed `defproc*' example

original commit: 9ca8c71aadebf741c6ac799b7b78ecf2113d4b16

pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/manual.scrbl

@@ -766,6 +766,7 @@ Equivalent to @racket[defmodule] variants @racket[#:no-declare].}
 
 @defform/subs[(defproc options prototype
                        result-contract-expr-datum
+                       maybe-value
                        pre-flow ...)
               ([prototype (id arg-spec ...)
                           (prototype arg-spec ...)]
@@ -782,6 +783,8 @@ Equivalent to @racket[defmodule] variants @racket[#:no-declare].}
                            (code:line #:link-target? link-target?-expr)]
                [maybe-id code:blank
                          (code:line #:id [src-id dest-id-expr])]
+               [maybe-value code:blank
+                            (code:line #:value value-expr-datum)]
                [ellipses @#,lit-ellipses]
                [ellipses+ @#,lit-ellipses+])]{
 
@@ -895,11 +898,17 @@ If @racket[#:id [src-id dest-id-expr]] is supplied, then
 place of @racket[src-id]. This split between @racket[src-id] and
 @racket[dest-id-expr] roles is useful for functional abstraction of
 @racket[defproc].
+
+If @racket[#:value value-expr-datum] is given, @racket[value-expr-datum]
+is typeset using @racket[racketblock0] and included in the documentation.
+As a service to readers, please use @racket[#:value] to document only
+simple, short functions.
 }
 
 @defform[(defproc* options
                    ([prototype
-                     result-contract-expr-datum] ...)
+                     result-contract-expr-datum
+                     maybe-value] ...)
                    pre-flow ...)]{
 
 Like @racket[defproc], but for multiple cases with the same
@@ -916,9 +925,8 @@ should use @racket[#:link-target? #f].
 Examples:
 @codeblock[#:keep-lang-line? #f]|{
 #lang scribble/manual
-@defproc[((make-pb&j)
+@defproc*[([(make-pb&j) sandwich?]
-          (make-pb&j [jelly jelly?]))
+           [(make-pb&j [jelly jelly?]) sandwich?])]{
-         sandwich?]{
   Returns a peanut butter and jelly sandwich. If @racket[jelly]
   is provided, then it is used instead of the standard (grape)
   jelly.
@@ -926,10 +934,9 @@ Examples:
 }|
 
 @doc-render-examples[
-  @defproc[#:link-target? #f
+  @defproc*[#:link-target? #f
-           ((make-pb&j)
+            ([(make-pb&j) sandwich?]
-            (make-pb&j [jelly jelly?]))
+             [(make-pb&j [jelly jelly?]) sandwich?])]{
-           sandwich?]{
     Returns a peanut butter and jelly sandwich. If @racket[jelly]
     is provided, then it is used instead of the standard (grape)
     jelly.
@@ -1221,7 +1228,10 @@ Examples:
 }
 
 
-@defform[(defparam maybe-link id arg-id contract-expr-datum pre-flow ...)]{
+@defform[(defparam maybe-link id arg-id
+           contract-expr-datum
+           maybe-value
+           pre-flow ...)]{
 
 Like @racket[defproc], but for a parameter. The
 @racket[contract-expr-datum] serves as both the result contract on the
@@ -1231,22 +1241,24 @@ parameter and the contract on values supplied for the parameter. The
 Examples:
 @codeblock[#:keep-lang-line? #f]|{
 #lang scribble/manual
-@defparam[current-sandwich sandwich sandwich?]{
+@defparam[current-sandwich sandwich sandwich?
+          #:value empty-sandwich]{
   A parameter that defines the current sandwich for operations that
-  involve eating a sandwich.
+  involve eating a sandwich. Default value is the empty sandwich.
 }
 }|
 @doc-render-examples[
   @defparam[#:link-target? #f
-            current-sandwich sandwich sandwich?]{
+            current-sandwich sandwich sandwich? #:value empty-sandwich]{
     A parameter that defines the current sandwich for operations that
-    involve eating a sandwich.
+    involve eating a sandwich. Default value is the empty sandwich.
   }]
 }
 
 
 @defform[(defparam* maybe-link id arg-id 
            in-contract-expr-datum out-contract-expr-datum
+           maybe-value
            pre-flow ...)]{
 
 Like @racket[defparam], but with separate contracts for when the parameter is being
@@ -1255,14 +1267,16 @@ coerces values matching a more flexible contract to a more restrictive one;
 @racket[current-directory] is an example).}
 
 
-@defform[(defboolparam maybe-link id arg-id pre-flow ...)]{
+@defform[(defboolparam maybe-link id arg-id
+           maybe-value
+           pre-flow ...)]{
 
 Like @racket[defparam], but the contract on a parameter argument is
 @racket[any/c], and the contract on the parameter result is
 @racket[boolean?].}
 
 
-@defform/subs[(defthing options id contract-expr-datum
+@defform/subs[(defthing options id contract-expr-datum maybe-value
                 pre-flow ...)
               ([options (code:line maybe-kind maybe-link maybe-id)]
                [maybe-kind code:blank
@@ -1270,7 +1284,9 @@ Like @racket[defparam], but the contract on a parameter argument is
                [maybe-link code:blank
                            (code:line #:link-target? link-target?-expr)]
                [maybe-id code:blank
-                         (code:line #:id id-expr)])]{
+                         (code:line #:id id-expr)]
+               [maybe-value code:blank
+                            (code:line #:value value-expr-datum)])]{
 
 Like @racket[defproc], but for a non-procedure binding.
 
@@ -1281,17 +1297,29 @@ it is used in the same way as for
 If @racket[#:id id-expr] is supplied, then the result of
 @racket[id-expr] is used in place of @racket[id].
 
+If @racket[#:value value-expr-datum] is given, @racket[value-expr-datum]
+is typeset using @racket[racketblock0] and included in the documentation.
+Wide values are put on a separate line.
+
 Examples:
 @codeblock[#:keep-lang-line? #f]|{
 #lang scribble/manual
 @defthing[moldy-sandwich sandwich?]{
   Don't eat this. Provided for backwards compatibility.
 }
+
+@defthing[empty-sandwich sandwich? #:value (make-sandwich empty)]{
+  The empty sandwich.
+}
 }|
 @doc-render-examples[
   @defthing[#:link-target? #f
             moldy-sandwich sandwich?]{
     Don't eat this. Provided for backwards compatibility.
+  }
+  @defthing[#:link-target? #f
+            empty-sandwich sandwich? #:value (make-sandwich empty)]{
+    The empty sandwich.
   }]
 }
 

pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-proc.rkt

@@ -117,12 +117,25 @@
                            "expected a result contract, found a string" #'c)
        #'(racketblock0 c))]))
 
+(define no-value #f)
+
+(define-syntax (result-value stx)
+  (syntax-case stx (no-value let)
+    [(_ no-value)  #'#f]
+    [(_ (let () e ...))  #'(racketblock0 e ...)]
+    [(_ v)  #'(racketblock0 v)]))
+
 (begin-for-syntax
  (define-splicing-syntax-class kind-kw
    #:description "#:kind keyword"
    (pattern (~optional (~seq #:kind kind)
                        #:defaults ([kind #'#f]))))
 
+ (define-splicing-syntax-class value-kw
+   #:description "#:value keyword"
+   (pattern (~optional (~seq #:value value)
+                       #:defaults ([value #'no-value]))))
+ 
  (define-splicing-syntax-class link-target?-kw
    #:description "#:link-target? keyword"
    (pattern (~seq #:link-target? expr))
@@ -152,13 +165,30 @@
 
 (define-syntax (defproc stx)
   (syntax-parse stx
-    [(_ kind:kind-kw lt:link-target?-kw i:id-kw (id arg ...) result desc ...)
+    [(_ kind:kind-kw
+        lt:link-target?-kw
+        i:id-kw
+        (id arg ...)
+        result
+        value:value-kw
+        desc ...)
      (syntax/loc stx
-       (defproc* #:kind kind.kind #:link-target? lt.expr #:id [i.key i.expr] [[(id arg ...) result]] desc ...))]))
+       (defproc*
+         #:kind kind.kind
+         #:link-target? lt.expr
+         #:id [i.key i.expr]
+         [[(id arg ...) result #:value value.value]]
+         desc ...))]))
 
 (define-syntax (defproc* stx)
   (syntax-parse stx
-    [(_ kind:kind-kw lt:link-target?-kw d:id-kw mode:mode-kw within:within-kw [[proto result] ...] desc ...)
+    [(_ kind:kind-kw
+        lt:link-target?-kw
+        d:id-kw
+        mode:mode-kw
+        within:within-kw
+        [[proto result value:value-kw] ...]
+        desc ...)
      (syntax/loc stx
        (with-togetherable-racket-variables
         ()
@@ -173,14 +203,15 @@
                     (list (arg-contracts proto) ...)
                     (list (arg-defaults proto) ...)
                     (list (lambda () (result-contract result)) ...)
-                    (lambda () (list desc ...))))))]))
+                    (lambda () (list desc ...))
+                    (list (result-value value.value) ...)))))]))
 
 (define-struct arg
   (special? kw id optional? starts-optional? ends-optional? num-closers))
 
 (define (*defproc kind link? mode within-id
-                  stx-ids sym prototypes arg-contractss arg-valss result-contracts
+                  stx-ids sym prototypes arg-contractss arg-valss result-contracts content-thunk
-                  content-thunk)
+                  [result-values (map (lambda (x) #f) result-contracts)])
   (define max-proto-width (current-display-width))
   (define ((arg->elem show-opt-start?) arg)
     (let* ([e (cond [(not (arg-special? arg))
@@ -282,7 +313,7 @@
                 (syntax-e stx-id)
                 (car p)))
           (loop (car p)))))
-  (define (do-one stx-id prototype args arg-contracts arg-vals result-contract
+  (define (do-one stx-id prototype args arg-contracts arg-vals result-contract result-value
                   first? add-background-label?)
     (let ([names (remq* '(... ...+) (map arg-id args))])
       (unless (= (length names) (length (remove-duplicates names eq?)))
@@ -550,7 +581,17 @@
           [else null]))
       args
       arg-contracts
-      arg-vals)))
+      arg-vals)
+     (if result-value
+         (let ([result-block  (if (block? result-value)
+                                  result-value
+                                  (make-omitable-paragraph (list result-value)))])
+           (list (list (list (make-table
+                              "argcontract"
+                              (list (list
+                                     (to-flow (make-element #f (list spacer "=" spacer)))
+                                     (make-flow (list result-block)))))))))
+         null)))
   (define all-args (map prototype-args prototypes))
   (define var-list
     (filter-map (lambda (a) (and (not (arg-special? a)) (arg-id a)))
@@ -564,7 +605,7 @@
        boxed-style
        (append-map
         do-one
-        stx-ids prototypes all-args arg-contractss arg-valss result-contracts
+        stx-ids prototypes all-args arg-contractss arg-valss result-contracts result-values
         (let loop ([ps prototypes] [stx-ids stx-ids] [accum null])
           (cond [(null? ps) null]
                 [(ormap (lambda (a) (eq? (extract-id (car ps) (car stx-ids)) a)) accum)
@@ -579,21 +620,21 @@
 
 (define-syntax (defparam stx)
   (syntax-parse stx
-    [(_ lt:link-target?-kw id arg contract desc ...)
+    [(_ lt:link-target?-kw id arg contract value:value-kw desc ...)
      #'(defproc* #:kind "parameter" #:link-target? lt.expr
-         ([(id) contract] [(id [arg contract]) void?]) 
+         ([(id) contract] [(id [arg contract]) void? #:value value.value]) 
          desc ...)]))
 (define-syntax (defparam* stx)
   (syntax-parse stx
-    [(_ lt:link-target?-kw id arg in-contract out-contract desc ...)
+    [(_ lt:link-target?-kw id arg in-contract out-contract value:value-kw desc ...)
      #'(defproc* #:kind "parameter" #:link-target? lt.expr
-         ([(id) out-contract] [(id [arg in-contract]) void?]) 
+         ([(id) out-contract] [(id [arg in-contract]) void? #:value value.value])
          desc ...)]))
 (define-syntax (defboolparam stx)
   (syntax-parse stx
-    [(_ lt:link-target?-kw id arg desc ...)
+    [(_ lt:link-target?-kw id arg value:value-kw desc ...)
      #'(defproc* #:kind "parameter" #:link-target? lt.expr
-         ([(id) boolean?] [(id [arg any/c]) void?]) 
+         ([(id) boolean?] [(id [arg any/c]) void? #:value value.value])
          desc ...)]))
 
 ;; ----------------------------------------
@@ -962,6 +1003,7 @@
                    #:defaults ([id-expr #'#f]))
         id 
         result 
+        value:value-kw
         desc ...)
      #'(with-togetherable-racket-variables
         ()
@@ -970,11 +1012,12 @@
                    lt.expr
                    (list (or id-expr (quote-syntax/loc id))) (list 'id) #f
                    (list (racketblock0 result))
-                   (lambda () (list desc ...))))]))
+                   (lambda () (list desc ...))
+                   (list (result-value value.value))))]))
 
 (define-syntax (defthing* stx)
   (syntax-parse stx
-    [(_ kind:kind-kw lt:link-target?-kw ([id result] ...) desc ...)
+    [(_ kind:kind-kw lt:link-target?-kw ([id result value:value-kw] ...) desc ...)
      #'(with-togetherable-racket-variables
         ()
         ()
@@ -982,7 +1025,8 @@
                    lt.expr
                    (list (quote-syntax/loc id) ...) (list 'id ...) #f
                    (list (racketblock0 result) ...)
-                   (lambda () (list desc ...))))]))
+                   (lambda () (list desc ...))
+                   (list (result-value value.value) ...)))]))
 
 (define (*defthing kind link? stx-ids names form? result-contracts content-thunk
                    [result-values (map (lambda (x) #f) result-contracts)])
@@ -993,90 +1037,91 @@
      (list
       (make-table
        boxed-style
-       (for/list ([stx-id (in-list stx-ids)]
+       (append*
-                  [name (in-list names)]
+        (for/list ([stx-id (in-list stx-ids)]
-                  [result-contract (in-list result-contracts)]
+                   [name (in-list names)]
-                  [result-value (in-list result-values)]
+                   [result-contract (in-list result-contracts)]
-                  [i (in-naturals)])
+                   [result-value (in-list result-values)]
-         (list
+                   [i (in-naturals)])
-          ((if (zero? i) (add-background-label (or kind "value")) values)
+          (let* ([result-block
-           (make-flow
+                  (and result-value
-            (make-table-if-necessary
+                       (if (block? result-value)
-             "argcontract"
+                           result-value
-             (let* ([result-block
+                           (make-omitable-paragraph (list result-value))))]
-                     (and result-value
+                 [contract-block
-                          (if (block? result-value)
+                  (if (block? result-contract)
-                              result-value
+                      result-contract
-                              (make-omitable-paragraph (list result-value))))]
+                      (make-omitable-paragraph (list result-contract)))]
-                    [contract-block
+                 [total-width (+ (string-length (format "~a" name))
-                     (if (block? result-contract)
+                                 3
-                         result-contract
+                                 (block-width contract-block)
-                         (make-omitable-paragraph (list result-contract)))]
+                                 (if result-block
-                    [total-width (+ (string-length (format "~a" name))
+                                     (+ (block-width result-block) 3)
-                                    3
+                                     0))])
-                                    (block-width contract-block)
+            (append
-                                    (if result-block
+             (list
-                                        (+ (block-width result-block) 3)
+              (list
-                                        0))])
+               ((if (zero? i) (add-background-label (or kind "value")) values)
-               (append
+                (make-flow
-                (list
+                 (make-table-if-necessary
-                 (append
+                  "argcontract"
-                  (list
+                  (append
-                   (make-flow
+                   (list
-                    (list
+                    (append
-                     (make-omitable-paragraph
-                      (list
-                       (let ([target-maker
-                              (and link?
-                                   ((if form? id-to-form-target-maker id-to-target-maker)
-                                    stx-id #t))])
-                         (define-values (content ref-content) 
-                           (if link?
-                               (definition-site name stx-id form?)
-                               (let ([s (make-just-context name stx-id)])
-                                 (values (to-element #:defn? #t s)
-                                         (to-element s)))))
-                         (if target-maker
-                             (target-maker
-                              content
-                              (lambda (tag)
-                                (make-toc-target2-element
-                                 #f
-                                 (make-index-element
-                                  #f
-                                  content
-                                  tag
-                                  (list (datum-intern-literal (symbol->string name)))
-                                  (list ref-content)
-                                  (with-exporting-libraries
-                                   (lambda (libs) (make-thing-index-desc name libs))))
-                                 tag
-                                 ref-content)))
-                             content))))))
-                   (make-flow
-                    (list
-                     (make-omitable-paragraph
-                      (list
-                       spacer ":" spacer))))
-                   (make-flow (list contract-block)))
-                  (if (and result-value
-                           (total-width . < . 60))
-                      (list
-                       (to-flow (make-element #f (list spacer "=" spacer)))
-                       (make-flow (list result-block)))
-                      null)))
-                (if (and result-value
-                         (total-width . >= . 60))
-                    (list
                      (list
-                      (make-table-if-necessary
+                      (make-flow
-                       "argcontract"
                        (list
-                        (list flow-spacer 
+                        (make-omitable-paragraph
-                              (to-flow (make-element #f (list spacer "=" spacer)))
+                         (list
-                              (make-flow (list result-block)))))
+                          (let ([target-maker
-                      'cont))
+                                 (and link?
-                    null)))))))))))
+                                      ((if form? id-to-form-target-maker id-to-target-maker)
+                                       stx-id #t))])
+                            (define-values (content ref-content) 
+                              (if link?
+                                  (definition-site name stx-id form?)
+                                  (let ([s (make-just-context name stx-id)])
+                                    (values (to-element #:defn? #t s)
+                                            (to-element s)))))
+                            (if target-maker
+                                (target-maker
+                                 content
+                                 (lambda (tag)
+                                   (make-toc-target2-element
+                                    #f
+                                    (make-index-element
+                                     #f
+                                     content
+                                     tag
+                                     (list (datum-intern-literal (symbol->string name)))
+                                     (list ref-content)
+                                     (with-exporting-libraries
+                                      (lambda (libs) (make-thing-index-desc name libs))))
+                                    tag
+                                    ref-content)))
+                                content))))))
+                      (make-flow
+                       (list
+                        (make-omitable-paragraph
+                         (list
+                          spacer ":" spacer))))
+                      (make-flow (list contract-block)))
+                     (if (and result-value
+                              (and (total-width . < . 60)
+                                   (not (table? result-value))))
+                         (list
+                          (to-flow (make-element #f (list spacer "=" spacer)))
+                          (make-flow (list result-block)))
+                         null)))))))))
+             (if (and result-value
+                      (or (total-width . >= . 60)
+                          (table? result-value)))
+                 (list (list (list (make-table
+                                    "argcontract"
+                                    (list (list
+                                           (to-flow (make-element #f (list spacer "=" spacer)))
+                                           (make-flow (list result-block))))))))
+                 null))))))))
     (content-thunk))))
 
 (define (defthing/proc kind id contract descs)

pkgs/scribble-pkgs/scribble-test/tests/scribble/docs/manual-ex.rkt

@@ -18,3 +18,5 @@
 
 (define-struct pt (x y))
 (struct pn (x y))
+
+(define v 10)

pkgs/scribble-pkgs/scribble-test/tests/scribble/docs/manual.scrbl

@@ -14,6 +14,14 @@
 
 @defproc[#:link-target? #f (f) integer?]{A function, again, not a link target.}
 
+@defproc[#:link-target? #f (f) integer? #:value 10]{A function, again, not a link target, documented to return @racket[10].}
+
+@defproc[#:link-target? #f (f) integer? #:value (let ()
+                                                  (define x 10)
+                                                  x)]{
+A function, again, not a link target, documented to return @racket[10] using a definition.
+}
+
 @defproc[#:kind "function" #:link-target? #f (g [x void?]) integer?]{A ``function,'' again, not a link target.}
 
 @defproc[#:id [i #'j] (i) void?]{Source is @racket[i], documents @racket[j].}
@@ -42,12 +50,27 @@
 
 @defparam[#:link-target? #f p k integer?]{A parameter, again.}
 
+@defparam[#:link-target? #f p k integer? #:value 10]{A parameter, again, with a documented default value.}
+
 @defparam*[#:link-target? #f p k real? integer?]{A parameter, yet again.}
 
+@defparam*[#:link-target? #f p k real? integer? #:value 10]{A parameter, yet again, with a documented default value.}
+
 @defboolparam[q on?]{A boolean parameter.}
 
 @defboolparam[#:link-target? #f q still-on?]{A boolean parameter, again.}
 
+@defboolparam[#:link-target? #f q still-on? #:value #f]{A boolean parameter, again, with a documented default value.}
+
+
+@defthing[v integer?]{A thing.}
+
+@defthing[#:link-target? #f v integer?]{A thing, again.}
+
+@defthing[#:link-target? #f v integer? #:value 10]{A thing, again, with a documented value.}
+
+@defthing[#:link-target? #f v integer? #:value 12345678901234567890123456789012345678901234567890]{A thing, again, with a documented value that's too wide to fit on one line.}
+
 
 @defstruct[pt ([x real?] [y real?])]{A structure type with extra name.}
 

pkgs/scribble-pkgs/scribble-test/tests/scribble/docs/manual.txt

@@ -26,6 +26,18 @@ A function with an optional keyword argument.
 
 A function, again, not a link target.
 
+(f) -> integer?
+ = 10          
+
+A function, again, not a link target, documented to return 10.
+
+(f) -> integer? 
+ = (define x 10)
+   x            
+
+A function, again, not a link target, documented to return 10 using a
+definition.
+
 (g x) -> integer?
   x : void?      
 
@@ -86,12 +98,26 @@ A parameter
 
 A parameter, again.
 
+(p) -> integer?
+(p k) -> void? 
+  k : integer? 
+ = 10          
+
+A parameter, again, with a documented default value.
+
 (p) -> integer?
 (p k) -> void? 
   k : real?    
 
 A parameter, yet again.
 
+(p) -> integer?
+(p k) -> void? 
+  k : real?    
+ = 10          
+
+A parameter, yet again, with a documented default value.
+
 (q) -> boolean? 
 (q on?) -> void?
   on? : any/c   
@@ -104,6 +130,31 @@ A boolean parameter.
 
 A boolean parameter, again.
 
+(q) -> boolean?       
+(q still-on?) -> void?
+  still-on? : any/c   
+ = #f                 
+
+A boolean parameter, again, with a documented default value.
+
+v : integer?
+
+A thing.
+
+v : integer?
+
+A thing, again.
+
+v : integer? = 10
+
+A thing, again, with a documented value.
+
+v : integer?                                         
+ = 12345678901234567890123456789012345678901234567890
+
+A thing, again, with a documented value that’s too wide to fit on one
+line.
+
 (struct pt (x y)                         
         #:extra-constructor-name make-pt)
   x : real?