master b15a2fc: * lisp/cedet/semantic/wisent/comp.el (wisent-struct): Remove

[Stefan Monnier]

branch: master
commit b15a2fc3481cdce9c1aeb719b90d8348de632a0c
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>

    * lisp/cedet/semantic/wisent/comp.el (wisent-struct): Remove
    
    (core, shifts, reductions, errs): Use cl-defstruct instead.
    Adjust all users of the set-<struct>-<field> setters to use
    `setf` instead.
---
 lisp/cedet/semantic/wisent/comp.el | 161 +++++++++++++++----------------------
 1 file changed, 66 insertions(+), 95 deletions(-)

diff --git a/lisp/cedet/semantic/wisent/comp.el 
b/lisp/cedet/semantic/wisent/comp.el
index a73cdfa..787e30c 100644
--- a/lisp/cedet/semantic/wisent/comp.el
+++ b/lisp/cedet/semantic/wisent/comp.el
@@ -84,43 +84,6 @@
        (let* ,bindings
          ,@body))))
 
-;; A naive implementation of data structures!  But it suffice here ;-)
-
-(defmacro wisent-struct (name &rest fields)
-  "Define a simple data structure called NAME.
-Which contains data stored in FIELDS.  FIELDS is a list of symbols
-which are field names or pairs (FIELD INITIAL-VALUE) where
-INITIAL-VALUE is a constant used as the initial value of FIELD when
-the data structure is created.  INITIAL-VALUE defaults to nil.
-
-This defines a `make-NAME' constructor, get-able `NAME-FIELD' and
-set-able `set-NAME-FIELD' accessors."
-  (let ((size (length fields))
-        (i    0)
-        accors field sufx fun ivals)
-    (while (< i size)
-      (setq field  (car fields)
-            fields (cdr fields))
-      (if (consp field)
-          (setq ivals (cons (cadr field) ivals)
-                field (car field))
-        (setq ivals (cons nil ivals)))
-      (setq sufx   (format "%s-%s" name field)
-            fun    (intern (format "%s" sufx))
-            accors (cons `(defmacro ,fun (s)
-                            (list 'aref s ,i))
-                         accors)
-            fun    (intern (format "set-%s" sufx))
-            accors (cons `(defmacro ,fun (s v)
-                            (list 'aset s ,i v))
-                         accors)
-            i      (1+ i)))
-    `(progn
-      (defmacro ,(intern (format "make-%s" name)) ()
-        (cons 'vector ',(nreverse ivals)))
-      ,@accors)))
-(put 'wisent-struct 'lisp-indent-function 1)
-
 ;; Other utilities
 
 (defsubst wisent-pad-string (s n &optional left)
@@ -434,7 +397,10 @@ Use `eq' to locate OBJECT."
 ;; parser's strategy of making all decisions one token ahead of its
 ;; actions.
 
-(wisent-struct core
+;; FIXME: Use `wisent-' prefix to fix namespace pollution!
+
+(cl-defstruct (core
+               (:constructor make-core ()))
   next                                  ; -> core
   link                                  ; -> core
   (number 0)
@@ -442,19 +408,22 @@ Use `eq' to locate OBJECT."
   (nitems 0)
   (items [0]))
 
-(wisent-struct shifts
+(cl-defstruct (shifts
+               (:constructor make-shifts ()))
   next                                  ; -> shifts
   (number 0)
   (nshifts 0)
   (shifts [0]))
 
-(wisent-struct reductions
+(cl-defstruct (reductions
+               (:constructor make-reductions ()))
   next                                  ; -> reductions
   (number 0)
   (nreds 0)
   (rules [0]))
 
-(wisent-struct errs
+(cl-defstruct (errs
+               (:constructor make-errs ()))
   (nerrs 0)
   (errs [0]))
 
@@ -1175,17 +1144,17 @@ Subroutine of `wisent-get-state'."
           n     (- iend isp1)
           p     (make-core)
           items (make-vector n 0))
-    (set-core-accessing-symbol p symbol)
-    (set-core-number p nstates)
-    (set-core-nitems p n)
-    (set-core-items  p items)
+    (setf (core-accessing-symbol p) symbol)
+    (setf (core-number p) nstates)
+    (setf (core-nitems p) n)
+    (setf (core-items  p) items)
     (setq isp2 0) ;; isp2 = p->items
     (while (< isp1 iend)
       ;; *isp2++ = *isp1++;
       (aset items isp2 (aref kernel-items isp1))
       (setq isp1 (1+ isp1)
             isp2 (1+ isp2)))
-    (set-core-next last-state p)
+    (setf (core-next last-state) p)
     (setq last-state p
           nstates (1+ nstates))
     p))
@@ -1228,7 +1197,7 @@ equivalent one exists already.  Used by 
`wisent-append-states'."
                 (if (core-link sp)
                     (setq sp (core-link sp))
                   ;; sp = sp->link = new-state(symbol)
-                  (setq sp (set-core-link sp (wisent-new-state symbol))
+                  (setq sp (setf (core-link sp) (wisent-new-state symbol))
                         found t)))))
       ;; bucket is empty
       ;; state-table[key] = sp = new-state(symbol)
@@ -1274,17 +1243,18 @@ SHIFTSET is set up as a vector of state numbers of 
those states."
     (setq p      (make-shifts)
           shifts (make-vector nshifts 0)
           i 0)
-    (set-shifts-number p (core-number this-state))
-    (set-shifts-nshifts p nshifts)
-    (set-shifts-shifts  p shifts)
+    (setf (shifts-number p) (core-number this-state))
+    (setf (shifts-nshifts p) nshifts)
+    (setf (shifts-shifts  p) shifts)
     (while (< i nshifts)
       ;; (p->shifts)[i] = shiftset[i];
       (aset shifts i (aref shiftset i))
       (setq i (1+ i)))
 
-    (if last-shift
-        (set-shifts-next last-shift p)
-      (setq first-shift p))
+    (setf (if last-shift
+              (shifts-next last-shift)
+            first-shift)
+          p)
     (setq last-shift p)))
 
 (defun wisent-insert-start-shift ()
@@ -1293,17 +1263,17 @@ That is the state to which a shift has already been 
made in the
 initial state.  Subroutine of `wisent-augment-automaton'."
   (let (statep sp)
     (setq statep (make-core))
-    (set-core-number statep nstates)
-    (set-core-accessing-symbol statep start-symbol)
-    (set-core-next last-state statep)
+    (setf (core-number statep) nstates)
+    (setf (core-accessing-symbol statep) start-symbol)
+    (setf (core-next last-state) statep)
     (setq last-state statep)
     ;; Make a shift from this state to (what will be) the final state.
     (setq sp (make-shifts))
-    (set-shifts-number sp nstates)
+    (setf (shifts-number sp) nstates)
     (setq nstates (1+ nstates))
-    (set-shifts-nshifts sp 1)
-    (set-shifts-shifts sp (vector nstates))
-    (set-shifts-next last-shift sp)
+    (setf (shifts-nshifts sp) 1)
+    (setf (shifts-shifts sp) (vector nstates))
+    (setf (shifts-next last-shift) sp)
     (setq last-shift sp)))
 
 (defun wisent-augment-automaton ()
@@ -1341,9 +1311,9 @@ already."
                             (setq i (shifts-nshifts sp)
                                   sp2 (make-shifts)
                                   shifts (make-vector (1+ i) 0))
-                            (set-shifts-number sp2 k)
-                            (set-shifts-nshifts sp2 (1+ i))
-                            (set-shifts-shifts sp2 shifts)
+                            (setf (shifts-number sp2) k)
+                            (setf (shifts-nshifts sp2) (1+ i))
+                            (setf (shifts-shifts sp2) shifts)
                             (aset shifts 0 nstates)
                             (while (> i 0)
                               ;; sp2->shifts[i] = sp->shifts[i - 1];
@@ -1351,19 +1321,19 @@ already."
                               (setq i (1- i)))
                             ;; Patch sp2 into the chain of shifts in
                             ;; place of sp, following sp1.
-                            (set-shifts-next sp2 (shifts-next sp))
-                            (set-shifts-next sp1 sp2)
+                            (setf (shifts-next sp2) (shifts-next sp))
+                            (setf (shifts-next sp1) sp2)
                             (if (eq sp last-shift)
                                 (setq last-shift sp2))
                             )
                         (setq sp2 (make-shifts))
-                        (set-shifts-number sp2 k)
-                        (set-shifts-nshifts sp2 1)
-                        (set-shifts-shifts sp2 (vector nstates))
+                        (setf (shifts-number sp2) k)
+                        (setf (shifts-nshifts sp2) 1)
+                        (setf (shifts-shifts sp2) (vector nstates))
                         ;; Patch sp2 into the chain of shifts between
                         ;; sp1 and sp.
-                        (set-shifts-next sp2 sp)
-                        (set-shifts-next sp1 sp2)
+                        (setf (shifts-next sp2) sp)
+                        (setf (shifts-next sp1) sp2)
                         (if (not sp)
                             (setq last-shift sp2))
                         )
@@ -1375,8 +1345,8 @@ already."
                         sp2 (make-shifts)
                         i   (shifts-nshifts sp)
                         shifts (make-vector (1+ i) 0))
-                  (set-shifts-nshifts sp2 (1+ i))
-                  (set-shifts-shifts sp2 shifts)
+                  (setf (shifts-nshifts sp2) (1+ i))
+                  (setf (shifts-shifts sp2) shifts)
                   ;; Stick this shift into the vector at the proper place.
                   (setq statep (core-next first-state)
                         k 0
@@ -1395,7 +1365,7 @@ already."
                     (setq k (1+ k)))
                   ;; Patch sp2 into the chain of shifts in place of
                   ;; sp, at the beginning.
-                  (set-shifts-next sp2 (shifts-next sp))
+                  (setf (shifts-next sp2) (shifts-next sp))
                   (setq first-shift sp2)
                   (if (eq last-shift sp)
                       (setq last-shift sp2))
@@ -1405,10 +1375,10 @@ already."
             ;; The initial state didn't even have any shifts.  Give it
             ;; one shift, to the next-to-final state.
             (setq sp (make-shifts))
-            (set-shifts-nshifts sp 1)
-            (set-shifts-shifts sp (vector nstates))
+            (setf (shifts-nshifts sp) 1)
+            (setf (shifts-shifts sp) (vector nstates))
             ;; Patch sp into the chain of shifts at the beginning.
-            (set-shifts-next sp first-shift)
+            (setf (shifts-next sp) first-shift)
             (setq first-shift sp)
             ;; Create the next-to-final state, with shift to what will
             ;; be the final state.
@@ -1416,8 +1386,8 @@ already."
       ;; There are no shifts for any state.  Make one shift, from the
       ;; initial state to the next-to-final state.
       (setq sp (make-shifts))
-      (set-shifts-nshifts sp 1)
-      (set-shifts-shifts sp (vector nstates))
+      (setf (shifts-nshifts sp) 1)
+      (setf (shifts-shifts sp) (vector nstates))
       ;; Initialize the chain of shifts with sp.
       (setq first-shift sp
             last-shift sp)
@@ -1428,25 +1398,25 @@ already."
     ;; next-to-final state.  The symbol for that shift is 0
     ;; (end-of-file).
     (setq statep (make-core))
-    (set-core-number statep nstates)
-    (set-core-next last-state statep)
+    (setf (core-number statep) nstates)
+    (setf (core-next last-state) statep)
     (setq last-state statep)
     ;; Make the shift from the final state to the termination state.
     (setq sp (make-shifts))
-    (set-shifts-number sp nstates)
+    (setf (shifts-number sp) nstates)
     (setq nstates (1+ nstates))
-    (set-shifts-nshifts sp 1)
-    (set-shifts-shifts sp (vector nstates))
-    (set-shifts-next last-shift sp)
+    (setf (shifts-nshifts sp) 1)
+    (setf (shifts-shifts sp) (vector nstates))
+    (setf (shifts-next last-shift) sp)
     (setq last-shift sp)
     ;; Note that the variable FINAL-STATE refers to what we sometimes
     ;; call the termination state.
     (setq final-state nstates)
     ;; Make the termination state.
     (setq statep (make-core))
-    (set-core-number statep nstates)
+    (setf (core-number statep) nstates)
     (setq nstates (1+ nstates))
-    (set-core-next last-state statep)
+    (setf (core-next last-state) statep)
     (setq last-state statep)))
 
 (defun wisent-save-reductions ()
@@ -1468,17 +1438,18 @@ their rule numbers."
     (when (> count 0)
       (setq p (make-reductions)
             rules (make-vector count 0))
-      (set-reductions-number p (core-number this-state))
-      (set-reductions-nreds  p count)
-      (set-reductions-rules  p rules)
+      (setf (reductions-number p) (core-number this-state))
+      (setf (reductions-nreds  p) count)
+      (setf (reductions-rules  p) rules)
       (setq i 0)
       (while (< i count)
         ;; (p->rules)[i] = redset[i]
         (aset rules i (aref redset i))
         (setq i (1+ i)))
-      (if last-reduction
-          (set-reductions-next last-reduction p)
-        (setq first-reduction p))
+      (setf (if last-reduction
+                (reductions-next last-reduction)
+              first-reduction)
+            p)
       (setq last-reduction p))))
 
 (defun wisent-generate-states ()
@@ -2064,7 +2035,7 @@ tables so that there is no longer a conflict."
           errs  (make-vector ntokens 0)
           nerrs 0
           i 0)
-    (set-errs-errs errp errs)
+    (setf (errs-errs errp) errs)
     (while (< i ntokens)
       (setq token (aref tags i))
       (when (and (wisent-BITISSET (aref LA lookaheadnum) i)
@@ -2113,7 +2084,7 @@ tables so that there is no longer a conflict."
           )))
       (setq i (1+ i)))
     (when (> nerrs 0)
-      (set-errs-nerrs errp nerrs)
+      (setf (errs-nerrs errp) nerrs)
       (aset err-table state errp))
     ))
 
@@ -2944,7 +2915,7 @@ And returns the updated top-of-stack index."
       (aset rcode r nil)
     (let* ((actn (aref rcode r))
            (n    (aref actn 1))         ; nb of val avail. in stack
-           (NAME (apply 'format "%s:%d" (aref actn 2)))
+           (NAME (apply #'format "%s:%d" (aref actn 2)))
            (form (wisent-semantic-action-expand-body (aref actn 0) n))
            ($l   (car form))            ; list of $vars used in body
            (form (cdr form))            ; expanded form of body