(define-syntax trace
  (syntax-rules ()
    ((trace x)
     (begin
       (write (quote x))
       (display " => ")
       (write x)
       (newline)
       x))))

(define (super-cons x res)
  (if (null? x)
      (reverse res)
      (super-cons (cdr x) (cons (car x) res))))

(define-syntax define-data
  (syntax-rules ()
    ((_ type (arg . args))
     (begin
       (for-each (lambda (i)
                   (begin
                     (eval `(define (,(car i) x . xx)
                              (list->vector (cons 'type (cons ',(car i) (cons x (super-cons xx '())))))) (interaction-environment)))) (cons 'arg 'args))
       (eval `(define (,(string->symbol (string-append (symbol->string 'type) (symbol->string '?))) x)
                (and (vector? x) (equal? 'type (vector-ref x 0)) (> (vector-length x) 2))) (interaction-environment))
       ))))

(define-syntax match
  (syntax-rules ()
    ((_ true x . xx) (match true x xx))
    ((_ true ((name arg ...) expr) other)
       (if (equal? name (vector-ref true 1))
           (apply (lambda (arg ...) expr) (cddr (vector->list true)))
           (match true (car other) (cdr other))))))

(begin
  (define-data figure ((square a)
                       (rectangle a b)
                       (triangle a b c)
                       (circle r)))

  (define s (square 10))
  (define r (rectangle 10 20))
  (define t (triangle 10 20 30))
  (define c (circle 10))

  (define test-1 (and (figure? s)
                      (figure? r)
                      (figure? t)
                      (figure? c)))

  (define a '(circle 0 0 1))
  (define b #f)

  (define test-2 (and (figure? a)
                      (figure? b)))

  (define pi (acos -1))

  (define (perim f)
    (match f
      ((square a)       (* 4 a))
      ((rectangle a b)  (* 2 (+ a b)))
      ((triangle a b c) (+ a b c))
      ((circle r)       (* 2 pi r))))

  (list test-1
        test-2
        (perim s)
        (perim r)
        (perim t)
        (round (perim c)))
  ) ; end