Changeset 11876


Ignore:
Timestamp:
Apr 1, 2009, 12:27:19 AM (11 years ago)
Author:
gb
Message:

Try to simplify COERCE-ing to certain recognizable subtypes of SEQUENCE
via compiler-macro/runtime support.

Location:
trunk/source
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/optimizers.lisp

    r11805 r11876  
    22772277        (t call)))
    22782278
    2279 (define-compiler-macro coerce (&whole call thing type)
    2280   (if (quoted-form-p type)
    2281     (setq type (cadr type)))
    2282   (if (ignore-errors (subtypep type 'single-float))
    2283     `(float ,thing 0.0f0)
    2284     (if (ignore-errors (subtypep type 'double-float))
    2285       `(float ,thing 0.0d0)
    2286       call)))
     2279(define-compiler-macro coerce (&whole call &environment env thing type)
     2280  (cond ((constantp type)
     2281         (if (quoted-form-p type)
     2282           (setq type (cadr type)))
     2283         (if (ignore-errors (subtypep type 'single-float))
     2284           `(float ,thing 0.0f0)
     2285           (if (ignore-errors (subtypep type 'double-float))
     2286             `(float ,thing 0.0d0)
     2287             (let* ((ctype (specifier-type-if-known type env))
     2288                    (simple nil)
     2289                    (extra nil))
     2290               (if (and (typep ctype 'array-ctype)
     2291                        (equal (array-ctype-dimensions ctype) '(*)))
     2292                 (if (eq (array-ctype-specialized-element-type ctype)
     2293                         (specifier-type 'character))
     2294                   (setq simple '%coerce-to-string)
     2295                   (if (and (eq *host-backend* *target-backend*)
     2296                            (array-ctype-typecode ctype))
     2297                     (setq simple '%coerce-to-vector
     2298                           extra (list (array-ctype-typecode ctype)))))
     2299                 (if (eq ctype (specifier-type 'list))
     2300                   (setq simple '%coerce-to-list)))
     2301               (if simple
     2302                 (let* ((temp (gensym)))
     2303                   `(let* ((,temp ,thing))
     2304                     (if (typep ,temp ',(type-specifier ctype))
     2305                       ,temp
     2306                       (,simple ,temp ,@extra))))
     2307               call)))))
     2308        (t call)))
    22872309
    22882310(define-compiler-macro equal (&whole call x y &environment env)
  • trunk/source/lib/sequences.lisp

    r11545 r11876  
    845845        (t (error "~S can't be coerced to type ~S." object output-type-spec))))))
    846846
     847(defun %coerce-to-string (seq)
     848   (let* ((len (length seq))
     849          (string (make-string len)))
     850     (declare (fixnum len) (simple-base-string string))
     851     (if (typep seq 'list)
     852       (do* ((l seq (cdr l))
     853             (i 0 (1+ i)))
     854            ((null l) string)
     855         (declare (list l) ; we know that it's a proper list because LENGTH won
     856                  (fixnum i))
     857         (setf (schar string i) (car l)))
     858       (dotimes (i len string)
     859         (setf (schar string i) (aref seq i))))))
     860
     861(defun %coerce-to-vector (seq subtype)
     862   (let* ((len (length seq))
     863          (vector (%alloc-misc len subtype)))
     864     (declare (fixnum len) (type (simple-array * (*)) vector))
     865     (if (typep seq 'list)
     866       (do* ((l seq (cdr l))
     867             (i 0 (1+ i)))
     868            ((null l) vector)
     869         (declare (list l) ; we know that it's a proper list because LENGTH won
     870                  (fixnum i))
     871         (setf (uvref vector i) (car l)))
     872       (dotimes (i len vector)
     873         (setf (uvref vector i) (aref seq i))))))
     874
     875(defun %coerce-to-list (seq)
     876  (if (typep seq 'list)
     877    seq
     878    (collect ((result))
     879      (dotimes (i (length seq) (result))
     880        (result (aref seq i))))))
     881
     882
     883
    847884
    848885(defun coerce-to-complex (object  output-type-spec)
Note: See TracChangeset for help on using the changeset viewer.