contract.ss
#lang scheme
#|
(define (contract-like? v)
  (contract? (coerce-contract/f v)))

(define (flat-contract-like? v)
  (flat-contract? (coerce-contract/f v)))

(define contract-like/c
  (flat-named-contract (string->symbol "contract, predicate, or constant")
    contract-like?))

(define flat-contract-like/c
  (flat-named-contract (string->symbol "flat contract, predicate, or constant")
    flat-contract-like?))
|#
(define nat/c
  (flat-named-contract '|natural number| exact-nonnegative-integer?))

(define pos/c
  (flat-named-contract '|positive integer| exact-positive-integer?))

(define truth/c
  (flat-named-contract '|truth value| (lambda (x) #t)))

(define thunk/c (-> any/c))
(define unary/c (-> any/c any/c))
(define binary/c (-> any/c any/c any/c))
(define predicate/c (-> any/c boolean?))
(define comparison/c (-> any/c any/c boolean?))
(define predicate-like/c (-> any/c truth/c))
(define comparison-like/c (-> any/c any/c truth/c))

(provide/contract
#|
 [contract-like? predicate/c]
 [flat-contract-like? predicate/c]

 [contract-like/c flat-contract?]
 [flat-contract-like/c flat-contract?]
|#
 [nat/c flat-contract?]
 [pos/c flat-contract?]
 [truth/c flat-contract?]

 [thunk/c contract?]
 [unary/c contract?]
 [binary/c contract?]
 [predicate/c contract?]
 [comparison/c contract?]
 [predicate-like/c contract?]
 [comparison-like/c contract?]

 )