First complete and untested version of buf checked in

diff --git a/source/buf.scm b/source/buf.scm
index ce17b551eb3d5fdcef21a26a1054281354d1a92e..2fcf7e08ba7163abe7217bda7ec9505cf5d103cc 100644 (file)
--- a/source/buf.scm
+++ b/source/buf.scm
@@ -2,7 +2,7 @@
 
 (define-record buf
   src
-  fn
+  ldfn
   pos
   marks
   data)
@@ -14,29 +14,61 @@
 
 (define (buf? obj)
   (and (buf-struct? obj)
-       (procedure? (buf-fn obj))
+       (procedure? (buf-ldfn obj))
        (integer?  (buf-pos obj))
        (list?     (buf-marks obj))
        (vector?   (buf-data obj))))
 
 (define (buf-marked? b)
-  (if (buf? b) '()))
+  (if (buf? b)
+    (> (length (buf-marks b)) 0)))
 
 (define (buf-mark b)
-  (if (buf? b) '()))
+  (if (buf? b)
+    (buf-marks-set! b (cons (buf-pos b) (buf-marks b)))))
 
 (define (buf-release b)
-  (if (buf? b) '()))
+  (if (buf? b)
+    (buf-marks-set! b (cdr (buf-marks b)))))
+
+(define (buf-advance b)
+  (if (buf? b)
+    (buf-pos-set! b (+ 1 (buf-pos b)))))
 
 (define (buf-sync b n)
-  (if (buf? b) '()))
+  (if (buf? b)
+    (let* ((pos     (buf-pos b))
+           (size    (length (buf-data)))
+           (nxt_idx (- (+ pos n) 1))
+           (max_idx (- size 1)))
+      (if (= size 0)
+        (buf-fill b n)
+        (if (>= nxt_idx max_idx)
+          (buf-fill b (- nxt_idx max_idx)))))))
 
 (define (buf-fill b n)
-  (if (buf? b) '()))
+  (if (buf? b)
+    (let loop ((i 0))
+      ((buf-ldfn b))
+      (if (< i n) (loop (+ i 1))))))
 
 (define (buf-lookahead b n)
-  (if (buf? b) '()))
+  (if (buf? b)
+    (buf-sync b n)
+    (vector-ref
+      (buf-data b)
+      (- (+ (buf-pos b) n) 1))))
 
 (define (buf-consume b n)
-  (if (buf? b) '()))
+  (if (buf? b)
+    (begin
+      (buf-advance b)
+      (if
+        (and
+          (= location size)
+          (not (buf-marked? b)))
+        (begin
+          (buf-pos-set! 0)
+          (buf-data-set! (vector))))
+      (buf-sync b1))))
 

diff --git a/tests/main.scm b/tests/main.scm
index 20c55c6f9c422f537cc34eb0bfbf11d30fa46529..47a49106cf4d4b5d491fb8061209106ce1bad8fe 100644 (file)
--- a/tests/main.scm
+++ b/tests/main.scm
@@ -2,5 +2,5 @@
   (uses library)
   (uses test_foo))
 
-(run-unit-tests)
+;(run-unit-tests)
 

diff --git a/tests/test_foo.scm b/tests/test_foo.scm
index 1726cdce0d6968f78f0ba3ddaff866f60fb95232..3f0f32e78805afa5fb18a7338a70793a8feb5d24 100644 (file)
--- a/tests/test_foo.scm
+++ b/tests/test_foo.scm
@@ -1,8 +1,8 @@
 (declare (unit test_foo))
 
-(test-suite "Foo unit tests"
-  (test "Foo does cool stuff"
-    (check-equal 42 (foo 1 2)) ))
+;(test-suite "Foo unit tests"
+;  (test "Foo does cool stuff"
+;    (check-equal 42 (foo 1 2)) ))
 
 (print "Hello, world!")