Changeset 4260 for trunk/j/src/org/armedbear/lisp/subtypep.lisp

Timestamp:

10/09/03 01:41:44 (19 years ago)

Author:

piso

Message:

SUBTYPEP-NORMALIZE-TYPE

File:

• trunk/j/src/org/armedbear/lisp/subtypep.lisp (modified) (4 diffs)

trunk/j/src/org/armedbear/lisp/subtypep.lisp

@@ -2 +2 @@
 ;;;
 ;;; Copyright (C) 2003 Peter Graves
-;;; $Id: subtypep.lisp,v 1.18 2003-10-08 19:12:00 piso Exp $
+;;; $Id: subtypep.lisp,v 1.19 2003-10-09 01:41:44 piso Exp $
 ;;;
 ;;; This program is free software; you can redistribute it and/or
@@ -111 +111 @@
 
 (defun subtypep-normalize-type (type)
+  (when (symbolp type)
+    (case type
+      (FIXNUM
+       (return-from subtypep-normalize-type
+                    '(integer #.most-negative-fixnum #.most-positive-fixnum)))
+      (BASE-CHAR
+       (return-from subtypep-normalize-type 'character))))
   (let (tp i)
     (loop
@@ -129 +136 @@
                (setq i (cadr i))
                (setq i (list (cadr i)))))))
-      (BASE-CHAR
-       (setq tp 'character))
-      (FIXNUM
-       (setq tp 'integer i '(#.most-negative-fixnum #.most-positive-fixnum)))
       ((SHORT-FLOAT SINGLE-FLOAT DOUBLE-FLOAT LONG-FLOAT)
        (setq tp 'float)))
@@ -309 +312 @@
                  (t
                   (values nil nil)))))))
+
+(when (fboundp 'jvm::jvm-compile)
+  (mapcar #'jvm::jvm-compile '(sys::subtypep-normalize-type
+                               sys::sub-interval-p
+                               sys::simple-subtypep
+                               subtypep)))