Merge pull request #40 from vermiculus/new-assoc-let

Fix performance issues with `sx-assoc-let' macro

5 files changed, 61 insertions, 85 deletions

diff --git a/sx-filter.el b/sx-filter.el
index aa815a2..acd8fc1 100644
--- a/sx-filter.el
+++ b/sx-filter.el
@@ -54,7 +54,7 @@ or string."
                      "filter/create"
                      keyword-arguments)))
       (sx-assoc-let (elt response 0)
-        (url-hexify-string filter)))))
+        (url-hexify-string .filter)))))
 
 
 ;;; Storage and Retrieval
diff --git a/sx-question-list.el b/sx-question-list.el
index caf24b1..ebd4e97 100644
--- a/sx-question-list.el
+++ b/sx-question-list.el
@@ -205,26 +205,26 @@ Used in the questions list to indicate a question was updated \"4d ago\"."
     (list
      data
      (vector
-      (list (int-to-string score)
-            'face (if upvoted 'sx-question-list-score-upvoted
+      (list (int-to-string .score)
+            'face (if .upvoted 'sx-question-list-score-upvoted
                     'sx-question-list-score))
-      (list (int-to-string answer_count)
-            'face (if (sx-question--accepted-answer data)
+      (list (int-to-string .answer_count)
+            'face (if (sx-question--accepted-answer .data)
                       'sx-question-list-answers-accepted
                     'sx-question-list-answers))
       (concat
        (propertize
-        title
-        'face (if (sx-question--read-p data)
+        .title
+        'face (if (sx-question--read-p .data)
                   'sx-question-list-read-question
                 ;; Increment `sx-question-list--unread-count' for the mode-line.
                 (cl-incf sx-question-list--unread-count)
                 'sx-question-list-unread-question))
        (propertize " " 'display "\n         ")
-       (propertize (concat (sx-time-since last_activity_date)
+       (propertize (concat (sx-time-since .last_activity_date)
                            sx-question-list-ago-string)
                    'face 'sx-question-list-date)
-       (propertize (concat " [" (mapconcat #'identity tags "] [") "]")
+       (propertize (concat " [" (mapconcat #'identity .tags "] [") "]")
                    'face 'sx-question-list-tags)
        (propertize " " 'display "\n"))))))
 
diff --git a/sx-request.el b/sx-request.el
index 56362fc..dd98ead 100644
--- a/sx-request.el
+++ b/sx-request.el
@@ -107,15 +107,15 @@ number of requests left every time it finishes a call.")
               (error "Response could not be read by `json-read-from-string'"))
             ;; If we get here, the response is a valid data structure
             (sx-assoc-let response
-              (when error_id
+              (when .error_id
                 (error "Request failed: (%s) [%i %s] %S"
-                       method error_id error_name error_message))
+                       .method .error_id .error_name .error_message))
               (when (< (setq sx-request-remaining-api-requests
-                             quota_remaining)
+                             .quota_remaining)
                        sx-request-remaining-api-requests-message-threshold)
                 (sx-message "%d API requests reamining"
                             sx-request-remaining-api-requests))
-              items)))))))
+              .items)))))))
 
 
 ;;; Support Functions
diff --git a/sx.el b/sx.el
index 6165714..7ed56d3 100644
--- a/sx.el
+++ b/sx.el
@@ -71,82 +71,42 @@ a string, just return it."
 
 
 ;;; Interpreting request data
-(defvar sx--api-symbols
-  '(
-    accept_rate
-    answer_count
-    answer_id
-    answers
-    body
-    body_markdown
-    close_vote_count
-    comment_count
-    comment_id
-    creation_date
-    delete_vote_count
-    display_name
-    downvoted
-    edited
-    error_id
-    error_name
-    error_message
-    favorite_count
-    filter
-    items
-    is_accepted
-    is_answered
-    last_activity_date
-    last_edit_date
-    last_editor
-    link
-    owner
-    profile_image
-    question_id
-    quota_remaining
-    reopen_vote_count
-    reputation
-    score
-    tags
-    title
-    upvoted
-    user_id
-    user_type
-    view_count
-    )
-  "")
-
-(defun sx--deep-search (symbol list)
-  "Non-nil if SYMBOL is contained somewhere inside LIST."
+(defun sx--deep-dot-search (data)
+  "Find symbols somewhere inside DATA which start with a `.'.
+Returns a list where each element is a cons cell. The car is the
+symbol, the cdr is the symbol without the `.'."
   (cond
-   ((symbolp list)
-    (eq symbol list))
-   ((not (listp list))
-    nil)
-   (t
-    (remove nil (mapcar (lambda (x) (sx--deep-search symbol x)) list)))))
+   ((symbolp data)
+    (let ((name (symbol-name data)))
+      (when (string-match "\\`\\." name)
+        ;; Return the cons cell inside a list, so it can be appended
+        ;; with other results in the clause below.
+        (list (cons data (intern (replace-match "" nil nil name)))))))
+   ((not (listp data)) nil)
+   (t (apply
+       #'append
+       (remove nil (mapcar #'sx--deep-dot-search data))))))
 
 (defmacro sx-assoc-let (alist &rest body)
-  "Execute BODY while let-binding api symbols to their values in ALIST.
-Any api symbol is any symbol listed in `sx--api-symbols'. Only
-those present in BODY are letbound, which leads to optimal
-performance.
+  "Execute BODY while let-binding dotted symbols to their values in ALIST.
+Dotted symbol is any symbol starting with a `.'. Only those
+present in BODY are letbound, which leads to optimal performance.
 
 For instance the following code
 
   (stack-core-with-data alist
-    (list title body))
+    (list .title .body))
 
 is equivalent to
 
-  (let ((title (cdr (assoc 'title alist)))
-        (body (cdr (assoc 'body alist))))
-    (list title body))"
+  (let ((.title (cdr (assoc 'title alist)))
+        (.body (cdr (assoc 'body alist))))
+    (list .title .body))"
   (declare (indent 1)
            (debug t))
-  (let ((symbols (cl-member-if
-                  (lambda (x) (sx--deep-search x body))
-                  sx--api-symbols)))
-    `(let ,(mapcar (lambda (x) `(,x (cdr (assoc ',x ,alist)))) symbols)
+  (let ((symbol-alist (sx--deep-dot-search body)))
+    `(let ,(mapcar (lambda (x) `(,(car x) (cdr (assoc ',(cdr x) ,alist))))
+                   symbol-alist)
        ,@body)))
 
 (defcustom sx-init-hook nil
diff --git a/test/tests.el b/test/tests.el
index a66394c..6a48257 100644
--- a/test/tests.el
+++ b/test/tests.el
@@ -20,6 +20,14 @@
         (insert-file-contents file)
         (read (buffer-string))))))
 
+(defmacro line-should-match (regexp)
+  ""
+  `(let ((line (buffer-substring-no-properties
+                (line-beginning-position)
+                (line-end-position))))
+     (message "Line here is: %S" line)
+     (should (string-match ,regexp line))))
+
 (setq
  sx-request-remaining-api-requests-message-threshold 50000
  debug-on-error t
@@ -89,14 +97,6 @@
                       ((1 . alpha) (2 . beta))]
                      '(1 2 3)))))
 
-(defmacro line-should-match (regexp)
-  ""
-  `(let ((line (buffer-substring-no-properties
-                (line-beginning-position)
-                (line-end-position))))
-     (message "Line here is: %S" line)
-     (should (string-match ,regexp line))))
-
 (ert-deftest question-list-display ()
   (cl-letf (((symbol-function #'sx-request-make)
              (lambda (&rest _) sx-test-data-questions)))
@@ -116,3 +116,19 @@
     (sx-question-list-previous 4)
     (line-should-match
      "^\\s-+2\\s-+1\\s-+&quot;Making tag completion table&quot; Freezes/Blocks -- how to disable [ 0-9]+[ydhms] ago\\s-+\\[autocomplete\\]")))
+
+(ert-deftest macro-test--sx-assoc-let ()
+  "Tests macro expansion for `sx-assoc-let'"
+  (should
+   (equal '(let ((.test (cdr (assoc 'test data))))
+             .test)
+          (macroexpand
+           '(sx-assoc-let data
+              .test))))
+  (should
+   (equal '(let ((.test-one (cdr (assoc 'test-one data)))
+                 (.test-two (cdr (assoc 'test-two data))))
+             (cons .test-one .test-two))
+          (macroexpand
+           '(sx-assoc-let data
+              (cons .test-one .test-two))))))