# HG changeset patch
# User Aidan Kehoe <kehoea@parhasard.net>
# Date 1284640563 -3600
# Node ID 0d436a78c514cca5bc27c840366a2fa9b927fc00
# Parent  75bcb5bef4595fcc37f01e3e173d96b59fa8a821
Add an implementation for #'the, cl-macs.el

lisp/ChangeLog addition:

2010-09-16  Aidan Kehoe  <kehoea@parhasard.net>

	* cl-macs.el (the): Add a docstring and an implementation for this
	macro.
	* bytecomp.el (byte-compile-initial-macro-environment): Add #'the
	to this, checking byte-compile-delete-errors to decide whether to
	make the type assertion. Change the initvalue to use backquote and
	preceding commas for the lambda expressions, to allow the latter
	to be compiled.

diff -r 75bcb5bef459 -r 0d436a78c514 lisp/ChangeLog
--- a/lisp/ChangeLog	Tue Sep 07 17:03:46 2010 +0100
+++ b/lisp/ChangeLog	Thu Sep 16 13:36:03 2010 +0100
@@ -1,3 +1,13 @@
+2010-09-16  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* cl-macs.el (the): Add a docstring and an implementation for this
+	macro.
+	* bytecomp.el (byte-compile-initial-macro-environment): Add #'the
+	to this, checking byte-compile-delete-errors to decide whether to
+	make the type assertion. Change the initvalue to use backquote and
+	preceding commas for the lambda expressions, to allow the latter
+	to be compiled.
+
 2010-09-06  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* cl-seq.el (replace):
diff -r 75bcb5bef459 -r 0d436a78c514 lisp/bytecomp.el
--- a/lisp/bytecomp.el	Tue Sep 07 17:03:46 2010 +0100
+++ b/lisp/bytecomp.el	Thu Sep 16 13:36:03 2010 +0100
@@ -493,13 +493,21 @@
 	  (fset (car elt) (cdr elt)))))))
 
 (defconst byte-compile-initial-macro-environment
-  '((byte-compiler-options . (lambda (&rest forms)
-			       (apply 'byte-compiler-options-handler forms)))
-    (eval-when-compile . (lambda (&rest body)
-			   (list 'quote (byte-compile-eval (cons 'progn body)))))
-    (eval-and-compile . (lambda (&rest body)
-			  (byte-compile-eval (cons 'progn body))
-			  (cons 'progn body))))
+  `((byte-compiler-options
+      . ,#'(lambda (&rest forms)
+	     (apply 'byte-compiler-options-handler forms)))
+    (eval-when-compile
+      . ,#'(lambda (&rest body)
+	     (list 'quote (byte-compile-eval (cons 'progn body)))))
+    (eval-and-compile
+      . ,#'(lambda (&rest body)
+	     (byte-compile-eval (cons 'progn body))
+	     (cons 'progn body)))
+    (the .
+      ,#'(lambda (&rest body)
+	   (if byte-compile-delete-errors
+	       (second body)
+	     (apply (cdr (symbol-function 'the)) body)))))
   "The default macro-environment passed to macroexpand by the compiler.
 Placing a macro here will cause a macro to have different semantics when
 expanded by the compiler as when expanded by the interpreter.")
diff -r 75bcb5bef459 -r 0d436a78c514 lisp/cl-macs.el
--- a/lisp/cl-macs.el	Tue Sep 07 17:03:46 2010 +0100
+++ b/lisp/cl-macs.el	Thu Sep 16 13:36:03 2010 +0100
@@ -1962,7 +1962,19 @@
 ;;;###autoload
 (defmacro locally (&rest body) (cons 'progn body))
 ;;;###autoload
-(defmacro the (type form) form)
+(defmacro the (type form)
+  "Assert that FORM gives a result of type TYPE, and return FORM.
+
+TYPE is a Common Lisp type specifier.
+
+If macro expansion of a `the' form happens during byte compilation, and the
+byte compiler customization variable `byte-compile-delete-errors' is
+non-nil, `the' just returns FORM, without making any type checks."
+  (if (cl-safe-expr-p form)
+      `(prog1 ,form (assert ,(cl-make-type-test form type) t))
+    (let ((saved (gensym)))
+      `(let ((,saved ,form))
+        (prog1 ,saved (assert ,(cl-make-type-test saved type) t))))))
 
 (defvar cl-proclaim-history t)    ; for future compilers
 (defvar cl-declare-stack t)       ; for future compilers