diff --git a/forge/forge.lisp b/forge/forge.lisp index e5c9bbe..7a80a37 100644 --- a/forge/forge.lisp +++ b/forge/forge.lisp @@ -5,7 +5,8 @@ (defpackage :scopes/forge (:use :common-lisp) (: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)) (in-package :scopes/forge) @@ -39,6 +40,10 @@ (compiled-function (funcall x)) (t (pushd x))))) +(defun call (code) + (dolist (x code) + (funcall x))) + (defun repl () (do ((input (read-line) (read-line))) ((string= input "q") nil) (exec-str input))) @@ -80,7 +85,7 @@ (reg-b "def" #'(lambda () (let* ((name (popd)) (code (comp (popd)))) - (register (voc) name #'(lambda () (exec code)))))) + (register (voc) name #'(lambda () (call code)))))) (reg-b "const" #'(lambda () (let ((name (popd)) @@ -110,3 +115,42 @@ (defun pushd (v) (push v (data-stack! *forge-env*))) +; sequence + +(defun make-seq () + (let* ((start (list nil)) + (p-cur (list start)) + (p-end (list start))) + #'(lambda (fn) + (funcall fn start p-cur p-end)))) + +(defun seq-all (seq) + (funcall seq #'(lambda (start cur end) + (declare (ignore cur) (ignore end)) + start))) + +(defun seq-cur (seq) + (funcall seq #'(lambda (start p-cur end) + (declare (ignore start) (ignore end)) + (car (car p-cur))))) + +(defun seq-end (seq) + (funcall seq #'(lambda (start cur p-end) + (declare (ignore start) (ignore cur)) + (car (car p-end))))) + +(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))) + +(defun add-to-seq (v p-end) + (setf (cdr (car p-end)) (list v)) + (pop (car p-end))) diff --git a/test/test-forge.lisp b/test/test-forge.lisp index 12dccce..4a17eca 100644 --- a/test/test-forge.lisp +++ b/test/test-forge.lisp @@ -13,6 +13,7 @@ (defun run () (let ((t:*tst* (t:test-suite))) + (test-seq) (test-exec) ;(format t "~%data-stack ~a" (dstack)) (test-def) @@ -21,6 +22,13 @@ (test-var) (t:show-result))) +(defun test-seq () + (let ((seq (forge:make-seq))) + (forge:seq-add seq 1) + (forge:seq-add seq 2) + (== (forge:seq-cur seq) 1) + (== (forge:seq-end seq) 2))) + (defun test-exec () (forge:exec '(4 2 +)) (== (car (forge:dstack)) 6)) diff --git a/test/test-storage.lisp b/test/test-storage.lisp index 7bd5a56..009ccb9 100644 --- a/test/test-storage.lisp +++ b/test/test-storage.lisp @@ -40,6 +40,7 @@ (defun test-track (st) (let (cont tr tr2 (data (make-hash-table))) (setf cont (make-instance 'tracking:container :storage st)) + (defparameter cl-user::*cont cont) (storage:drop-table st :tracks) (tracking:create-table cont) (setf tr (tracking:make-item cont "t01" "john"))