;;; -*- Mode:LISP; Package:READ; Readtable:CL; Base:10 -*-

(defmacro backquote (argument)


(backquote (foo bar)) --> (quote (foo bar))
(backquote foo) -> (quote foo)
(backquote (unquote foo)) -> foo

(backquote (foo bar)) -> (quote (foo bar))
(backquote ((unquote foo) bar)) -> (foo (quote bar))

`(,foo bar)

;;; (backquote (e1 e2 ... en . (unquote form)))


(defmacro backquote (expression)
  (cond ((vectorp expression)
	 `(VECTOR ,@(nbutlast 
		      (expand-backquoted-list (coerce expression 'list)))))
	((not (listp expression))
	 `(QUOTE ,expression))
	((eq (car expression) 'UNQUOTE)
	 `,(cadr expression))
	((or (eq (car expression) 'UNQUOTE-SPLICING)
	     (eq (car expression) 'DESTRUCTIVE-UNQUOTE-SPLICING))
	 (error "Can't unquote-splicing immediaely after backquote."))
	((eq (car expression) 'BACKQUOTE)
	 `(BACKQUOTE ,(macroexpand expression)))
	(t
	 `(LIST* ,@(expand-backquoted-list expression)))))


(apply #'list* (expand-backquoted-list expression)))))








;`(quote foo)
;(append [quote] [foo])
;(append (list 'quote) (list 'foo))




					 
(defun expand-backquoted-list (expr)
  "EXPR is a (possibly dotted) list.  Return a list suitable for LIST* to be applied to."
  (cond
    ((not (consp expr))
     (list `(QUOTE ,expr)))
    ((eq (car expr) 'UNQUOTE)
     (cadr expr))
    ((or (eq (car expr) 'UNQUOTE-SPLICING)
	 (eq (car expr) 'DESTRUCTIVE-UNQUOTE-SPLICING))
     (error "foo"))
    (t
     (let ((element (car expr)))
       (cond ((not (listp element))
	      (cons `(BACKQUOTE ,element)
		    (expand-backquoted-list (cdr expr))))
	     ((eq (car element) 'UNQUOTE)
	      (cons (cadr element)
		    (expand-backquoted-list (cdr expr))))
	     ((or (eq (car element) 'UNQUOTE-SPLICING)
		  (eq (car element) 'DESTRUCTIVE-UNQUOTE-SPLICING))
	      (if (listp (cadr element))
		  (append (cadr element)
			  (expand-backquoted-list (cdr expr)))
		  (error "bar")))
	     (t
	      (cons `(BACKQUOTE ,element)
		    (expand-backquoted-list (cdr expr)))))))))


(defun unquote (expression)
  (error "Can't unquote"))

(defun unquote-splicing (expression)
  (error "Can't unquote splicing"))

(defun destructive-unquote-splicing (expression)
  (error "Can't unquote splicing"))