(deftype dimension ()
  '(integer 1 #.(min (floor (sqrt array-dimension-limit))
                 (floor (sqrt most-positive-fixnum)))))

(deftype f32 ()
  'single-float)

(declaim (ftype (function (t) single-float) f32))
(defun f32 (value)
  (declare (optimize speed (debug 1) (safety 1) (compilation-speed 0)))
  (float value 0.0))

(define-compiler-macro f32
    (value &environment env)
  (if (constantp value env)
      `(load-time-value
        (let ((,'value ,value))
          ,@'((float value 0.0))))
      `(let ((,'value ,value))
         ,@'((float value 0.0)))))

(defstruct (type-object
            (:constructor nil)
            (:copier nil)
            (:predicate nil)))

(declaim (inline %matn marrn mrowsn mcolsn))
(defstruct
    (matn (:include type-object) (:constructor %matn (marrn mrowsn mcolsn))
          (:copier matn-copy) (:predicate matn-p) (:conc-name nil))
  (marrn nil :type (simple-array f32 (*)) :read-only nil)
  (mrowsn nil :type dimension :read-only nil)
  (mcolsn nil :type dimension :read-only nil))

(declaim (ftype (function (matn) matn) copy/n/f32)
         (inline copy/n/f32))
(defun copy/n/f32 (m)
  (declare (optimize speed (safety 0) (debug 0) (compilation-speed 0))
           (type matn m))
  (let ((orig (marrn m))
        (arr (make-array (length (marrn m)) :element-type 'f32)))
    (loop for i from 0 below (length (marrn m)) by 1
          do (progn (setf (aref arr i) (aref orig i)))
          finally (return nil))
    (%matn arr (mrowsn m) (mcolsn m))))

(defun mcopy (a)
  (declare (optimize speed (debug 1) (safety 1) (compilation-speed 0)))
  (etypecase a
    (matn (progn (copy/n/f32 a)))))

(sb-c:defknown mcopy
    ((or matn imatn dmatn imat4 dmat4 mat4 imat3 dmat3 mat3 imat2 dmat2 mat2))
    (or t)
    (sb-c:any)
  :overwrite-fndb-silently
  t)
(sb-c:deftransform mcopy
    ((a) (matn))
  '(copy/n/f32 a))