type-case and list-case for typed/racket

utils.rkt

(define-syntax (type-case stx)
  (define (add-huh s)
    (datum->syntax stx (string->symbol (string-append (symbol->string (syntax-e s)) "?"))))
  (syntax-case stx ()
    [(_ val
        [(ty field ...) body]
        ...)
     (with-syntax ([(p ...) (map add-huh (syntax-e #'(ty ...)))])
       #'(let ([v val])
           (cond
             [(p v) (match v [(ty field ...) body])]
             ...)))]))

(define-syntax type-case-lambda
  (syntax-rules ()
    [(_ [(ty field ...) body] ...)
     (λ (v) (type-case [(ty field ...) body] ...))]))


(define-syntax list-case
  (syntax-rules (cons empty)
    [(_ expr [empty ebody] [(cons f r) cbody])
     (let ([v expr])
       (cond
         [(empty? v) ebody]
         [(cons? v) (let ([f (first v)]
                           [r (rest v)])
                       cbody)]))]
    [(_ expr [(cons f r) cbody] [empty ebody])
     (let ([v expr])
       (cond
         [(empty? v) ebody]
         [(cons? v) (let ([f (first v)]
                           [r (rest v)])
                       cbody)]))]))