1.0.15.36: fix bug 423

[sbcl.git] / src / compiler / ir1-translators.lisp

diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp
index 48bc62a..a6a6f64 100644 (file)
--- a/src/compiler/ir1-translators.lisp
+++ b/src/compiler/ir1-translators.lisp
@@ -74,7 +74,7 @@ otherwise evaluate ELSE and return its values. ELSE defaults to NIL."
   (if (policy *lexenv* (= store-coverage-data 0))
       nil
       (labels ((sub (form)
-                 (or (gethash form *source-paths*)
+                 (or (get-source-path form)
                      (and (consp form)
                           (some #'sub form)))))
         (or (sub form)))))
@@ -475,10 +475,11 @@ Return VALUE without evaluating it."
 (defun name-lambdalike (thing)
   (ecase (car thing)
     ((named-lambda)
-     (second thing))
+     (or (second thing)
+         `(lambda ,(third thing))))
     ((lambda instance-lambda)
      `(lambda ,(second thing)))
-    ((lambda-with-lexenv)'
+    ((lambda-with-lexenv)
      `(lambda ,(fifth thing)))))
 
 (defun fun-name-leaf (thing)
@@ -575,7 +576,7 @@ be a lambda expression."
 ;;; directly to %FUNCALL, instead of waiting around for type
 ;;; inference.
 (define-source-transform funcall (function &rest args)
-  (if (and (consp function) (eq (car function) 'function))
+  (if (and (consp function) (member (car function) '(function lambda)))
       `(%funcall ,function ,@args)
       (let ((name (constant-global-fun-name function)))
         (if name
@@ -585,6 +586,11 @@ be a lambda expression."
 (deftransform %coerce-callable-to-fun ((thing) (function) *)
   "optimize away possible call to FDEFINITION at runtime"
   'thing)
+
+(define-source-transform %coerce-callable-to-fun (thing)
+  (if (and (consp thing) (member (car thing) '(function lambda)))
+      thing
+      (values nil t)))
 \f
 ;;;; LET and LET*
 ;;;;
@@ -700,7 +706,7 @@ form to reference any of the previous VARS."
   #!+sb-doc
   "LOCALLY declaration* form*
 
-Sequentially evaluate the FORMS in a lexical environment where the the
+Sequentially evaluate the FORMS in a lexical environment where the
 DECLARATIONS have effect. If LOCALLY is a top level form, then the FORMS are
 also processed as top level forms."
   (ir1-translate-locally body start next result))
@@ -854,26 +860,34 @@ other."
 
 ;;; Assert that FORM evaluates to the specified type (which may be a
 ;;; VALUES type). TYPE may be a type specifier or (as a hack) a CTYPE.
-(def-ir1-translator the ((type value) start next result)
-  (the-in-policy type value (lexenv-policy *lexenv*) start next result))
+(def-ir1-translator the ((value-type form) start next result)
+  #!+sb-doc
+  "Specifies that the values returned by FORM conform to the VALUE-TYPE.
+
+CLHS specifies that the consequences are undefined if any result is
+not of the declared type, but SBCL treats declarations as assertions
+as long as SAFETY is at least 2, in which case incorrect type
+information will result in a runtime type-error instead of leading to
+eg. heap corruption. This is however expressly non-portable: use
+CHECK-TYPE instead of THE to catch type-errors at runtime. THE is best
+considered an optimization tool to inform the compiler about types it
+is unable to derive from other declared types."
+  (the-in-policy value-type form (lexenv-policy *lexenv*) start next result))
 
 ;;; This is like the THE special form, except that it believes
 ;;; whatever you tell it. It will never generate a type check, but
 ;;; will cause a warning if the compiler can prove the assertion is
 ;;; wrong.
-(def-ir1-translator truly-the ((type value) start next result)
+(def-ir1-translator truly-the ((value-type form) start next result)
   #!+sb-doc
-  ""
-  #-nil
-  (let ((type (coerce-to-values (compiler-values-specifier-type type)))
-        (old (when result (find-uses result))))
-    (ir1-convert start next result value)
-    (when result
-      (do-uses (use result)
-        (unless (memq use old)
-          (derive-node-type use type)))))
-  #+nil
-  (the-in-policy type value '((type-check . 0)) start cont))
+  "Specifies that the values returned by FORM conform to the
+VALUE-TYPE, and causes the compiler to trust this information
+unconditionally.
+
+Consequences are undefined if any result is not of the declared type
+-- typical symptoms including memory corruptions. Use with great
+care."
+  (the-in-policy value-type form '((type-check . 0)) start next result))
 \f
 ;;;; SETQ