From: Keith Packard <keithp@keithp.com>
Date: Thu, 4 Jan 2018 10:28:13 +0000 (-0800)
Subject: altos/scheme: Add vector and string funcs. Test everybody.
X-Git-Tag: 1.8.5~1^2~2^2~19
X-Git-Url: https://git.gag.com/?p=fw%2Faltos;a=commitdiff_plain;h=0d9a3e0378f84ffc8447747150066eae33cd3229

altos/scheme: Add vector and string funcs. Test everybody.

Add a bunch of string and vector functions from r7rs. I think most
everything is here now.

Signed-off-by: Keith Packard <keithp@keithp.com>
---

diff --git a/src/scheme/Makefile-inc b/src/scheme/Makefile-inc
index 1a080a4e..db5083df 100644
--- a/src/scheme/Makefile-inc
+++ b/src/scheme/Makefile-inc
@@ -23,3 +23,8 @@ SCHEME_HDRS=\
 	ao_scheme_os.h \
 	ao_scheme_read.h \
 	ao_scheme_builtin.h
+
+SCHEME_SCHEME=\
+	ao_scheme_const.scheme \
+	ao_scheme_vector.scheme \
+	ao_scheme_string.scheme
diff --git a/src/scheme/ao_scheme_const.scheme b/src/scheme/ao_scheme_const.scheme
index 29f000b3..107d60a6 100644
--- a/src/scheme/ao_scheme_const.scheme
+++ b/src/scheme/ao_scheme_const.scheme
@@ -13,6 +13,8 @@
 ;
 ; Lisp code placed in ROM
 
+(def (quote _?_) (lambda (a b) (cond ((eq? a b) a) (else (exit)))))
+
 					; return a list containing all of the arguments
 (def (quote list) (lambda l l))
 
@@ -80,7 +82,7 @@
 
 					; execute to resolve macros
 
-(or #f #t)
+(_?_ (or #f #t) #t)
 
 (begin
  (def! and
@@ -109,7 +111,43 @@
 
 					; execute to resolve macros
 
-(and #t #f)
+(_?_ (and #t #f) #f)
+
+					; recursive equality
+
+(begin
+  (def! equal?
+    (lambda (a b)
+      (cond ((eq? a b) #t)
+	    ((and (pair? a) (pair? b))
+	     (and (equal? (car a) (car b))
+		  (equal? (cdr a) (cdr b)))
+	     )
+	    ((and (vector? a) (vector? b) (= (vector-length a) (vector-length b)))
+	     ((lambda (i l)
+		(while (and (< i l)
+			    (equal? (vector-ref a i)
+				    (vector-ref b i)))
+		       (set! i (+ i 1)))
+		(eq? i l)
+		)
+	      0
+	      (vector-length a)
+	      )
+	     )
+	    (else #f)
+	    )
+      )
+    )
+  'equal?
+  )
+
+(_?_ (equal? '(a b c) '(a b c)) #t)
+(_?_ (equal? '(a b c) '(a b b)) #f)
+(_?_ (equal? #(1 2 3) #(1 2 3)) #t)
+(_?_ (equal? #(1 2 3) #(4 5 6)) #f)
+
+(def (quote _??_) (lambda (a b) (cond ((equal? a b) a) (else (exit)))))
 
 (begin
  (def! quasiquote
@@ -275,12 +313,24 @@
 
 (define (caar l) (car (car l)))
 
+(_??_ (caar '((1 2 3) (4 5 6))) 1)
+
 (define (cadr l) (car (cdr l)))
 
+(_??_ (cadr '(1 2 3 4 5 6)) 2)
+
 (define (cdar l) (cdr (car l)))
 
+(_??_ (cdar '((1 2) (3 4))) '(2))
+
+(define (cddr l) (cdr (cdr l)))
+
+(_??_ (cddr '(1 2 3)) '(3))
+
 (define (caddr l) (car (cdr (cdr l))))
 
+(_??_ (caddr '(1 2 3 4)) 3)
+
 					; (if <condition> <if-true>)
 					; (if <condition> <if-true> <if-false)
 
@@ -297,33 +347,33 @@
 	 )
   )
 
-(if (> 3 2) 'yes)
-(if (> 3 2) 'yes 'no)
-(if (> 2 3) 'no 'yes)
-(if (> 2 3) 'no)
+(_??_ (if (> 3 2) 'yes) 'yes)
+(_??_ (if (> 3 2) 'yes 'no) 'yes)
+(_??_ (if (> 2 3) 'no 'yes) 'yes)
+(_??_ (if (> 2 3) 'no) #f)
 
 					; simple math operators
 
 (define zero? (macro (value) `(eq? ,value 0)))
 
-(zero? 1)
-(zero? 0)
-(zero? "hello")
+(_??_ (zero? 1) #f)
+(_??_ (zero? 0) #t)
+(_??_ (zero? "hello") #f)
 
 (define positive? (macro (value) `(> ,value 0)))
 
-(positive? 12)
-(positive? -12)
+(_??_ (positive? 12) #t)
+(_??_ (positive? -12) #f)
 
 (define negative? (macro (value) `(< ,value 0)))
 
-(negative? 12)
-(negative? -12)
+(_??_ (negative? 12) #f)
+(_??_ (negative? -12) #t)
 
 (define (abs x) (if (>= x 0) x (- x)))
 
-(abs 12)
-(abs -12)
+(_??_ (abs 12) 12)
+(_??_ (abs -12) 12)
 
 (define max (lambda (first . rest)
 		   (while (not (null? rest))
@@ -335,8 +385,8 @@
 		   first)
   )
 
-(max 1 2 3)
-(max 3 2 1)
+(_??_ (max 1 2 3) 3)
+(_??_ (max 3 2 1) 3)
 
 (define min (lambda (first . rest)
 		   (while (not (null? rest))
@@ -348,35 +398,37 @@
 		   first)
   )
 
-(min 1 2 3)
-(min 3 2 1)
+(_??_ (min 1 2 3) 1)
+(_??_ (min 3 2 1) 1)
 
 (define (even? x) (zero? (% x 2)))
 
-(even? 2)
-(even? -2)
-(even? 3)
-(even? -1)
+(_??_ (even? 2) #t)
+(_??_ (even? -2) #t)
+(_??_ (even? 3) #f)
+(_??_ (even? -1) #f)
 
 (define (odd? x) (not (even? x)))
 
-(odd? 2)
-(odd? -2)
-(odd? 3)
-(odd? -1)
-
+(_??_ (odd? 2) #f)
+(_??_ (odd? -2) #f)
+(_??_ (odd? 3) #t)
+(_??_ (odd? -1) #t)
 
-(define (list-tail x k)
-  (if (zero? k)
-      x
-    (list-tail (cdr x (- k 1)))
-    )
-  )
+(_??_ (list-tail '(1 2 3 . 4) 3) 4)
 
 (define (list-ref x k)
   (car (list-tail x k))
   )
 
+(_??_ (list-ref '(1 2 3 4) 3) 4)
+
+(define (list-set! x k v)
+  (set-car! (list-tail x k) v)
+  x)
+
+(list-set! (list 1 2 3) 1 4)
+
 					; define a set of local
 					; variables all at once and
 					; then evaluate a list of
@@ -429,7 +481,7 @@
      )
 		   
 
-(let ((x 1) (y)) (set! y 2) (+ x y))
+(_??_ (let ((x 1) (y)) (set! y 2) (+ x y)) 3)
 
 					; define a set of local
 					; variables one at a time and
@@ -501,15 +553,17 @@
 	 )
      )
 
-(let* ((x 1) (y x)) (+ x y))
+(_??_ (let* ((x 1) (y x)) (+ x y)) 2)
 
 (define when (macro (test . l) `(cond (,test ,@l))))
 
-(when #t (write 'when))
+(_??_ (when #t (+ 1 2)) 3)
+(_??_ (when #f (+ 1 2)) #f)
 
 (define unless (macro (test . l) `(cond ((not ,test) ,@l))))
 
-(unless #f (write 'unless))
+(_??_ (unless #f (+ 2 3)) 5)
+(_??_ (unless #t (+ 2 3)) #f)
 
 (define (reverse list)
   (define (_r old new)
@@ -521,33 +575,27 @@
   (_r list ())
   )
 
-(reverse '(1 2 3))
-
-(define (list-tail x k)
-  (if (zero? k)
-      x
-    (list-tail (cdr x) (- k 1))))
-
-(list-tail '(1 2 3) 2)
-
-(define (list-ref x k) (car (list-tail x k)))
-
-(list-ref '(1 2 3) 2)
-    
-					; recursive equality
+(_??_ (reverse '(1 2 3)) '(3 2 1))
 
-(define (equal? a b)
-  (cond ((eq? a b) #t)
-	((and (pair? a) (pair? b))
-	 (and (equal? (car a) (car b))
-	      (equal? (cdr a) (cdr b)))
-	 )
-	(else #f)
+(define make-list
+  (lambda (a . b)
+    (define (_m a x)
+      (if (zero? a)
+	  x
+	  (_m (- a 1) (cons b x))
+	  )
+      )
+    (if (null? b)
+	(set! b #f)
+	(set! b (car b))
 	)
+    (_m a '())
+    )
   )
+    
+(_??_ (make-list 10 'a) '(a a a a a a a a a a))
 
-(equal? '(a b c) '(a b c))
-(equal? '(a b c) '(a b b))
+(_??_ (make-list 10) '(#f #f #f #f #f #f #f #f #f #f))
 
 (define member (lambda (obj list . test?)
 		      (cond ((null? list)
@@ -563,105 +611,118 @@
 		      )
   )
 
-(member '(2) '((1) (2) (3)))
+(_??_ (member '(2) '((1) (2) (3)))  '((2) (3)))
 
-(member '(4) '((1) (2) (3)))
+(_??_ (member '(4) '((1) (2) (3))) #f)
 
 (define (memq obj list) (member obj list eq?))
 
-(memq 2 '(1 2 3))
+(_??_ (memq 2 '(1 2 3)) '(2 3))
 
-(memq 4 '(1 2 3))
+(_??_ (memq 4 '(1 2 3)) #f)
 
-(memq '(2) '((1) (2) (3)))
+(_??_ (memq '(2) '((1) (2) (3))) #f)
 
 (define (memv obj list) (member obj list eqv?))
 
-(memv 2 '(1 2 3))
+(_??_ (memv 2 '(1 2 3)) '(2 3))
 
-(memv 4 '(1 2 3))
+(_??_ (memv 4 '(1 2 3)) #f)
 
-(memv '(2) '((1) (2) (3)))
+(_??_ (memv '(2) '((1) (2) (3))) #f)
 
-(define (_assoc obj list test?)
+(define (assoc obj list . compare)
+  (if (null? compare)
+      (set! compare equal?)
+      (set! compare (car compare))
+      )
   (if (null? list)
       #f
-    (if (test? obj (caar list))
+    (if (compare obj (caar list))
 	(car list)
-      (_assoc obj (cdr list) test?)
-      )
+	(assoc obj (cdr list) compare)
+	)
     )
   )
 
-(define (assq obj list) (_assoc obj list eq?))
-(define (assv obj list) (_assoc obj list eqv?))
-(define (assoc obj list) (_assoc obj list equal?))
+(define (assq obj list) (assoc obj list eq?))
+(define (assv obj list) (assoc obj list eqv?))
 
-(assq 'a '((a 1) (b 2) (c 3)))
-(assv 'b '((a 1) (b 2) (c 3)))
-(assoc '(c) '((a 1) (b 2) ((c) 3)))
+(_??_ (assq 'a '((a 1) (b 2) (c 3))) '(a 1))
+(_??_ (assv 'b '((a 1) (b 2) (c 3))) '(b 2))
+(_??_ (assoc '(c) '((a 1) (b 2) ((c) 3))) '((c) 3))
 
 (define char? integer?)
 
-(char? #\q)
-(char? "h")
+(_??_ (char? #\q) #t)
+(_??_ (char? "h") #f)
 
 (define (char-upper-case? c) (<= #\A c #\Z))
 
-(char-upper-case? #\a)
-(char-upper-case? #\B)
-(char-upper-case? #\0)
-(char-upper-case? #\space)
+(_??_ (char-upper-case? #\a) #f)
+(_??_ (char-upper-case? #\B) #t)
+(_??_ (char-upper-case? #\0) #f)
+(_??_ (char-upper-case? #\space) #f)
 
 (define (char-lower-case? c) (<= #\a c #\a))
 
-(char-lower-case? #\a)
-(char-lower-case? #\B)
-(char-lower-case? #\0)
-(char-lower-case? #\space)
+(_??_ (char-lower-case? #\a) #t)
+(_??_ (char-lower-case? #\B) #f)
+(_??_ (char-lower-case? #\0) #f)
+(_??_ (char-lower-case? #\space) #f)
 
 (define (char-alphabetic? c) (or (char-upper-case? c) (char-lower-case? c)))
 
-(char-alphabetic? #\a)
-(char-alphabetic? #\B)
-(char-alphabetic? #\0)
-(char-alphabetic? #\space)
+(_??_ (char-alphabetic? #\a) #t)
+(_??_ (char-alphabetic? #\B) #t)
+(_??_ (char-alphabetic? #\0) #f)
+(_??_ (char-alphabetic? #\space) #f)
 
 (define (char-numeric? c) (<= #\0 c #\9))
 
-(char-numeric? #\a)
-(char-numeric? #\B)
-(char-numeric? #\0)
-(char-numeric? #\space)
+(_??_ (char-numeric? #\a) #f)
+(_??_ (char-numeric? #\B) #f)
+(_??_ (char-numeric? #\0) #t)
+(_??_ (char-numeric? #\space) #f)
 
 (define (char-whitespace? c) (or (<= #\tab c #\return) (= #\space c)))
 
-(char-whitespace? #\a)
-(char-whitespace? #\B)
-(char-whitespace? #\0)
-(char-whitespace? #\space)
+(_??_ (char-whitespace? #\a) #f)
+(_??_ (char-whitespace? #\B) #f)
+(_??_ (char-whitespace? #\0) #f)
+(_??_ (char-whitespace? #\space) #t)
 
 (define char->integer (macro (v) v))
 (define integer->char char->integer)
 
 (define (char-upcase c) (if (char-lower-case? c) (+ c (- #\A #\a)) c))
 
-(char-upcase #\a)
-(char-upcase #\B)
-(char-upcase #\0)
-(char-upcase #\space)
+(_??_ (char-upcase #\a) #\A)
+(_??_ (char-upcase #\B) #\B)
+(_??_ (char-upcase #\0) #\0)
+(_??_ (char-upcase #\space) #\space)
 
 (define (char-downcase c) (if (char-upper-case? c) (+ c (- #\a #\A)) c))
 
-(char-downcase #\a)
-(char-downcase #\B)
-(char-downcase #\0)
-(char-downcase #\space)
+(_??_ (char-downcase #\a) #\a)
+(_??_ (char-downcase #\B) #\b)
+(_??_ (char-downcase #\0) #\0)
+(_??_ (char-downcase #\space) #\space)
+
+(define (digit-value c)
+  (if (char-numeric? c)
+      (- c #\0)
+      #f)
+  )
+
+(_??_ (digit-value #\1) 1)
+(_??_ (digit-value #\a) #f)
 
 (define string (lambda chars (list->string chars)))
 
-(display "apply\n")
-(apply cons '(a b))
+(_??_ (string #\a #\b #\c) "abc")
+
+(_??_ (apply cons '(a b)) '(a . b))
 
 (define map
   (lambda (proc . lists)
@@ -690,7 +751,7 @@
 	 )
   )
 
-(map cadr '((a b) (d e) (g h)))
+(_??_ (map cadr '((a b) (d e) (g h))) '(b e h))
 
 (define for-each
   (lambda (proc . lists)
@@ -708,23 +769,6 @@
 
 (for-each display '("hello" " " "world" "\n"))
 
-(define (_string-ml strings)
-  (if (null? strings) ()
-    (cons (string->list (car strings)) (_string-ml (cdr strings)))
-    )
-  )
-
-(define string-map (lambda (proc . strings)
-			  (list->string (apply map proc (_string-ml strings))))))
-
-(string-map (lambda (x) (+ 1 x)) "HAL")
-
-(define string-for-each
-  (lambda (proc . strings)
-    (apply for-each proc (_string-ml strings))))
-
-(string-for-each write-char "IBM\n")
-
 (define (newline) (write-char #\newline))
 
 (newline)
@@ -746,7 +790,7 @@
 
 
 
-`(hello ,(+ 1 2) ,@(list 1 2 3) `foo)
+(_??_ `(hello ,(+ 1 2) ,@(list 1 2 3) `foo) '(hello 3 1 2 3 (quasiquote foo)))
 
 
 (define repeat
@@ -816,4 +860,43 @@
 	 )
   )
 
-(case 12 (1 "one") (2 "two") (3 => (lambda (x) (write "the value is" x))) (12 "twelve") (else "else"))
+(_??_ (case 1 (1 "one") (2 "two") (3 => (lambda (x) (write "the value is" x))) (12 "twelve") (else "else")) "one")
+(_??_ (case 2 (1 "one") (2 "two") (3 => (lambda (x) (write "the value is" x))) (12 "twelve") (else "else")) "two")
+(_??_ (case 3 (1 "one") (2 "two") (3 => (lambda (x) (write "the value is" x) "three")) (12 "twelve") (else "else")) "three")
+(_??_ (case 4 (1 "one") (2 "two") (3 => (lambda (x) (write "the value is" x))) (12 "twelve") (else "else")) "else")
+(_??_ (case 12 (1 "one") (2 "two") (3 => (lambda (x) (write "the value is" x))) (12 "twelve") (else "else")) "twelve")
+
+(define do
+  (macro (vars test . cmds)
+    (define (_step v)
+      (if (null? v)
+	  '()
+	  (if (null? (cddr (car v)))
+	      (_step (cdr v))
+	      (cons `(set! ,(caar v) ,(caddr (car v)))
+		    (_step (cdr v))
+		    )
+	      )
+	  )
+      )
+    `(let ,(map (lambda (v) (list (car v) (cadr v))) vars)
+       (while (not ,(car test))
+	      ,@cmds
+	      ,@(_step vars)
+	      )
+       ,@(cdr test)
+       )
+    )
+  )
+
+(do ((x 1 (+ x 1)))
+    ((= x 10) "done")
+  (display "x: ")
+  (write x)
+  (newline)
+  )
+
+(_??_ (do ((vec (make-vector 5))
+	   (i 0 (+ i 1)))
+	  ((= i 5) vec)
+	(vector-set! vec i i)) #(0 1 2 3 4))
diff --git a/src/scheme/ao_scheme_string.scheme b/src/scheme/ao_scheme_string.scheme
new file mode 100644
index 00000000..10e6fa4f
--- /dev/null
+++ b/src/scheme/ao_scheme_string.scheme
@@ -0,0 +1,152 @@
+;
+; Copyright © 2018 Keith Packard <keithp@keithp.com>
+;
+; This program is free software; you can redistribute it and/or modify
+; it under the terms of the GNU General Public License as published by
+; the Free Software Foundation, either version 2 of the License, or
+; (at your option) any later version.
+;
+; This program is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of
+; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+; General Public License for more details.
+;
+; string functions placed in ROM
+
+(define string-map
+  (lambda (proc . strings)
+					; result length is min of arg lengths
+    (let* ((l (apply min (map string-length strings)))
+					; create the result
+	   (s (make-string l)))
+					; walk the strings, doing evaluation
+      (define (_m p)
+	(if (equal? p l)
+	    s
+	    (begin
+	      (string-set! s p (apply proc (map (lambda (s) (string-ref s p)) strings)))
+	      (_m (+ p 1))
+	      )
+	    )
+	)
+      (_m 0)
+      )
+    )
+  )
+
+(_??_ (string-map (lambda (x) (+ 1 x)) "HAL") "IBM")
+
+(define string-copy!
+  (lambda (t a f . args)
+    (let ((l 0)
+	  (h (string-length f))
+	  (o a)
+	  (d 1))
+					; handle optional start/end args
+      
+      (if (not (null? args))
+	  (begin
+	    (set! l (car args))
+	    (if (not (null? (cdr args)))
+		(set! h (cadr args)))
+	    (set! o (- a l))
+	    )
+	  )
+					; flip copy order if dst is
+					; after src
+      (if (< l a)
+	  (begin
+	    (set! d h)
+	    (set! h (- l 1))
+	    (set! l (- d 1))
+	    (set! d -1)
+	    )
+	  )
+					; loop copying one at a time
+      (do ((p l (+ p d))
+	   )
+	  ((= p h) t)
+	(string-set! t (+ p o) (string-ref f p))
+	)
+      )
+    )
+  )
+
+(_??_ (string-copy! (make-string 10) 0 "hello" 0 5) "hello     ")
+(_??_ (string-copy! (make-string 10) 1 "hello" 0 5) " hello    ")
+(_??_ (string-copy! (make-string 10) 0 "hello" 0 5) "hello     ")
+
+(define (string-upcase s) (string-map char-upcase s))
+(define (string-downcase s) (string-map char-downcase s))
+(define string-foldcase string-downcase)
+
+(define string-copy
+  (lambda (s . args)
+    (let ((l 0)
+	  (h (string-length s)))
+      (if (not (null? args))
+	  (begin
+	    (set! l (car args))
+	    (if (not (null? (cdr args)))
+		(set! h (cadr args)))
+	    )
+	  )
+      (string-copy! (make-string (- h l)) 0 s l h)
+      )
+    )
+  )
+
+(_??_ (string-copy "hello" 0 1) "h")
+(_??_ (string-copy "hello" 1) "ello")
+(_??_ (string-copy "hello") "hello")
+
+(define substring string-copy)
+
+(define string-fill!
+  (lambda (s a . args)
+    (let ((l 0)
+	  (h (string-length s)))
+      (cond ((not (null? args))
+	     (set! l (car args))
+	     (cond ((not (null? (cdr args)))
+		    (set! h (cadr args)))
+		   )
+	     )
+	    )
+      (define (_f b)
+	(cond ((< b h)
+	       (string-set! s b a)
+	       (_f (+ b 1))
+	       )
+	      (else s)
+	      )
+	)
+      (_f l)
+      )
+    )
+  )
+
+(_??_ (string-fill! (make-string 10) #\a) "aaaaaaaaaa")
+(_??_ (string-fill! (make-string 10) #\a 1 2) " a        ")
+
+(define string-for-each
+  (lambda (proc . strings)
+					; result length is min of arg lengths
+    (let* ((l (apply min (map string-length strings)))
+	   )
+					; walk the strings, doing evaluation
+      (define (_m p)
+	(if (equal? p l)
+	    #t
+	    (begin
+	      (apply proc (map (lambda (s) (string-ref s p)) strings))
+	      (_m (+ p 1))
+	      )
+	    )
+	)
+      (_m 0)
+      )
+    )
+  )
+
+(_??_ (string-for-each write-char "IBM\n") #t)
diff --git a/src/scheme/ao_scheme_vector.scheme b/src/scheme/ao_scheme_vector.scheme
new file mode 100644
index 00000000..bf40204b
--- /dev/null
+++ b/src/scheme/ao_scheme_vector.scheme
@@ -0,0 +1,192 @@
+;
+; Copyright © 2018 Keith Packard <keithp@keithp.com>
+;
+; This program is free software; you can redistribute it and/or modify
+; it under the terms of the GNU General Public License as published by
+; the Free Software Foundation, either version 2 of the License, or
+; (at your option) any later version.
+;
+; This program is distributed in the hope that it will be useful, but
+; WITHOUT ANY WARRANTY; without even the implied warranty of
+; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+; General Public License for more details.
+;
+; vector functions placed in ROM
+
+
+(define vector->string
+  (lambda (v . args)
+    (let ((l 0)
+	  (h (vector-length v)))
+      (if (not (null? args))
+	  (begin
+	    (set! l (car args))
+	    (if (not (null? (cdr args)))
+		(set! h (cadr args)))
+	    )
+	  )
+      (do ((s (make-string (- h l)))
+	   (p l (+ p 1))
+	   )
+	  ((= p h) s)
+	(string-set! s (- p l) (vector-ref v p))
+	)
+      )
+    )
+  )
+
+(_??_ (vector->string #(#\a #\b #\c) 0 2) "ab")
+
+(define string->vector
+  (lambda (s . args)
+    (let ((l 0)
+	  (h (string-length s)))
+      (if (not (null? args))
+	  (begin
+	    (set! l (car args))
+	    (if (not (null? (cdr args)))
+		(set! h (cadr args)))
+	    )
+	  )
+      (do ((v (make-vector (- h l)))
+	   (p l (+ p 1))
+	   )
+	  ((= p h) v)
+	(vector-set! v (- p l) (string-ref s p))
+	)
+      )
+    )
+  )
+
+(_??_ (string->vector "hello" 0 2) #(#\h #\e))
+    
+(define vector-copy!
+  (lambda (t a f . args)
+    (let ((l 0)
+	  (h (vector-length f))
+	  (o a)
+	  (d 1))
+					; handle optional start/end args
+      
+      (if (not (null? args))
+	  (begin
+	    (set! l (car args))
+	    (if (not (null? (cdr args)))
+		(set! h (cadr args)))
+	    (set! o (- a l))
+	    )
+	  )
+					; flip copy order if dst is
+					; after src
+      (if (< l a)
+	  (begin
+	    (set! d h)
+	    (set! h (- l 1))
+	    (set! l (- d 1))
+	    (set! d -1)
+	    )
+	  )
+					; loop copying one at a time
+      (do ((p l (+ p d))
+	   )
+	  ((= p h) t)
+	(vector-set! t (+ p o) (vector-ref f p))
+	)
+      )
+    )
+  )
+
+					; simple vector-copy test
+
+(_??_ (vector-copy! (make-vector 10 "t") 0 (make-vector 5 "f") 0 5) #("f" "f" "f" "f" "f" "t" "t" "t" "t" "t"))
+
+(let ((v (vector 1 2 3 4 5 6 7 8 9 0)))
+  (vector-copy! v 1 v 0 2)
+  (display "v ") (write v) (newline)
+  )
+
+(define vector-copy
+  (lambda (v . args)
+    (let ((l 0)
+	  (h (vector-length v)))
+      (if (not (null? args))
+	  (begin
+	    (set! l (car args))
+	    (if (not (null? (cdr args)))
+		(set! h (cadr args)))
+	    )
+	  )
+      (vector-copy! (make-vector (- h l)) 0 v)
+      )
+    )
+  )
+
+(_??_ (vector-copy #(1 2 3) 0 3) #(1 2 3))
+
+(define vector-append
+  (lambda a
+    (define (_f v a p)
+      (if (null? a)
+	  v
+	  (begin
+	    (vector-copy! v p (car a))
+	    (_f v (cdr a) (+ p (vector-length (car a))))
+	    )
+	  )
+      )
+    (_f (make-vector (apply + (map vector-length a))) a 0)
+    )
+  )
+
+(_??_ (vector-append #(1 2 3) #(4 5 6) #(7 8 9)) #(1 2 3 4 5 6 7 8 9))
+
+(define vector-fill!
+  (lambda (v a . args)
+    (let ((l 0)
+	  (h (vector-length v)))
+      (cond ((not (null? args))
+	     (set! l (car args))
+	     (cond ((not (null? (cdr args)))
+		    (set! h (cadr args)))
+		   )
+	     )
+	    )
+      (define (_f b)
+	(cond ((< b h)
+	       (vector-set! v b a)
+	       (_f (+ b 1))
+	       )
+	      (else v)
+	      )
+	)
+      (_f l)
+      )
+    )
+  )
+
+(_??_ (vector-fill! (make-vector 3) #t 1 2) #(#f #t #f))
+
+					; like 'map', but for vectors
+
+(define vector-map
+  (lambda (proc . vectors)
+					; result length is min of arg lengths
+    (let* ((l (apply min (map vector-length vectors)))
+					; create the result
+	   (v (make-vector l)))
+					; walk the vectors, doing evaluation
+      (define (_m p)
+	(if (equal? p l)
+	    v
+	    (begin
+	      (vector-set! v p (apply proc (map (lambda (v) (vector-ref v p)) vectors)))
+	      (_m (+ p 1))
+	      )
+	    )
+	)
+      (_m 0)
+      )
+    )
+  )
+    
+(_??_ (vector-map + #(1 2 3) #(4 5 6)) #(5 7 9))
diff --git a/src/scheme/test/Makefile b/src/scheme/test/Makefile
index ee46118e..8858f0f6 100644
--- a/src/scheme/test/Makefile
+++ b/src/scheme/test/Makefile
@@ -3,6 +3,8 @@ include ../Makefile-inc
 vpath %.o .
 vpath %.c ..
 vpath %.h ..
+vpath %.scheme ..
+vpath ao_scheme_make_const ../make-const
 
 SRCS=$(SCHEME_SRCS) ao_scheme_test.c
 HDRS=$(SCHEME_HDRS) ao_scheme_const.h
@@ -20,8 +22,8 @@ ao-scheme: $(OBJS)
 
 $(OBJS): $(HDRS)
 
-ao_scheme_const.h: ../make-const/ao_scheme_make_const ../ao_scheme_const.scheme
-	../make-const/ao_scheme_make_const -o $@ ../ao_scheme_const.scheme
+ao_scheme_const.h: ao_scheme_make_const $(SCHEME_SCHEME)
+	$^ -o $@
 
 clean::
 	rm -f $(OBJS) ao-scheme ao_scheme_const.h