forge: use deftest; implement seq as class
This commit is contained in:
parent
53a61b660b
commit
547e02b85f
2 changed files with 25 additions and 42 deletions
|
@ -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)))
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Add table
Reference in a new issue