diff --git a/code/exports.lisp b/code/exports.lisp index bb247b934d65da929e2afc5994abcb2e098feb0a..58cae4a15b582f8dae1112093463574805f8479c 100644 --- a/code/exports.lisp +++ b/code/exports.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.131 1997/11/07 17:11:16 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.132 1997/11/15 04:38:46 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1429,8 +1429,8 @@ "BOOLEAN" "BYTE-SPECIFIER" "CALLABLE" "CHAR-INT" "CHECK-FOR-CIRCULARITY" "CODE-COMPONENT" "CODE-COMPONENT-P" "CODE-DEBUG-INFO" "CODE-HEADER-REF" "CODE-HEADER-SET" - "CODE-INSTRUCTIONS" "COMPLEX-FLOAT-P" - "COMPLEX-SINGLE-FLOAT-P" "COMPLEX-DOUBLE-FLOAT-P" + "CODE-INSTRUCTIONS" "COMPLEX-FLOAT-P" "COMPLEX-SINGLE-FLOAT-P" + "COMPLEX-DOUBLE-FLOAT-P" "COMPLEX-RATIONAL-P" "CONSED-SEQUENCE" "CONSTANT-TYPE" "CONSTANT-TYPE-P" "CONSTANT-TYPE-TYPE" "CONTAINING-INTEGER-TYPE" "CONTROL-STACK-POINTER-SAP" "COPY-FROM-SYSTEM-AREA" @@ -1475,7 +1475,8 @@ "OBJECT-NOT-COERCABLE-TO-FUNCTION-ERROR" "OBJECT-NOT-COMPLEX-ERROR" "OBJECT-NOT-COMPLEX-FLOAT-ERROR" "OBJECT-NOT-COMPLEX-SINGLE-FLOAT-ERROR" - "OBJECT-NOT-COMPLEX-DOUBLE-FLOAT-ERROR" "OBJECT-NOT-CONS-ERROR" + "OBJECT-NOT-COMPLEX-DOUBLE-FLOAT-ERROR" + "OBJECT-NOT-COMPLEX-RATIONAL-ERROR" "OBJECT-NOT-CONS-ERROR" "OBJECT-NOT-DOUBLE-FLOAT-ERROR" "OBJECT-NOT-FIXNUM-ERROR" "OBJECT-NOT-FLOAT-ERROR" "OBJECT-NOT-FUNCTION-ERROR" "OBJECT-NOT-FUNCTION-OR-SYMBOL-ERROR" "OBJECT-NOT-INSTANCE-ERROR" diff --git a/code/interr.lisp b/code/interr.lisp index bf0faa97af17bfc328e21ad719dfc50881f0a625..b043d9df38cf73757153f103f19d8348dc362d14 100644 --- a/code/interr.lisp +++ b/code/interr.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/interr.lisp,v 1.31 1997/11/01 22:58:13 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/interr.lisp,v 1.32 1997/11/15 04:38:49 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -417,6 +417,13 @@ :datum object :expected-type 'complex)) +#+complex-float +(deferr object-not-complex-rational-error (object) + (error 'type-error + :function-name name + :datum object + :expected-type '(complex rational))) + #+complex-float (deferr object-not-complex-single-float-error (object) (error 'type-error diff --git a/code/pred.lisp b/code/pred.lisp index c62c7a70498cf704e7a010592ae264a574ec9397..fbb32688a245c177d39265292cfcb73f6112eb15 100644 --- a/code/pred.lisp +++ b/code/pred.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pred.lisp,v 1.41 1997/11/07 17:11:19 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pred.lisp,v 1.42 1997/11/15 04:38:50 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -54,6 +54,7 @@ consp compiled-function-p complexp + #+complex-float complex-rational-p #+complex-float complex-float-p #+complex-float complex-single-float-p #+complex-float complex-double-float-p diff --git a/compiler/generic/interr.lisp b/compiler/generic/interr.lisp index a48e59e654f1ec77ea69ca47fb82b5efc2675b08..f43e9f1ac581936b908431b2f448f26804fb3fd7 100644 --- a/compiler/generic/interr.lisp +++ b/compiler/generic/interr.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/interr.lisp,v 1.7 1997/11/07 17:11:24 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/interr.lisp,v 1.8 1997/11/15 04:39:00 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -162,6 +162,9 @@ (object-not-complex "Object is not of type COMPLEX.") #+complex-float + (object-not-complex-rational + "Object is not of type (COMPLEX RATIONAL).") + #+complex-float (object-not-complex-float "Object is not of type (COMPLEX FLOAT).") #+complex-float diff --git a/compiler/generic/vm-fndb.lisp b/compiler/generic/vm-fndb.lisp index 794fceeedceb2842989ae98ee8b08faf65c468e2..1641fcda8a4e2373c94cf6e01a719ab38b19eed4 100644 --- a/compiler/generic/vm-fndb.lisp +++ b/compiler/generic/vm-fndb.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-fndb.lisp,v 1.56 1997/11/07 17:11:26 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-fndb.lisp,v 1.57 1997/11/15 04:39:01 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -48,7 +48,7 @@ (defknown (fixnump bignump ratiop short-float-p single-float-p double-float-p long-float-p - #+complex-float complex-float-p + #+complex-float complex-rational-p #+complex-float complex-float-p #+complex-float complex-single-float-p #+complex-float complex-double-float-p base-char-p %string-char-p %standard-char-p %instancep diff --git a/compiler/srctran.lisp b/compiler/srctran.lisp index 66ba2cd914785441a859e5c80a07002af766e377..6133109528a2e912c4de19065cc4acdc4f794fc3 100644 --- a/compiler/srctran.lisp +++ b/compiler/srctran.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.60 1997/11/01 22:58:24 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.61 1997/11/15 04:38:54 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -239,12 +239,12 @@ #+complex-float (def-source-transform realpart (num) (once-only ((n-num num)) - `(cond - ((kernel:complex-double-float-p ,n-num) + `(typecase ,n-num + ((complex double-float) (vm::complex-double-float-real ,n-num)) - ((kernel:complex-single-float-p ,n-num) + ((complex single-float) (vm::complex-single-float-real ,n-num)) - ((complexp ,n-num) + ((complex rational) (kernel:%realpart ,n-num)) (t ,n-num)))) @@ -252,14 +252,14 @@ #+complex-float (def-source-transform imagpart (num) (once-only ((n-num num)) - `(cond - ((kernel:complex-double-float-p ,n-num) + `(typecase ,n-num + ((complex double-float) (vm::complex-double-float-imag ,n-num)) - ((kernel:complex-single-float-p ,n-num) + ((complex single-float) (vm::complex-single-float-imag ,n-num)) - ((complexp ,n-num) + ((complex rational) (kernel:%imagpart ,n-num)) - ((floatp ,n-num) + (float (float 0 ,n-num)) (t 0)))) diff --git a/compiler/typetran.lisp b/compiler/typetran.lisp index 3842d37b79e153c46c00bc147a6e5d956f6cbbe9..db6899ee00e9a5578c7c0e11134c7cc48b35bb3f 100644 --- a/compiler/typetran.lisp +++ b/compiler/typetran.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/typetran.lisp,v 1.30 1997/11/07 17:11:22 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/typetran.lisp,v 1.31 1997/11/15 04:38:57 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -134,6 +134,7 @@ (define-type-predicate characterp character) (define-type-predicate compiled-function-p compiled-function) (define-type-predicate complexp complex) + #+complex-float (define-type-predicate complex-rational-p (complex rational)) #+complex-float (define-type-predicate complex-float-p (complex float)) (define-type-predicate consp cons) (define-type-predicate floatp float) diff --git a/compiler/x86/type-vops.lisp b/compiler/x86/type-vops.lisp index 94554626383c1bee3ebd6e71a5bb4351c2015d1c..94aa2a295ea388ec054da74029bd354d8f7d1de6 100644 --- a/compiler/x86/type-vops.lisp +++ b/compiler/x86/type-vops.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/type-vops.lisp,v 1.5 1997/11/07 17:11:28 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/type-vops.lisp,v 1.6 1997/11/15 04:39:03 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -293,7 +293,11 @@ #+complex-float complex-double-float-type) #+complex-float -(def-type-vops complex-float-p check-complex-float-p nil +(def-type-vops complex-rational-p check-complex-rational nil + object-not-complex-rational-error complex-type) + +#+complex-float +(def-type-vops complex-float-p check-complex-float nil object-not-complex-float-error complex-single-float-type complex-double-float-type)