(defpackage "COM.INFORMATIMAGO.COMMON-LISP.CARRAY"
  (:use "CL")
  (:export "MAKE-CONTROLLED-ARRAY"
           "CONTROLLED-ARRAY"
           "CAREF"))

(in-package "COM.INFORMATIMAGO.COMMON-LISP.CARRAY")

(defstruct (controlled-array
            (:constructor make-controlled-array (array element-type))
            (:conc-name %carray-))
  array
  element-type)

(defun caref (carray &rest indices)
  (apply (function aref) (%carray-array carray)  indices))

(defun (setf caref) (new-value carray &rest indices)
  (if (typep new-value (%carray-element-type carray))
      (setf (apply (function aref)  (%carray-array carray) indices) new-value)
      (error 'type-error :datum new-value :expected-type (%carray-element-type carray))))


(let ((carray (make-controlled-array (make-array 3
                                                 :element-type '(integer 1 12)
                                                 :initial-element 6)
                                     '(integer 1 12))))

  (setf (aref (%carray-array carray) 1) 100)
  (print carray)
  (print (multiple-value-list (ignore-errors (setf (caref carray 2) 100))))
  (print carray)
  (setf (caref carray 1) 7)
  (print carray)
  (values))
;; prints:
;; #S(controlled-array :array #(6 100 6) :element-type (integer 1 12))
;; (nil #<type-error #x30203DBE28AD>)
;; #S(controlled-array :array #(6 100 6) :element-type (integer 1 12))
;; #S(controlled-array :array #(6 7 6) :element-type (integer 1 12))