Changeset 3828


Ignore:
Timestamp:
09/16/03 17:59:41 (18 years ago)
Author:
piso
Message:

IN-INTERVAL-P

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/typep.lisp

    r3783 r3828  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: typep.lisp,v 1.4 2003-09-14 17:57:45 piso Exp $
     4;;; $Id: typep.lisp,v 1.5 2003-09-16 17:59:41 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    3030         (and (null displaced-to) (zerop offset)))))
    3131
     32(defun in-interval-p (x interval)
     33  (let (low high)
     34    (if (endp interval)
     35        (setq low '* high '*)
     36        (if (endp (cdr interval))
     37            (setq low (car interval) high '*)
     38            (setq low (car interval) high (cadr interval))))
     39    (cond ((eq low '*))
     40          ((consp low)
     41           (when (<= x (car low)) (return-from in-interval-p nil)))
     42          ((when (< x low) (return-from in-interval-p nil))))
     43    (cond ((eq high '*))
     44          ((consp high)
     45           (when (>= x (car high)) (return-from in-interval-p nil)))
     46          ((when (> x high) (return-from in-interval-p nil))))
     47    (return-from in-interval-p t)))
     48
    3249(defun match-dimensions (dim pat)
    3350  (if (null dim)
     
    5370           (return-from typep t)))
    5471       nil)
     72      (INTEGER
     73       (and (integerp object) (in-interval-p object i)))
    5574      (SIMPLE-BIT-VECTOR
    5675       (and (simple-bit-vector-p object)
Note: See TracChangeset for help on using the changeset viewer.