diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2013-12-28 15:47:35 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2013-12-29 15:57:24 +0100 |
| commit | 363ae1da82cbb83b57b57f78b716125b79e2ac39 (patch) | |
| tree | 8d529ac3dd92d375c319334bd6203ce3a3f10ad7 | |
| parent | a2cbbb743da26abc3a1bdbcd9af2d07018c2a8a6 (diff) | |
| download | guix-363ae1da82cbb83b57b57f78b716125b79e2ac39.tar guix-363ae1da82cbb83b57b57f78b716125b79e2ac39.tar.gz | |
pk-crypto: Add 'canonical-sexp-length' and related procedures.
* guix/pk-crypto.scm (canonical-sexp-length, canonical-sexp-null?,
canonical-sexp-list?): New procedures.
* tests/pk-crypto.scm ("canonical-sexp-length", "canonical-sexp-list?"):
New tests.
| -rw-r--r-- | guix/pk-crypto.scm | 20 | ||||
| -rw-r--r-- | tests/pk-crypto.scm | 12 |
2 files changed, 32 insertions, 0 deletions
diff --git a/guix/pk-crypto.scm b/guix/pk-crypto.scm index e5ada6a177..0d1af07313 100644 --- a/guix/pk-crypto.scm +++ b/guix/pk-crypto.scm @@ -32,6 +32,9 @@ canonical-sexp-cdr canonical-sexp-nth canonical-sexp-nth-data + canonical-sexp-length + canonical-sexp-null? + canonical-sexp-list? bytevector->hash-data hash-data->bytevector sign @@ -156,6 +159,14 @@ different from Scheme's 'list-ref'.)" 0 (native-endianness) (sizeof size_t))) +(define canonical-sexp-length + (let* ((ptr (libgcrypt-func "gcry_sexp_length")) + (proc (pointer->procedure int ptr '(*)))) + (lambda (sexp) + "Return the length of SEXP if it's a list (including the empty list); +return zero if SEXP is an atom." + (proc (canonical-sexp->pointer sexp))))) + (define token-string? (let ((token-cs (char-set-union char-set:digit char-set:letter @@ -263,4 +274,13 @@ return #f if not found." #f (pointer->canonical-sexp res)))))) +(define-inlinable (canonical-sexp-null? sexp) + "Return #t if SEXP is the empty-list sexp." + (null-pointer? (canonical-sexp->pointer sexp))) + +(define (canonical-sexp-list? sexp) + "Return #t if SEXP is a list." + (or (canonical-sexp-null? sexp) + (> (canonical-sexp-length sexp) 0))) + ;;; pk-crypto.scm ends here diff --git a/tests/pk-crypto.scm b/tests/pk-crypto.scm index 8da533f5b2..3135d5a60c 100644 --- a/tests/pk-crypto.scm +++ b/tests/pk-crypto.scm @@ -82,6 +82,18 @@ (gc) +(test-equal "canonical-sexp-length" + '(0 1 2 4 0 0) + (map (compose canonical-sexp-length string->canonical-sexp) + '("()" "(a)" "(a b)" "(a #616263# b #C001#)" "a" "#123456#"))) + +(test-equal "canonical-sexp-list?" + '(#t #f #t #f) + (map (compose canonical-sexp-list? string->canonical-sexp) + '("()" "\"abc\"" "(a b c)" "#123456#"))) + +(gc) + (test-equal "canonical-sexp-car + cdr" '("(b \n (c xyz)\n )") (let ((lst (string->canonical-sexp "(a (b (c xyz)))"))) |