Elide struct type checks in unsafe code.

froggey · Feb 20, 2017 · 61743cd · 61743cd
1 parent 168f286
commit 61743cd
Show file tree

Hide file tree

Showing 2 changed files with 17 additions and 3 deletions.
diff --git a/compiler/transforms.lisp b/compiler/transforms.lisp
@@ -406,3 +406,11 @@
 (define-transform sys.int::%coerce-to-callable ((object function))
     ((:optimize (= safety 0) (= speed 3)))
   object)
+
+(define-transform sys.int::enable-unsafe-struct-access ()
+    ((:optimize (= safety 0)))
+  `'t)
+
+(define-transform sys.int::enable-unsafe-struct-access ()
+    ((:optimize (/= safety 0)))
+  `'nil)
diff --git a/system/defstruct.lisp b/system/defstruct.lisp
@@ -326,14 +326,20 @@
             (append included-slots
                     slot-descriptions))))
 
+;; The compiler will replace calls to this function with NIL or T
+;; depending on the current SAFETY setting.
+(defun enable-unsafe-struct-access ()
+  nil)
+
 (defmacro check-struct-type (place struct-type)
   (let ((value (gensym))
         (struct-type-sym (gensym "struct-type")))
     `(let ((,value ,place)
            (,struct-type-sym ,struct-type))
-       (when (not (and (structure-object-p ,value)
-                       (or (eql (%struct-slot ,value 0) ,struct-type-sym)
-                           (structure-type-p ,value ,struct-type-sym))))
+       (when (not (or (enable-unsafe-struct-access)
+                      (and (structure-object-p ,value)
+                           (or (eql (%struct-slot ,value 0) ,struct-type-sym)
+                               (structure-type-p ,value ,struct-type-sym)))))
          (raise-type-error ,value (structure-name ,struct-type-sym))))))
 
 (defun generate-normal-defstruct (name slot-descriptions conc-name constructors predicate area copier