cursed polymorphic unboxed array code

[stylewarning]

I was just playing around with implementing efficient arithmetic with polymorphic unboxed arrays. The code below is clumsy (you have to write stuff like (Array ArrayDoubleFloat Double-Float) and (ArrayDoubleFloat Double-Float) when you want to actually use a specific unboxed array type...), but it works! >_>

(cl:defpackage #:coalton-array
  (:use #:coalton
        #:coalton-prelude))

(cl:in-package #:coalton-array)

(coalton-toplevel
  (define-class (Array :f :t)
    (make (UFix -> :t -> (:f :t)))
    (size ((:f :t) -> UFix))
    (aref ((:f :t) -> UFix -> :t))
    (set! ((:f :t) -> UFix -> :t -> Unit)))

  (define (%sum-array a n i s)
    (if (< i n)
        (%sum-array a n (1+ i) (+ s (aref a i)))
        s))

  (define (sum-array a)
    (%sum-array a (size a) 0 0))

  (define (map! f a)
    (let ((s (size a))
          (iter (fn (i)
                  (when (< i s)
                    (set! a i (f (aref a i)))
                    (iter (1+ i))))))
      (iter 0)))

  (declare double! ((Array :f :t) (Num :t) => (:f :t) -> Unit))
  (define double! (map! (* 2))))


(cl:defmacro %define-unboxed-array (cl-type ct-type coalton-array-type)
  `(coalton-toplevel
     (repr :native (cl:simple-array ,cl-type (cl:*)))
     (define-type (,coalton-array-type :t))

     (define-instance (Array ,coalton-array-type ,ct-type)
       (define (make n x)
         (lisp (,coalton-array-type ,ct-type) (n x)
           (cl:make-array n :element-type ',cl-type :initial-element x)))
       (define (size a)
         (lisp UFix (a)
           (cl:length a)))
       (define (aref a n)
         (lisp ,ct-type (a n)
           (cl:aref a n)))
       (define (set! a n x)
         (lisp Unit (a n x)
           (cl:setf (cl:aref a n) x)
           Unit)))))

(%define-unboxed-array cl:single-float Single-Float ArraySingleFloat)
(%define-unboxed-array cl:double-float Double-Float ArrayDoubleFloat)
(%define-unboxed-array (cl:complex cl:single-float) (Complex Single-Float) ArrayComplexSingleFloat)
(%define-unboxed-array (cl:complex cl:double-float) (Complex Double-Float) ArrayComplexDoubleFloat)

Note that sum-array, map!, and double! is polymorphic.

COALTON-ARRAY> (coalton
                (let ((a (the (ArrayDoubleFloat Double-Float) (make 10 1.0d0))))
                  (sum-array a)))
10.0d0

COALTON-ARRAY> (coalton
                (let ((a (the (ArrayComplexDoubleFloat (Complex Double-Float)) (make 10 (Complex 1.0d0 -1.0d0)))))
                  (progn
                    (double! a)
                    (sum-array a))))
#C(20.0d0 -20.0d0)

You can monomorphize just fine to get native double-float instructions inside of the loops:

(coalton-toplevel
  (monomorphize)
  (declare sum-array-df ((ArrayDoubleFloat Double-Float) -> Double-Float))
  (define sum-array-df sum-array))

Peeking into the disassembly of the monomorphized sum-array-df loop innards:

...
; D36:       F2420F10549001   MOVSD XMM2, [RAX+R10*4+1]
; D3D:       488B45E0         MOV RAX, [RBP-32]
; D41:       F20F1048F9       MOVSD XMM1, [RAX-7]
; D46:       F20F58CA         ADDSD XMM1, XMM2
...

Edit 1: Did match destructuring in the method implementations so Coalton would generate correct type annotations for the inner accessors.

Edit 2: Simplify by getting rid of intermediate unboxed array type.

[aijony]

Perhaps I'm not understanding this correctly, but the following generates the same disassembly on my machine:

(coalton-toplevel
  (repr :native cl:simple-array)
  (define-type (UnboxedArray :t))

  (define-class (Unboxable :t)
    (make (UFix -> :t -> (UnboxedArray :t)))
    (size ((UnboxedArray :t) -> UFix))
    (aref ((UnboxedArray :t) -> UFix -> :t))
    (set! ((UnboxedArray :t) -> UFix -> :t -> Unit))))

(cl:defmacro %define-unboxed-array (cl-type ct-type )
  `(coalton-toplevel
     (define-instance (Unboxable ,ct-type)
       (define (make n x)
         (lisp (UnboxedArray ,ct-type) (n x)
           (cl:make-array n :element-type ',cl-type :initial-element x)))
       (define (size a)
         (lisp UFix (a)
           (cl:length a)))
       (define (aref a n)
         (lisp ,ct-type (a n)
           (cl:aref a n)))
       (define (set! a n x)
         (lisp Unit (a n x)
           (cl:setf (cl:aref a n) x)
           Unit)))))

[stylewarning]

This code won't actually make a flat array of unboxed values. Your code is still an array of pointers.

[stylewarning]

So logically maybe you'll make a few storage types like DoubleArrayStorage and instead have a type class (Array :storage :type) with instance (Array DoubleArrayStorage Double-Float), but then you can't type double! because

(declare double! ((Array :s :t) (Num :t) => :s -> Unit))

is invalid (can't have :t on the LHS and not the RHS).

[stylewarning]

P.S., I should have used match forms in the implementations of the class methods so Coalton would emit the inner array types... whoops.

Edit: Added.

[stylewarning]

h/t @aijony I didn't know one could do

     (repr :native cl-foo)
     (define-type (ct-foo :t))

with the type variable :t, even if :t really has no "meaning" there, which massively simplifies the implementation.

[gefjon]

Associated types (or type families, or whatever) could greatly improve the ergonomics of this; one could write the type of double! as ((Array :elt) (Num :elt) => (ArrayOf :elt) -> Unit).

That said, I'd still sorta prefer just having the compiler know about arrays, and the handful of other cl types that can be specialized.

[digikar99]

Indeed, if there was a way to map a set of parametric type instances to their runtime representations, then it seems the code can be much cleaner.

(coalton-toplevel
  (repr :native (cl:simple-array cl:single-float (cl:*)))
  (define-type (array single-float))
  (repr :native (cl:simple-array cl:double-float (cl:*)))
  (define-type (array double-float)))

[stylewarning]

See #1007 for a proposed, more ergonomic design based on the above.