Skip to content
Snippets Groups Projects
Commit 8bcc33f5 authored by ram's avatar ram
Browse files

Merged non-descriptor changes:

 revision 1.1.2.1
 date: 90/03/27 12:21:55;  author: ram;  state: Exp;  lines added/del: 13/12
 Changed TYPEP transform to distinguish between hairy and unknown types.
 Also, if a type is unknown, we give an optional efficency note instead
 of a warning.  Any warnings should now be given as a consequence of
 the PARSE-UNKNOWN-TYPE condition.
 ----------------------------
 revision 1.1.1.3
 date: 90/03/27 17:02:25;  author: wlott;  state: Exp;  lines added/del: 1/24
 Moved implementation specific predicates into a new VM specific file:
 vm-typetran.lisp.
 ----------------------------
 revision 1.1.1.2
 date: 90/03/26 21:57:20;  author: wlott;  state: Exp;  lines added/del: 6/2
 Only take continuation-value of constant-continuations in the %typep
 transform.

 Deal with NIL for the class when converting numeric typep tests.
 ----------------------------
 revision 1.1.1.1
 date: 90/03/23 21:52:24;  author: wlott;  state: Exp;  lines added/del: 1/0
 Added predicate for base-characters.
parent 10f9de4b
No related branches found
No related tags found
No related merge requests found
...@@ -7,15 +7,13 @@ ...@@ -7,15 +7,13 @@
;;; Scott Fahlman (FAHLMAN@CMUC). ;;; Scott Fahlman (FAHLMAN@CMUC).
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/typetran.lisp,v 1.1.1.3 1990/03/27 17:02:25 wlott Exp $
;;;
;;; This file contains stuff that implements the portable IR1 semantics of ;;; This file contains stuff that implements the portable IR1 semantics of
;;; type tests. The main thing we do is convert complex type tests into ;;; type tests. The main thing we do is convert complex type tests into
;;; simpler code that can be compiled inline. ;;; simpler code that can be compiled inline.
;;; ;;;
;;; Written by Rob MacLachlan ;;; Written by Rob MacLachlan
;;; ;;;
(in-package "C") (in-package 'c)
;;;; Type predicate translation: ;;;; Type predicate translation:
...@@ -98,7 +96,6 @@ ...@@ -98,7 +96,6 @@
;;; Flush %Typep tests whose result is known at compile time. ;;; Flush %Typep tests whose result is known at compile time.
;;; ;;;
(deftransform %typep ((object type)) (deftransform %typep ((object type))
(unless (constant-continuation-p type) (give-up))
(ir1-transform-type-predicate (ir1-transform-type-predicate
object object
(specifier-type (continuation-value type)))) (specifier-type (continuation-value type))))
...@@ -154,6 +151,28 @@ ...@@ -154,6 +151,28 @@
(def-source-transform atom (x) (def-source-transform atom (x)
`(not (consp ,x))) `(not (consp ,x)))
;;;; Internal predicates:
;;;
;;; These type predicates are used to implement simple cases of typep. They
;;; shouldn't be used explicitly.
;;; Numeric type predicates:
;;;
(define-type-predicate bignump bignum)
(define-type-predicate double-float-p double-float)
(define-type-predicate fixnump fixnum)
(define-type-predicate long-float-p long-float)
(define-type-predicate ratiop ratio)
(define-type-predicate short-float-p short-float)
(define-type-predicate single-float-p single-float)
;;; Character type predicates. Unlike the un-%'ed versions, these are true
;;; type predicates, accepting any type object.
;;;
(define-type-predicate %string-char-p string-char)
(define-type-predicate %standard-char-p standard-char)
;;;; Typep source transform: ;;;; Typep source transform:
...@@ -209,8 +228,7 @@ ...@@ -209,8 +228,7 @@
'fixnum 'fixnum
'integer)) 'integer))
(rational 'rational) (rational 'rational)
(float (or (numeric-type-format type) 'float)) (float (or (numeric-type-format type) 'float)))))
((nil) 'number))))
(once-only ((n-object object)) (once-only ((n-object object))
(ecase (numeric-type-complexp type) (ecase (numeric-type-complexp type)
(:real (:real
...@@ -229,24 +247,25 @@ ...@@ -229,24 +247,25 @@
;;; Source-Transform-Hairy-Typep -- Internal ;;; Source-Transform-Hairy-Typep -- Internal
;;; ;;;
;;; Do the source transformation for a test of a known hairy type. AND, ;;; Do the source transformation for a test of a hairy type. AND, SATISFIES
;;; SATISFIES and NOT are converted into the obvious code. We convert ;;; and NOT are converted into the obvious code. We convert unknown types to
;;; anything else to %TYPEP. ;;; %TYPEP, emitting an efficiency note if appropriate.
;;; ;;;
(defun source-transform-hairy-typep (object type) (defun source-transform-hairy-typep (object type)
(declare (type hairy-type type)) (declare (type hairy-type type))
(let ((spec (hairy-type-specifier type))) (let ((spec (hairy-type-specifier type)))
(cond ((or (atom spec) (cond ((unknown-type-p type)
(not (member (first spec) '(and not satisfies)))) (when (policy nil (> speed brevity))
(compiler-warning "Unknown type specifier: ~S." spec) (compiler-note "Can't open-code test of unknown type ~S." type))
`(%typep ,object ',spec)) `(%typep ,object ',spec))
((and (eq (first spec) 'satisfies) (consp (rest spec)))
`(funcall ',(second spec) ,object))
(t (t
(once-only ((n-obj object)) (ecase (first spec)
`(,(first spec) ,@(mapcar #'(lambda (x) (satisfies `(funcall #',(second spec) ,object))
`(typep ,n-obj ',x)) ((not and)
(rest spec)))))))) (once-only ((n-obj object))
`(,(first spec) ,@(mapcar #'(lambda (x)
`(typep ,n-obj ',x))
(rest spec))))))))))
;;; Source-Transform-Union-Typep -- Internal ;;; Source-Transform-Union-Typep -- Internal
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment