Changeset 11680
 Timestamp:
 Feb 4, 2009, 5:37:26 PM (10 years ago)
 Location:
 branches/working0711/ccl/level1
 Files:

 3 edited
Legend:
 Unmodified
 Added
 Removed

branches/working0711/ccl/level1/l1clos.lisp
r11479 r11680 195 195 (return))) 196 196 (standardizedtypespecifier 197 `(and ,@(mapcar #'(lambda (d) (or (%slotdefinitiontype d) t)) 198 directslots))))) 197 (if (cdr directslots) 198 `(and ,@(mapcar #'(lambda (d) (or (%slotdefinitiontype d) t)) 199 directslots)) 200 (%slotdefinitiontype (car directslots)))))) 199 201 200 202 (defmethod computeeffectiveslotdefinition ((class slotsclass) 
branches/working0711/ccl/level1/l1errorsystem.lisp
r11511 r11680 191 191 (definecondition simpleprogramerror (simplecondition programerror) 192 192 ((context :initarg :context :reader simpleprogramerrorcontext :initform nil))) 193 194 (definecondition invalidtypespecifier (programerror) 195 ((typespec :initarg :typespec :reader invalidtypespecifiertypespec)) 196 (:report (lambda (c s) 197 (withslots (typespec) c 198 (format s "Invalid type specifier: ~s ." typespec))))) 193 199 194 200 (defun signalprogramerror (string &rest args) 
branches/working0711/ccl/level1/l1typesys.lisp
r11164 r11680 1356 1356 (funcall (typeclassunparse (ctypeclassinfo type)) type))) 1357 1357 1358 1359 (defconstant compoundonlytypespecifiers 1360 ;; See CLHS Figure 44. 1361 '(and mod satisfies eql not values member or)) 1362 1363 1358 1364 ;;; VALUESSPECIFIERTYPE  Interface 1359 1365 ;;; … … 1386 1392 (and cell (cdr cell)))) 1387 1393 (t 1394 (when (member spec compoundonlytypespecifiers) 1395 (error 'invalidtypespecifier :typespec spec)) 1388 1396 (let* ((lspec (if (atom spec) (list spec) spec)) 1389 1397 (fun (infotypetranslator (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 (findclass (car spec) nil env) 1402 (infotypebuiltin (car spec))))) 1392 1403 (symbolp spec)) 1393 1404 (when *typesysteminitialized* … … 1397 1408 nil) 1398 1409 (t 1399 (error "Bad thing to be a type specifier: ~S."spec)))))))))1410 (error 'invalidtypespecifier :typespec spec))))))))) 1400 1411 1401 1412 (evalwhen (:compiletoplevel :execute) … … 1528 1539 (handlercase 1529 1540 (typespecifier (specifiertype spec env)) 1541 (invalidtypespecifier () spec) 1530 1542 (parseunknowntype () spec))) 1531 1543 … … 1558 1570 (when pred (setf (numericctypepredicate res) pred)))) 1559 1571 (unless (unknownctypep res) 1560 1561 1572 (setf (infotypebuiltin spec) res) 1573 (setf (infotypekind spec) :primitive))))) 1562 1574 1563 1575 ;;;; Builtin types. … … 3956 3968 `(simplearray (signedbyte 32) (,size))) 3957 3969 3970 3971 3972 (deftype simpleshortfloatvector (&optional size) 3973 `(simplearray shortfloat (,size))) 3974 3975 (deftype unsignedwordvector (&optional size) 3976 `(vector (unsignedbyte 16) ,size)) 3977 3978 (deftype singlefloatvector (&optional size) 3979 `(vector shortfloat ,size)) 3980 3981 (deftype unsignedbytevector (&optional size) 3982 `(vector (unsignedbyte 8) ,size)) 3983 3984 (deftype unsignedlongvector (&optional size) 3985 `(vector (unsignedbyte 32) ,size)) 3986 3987 (deftype longfloatvector (&optional size) 3988 `(vector doublefloat ,size)) 3989 3990 (deftype longvector (&optional size) 3991 `(vector (signedbyte 32) ,size)) 3992 3993 (deftype doublefloatvector (&optional size) 3994 `(vector doublefloat ,size)) 3995 3996 (deftype bytevector (&optional size) 3997 `(vector (signedbyte 8) ,size)) 3998 3999 (deftype generalvector (&optional size) 4000 `(vector t ,size)) 4001 4002 (deftype wordvector (&optional size) 4003 `(vector (signedbyte 16) ,size)) 4004 4005 (deftype shortfloatvector (&optional size) 4006 `(vector singlefloat ,size)) 4007 4008 (deftype simple1darray (&optional size) 4009 `(simplearray * (,size))) 4010 4011 (deftype simplelongvector (&optional size) 4012 `(simplearray (signedbyte 32) (,size))) 4013 4014 (deftype simplewordvector (&optional size) 4015 `(simplearray (signedbyte 16) (,size))) 4016 4017 (deftype simpleshortfloatvector (&optional size) 4018 `(simplearray singlefloat (,size))) 4019 4020 (deftype simplebytevector (&optional size) 4021 `(simplearray (signedbyte 8) (,size))) 4022 3958 4023 (deftype simpledoublefloatvector (&optional size) 3959 4024 `(simplearray doublefloat (,size))) 3960 4025 3961 (deftype simpleshortfloatvector (&optional size)3962 `(simplearray shortfloat (,size)))3963 3964 (deftype unsignedwordvector (&optional size)3965 `(vector (unsignedbyte 16) ,size))3966 3967 (deftype singlefloatvector (&optional size)3968 `(vector shortfloat ,size))3969 3970 (deftype unsignedbytevector (&optional size)3971 `(vector (unsignedbyte 8) ,size))3972 3973 (deftype unsignedlongvector (&optional size)3974 `(vector (unsignedbyte 32) ,size))3975 3976 (deftype longfloatvector (&optional size)3977 `(vector doublefloat ,size))3978 3979 (deftype longvector (&optional size)3980 `(vector (signedbyte 32) ,size))3981 3982 (deftype doublefloatvector (&optional size)3983 `(vector doublefloat ,size))3984 3985 (deftype bytevector (&optional size)3986 `(vector (signedbyte 8) ,size))3987 3988 (deftype generalvector (&optional size)3989 `(vector t ,size))3990 3991 (deftype wordvector (&optional size)3992 `(vector (signedbyte 16) ,size))3993 3994 (deftype shortfloatvector (&optional size)3995 `(vector singlefloat ,size))3996 3997 (deftype simple1darray (&optional size)3998 `(simplearray * (,size)))3999 4000 (deftype simplelongvector (&optional size)4001 `(simplearray (signedbyte 32) (,size)))4002 4003 (deftype simplewordvector (&optional size)4004 `(simplearray (signedbyte 16) (,size)))4005 4006 (deftype simpleshortfloatvector (&optional size)4007 `(simplearray singlefloat (,size)))4008 4009 (deftype simplebytevector (&optional size)4010 `(simplearray (signedbyte 8) (,size)))4011 4012 (deftype simpledoublefloatvector (&optional size)4013 `(simplearray doublefloat (,size)))4014 4015 4026 (deftype simplesinglefloatvector (&optional size) 4016 4027 `(simplearray singlefloat (,size))) 4017 4028 4029 (deftype simplelongfloatvector (&optional size) 4030 `(simplearray doublefloat (,size))) 4031 4018 4032 (deftype simplefixnumvector (&optional size) 4019 4033 `(simplearray fixnum (,size))) 4034 4035 (deftype fixnumvector (&optional size) 4036 `(array fixnum (,size))) 4020 4037 4021 4038 #+64bittarget … … 4034 4051 `(doublefloat ,low ,high)) 4035 4052 4053 # 4036 4054 ;;; As empty a type as you're likely to find ... 4037 4055 (deftype extendedchar () 4038 4056 "Type of CHARACTERs that aren't BASECHARs." 4039 4057 nil) 4058 # 4040 4059 4041 4060 (deftype natural () … … 4321 4340 (unless (eq ctype *universaltype*) 4322 4341 (generatepredicateforctype ctype))) 4342 (invalidtypespecifier () 4343 (warn "Invalid type specifier ~s in slot definition for ~s in class ~s." type (slotdefinitionname spec) (slotdefinitionclass 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 (slotdefinitionname spec) (slotdefinitionclass spec) (slotdefinitiontype 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 (slotvalue spec 'typepredicate) nil) 4351 t)) 4323 4352 (parseunknowntype (c) 4324 4353 (declare (ignore c))
Note: See TracChangeset
for help on using the changeset viewer.