X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=inline;f=src%2Fcompiler%2Fir1util.lisp;h=926e183a0d53222292affc8519e42c65548cc9e4;hb=dea9bd5c1afe23d9e061c60db654b88187ba9a5e;hp=7dd4459e41c442f23c5d074374f73add79dcadc2;hpb=9347abeb5f42dc83d372c19b14e86204a6a588dd;p=sbcl.git

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index 7dd4459..926e183 100644
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -1378,6 +1378,29 @@
 	  (funcall warn-fun "Lisp error during ~A:~%~A" context condition)
 	  (return-from careful-call (values nil nil))))))
    t))
+
+;;; Variations of SPECIFIER-TYPE for parsing possibly wrong
+;;; specifiers.
+(macrolet
+    ((deffrob (basic careful compiler transform)
+       `(progn
+          (defun ,careful (specifier)
+            (handler-case (,basic specifier)
+              (simple-error (condition)
+                (values nil (list* (simple-condition-format-control condition)
+                                   (simple-condition-format-arguments condition))))))
+          (defun ,compiler (specifier)
+            (multiple-value-bind (type error-args) (,careful specifier)
+              (or type
+                  (apply #'compiler-error error-args))))
+          (defun ,transform (specifier)
+            (multiple-value-bind (type error-args) (,careful specifier)
+              (or type
+                  (apply #'give-up-ir1-transform
+                         error-args)))))))
+  (deffrob specifier-type careful-specifier-type compiler-specifier-type ir1-transform-specifier-type)
+  (deffrob values-specifier-type careful-values-specifier-type compiler-values-specifier-type ir1-transform-values-specifier-type))
+
 
 ;;;; utilities used at run-time for parsing &KEY args in IR1