Split deserialization functions; use alexandria

serialize-lib.lisp

@@ -5,7 +5,7 @@
 (in-package :atsl)
 
 (defmacro unescape (seq)
-  (let ((match (gensym)) (replacef (gensym)))
+  (alexandria:with-gensyms (replacef match)
     `(flet ((,replacef (,match)
 	      (string (ecase (char ,match 1)
 			(#\: #\:)
@@ -15,12 +15,12 @@
        (cl-ppcre:regex-replace-all "&[:nr&]" ,seq #',replacef :simple-calls t))))
 
 (defmacro string-to-value (seq table-allow)
-  (let ((str (gensym)) (datatype (gensym)) (restdata (gensym)) (n (gensym)))
+  (alexandria:with-gensyms (str datatype restdata n)
     `(let* ((,str ,seq)
 	    (,datatype (char ,str 0))
 	    (,restdata (subseq ,str 1)))
        (ecase ,datatype
-	 (#\T (if ,table-allow 'table (error "table not allowed")))
+	 (#\T ,(if table-allow `'table `(error "table not allowed")))
 	 (#\N (let ((,n (parse-float ,restdata :type 'real)))
 		(if (typep ,n 'ratio) (coerce ,n 'float) ,n)))
 	 (#\B (ecase (parse-integer ,restdata)
@@ -31,34 +31,57 @@
 (defmacro adjust-line (line)
   `(string-right-trim '(#\Return) ,line))
 
-(defun read-table (stream restype)
-  (let ((ht (case restype
-	      (:alist nil)
-	      (otherwise (make-hash-table)))))
-    (do ((line (adjust-line (read-line stream nil))
-	       (adjust-line (read-line stream nil))))
-	((or (null line) (equal line "E")) ht)
-      (cl-ppcre:register-groups-bind
-       (key value)
-       ("^(.*[^&]):(.+)$" line)
-       (let* ((kv (string-to-value key nil))
-	      (vt (string-to-value value t))
-	      (vv (if (equal vt 'table)
-		      (read-table stream restype)
-		      vt)))
-	 (case restype
-	   (:alist (let ((c (assoc kv ht :test #'equal)))
-		     (if c (setf (cdr c) vv)
-			 (push (cons kv vv) ht))))
-	   (otherwise (setf (gethash kv ht) vv))))))))
+(defmacro read-table-entry (line stream gett-f)
+  (alexandria:with-gensyms (key value kv vt)
+    `(cl-ppcre:register-groups-bind
+      (,key ,value)
+      ("^(.*[^&]):(.+)$" ,line)
+      (let ((,kv (string-to-value ,key nil))
+	    (,vt (string-to-value ,value t)))
+	(values ,kv (if (equal ,vt 'table)
+			(funcall ,gett-f ,stream)))))))
 
-(defun from-stream (stream restype)
-  (let* ((header (adjust-line (read-line stream nil)))
-	 (sver (parse-integer
-		(cl-ppcre:regex-replace "^LUA_SER v=([12])$" header "\\1"))))
-    ;; We don't need much checking here for now
-    (assert sver)
-    (read-table stream restype)))
+(defmacro iterate-table-entries ((stream key val gett-f) &body body)
+  (alexandria:with-gensyms (line)
+    (alexandria:once-only
+     (stream)
+     `(do ((,line (adjust-line (read-line ,stream nil))
+		  (adjust-line (read-line ,stream nil))))
+	  ((or (null ,line) (equal ,line "E")))
+	(multiple-value-bind (,key ,val)
+	    (read-table-entry ,line ,stream ,gett-f)
+	  ,@body)))))
+
+(declaim (ftype (function (stream) list) read-table-as-alist))
+(defun read-table-as-alist (stream)
+  (let ((ht ()))
+    (iterate-table-entries
+     (stream kv vv #'read-table-as-alist)
+     (let ((c (assoc kv ht :test #'equal)))
+       (if c
+	   (setf (cdr c) vv)
+	   (push (cons kv vv) ht))))
+    ht))
+
+(declaim (ftype (function (stream) hash-table) read-table-as-hash-table))
+(defun read-table-as-hash-table (stream)
+  (let ((ht (make-hash-table)))
+    (iterate-table-entries
+     (stream kv vv #'read-table-as-hash-table)
+     (setf (gethash kv ht) vv))
+    ht))
+
+(defmacro from-stream (stream restype)
+  (alexandria:with-gensyms (header sver)
+    (alexandria:once-only
+     (stream)
+     `(let* ((,header (adjust-line (read-line ,stream nil)))
+	     (,sver (parse-integer (cl-ppcre:regex-replace "^LUA_SER v=([12])$" ,header "\\1"))))
+	(assert ,sver)
+	(,(ecase restype
+	    (:alist 'read-table-as-alist)
+	    (:hash-table 'read-table-as-hash-table))
+	  ,stream)))))
 
 (defmacro from-file (filename restype)
   (let ((stream (gensym)) (fn (gensym)))

ywatds.asd

@@ -4,7 +4,7 @@
     :version "0.1"
     :author "Y.W."
     :license "GNU AGPL 3 or later"
-    :depends-on ("asdf" "easy-routes" "cl-ppcre" "parse-float")
+    :depends-on ("asdf" "easy-routes" "cl-ppcre" "parse-float" "alexandria")
     :components ((:file "serialize-lib")
 		 (:file "server-wrapper")
 		 (:file "dataserver" :depends-on ("serialize-lib"