From: Michael D. Lowis <mike@mdlowis.com>
Date: Wed, 4 Jul 2012 00:58:28 +0000 (-0400)
Subject: First complete and untested version of buf checked in
X-Git-Url: https://git.mdlowis.com/?a=commitdiff_plain;h=3bc476aa82adff98309fdfe6b741c806fb81fabc;p=archive%2Fdlang-scm.git

First complete and untested version of buf checked in
---

diff --git a/source/buf.scm b/source/buf.scm
index ce17b55..2fcf7e0 100644
--- 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 20c55c6..47a4910 100644
--- 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 1726cdc..3f0f32e 100644
--- 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!")