From 6d3302ccabeed8cfabd709c0390a94537255b60d Mon Sep 17 00:00:00 2001
From: Juan Jose Garcia Ripoll <jjgarcia@users.sourceforge.net>
Date: Sun, 11 Dec 2011 18:20:29 +0100
Subject: [PATCH] When a compiler macro aborts with an error, ECL just
 recovers, issues a warning and continues.

---
 src/CHANGELOG       |  4 ++++
 src/cmp/cmpeval.lsp |  6 +++---
 src/cmp/cmputil.lsp | 13 ++++++++++++-
 3 files changed, 19 insertions(+), 4 deletions(-)

diff --git a/src/CHANGELOG b/src/CHANGELOG
index f9a0cda54..e59dccf64 100755
--- a/src/CHANGELOG
+++ b/src/CHANGELOG
@@ -147,6 +147,10 @@ ECL 11.7.1:
    done using two new functions, EXT:HASH-TABLE-CONTENT and
    EXT:HASH-TABLE-FILL.
 
+ - When a compiler macro fails, ECL simply ignores the errors and
+   continues. This is more to the spirit of the compiler macros, as explained
+   here http://lists.common-lisp.net/pipermail/pro/2011-December/000675.html
+
 ;;; Local Variables: ***
 ;;; mode:text ***
 ;;; fill-column:79 ***
diff --git a/src/cmp/cmpeval.lsp b/src/cmp/cmpeval.lsp
index 048065352..f2d963a55 100644
--- a/src/cmp/cmpeval.lsp
+++ b/src/cmp/cmpeval.lsp
@@ -47,15 +47,15 @@
 (defvar *c1t* (make-c1form* 'LOCATION :type (object-type t) :args t))
 (defun c1t () *c1t*)
 
-(defun c1call-symbol (fname args &aux fd)
+(defun c1call-symbol (fname args &aux fd success)
   (cond ((setq fd (gethash fname *c1-dispatch-table*))
 	 (funcall fd args))
 	((c1call-local fname args))
 	((and (setq fd (compiler-macro-function fname))
 	      (inline-possible fname)
-	      (let ((success nil))
+	      (progn
 		(multiple-value-setq (fd success)
-		  (cmp-expand-macro fd (list* fname args)))
+		  (cmp-expand-compiler-macro fd fname args))
 		success))
 	 (c1expr fd))
 	((setq fd (cmp-macro-function fname))
diff --git a/src/cmp/cmputil.lsp b/src/cmp/cmputil.lsp
index 46fa12906..ab5a0722c 100644
--- a/src/cmp/cmputil.lsp
+++ b/src/cmp/cmputil.lsp
@@ -98,10 +98,13 @@
 
 (define-condition compiler-debug-note (compiler-note) ())
 
-(define-condition compiler-warning (compiler-message simple-condition style-warning)
+(define-condition compiler-warning (compiler-message style-warning)
   ((prefix :initform "Warning")
    (format :initform +warn-format+)))
 
+(define-condition compiler-macro-expansion-failed (compiler-warning)
+  ())
+
 (define-condition compiler-error (compiler-message)
   ((prefix :initform "Error")
    (format :initform +error-format+)))
@@ -364,6 +367,14 @@
               form c)
       (values nil nil))))
   
+(defun cmp-expand-compiler-macro (fd fname args &optional (env *cmp-env*))
+  (handler-case
+      (cmp-expand-macro fd (list* fname args))
+    (serious-condition (c)
+      (do-cmpwarn 'compiler-macro-expansion-failed
+	:format-control "The expansion of the compiler macro~%~T~A~%was aborted because of a serious condition~%~A" :format-arguments (list fname c))
+      (values nil nil))))
+
 (defun si::compiler-clear-compiler-properties (symbol)
   #-:CCL
   ;(sys::unlink-symbol symbol)