Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-18 21:29:19 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Forgot to add file for (srfi 160 mini).

Browse source
This commit is contained in:
Alex Shinn 2024-05-28 23:13:18 +09:00
parent 2161f0df6e
commit 609c78c0ca
1 changed files with 52 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

52
lib/srfi/160/mini.sld Normal file
View file

@ -0,0 +1,52 @@
(define-library (srfi 160 mini)
(export
make-f8vector f8vector f8? f8vector?
f8vector-ref f8vector-set! f8vector-length
f8vector->list list->f8vector
make-f16vector f16vector f16? f16vector?
f16vector-ref f16vector-set! f16vector-length
f16vector->list list->f16vector)
(import (scheme base)
(srfi 160 prims)
(only (chibi) list->uvector make-uvector))
(begin
(define (f8? x) (and (real? x) (inexact? x)))
(define f8vector-length uvector-length)
(define (make-f8vector len . o)
(let ((res (make-uvector SEXP_F8 len)))
(if (and (pair? o) (not (zero? (car o))))
(do ((i 0 (+ i 1)))
((>= i len))
(f8vector-set! res i (car o))))
res))
(define (f8vector->list uv . o)
(let ((start (if (pair? o) (car o) 0))
(end (if (and (pair? o) (pair? (cdr o)))
(cadr o)
(f8vector-length uv))))
(do ((i (- end 1) (- i 1))
(res '() (cons (f8vector-ref uv i) res)))
((< i start) res))))
(define (list->f8vector ls) (list->uvector SEXP_F8 ls))
(define (f8vector . args) (list->f8vector args))
(define (f16? x) (and (real? x) (inexact? x)))
(define f16vector-length uvector-length)
(define (make-f16vector len . o)
(let ((res (make-uvector SEXP_F16 len)))
(if (and (pair? o) (not (zero? (car o))))
(do ((i 0 (+ i 1)))
((>= i len))
(f16vector-set! res i (car o))))
res))
(define (f16vector->list uv . o)
(let ((start (if (pair? o) (car o) 0))
(end (if (and (pair? o) (pair? (cdr o)))
(cadr o)
(f16vector-length uv))))
(do ((i (- end 1) (- i 1))
(res '() (cons (f16vector-ref uv i) res)))
((< i start) res))))
(define (list->f16vector ls) (list->uvector SEXP_F16 ls))
(define (f16vector . args) (list->f16vector args))
))