Changeset 11687


Ignore:
Timestamp:
Feb 5, 2009, 2:55:33 AM (11 years ago)
Author:
gz
Message:

r11680-r11686 from working-0711. Primarily make more cases of invalid-type-specifier errors come through at compile time.

Location:
trunk/source
Files:
3 edited

Legend:

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

    r11645 r11687  
    642642(defun specifier-type-if-known (typespec &optional env)
    643643  (handler-case (specifier-type typespec env)
    644     (parse-unknown-type (c) (values nil (parse-unknown-type-specifier c)))
    645     (error () nil)))
     644    (parse-unknown-type (c) (values nil (parse-unknown-type-specifier c)))))
    646645
    647646#+debugging-version
     
    650649                                       (break "caught unknown-type ~s" c)
    651650                                       (return-from specifier-type-if-known
    652                                          (values nil (parse-unknown-type-specifier c)))))
    653                  (error (lambda (c)
    654                           (break "caught error ~s" c)
    655                           (return-from specifier-type-if-known nil))))
     651                                         (values nil (parse-unknown-type-specifier c))))))
    656652    (specifier-type typespec env)))
    657653
     
    15921588
    15931589(define-compiler-macro typep  (&whole call &environment env thing type &optional e)
    1594   (if (quoted-form-p type)
    1595     (if (and (constantp thing) (specifier-type-if-known type env))
    1596       (typep (if (quoted-form-p thing) (%cadr thing) thing) (%cadr type) env)
    1597       (or (and (null e) (optimize-typep thing (%cadr type) env))
    1598           call))
    1599     (if (eq type t)
    1600       `(progn ,thing t)
    1601       call)))
     1590  (if (or (quoted-form-p type) (self-evaluating-p type))
     1591    (let ((type-val (nx-unquote type)))
     1592      (if (eq type-val t)
     1593        `(progn ,thing t)
     1594        (if (and (or (quoted-form-p thing) (self-evaluating-p thing))
     1595                 (specifier-type-if-known type-val env))
     1596          (typep (nx-unquote thing) type-val env)
     1597          (or (and (null e) (optimize-typep thing type-val env))
     1598              call))))
     1599    call))
    16021600
    16031601(define-compiler-macro structure-typep (&whole w thing type)
    16041602  (if (not (quoted-form-p type))
    16051603    (progn
    1606       (warn "Non-qouted structure-type in ~s" w)
     1604      (warn "Non-quoted structure-type in ~s" w)
    16071605      w)
    16081606    (let* ((type (nx-unquote type)))
  • trunk/source/lib/macros.lisp

    r11622 r11687  
    19511951                      (writer-info (%cons-def-info 'defmethod (dpb 2 $lfbits-numreq 0) nil nil (list t class-name))))
    19521952                 (when (memq slot-name slot-names)
    1953                    (SIGNAL-PROGRAM-error "Multiple slots named ~S in DEFCLASS ~S" slot-name class-name))
     1953                   (signal-program-error "Multiple slots named ~S in DEFCLASS ~S" slot-name class-name))
    19541954                 (push slot-name slot-names)
    19551955                 (do ((options (cdr slot) (cddr options))
     
    19831983                        (duplicate-options slot)
    19841984                        (setq type-p t))
    1985                       ;(when (null (cadr options)) (signal-program-error "Illegal options ~S" options))
    1986                       (setq type (cadr options)))
     1985                      (setq type (cadr options))
     1986                      ;; complain about illegal typespecs
     1987                      (handler-case (specifier-type type env)
     1988                        (invalid-type-specifier ()
     1989                          (warn "Invalid type ~s in ~s slot definition ~s" type class-name slot))))
    19871990                     (:initform
    19881991                      (if initform-p
  • trunk/source/lib/nfcomp.lisp

    r11600 r11687  
    878878
    879879(defun fcomp-macroexpand-1 (form env)
    880   (let* ((*nx-source-note-map* *fcomp-source-note-map*))
    881     (multiple-value-bind (new win)
    882         (macroexpand-1 form env)
    883       (when win
    884         (nx-note-source-transformation form new))
    885       (values new win))))
     880  (handler-bind ((warning (lambda (c)
     881                            (nx1-whine :program-error c)
     882                            (muffle-warning c)))
     883                 (program-error (lambda (c)
     884                                  (if *fasl-break-on-program-errors*
     885                                    (cerror "continue compilation ignoring this form" c)
     886                                    (progn
     887                                      (when (typep c 'compile-time-program-error)
     888                                        (setq c (make-condition 'simple-program-error
     889                                                  :format-control (simple-condition-format-control c)
     890                                                  :format-arguments (simple-condition-format-arguments c))))
     891                                      (nx1-whine :program-error c)))
     892                                  (return-from fcomp-macroexpand-1 (values nil t)))))
     893    (let* ((*nx-source-note-map* *fcomp-source-note-map*))
     894      (multiple-value-bind (new win)
     895          (macroexpand-1 form env)
     896        (when win
     897          (nx-note-source-transformation form new))
     898        (values new win)))))
    886899
    887900(defun fcomp-transform (form env)
Note: See TracChangeset for help on using the changeset viewer.