Changeset 3828

Timestamp:

09/16/03 17:59:41 (20 years ago)

Author:

piso

Message:

IN-INTERVAL-P

File:

• trunk/j/src/org/armedbear/lisp/typep.lisp (modified) (3 diffs)

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

@@ -2 +2 @@
 ;;;
 ;;; Copyright (C) 2003 Peter Graves
-;;; $Id: typep.lisp,v 1.4 2003-09-14 17:57:45 piso Exp $
+;;; $Id: typep.lisp,v 1.5 2003-09-16 17:59:41 piso Exp $
 ;;;
 ;;; This program is free software; you can redistribute it and/or
@@ -30 +30 @@
          (and (null displaced-to) (zerop offset)))))
 
+(defun in-interval-p (x interval)
+  (let (low high)
+    (if (endp interval)
+        (setq low '* high '*)
+        (if (endp (cdr interval))
+            (setq low (car interval) high '*)
+            (setq low (car interval) high (cadr interval))))
+    (cond ((eq low '*))
+          ((consp low)
+           (when (<= x (car low)) (return-from in-interval-p nil)))
+          ((when (< x low) (return-from in-interval-p nil))))
+    (cond ((eq high '*))
+          ((consp high)
+           (when (>= x (car high)) (return-from in-interval-p nil)))
+          ((when (> x high) (return-from in-interval-p nil))))
+    (return-from in-interval-p t)))
+
 (defun match-dimensions (dim pat)
   (if (null dim)
@@ -53 +70 @@
            (return-from typep t)))
        nil)
+      (INTEGER
+       (and (integerp object) (in-interval-p object i)))
       (SIMPLE-BIT-VECTOR
        (and (simple-bit-vector-p object)