add #:error-name argument to opt/c

this makes it easier to stick opt/c implicitly into
various other contract using forms

collects/racket/contract/private/opt-guts.rkt

@@ -23,6 +23,7 @@
          opt/info-change-val
          
          opt/unknown
+         opt-error-name
          
          optres-exp
          optres-lifts
@@ -262,7 +263,7 @@
     (build-optres
      #:exp #'(partial-var val)
      #:lifts (list (cons #'lift-var 
-                         #'(coerce-contract 'opt/c uctc)))
+                         #`(coerce-contract '#,(opt-error-name) uctc)))
      #:superlifts null
      #:partials
      (list (cons
@@ -281,6 +282,9 @@
      #:chaperone #'(chaperone-contract? lift-var)
      #:name #'(contract-name lift-var))))
 
+
+(define opt-error-name (make-parameter 'opt/c))
+
 ;; combine-two-chaperone?s : (or/c boolean? syntax?) (or/c boolean? syntax?) -> (or/c boolean? syntax?)
 (define (combine-two-chaperone?s chaperone-a? chaperone-b?)
   (cond

collects/racket/contract/private/opt.rkt

@@ -171,26 +171,33 @@
 ;; contract combinators and attempts to "unroll" those combinators to save
 ;; on things such as closure allocation time.
 (define-syntax (opt/c stx)  
-  (syntax-case stx ()
-    [(_ e)
-     (let ()
-       (define info (make-opt/info #'ctc #'val #'blame #f '() #f #f #'this #'that))
-       (define an-optres (opt/i info #'e))
-       (bind-superlifts
-        (optres-superlifts an-optres)
-        (bind-lifts
-         (optres-lifts an-optres)
-         #`(make-opt-contract
-            (λ (ctc)
-              (λ (blame)
-                #,(bind-superlifts
-                   (optres-partials an-optres)
-                   #`(λ (val) #,(optres-exp an-optres)))))
-            #,(optres-name an-optres)
-            (λ (this that) #f)
-            (vector)
-            (begin-lifted (box #f))
-            #,(optres-chaperone an-optres)))))]))
+  (define-values (exp error-name-sym)
+    (syntax-case stx ()
+      [(_ e) (values #'e 'opt/c)]
+      [(_ e #:error-name x) 
+       (begin
+         (unless (identifier? #'x)
+           (raise-syntax-error 'opt/c "expected a name" stx #'x))
+         (values #'e (syntax-e #'x)))]))
+  
+  (parameterize ([opt-error-name error-name-sym])
+    (define info (make-opt/info #'ctc #'val #'blame #f '() #f #f #'this #'that))
+    (define an-optres (opt/i info exp))
+    (bind-superlifts
+     (optres-superlifts an-optres)
+     (bind-lifts
+      (optres-lifts an-optres)
+      #`(make-opt-contract
+         (λ (ctc)
+           (λ (blame)
+             #,(bind-superlifts
+                (optres-partials an-optres)
+                #`(λ (val) #,(optres-exp an-optres)))))
+         #,(optres-name an-optres)
+         (λ (this that) #f)
+         (vector)
+         (begin-lifted (box #f))
+         #,(optres-chaperone an-optres))))))
 
 ;; this macro optimizes 'e' as a contract,
 ;; using otherwise-id if it does not recognize 'e'.

collects/scribblings/reference/contracts.scrbl

@@ -2247,14 +2247,31 @@ describes the expected type of contract and must be one of the keywords
 @racket[type] is not given, an impersonator contract is created.}
 
 
-@defform[(opt/c contract-expr)]{
+@defform/subs[(opt/c contract-expr maybe-name)
+              ([maybe-name (code:line)
+                           (code:line #:error-name id)])]{
 
 This optimizes its argument contract expression by
 traversing its syntax and, for known contract combinators,
 fuses them into a single contract combinator that avoids as
 much allocation overhead as possible. The result is a
 contract that should behave identically to its argument,
-except faster (due to less allocation).}
+except faster.
+
+If the @racket[#:error-name] argument is present, and
+@racket[contract-expr] evaluates to a non-contract
+expression, then @racket[opt/c] raises an error using
+@racket[id] as the name of the primitive, instead of using
+the name @racket[opt/c].
+
+@examples[#:eval (contract-eval)
+                 (define/contract (f x)
+                   (opt/c '(not-a-contract))
+                   x)
+                 (define/contract (f x)
+                   (opt/c '(not-a-contract) #:error-name define/contract)
+                   x)]
+}
 
 
 @defform[(define-opt/c (id id ...) expr)]{