add specialized LispArray and Complex logic

This commit does two main things:

1. Adds (LispArray :t). There are presently no constructors for it,
but there is logic to emit appropriately specialized (SIMPLE-ARRAY <t>
(*)) declarations in many common monomorphic cases.

2. Handles the repr of (Complex :t) specially from LISP-TYPE so that
more specific type declarations are emitted for floating point types.

coalton.asd

@@ -168,6 +168,7 @@
                (:file "optional")
                (:file "result")
                (:file "tuple")
+               (:file "lisparray")
                (:file "list")
                (:file "vector")
                (:file "char")

library/lisparray.lisp

@@ -0,0 +1,64 @@
+;;;; lisparray.lisp
+;;;;
+;;;; An interface to Common Lisp rank-1 SIMPLE-ARRAYs.
+
+(coalton-library/utils:defstdlib-package #:coalton-library/lisparray
+  (:use #:coalton)
+  (:local-nicknames (#:ram #:coalton-library/randomaccess)
+                    (#:ty  #:coalton-library/types))
+  (:export
+   #:LispArray))
+
+(in-package #:coalton-library/lisparray)
+
+(named-readtables:in-readtable coalton:coalton)
+
+#+coalton-release
+(cl:declaim #.coalton-impl/settings:*coalton-optimize-library*)
+
+(coalton-toplevel
+  ;; The representation of (LispArray :t) is specially dealt with by
+  ;; the compiler in lisp-type.lisp.
+  (define-type (LispArray :t)
+    "A one-dimensional, non-resizable array of elements.
+
+These arrays are represented as possibly specialized `(cl:simple-array <t> (cl:*))` and are meant to be used as a flexible tool to implement efficient data structures. One should consult `Vector` or `Seq` for more general sequential data structure needs.
+
+Whether or not the arrays are specialized depends on the underlying Lisp implementation. Consult `cl:upgraded-array-element-type` to determine whether `LispArray` may get specialized.")
+
+)                                       ; COALTON-TOPLEVEL
+
+(coalton-toplevel
+  (declare make-lisparray (ty:RuntimeRepr :t => UFix -> :t -> (LispArray :t)))
+  (define (make-lisparray n x)
+    ;; FIXME: how can we get this statically?
+    (let ((type (ty:runtime-repr (ty:proxy-of x))))
+      (lisp (LispArray :t) (n x type)
+        (cl:make-array n :element-type type :initial-element x)))))
+
+(coalton-toplevel
+  (define-instance (ty:RuntimeRepr :t => ram:RandomAccess (LispArray :t) :t)
+    (define (ram:make n x)
+      (make-lisparray n x))
+
+    (define (ram:length v)
+      (lisp UFix (v)
+        (cl:length v)))
+
+    (define (ram:readable? v_)
+      True)
+
+    (define (ram:writable? v_)
+      True)
+
+    (define (ram:unsafe-aref v i)
+      (lisp :t (v i)
+        (cl:aref v i)))
+
+    (define (ram:unsafe-set! v i x)
+      (lisp Unit (v i x)
+        (cl:setf (cl:aref v i) x)
+        Unit))))
+
+#+sb-package-locks
+(sb-ext:lock-package "COALTON-LIBRARY/LISPARRAY")

library/math/complex.lisp

@@ -25,11 +25,18 @@
 (cl:declaim #.coalton-impl/settings:*coalton-optimize-library*)
 
 (coalton-toplevel
-  (repr :native (cl:or cl:number complex))
+  ;; The representation of (Complex :t) is specially dealt with by the
+  ;; compiler in lisp-type.lisp.
   (define-type (Complex :a)
     "Complex number that may either have a native or constructed representation."
     (%Complex :a :a))
+)
 
+;; Quirk: We had to split the above COALTON-TOPLEVEL from the bottom
+;; one because Allegro needs to know about Complex before it gets used
+;; as a Lisp type in codegen. SBCL and CCL tolerate it fine.
+
+(coalton-toplevel
   (define-class (Num :a => Complex :a)
     (complex (:a -> :a -> (Complex :a)))
     (real-part (Complex :a -> :a))

src/doc/generate-documentation.lisp

@@ -121,6 +121,7 @@
                coalton-library/char
                coalton-library/string
                coalton-library/tuple
+               coalton-library/lisparray
                coalton-library/optional
                coalton-library/list
                coalton-library/result

src/typechecker/lisp-type.lisp

@@ -15,6 +15,42 @@
 
 (in-package #:coalton-impl/typechecker/lisp-type)
 
+(defun lisp-type= (x y)
+  (and (subtypep x y)
+       (subtypep y x)))
+
+;;; This is a list of Coalton tycon names that (1) have a finite
+;;; number of specialized representations, and (2) won't yet exist
+;;; when this file is first compiled.
+
+;;; Complex
+(defun complex-tycon ()
+  (and (find-package "COALTON-LIBRARY/MATH/COMPLEX")
+       (find-symbol "COMPLEX" "COALTON-LIBRARY/MATH/COMPLEX")))
+
+(defvar *specialized-complex-part-types-considered*
+  '(cl:single-float cl:double-float))
+
+;;; Simple Arrays
+(defun lisparray-tycon ()
+  (and (find-package "COALTON-LIBRARY/LISPARRAY")
+       (find-symbol "LISPARRAY" "COALTON-LIBRARY/LISPARRAY")))
+
+(defvar *specialized-array-element-types-considered*
+  `(
+    ;; Float types
+    cl:single-float cl:double-float
+    ;; Complex float types
+    (cl:complex cl:single-float) (cl:complex cl:double-float)
+    ;; Integer types
+    cl:fixnum
+    (cl:and cl:fixnum cl:unsigned-byte)
+    ,@(loop :for byte-type :in '(cl:signed-byte cl:unsigned-byte)
+            :nconc (loop :for size :in '(8 16 32 64)
+                         :collect `(,byte-type ,size))))
+  )
+
+
 ;;;
 ;;; Lisp types for coalton types
 ;;;
@@ -30,7 +66,6 @@ USE-FUNCTION-ENTRIES specifies whether to emit FUNCTION-ENTRY for functions, emi
     't)
 
   (:method ((ty tycon) env)
-    (declare (ignore))
     (let*
         ((tcon-name (tycon-name ty))
          (type-entry (lookup-type env tcon-name :no-error t)))
@@ -49,6 +84,40 @@ USE-FUNCTION-ENTRIES specifies whether to emit FUNCTION-ENTRY for functions, emi
       ((function-type-p ty)
        'function-entry)
 
+      ((typep (tapp-from ty) 'tycon)
+       (let ((from (tycon-name (tapp-from ty)))
+             (to   (tapp-to ty)))
+         (cond
+           ;; First we deal with specialized parametric types.
+           ;;
+           ;; (Complex :t)
+           ((and (not (null (complex-tycon)))
+                 (eq from (complex-tycon)))
+            (let ((lisp-to (lisp-type to env)))
+              (cond
+                ((member lisp-to
+                         *specialized-complex-part-types-considered*
+                         :test #'lisp-type=)
+                 `(cl:complex ,lisp-to))
+                (t
+                 `(cl:or cl:number ,(complex-tycon))))))
+
+           ;; (LispArray :t)
+           ((and (not (null (lisparray-tycon)))
+                 (eq from (lisparray-tycon)))
+            (let ((lisp-to (lisp-type to env)))
+              (cond
+                ((member lisp-to
+                         *specialized-array-element-types-considered*
+                         :test #'lisp-type=)
+                 `(cl:simple-array ,lisp-to (cl:*)))
+                (t
+                 `(cl:simple-array cl:* (cl:*))))))
+
+           ;; Otherwise we fall back.
+           (t
+            (lisp-type (tapp-from ty) env)))))
+
       ;; Otherwise, emit the applied type
       (t
        ;; Our underlying representation of types does not have any