From 363ae1da82cbb83b57b57f78b716125b79e2ac39 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 28 Dec 2013 15:47:35 +0100 Subject: 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. --- guix/pk-crypto.scm | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) (limited to 'guix/pk-crypto.scm') 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 @@ (define-module (guix pk-crypto) 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 @@ (define (dereference-size_t p) 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 @@ (define find-sexp-token #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 -- cgit v1.2.3