From 363ae1da82cbb83b57b57f78b716125b79e2ac39 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
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 @@
             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
-- 
cgit v1.2.3