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 ()
(let* ((start (list nil))
(p-cur (list start))
(p-end (list start))
(args (list p-cur p-end start)))
(cur start)
(end start)
(args (list start cur end)))
#'(lambda (fn)
(funcall fn args))))
(setf args (apply fn args)))))
(defun seq-all (seq)
(funcall seq #'(lambda (args)
(cdr (third args)))))
(let (rv)
(funcall seq #'(lambda (start cur end)
(setf rv (cdr start))
(list start cur end)))
rv))
(defun seq-cur (seq)
(funcall seq #'(lambda (args)
(car (car (first args))))))
(defun seq-next (seq)
(funcall seq #'(lambda (args)
(pop (car (first args)))
(seq-cur seq))))
(let (rv)
(funcall seq #'(lambda (start cur end)
(setf rv (car cur))
(list start cur end)))
rv))
(defun seq-end (seq)
(funcall seq #'(lambda (args)
(car (car (second args))))))
(let (rv)
(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)
(funcall seq #'(lambda (args)
(add-to-seq v (second args)))))
(let (rv)
(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)))