units contracts

units-contract.rkt

#lang racket
(require measures)

(define-syntax-rule (define-units-contract name m1)
  (define name
         (make-flat-contract
          #:name 'name
          #:first-order
          (λ(m2)(measure-units-equal? m1 m2)))))

(define-units-contract Mass/c kg)
(define-units-contract Velocity/c (m* m (m/ s)))
(define-units-contract Energy/c J)

(define/contract (kinetic-energy m v)
  (Mass/c Velocity/c . -> . Energy/c)
  (m* 1/2 m v v))

(kinetic-energy (m* 1000 kg) (m* 90 km (m/ h)))

(kinetic-energy (m* 1000 kg) (m* 90 km h))

#|
(measure 312500 (set (unit 's -2) (unit 'kg 1) (unit 'm 2)))
 kinetic-energy: contract violation
  expected: Velocity/c
  given: (measure 324000000 (set (unit 's 1) (unit 'm 1)))
  in: the 2nd argument of
      (-> Mass/c Velocity/c Energy/c)
  contract from: (function kinetic-energy)
  blaming: anonymous-module
  at: unsaved-editor6122:15.18
|#