3BSD/usr/lib/lisp/backquote

(setsyntax '";" 'splicing 'zapline)
(setq **backquote** 1)

(setsyntax '"`" 'macro '(lambda nil
  (back=quotify  ((lambda (**backquote**) (read)) 
		    (add1 **backquote**)))))

(setsyntax '"," 'macro '(lambda nil
  ((lambda (**backquote**)
	   (cond ((zerop **backquote**)
		  (break '"comma not inside a backquote."))
		 ((equal (tyipeek) 64)
		  (tyi)
		  (cons '",@" (read)))
		 (t (cons '"," (read)))))
   (sub1 **backquote**]

(def back=quotify 
  (lambda (x)
	  ((lambda (a d aa ad dqp)
		   (cond ((atom x) (list 'quote x))
			 ((eq (car x) '",") (cdr x))
			 ((or (atom (car x))
			      (not (memq (caar x) '( ",@" ",."))))
			  (setq a (back=quotify (car x)) d (back=quotify (cdr x))
				ad (atom d) aa (atom a)
				dqp (and (not ad) (eq (car d) 'quote)))
			  (cond ((and dqp (not (atom a)) (eq (car a) 'quote))
				 (list 'quote (cons (cadr a) (cadr d))))
				((and dqp (null (cadr d)))
				 (list 'list a))
				((and (not ad) (eq (car d) 'list))
				 (cons 'list (cons a (cdr d))))
				(t (list 'cons a d))))
			 ((eq (caar x) '",@")
			  (list 'append (cdar x) (back=quotify (cdr x))))
			 ((eq (caar x) '",.")
			  (list 'nconc (cdar x)(back=quotify (cdr x))))
			 ))
	   nil nil nil nil nil)))