;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 125.9
;;; Reason:
;;;  Problems with describing an integer type.  If you do:
;;;      (setq a 4)
;;;      (check-type a (integer 5))
;;;  you get:
;;;       error: a is not an integer greater than 5
;;;  Fixed to be
;;;       error: a is not an integer greater than or equal to 5
;;;  
;;;  If you then do:
;;;      (check-type a (integer (4)))
;;;  you get:
;;;       error: a is not an integer greater than 5
;;;  Fixed to be
;;;       error: a is not an integer greater than 4
;;;  
;;;  Similar fixes for when the upper bound is specified
;;;  inclusively or exclusively.
;;; Written 20-Jul-88 17:39:43 by pld (Peter L. DeWolf) at site Gigamos Cambridge
;;; while running on Cthulhu from band 3
;;; with System 125.8, ZWEI 125.2, ZMail 73.0, Local-File 75.0, File-Server 24.0, Unix-Interface 13.0, Tape 24.0, Lambda-Diag 17.0, Experimental Kermit 36.3, microcode 1761, SDU Boot Tape 3.14, SDU ROM 8.



; From modified file DJ: L.SYS; TYPES.LISP#106 at 20-Jul-88 17:39:55
#10R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; TYPES  "

(defun integer-type-name (type noun article &aux low low-inclusive high high-inclusive)
  (setq low (cond ((null (cdr type)) '*)
		  ((consp (cadr type)) (floor (1+ (car (cadr type)))))
		  ((integerp (cadr type))
		   (setq low-inclusive t)
		   (cadr type))
		  (t (cadr type))))
  (setq high (cond ((null (cddr type)) '*)
		   ((consp (caddr type)) (ceiling (1- (car (caddr type)))))
		   ((integerp (caddr type))
		    (setq high-inclusive t)
		    (caddr type))
		   (t (caddr type))))
  (cond ((and (eq low '*) (eq high '*))
	 (string-append article noun))
	((and (eq low 0) (eq high '*))
	 (string-append "a non-negative " noun))
;	  ((and (eq high 0) (eq low '*))
;	   (string-append "a non-positive " noun))
	((eq high '*)
	 (cond ((not (integerp low)))
	       (low-inclusive
		(format nil "~A~A greater than or equal to ~D" article noun low))
	       (t
		(format nil "~A~A greater than ~D" article noun (1- low)))))
	((eq low '*)
	 (cond ((not (integerp high)))
	       (high-inclusive
		(format nil "~A~A less than or equal to ~D" article noun high))
	       (t
		(format nil "~A~A less than ~D" article noun (1+ high)))))
	((not (and (integerp low) (integerp high)))
	 nil)
	((= low high)
	 (format nil "the ~A ~D" noun low))
	((= high (1+ low))
	 (format nil "either ~D or ~D" low high))
	((< high low)
	 nil)
	(t
	 (format nil "~A~A between ~D and ~D (incl)" article noun low high))))

))