implementation of RandomAccess class

This adds a new class to the standard library (RandomAccess :F :T)
allows the storage of elements of type :T inside of a storage type :F
with efficient O(1) read/write access.

The class implements a few instances (which could be expanded to all
reasonable efficient types), and uses the convention of adding an 's'
to the base type (e.g., a storage of Double-Float is DoubleFloats). We
don't keep "legacy" '-' in existing names.

All operations become efficient Common Lisp code, up to inlining.

coalton.asd

@@ -167,6 +167,7 @@
                (:file "result")
                (:file "tuple")
                (:file "list")
+               (:file "randomaccess")
                (:file "vector")
                (:file "char")
                (:file "string")

library/randomaccess.lisp

@@ -0,0 +1,223 @@
+(coalton-library/utils:defstdlib-package #:coalton-library/randomaccess
+  (:use
+   #:coalton
+   #:coalton-library/classes)
+  (:local-nicknames
+   (#:c #:coalton-library/math/complex)
+   (#:a #:coalton-library/math/arith)
+   (#:types #:coalton-library/types)
+   (#:iter #:coalton-library/iterator)
+   (#:cell #:coalton-library/cell))
+  (:export
+   #:RandomAccess
+   #:make
+   #:size
+   #:unsafe-aref
+   #:unsafe-set!
+
+   #:aref
+   #:set!
+
+   #:SingleFloats
+   #:DoubleFloats
+
+   #:IFixes
+   #:I8s
+   #:I16s
+   #:I32s
+   #:I64s
+
+   #:UFixes
+   #:U8s
+   #:U16s
+   #:U32s
+   #:U64s
+
+   #:Booleans
+
+   #:ComplexSingleFloats
+   #:ComplexDoubleFloats))
+
+(in-package #:coalton-library/randomaccess)
+
+(named-readtables:in-readtable coalton:coalton)
+
+#+coalton-release
+(cl:declaim #.coalton-impl/settings:*coalton-optimize-library*)
+
+;;; Class Implementation
+(coalton-toplevel
+  ;; The decision to use a functional dependency was an ergonomic one,
+  ;; not a technical one. If we did not establish this dependency, we
+  ;; would win flexibility (a single storage type can store multiple
+  ;; data types), but we would lose a lot of practical ergonomics
+  ;; (e.g., we would need Proxy types, calls to size would need to be
+  ;; disambiguated, etc.).
+  ;;
+  ;; While we lose some flexibility, we still retain some. For
+  ;; instance, we can have multiple storage types for double floats
+  ;; (think: Lisp arrays, C arrays, GPU arrays, etc.).
+  (define-class (RandomAccess :f :t (:f -> :t))
+    "Establishes that `:f` is a random-access store of elements of type `:t`. The **storage type** `:f` implies the **stored type** `:t`. The storage is expected to be sequential and O(1) in random access reads and writes.
+
+It is permitted for any of `make`, `unsafe-aref`, or `unsafe-set!` to error."
+    (make (UFix -> :t -> :f))
+    (size (:f -> UFix))
+    (readable? (:f -> Boolean))
+    (writable? (:f -> Boolean))
+    (unsafe-aref (:f -> UFix -> :t))
+    (unsafe-set! (:f -> UFix -> :t -> Unit))))
+
+;;; Derived Functions
+(coalton-toplevel
+  (declare aref (RandomAccess :f :t => :f -> UFix -> (Optional :t)))
+  (define (aref storage index)
+    "Read the element at `index` of the random-access storage `storage`. Return `None` if the read is out-of-bounds or not permitted."
+    (if (and (readable? storage)
+             (<= 0 index)
+             (< index (size storage)))
+        (Some (unsafe-aref storage index))
+        None))
+
+  (declare set! (RandomAccess :f :t => :f -> UFix -> :t -> (Optional Unit)))
+  (define (set! storage index value)
+    "Write the element `value` at `index` of the random-access storage `storage`. Return `None` if the write is out-of-bounds or not permitted."
+    (if (and (writable? storage)
+             (<= 0 index)
+             (< index (size storage)))
+        (Some (unsafe-set! storage index value))
+        None)))
+
+;;; General Instances
+(coalton-toplevel
+  #+ignore
+  (define-instance (RandomAccess :f :t => iter:IntoIterator :f :t)
+    (define (iter:into-iter a)
+      (let idx = (the (cell:Cell UFix) (cell:new 0)))
+      (iter:with-size
+          (fn ()
+            (let ((value (unsafe-aref a (cell:read idx))))
+              (cell:increment! idx)
+              value))
+        (size a)))))
+
+;;; Built-In Storage Types
+(cl:defmacro %define-unboxed-array (ct-type coalton-array-type cl:&optional cl-type)
+  (cl:let ((cl-type (cl:or
+                     cl-type
+                     (cl:eval `(coalton (types:runtime-repr (the (types:Proxy ,ct-type) types:Proxy)))))))
+    `(coalton-toplevel
+       (repr :native (cl:simple-array ,cl-type (cl:*)))
+       (define-type ,coalton-array-type)
+
+       (define-instance (RandomAccess ,coalton-array-type ,ct-type)
+         (define (make n x)
+           (lisp ,coalton-array-type (n x)
+             (cl:make-array n :element-type ',cl-type :initial-element x)))
+         (define (size a)
+           (lisp UFix (a)
+             (cl:length a)))
+         (define (readable? _)
+           True)
+         (define (writable? _)
+           True)
+         (define (unsafe-aref a n)
+           (lisp ,ct-type (a n)
+             (cl:aref a n)))
+         (define (unsafe-set! a n x)
+           (lisp Unit (a n x)
+             (cl:setf (cl:aref a n) x)
+             Unit)))
+
+       ;; Good idea?
+       #+ignore
+       (define-instance (iter:IntoIterator ,coalton-array-type ,ct-type)
+         (define (iter:into-iter a)
+           (let idx = (the (cell:Cell UFix) (cell:new 0)))
+           (iter:with-size
+               (fn ()
+                 (let ((value (aref a (cell:read idx))))
+                   (cell:increment! idx)
+                   (Some value)))
+             (size a)))))))
+
+(%define-unboxed-array Single-Float SingleFloats)
+(%define-unboxed-array Double-Float DoubleFloats)
+
+(%define-unboxed-array IFix IFixes)
+(%define-unboxed-array I8 I8s)
+(%define-unboxed-array I16 I16s)
+(%define-unboxed-array I32 I32s)
+(%define-unboxed-array I64 I64s)
+
+(%define-unboxed-array UFix UFixes)
+(%define-unboxed-array U8 U8s)
+(%define-unboxed-array U16 U16s)
+(%define-unboxed-array U32 U32s)
+(%define-unboxed-array U64 U64s)
+
+;; Complex numbers don't use a specialized representation. See gh #1008.
+(%define-unboxed-array (c:Complex Single-Float) ComplexSingleFloats (cl:complex cl:single-float))
+(%define-unboxed-array (c:Complex Double-Float) ComplexDoubleFloats (cl:complex cl:double-float))
+
+;; Booleans stored as bits
+(coalton-toplevel
+  (repr :native cl:simple-bit-vector)
+  (define-type Booleans)
+
+  (define-instance (RandomAccess Booleans Boolean)
+    (define (make n x)
+      (lisp Booleans (n x)
+        (cl:make-array n :element-type 'cl:bit :initial-element (cl:if x 1 0))))
+    (define (size a)
+      (lisp UFix (a)
+        (cl:length a)))
+    (define (readable? _)
+      True)
+    (define (writable? _)
+      True)
+    (define (unsafe-aref a n)
+      (lisp Boolean (a n)
+        (cl:= 1 (cl:sbit a n))))
+    (define (unsafe-set! a n x)
+      (lisp Unit (a n x)
+        (cl:setf (cl:sbit a n) (cl:if x 1 0))
+        Unit))))
+
+;;; Examples, to be deleted...
+(coalton-toplevel
+  (define (%sum-array a n i s)
+    (if (< i n)
+        (%sum-array a n (a:1+ i) (+ s (unsafe-aref a i)))
+        s))
+
+  (define (sum-array a)
+    (%sum-array a (size a) 0 0))
+
+  (declare map! (RandomAccess :f :t => (:t -> :t) -> :f -> Unit))
+  (define (map! f a)
+    (let ((s (size a))
+          (iter (fn (i)
+                  (when (< i s)
+                    (unsafe-set! a i (f (unsafe-aref a i)))
+                    (iter (a:1+ i))))))
+      (iter 0)))
+
+  (declare double! ((RandomAccess :f :t) (Num :t) => :f -> Unit))
+  (define double! (map! (* 2)))
+
+  (define (ex1)
+    (let ((a (the DoubleFloats (make 10 1.0d0))))
+      (sum-array a)))
+
+  (define (ex2)
+    (let ((a (the ComplexDoubleFloats (make 10 (c:complex 1.0d0 -1.0d0)))))
+      (double! a)
+      (sum-array a)))
+
+  (monomorphize)
+  (declare sum-array-df (DoubleFloats -> Double-Float))
+  (define sum-array-df sum-array))
+
+#+sb-package-locks
+(sb-ext:lock-package "COALTON-LIBRARY/RANDOMACCESS")

src/doc/generate-documentation.lisp

@@ -125,6 +125,7 @@
                coalton-library/list
                coalton-library/result
                coalton-library/cell
+               coalton-library/randomaccess
                coalton-library/vector
                coalton-library/slice
                coalton-library/hashtable