#lang scheme

(define (caar? a) (and (pair? a) (pair? (car a)) (not (pair? (caar a)))))

;; insert before the leftmost member of each list a different symbol
(define (insert-prefix datum prefix [splicer #f])
  (cond
    [(not (pair? datum)) datum]
    [(eq? (car datum) 'quote) datum]
    [(eq? (car datum) 'unquote) (cadr datum)]
    [(eq? (car datum) 'unquote-splicing)
     (if splicer 
         (cons splicer (cdr datum))
         (cadr datum))]
    [else
     (apply list 
            prefix (list 'quote (car datum))
            (let loop ([datum (cdr datum)] [result null])
              (if (null? datum) (reverse result)
                  (loop
                   (cdr datum)
                   (if (caar? datum)
                       (cons (insert-prefix (car datum) prefix splicer) result)
                       (cons (car datum) result))))))]))

(provide insert-prefix)