[armedbear-cvs] r14081 - trunk/abcl/src/org/armedbear/lisp

[ehuelsmann at common-lisp.net]

Author: ehuelsmann
Date: Tue Aug 14 01:01:40 2012
New Revision: 14081

Log:
Re #236: prepare to offer restarts from inside the compiler.

Note: Restarts, when used to replace forms, need to be in pass1 because that's
      where we inject variable references, etc.

Modified:
   trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp	Mon Aug 13 09:04:38 2012	(r14080)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp	Tue Aug 14 01:01:40 2012	(r14081)
@@ -977,17 +977,9 @@
     (when (and (consp function-form)
                (eq (%car function-form) 'FUNCTION))
       (let ((name (%cadr function-form)))
-;;         (format t "p1-funcall name = ~S~%" name)
         (let ((source-transform (source-transform name)))
           (when source-transform
-;;             (format t "found source transform for ~S~%" name)
-;;             (format t "old form = ~S~%" form)
-;;             (let ((new-form (expand-source-transform form)))
-;;               (when (neq new-form form)
-;;                 (format t "new form = ~S~%" new-form)
-;;                 (return-from p1-funcall (p1 new-form))))
             (let ((new-form (expand-source-transform (list* name (cddr form)))))
-;;               (format t "new form = ~S~%" new-form)
               (return-from p1-funcall (p1 new-form)))
             )))))
   ;; Otherwise...
@@ -1164,9 +1156,6 @@
   (let* ((op (car form))
          (local-function (find-local-function op)))
     (when local-function
-;;            (format t "p1 local call to ~S~%" op)
-;;            (format t "inline-p = ~S~%" (inline-p op))
-
       (when (and *enable-inline-expansion* (inline-p op)
                  (local-function-definition local-function))
         (let* ((definition (local-function-definition local-function))
@@ -1272,7 +1261,7 @@
                 (p1 `(%funcall (function ,op) ,@(cdr form)))
                 (p1 maybe-optimized-call))))
          (t
-          form))))))
+          (compiler-unsupported "P1 unhandled case ~S" form)))))))
 
 (defun install-p1-handler (symbol handler)
   (setf (get symbol 'p1-handler) handler))
@@ -1322,7 +1311,6 @@
 (initialize-p1-handlers)
 
 (defun p1-compiland (compiland)
-;;   (format t "p1-compiland name = ~S~%" (compiland-name compiland))
   (let ((*current-compiland* compiland)
         (*local-functions* *local-functions*)
         (*visible-variables* *visible-variables*)