emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/trie bbfecae 085/111: Do lexbind test at compile-time i


From: Stefan Monnier
Subject: [elpa] externals/trie bbfecae 085/111: Do lexbind test at compile-time instead of load-time.
Date: Mon, 14 Dec 2020 11:35:26 -0500 (EST)

branch: externals/trie
commit bbfecaee914d834daadb7ca980c8cb36b1b27340
Author: Toby S. Cubitt <toby-predictive@dr-qubit.org>
Commit: Toby S. Cubitt <toby-predictive@dr-qubit.org>

    Do lexbind test at compile-time instead of load-time.
---
 trie.el | 122 +++++++++++++++++++++++++++++++++-------------------------------
 1 file changed, 63 insertions(+), 59 deletions(-)

diff --git a/trie.el b/trie.el
index dd310ca..e36e417 100644
--- a/trie.el
+++ b/trie.el
@@ -177,6 +177,68 @@
 ;;; ================================================================
 ;;;           Internal utility functions and macros
 
+(defmacro trie--if-lexical-binding (then else)
+  "If lexical binding is in effect, evaluate THEN, otherwise ELSE."
+  (declare (indent 1) (debug t))
+  (if (let ((tempvar nil)
+           (f (let ((tempvar t)) (lambda () tempvar))))
+       tempvar  ;; shut up "unused lexical variable" byte-compiler warning
+       (funcall f))
+      then else))
+
+
+;; wrap CMPFUN for use in a subtree
+(trie--if-lexical-binding
+    (defun trie--wrap-cmpfun (cmpfun)
+      (lambda (a b)
+       (setq a (trie--node-split a)
+             b (trie--node-split b))
+       (cond ((eq a trie--terminator)
+              (if (eq b trie--terminator) nil t))
+             ((eq b trie--terminator) nil)
+             (t (funcall cmpfun a b)))))
+  (defun trie--wrap-cmpfun (cmpfun)
+    `(lambda (a b)
+       (setq a (trie--node-split a)
+            b (trie--node-split b))
+       (cond ((eq a trie--terminator)
+             (if (eq b trie--terminator) nil t))
+            ((eq b trie--terminator) nil)
+            (t (,cmpfun a b))))))
+
+
+;; create equality function from trie comparison function
+(trie--if-lexical-binding
+    (defun trie--construct-equality-function (comparison-function)
+      (lambda (a b)
+        (not (or (funcall comparison-function a b)
+                 (funcall comparison-function b a)))))
+  (defun trie--construct-equality-function (comparison-function)
+    `(lambda (a b)
+       (not (or (,comparison-function a b)
+               (,comparison-function b a))))))
+
+
+;; create Lewenstein rank function from trie comparison function
+(trie--if-lexical-binding
+    (defun trie--construct-Lewenstein-rankfun (comparison-function)
+      (let ((compfun (trie-construct-sortfun comparison-function)))
+       (lambda (a b)
+         (cond
+          ((< (nth 1 (car a)) (nth 1 (car b))) t)
+          ((> (nth 1 (car a)) (nth 1 (car b))) nil)
+          (t (funcall compfun (nth 0 (car a)) (nth 0 (car b))))))))
+  (defun trie--construct-Lewenstein-rankfun (comparison-function)
+    `(lambda (a b)
+       (cond
+       ((< (nth 1 (car a)) (nth 1 (car b))) t)
+       ((> (nth 1 (car a)) (nth 1 (car b))) nil)
+       (t ,(trie-construct-sortfun comparison-function)
+          (nth 0 (car a)) (nth 0 (car b)))))))
+
+
+
+
 ;;; ----------------------------------------------------------------
 ;;;           Functions and macros for handling a trie.
 
@@ -232,64 +294,6 @@
   transform-for-print transform-from-read print-form)
 
 
-(defmacro trie-lexical-binding-p ()
-  "Return non-nil if lexical binding is in effect, nil otherwise."
-  (let ((tempvar (make-symbol "x")))
-    `(let ((,tempvar nil)
-           (f (let ((,tempvar t)) (lambda () ,tempvar))))
-       (funcall f))))
-
-
-;; wrap CMPFUN for use in a subtree
-(if (trie-lexical-binding-p)
-    (defun trie--wrap-cmpfun (cmpfun)
-      (lambda (a b)
-       (setq a (trie--node-split a)
-             b (trie--node-split b))
-       (cond ((eq a trie--terminator)
-              (if (eq b trie--terminator) nil t))
-             ((eq b trie--terminator) nil)
-             (t (funcall cmpfun a b)))))
-  (defun trie--wrap-cmpfun (cmpfun)
-    `(lambda (a b)
-       (setq a (trie--node-split a)
-            b (trie--node-split b))
-       (cond ((eq a trie--terminator)
-             (if (eq b trie--terminator) nil t))
-            ((eq b trie--terminator) nil)
-            (t (,cmpfun a b))))))
-
-
-;; create equality function from trie comparison function
-(if (trie-lexical-binding-p)
-    (defun trie--construct-equality-function (comparison-function)
-      (lambda (a b)
-        (not (or (funcall comparison-function a b)
-                 (funcall comparison-function b a)))))
-  (defun trie--construct-equality-function (comparison-function)
-    `(lambda (a b)
-       (not (or (,comparison-function a b)
-               (,comparison-function b a))))))
-
-
-;; create Lewenstein rank function from trie comparison function
-(if (trie-lexical-binding-p)
-    (defun trie--construct-Lewenstein-rankfun (comparison-function)
-      (let ((compfun (trie-construct-sortfun comparison-function)))
-       (lambda (a b)
-         (cond
-          ((< (nth 1 (car a)) (nth 1 (car b))) t)
-          ((> (nth 1 (car a)) (nth 1 (car b))) nil)
-          (t (funcall compfun (nth 0 (car a)) (nth 0 (car b))))))))
-  (defun trie--construct-Lewenstein-rankfun (comparison-function)
-    `(lambda (a b)
-       (cond
-       ((< (nth 1 (car a)) (nth 1 (car b))) t)
-       ((> (nth 1 (car a)) (nth 1 (car b))) nil)
-       (t ,(trie-construct-sortfun comparison-function)
-          (nth 0 (car a)) (nth 0 (car b)))))))
-
-
 
 
 ;;; ----------------------------------------------------------------
@@ -626,7 +630,7 @@ functions must *never* bind any variables with names 
commencing
           (trie--node-subtree (trie--root trie))))
 
 
-(if (trie-lexical-binding-p)
+(trie--if-lexical-binding
     (defun trie-construct-sortfun (cmpfun &optional reverse)
       "Construct function to compare key sequences, based on a CMPFUN
 that compares individual elements of the sequence. Order is



reply via email to

[Prev in Thread] Current Thread [Next in Thread]