Changeset 11665 for trunk/source/level-1/l1-typesys.lisp
- Timestamp:
- Jan 30, 2009, 12:00:31 PM (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/source/level-1/l1-typesys.lisp
r11121 r11665 1356 1356 (funcall (type-class-unparse (ctype-class-info type)) type))) 1357 1357 1358 1359 (defconstant compound-only-type-specifiers 1360 ;; See CLHS Figure 4-4. 1361 '(and mod satisfies eql not values member or)) 1362 1363 1358 1364 ;;; VALUES-SPECIFIER-TYPE -- Interface 1359 1365 ;;; … … 1386 1392 (and cell (cdr cell)))) 1387 1393 (t 1394 (when (member spec compound-only-type-specifiers) 1395 (error 'invalid-type-specifier :typespec spec)) 1388 1396 (let* ((lspec (if (atom spec) (list spec) spec)) 1389 1397 (fun (info-type-translator (car lspec)))) 1390 1398 (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))))) 1392 1403 (symbolp spec)) 1393 1404 (when *type-system-initialized* … … 1397 1408 nil) 1398 1409 (t 1399 (error "Bad thing to be a type specifier: ~S."spec)))))))))1410 (error 'invalid-type-specifier :typespec spec))))))))) 1400 1411 1401 1412 (eval-when (:compile-toplevel :execute) … … 1528 1539 (handler-case 1529 1540 (type-specifier (specifier-type spec env)) 1541 (invalid-type-specifier () spec) 1530 1542 (parse-unknown-type () spec))) 1531 1543 … … 1558 1570 (when pred (setf (numeric-ctype-predicate res) pred)))) 1559 1571 (unless (unknown-ctype-p res) 1560 1561 1572 (setf (info-type-builtin spec) res) 1573 (setf (info-type-kind spec) :primitive))))) 1562 1574 1563 1575 ;;;; Builtin types. … … 3956 3968 `(simple-array (signed-byte 32) (,size))) 3957 3969 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 3958 4023 (deftype simple-double-float-vector (&optional size) 3959 4024 `(simple-array double-float (,size))) 3960 4025 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 4015 4026 (deftype simple-single-float-vector (&optional size) 4016 4027 `(simple-array single-float (,size))) 4017 4028 4029 (deftype simple-long-float-vector (&optional size) 4030 `(simple-array double-float (,size))) 4031 4018 4032 (deftype simple-fixnum-vector (&optional size) 4019 4033 `(simple-array fixnum (,size))) 4034 4035 (deftype fixnum-vector (&optional size) 4036 `(array fixnum (,size))) 4020 4037 4021 4038 #+64-bit-target … … 4034 4051 `(double-float ,low ,high)) 4035 4052 4053 #|| 4036 4054 ;;; As empty a type as you're likely to find ... 4037 4055 (deftype extended-char () 4038 4056 "Type of CHARACTERs that aren't BASE-CHARs." 4039 4057 nil) 4058 ||# 4040 4059 4041 4060 (deftype natural () … … 4321 4340 (unless (eq ctype *universal-type*) 4322 4341 (generate-predicate-for-ctype ctype))) 4342 (invalid-type-specifier () 4343 (warn "Invalid type soecifier ~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)) 4323 4352 (parse-unknown-type (c) 4324 4353 (declare (ignore c))
Note: See TracChangeset
for help on using the changeset viewer.