67 lines
2.2 KiB
Racket
67 lines
2.2 KiB
Racket
#lang racket/base
|
|
(require "../unsafe.ss")
|
|
|
|
(define-struct cvector (ptr type length))
|
|
|
|
(provide cvector? cvector-length cvector-type cvector-ptr
|
|
;; make-cvector* is a dangerous operation
|
|
(protect-out (rename-out [make-cvector make-cvector*])))
|
|
|
|
(define-syntax define*
|
|
(syntax-rules ()
|
|
[(_ (name . args) body ...)
|
|
(begin (provide name) (define (name . args) body ...))]
|
|
[(_ name expr)
|
|
(begin (provide name) (define name expr))]))
|
|
|
|
(define _cvector* ; used only as input types
|
|
(make-ctype _pointer cvector-ptr
|
|
(lambda (x)
|
|
(error '_cvector
|
|
"cannot automatically convert a C pointer to a cvector"))))
|
|
|
|
;; (_cvector <mode> [<type> <len>]) | _cevector
|
|
;; Same as _list etc above, except that it uses C vectors.
|
|
(provide _cvector)
|
|
(define-fun-syntax _cvector
|
|
(syntax-id-rules (i o io)
|
|
[(_ i ) _cvector*]
|
|
[(_ o t n) (type: _pointer ; needs to be a pointer, not a cvector*
|
|
pre: (malloc n t)
|
|
post: (x => (make-cvector x t n)))]
|
|
[(_ io ) (type: _cvector*
|
|
bind: tmp
|
|
pre: (x => (cvector-ptr x))
|
|
post: (x => tmp))]
|
|
[(_ . xs) (_cvector* . xs)]
|
|
[_ _cvector*]))
|
|
|
|
(provide (rename-out [allocate-cvector make-cvector]))
|
|
(define (allocate-cvector type len)
|
|
(make-cvector (if (zero? len) #f ; 0 => NULL
|
|
(malloc len type))
|
|
type len))
|
|
|
|
(provide (rename-out [cvector-args cvector]))
|
|
(define (cvector-args type . args)
|
|
(list->cvector args type))
|
|
|
|
(define* (cvector-ref v i)
|
|
(if (and (exact-nonnegative-integer? i) (< i (cvector-length v)))
|
|
(ptr-ref (cvector-ptr v) (cvector-type v) i)
|
|
(error 'cvector-ref "bad index ~e for cvector bounds of 0..~e"
|
|
i (sub1 (cvector-length v)))))
|
|
|
|
(define* (cvector-set! v i x)
|
|
(if (and (exact-nonnegative-integer? i) (< i (cvector-length v)))
|
|
(ptr-set! (cvector-ptr v) (cvector-type v) i x)
|
|
(error 'cvector-ref "bad index ~e for cvector bounds of 0..~e"
|
|
i (sub1 (cvector-length v)))))
|
|
|
|
(define* (cvector->list v)
|
|
(cblock->list (cvector-ptr v) (cvector-type v) (cvector-length v)))
|
|
|
|
(define* (list->cvector l type)
|
|
(make-cvector (list->cblock l type) type (length l)))
|
|
|