b8efd58aca
* `list->array' now accepts an optional shape argument, and always returns an immutable array * `vector->array' now accepts an optional shape argument, and always returns a mutable array * Removed `make-mutable-array' because `vector->array' does its job now (I never liked the name anyway) * Renamed `unsafe-mutable-array' to `unsafe-vector->array' * Added optional type annotation to `array' macro to match `mutable-array' * Reworded error messages in array broadcasting functions * Made minor array doc fixes
45 lines
1.4 KiB
Racket
45 lines
1.4 KiB
Racket
#lang racket/base
|
|
|
|
(require (for-syntax racket/base)
|
|
(only-in typed/racket/base inst Index))
|
|
|
|
(provide array/syntax)
|
|
|
|
(define-for-syntax (syntax-vector-shape e-stx)
|
|
(syntax-case e-stx ()
|
|
[#[] (list 0)]
|
|
[#[e0 e ...]
|
|
(let ([lst (syntax->list #'(e0 e ...))])
|
|
(define d (length lst))
|
|
(define ds (syntax-vector-shape (car lst)))
|
|
(if ds
|
|
(let loop ([lst (cdr lst)])
|
|
(cond [(null? lst) (cons d ds)]
|
|
[(equal? ds (syntax-vector-shape (car lst)))
|
|
(loop (cdr lst))]
|
|
[else #f]))
|
|
#f))]
|
|
[_ null]))
|
|
|
|
(define-for-syntax (syntax-vector-flatten e-stx)
|
|
(reverse
|
|
(let loop ([e-stx e-stx] [acc null])
|
|
(syntax-case e-stx ()
|
|
[#[e ...]
|
|
(let ([lst (syntax->list #'(e ...))])
|
|
(for/fold ([acc acc]) ([lst (in-list lst)])
|
|
(loop lst acc)))]
|
|
[else
|
|
(cons e-stx acc)]))))
|
|
|
|
(define-syntax (array/syntax stx)
|
|
(syntax-case stx ()
|
|
[(_ orig-name constr ->array e)
|
|
(let ([ds (syntax-vector-shape #'e)])
|
|
(unless ds
|
|
(raise-syntax-error (syntax->datum #'orig-name) "expected rectangular data" stx #'e))
|
|
(with-syntax ([(d ...) ds]
|
|
[(v ...) (syntax-vector-flatten #'e)])
|
|
(syntax/loc stx
|
|
(->array ((inst vector Index) d ...) (constr v ...)))))]))
|