forge sequence: improvements

This commit is contained in:
Helmut Merz 2024-05-19 10:30:45 +02:00
parent 7dd30882e0
commit 3eca0d0c19
2 changed files with 18 additions and 23 deletions

View file

@ -6,7 +6,7 @@
(:use :common-lisp)
(:export #:*forge-env*
#:forge-env #:dstack #:exec #:exec-str #:repl
#:make-seq #:seq-all #:seq-cur #:seq-end #:seq-add))
#:make-seq #:seq-all #:seq-cur #:seq-next #:seq-end #:seq-add))
(in-package :scopes/forge)
@ -120,36 +120,31 @@
(defun make-seq ()
(let* ((start (list nil))
(p-cur (list start))
(p-end (list start)))
(p-end (list start))
(args (list p-cur p-end start)))
#'(lambda (fn)
(funcall fn start p-cur p-end))))
(funcall fn args))))
(defun seq-all (seq)
(funcall seq #'(lambda (start cur end)
(declare (ignore cur) (ignore end))
start)))
(funcall seq #'(lambda (args)
(cdr (third args)))))
(defun seq-cur (seq)
(funcall seq #'(lambda (start p-cur end)
(declare (ignore start) (ignore end))
(car (car p-cur)))))
(funcall seq #'(lambda (args)
(car (car (first args))))))
(defun seq-next (seq)
(funcall seq #'(lambda (args)
(pop (car (first args)))
(seq-cur seq))))
(defun seq-end (seq)
(funcall seq #'(lambda (start cur p-end)
(declare (ignore start) (ignore cur))
(car (car p-end)))))
(funcall seq #'(lambda (args)
(car (car (second args))))))
(defun seq-add (seq v)
(funcall seq #'(lambda (start cur p-end)
(declare (ignore cur))
(add-to-sequence v start p-end))))
(defun add-to-sequence (v start p-end)
(if (car start)
(progn
(setf (cdr (car p-end)) (list v))
(pop (car p-end)))
(setf (car start) v)))
(funcall seq #'(lambda (args)
(add-to-seq v (second args)))))
(defun add-to-seq (v p-end)
(setf (cdr (car p-end)) (list v))

View file

@ -26,7 +26,7 @@
(let ((seq (forge:make-seq)))
(forge:seq-add seq 1)
(forge:seq-add seq 2)
(== (forge:seq-cur seq) 1)
(== (forge:seq-next seq) 1)
(== (forge:seq-end seq) 2)))
(defun test-exec ()