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

forge sequence: improvements

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

39
forge/forge.lisp
View file

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

2
test/test-forge.lisp
View file

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