Changeset 8032


Ignore:
Timestamp:
Jan 10, 2008, 8:04:24 AM (12 years ago)
Author:
gb
Message:

Handle unquoted type T in TYPEP.

In REQUIRE-TYPE, don't devolve to %REQUIRE-TYPE just because we
have a predicate; TYPEP can often use that predicate inline.

Provide a compiler-macro for UNSIGNED-BYTE-P: some code does
typechecking before that's defined as a function.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/compiler/optimizers.lisp

    r7961 r8032  
    919919;;; (<typecheck> foo)).
    920920(define-compiler-macro require-type (&whole call &environment env arg type)
    921   (cond ((and (quoted-form-p type)
    922               (setq type (%cadr type))
     921  (cond ((and (or (eq type t)
     922                  (and (quoted-form-p type)
     923                       (setq type (%cadr type))))
    923924              (not (typep (specifier-type type) 'unknown-ctype)))       
    924925         (cond ((nx-form-typep arg type env) arg)
     
    964965               ((type= (specifier-type type)
    965966                       (specifier-type '(unsigned-byte 64)))
    966                 `(the (unsigned-byte 64) (require-u64 ,arg)))               
     967                `(the (unsigned-byte 64) (require-u64 ,arg)))
     968               #+nil
    967969               ((and (symbolp type)
    968970                     (let ((simpler (type-predicate type)))
    969971                       (if simpler `(the ,type (%require-type ,arg ',simpler))))))
     972               #+nil
    970973               ((and (symbolp type)(find-class type nil env))
    971974                  `(%require-type-class-cell ,arg (load-time-value (find-class-cell ',type t))))
     
    15301533  (declare (ignore e))
    15311534  (if (quoted-form-p type)
    1532     (or (optimize-typep thing (%cadr type) env)
    1533         call)
     1535    (if (constantp thing)
     1536      (typep (if (quoted-form-p thing) (%cadr thing) thing) (%cadr type))
     1537      (or (optimize-typep thing (%cadr type) env)
     1538          call))
    15341539    (if (eq type t)
    15351540      `(progn ,thing t)
     
    20132018    call))
    20142019
     2020(define-compiler-macro instance-slots (&whole w instance)
     2021  (if (and (constantp instance)
     2022           (eql (typecode instance) (nx-lookup-target-uvector-subtag :instance)))
     2023    `(instance.slots ,instance)
     2024    w))
     2025
     2026(define-compiler-macro unsigned-byte-p (x)
     2027  (if (typep (nx-unquote x) 'unsigned-byte)
     2028    t
     2029    (let* ((val (gensym)))
     2030      `(let* ((,val ,x))
     2031        (and (integerp ,val) (not (< ,val 0)))))))
     2032
    20152033(provide "OPTIMIZERS")
    20162034
     2035
     2036
     2037
     2038
     2039
     2040
Note: See TracChangeset for help on using the changeset viewer.