[movitz-cvs] CVS update: movitz/losp/muerte/integers.lisp

[Frode Vatvedt Fjeld]

Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv5020

Modified Files:
	integers.lisp 
Log Message:
Rearranged some code to have movitz build cleanly.

Date: Wed Aug 24 09:31:40 2005
Author: ffjeld

Index: movitz/losp/muerte/integers.lisp
diff -u movitz/losp/muerte/integers.lisp:1.107 movitz/losp/muerte/integers.lisp:1.108
--- movitz/losp/muerte/integers.lisp:1.107	Fri Aug 12 23:37:42 2005
+++ movitz/losp/muerte/integers.lisp	Wed Aug 24 09:31:40 2005
@@ -9,7 +9,7 @@
 ;;;; Created at:    Wed Nov  8 18:44:57 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: integers.lisp,v 1.107 2005/08/12 21:37:42 ffjeld Exp $
+;;;; $Id: integers.lisp,v 1.108 2005/08/24 07:31:40 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -256,71 +256,6 @@
 ;;;
 
 
-(defmacro define-number-relational (name 2op-name condition &key (defun-p t) 3op-name)
-  `(progn
-     ,(when condition
-	`(define-compiler-macro ,2op-name (n1 n2 &environment env)
-	   (cond
-	    ((and (movitz:movitz-constantp n1 env)
-		  (movitz:movitz-constantp n2 env))
-	     (list ',2op-name (movitz:movitz-eval n1 env) (movitz:movitz-eval n2 env)))
-	    ((movitz:movitz-constantp n1 env)
-	     (let ((n1 (movitz::movitz-eval n1 env)))
-	       (check-type n1 number)
-	       (if (typep n1 '(signed-byte 30))
-		   `(with-inline-assembly (:returns ,,condition :side-effects nil)
-		      (:compile-two-forms (:eax :ebx) ,n1 ,n2)
-		      (:call-global-pf fast-compare-fixnum-real))
-		 `(with-inline-assembly (:returns ,,condition :side-effects nil)
-		    (:compile-two-forms (:eax :ebx) ,n1 ,n2)
-		    (:call-global-pf fast-compare-two-reals)))))
-	    ((movitz:movitz-constantp n2 env)
-	     (let ((n2 (movitz:movitz-eval n2 env)))
-	       (check-type n2 number)
-	       (if (typep n2 '(signed-byte 30))
-		   `(with-inline-assembly (:returns ,,condition :side-effects nil)
-		      (:compile-two-forms (:eax :ebx) ,n1 ,n2)
-		      (:call-global-pf fast-compare-real-fixnum))
-		 `(with-inline-assembly (:returns ,,condition :side-effects nil)
-		    (:compile-two-forms (:eax :ebx) ,n1 ,n2)
-		    (:call-global-pf fast-compare-two-reals)))))
-	    (t `(with-inline-assembly (:returns ,,condition :side-effects nil)
-		  (:compile-two-forms (:eax :ebx) ,n1 ,n2)
-		  (:call-global-pf fast-compare-two-reals))))))
-
-     (defun ,2op-name (n1 n2)
-       (,2op-name n1 n2))
-
-     (define-compiler-macro ,name (&whole form number &rest more-numbers)
-       (case (length more-numbers)
-	 (0 `(progn ,number t))
-	 (1 `(,',2op-name ,number ,(first more-numbers)))
-	 ,@(when 3op-name
-	     `((2 `(,',3op-name ,number ,(first more-numbers) ,(second more-numbers)))))
-	 (t #+ignore (when (= 2 (length more-numbers))
-		       (warn "3op: ~S" form))
-	  `(and (,',2op-name ,number ,(first more-numbers))
-		  (,',name , at more-numbers)))))
-
-     ,(when defun-p
-	`(defun ,name (number &rest more-numbers)
-	   (declare (dynamic-extent more-numbers))
-	   (cond
-	    ((null more-numbers)
-	     (check-type number fixnum)
-	     t)
-	    ((not (cdr more-numbers))
-	     (,2op-name number (first more-numbers)))
-	    (t (and (,2op-name number (first more-numbers))
-		    (do ((p more-numbers (cdr p)))
-			((not (cdr p)) t)
-		      (unless (,2op-name (car p) (cadr p))
-			(return nil))))))))))
-
-(define-number-relational >= >=%2op :boolean-greater-equal)
-(define-number-relational > >%2op :boolean-greater)
-(define-number-relational < <%2op :boolean-less)
-(define-number-relational <= <=%2op :boolean-less-equal :3op-name <=%3op)
 
 ;;; Unsigned
 
@@ -402,45 +337,6 @@
 (defun oddp (x)
   (compiler-macro-call oddp x))
 
-;;; Types
-
-(define-typep integer (x &optional (min '*) (max '*))
-  (and (typep x 'integer)
-       (or (eq min '*) (<= min x))
-       (or (eq max '*) (<= x max))))
-
-(deftype signed-byte (&optional (size '*))
-  (cond
-   ((eq size '*)
-    'integer)
-   ((typep size '(integer 1 *))
-    (list 'integer
-	  (- (ash 1 (1- size)))
-	  (1- (ash 1 (1- size)))))
-   (t (error "Illegal size for signed-byte."))))
-
-(deftype unsigned-byte (&optional (size '*))
-  (cond
-   ((eq size '*)
-    '(integer 0))
-   ((typep size '(integer 1 *))
-    (list 'integer 0 (1- (ash 1 size))))
-   (t (error "Illegal size for unsigned-byte."))))
-
-(define-typep rational (x &optional (lower-limit '*) (upper-limit '*))
-  (and (typep x 'rational)
-       (or (eq lower-limit '*)
-	   (<= lower-limit x))
-       (or (eq upper-limit '*)
-	   (<= x upper-limit))))
-
-(deftype real (&optional (lower-limit '*) (upper-limit '*))
-  `(or (integer ,lower-limit ,upper-limit)
-       (rational ,lower-limit ,upper-limit)))
-  
-
-(define-simple-typep (bit bitp) (x)
-  (or (eq x 0) (eq x 1)))
 
 ;;;