Added array utilities

This commit is contained in:
retropikzel 2025-04-06 07:59:19 +03:00
parent 70d19a8a90
commit 3f4cb7f668
5 changed files with 118 additions and 41 deletions

View File

@ -26,11 +26,9 @@ conforming to some specification.
- [Status](#status)
- [Current caveats](#current-caveats)
- [Roadmap](#roadmap)
- [Implementation table](#implementation-table)
- [Beta](#beta)
- [Alpha](#alpha)
- [Not started](#not-started)
- [Other](#other)
- [Feature implementation table](#feature-implementation-table)
- [Primitives](#feature-implementation-table-primitives)
- [Built upon](#feature-implementation-table-built-upon)
- [Documentation](#documentation)
- [Installation](#installation)
- [Compiling the library](#compiling-the-library)
@ -93,10 +91,6 @@ conforming to some specification.
Currently the interface of the library is in okay shape. It propably will not change much but no
guarantees are being made just yet.
Due to supporting many different Scheme implementations, different parts of this software are in
different stage. As a whole it is still in **alpha** stage. That said the interface should not be
changing anymore and some implementations are in **beta**.
### Current caveats
<a name="current-caveats"></a>
@ -112,41 +106,46 @@ changing anymore and some implementations are in **beta**.
For roadmap to 1.0.0 see [issues](https://todo.sr.ht/~retropikzel/r7rs-pffi?search=status%3Aopen%20label%3A%221.0.0%22)
## Implementation table
<a name="implementation-table"></a>
## Feature mplementation table
<a name="feature-implementation-table"></a>
### Released
<a name="released"></a>
## Primitives
<a name="feature-implementation-table-primitives"></a>
| | pffi-init | pffi-size-of | pffi-define-library | pffi-pointer-null | pffi-pointer-null? | pffi-pointer-address | pffi-pointer? | pffi-pointer-set! | pffi-pointer-get | pffi-define | pffi-define-callback |
|--------------|:---------:|:------------:|:-------------------:|:-----------------:|:------------------:|:--------------------:|:-------------:|:-----------------:|:----------------:|:-----------:|:--------------------:|
| Chibi | X | X | X | X | X | X | X | X | X | X | |
| Chicken-5 | X | X | X | X | X | X | X | X | X | X | X |
| Cyclone | X | X | X | X | X | | X | X | X | X | |
| Gambit | X | X | | | | X | | | | | |
| Gauche | X | X | X | X | X | X | X | X | X | X | |
| Gerbil | X | | | | | | | | | | |
| Guile | X | X | X | X | X | X | X | X | X | X | X |
| Kawa | X | X | X | X | X | X | X | X | X | X | X |
| Larceny | X | | | | | | | | | | |
| Mosh | X | X | X | X | X | | X | X | X | X | X |
| Racket | X | X | X | X | X | X | X | X | X | X | X |
| Saggittarius | X | X | X | X | X | X | X | X | X | X | X |
| Skint | X | | | | | | | | | | |
| Stklos | X | X | X | X | X | | X | | | | |
| tr7 | | | | | | | | | | | |
| Ypsilon | X | X | X | X | X | X | X | X | X | X | X |
### Beta
<a name="beta"></a>
## Built upon
<a name="feature-implementation-table-built-upon"></a>
| | pffi-init | pffi-size-of | pffi-define-library | pffi-pointer-null | pffi-pointer-null? | pffi-pointer-allocate | pffi-pointer-address | pffi-pointer? | pffi-pointer-free | pffi-pointer-set! | pffi-pointer-get | pffi-string->pointer | pffi-pointer->string | pffi-struct-make | pffi-struct-pointer | pffi-struct-offset-get | pffi-struct-get | pffi-struct-set! | pffi-define | pffi-define-callback |
|--------------|:---------:|:------------:|:-------------------:|:-----------------:|:------------------:|:---------------------:|:--------------------:|:-------------:|:-----------------:|:-----------------:|:----------------:|:--------------------:|:--------------------:|:----------------:|:-------------------:|:----------------------:|:---------------:|:----------------:|:-----------:|:--------------------:|
| Chibi | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | |
| Chicken-5 | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X |
| Gauche | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | |
| Guile | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X |
| Kawa | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X |
| Racket | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X |
| Saggittarius | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X |
These features are built upon the primitives and if primitives are implemented
and work, they should work too.
### Alpha
<a name="alpha"></a>
| | pffi-init | pffi-size-of | pffi-define-library | pffi-pointer-null | pffi-pointer-null? | pffi-pointer-allocate | pffi-pointer-address | pffi-pointer? | pffi-pointer-free | pffi-pointer-set! | pffi-pointer-get | pffi-string->pointer | pffi-pointer->string | pffi-struct-make | pffi-struct-pointer | pffi-struct-offset-get | pffi-struct-get | pffi-struct-set! | pffi-define | pffi-define-callback |
|--------------|:---------:|:------------:|:-------------------:|:-----------------:|:------------------:|:---------------------:|:--------------------:|:-------------:|:-----------------:|:-----------------:|:----------------:|:--------------------:|:--------------------:|:----------------:|:-------------------:|:----------------------:|:---------------:|:----------------:|:-----------:|:--------------------:|
| Cyclone | X | X | X | X | X | X | | X | X | X | X | X | X | X | X | X | X | X | X | |
| Gambit | X | X | | | | | X | | | | | | | X | X | X | X | X | | |
| Gerbil | X | | | | | | | | | | | | | X | X | X | X | X | | |
| Larceny | X | | | | | | | | | | | | | X | X | X | X | X | | |
| Mosh | X | X | X | X | X | X | | X | X | X | X | X | X | X | X | X | X | X | X | X |
| Skint | X | | | | | | | | | | | | | X | X | X | X | X | | |
| Stklos | X | X | X | X | X | X | | X | X | | | | | X | X | X | X | X | | |
| tr7 | | | | | | | | | | | | | | X | X | X | X | X | | |
| Ypsilon | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X | X |
- pffi-pointer-allocate
- pffi-pointer-free
- pffi-pointer-\>string
- pffi-string-\>pointer
- pffi-struct-make
- pffi-struct-pointer
- pffi-struct-offset-get
- pffi-struct-get
- pffi-struct-set!
### Not started
<a name="not-started"></a>

View File

@ -29,6 +29,8 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-list->array
pffi-array->list
pffi-define
pffi-define-callback
;scheme-procedure-to-pointer
@ -65,6 +67,8 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-list->array
pffi-array->list
pffi-define
pffi-define-callback))
(chicken6
@ -97,6 +101,8 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-list->array
pffi-array->list
pffi-define
pffi-define-callback))
(cyclone
@ -126,6 +132,8 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-list->array
pffi-array->list
pffi-define
;pffi-define-callback
))
@ -156,6 +164,8 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-list->array
pffi-array->list
pffi-define
;pffi-define-callback
))
@ -187,6 +197,8 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-list->array
pffi-array->list
pffi-define
;pffi-define-callback
))
@ -215,6 +227,8 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-list->array
pffi-array->list
;pffi-define
;pffi-define-callback
))
@ -247,6 +261,8 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-list->array
pffi-array->list
pffi-define
pffi-define-callback))
(kawa
@ -275,6 +291,8 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-list->array
pffi-array->list
pffi-define
pffi-define-callback
))
@ -309,6 +327,8 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-list->array
pffi-array->list
;pffi-define
;pffi-define-callback
))
@ -339,6 +359,8 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-list->array
pffi-array->list
pffi-define
pffi-define-callback))
(racket
@ -372,6 +394,8 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-list->array
pffi-array->list
pffi-define
pffi-define-callback))
(sagittarius
@ -402,6 +426,8 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-list->array
pffi-array->list
pffi-define
pffi-define-callback))
(skint
@ -429,6 +455,8 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-list->array
pffi-array->list
;pffi-define
;pffi-define-callback
))
@ -459,6 +487,8 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-list->array
pffi-array->list
pffi-define
;pffi-define-callback
))
@ -488,6 +518,8 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-list->array
pffi-array->list
;pffi-define
;pffi-define-callback
))
@ -520,6 +552,8 @@
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-list->array
pffi-array->list
pffi-define
pffi-define-callback))
(else (error "Unsupported implementation")))
@ -544,5 +578,6 @@
;(include "pffi/shared/union.scm")
(include "pffi/shared/main.scm")
(include "pffi/shared/pointer.scm")
(include "pffi/shared/array.scm")
(include "pffi/shared/struct.scm")
)

View File

@ -22,7 +22,8 @@
((equal? type 'string) 'void*)
((equal? type 'void) 'void)
((equal? type 'callback) 'callback)
((equal? type 'struct) 'char*)
((equal? type 'struct) 'void*)
((list? type) (map pffi-type->native-type type))
(else #f))))
(define pffi-pointer?
@ -81,7 +82,7 @@
(lambda (pointer)
(address pointer 0)))
#;(define pffi-pointer-null
(define pffi-pointer-null
(lambda ()
(empty-pointer)))

View File

@ -0,0 +1,22 @@
(define pffi-list->array
(lambda (type list-arg)
(let* ((type-size (pffi-size-of type))
(array (pffi-pointer-allocate (* type-size (length list-arg))))
(offset 0))
(for-each
(lambda (item)
(pffi-pointer-set! array type offset item)
(set! offset (+ offset type-size)))
list-arg)
array)))
(define pffi-array->list
(lambda (type array size)
(letrec* ((type-size (pffi-size-of type))
(max-offset (* type-size size))
(looper (lambda (offset result)
(if (= offset max-offset)
result
(looper (+ offset type-size)
(append result (list (pffi-pointer-get array type offset))))))))
(looper 0 (list)))))

View File

@ -884,6 +884,26 @@
(debug (pffi-struct-get struct-test2 'n))
(assert = (pffi-struct-get struct-test2 'n) 14.0)
; Array utilities
(print-header "Array utilities")
(define test-list1 (list 1 2 3))
(debug test-list1)
(debug (pffi-list->array 'int test-list1))
(assert equal? (pffi-array->list 'int (pffi-list->array 'int test-list1) 3) test-list1)
(define test-array1 (pffi-pointer-allocate (* (pffi-size-of 'int) 3)))
(pffi-pointer-set! test-array1 'int (* (pffi-size-of 'int) 0) 4)
(pffi-pointer-set! test-array1 'int (* (pffi-size-of 'int) 1) 5)
(pffi-pointer-set! test-array1 'int (* (pffi-size-of 'int) 2) 6)
(debug test-array1)
(debug (pffi-array->list 'int test-array1 3))
(define check-list1 (list 4 5 6))
(assert equal? (pffi-array->list 'int test-array1 3) check-list1)
;; pffi-struct-dereference
;(print-header "pffi-struct-dereference 1")