summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorpukkamustard <pukkamustard@posteo.net>2021-01-14 11:39:41 +0100
committerpukkamustard <pukkamustard@posteo.net>2021-01-14 11:43:00 +0100
commit5482ab531b9ae563646bec16a285ab317cef46ff (patch)
tree2bc4f398e13e3df966a1dd94a52ee12d4101f866
parentfbb5e56621682e20c7143bb231db60a0af2d26a2 (diff)
(cbor indefinite-length): Add support for indefinite length arrays and maps
-rw-r--r--Makefile.am3
-rw-r--r--README.org37
-rw-r--r--cbor/decode.scm41
-rw-r--r--cbor/encode.scm24
-rw-r--r--cbor/indefinite-length.scm16
-rw-r--r--cbor/tag.scm8
-rw-r--r--hall.scm3
-rw-r--r--tests/cbor.scm13
8 files changed, 108 insertions, 37 deletions
diff --git a/Makefile.am b/Makefile.am
index 016fa25..a60d70f 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -37,7 +37,8 @@ SUFFIXES = .scm .go
SOURCES = cbor.scm \
cbor/decode.scm \
cbor/encode.scm \
- cbor/tag.scm
+ cbor/tag.scm \
+ cbor/indefinite-length.scm
TESTS = tests/cbor.scm
diff --git a/README.org b/README.org
index 8a1e1f2..28715ec 100644
--- a/README.org
+++ b/README.org
@@ -4,26 +4,26 @@
guile-cbor is a Guile implementation of CBOR (Concise Binary Object Representation) as specified by [[https://www.rfc-editor.org/rfc/rfc8949.html][RFC8949]].
-
* Usage
** Native Scheme Values <-> CBOR data items
-| Native Scheme | CBOR | Note |
-|------------------+------------------------------------------------+-----------------------------------------------------------------|
-| positive integer | unsigned integer (major type 0) | |
-| negative integer | negative integer (major type 0) | |
-| bytevector | byte string (major type 2) | |
-| string | text string (major type 3) | |
-| vector | array (major type 4) | See also how [[https://github.com/aconchillo/guile-json#usage][guile-json]] maps arrays |
-| alist | map (major type 5) | |
-| <cbor-tag> | tagged data item (major type 6) | |
-| - | IEEE 754 Half-Precision Float (major type 7) | Can not be parsed (FIXME) |
-| real | IEEE 754 Double-Precision Float (major type 7) | Scheme reals are always encoded as CBOR double precision floats |
-| real | IEEE 754 Single-Precision Float (major type 7) | CBOR single precision floats are parsed as Scheme real numbers |
-| #f | false (major type 7, simple value 20) | |
-| #t | true (major type 7, simple value 21) | |
-| #nil | null (major type 7, simple value 22) | |
+| Native Scheme | CBOR | Note |
+|--------------------------+------------------------------------------------+---------------------------------------------------------------------------------------------------------------------------------------------------|
+| positive integer | unsigned integer (major type 0) | |
+| negative integer | negative integer (major type 0) | |
+| bytevector | byte string (major type 2) | |
+| string | text string (major type 3) | |
+| vector | array (major type 4) | See also how [[https://github.com/aconchillo/guile-json#usage][guile-json]] maps arrays |
+| alist | map (major type 5) | |
+| <cbor-tag> | tagged data item (major type 6) | A Scheme record is used for CBOR tags |
+| - | IEEE 754 Half-Precision Float (major type 7) | Can not be parsed (FIXME) |
+| real | IEEE 754 Double-Precision Float (major type 7) | Scheme reals are always encoded as CBOR double precision floats |
+| real | IEEE 754 Single-Precision Float (major type 7) | CBOR single precision floats are parsed as Scheme real numbers |
+| #f | false (major type 7, simple value 20) | |
+| #t | true (major type 7, simple value 21) | |
+| #nil | null (major type 7, simple value 22) | |
+| <cbor-indefinite-length> | Indefinite-Length Arrays and Maps | A Scheme record is used to encode indefinite-length arrays and maps. Arrays or maps of indefinite length are decoded to simple vectors or alists. |
* Todos
** TODO Extended Generic Data Models
@@ -32,15 +32,16 @@ Currently not the full "extended generic data model" is supported (only simple v
It might be nice to support the full extended generic data model (bignums, decimal fractions, bigfloats and date/time tags).
-** TODO Indefinite Lenght *
+** TODO Indefinite Length Byte Strings and Text Strings
Currently no support.
** TODO Tests
-Some examples from the specification have been added.
+Some examples from the specification have been added but not all.
** TODO texinfo documentation
+
* License
GPL-3.0-or-later see [[./COPYING]].
diff --git a/cbor/decode.scm b/cbor/decode.scm
index d68c562..01c9535 100644
--- a/cbor/decode.scm
+++ b/cbor/decode.scm
@@ -66,14 +66,41 @@
((3) (utf8->string (get-bytevector-n port argument)))
;; array of data items
- ((4) (vector-unfold
- (lambda (_) (get-cbor-data-item port))
- argument))
+ ((4) (if (eqv? argument 'indefinite-length)
+
+ ;; Read values until we get a 'break
+ (reverse-list->vector
+ (let loop ((value (get-cbor-data-item port))
+ (lst '()))
+ (if (eqv? value 'break)
+ lst
+ (loop (get-cbor-data-item port)
+ (cons value lst)))))
+
+ ;; Read argument many values
+ (vector-unfold
+ (lambda (_) (get-cbor-data-item port))
+ argument)))
;; map of pairs of data items
- ((5) (map (lambda (_) (cons (get-cbor-data-item port)
- (get-cbor-data-item port)))
- (iota argument)))
+ ((5) (if (eqv? argument 'indefinite-length)
+
+ ;; Read values until we get a 'break
+ (reverse
+ (let loop ((lst '()))
+ ;; read the key
+ (let ((key (get-cbor-data-item port)))
+ (if (eqv? key 'break)
+ lst
+ (loop (cons (cons key
+ ;; get the value
+ (get-cbor-data-item port))
+ lst))))))
+
+ ;; Read argument many key-value pairs
+ (map (lambda (_) (cons (get-cbor-data-item port)
+ (get-cbor-data-item port)))
+ (iota argument))))
;; tagged data item
((6) (make-cbor-tag argument
@@ -99,5 +126,7 @@
(display bv)
(bytevector-ieee-double-ref bv 0 (endianness big))))
+ ((31) 'break)
+
;; TODO error handling
(else 'not-well-formed))))))
diff --git a/cbor/encode.scm b/cbor/encode.scm
index 27905ed..2e083a3 100644
--- a/cbor/encode.scm
+++ b/cbor/encode.scm
@@ -9,6 +9,7 @@
#:use-module (rnrs io ports)
#:use-module (cbor tag)
+ #:use-module (cbor indefinite-length)
#:export (put-cbor-data-item))
@@ -51,6 +52,26 @@
;; TODO error integer out of bound
(else 'oops))))
+(define (put-cbor-indefinite-length port value)
+ (cond
+
+ ;; Indefinite-length array
+ ((vector? value)
+ (put-cbor-initial-byte port 4 31)
+ (vector-for-each (lambda (sub-value)
+ (put-cbor-data-item port sub-value))
+ value)
+ (put-cbor-initial-byte port 7 31))
+
+ ;; Indefinite-length map
+ ((list? value)
+ (put-cbor-initial-byte port 5 31)
+ (for-each (lambda (key-value)
+ (put-cbor-data-item port (car key-value))
+ (put-cbor-data-item port (cdr key-value)))
+ value)
+ (put-cbor-initial-byte port 7 31))))
+
(define (put-cbor-data-item port value)
(cond
@@ -88,6 +109,9 @@
(put-cbor-integer port 6 (cbor-tag-number value))
(put-cbor-data-item port (cbor-tag-content value)))
+ ((cbor-indefinite-length? value)
+ (put-cbor-indefinite-length port (cbor-indefinite-length-value value)))
+
((real? value)
(let ((bv (make-bytevector 8)))
(put-cbor-initial-byte port 7 27)
diff --git a/cbor/indefinite-length.scm b/cbor/indefinite-length.scm
new file mode 100644
index 0000000..38a12ea
--- /dev/null
+++ b/cbor/indefinite-length.scm
@@ -0,0 +1,16 @@
+; SPDX-FileCopyrightText: 2021 pukkamustard <pukkamustard@posteo.net>
+;
+; SPDX-License-Identifier: GPL-3.0-or-later
+
+(define-module (cbor indefinite-length)
+ #:use-module (srfi srfi-9)
+
+ #:export (<cbor-indefinite-length>
+ make-cbor-indefinite-length
+ cbor-indefinite-length?
+ cbor-indefinite-length-value))
+
+(define-record-type <cbor-indefinite-length>
+ (make-cbor-indefinite-length value)
+ cbor-indefinite-length?
+ (value cbor-indefinite-length-value))
diff --git a/cbor/tag.scm b/cbor/tag.scm
index dfb5651..94bb37a 100644
--- a/cbor/tag.scm
+++ b/cbor/tag.scm
@@ -4,8 +4,6 @@
(define-module (cbor tag)
#:use-module (srfi srfi-9)
- #:use-module (srfi srfi-9 gnu)
- #:use-module (ice-9 format)
#:export (<cbor-tag>
make-cbor-tag
@@ -19,9 +17,3 @@
(number cbor-tag-number)
(content cbor-tag-content))
-(set-record-type-printer!
- <cbor-tag>
- (lambda (tag port)
- (format port "~d(~a)"
- (cbor-tag-number tag)
- (cbor-tag-content tag))))
diff --git a/hall.scm b/hall.scm
index 59e901c..4aa057a 100644
--- a/hall.scm
+++ b/hall.scm
@@ -15,7 +15,8 @@ Object Representation (CBOR) as defined by RFC 8949.")
((scheme-file "cbor")
(directory "cbor" ((scheme-file "decode")
(scheme-file "encode")
- (scheme-file "tag")))))
+ (scheme-file "tag")
+ (scheme-file "indefinite-length")))))
(tests ((directory "tests" ((scheme-file "cbor")))))
(programs ((directory "scripts" ())))
(documentation
diff --git a/tests/cbor.scm b/tests/cbor.scm
index cc66323..da3e062 100644
--- a/tests/cbor.scm
+++ b/tests/cbor.scm
@@ -4,6 +4,7 @@
(define-module (tests cbor)
#:use-module (cbor)
+ #:use-module (cbor indefinite-length)
#:use-module (rnrs bytevectors)
@@ -40,10 +41,16 @@
)
)
-(scm->cbor 1.1)
+;; (scm->cbor 1.1)
-(scm->cbor 18446744073709551616)
-(1+ 18446744073709551616)
+;; (scm->cbor 18446744073709551616)
+
+;; (cbor->scm (scm->cbor (make-cbor-indefinite-length #(1 "Hello"))))
+
+;; (cbor->scm
+;; (scm->cbor (make-cbor-indefinite-length '(("a" . 1)))))
+
+;; (scm->cbor "a")
(test-begin "Examples from specification")
(for-each