(define (qq-expand x)
  (if (and (pair? x) (eq? 'quasiquote (car x)))
      (qq-expand-to (cadr x) 0)
      x))

(define (qq-expand-to x depth)
  (if (pair? x)
      (case (car x)
        ((quasiquote)
         `(cons ',(car x) ,(qq-expand-to (cdr x) (+ depth 1))))
        ((unquote unquote-splicing)
         (cond ((> depth 0)
                `(cons ',(car x) ,(qq-expand-to (cdr x) (- depth 1))))
               ((and (eq? 'unquote (car x))
                     (not (null? (cdr x)))
                     (null? (cddr x)))
                (cadr x))
               (else 
                (error "Illegal"))))
        (else
         `(append ,(qq-expand-list (car x) depth)
                  ,(qq-expand-to (cdr x) depth))))
      `',x))))

(define (qq-expand-list x depth)
  (if (pair? x)
      (case (car x)
        ((quasiquote)
         `(list (cons ',(car x) ,(qq-expand-to (cdr x) (+ depth 1)))))
        ((unquote unquote-splicing)
         (cond ((> depth 0)
                `(list (cons ',(car x) ,(qq-expand-to (cdr x) (- depth 1)))))
               ((eq? 'unquote (car x))
                `(list . ,(cdr x)))
               (else
                `(append . ,(cdr x)))))
        (else
         `(list (append ,(qq-expand-list (car x) depth)
                        ,(qq-expand-to (cdr x) depth)))))
      `'(,x)))