Ignore:
Timestamp:
Sep 15, 2010, 12:07:42 AM (9 years ago)
Author:
gz
Message:

r14258 from trunk (defstruct changes)

Location:
branches/qres/ccl
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/qres/ccl

  • branches/qres/ccl/lib/macros.lisp

    r14056 r14259  
    590590                                         ,setter)))
    591591                                 (push (list (car d) (car v)) let-list)))))
    592                           ((and (type-and-refinfo-p (setq temp (or (environment-structref-info accessor env)
    593                                                                    (and #-bccl (boundp '%structure-refs%)
    594                                                                         (gethash accessor %structure-refs%)))))
    595                                 (not (refinfo-r/o (if (consp temp) (%cdr temp) temp))))
    596                            (if (consp temp)
    597                              ;; strip off type, but add in a require-type
    598                              (let ((type (%car temp)))
    599                                `(the ,type (setf ,(defstruct-ref-transform (%cdr temp) (%cdar args) env)
    600                                             (require-type ,value ',type))))
    601                              `(setf ,(defstruct-ref-transform temp (%cdar args) env)
    602                                ,value)))
     592                          ((and (setq temp (structref-info accessor env))
     593                                (accessor-structref-info-p temp)
     594                                (not (refinfo-r/o (structref-info-refinfo temp))))
     595                           (let ((form (defstruct-ref-transform temp (%cdar args) env t))
     596                                 (type (defstruct-type-for-typecheck (structref-info-type temp) env)))
     597                             (if (eq type t)
     598                               `(setf ,form ,value)
     599                               ;; strip off type, but add in a typecheck
     600                               `(the ,type (setf ,form (typecheck ,value ,type))))))
    603601                          (t
    604602                           (multiple-value-bind (res win)
     
    28202818       (setf ,place (%check-type ,val ',typespec ',place ,string))))))
    28212819
    2822 
     2820(defmacro typecheck (object typespec &environment env)
     2821  (cond ((eq typespec 't)
     2822         object)
     2823        ((nx-inhibit-safety-checking env)
     2824         `(the ,typespec ,object))
     2825        (t
     2826         `(require-type ,object ',(nx1-typespec-for-typep typespec env)))))
    28232827
    28242828
     
    33043308  (if (consp place)
    33053309    (let* ((sym (car place))
    3306            (struct-transform (or (environment-structref-info sym env)
    3307                                  (gethash sym %structure-refs%))))
     3310           (struct-transform (structref-info sym env)))
    33083311      (if struct-transform
    33093312        (setq place (defstruct-ref-transform struct-transform (cdr place) env)
     
    35483551      (signal-program-error "~s is not a special variable ." place))
    35493552    (let* ((sym (car place))
    3550            (struct-transform (or (ccl::environment-structref-info sym env)
    3551                                  (gethash sym ccl::%structure-refs%))))
     3553           (struct-transform (structref-info sym env)))
    35523554      (if struct-transform
    35533555        (setq place (defstruct-ref-transform struct-transform (cdr place) env)
Note: See TracChangeset for help on using the changeset viewer.