[gnunet-scheme] 27/324: Define bytevector slices

[gnunet]

This is an automated email from the git hooks/post-receive script.

maxime-devos pushed a commit to branch master
in repository gnunet-scheme.

commit 6455428be1d31aeccd7befb5edc35233296675fa
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Mon Nov 16 21:19:49 2020 +0100

    Define bytevector slices
---
 gnu/gnunet/utils/bv-slice.scm | 180 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 180 insertions(+)

diff --git a/gnu/gnunet/utils/bv-slice.scm b/gnu/gnunet/utils/bv-slice.scm
new file mode 100644
index 0000000..4dfbc2c
--- /dev/null
+++ b/gnu/gnunet/utils/bv-slice.scm
@@ -0,0 +1,180 @@
+;;   This file is part of scheme-GNUnet, a partial Scheme port of GNUnet.
+;;   Copyright (C) 2020 Maxime Devos <maxime.devos@student.kuleuven.be>
+;;
+;;   scheme-GNUnet is free software: you can redistribute it and/or modify it
+;;   under the terms of the GNU Affero General Public License as published
+;;   by the Free Software Foundation, either version 3 of the License,
+;;   or (at your option) any later version.
+;;
+;;   scheme-GNUnet is distributed in the hope that it will be useful, but
+;;   WITHOUT ANY WARRANTY; without even the implied warranty of
+;;   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;   Affero General Public License for more details.
+;;
+;;   You should have received a copy of the GNU Affero General Public License
+;;   along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;
+;;   SPDX-License-Identifier: AGPL-3.0-or-later
+;;
+;;   As a special exception to the GNU Affero General Public License,
+;;   the file may be relicensed under any license used for
+;;   most source code of GNUnet 0.13.1, or later versions, as published by
+;;   GNUnet e.V.
+
+;; Author: Maxime Devos
+;; Source: gnu/gnunet/utils/bv-slice.scm
+;; Brief: parts of bytevectors, with read/write restricted
+;; (TODO: parts of vectors, uniform vectors ...)
+
+(library (gnu gnunet utils bv-slice)
+  (export slice?
+         slice-bv
+         slice-offset
+         slice-length
+         slice-slice
+         bv-slice/read-write
+         make-slice/read-write
+         slice-readable?
+         slice-writable?
+         slice/read-only
+         slice/write-only
+         slice/read-write
+         slice-u8-ref
+         slice-u16-ref
+         slice-u32-ref
+         slice-u64-ref
+         slice-u8-set!
+         slice-u16-set!
+         slice-u32-set!
+         slice-u64-set!)
+  (import (rnrs arithmetic bitwise)
+         (rnrs base)
+         (rnrs bytevectors)
+         (rnrs control)
+         (rnrs records syntactic)
+         (srfi srfi-31))
+
+  (define-record-type (<slice> %make-slice slice?)
+    ;; TODO: perhaps use pointer->bytevector
+    ;; and bytevector->pointer when available
+    ;; to remove the use of offset and length
+    (fields (immutable bv slice-bv) ;; unsafe: bounds may be ignored
+           (immutable offset slice-offset) ;; unsafe: implementation details
+           (immutable length slice-length)
+           (immutable cap-bits slice-capability-bits))
+    (opaque #t)
+    (sealed #t))
+
+  (define slice-slice
+    (case-lambda
+      "Select a part of the slice, preserving capabilities"
+      ((slice)
+       (assert (slice? slice))
+       slice)
+      ((slice offset)
+       (assert (slice? slice))
+       (assert (and (integer? offset)
+                   (exact? offset)
+                   (<= 0 offset)
+                   (<= offset (slice-length slice))))
+       (%make-slice (slice-bv slice)
+                   offset
+                   (- (slice-length slice) offset)
+                   (slice-capability-bits slice)))
+      ((slice offset length)
+       (assert (slice? slice))
+       (assert (and (integer? offset)
+                   (exact? offset)
+                   (<= 0 offset)))
+       (assert (and (integer? length)
+                   (exact? length)
+                   (<= 0 length)))
+       (assert (<= (+ offset length)
+                  (slice-length slice)))
+       (%make-slice (slice-bv slice)
+                   (+ offset (slice-offset slice))
+                   length
+                   (slice-capability-bits slice)))))
+
+  (define CAP_READ  #b1)
+  (define CAP_WRITE #b10)
+  (define CAP_ALL (bitwise-ior CAP_READ CAP_WRITE))
+
+  (define (slice-as-well process-first-arg)
+    (case-lambda
+      "Do @var{process-first-arg}, and then perhaps slice"
+      ((obj)
+       (process-first-arg obj))
+      ((obj offset)
+       (slice-slice (process-first-arg obj) offset))
+      ((obj offset length)
+       (slice-slice (process-first-arg obj) offset length))))
+
+  (define bv-slice/read-write
+    (slice-as-well
+     (lambda (bv)
+      "Construct a read-write bytevector slice.  Mutations will change
+the bytevector in place."
+      (assert (bytevector? bv))
+      (%make-slice bv 0 (bytevector-length bv)
+                  (bitwise-ior CAP_READ CAP_WRITE)))))
+
+  (define (make-slice/read-write length)
+    "Make a fresh, zero-initialised, read-write slice"
+    (bv-slice/read-write (make-bytevector length 0)))
+
+  (define (make-slice-cap-p required-cap-bits)
+    (assert (= (bitwise-and required-cap-bits CAP_ALL)
+              required-cap-bits))
+    (lambda (slice)
+      "Does @var{slice} have the capabilities @var{required-cap-bits}?"
+      (= (bitwise-and (slice-capability-bits slice) required-cap-bits)
+        required-cap-bits)))
+
+  (define slice-readable? (make-slice-cap-p CAP_READ))
+  (define slice-writable? (make-slice-cap-p CAP_WRITE))
+
+  (define (make-select-capabilities desired-cap-bits)
+    (let ((ok? (make-slice-cap-p desired-cap-bits)))
+      (slice-as-well
+       (lambda (slice)
+        (assert (ok? slice))
+        (%make-slice (slice-bv slice)
+                     (slice-offset slice)
+                     (slice-length slice)
+                     desired-cap-bits)))))
+  (define slice/read-only
+    (make-select-capabilities CAP_READ))
+  (define slice/write-only
+    (make-select-capabilities CAP_WRITE))
+  (define slice/read-write
+    (make-select-capabilities (bitwise-ior CAP_READ CAP_WRITE)))
+
+  (define (wrap-rnrs-ref rnrs-ref ok? size)
+    (lambda (slice index . rest)
+      (assert (and (exact? index)
+                  (integer? index)
+                  (<= 0 index)
+                  (<= (+ index size) (slice-length slice))))
+      (assert (ok? slice))
+      (apply rnrs-ref (slice-bv slice)
+            (+ (slice-offset slice) index)
+            rest)))
+
+  (define slice-u8-ref
+    (wrap-rnrs-ref bytevector-u8-ref slice-readable? 1))
+  (define slice-u16-ref
+    (wrap-rnrs-ref bytevector-u16-ref slice-readable? 2))
+  (define slice-u32-ref
+    (wrap-rnrs-ref bytevector-u32-ref slice-readable? 4))
+  (define slice-u64-ref
+    (wrap-rnrs-ref bytevector-u64-ref slice-readable? 8))
+
+  (define slice-u8-set!
+    (wrap-rnrs-ref bytevector-u8-set! slice-writable? 1))
+  (define slice-u16-set!
+    (wrap-rnrs-ref bytevector-u16-set! slice-writable? 2))
+  (define slice-u32-set!
+    (wrap-rnrs-ref bytevector-u32-set! slice-writable? 4))
+  (define slice-u64-set!
+    (wrap-rnrs-ref bytevector-u64-set! slice-writable? 8)))

-- 
To stop receiving notification emails like this one, please contact
gnunet@gnunet.org.