1;;; -*- mode:scheme; coding:utf-8; -*-
2;;;
3;;; srfi/%3a160/base.scm - Homogeneous numeric vector datatypes (base)
4;;;
5;;;   Copyright (c) 2020  Takashi Kato  <ktakashi@ymail.com>
6;;;
7;;;   Redistribution and use in source and binary forms, with or without
8;;;   modification, are permitted provided that the following conditions
9;;;   are met:
10;;;
11;;;   1. Redistributions of source code must retain the above copyright
12;;;      notice, this list of conditions and the following disclaimer.
13;;;
14;;;   2. Redistributions in binary form must reproduce the above copyright
15;;;      notice, this list of conditions and the following disclaimer in the
16;;;      documentation and/or other materials provided with the distribution.
17;;;
18;;;   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
19;;;   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
20;;;   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
21;;;   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
22;;;   OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
23;;;   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
24;;;   TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
25;;;   PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
26;;;   LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
27;;;   NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
28;;;   SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
29;;;
30
31
32#!nounbound
33(library (srfi :160 base)
34    (export make-u8vector make-s8vector make-u16vector make-s16vector
35	    make-u32vector make-s32vector make-u64vector make-s64vector
36	    make-f32vector make-f64vector make-c64vector make-c128vector
37
38	    u8vector s8vector u16vector s16vector
39	    u32vector s32vector u64vector s64vector
40	    f32vector f64vector c64vector c128vector
41
42	    u8vector? s8vector? u16vector? s16vector?
43	    u32vector? s32vector? u64vector? s64vector?
44	    f32vector? f64vector? c64vector? c128vector?
45
46	    u8vector-length s8vector-length u16vector-length s16vector-length
47	    u32vector-length s32vector-length u64vector-length s64vector-length
48	    f32vector-length f64vector-length c64vector-length c128vector-length
49
50	    u8vector-ref s8vector-ref u16vector-ref s16vector-ref
51	    u32vector-ref s32vector-ref u64vector-ref s64vector-ref
52	    f32vector-ref f64vector-ref c64vector-ref c128vector-ref
53
54	    u8vector-set! s8vector-set! u16vector-set! s16vector-set!
55	    u32vector-set! s32vector-set! u64vector-set! s64vector-set!
56	    f32vector-set! f64vector-set! c64vector-set! c128vector-set!
57
58	    u8vector->list s8vector->list u16vector->list s16vector->list
59	    u32vector->list s32vector->list u64vector->list s64vector->list
60	    f32vector->list f64vector->list c64vector->list c128vector->list
61
62	    list->u8vector list->s8vector list->u16vector list->s16vector
63	    list->u32vector list->s32vector list->u64vector list->s64vector
64	    list->f32vector list->f64vector list->c64vector list->c128vector
65
66	    u8? s8? u16? s16? u32? s32? u64? s64? f32? f64? c64? c128?
67
68	    :export-reader-macro
69	    )
70    (import (rnrs)
71	    (only (scheme base) exact-integer?)
72	    (sagittarius) ;; for format
73	    (sagittarius reader)
74	    ;; @vector->list of srfi-4 has extension of srfi-160
75	    ;; so just re-export ;)
76	    (srfi :4 numeric-vectors)
77	    (srfi :160 base c64)
78	    (srfi :160 base c128))
79
80(define (u8? n) (and (exact-integer? n) (<= 0 n 255)))
81(define (s8? n) (and (exact-integer? n) (<= -128 n 127)))
82(define (u16? n) (and (exact-integer? n) (<= 0 n 65535)))
83(define (s16? n) (and (exact-integer? n) (<= -32768 n 32767)))
84(define (u32? n) (and (exact-integer? n) (<= 0 n 4294967295)))
85(define (s32? n) (and (exact-integer? n) (<= -2147483648 n 2147483647)))
86(define (u64? n) (and (exact-integer? n) (<= 0 n 18446744073709551615)))
87(define (s64? n) (and (exact-integer? n)
88		      (<= -9223372036854775808 n 9223372036854775807)))
89(define (f32? n) (and (inexact? n) (real? n)))
90(define (f64? n) (f32? n))
91(define (c64? n) (inexact? n))
92(define (c128? n) (inexact? n))
93
94(define-dispatch-macro
95  |#c-reader| #\# #\c
96  (lambda (port c param)
97    (if (delimited-char? (lookahead-char port))
98	#f
99	(let ((n (read port)))
100	  (unless (integer? n)
101	    (raise-i/o-read-error '|#c-reader| "invalid character for #c" port))
102	  (let ((lst (read port))) ;; must be a list
103	    (unless (list? lst)
104	      (raise-i/o-read-error '|#c-reader|
105				    (format "list required, but got ~s" lst)
106				    port))
107	    (let ((ctr (case n
108			 ((64) c64vector)
109			 ((128) c128vector)
110			 (else
111			  (raise-i/o-read-error '|#c-reader|
112			   (format "given number was not supported ~a" n)
113			   port)))))
114	      (apply ctr lst)))))))
115
116)
117