cco/cl-scopes
3
0
Fork 0
Code Issues 1 Pull requests Releases Wiki Activity Actions

forge sequence: functional version

Browse source
This commit is contained in:
Helmut Merz 2024-05-19 11:05:52 +02:00
parent 3eca0d0c19
commit 8e5317810b
1 changed files with 34 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

54
forge/forge.lisp
View file

@ -119,33 +119,47 @@
(defun make-seq () (defun make-seq ()
(let* ((start (list nil)) (let* ((start (list nil))
(p-cur (list start)) (cur start)
(p-end (list start)) (end start)
(args (list p-cur p-end start))) (args (list start cur end)))
#'(lambda (fn) #'(lambda (fn)
(funcall fn args)))) (setf args (apply fn args)))))
(defun seq-all (seq) (defun seq-all (seq)
(funcall seq #'(lambda (args) (let (rv)
(cdr (third args))))) (funcall seq #'(lambda (start cur end)
(setf rv (cdr start))
(list start cur end)))
rv))
(defun seq-cur (seq) (defun seq-cur (seq)
(funcall seq #'(lambda (args) (let (rv)
(car (car (first args)))))) (funcall seq #'(lambda (start cur end)
(setf rv (car cur))
(defun seq-next (seq) (list start cur end)))
(funcall seq #'(lambda (args) rv))
(pop (car (first args)))
(seq-cur seq))))
(defun seq-end (seq) (defun seq-end (seq)
(funcall seq #'(lambda (args) (let (rv)
(car (car (second args)))))) (funcall seq #'(lambda (start cur end)
(setf rv (car end))
(list start cur end)))
rv))
(defun seq-next (seq)
(let (rv)
(funcall seq #'(lambda (start cur end)
(pop cur)
(setf rv (car cur))
(list start cur end)))
rv))
(defun seq-add (seq v) (defun seq-add (seq v)
(funcall seq #'(lambda (args) (let (rv)
(add-to-seq v (second args))))) (funcall seq #'(lambda (start cur end)
(setf (cdr end) (list v))
(pop end)
(setf rv v)
(list start cur end)))
rv))
(defun add-to-seq (v p-end)
(setf (cdr (car p-end)) (list v))
(pop (car p-end)))