forge: use deftest; implement seq as class

This commit is contained in:
Helmut Merz 2024-05-21 11:39:34 +02:00
parent 53a61b660b
commit 547e02b85f
2 changed files with 25 additions and 42 deletions

View file

@ -117,47 +117,30 @@
; sequence
(defun make-seq ()
(let* ((start (list nil))
(cur start)
(end start)
(args (list start cur end)))
#'(lambda (fn)
(setf args (apply fn args)))))
(defclass seq ()
((start :reader start :initform (list nil) :initarg :start)
(cur :accessor cur)
(end :accessor end)))
(defun make-seq (&optional start)
(let* ((start (cons nil start))
(seq (make-instance 'seq :start start)))
(setf (cur seq) (setf (end seq) start))
seq))
(defun seq-all (seq)
(let (rv)
(funcall seq #'(lambda (start cur end)
(setf rv (cdr start))
(list start cur end)))
rv))
(cdr (start seq)))
(defun seq-cur (seq)
(let (rv)
(funcall seq #'(lambda (start cur end)
(setf rv (car cur))
(list start cur end)))
rv))
(car (cur seq)))
(defun seq-end (seq)
(let (rv)
(funcall seq #'(lambda (start cur end)
(setf rv (car end))
(list start cur end)))
rv))
(car (end seq)))
(defun seq-next (seq)
(let (rv)
(funcall seq #'(lambda (start cur end)
(pop cur)
(setf rv (car cur))
(list start cur end)))
rv))
(pop (cur seq))
(car (cur seq)))
(defun seq-add (seq v)
(funcall seq #'(lambda (start cur end)
(setf (cdr end) (list v))
(pop end)
(list start cur end)))
nil)
(setf (cdr (end seq)) (list v))
(pop (end seq)))

View file

@ -7,12 +7,12 @@
(:local-nicknames (:forge :scopes/forge)
(:t :scopes/testing))
(:export #:run)
(:import-from :scopes/testing #:==))
(:import-from :scopes/testing #:deftest #:==))
(in-package :scopes/test-forge)
(defun run ()
(let ((t:*test-suite* (t:test-suite)))
(let ((t:*test-suite* (t:test-suite "forge")))
(test-seq)
(test-exec)
;(format t "~%data-stack ~a" (dstack))
@ -22,32 +22,32 @@
(test-var)
(t:show-result)))
(defun test-seq ()
(deftest test-seq ()
(let ((seq (forge:make-seq)))
(forge:seq-add seq 1)
(forge:seq-add seq 2)
(== (forge:seq-next seq) 1)
(== (forge:seq-end seq) 2)))
(defun test-exec ()
(deftest test-exec ()
(forge:exec '(4 2 +))
(== (car (forge:dstack)) 6))
(defun test-def ()
(deftest test-def ()
(forge:exec '((dup *) "square" def))
(forge:exec '(7 square))
(== (car (forge:dstack)) 49))
(defun test-exec-str ()
(deftest test-exec-str ()
(forge:exec-str "16 square")
(== (car (forge:dstack)) 256))
(defun test-const ()
(deftest test-const ()
(forge:exec-str "17 \"c1\" const")
(forge:exec-str "c1 square")
(== (car (forge:dstack)) 289))
(defun test-var ()
(deftest test-var ()
(forge:exec '(24 "v1" var))
(forge:exec '(v1 get 2 *))
(== (car (forge:dstack)) 48)