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