3670916a11
Replaced pointwise operators with macros that expand to applications of `array-map'; allows more precise return types and reduces compilation time Changed literal array syntax to use #() to delimit rows instead of [] (still suggest using square parens, though) Minor refactoring Fixed a macro so that the only problem with "array-tests.rkt" now is that typed/rackunit is b0rked
44 lines
1.3 KiB
Racket
44 lines
1.3 KiB
Racket
#lang racket/base
|
|
|
|
(require (for-syntax racket/base))
|
|
|
|
(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 (vector d ...) (constr v ...)))))]))
|