1 ;;; myers.el --- Random-access singly-linked lists -*- lexical-binding: t; -*-
3 ;; Copyright (C) 2016 Free Software Foundation, Inc.
5 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
6 ;; Keywords: list, containers
7 ;; Package-Requires: ((emacs "25"))
10 ;; This program is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; This program is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
25 ;; This package implements Eugene W. Myers's "stacks" which are like
26 ;; standard singly-linked lists, except that they also provide efficient
27 ;; lookup. More specifically:
29 ;; cons/car/cdr are O(1), while (nthcdr N L) is O(min (N, log L))
31 ;; For details, see "An applicative random-access stack", Eugene W. Myers,
32 ;; 1983, Information Processing Letters
33 ;; http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.188.9344&rep=rep1&type=pdf
44 (:constructor myers--cons (car cdr skip-distance skip)))
45 (car nil :read-only t)
46 (cdr nil :read-only t :type (or null myers))
47 ;; Contrary to Myers's presentation, we index from the top of the stack,
48 ;; and we don't store the total length but the "skip distance" instead.
49 ;; This makes `cons' slightly faster, and better matches our use for
50 ;; debruijn environments.
51 (skip-distance nil :read-only t :type integer)
52 (skip nil :read-only t :type (or null myers)))
54 (defun myers-cons (car cdr)
55 "Create a new Myers cons, give it CAR and CDR as components, and return it.
56 This like `cons' but for Myers's lists."
58 (myers--cons car cdr 1 cdr)
59 (let ((s1 (myers--skip-distance cdr))
60 (cddr (myers--skip cdr)))
62 (myers--cons car cdr 1 cdr)
63 (let ((s2 (myers--skip-distance cddr))
64 (cdddr (myers--skip cddr)))
66 (myers--cons car cdr (+ 1 s1 s2) cdddr)
67 (myers--cons car cdr 1 cdr)))))))
69 (defun myers-list (&rest objects)
70 "Return a newly created list with specified arguments as elements."
72 (dolist (x (nreverse objects))
73 (setq list (myers-cons x list)))
76 ;; FIXME: Should myers-car/cdr just defer to myers--car/cdr, or should they
77 ;; reproduce car/cdr's behavior more faithfully and return nil when the arg
79 (defalias 'myers-car #'myers--car)
80 (defalias 'myers-cdr #'myers--cdr)
82 (pcase-defmacro myers-cons (car cdr)
83 `(cl-struct myers (car ,car) (cdr ,cdr)))
85 (defun myers-nthcdr (n list)
86 "Take `myers-cdr' N times on LIST, return the result."
87 (while (and (> n 0) list)
88 (let ((s (myers--skip-distance list)))
90 (setq n (- n s) list (myers--skip list))
91 (setq n (- n 1) list (myers--cdr list)))))
94 ;; This operation would be more efficient using Myers's choice of keeping
95 ;; the length (instead of the skip-distance) in each node.
96 (cl-defmethod seq-length ((seq myers))
99 (cl-incf n (myers--skip-distance seq))
100 (setq seq (myers--skip seq)))
103 (cl-defmethod seq-elt ((seq myers) n)
104 (let ((l (myers-nthcdr n seq)))
105 (when l (myers--car l))))
108 (cl-defmethod seq-do (fun (seq myers))
110 (funcall fun (myers--car seq))
111 (setq seq (myers--cdr seq))))
113 (cl-defmethod seqp ((_seq myers)) t)
115 (cl-defmethod seq-copy ((seq myers))
118 (push (myers--car seq) elts)
119 (setq seq (myers--cdr seq)))
121 (setq seq (myers-cons elt seq)))
124 (cl-defmethod seq-subseq ((seq myers) start &optional end)
126 (let ((nstart (+ (seq-length seq) start)))
128 (signal 'args-out-of-range (list seq start))
129 (setq start nstart))))
130 (setq seq (myers-nthcdr start seq))
133 (let ((nend (if (>= end 0)
135 (+ end (seq-length seq)))))
137 (signal 'args-out-of-range (list seq end))
142 (push (myers--car seq) elts)
143 (setq seq (myers--cdr seq)))
145 (setq res (myers-cons elt res)))
148 (cl-defmethod seq-empty-p ((_seq myers)) nil)
150 (cl-defmethod seq-reverse ((seq myers))
153 (setq res (myers-cons (myers--car seq) res))
154 (setq seq (myers--cdr seq)))
157 (defun myers-find (pred list)
158 "Find the first element of LIST for which PRED returns non-nil.
159 \"Binary\" search, assuming the list is \"sorted\" (i.e. all elements after
160 this one also return true).
161 Return the node holding that element (or nil, if none found)."
164 (if (funcall pred (myers--car list))
166 (let ((l2 (myers--skip list)))
167 (setq list (myers--cdr list))
171 (and l2 (not (funcall pred (myers--car l2)))
173 (setq list (myers--cdr l2))
174 (setq l2 (myers--skip l2))
179 ;; (* Find the last node for which the predicate `p' is false.
180 ;; * "Binary" search, assuming the list is "sorted" (i.e. all elements after
181 ;; * this one also return true). *)
182 ;; let rec findcdr p l =
183 ;; let rec findcdr2 last l1 l2 =
185 ;; | _, (Mcons (x, l1, _, l2) as l) when not (p x) -> findcdr2 (Some l) l1 l2
186 ;; | l, _ -> findcdr1 last l
187 ;; and findcdr1 last l =
190 ;; | Mcons (x, _, _, _) when p x -> last
191 ;; | Mcons (_, l1, _, l2) -> findcdr2 (Some l) l1 l2
192 ;; in findcdr1 None l
196 ;;; myers.el ends here