Changeset 11680


Ignore:
Timestamp:
Feb 4, 2009, 5:37:26 PM (10 years ago)
Author:
gz
Message:

r11664-r11666 from trunk

Location:
branches/working-0711/ccl/level-1
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/level-1/l1-clos.lisp

    r11479 r11680  
    195195          (return)))
    196196      (standardized-type-specifier
    197        `(and ,@(mapcar #'(lambda (d) (or (%slot-definition-type d) t))
    198                        direct-slots)))))
     197       (if (cdr direct-slots)
     198         `(and ,@(mapcar #'(lambda (d) (or (%slot-definition-type d) t))
     199                         direct-slots))
     200         (%slot-definition-type (car direct-slots))))))
    199201
    200202(defmethod compute-effective-slot-definition ((class slots-class)
  • branches/working-0711/ccl/level-1/l1-error-system.lisp

    r11511 r11680  
    191191(define-condition simple-program-error (simple-condition program-error)
    192192  ((context :initarg :context :reader simple-program-error-context :initform nil)))
     193
     194(define-condition invalid-type-specifier (program-error)
     195  ((typespec :initarg :typespec :reader invalid-type-specifier-typespec))
     196  (:report (lambda (c s)
     197             (with-slots (typespec) c
     198               (format s "Invalid type specifier: ~s ." typespec)))))
    193199
    194200(defun signal-program-error (string &rest args)
  • branches/working-0711/ccl/level-1/l1-typesys.lisp

    r11164 r11680  
    13561356    (funcall (type-class-unparse (ctype-class-info type)) type)))
    13571357
     1358
     1359(defconstant compound-only-type-specifiers
     1360  ;; See CLHS Figure 4-4.
     1361  '(and mod satisfies eql not values member or))
     1362
     1363
    13581364;;; VALUES-SPECIFIER-TYPE  --  Interface
    13591365;;;
     
    13861392           (and cell (cdr cell))))
    13871393         (t
     1394          (when (member spec compound-only-type-specifiers)
     1395            (error 'invalid-type-specifier :typespec spec))
    13881396          (let* ((lspec (if (atom spec) (list spec) spec))
    13891397                 (fun (info-type-translator (car lspec))))
    13901398            (cond (fun (funcall fun lspec env))
    1391                   ((or (and (consp spec) (symbolp (car spec)))
     1399                  ((or (and (consp spec)
     1400                            (symbolp (car spec))
     1401                            (not (or (find-class (car spec) nil env)
     1402                                     (info-type-builtin (car spec)))))
    13921403                       (symbolp spec))
    13931404                   (when *type-system-initialized*
     
    13971408                   nil)
    13981409                  (t
    1399                    (error "Bad thing to be a type specifier: ~S." spec)))))))))
     1410                   (error 'invalid-type-specifier :typespec spec)))))))))
    14001411
    14011412(eval-when (:compile-toplevel :execute)
     
    15281539  (handler-case
    15291540      (type-specifier (specifier-type spec env))
     1541    (invalid-type-specifier () spec)
    15301542    (parse-unknown-type () spec)))
    15311543
     
    15581570          (when pred (setf (numeric-ctype-predicate res) pred))))
    15591571      (unless (unknown-ctype-p res)
    1560           (setf (info-type-builtin spec) res)
    1561           (setf (info-type-kind spec) :primitive)))))
     1572        (setf (info-type-builtin spec) res)
     1573        (setf (info-type-kind spec) :primitive)))))
    15621574
    15631575;;;; Builtin types.
     
    39563968  `(simple-array (signed-byte 32) (,size)))
    39573969
     3970
     3971
     3972(deftype simple-short-float-vector (&optional size)
     3973  `(simple-array short-float (,size)))
     3974
     3975(deftype unsigned-word-vector (&optional size)
     3976  `(vector (unsigned-byte 16) ,size))
     3977
     3978(deftype single-float-vector (&optional size)
     3979  `(vector short-float ,size))
     3980
     3981(deftype unsigned-byte-vector (&optional size)
     3982  `(vector (unsigned-byte 8) ,size))
     3983
     3984(deftype unsigned-long-vector (&optional size)
     3985  `(vector (unsigned-byte 32) ,size))
     3986
     3987(deftype long-float-vector (&optional size)
     3988  `(vector double-float ,size))
     3989
     3990(deftype long-vector (&optional size)
     3991  `(vector (signed-byte 32) ,size))
     3992
     3993(deftype double-float-vector (&optional size)
     3994  `(vector double-float ,size))
     3995
     3996(deftype byte-vector (&optional size)
     3997  `(vector (signed-byte 8) ,size))
     3998
     3999(deftype general-vector (&optional size)
     4000  `(vector t ,size))
     4001
     4002(deftype word-vector (&optional size)
     4003  `(vector (signed-byte 16) ,size))
     4004
     4005(deftype short-float-vector (&optional size)
     4006  `(vector single-float ,size))
     4007
     4008(deftype simple-1d-array (&optional size)
     4009  `(simple-array * (,size)))
     4010
     4011(deftype simple-long-vector (&optional size)
     4012  `(simple-array (signed-byte 32) (,size)))
     4013
     4014(deftype simple-word-vector (&optional size)
     4015  `(simple-array (signed-byte 16) (,size)))
     4016
     4017(deftype simple-short-float-vector (&optional size)
     4018  `(simple-array single-float (,size)))
     4019
     4020(deftype simple-byte-vector (&optional size)
     4021  `(simple-array (signed-byte 8) (,size)))
     4022
    39584023(deftype simple-double-float-vector (&optional size)
    39594024  `(simple-array double-float (,size)))
    39604025
    3961 (deftype simple-short-float-vector (&optional size)
    3962   `(simple-array short-float (,size)))
    3963 
    3964 (deftype unsigned-word-vector (&optional size)
    3965   `(vector (unsigned-byte 16) ,size))
    3966 
    3967 (deftype single-float-vector (&optional size)
    3968   `(vector short-float ,size))
    3969 
    3970 (deftype unsigned-byte-vector (&optional size)
    3971   `(vector (unsigned-byte 8) ,size))
    3972 
    3973 (deftype unsigned-long-vector (&optional size)
    3974   `(vector (unsigned-byte 32) ,size))
    3975 
    3976 (deftype long-float-vector (&optional size)
    3977   `(vector double-float ,size))
    3978 
    3979 (deftype long-vector (&optional size)
    3980   `(vector (signed-byte 32) ,size))
    3981 
    3982 (deftype double-float-vector (&optional size)
    3983   `(vector double-float ,size))
    3984 
    3985 (deftype byte-vector (&optional size)
    3986   `(vector (signed-byte 8) ,size))
    3987 
    3988 (deftype general-vector (&optional size)
    3989   `(vector t ,size))
    3990 
    3991 (deftype word-vector (&optional size)
    3992   `(vector (signed-byte 16) ,size))
    3993 
    3994 (deftype short-float-vector (&optional size)
    3995   `(vector single-float ,size))
    3996 
    3997 (deftype simple-1d-array (&optional size)
    3998   `(simple-array * (,size)))
    3999 
    4000 (deftype simple-long-vector (&optional size)
    4001   `(simple-array (signed-byte 32) (,size)))
    4002 
    4003 (deftype simple-word-vector (&optional size)
    4004   `(simple-array (signed-byte 16) (,size)))
    4005 
    4006 (deftype simple-short-float-vector (&optional size)
    4007   `(simple-array single-float (,size)))
    4008 
    4009 (deftype simple-byte-vector (&optional size)
    4010   `(simple-array (signed-byte 8) (,size)))
    4011 
    4012 (deftype simple-double-float-vector (&optional size)
    4013   `(simple-array double-float (,size)))
    4014 
    40154026(deftype simple-single-float-vector (&optional size)
    40164027  `(simple-array single-float (,size)))
    40174028
     4029(deftype simple-long-float-vector (&optional size)
     4030  `(simple-array double-float (,size)))
     4031
    40184032(deftype simple-fixnum-vector (&optional size)
    40194033  `(simple-array fixnum (,size)))
     4034
     4035(deftype fixnum-vector (&optional size)
     4036  `(array fixnum (,size)))
    40204037
    40214038#+64-bit-target
     
    40344051  `(double-float ,low ,high))
    40354052
     4053#||
    40364054;;; As empty a type as you're likely to find ...
    40374055(deftype extended-char ()
    40384056  "Type of CHARACTERs that aren't BASE-CHARs."
    40394057  nil)
     4058||#
    40404059
    40414060(deftype natural ()
     
    43214340                    (unless (eq ctype *universal-type*)
    43224341                      (generate-predicate-for-ctype ctype)))
     4342                (invalid-type-specifier ()
     4343                  (warn "Invalid type specifier ~s in slot definition for ~s in class ~s." type (slot-definition-name spec) (slot-definition-class spec))
     4344                  (lambda (v)
     4345                    (cerror "Allow the assignment or initialization."
     4346                            "Can't determine whether or not the value ~s should be used to initialize or assign to the slot ~&named ~s in an instance of ~s, because the slot is declared ~&to be of the invalid type ~s."
     4347                            v (slot-definition-name spec) (slot-definition-class spec) (slot-definition-type spec))
     4348                    ;; Suppress further checking, at least for things that use this effective slotd.
     4349                    ;; (It's hard to avoid this, and more trouble than it's worth to do better.)
     4350                    (setf (slot-value spec 'type-predicate) nil)
     4351                    t))
    43234352                (parse-unknown-type (c)
    43244353                   (declare (ignore c))
Note: See TracChangeset for help on using the changeset viewer.