(defpackage "COM.INFORMATIMAGO.COMMON-LISP.CARRAY"
  (:use "CL")
  (:shadow "MAKE-ARRAY" "AREF" "ARRAY-DIMENSIONS" #|…|#)
  (:export "MAKE-ARRAY" "AREF" "ARRAY-DIMENSIONS" #|…|#))

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

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

(defun make-array (dimensions &rest keys &key (element-type 't) &allow-other-keys)
  (make-controlled-array (apply (function cl:make-array) dimensions keys)
                         element-type))

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

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

(defun array-dimensions (array)
  (cl:array-dimensions array))



(let ((array  (make-array 3
                          :element-type '(integer 1 12)
                          :initial-element 6)))
  (print (multiple-value-list (ignore-errors (setf (aref array 2) 100))))
  (print array)
  (setf (aref array 1) 7)
  (print array)
  (values))


;; prints:
;; (nil #<type-error #x30203DC8ABDD>)
;; #S(controlled-array :array #(6 6 6) :element-type (integer 1 12))
;; #S(controlled-array :array #(6 7 6) :element-type (integer 1 12))