Changeset 13252

Timestamp:

Dec 3, 2009, 10:38:54 AM (15 years ago)

Author:

Gary Byers

Message:

In NX1-REQUIRE (which handles REQUIRE-TYPE of builtin types), treat
the form as (THE type form) - with no runtime typecheck - in unsafe
code.

File:

• trunk/source/compiler/nx1.lisp (modified) (1 diff)

trunk/source/compiler/nx1.lisp

@@ -454 +454 @@
                       (%nx1-operator %natural-logand)))
 
-(defnx1 nx1-require ((require-simple-vector) (require-simple-string) (require-integer) (require-list)
-                     (require-fixnum) (require-real) (require-character) (require-number) (require-symbol) (require-s8) (require-u8) (require-s16) (require-u16) (require-s32) (require-u32) (require-s64) (require-u64))
-        (arg)
-  (make-acode (%nx1-default-operator) (nx1-form arg)))
+(defnx1 nx1-require ((require-simple-vector)
+                     (require-simple-string)
+                     (require-integer)
+                     (require-list)
+                     (require-fixnum)
+                     (require-real)
+                     (require-character)
+                     (require-number)
+                     (require-symbol)
+                     (require-s8)
+                     (require-u8)
+                     (require-s16)
+                     (require-u16)
+                     (require-s32)
+                     (require-u32)
+                     (require-s64)
+                     (require-u64))
+        (arg &environment env)
+
+  (if (nx-inhibit-safety-checking env)
+    (let* ((op *nx-sfname*)
+           (type (case op
+                   (require-simple-vector 'simple-vector)
+                   (require-simple-string 'simple-string)
+                   (require-integer 'integer)
+                     (require-list 'list)
+                     (require-fixnum 'fixnum)
+                     (require-real 'real)
+                     (require-character 'charater)
+                     (require-number 'number)
+                     (require-symbol 'symbol)
+                     (require-s8 '(signed-byte 8))
+                     (require-u8 '(unsigned-byte 8))
+                     (require-s16 '(signed-byte 16))
+                     (require-u16 '(unsigned-byte 16))
+                     (require-s32 '(signed-byte 32))
+                     (require-u32 '(unsigned-byte 32))
+                     (require-s64 '(signed-byte 64))
+                     (require-u64 '(unsigned-byte 64)))))
+      (nx1-form `(the ,type ,arg)))
+    (make-acode (%nx1-default-operator) (nx1-form arg))))
 
 (defnx1 nx1-%marker-marker ((%unbound-marker) (%slot-unbound-marker) (%illegal-marker)) ()