X-Git-Url: https://git.gag.com/?p=fw%2Faltos;a=blobdiff_plain;f=src%2Fscheme%2Fao_scheme_string.scheme;fp=src%2Fscheme%2Fao_scheme_string.scheme;h=0000000000000000000000000000000000000000;hp=99f16faba7dd316709c3a7e4641d6bd1f2e141ad;hb=f26cc1a677f577da533425a15485fcaa24626b23;hpb=4b52fc6eea9a478cb3dd42dcd32c92838df39734

diff --git a/src/scheme/ao_scheme_string.scheme b/src/scheme/ao_scheme_string.scheme
deleted file mode 100644
index 99f16fab..00000000
--- a/src/scheme/ao_scheme_string.scheme
+++ /dev/null
@@ -1,156 +0,0 @@
-;
-; 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 (lambda chars (list->string chars)))
-
-(string #\a #\b #\c)
-
-(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")
-
-(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)
-(string-copy! (make-string 10) 1 "hello" 0 5)
-(string-copy! (make-string 10) 0 "hello" 0 5)
-
-(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)
-(string-copy "hello" 1)
-(string-copy "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)
-(string-fill! (make-string 10) #\a 1 2)
-
-(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")