2 files changed, 32 insertions(+), 0 deletions(-)

M guix/pk-crypto.scm
M tests/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

@@ 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)))")))