master 83d9fbe: * lisp/emacs-lisp/bindat.el (bindat-spec): New macro.

[Stefan Monnier]

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

    * lisp/emacs-lisp/bindat.el (bindat-spec): New macro.
    
    It's basically an alias for `quote`, but it offers the advantage of
    providing Edebug support and opens the possibility of compiling
    the bindat spec to ELisp code.
    
    * doc/lispref/processes.texi (Bindat Spec): Document `bindat-spec`.
    (Bindat Functions): Tweak a few things to adjust to the state of the code.
    
    * test/lisp/emacs-lisp/bindat-tests.el: Use it.
    
    * test/lisp/emacs-lisp/edebug-tests.el (edebug-tests--read): New function.
    (edebug-tests--&rest-behavior): New test.
---
 doc/lispref/processes.texi           | 28 +++++++++--------
 etc/NEWS                             |  2 ++
 lisp/emacs-lisp/bindat.el            | 59 ++++++++++++++++++++++++++++++------
 test/lisp/emacs-lisp/bindat-tests.el |  9 ++++--
 test/lisp/emacs-lisp/edebug-tests.el | 17 +++++++++++
 5 files changed, 91 insertions(+), 24 deletions(-)

diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index 8346165..661e56d 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -3368,6 +3368,11 @@ processed, and how to pack or unpack it.  We normally 
keep bindat specs
 in variables whose names end in @samp{-bindat-spec}; that kind of name
 is automatically recognized as risky.
 
+@defmac bindat-spec &rest specs
+Creates a Bindat spec object according to the data layout
+specification @var{specs}.
+@end defmac
+
 @cindex endianness
 @cindex big endian
 @cindex little endian
@@ -3398,7 +3403,6 @@ Unsigned integer in network byte order, with length 3.
 @itemx dword
 @itemx long
 Unsigned integer in network byte order, with length 4.
-Note: These values may be limited by Emacs's integer implementation limits.
 
 @item u16r
 @itemx u24r
@@ -3534,16 +3538,16 @@ repetition has completed.
 @node Bindat Functions
 @subsection Functions to Unpack and Pack Bytes
 
-  In the following documentation, @var{spec} refers to a data layout
-specification, @code{bindat-raw} to a byte array, and @var{struct} to an
-alist representing unpacked field data.
+  In the following documentation, @var{spec} refers to a Bindat spec
+object as returned from @code{bindat-spec}, @code{raw} to a byte
+array, and @var{struct} to an alist representing unpacked field data.
 
-@defun bindat-unpack spec bindat-raw &optional bindat-idx
+@defun bindat-unpack spec raw &optional idx
 @c FIXME?  Again, no multibyte?
 This function unpacks data from the unibyte string or byte
-array @code{bindat-raw}
+array var{raw}
 according to @var{spec}.  Normally, this starts unpacking at the
-beginning of the byte array, but if @var{bindat-idx} is non-@code{nil}, it
+beginning of the byte array, but if @var{idx} is non-@code{nil}, it
 specifies a zero-based starting position to use instead.
 
 The value is an alist or nested alist in which each element describes
@@ -3576,15 +3580,15 @@ This function returns the total length of the data in 
@var{struct},
 according to @var{spec}.
 @end defun
 
-@defun bindat-pack spec struct &optional bindat-raw bindat-idx
+@defun bindat-pack spec struct &optional raw idx
 This function returns a byte array packed according to @var{spec} from
 the data in the alist @var{struct}.  It normally creates and fills a
-new byte array starting at the beginning.  However, if @var{bindat-raw}
+new byte array starting at the beginning.  However, if @var{raw}
 is non-@code{nil}, it specifies a pre-allocated unibyte string or vector to
-pack into.  If @var{bindat-idx} is non-@code{nil}, it specifies the starting
-offset for packing into @code{bindat-raw}.
+pack into.  If @var{idx} is non-@code{nil}, it specifies the starting
+offset for packing into var{raw}.
 
-When pre-allocating, you should make sure @code{(length @var{bindat-raw})}
+When pre-allocating, you should make sure @code{(length @var{raw})}
 meets or exceeds the total length to avoid an out-of-range error.
 @end defun
 
diff --git a/etc/NEWS b/etc/NEWS
index 7f32f7b..3ac9bb2 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -357,6 +357,8 @@ the buffer cycles the whole buffer between "only top-level 
headings",
 It used to be enabled when Emacs is started in GUI mode but not when started
 in text mode.  The cursor still only actually blinks in GUI frames.
 
++++
+** Bindat has a new 'bindat-spec' macro to define specs, with Edebug support
 ** pcase
 
 +++
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index bf01347..0bb4b87 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -65,13 +65,15 @@
 ;;  The corresponding Lisp bindat specification looks like this:
 ;;
 ;;  (setq header-bindat-spec
-;;    '((dest-ip   ip)
+;;    (bindat-spec
+;;      (dest-ip   ip)
 ;;     (src-ip    ip)
 ;;     (dest-port u16)
 ;;     (src-port  u16)))
 ;;
 ;;  (setq data-bindat-spec
-;;    '((type      u8)
+;;    (bindat-spec
+;;      (type      u8)
 ;;     (opcode    u8)
 ;;     (length    u16r)  ;; little endian order
 ;;     (id        strz 8)
@@ -79,7 +81,8 @@
 ;;     (align     4)))
 ;;
 ;;  (setq packet-bindat-spec
-;;    '((header    struct header-bindat-spec)
+;;    (bindat-spec
+;;      (header    struct header-bindat-spec)
 ;;     (items     u8)
 ;;     (fill      3)
 ;;     (item      repeat (items)
@@ -179,7 +182,7 @@
 ;; is interpreted by evalling TAG_VAL and then comparing that to
 ;; each TAG using equal; if a match is found, the corresponding SPEC
 ;; is used.
-;; If TAG is a form (eval EXPR), EXPR is evalled with `tag' bound to the
+;; If TAG is a form (eval EXPR), EXPR is eval'ed with `tag' bound to the
 ;; value of TAG_VAL; the corresponding SPEC is used if the result is non-nil.
 ;; Finally, if TAG is t, the corresponding SPEC is used unconditionally.
 ;;
@@ -368,8 +371,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
     (setq field (cdr field)))
   struct)
 
-
-;; Calculate bindat-raw length of structured data
+;;;; Calculate bindat-raw length of structured data
 
 (defvar bindat--fixed-length-alist
   '((u8 . 1) (byte . 1)
@@ -452,13 +454,13 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
          (setq bindat-idx (+ bindat-idx len))))))))
 
 (defun bindat-length (spec struct)
-  "Calculate bindat-raw length for STRUCT according to bindat SPEC."
+  "Calculate `bindat-raw' length for STRUCT according to bindat SPEC."
   (let ((bindat-idx 0))
     (bindat--length-group struct spec)
     bindat-idx))
 
 
-;; Pack structured data into bindat-raw
+;;;; Pack structured data into bindat-raw
 
 (defun bindat--pack-u8 (v)
   (aset bindat-raw bindat-idx (logand v 255))
@@ -623,8 +625,47 @@ Optional fourth arg IDX is the starting offset into RAW."
     (bindat--pack-group struct spec)
     (if raw nil bindat-raw)))
 
+;;;; Debugging support
+
+(def-edebug-elem-spec 'bindat-spec '(&rest bindat-item))
+
+(def-edebug-elem-spec 'bindat-item
+  '(([&optional bindat-field]
+     &or ["eval" form]
+         ["fill" bindat-len]
+         ["align" bindat-len]
+         ["struct" form]          ;A reference to another bindat-spec.
+         ["union" bindat-tag-val &rest (bindat-tag bindat-spec)]
+         ["repeat" integerp bindat-spec]
+         bindat-type)))
+
+(def-edebug-elem-spec 'bindat-type
+  '(&or ("eval" form)
+        ["str"  bindat-len]
+        ["strz" bindat-len]
+        ["vec"  bindat-len &optional bindat-type]
+        ["bits" bindat-len]
+        symbolp))
+
+(def-edebug-elem-spec 'bindat-field
+  '(&or ("eval" form) symbolp))
+
+(def-edebug-elem-spec 'bindat-len '(&or [] "nil" bindat-arg))
+
+(def-edebug-elem-spec 'bindat-tag-val '(bindat-arg))
+
+(def-edebug-elem-spec 'bindat-tag '(&or ("eval" form) atom))
+
+(def-edebug-elem-spec 'bindat-arg
+  '(&or ("eval" form) integerp (&rest symbolp integerp)))
+
+(defmacro bindat-spec (&rest fields)
+  "Build the bindat spec described by FIELDS."
+  (declare (indent 0) (debug (bindat-spec)))
+  ;; FIXME: We should really "compile" this to a triplet of functions!
+  `',fields)
 
-;; Misc. format conversions
+;;;; Misc. format conversions
 
 (defun bindat-format-vector (vect fmt sep &optional len)
   "Format vector VECT using element format FMT and separator SEP.
diff --git a/test/lisp/emacs-lisp/bindat-tests.el 
b/test/lisp/emacs-lisp/bindat-tests.el
index a9a8819..72883fc 100644
--- a/test/lisp/emacs-lisp/bindat-tests.el
+++ b/test/lisp/emacs-lisp/bindat-tests.el
@@ -24,13 +24,15 @@
 (require 'cl-lib)
 
 (defvar header-bindat-spec
-  '((dest-ip ip)
+  (bindat-spec
+    (dest-ip ip)
     (src-ip ip)
     (dest-port u16)
     (src-port u16)))
 
 (defvar data-bindat-spec
-  '((type u8)
+  (bindat-spec
+    (type u8)
     (opcode u8)
     (length u16r) ;; little endian order
     (id strz 8)
@@ -38,7 +40,8 @@
     (align 4)))
 
 (defvar packet-bindat-spec
-  '((header struct header-bindat-spec)
+  (bindat-spec
+    (header struct header-bindat-spec)
     (items u8)
     (fill 3)
     (item repeat (items)
diff --git a/test/lisp/emacs-lisp/edebug-tests.el 
b/test/lisp/emacs-lisp/edebug-tests.el
index d81376e..daac433 100644
--- a/test/lisp/emacs-lisp/edebug-tests.el
+++ b/test/lisp/emacs-lisp/edebug-tests.el
@@ -970,6 +970,23 @@ primary ones (Bug#42671)."
               (eval '(setf (edebug-test-code-use-gv-expander (cons 'a 'b)) 3) 
t))
             "(func"))))
 
+(defun edebug-tests--read (form spec)
+  (with-temp-buffer
+    (print form (current-buffer))
+    (goto-char (point-min))
+    (cl-letf ((edebug-all-forms t)
+              ((get (car form) 'edebug-form-spec) spec))
+      (edebug--read nil (current-buffer)))))
+
+(ert-deftest edebug-tests--&rest-behavior ()
+  ;; `&rest' is documented to allow the last "repetition" to be aborted early.
+  (should (edebug-tests--read '(dummy x 1 y 2 z)
+                              '(&rest symbolp integerp)))
+  ;; `&rest' should notice here that the "symbolp integerp" sequence
+  ;; is not respected.
+  (should-error (edebug-tests--read '(dummy x 1 2 y)
+                                    '(&rest symbolp integerp))))
+
 (ert-deftest edebug-tests-cl-flet ()
   "Check that Edebug can instrument `cl-flet' forms without name
 clashes (Bug#41853)."