(begin
  ;; FIXME
  (define (transformer f)
    (lambda (form env)
      (let ((ephemeron1 (make-ephemeron-table))
            (ephemeron2 (make-ephemeron-table)))
        (letrec
            ((wrap (lambda (var1)
                     (or (ephemeron1 var1)
                         (let ((var2 (make-identifier var1 env)))
                           (ephemeron1 var1 var2)
                           (ephemeron2 var2 var1)
                           var2))))
             (unwrap (lambda (var2)
                       (or (ephemeron2 var2)
                           var2)))
             (walk (lambda (f form)
                     (cond
                      ((identifier? form)
                       (f form))
                      ((pair? form)
                       (cons (walk f (car form)) (walk f (cdr form))))
                      (else
                       form)))))
          (let ((form (cdr form)))
            (walk unwrap (apply f (walk wrap form))))))))
  (let ()
    (define (define-transformer name transformer)
      (add-macro! name transformer))

    (define (the var)                   ; synonym for #'var
      (make-identifier var default-environment))

    (define the-core-define (the 'core#define))
    (define the-core-lambda (the 'core#lambda))
    (define the-core-begin (the 'core#begin))
    (define the-core-quote (the 'core#quote))
    (define the-core-set! (the 'core#set!))
    (define the-core-if (the 'core#if))
    (define the-core-define-macro (the 'core#define-macro))

    (define the-define (the 'define))
    (define the-lambda (the 'lambda))
    (define the-begin (the 'begin))
    (define the-quote (the 'quote))
    (define the-set! (the 'set!))
    (define the-if (the 'if))
    (define the-define-macro (the 'define-macro))

    (define-transformer 'quote
      (lambda (form env)
        (if (= (length form) 2)
            `(,the-core-quote ,(cadr form))
            (error "malformed quote" form))))

    (define-transformer 'if
      (lambda (form env)
        (let ((len (length form)))
          (cond
           ((= len 3) `(,@form #undefined))
           ((= len 4) `(,the-core-if . ,(cdr form)))
           (else (error "malformed if" form))))))

    (define-transformer 'begin
      (lambda (form env)
        (let ((len (length form)))
          (cond
           ((= len 1) #undefined)
           ((= len 2) (cadr form))
           ((= len 3) `(,the-core-begin . ,(cdr form)))
           (else `(,the-core-begin ,(cadr form) (,the-begin . ,(cddr form))))))))

    (define-transformer 'set!
      (lambda (form env)
        (if (and (= (length form) 3) (identifier? (cadr form)))
            `(,the-core-set! . ,(cdr form))
            (error "malformed set!" form))))

    (define (check-formal formal)
      (or (null? formal)
          (identifier? formal)
          (and (pair? formal)
               (identifier? (car formal))
               (check-formal (cdr formal)))))

    (define-transformer 'lambda
      (lambda (form env)
        (if (= (length form) 1)
            (error "malformed lambda" form)
            (if (check-formal (cadr form))
                `(,the-core-lambda ,(cadr form) (,the-begin . ,(cddr form)))
                (error "malformed lambda" form)))))

    (define-transformer 'define
      (lambda (form env)
        (let ((len (length form)))
          (if (= len 1)
              (error "malformed define" form)
              (let ((formal (cadr form)))
                (if (identifier? formal)
                    (if (= len 3)
                        `(,the-core-define . ,(cdr form))
                        (error "malformed define" form))
                    (if (pair? formal)
                        `(,the-define ,(car formal) (,the-lambda ,(cdr formal) . ,(cddr form)))
                        (error "define: binding to non-varaible object" form))))))))

    (define-transformer 'define-macro
      (lambda (form env)
        (if (= (length form) 3)
            (if (identifier? (cadr form))
                `(,the-core-define-macro . ,(cdr form))
                (error "define-macro: binding to non-variable object" form))
            (error "malformed define-macro" form))))


    (define-transformer 'syntax-error
      (lambda (form _)
        (apply error (cdr form))))

    (define-macro define-auxiliary-syntax
      (lambda (form _)
        `(define-transformer ',(cadr form)
           (lambda _
             (error "invalid use of auxiliary syntax" ',(cadr form))))))

    (define-auxiliary-syntax else)
    (define-auxiliary-syntax =>)
    (define-auxiliary-syntax unquote)
    (define-auxiliary-syntax unquote-splicing)
    (define-auxiliary-syntax syntax-unquote)
    (define-auxiliary-syntax syntax-unquote-splicing)

    (define-transformer 'let
      (lambda (form env)
        (if (identifier? (cadr form))
            (let ((name   (car (cdr form)))
                  (formal (car (cdr (cdr form))))
                  (body   (cdr (cdr (cdr form)))))
              `((,the-lambda ()
                             (,the-define (,name . ,(map car formal)) . ,body)
                             (,name . ,(map cadr formal)))))
            (let ((formal (car (cdr form)))
                  (body   (cdr (cdr form))))
              `((,the-lambda ,(map car formal) . ,body) . ,(map cadr formal))))))

    (define-transformer 'and
      (lambda (form env)
        (if (null? (cdr form))
            #t
            (if (null? (cddr form))
                (cadr form)
                `(,the-if ,(cadr form) (,(the 'and) . ,(cddr form)) #f)))))

    (define-transformer 'or
      (lambda (form env)
        (if (null? (cdr form))
            #f
            (let ((tmp (make-identifier 'it env))) ; should we use #f as the env for tmp?
              `(,(the 'let) ((,tmp ,(cadr form)))
                (,the-if ,tmp ,tmp (,(the 'or) . ,(cddr form))))))))

    (define-transformer 'cond
      (lambda (form env)
        (let ((clauses (cdr form)))
          (if (null? clauses)
              #undefined
              (let ((clause (car clauses)))
                (if (and (identifier? (car clause))
                         (identifier=? (the 'else) (make-identifier (car clause) env)))
                    `(,the-begin . ,(cdr clause))
                    (if (null? (cdr clause))
                        `(,(the 'or) ,(car clause) (,(the 'cond) . ,(cdr clauses)))
                        (if (and (identifier? (cadr clause))
                                 (identifier=? (the '=>) (make-identifier (cadr clause) env)))
                            (let ((tmp (make-identifier 'tmp env)))
                              `(,(the 'let) ((,tmp ,(car clause)))
                                (,the-if ,tmp (,(cadr (cdr clause)) ,tmp) (,(the 'cond) . ,(cddr form)))))
                            `(,the-if ,(car clause)
                                      (,the-begin . ,(cdr clause))
                                      (,(the 'cond) . ,(cdr clauses)))))))))))

    (define-transformer 'quasiquote
      (lambda (form env)

        (define (quasiquote? form)
          (and (pair? form)
               (identifier? (car form))
               (identifier=? (the 'quasiquote) (make-identifier (car form) env))))

        (define (unquote? form)
          (and (pair? form)
               (identifier? (car form))
               (identifier=? (the 'unquote) (make-identifier (car form) env))))

        (define (unquote-splicing? form)
          (and (pair? form)
               (pair? (car form))
               (identifier? (caar form))
               (identifier=? (the 'unquote-splicing) (make-identifier (caar form) env))))

        (define (qq depth expr)
          (cond
           ;; unquote
           ((unquote? expr)
            (if (= depth 1)
                (cadr expr)
                (list (the 'list)
                      (list (the 'quote) (the 'unquote))
                      (qq (- depth 1) (car (cdr expr))))))
           ;; unquote-splicing
           ((unquote-splicing? expr)
            (if (= depth 1)
                (list (the 'append)
                      (car (cdr (car expr)))
                      (qq depth (cdr expr)))
                (list (the 'cons)
                      (list (the 'list)
                            (list (the 'quote) (the 'unquote-splicing))
                            (qq (- depth 1) (car (cdr (car expr)))))
                      (qq depth (cdr expr)))))
           ;; quasiquote
           ((quasiquote? expr)
            (list (the 'list)
                  (list (the 'quote) (the 'quasiquote))
                  (qq (+ depth 1) (car (cdr expr)))))
           ;; list
           ((pair? expr)
            (list (the 'cons)
                  (qq depth (car expr))
                  (qq depth (cdr expr))))
           ;; vector
           ((vector? expr)
            (list (the 'list->vector) (qq depth (vector->list expr))))
           ;; simple datum
           (else
            (list (the 'quote) expr))))

        (let ((x (cadr form)))
          (qq 1 x))))

    (define-transformer 'let*
      (lambda (form env)
        (let ((bindings (car (cdr form)))
              (body     (cdr (cdr form))))
          (if (null? bindings)
              `(,(the 'let) () . ,body)
              `(,(the 'let) ((,(car (car bindings)) . ,(cdr (car bindings))))
                (,(the 'let*) ,(cdr bindings) . ,body))))))

    (define-transformer 'letrec
      (lambda (form env)
        `(,(the 'letrec*) . ,(cdr form))))

    (define-transformer 'letrec*
      (lambda (form env)
        (let ((bindings (car (cdr form)))
              (body     (cdr (cdr form))))
          (let ((variables (map (lambda (v) `(,v #undefined)) (map car bindings)))
                (initials  (map (lambda (v) `(,(the 'set!) ,@v)) bindings)))
            `(,(the 'let) ,variables
              ,@initials
              ,@body)))))

    (define-transformer 'let-values
      (lambda (form env)
        `(,(the 'let*-values) ,@(cdr form))))

    (define-transformer 'let*-values
      (lambda (form env)
        (let ((formal (car (cdr form)))
              (body   (cdr (cdr form))))
          (if (null? formal)
              `(,(the 'let) () ,@body)
              `(,(the 'call-with-values) (,the-lambda () ,@(cdr (car formal)))
                (,(the 'lambda) (,@(car (car formal)))
                 (,(the 'let*-values) (,@(cdr formal))
                  ,@body)))))))

    (define-transformer 'define-values
      (lambda (form env)
        (let ((formal (car (cdr form)))
              (body   (cdr (cdr form))))
          (let ((arguments (make-identifier 'arguments env)))
            `(,the-begin
              ,@(let loop ((formal formal))
                  (if (pair? formal)
                      `((,the-define ,(car formal) #undefined) ,@(loop (cdr formal)))
                      (if (identifier? formal)
                          `((,the-define ,formal #undefined))
                          '())))
              (,(the 'call-with-values) (,the-lambda () ,@body)
               (,the-lambda
                ,arguments
                ,@(let loop ((formal formal) (args arguments))
                    (if (pair? formal)
                        `((,the-set! ,(car formal) (,(the 'car) ,args)) ,@(loop (cdr formal) `(,(the 'cdr) ,args)))
                        (if (identifier? formal)
                            `((,the-set! ,formal ,args))
                            '()))))))))))

    (define-transformer 'do
      (lambda (form env)
        (let ((bindings (car (cdr form)))
              (test     (car (car (cdr (cdr form)))))
              (cleanup  (cdr (car (cdr (cdr form)))))
              (body     (cdr (cdr (cdr form)))))
          (let ((loop (make-identifier 'loop env)))
            `(,(the 'let) ,loop ,(map (lambda (x) `(,(car x) ,(cadr x))) bindings)
              (,the-if ,test
                       (,the-begin . ,cleanup)
                       (,the-begin
                        ,@body
                        (,loop . ,(map (lambda (x)
                                         (if (null? (cdr (cdr x)))
                                             (car x)
                                             (car (cdr (cdr x)))))
                                       bindings)))))))))

    (define-transformer 'when
      (lambda (form env)
        (let ((test (car (cdr form)))
              (body (cdr (cdr form))))
          `(,the-if ,test
                    (,the-begin ,@body)
                    #undefined))))

    (define-transformer 'unless
      (lambda (form env)
        (let ((test (car (cdr form)))
              (body (cdr (cdr form))))
          `(,the-if ,test
                    #undefined
                    (,the-begin ,@body)))))

    (define-transformer 'case
      (lambda (form env)
        (let ((key     (car (cdr form)))
              (clauses (cdr (cdr form))))
          (let ((the-key (make-identifier 'key env)))
            `(,(the 'let) ((,the-key ,key))
              ,(let loop ((clauses clauses))
                 (if (null? clauses)
                     #undefined
                     (let ((clause (car clauses)))
                       `(,the-if ,(if (and (identifier? (car clause))
                                           (identifier=? (the 'else) (make-identifier (car clause) env)))
                                      #t
                                      `(,(the 'or) ,@(map (lambda (x) `(,(the 'eqv?) ,the-key (,the-quote ,x))) (car clause))))
                                 ,(if (and (identifier? (cadr clause))
                                           (identifier=? (the '=>) (make-identifier (cadr clause) env)))
                                      `(,(car (cdr (cdr clause))) ,the-key)
                                      `(,the-begin ,@(cdr clause)))
                                 ,(loop (cdr clauses)))))))))))

    (define-transformer 'parameterize
      (lambda (form env)
        (let ((formal (car (cdr form)))
              (body   (cdr (cdr form))))
          `(,(the 'with-dynamic-environment)
            (,(the 'list) ,@(map (lambda (x) `(,(the 'cons) ,(car x) ,(cadr x))) formal))
            (,the-lambda () ,@body)))))

    (define-transformer 'syntax-quote
      (lambda (form env)
        (let ((renames '()))
          (letrec
              ((rename (lambda (var)
                         (let ((x (assq var renames)))
                           (if x
                               (cadr x)
                               (begin
                                 (set! renames `((,var ,(make-identifier var env) (,(the 'make-identifier) ',var ',env)) . ,renames))
                                 (rename var))))))
               (walk (lambda (f form)
                       (cond
                        ((identifier? form)
                         (f form))
                        ((pair? form)
                         `(,(the 'cons) (walk f (car form)) (walk f (cdr form))))
                        ((vector? form)
                         `(,(the 'list->vector) (walk f (vector->list form))))
                        (else
                         `(,(the 'quote) ,form))))))
            (let ((form (walk rename (cadr form))))
              `(,(the 'let)
                ,(map cdr renames)
                ,form))))))

    (define-transformer 'syntax-quasiquote
      (lambda (form env)
        (let ((renames '()))
          (letrec
              ((rename (lambda (var)
                         (let ((x (assq var renames)))
                           (if x
                               (cadr x)
                               (begin
                                 (set! renames `((,var ,(make-identifier var env) (,(the 'make-identifier) ',var ',env)) . ,renames))
                                 (rename var)))))))

            (define (syntax-quasiquote? form)
              (and (pair? form)
                   (identifier? (car form))
                   (identifier=? (the 'syntax-quasiquote) (make-identifier (car form) env))))

            (define (syntax-unquote? form)
              (and (pair? form)
                   (identifier? (car form))
                   (identifier=? (the 'syntax-unquote) (make-identifier (car form) env))))

            (define (syntax-unquote-splicing? form)
              (and (pair? form)
                   (pair? (car form))
                   (identifier? (caar form))
                   (identifier=? (the 'syntax-unquote-splicing) (make-identifier (caar form) env))))

            (define (qq depth expr)
              (cond
               ;; syntax-unquote
               ((syntax-unquote? expr)
                (if (= depth 1)
                    (car (cdr expr))
                    (list (the 'list)
                          (list (the 'quote) (the 'syntax-unquote))
                          (qq (- depth 1) (car (cdr expr))))))
               ;; syntax-unquote-splicing
               ((syntax-unquote-splicing? expr)
                (if (= depth 1)
                    (list (the 'append)
                          (car (cdr (car expr)))
                          (qq depth (cdr expr)))
                    (list (the 'cons)
                          (list (the 'list)
                                (list (the 'quote) (the 'syntax-unquote-splicing))
                                (qq (- depth 1) (car (cdr (car expr)))))
                          (qq depth (cdr expr)))))
               ;; syntax-quasiquote
               ((syntax-quasiquote? expr)
                (list (the 'list)
                      (list (the 'quote) (the 'quasiquote))
                      (qq (+ depth 1) (car (cdr expr)))))
               ;; list
               ((pair? expr)
                (list (the 'cons)
                      (qq depth (car expr))
                      (qq depth (cdr expr))))
               ;; vector
               ((vector? expr)
                (list (the 'list->vector) (qq depth (vector->list expr))))
               ;; identifier
               ((identifier? expr)
                (rename expr))
               ;; simple datum
               (else
                (list (the 'quote) expr))))

            (let ((body (qq 1 (cadr form))))
              `(,(the 'let)
                ,(map cdr renames)
                ,body))))))

    (define-transformer 'define-syntax
      (lambda (form env)
        (let ((formal (car (cdr form)))
              (body   (cdr (cdr form))))
          (if (pair? formal)
              `(,(the 'define-syntax) ,(car formal) (,the-lambda ,(cdr formal) ,@body))
              `(,the-define-macro ,formal (,(the 'transformer) (,the-begin ,@body)))))))

    (define-transformer 'letrec-syntax
      (lambda (form env)
        (let ((formal (car (cdr form)))
              (body   (cdr (cdr form))))
          `(let ()
             ,@(map (lambda (x)
                      `(,(the 'define-syntax) ,(car x) ,(cadr x)))
                    formal)
             ,@body))))

    (define-transformer 'let-syntax
      (lambda (form env)
        `(,(the 'letrec-syntax) ,@(cdr form))))))