Commit | Line | Data |
---|---|---|
6be07c52 TTN |
1 | ;;; srfi-4.scm --- Homogeneous Numeric Vector Datatypes |
2 | ||
3 | ;; Copyright (C) 2001, 2002 Free Software Foundation, Inc. | |
4 | ;; | |
73be1d9e MV |
5 | ;; This library is free software; you can redistribute it and/or |
6 | ;; modify it under the terms of the GNU Lesser General Public | |
7 | ;; License as published by the Free Software Foundation; either | |
8 | ;; version 2.1 of the License, or (at your option) any later version. | |
9 | ;; | |
10 | ;; This library is distributed in the hope that it will be useful, | |
6be07c52 TTN |
11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
73be1d9e MV |
13 | ;; Lesser General Public License for more details. |
14 | ;; | |
15 | ;; You should have received a copy of the GNU Lesser General Public | |
16 | ;; License along with this library; if not, write to the Free Software | |
17 | ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA | |
6be07c52 TTN |
18 | |
19 | ;;; Author: Martin Grabmueller <mgrabmue@cs.tu-berlin.de> | |
71ca65d9 MG |
20 | |
21 | ;;; Commentary: | |
22 | ||
6be07c52 TTN |
23 | ;; This module implements homogeneous numeric vectors as defined in SRFI-4. |
24 | ;; This module is fully documented in the Guile Reference Manual. | |
71ca65d9 MG |
25 | |
26 | ;;; Code: | |
27 | ||
1a179b03 MD |
28 | (define-module (srfi srfi-4) |
29 | :export ( | |
71ca65d9 MG |
30 | ;;; Unsigned 8-bit vectors. |
31 | u8vector? make-u8vector u8vector u8vector-length u8vector-ref | |
32 | u8vector-set! u8vector->list list->u8vector | |
33 | ||
34 | ;;; Signed 8-bit vectors. | |
35 | s8vector? make-s8vector s8vector s8vector-length s8vector-ref | |
36 | s8vector-set! s8vector->list list->s8vector | |
37 | ||
38 | ;;; Unsigned 16-bit vectors. | |
39 | u16vector? make-u16vector u16vector u16vector-length u16vector-ref | |
40 | u16vector-set! u16vector->list list->u16vector | |
41 | ||
42 | ;;; Signed 16-bit vectors. | |
43 | s16vector? make-s16vector s16vector s16vector-length s16vector-ref | |
44 | s16vector-set! s16vector->list list->s16vector | |
45 | ||
46 | ;;; Unsigned 32-bit vectors. | |
47 | u32vector? make-u32vector u32vector u32vector-length u32vector-ref | |
48 | u32vector-set! u32vector->list list->u32vector | |
49 | ||
50 | ;;; Signed 32-bit vectors. | |
51 | s32vector? make-s32vector s32vector s32vector-length s32vector-ref | |
52 | s32vector-set! s32vector->list list->s32vector | |
53 | ||
54 | ;;; Unsigned 64-bit vectors. | |
55 | u64vector? make-u64vector u64vector u64vector-length u64vector-ref | |
56 | u64vector-set! u64vector->list list->u64vector | |
57 | ||
58 | ;;; Signed 64-bit vectors. | |
59 | s64vector? make-s64vector s64vector s64vector-length s64vector-ref | |
60 | s64vector-set! s64vector->list list->s64vector | |
61 | ||
62 | ;;; 32-bit floating point vectors. | |
63 | f32vector? make-f32vector f32vector f32vector-length f32vector-ref | |
64 | f32vector-set! f32vector->list list->f32vector | |
65 | ||
66 | ;;; 64-bit floating point vectors. | |
67 | f64vector? make-f64vector f64vector f64vector-length f64vector-ref | |
68 | f64vector-set! f64vector->list list->f64vector | |
1a179b03 | 69 | )) |
71ca65d9 MG |
70 | |
71 | ||
72 | ;; Make 'srfi-4 available as a feature identifiere to `cond-expand'. | |
73 | ;; | |
74 | (cond-expand-provide (current-module) '(srfi-4)) | |
75 | ||
76 | ||
77 | ;; Load the compiled primitives from the shared library. | |
78 | ;; | |
79 | (load-extension "libguile-srfi-srfi-4" "scm_init_srfi_4") | |
80 | ||
81 | ||
82 | ;; Reader extension for #f32() and #f64() vectors. | |
83 | ;; | |
84 | (define (hash-f char port) | |
85 | (if (or (char=? (peek-char port) #\3) | |
86 | (char=? (peek-char port) #\6)) | |
87 | (let* ((obj (read port))) | |
88 | (if (number? obj) | |
89 | (cond ((= obj 32) | |
90 | (let ((l (read port))) | |
91 | (if (list? l) | |
92 | (list->f32vector l) | |
93 | (error "syntax error in #f32() vector literal")))) | |
94 | ((= obj 64) | |
95 | (let ((l (read port))) | |
96 | (if (list? l) | |
97 | (list->f64vector l) | |
98 | (error "syntax error in #f64() vector literal")))) | |
99 | (else | |
100 | (error "syntax error in #f...() vector literal"))) | |
101 | (error "syntax error in #f...() vector literal"))) | |
102 | #f)) | |
103 | ||
104 | ||
105 | ;; Reader extension for #u8(), #u16(), #u32() and #u64() vectors. | |
106 | ;; | |
107 | (define (hash-u char port) | |
108 | (if (or (char=? (peek-char port) #\8) | |
109 | (char=? (peek-char port) #\1) | |
110 | (char=? (peek-char port) #\3) | |
111 | (char=? (peek-char port) #\6)) | |
112 | (let ((obj (read port))) | |
113 | (cond ((= obj 8) | |
114 | (let ((l (read port))) | |
115 | (if (list? l) | |
116 | (list->u8vector l) | |
117 | (error "syntax error in #u8() vector literal")))) | |
118 | ((= obj 16) | |
119 | (let ((l (read port))) | |
120 | (if (list? l) | |
121 | (list->u16vector l) | |
122 | (error "syntax error in #u16() vector literal")))) | |
123 | ((= obj 32) | |
124 | (let ((l (read port))) | |
125 | (if (list? l) | |
126 | (list->u32vector l) | |
127 | (error "syntax error in #u32() vector literal")))) | |
128 | ((= obj 64) | |
129 | (let ((l (read port))) | |
130 | (if (list? l) | |
131 | (list->u64vector l) | |
132 | (error "syntax error in #u64() vector literal")))) | |
133 | (else | |
134 | (error "syntax error in #u...() vector literal")))) | |
135 | (error "syntax error in #u...() vector literal"))) | |
6be07c52 | 136 | |
71ca65d9 MG |
137 | |
138 | ;; Reader extension for #s8(), #s16(), #s32() and #s64() vectors. | |
139 | ;; | |
140 | (define (hash-s char port) | |
141 | (if (or (char=? (peek-char port) #\8) | |
142 | (char=? (peek-char port) #\1) | |
143 | (char=? (peek-char port) #\3) | |
144 | (char=? (peek-char port) #\6)) | |
145 | (let ((obj (read port))) | |
146 | (cond ((= obj 8) | |
147 | (let ((l (read port))) | |
148 | (if (list? l) | |
149 | (list->s8vector l) | |
150 | (error "syntax error in #s8() vector literal")))) | |
151 | ((= obj 16) | |
152 | (let ((l (read port))) | |
153 | (if (list? l) | |
154 | (list->s16vector l) | |
155 | (error "syntax error in #s16() vector literal")))) | |
156 | ((= obj 32) | |
157 | (let ((l (read port))) | |
158 | (if (list? l) | |
159 | (list->s32vector l) | |
160 | (error "syntax error in #s32() vector literal")))) | |
161 | ((= obj 64) | |
162 | (let ((l (read port))) | |
163 | (if (list? l) | |
164 | (list->s64vector l) | |
165 | (error "syntax error in #s64() vector literal")))) | |
166 | (else | |
167 | (error "syntax error in #s...() vector literal")))) | |
168 | (error "syntax error in #s...() vector literal"))) | |
6be07c52 | 169 | |
71ca65d9 MG |
170 | |
171 | ;; Install the hash extensions. | |
172 | ;; | |
173 | (read-hash-extend #\f hash-f) | |
174 | (read-hash-extend #\u hash-u) | |
175 | (read-hash-extend #\s hash-s) | |
6be07c52 TTN |
176 | |
177 | ;;; srfi-4.scm ends here |