PasteRack.org
Paste # 51673
2015-03-18 08:33:00

Fork as a new paste.

Paste viewed 554 times.


Embed:

define/tc macro

  1. #lang racket/base
  2.  
  3. (provide define/tc
  4.          define/tc/module
  5.          (all-from-out rackunit
  6.                        racket/contract))
  7.  
  8. (require (for-syntax racket/base
  9.                      racket/syntax
  10.                      syntax/parse
  11.                      racket/contract)
  12.          rackunit
  13.          racket/contract)
  14.  
  15. ;;; Macro for defining with contract and tests at the same time
  16. ;;; Usage is illustrated below.
  17. (define-syntax (define/tc stx)
  18.   (syntax-parse stx
  19.     [(tc (func-name:id arg ...)
  20.          contract-spec
  21.          ([(test-input:expr ...) desired-result:expr] ...)
  22.          body:expr ...)
  23.      #'(begin
  24.          (define/contract (func-name arg ...)
  25.            contract-spec
  26.            body ...)
  27.          (check-equal? (func-name test-input ...) desired-result)
  28.          ...)]
  29.     [(tc (func-name:id arg ...)
  30.          contract-spec
  31.          ([test-input:expr desired-result:expr] ...)
  32.          body:expr ...)
  33.      #'(begin
  34.          (define/contract (func-name arg ...)
  35.            contract-spec
  36.            body ...)
  37.          (check-equal? (func-name test-input) desired-result)
  38.          ...)]))
  39.  
  40. (define-syntax (define/tc/module stx)
  41.   (syntax-parse stx
  42.     [(tc (func-name:id arg ...)
  43.          contract-spec
  44.          ([(test-input:expr ...) desired-result:expr] ...)
  45.          body:expr ...)
  46.      #'(begin
  47.          (define/contract (func-name arg ...)
  48.            contract-spec
  49.            body ...)
  50.          (module+ test
  51.            (check-equal? (func-name test-input ...) desired-result)
  52.            ...))]
  53.     [(tc (func-name:id arg:id ...)
  54.          contract-spec
  55.          ([test-input:expr desired-result:expr] ...)
  56.          body:expr ...)
  57.      #'(begin
  58.          (define/contract (func-name arg ...)
  59.            contract-spec
  60.            body ...)
  61.          (module+ test
  62.            (check-equal? (func-name test-input) desired-result) ...))]))
  63.  
  64. (module+ main
  65.   (define/tc (square x)
  66.     (integer? . -> . integer?)
  67.  
  68.     ([2 4]
  69.      [3 9]
  70.      [5 25])
  71.  
  72.     (expt x 2))
  73.  
  74.   (define/tc (square2&add x y)
  75.     (integer? integer? . -> . integer?)
  76.  
  77.     ([(2 3) 13]
  78.      [(1 2) 5])
  79.  
  80.     (+ (expt x 2) (expt y 2))))

=>