Changing absent so that fields may be specified as well as methods.

collects/racket/private/class-internal.rkt

@@ -2575,6 +2575,9 @@
       (for ([f (class/c-fields ctc)])
         (unless (hash-ref field-ht f #f)
           (fail "no public field ~a" f)))
+      (for ([f (class/c-absent-fields ctc)])
+        (when (hash-ref field-ht f #f)
+          (fail "class already contains public field ~a" f)))
       (for ([f (class/c-inherit-fields ctc)])
         (unless (hash-ref field-ht f #f)
           (fail "no public field ~a" f)))))
@@ -2899,7 +2902,7 @@
    inherits inherit-contracts inherit-fields inherit-field-contracts
    supers super-contracts inners inner-contracts
    overrides override-contracts augments augment-contracts
-   augrides augride-contracts absents)
+   augrides augride-contracts absents absent-fields)
   #:omit-define-syntaxes
   #:property prop:contract
   (build-contract-property
@@ -2918,6 +2921,15 @@
                (if (null? is)
                    null
                    (list (cons name (pair-ids-ctcs is ctcs)))))]
+            [handle-absents
+             (λ (meths fields)
+               (cond
+                 [(and (null? meths) (null? fields))
+                  null]
+                 [(null? fields)
+                  (list (cons 'absent meths))]
+                 [else
+                  (list (list* 'absent (cons 'field fields) meths))]))]
             [handled-methods
              (for/list ([i (in-list (class/c-methods ctc))]
                         [ctc (in-list (class/c-method-contracts ctc))])
@@ -2937,8 +2949,7 @@
                (handle-optional 'override (class/c-overrides ctc) (class/c-override-contracts ctc))
                (handle-optional 'augment (class/c-augments ctc) (class/c-augment-contracts ctc))
                (handle-optional 'augride (class/c-augrides ctc) (class/c-augride-contracts ctc))
-               (let ([absents (class/c-absents ctc)])
+               (handle-absents (class/c-absents ctc) (class/c-absent-fields ctc))))))
-                 (if (null? absents) null (list (cons 'absent absents))))))))
    #:first-order
    (λ (ctc)
      (λ (cls)
@@ -2958,13 +2969,29 @@
        (values #'(quote x) 
                #`(coerce-contract '#,form-name (let ([x ctc]) x)))]
       [_
-       (raise-syntax-error 'class/c "expected identifier or (id contract)" stx)]))
+       (raise-syntax-error form-name "expected identifier or (id contract)" stx)]))
   (define (parse-names-ctcs stx)
     (for/fold ([names null]
                [ctcs null])
       ([stx (in-list (syntax->list stx))])
       (let-values ([(name ctc) (parse-name-ctc stx)])
         (values (cons name names) (cons ctc ctcs)))))
+  (define (parse-absents stx)
+    (for/fold ([meths null]
+               [fields null])
+      ([stx (in-list (syntax->list stx))])
+      (syntax-case stx (field)
+        [(field f-id ...)
+         (let ([symbols (for/list ([id (in-list (syntax->list #'(f-id ...)))])
+                          (unless (identifier? id)
+                            (raise-syntax-error 'class/c "expected identifier" stx))
+                          #`(quote #,id))])
+           (values meths (append (reverse symbols) fields)))]
+        [id
+         (identifier? #'id)
+         (values (cons #'(quote id) meths) fields)]
+        [_
+         (raise-syntax-error 'class/c "expected identifier or (field id ...)" stx)])))
   (define (parse-spec stx)
     (syntax-case stx (field inherit inherit-field init init-field super inner override augment augride absent)
       [(field f-spec ...)
@@ -3052,16 +3079,15 @@
                       (append names (hash-ref parsed-forms 'augrides null)))
            (hash-set! parsed-forms 'augride-contracts
                       (append ctcs (hash-ref parsed-forms 'augride-contracts null)))))]
-      [(absent m-id ...)
+      [(absent a-spec ...)
        (begin
          (when object/c?
            (raise-syntax-error 'object/c "absent specification not allowed in object/c" stx))
-         (let ([ids (syntax->list #'(m-id ...))])
+         (let-values ([(meths fields) (parse-absents #'(a-spec ...))])
-           (for ([id (in-list ids)])
-             (unless (identifier? id)
-               (raise-syntax-error form-name "non-identifier in absent specification" id)))
            (hash-set! parsed-forms 'absents
-                    (append (map (λ (x) #`(quote #,x)) ids) (hash-ref parsed-forms 'absents null)))))]
+                      (append meths (hash-ref parsed-forms 'absents null)))
+           (hash-set! parsed-forms 'absent-fields
+                      (append fields (hash-ref parsed-forms 'absent-fields null)))))]
       [m-spec
        (let-values ([(name ctc1) (parse-name-ctc #'m-spec)])
          (hash-set! parsed-forms 'methods
@@ -3098,7 +3124,8 @@
                      [augment-ctcs #`(list #,@(reverse (hash-ref parsed-forms 'augment-contracts null)))]
                      [augrides #`(list #,@(reverse (hash-ref parsed-forms 'augrides null)))]
                      [augride-ctcs #`(list #,@(reverse (hash-ref parsed-forms 'augride-contracts null)))]
-                     [absents #`(list #,@(reverse (hash-ref parsed-forms 'absents null)))])
+                     [absents #`(list #,@(reverse (hash-ref parsed-forms 'absents null)))]
+                     [absent-fields #`(list #,@(reverse (hash-ref parsed-forms 'absent-fields null)))])
          (syntax/loc stx
            (let* ([inits+contracts (sort (list (cons i i-c) ...)
                                          (lambda (s1 s2) 
@@ -3114,7 +3141,7 @@
                            overrides override-ctcs
                            augments augment-ctcs
                            augrides augride-ctcs
-                           absents)))))]))
+                           absents absent-fields)))))]))
 
 (define (check-object-contract obj methods fields fail)
   (unless (object? obj)

collects/scribblings/reference/class.scrbl

@@ -1493,14 +1493,17 @@ resulting trait are the same as for @scheme[trait-sum], otherwise the
   (override method-spec ...)
   (augment method-spec ...)
   (augride method-spec ...)
-  (absent method-id ...)]
+  (absent absent-spec ...)]
  
  [method-spec
   method-id
   (method-id method-contract)]
  [field-spec
   field-id
-  (field-id contract-expr)])]{
+  (field-id contract-expr)]
+ [absent-spec
+  method-id
+  (field field-id ...)])]{
 Produces a contract for a class.
 
 There are two major categories of contracts listed in a @scheme[class/c]
@@ -1518,7 +1521,7 @@ contracts which discuss the state of the object when the method is called
 contract forms, such as @scheme[->m], are provided as a shorthand
 for writing method contracts.
 
-Methods listed in an @scheme[absent] clause must @emph{not} be present in the class.
+Methods and fields listed in an @scheme[absent] clause must @emph{not} be present in the class.
 
 The external contracts are as follows:
 

collects/tests/racket/contract-test.rktl

@@ -6738,6 +6738,17 @@
               'pos
               'neg))
   
+  (test/spec-passed
+   'class/c-first-order-absent-3
+   '(contract (class/c (absent (field f))) object% 'pos 'neg))
+  
+  (test/pos-blame
+   'class/c-first-order-absent-4
+   '(contract (class/c (absent (field f)))
+              (class object% (super-new) (field [f 3]))
+              'pos
+              'neg))
+  
   (test/spec-passed
    'class/c-higher-order-init-1
    '(let ([c% (contract (class/c (init [a number?]))