Advertisement
Guest User

Untitled

a guest
Dec 1st, 2018
162
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.47 KB | None | 0 0
  1.  
  2. (defpackage "COM.INFORMATIMAGO.COMMON-LISP.CARRAY"
  3. (:use "CL")
  4. (:export "MAKE-CONTROLLED-ARRAY"
  5. "CONTROLLED-ARRAY"
  6. "CAREF"))
  7.  
  8. (in-package "COM.INFORMATIMAGO.COMMON-LISP.CARRAY")
  9.  
  10. (defstruct (controlled-array
  11. (:constructor make-controlled-array (array element-type))
  12. (:conc-name %carray-))
  13. array
  14. element-type)
  15.  
  16. (defun caref (carray &rest indices)
  17. (apply (function aref) (%carray-array carray) indices))
  18.  
  19. (defun (setf caref) (new-value carray &rest indices)
  20. (if (typep new-value (%carray-element-type carray))
  21. (setf (apply (function aref) (%carray-array carray) indices) new-value)
  22. (error 'type-error :datum new-value :expected-type (%carray-element-type carray))))
  23.  
  24.  
  25. (let ((carray (make-controlled-array (make-array 3
  26. :element-type '(integer 1 12)
  27. :initial-element 6)
  28. '(integer 1 12))))
  29.  
  30. (setf (aref (%carray-array carray) 1) 100)
  31. (print carray)
  32. (print (multiple-value-list (ignore-errors (setf (caref carray 2) 100))))
  33. (print carray)
  34. (setf (caref carray 1) 7)
  35. (print carray)
  36. (values))
  37. ;; prints:
  38. ;; #S(controlled-array :array #(6 100 6) :element-type (integer 1 12))
  39. ;; (nil #<type-error #x30203DBE28AD>)
  40. ;; #S(controlled-array :array #(6 100 6) :element-type (integer 1 12))
  41. ;; #S(controlled-array :array #(6 7 6) :element-type (integer 1 12))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement