Changeset 4119

Timestamp:

09/29/03 01:29:13 (19 years ago)

Author:

piso

Message:

SUBTYPEP: work in progress.

File:

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

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

@@ -2 +2 @@
 ;;;
 ;;; Copyright (C) 2003 Peter Graves
-;;; $Id: subtypep.lisp,v 1.15 2003-09-27 17:31:58 piso Exp $
+;;; $Id: subtypep.lisp,v 1.16 2003-09-29 01:29:13 piso Exp $
 ;;;
 ;;; This program is free software; you can redistribute it and/or
@@ -250 +250 @@
                        (values nil t)))
                   (t (values nil (known-type-p t1)))))
+           ((eq t2 'vector)
+            (if (eq t1 'base-string)
+                (if (eq (car i2) 'base-char)
+                    (values t t)
+                    (values nil t))
+                (values nil (known-type-p t2))))
            ((eq t2 'simple-string)
             (if (memq t1 '(simple-string simple-base-string))
                 (if (or (null i2) (eq (car i2) '*))
+                    (values t t)
+                    (values nil t))
+                (values nil (known-type-p t2))))
+           ((eq t2 'base-string)
+            (if (eq t1 'vector)
+                (if (eq (car i1) 'base-char)
+                    (values t t)
+                    (values nil t))
+                (values nil (known-type-p t2))))
+           ((eq t2 'string)
+            (if (eq t1 'vector)
+                (if (eq (car i1) 'character)
                     (values t t)
                     (values nil t))