diff --git a/coalton.asd b/coalton.asd index aea57a91c..67d4aa1de 100644 --- a/coalton.asd +++ b/coalton.asd @@ -167,6 +167,7 @@ (:file "result") (:file "tuple") (:file "list") + (:file "array") (:file "vector") (:file "char") (:file "string") diff --git a/library/array.lisp b/library/array.lisp new file mode 100644 index 000000000..582301977 --- /dev/null +++ b/library/array.lisp @@ -0,0 +1,110 @@ +(coalton-library/utils:defstdlib-package #:coalton-library/array + (:use + #:coalton + #:coalton-library/classes) + (:local-nicknames + (#:c #:coalton-library/math/complex) + (#:a #:coalton-library/math/arith)) + (:export + #:Array + #:make + #:size + #:aref + #:set! + + #:SingleFloats + #:DoubleFloats + #:ComplexSingleFloats + #:ComplexDoubleFloats)) + +(in-package #:coalton-library/array) + +(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 (Array :f :t (:f -> :t)) + "Establishes that `:f` can (only) store elements of type `:t`. The **storage type** `:f` implies the **stored type** `:t`. + +The storage is expected to be sequential and efficient in random access." + (make (UFix -> :t -> :f)) + (size (:f -> UFix)) + (aref (:f -> UFix -> :t)) + (set! (:f -> UFix -> :t -> Unit)))) + +;;; Built-In Storage Types +(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) + + (define-instance (Array ,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 (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 SingleFloats) +(%define-unboxed-array cl:double-float Double-Float DoubleFloats) +(%define-unboxed-array (cl:complex cl:single-float) (c:Complex Single-Float) ComplexSingleFloats) +(%define-unboxed-array (cl:complex cl:double-float) (c:Complex Double-Float) ComplexDoubleFloats) + +;;; Examples, to be deleted... +(coalton-toplevel + (define (%sum-array a n i s) + (if (< i n) + (%sum-array a n (a:1+ i) (+ s (aref a i))) + s)) + + (define (sum-array a) + (%sum-array a (size a) 0 0)) + + (declare map! (Array :f :t => (:t -> :t) -> :f -> Unit)) + (define (map! f a) + (let ((s (size a)) + (iter (fn (i) + (when (< i s) + (set! a i (f (aref a i))) + (iter (a:1+ i)))))) + (iter 0))) + + (declare double! ((Array :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/ARRAY") diff --git a/src/doc/generate-documentation.lisp b/src/doc/generate-documentation.lisp index 86315d7cc..c1b48d9c1 100644 --- a/src/doc/generate-documentation.lisp +++ b/src/doc/generate-documentation.lisp @@ -125,6 +125,7 @@ coalton-library/list coalton-library/result coalton-library/cell + coalton-library/array coalton-library/vector coalton-library/slice coalton-library/hashtable