From f66e728ead4f4b553856985c8e287d424c9f56dc Mon Sep 17 00:00:00 2001 From: Robert Smith Date: Wed, 11 Oct 2023 15:00:39 -0700 Subject: [PATCH] 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 (*)) 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 | 1 + library/lisparray.lisp | 64 ++++++++++++++++++++++++++ library/math/complex.lisp | 9 +++- src/doc/generate-documentation.lisp | 1 + src/typechecker/lisp-type.lisp | 71 ++++++++++++++++++++++++++++- 5 files changed, 144 insertions(+), 2 deletions(-) create mode 100644 library/lisparray.lisp diff --git a/coalton.asd b/coalton.asd index f9e41fe6e..33bd0c4f4 100644 --- a/coalton.asd +++ b/coalton.asd @@ -168,6 +168,7 @@ (:file "optional") (:file "result") (:file "tuple") + (:file "lisparray") (:file "list") (:file "vector") (:file "char") diff --git a/library/lisparray.lisp b/library/lisparray.lisp new file mode 100644 index 000000000..e15aaac87 --- /dev/null +++ b/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 (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") diff --git a/library/math/complex.lisp b/library/math/complex.lisp index 240c7d14a..7bd06e4f6 100644 --- a/library/math/complex.lisp +++ b/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)) diff --git a/src/doc/generate-documentation.lisp b/src/doc/generate-documentation.lisp index 00d402dab..ac241b8b3 100644 --- a/src/doc/generate-documentation.lisp +++ b/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 diff --git a/src/typechecker/lisp-type.lisp b/src/typechecker/lisp-type.lisp index fa9ebdb2b..9d105043b 100644 --- a/src/typechecker/lisp-type.lisp +++ b/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