work in progress: forge sequence (pseudo-pointer)

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)))

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))

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"))