From 0f7abae8b9525d60685ae3b9ecc2fb4131c766a4 Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Sat, 26 Jul 2008 19:23:28 +0200 Subject: Reader: Support quasiquotation. --- util.lisp | 37 +++++++++++++++++++++++++++++++++++++ 1 file changed, 37 insertions(+) (limited to 'util.lisp') diff --git a/util.lisp b/util.lisp index 50688a3..ca1b25a 100644 --- a/util.lisp +++ b/util.lisp @@ -134,3 +134,40 @@ (list 'quote (car this-clause)))) (cons 'progn (cdr this-clause)) (list* 'case object-sym rest))))))) + +(%defmacro* sys::quasiquote (object) + (if (not (consp object)) + (list 'quote object) + (cond ((eq 'sys::unquote (car object)) (car (cdr object))) + ((eq 'sys::quasiquote (car object)) (list 'quote object)) + ((and (consp (car object)) + (eq 'sys::unquote-splicing (car (car object)))) + (list 'append + (car (cdr (car object))) + (list 'sys::quasiquote (cdr object)))) + (t (list 'cons + (list 'sys::quasiquote (car object)) + (list 'sys::quasiquote (cdr object))))))) + +(%defun* list-eqp (list1 list2) + "Not really EQUALP (only works on trees of symbols)." + (if (and (consp list1) (consp list2)) + (and (list-eqp (car list1) (car list2)) + (list-eqp (cdr list1) (cdr list2))) + (eq list1 list2))) + +(%defun* macroexpand (object . rest) + (let* ((env (if rest (car rest) nil)) + (expansion-1 (macroexpand-1 object env)) + (expansion-2 (macroexpand-1 expansion-1 env))) + (if (list-eqp expansion-1 expansion-2) + expansion-1 + (macroexpand expansion-2)))) + +(%defun* macroexpand-all (object . rest) + (let* ((env (if rest (car rest) nil))) + (if (consp object) + (let ((expansion (macroexpand object env))) + (cons (macroexpand-all (car expansion)) + (macroexpand-all (cdr expansion)))) + object))) -- cgit v1.2.3