[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/myers cc8d39d 1/2: * myers.el: New package
From: |
Stefan Monnier |
Subject: |
[elpa] externals/myers cc8d39d 1/2: * myers.el: New package |
Date: |
Sat, 28 Nov 2020 19:09:51 -0500 (EST) |
branch: externals/myers
commit cc8d39d05c4a48545336510df7ac9ab186611ea2
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>
* myers.el: New package
---
myers.el | 196 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 196 insertions(+)
diff --git a/myers.el b/myers.el
new file mode 100644
index 0000000..e52dd6a
--- /dev/null
+++ b/myers.el
@@ -0,0 +1,196 @@
+;;; myers.el --- Random-access singly-linked lists -*- lexical-binding: t;
-*-
+
+;; Copyright (C) 2016 Free Software Foundation, Inc.
+
+;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
+;; Keywords: list, containers
+;; Package-Requires: ((emacs "25"))
+;; Version: 0.1
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This package implements Eugene W. Myers's "stacks" which are like
+;; standard singly-linked lists, except that they also provide efficient
+;; lookup. More specifically:
+;;
+;; cons/car/cdr are O(1), while (nthcdr N L) is O(min (N, log L))
+;;
+;; For details, see "An applicative random-access stack", Eugene W. Myers,
+;; 1983, Information Processing Letters
+;;
http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.188.9344&rep=rep1&type=pdf
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'seq)
+
+(cl-defstruct (myers
+ (:copier nil)
+ (:constructor nil)
+ (:conc-name myers--)
+ (:constructor myers--cons (car cdr skip-distance skip)))
+ (car nil :read-only t)
+ (cdr nil :read-only t :type (or null myers))
+ ;; Contrary to Myers's presentation, we index from the top of the stack,
+ ;; and we don't store the total length but the "skip distance" instead.
+ ;; This makes `cons' slightly faster, and better matches our use for
+ ;; debruijn environments.
+ (skip-distance nil :read-only t :type integer)
+ (skip nil :read-only t :type (or null myers)))
+
+(defun myers-cons (car cdr)
+ "Create a new Myers cons, give it CAR and CDR as components, and return it.
+This like `cons' but for Myers's lists."
+ (if (null cdr)
+ (myers--cons car cdr 1 cdr)
+ (let ((s1 (myers--skip-distance cdr))
+ (cddr (myers--skip cdr)))
+ (if (null cddr)
+ (myers--cons car cdr 1 cdr)
+ (let ((s2 (myers--skip-distance cddr))
+ (cdddr (myers--skip cddr)))
+ (if (<= s2 s1)
+ (myers--cons car cdr (+ 1 s1 s2) cdddr)
+ (myers--cons car cdr 1 cdr)))))))
+
+(defun myers-list (&rest objects)
+ "Return a newly created list with specified arguments as elements."
+ (let ((list nil))
+ (dolist (x (nreverse objects))
+ (setq list (myers-cons x list)))
+ list))
+
+;; FIXME: Should myers-car/cdr just defer to myers--car/cdr, or should they
+;; reproduce car/cdr's behavior more faithfully and return nil when the arg
+;; is nil?
+(defalias 'myers-car #'myers--car)
+(defalias 'myers-cdr #'myers--cdr)
+
+(pcase-defmacro myers-cons (car cdr)
+ `(cl-struct myers (car ,car) (cdr ,cdr)))
+
+(defun myers-nthcdr (n list)
+ "Take `myers-cdr' N times on LIST, return the result."
+ (while (and (> n 0) list)
+ (let ((s (myers--skip-distance list)))
+ (if (<= s n)
+ (setq n (- n s) list (myers--skip list))
+ (setq n (- n 1) list (myers--cdr list)))))
+ list)
+
+;; This operation would be more efficient using Myers's choice of keeping
+;; the length (instead of the skip-distance) in each node.
+(cl-defmethod seq-length ((seq myers))
+ (let ((n 0))
+ (while seq
+ (cl-incf n (myers--skip-distance seq))
+ (setq seq (myers--skip seq)))
+ n))
+
+(cl-defmethod seq-elt ((seq myers) n)
+ (let ((l (myers-nthcdr n seq)))
+ (when l (myers--car l))))
+
+
+(cl-defmethod seq-do (fun (seq myers))
+ (while seq
+ (funcall fun (myers--car seq))
+ (setq seq (myers--cdr seq))))
+
+(cl-defmethod seqp ((_seq myers)) t)
+
+(cl-defmethod seq-copy ((seq myers))
+ (let ((elts ()))
+ (while seq
+ (push (myers--car seq) elts)
+ (setq seq (myers--cdr seq)))
+ (dolist (elt elts)
+ (setq seq (myers-cons elt seq)))
+ seq))
+
+(cl-defmethod seq-subseq ((seq myers) start &optional end)
+ (when (< start 0)
+ (let ((nstart (+ (seq-length seq) start)))
+ (if (< nstart 0)
+ (signal 'args-out-of-range (list seq start))
+ (setq start nstart))))
+ (setq seq (myers-nthcdr start seq))
+ (if (null end)
+ (seq-copy seq)
+ (let ((nend (if (>= end 0)
+ (- end start)
+ (+ end (seq-length seq)))))
+ (if (< nend 0)
+ (signal 'args-out-of-range (list seq end))
+ (setq end nend)))
+ (let ((elts ())
+ (res ()))
+ (dotimes (_ end)
+ (push (myers--car seq) elts)
+ (setq seq (myers--cdr seq)))
+ (dolist (elt elts)
+ (setq res (myers-cons elt res)))
+ res)))
+
+(cl-defmethod seq-empty-p ((_seq myers)) nil)
+
+(cl-defmethod seq-reverse ((seq myers))
+ (let ((res ()))
+ (while seq
+ (setq res (myers-cons (myers--car seq) res))
+ (setq seq (myers--cdr seq)))
+ res))
+
+(defun myers-find (pred list)
+ "Find the first element of LIST for which PRED returns non-nil.
+\"Binary\" search, assuming the list is \"sorted\" (i.e. all elements after
+this one also return true).
+Return the node holding that element (or nil, if none found)."
+ (while
+ (when list
+ (if (funcall pred (myers--car list))
+ nil
+ (let ((l2 (myers--skip list)))
+ (setq list (myers--cdr list))
+ (if (eq l2 list)
+ t
+ (while
+ (and l2 (not (funcall pred (myers--car l2)))
+ (progn
+ (setq list (myers--cdr l2))
+ (setq l2 (myers--skip l2))
+ t))))
+ t))))
+ list)
+
+;; (* Find the last node for which the predicate `p' is false.
+;; * "Binary" search, assuming the list is "sorted" (i.e. all elements after
+;; * this one also return true). *)
+;; let rec findcdr p l =
+;; let rec findcdr2 last l1 l2 =
+;; match l1,l2 with
+;; | _, (Mcons (x, l1, _, l2) as l) when not (p x) -> findcdr2 (Some l) l1
l2
+;; | l, _ -> findcdr1 last l
+;; and findcdr1 last l =
+;; match l with
+;; | Mnil -> last
+;; | Mcons (x, _, _, _) when p x -> last
+;; | Mcons (_, l1, _, l2) -> findcdr2 (Some l) l1 l2
+;; in findcdr1 None l
+
+
+(provide 'myers)
+;;; myers.el ends here