master 03ada27: * lisp/emacs-lisp/bindat.el: Minor refactoring

[Stefan Monnier]

branch: master
commit 03ada27cb81dabb87eff38f2d66fe8fc4a02da46
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    * lisp/emacs-lisp/bindat.el: Minor refactoring
    
    (bindat--unpack-str, bindat--unpack-strz, bindat--unpack-bits):
    New functions, extracted from `bindat--unpack-item`.
    (bindat--unpack-item): Use them.
    (bindat--align): New function.
    (bindat--unpack-group, bindat--length-group, bindat--pack-group): Use it.
    (bindat-get-field): Allow integers to index both lists (as returned by
    `repeat`) and vectors (as returned by `vec`).
    (bindat--pack-str, bindat--pack-bits): New functions, extracted from
    `bindat--pack-item`.
    (bindat--pack-item): Use them.
    
    * test/lisp/emacs-lisp/bindat-tests.el (struct-bindat): Place the fields
    in the order in which they appear in the structs.
---
 lisp/emacs-lisp/bindat.el            | 139 ++++++++++++++++++-----------------
 test/lisp/emacs-lisp/bindat-tests.el |  26 +++----
 2 files changed, 83 insertions(+), 82 deletions(-)

diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index b1b2144..830e61f 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -201,7 +201,7 @@
 (defvar bindat-raw)
 (defvar bindat-idx)
 
-(defun bindat--unpack-u8 ()
+(defsubst bindat--unpack-u8 ()
   (prog1
       (aref bindat-raw bindat-idx)
     (setq bindat-idx (1+ bindat-idx))))
@@ -230,47 +230,50 @@
 (defun bindat--unpack-u64r ()
   (logior (bindat--unpack-u32r) (ash (bindat--unpack-u32r) 32)))
 
+(defun bindat--unpack-str (len)
+  (let ((s (substring bindat-raw bindat-idx (+ bindat-idx len))))
+    (setq bindat-idx (+ bindat-idx len))
+    (if (stringp s) s
+      (apply #'unibyte-string s))))
+
+(defun bindat--unpack-strz (len)
+  (let ((i 0) s)
+    (while (and (< i len) (/= (aref bindat-raw (+ bindat-idx i)) 0))
+      (setq i (1+ i)))
+    (setq s (substring bindat-raw bindat-idx (+ bindat-idx i)))
+    (setq bindat-idx (+ bindat-idx len))
+    (if (stringp s) s
+      (apply #'unibyte-string s))))
+
+(defun bindat--unpack-bits (len)
+  (let ((bits nil) (bnum (1- (* 8 len))) j m)
+    (while (>= bnum 0)
+      (if (= (setq m (bindat--unpack-u8)) 0)
+         (setq bnum (- bnum 8))
+       (setq j 128)
+       (while (> j 0)
+         (if (/= 0 (logand m j))
+             (setq bits (cons bnum bits)))
+         (setq bnum (1- bnum)
+               j (ash j -1)))))
+    bits))
+
 (defun bindat--unpack-item (type len &optional vectype)
   (if (eq type 'ip)
       (setq type 'vec len 4))
   (pcase type
-   ((or 'u8 'byte)
-    (bindat--unpack-u8))
-   ((or 'u16 'word 'short)
-    (bindat--unpack-u16))
+   ((or 'u8 'byte) (bindat--unpack-u8))
+   ((or 'u16 'word 'short) (bindat--unpack-u16))
    ('u24 (bindat--unpack-u24))
-   ((or 'u32 'dword 'long)
-    (bindat--unpack-u32))
+   ((or 'u32 'dword 'long) (bindat--unpack-u32))
    ('u64  (bindat--unpack-u64))
    ('u16r (bindat--unpack-u16r))
    ('u24r (bindat--unpack-u24r))
    ('u32r (bindat--unpack-u32r))
    ('u64r (bindat--unpack-u64r))
-   ('bits
-    (let ((bits nil) (bnum (1- (* 8 len))) j m)
-      (while (>= bnum 0)
-       (if (= (setq m (bindat--unpack-u8)) 0)
-           (setq bnum (- bnum 8))
-         (setq j 128)
-         (while (> j 0)
-           (if (/= 0 (logand m j))
-               (setq bits (cons bnum bits)))
-           (setq bnum (1- bnum)
-                 j (ash j -1)))))
-      bits))
-   ('str
-    (let ((s (substring bindat-raw bindat-idx (+ bindat-idx len))))
-      (setq bindat-idx (+ bindat-idx len))
-      (if (stringp s) s
-       (apply #'unibyte-string s))))
-   ('strz
-    (let ((i 0) s)
-      (while (and (< i len) (/= (aref bindat-raw (+ bindat-idx i)) 0))
-       (setq i (1+ i)))
-      (setq s (substring bindat-raw bindat-idx (+ bindat-idx i)))
-      (setq bindat-idx (+ bindat-idx len))
-      (if (stringp s) s
-       (apply #'unibyte-string s))))
+   ('bits (bindat--unpack-bits len))
+   ('str (bindat--unpack-str len))
+   ('strz (bindat--unpack-strz len))
    ('vec
     (let ((v (make-vector len 0)) (vlen 1))
       (if (consp vectype)
@@ -283,6 +286,9 @@
       v))
    (_ nil)))
 
+(defsubst bindat--align (n len)
+  (* len (/ (+ n (1- len)) len)))       ;Isn't there a simpler way?
+
 (defun bindat--unpack-group (spec)
   (with-suppressed-warnings ((lexical struct last))
     (defvar struct) (defvar last))
@@ -317,8 +323,7 @@
         ('fill
          (setq bindat-idx (+ bindat-idx len)))
         ('align
-         (while (/= (% bindat-idx len) 0)
-           (setq bindat-idx (1+ bindat-idx))))
+         (setq bindat-idx (bindat--align bindat-idx len)))
         ('struct
          (setq data (bindat--unpack-group (eval len t))))
         ('repeat
@@ -366,9 +371,8 @@ An integer value in the field list is taken as an array 
index,
 e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
   (while (and struct field)
     (setq struct (if (integerp (car field))
-                    (nth (car field) struct)
-                  (let ((val (assq (car field) struct)))
-                    (if (consp val) (cdr val)))))
+                    (elt struct (car field))
+                  (cdr (assq (car field) struct))))
     (setq field (cdr field)))
   struct)
 
@@ -421,8 +425,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
         ('fill
          (setq bindat-idx (+ bindat-idx len)))
         ('align
-         (while (/= (% bindat-idx len) 0)
-           (setq bindat-idx (1+ bindat-idx))))
+         (setq bindat-idx (bindat--align bindat-idx len)))
         ('struct
          (bindat--length-group
           (if field (bindat-get-field struct field) struct) (eval len t)))
@@ -460,7 +463,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
 
 ;;;; Pack structured data into bindat-raw
 
-(defun bindat--pack-u8 (v)
+(defsubst bindat--pack-u8 (v)
   (aset bindat-raw bindat-idx (logand v 255))
   (setq bindat-idx (1+ bindat-idx)))
 
@@ -498,42 +501,41 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
   (bindat--pack-u32r v)
   (bindat--pack-u32r (ash v -32)))
 
+(defun bindat--pack-str (len v)
+  (dotimes (i (min len (length v)))
+    (aset bindat-raw (+ bindat-idx i) (aref v i)))
+  (setq bindat-idx (+ bindat-idx len)))
+
+(defun bindat--pack-bits (len v)
+  (let ((bnum (1- (* 8 len))) j m)
+    (while (>= bnum 0)
+      (setq m 0)
+      (if (null v)
+         (setq bnum (- bnum 8))
+       (setq j 128)
+       (while (> j 0)
+         (if (memq bnum v)
+             (setq m (logior m j)))
+         (setq bnum (1- bnum)
+               j (ash j -1))))
+      (bindat--pack-u8 m))))
+
 (defun bindat--pack-item (v type len &optional vectype)
   (if (eq type 'ip)
       (setq type 'vec len 4))
   (pcase type
-   ((guard (null v))
-    (setq bindat-idx (+ bindat-idx len)))
-   ((or 'u8 'byte)
-    (bindat--pack-u8 v))
-   ((or 'u16 'word 'short)
-    (bindat--pack-u16 v))
-   ('u24
-    (bindat--pack-u24 v))
-   ((or 'u32 'dword 'long)
-    (bindat--pack-u32 v))
+   ((guard (null v)) (setq bindat-idx (+ bindat-idx len)))
+   ((or 'u8 'byte) (bindat--pack-u8 v))
+   ((or 'u16 'word 'short) (bindat--pack-u16 v))
+   ('u24 (bindat--pack-u24 v))
+   ((or 'u32 'dword 'long) (bindat--pack-u32 v))
    ('u64  (bindat--pack-u64 v))
    ('u16r (bindat--pack-u16r v))
    ('u24r (bindat--pack-u24r v))
    ('u32r (bindat--pack-u32r v))
    ('u64r (bindat--pack-u64r v))
-   ('bits
-    (let ((bnum (1- (* 8 len))) j m)
-      (while (>= bnum 0)
-       (setq m 0)
-       (if (null v)
-           (setq bnum (- bnum 8))
-         (setq j 128)
-         (while (> j 0)
-           (if (memq bnum v)
-               (setq m (logior m j)))
-           (setq bnum (1- bnum)
-                 j (ash j -1))))
-       (bindat--pack-u8 m))))
-   ((or 'str 'strz)
-    (dotimes (i (min len (length v)))
-      (aset bindat-raw (+ bindat-idx i) (aref v i)))
-    (setq bindat-idx (+ bindat-idx len)))
+   ('bits (bindat--pack-bits len v))
+   ((or 'str 'strz) (bindat--pack-str len v))
    ('vec
     (let ((l (length v)) (vlen 1))
       (if (consp vectype)
@@ -580,8 +582,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
         ('fill
          (setq bindat-idx (+ bindat-idx len)))
         ('align
-         (while (/= (% bindat-idx len) 0)
-           (setq bindat-idx (1+ bindat-idx))))
+         (setq bindat-idx (bindat--align bindat-idx len)))
         ('struct
          (bindat--pack-group
           (if field (bindat-get-field struct field) struct) (eval len t)))
diff --git a/test/lisp/emacs-lisp/bindat-tests.el 
b/test/lisp/emacs-lisp/bindat-tests.el
index 72883fc..9c417c8 100644
--- a/test/lisp/emacs-lisp/bindat-tests.el
+++ b/test/lisp/emacs-lisp/bindat-tests.el
@@ -1,4 +1,4 @@
-;;; bindat-tests.el --- tests for bindat.el  -*- lexical-binding: t; coding: 
utf-8; -*-
+;;; bindat-tests.el --- tests for bindat.el  -*- lexical-binding: t -*-
 
 ;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
 
@@ -23,14 +23,14 @@
 (require 'bindat)
 (require 'cl-lib)
 
-(defvar header-bindat-spec
+(defconst header-bindat-spec
   (bindat-spec
     (dest-ip ip)
     (src-ip ip)
     (dest-port u16)
     (src-port u16)))
 
-(defvar data-bindat-spec
+(defconst data-bindat-spec
   (bindat-spec
     (type u8)
     (opcode u8)
@@ -39,7 +39,7 @@
     (data vec (length))
     (align 4)))
 
-(defvar packet-bindat-spec
+(defconst packet-bindat-spec
   (bindat-spec
     (header struct header-bindat-spec)
     (items u8)
@@ -47,23 +47,23 @@
     (item repeat (items)
           (struct data-bindat-spec))))
 
-(defvar struct-bindat
+(defconst struct-bindat
   '((header
      (dest-ip . [192 168 1 100])
      (src-ip . [192 168 1 101])
      (dest-port . 284)
      (src-port . 5408))
     (items . 2)
-    (item ((data . [1 2 3 4 5])
-           (id . "ABCDEF")
-           (length . 5)
+    (item ((type . 2)
            (opcode . 3)
-           (type . 2))
-          ((data . [6 7 8 9 10 11 12])
-           (id . "BCDEFG")
-           (length . 7)
+           (length . 5)
+           (id . "ABCDEF")
+           (data . [1 2 3 4 5]))
+          ((type . 1)
            (opcode . 4)
-           (type . 1)))))
+           (length . 7)
+           (id . "BCDEFG")
+           (data . [6 7 8 9 10 11 12])))))
 
 (ert-deftest bindat-test-pack ()
   (should (equal