cl-rw

Layered streams for Common Lisp
git clone https://logand.com/git/cl-rw.git/
Log | Files | Refs

commit 4fbef79607f7b003b1502503bc596deb47d8e915
parent c6f2cf9dfd016366dae673e47f032c1751f61232
Author: Tomas Hlavaty <tom@logand.com>
Date:   Tue, 24 Oct 2017 00:01:35 +0200

same-fringe experiment

Diffstat:
Mrw.lisp | 82+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 82 insertions(+), 0 deletions(-)

diff --git a/rw.lisp b/rw.lisp @@ -647,6 +647,28 @@ ;;(slurp (reduce-reader (reader '(1 2 3)) #'+ 0)) +(defun final (reader) + (labels ((rec (z) + (let ((x (next reader))) + (if x + (rec x) + z)))) + (rec nil)) + #+nil + (do (x + (z nil x)) + ((not (setq x (next reader))) + z)) + #+nil + (let (z) + (loop + with x + while (setq x (next reader)) + do (setq z x)) + z)) + +;;(final (reduce-reader (reader '(1 2 3)) #'+ 0)) + (defun count-reader (reader) (let ((i 0)) (lambda () @@ -667,5 +689,65 @@ ;;(slurp (zip-reader (list (reader '(1 2 3 4 5)) (reader '(a b c d))))) ;;(slurp (zip-reader (list (reader '(1 2 3 4 5)) (reader '(a b c d e f))))) +(defun zip2-reader (readers) + (lambda () + (let ((z (mapcar 'next readers))) + (when (some #'identity z) + z)))) + +;;(slurp (zip2-reader (list (reader '(1 2 3 4 5)) (reader '(a b c d))))) +;;(slurp (zip2-reader (list (reader '(1 2 3 4 5)) (reader '(a b c d e f))))) + ;; ? readers -> choose one based on some criterion? flat-reader + sort? ;; mux-reader + +;; same fringe +;; tree not in memory but computed lazily/on the fly, possibly huge +;; try find / -type f +;; what if e.g. same=hash but diff timestamp => collect differences => pull vs cb? +(labels ((down (x) + (if (atom x) + x + (map-reader (reader x) #'down)))) + (ecase (final + (reduce-reader + (zip2-reader ;; stops on first eof, need to stop when all eof + (list + (flat-reader (map-reader (reader '(1 (2 (3 4) 5 6) 7)) #'down)) + (flat-reader (map-reader (reader '(1 (2 (3 4) 5 6) 7)) #'down)))) + (lambda (x i) + (or (and i (eql (car x) (cadr x))) :no)) + t)) + ((t) t) + (:no nil))) + +(defun same-elements-p (list) + (let ((h (car list))) + (dolist (i (cdr list) t) + (unless (eql h i) + (return))))) + +(defun same-fringe (readers) + (final (reduce-reader (zip2-reader readers) + (lambda (x i) + (or (and i (same-elements-p x)) + (return-from same-fringe))) + t))) + +(defun same-fringe (readers) + (final (map-reader (zip2-reader readers) + (lambda (x) + (or (same-elements-p x) + (return-from same-fringe)))))) + +#+nil +(labels ((down (x) + (if (atom x) + x + (map-reader (reader x) #'down)))) + (same-fringe + (list + (flat-reader (map-reader (reader '(1 (2 (3 4) 5 6) 7)) #'down)) + (flat-reader (map-reader (reader '(1 (2 (3 4) 5 6) 7)) #'down)) + (flat-reader (map-reader (reader '(1 (2 (3 4) 5 6) 7)) #'down)) + (flat-reader (map-reader (reader '(1 (2 (3 4) 5 6) 7)) #'down)))))