[armedbear-cvs] r11467 - trunk/abcl/src/org/armedbear/lisp

Ville Voutilainen vvoutilainen at common-lisp.net
Sun Dec 21 23:55:42 UTC 2008


Author: vvoutilainen
Date: Sun Dec 21 23:55:41 2008
New Revision: 11467

Log:
generate-type-check-for-value is very similar to
generate-type-check-for-variable, clean up
generate-type-check-for-value before combining
the functions.


Modified:
   trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	Sun Dec 21 23:55:41 2008
@@ -7926,22 +7926,15 @@
 
 (declaim (ftype (function (t) t) generate-type-check-for-value))
 (defun generate-type-check-for-value (declared-type)
-  (cond ((eq declared-type 'SYMBOL)
-         (generate-instanceof-type-check-for-value 'SYMBOL))
-        ((eq declared-type 'CHARACTER)
-         (generate-instanceof-type-check-for-value 'CHARACTER))
-        ((eq declared-type 'CONS)
-         (generate-instanceof-type-check-for-value 'CONS))
-        ((eq declared-type 'HASH-TABLE)
-         (generate-instanceof-type-check-for-value 'HASH-TABLE))
-        ((fixnum-type-p declared-type)
-         (generate-instanceof-type-check-for-value 'FIXNUM))
-        ((subtypep declared-type 'STRING)
-         (generate-instanceof-type-check-for-value 'STRING))
-        ((subtypep declared-type 'VECTOR)
-         (generate-instanceof-type-check-for-value 'VECTOR))
-        (t
-         nil)))
+  (let* ((type-to-use
+	  (or
+	   (when (fixnum-type-p declared-type) 'FIXNUM)
+	   (find-if #'(lambda (type) (eq type declared-type))
+		    `(SYMBOL CHARACTER CONS HASH-TABLE STREAM))
+	   (find-if #'(lambda (type) (subtypep declared-type type)) 
+		    `(STRING VECTOR)))))
+    (when type-to-use
+      (generate-instanceof-type-check-for-value type-to-use))))
 
 (defun p2-the (form target representation)
   (let ((type-form (second form))




More information about the armedbear-cvs mailing list