2 ; Copyright © 2018 Keith Packard <keithp@keithp.com>
4 ; This program is free software; you can redistribute it and/or modify
5 ; it under the terms of the GNU General Public License as published by
6 ; the Free Software Foundation, either version 2 of the License, or
7 ; (at your option) any later version.
9 ; This program is distributed in the hope that it will be useful, but
10 ; WITHOUT ANY WARRANTY; without even the implied warranty of
11 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 ; General Public License for more details.
14 ; string functions placed in ROM
17 (lambda (proc . strings)
18 ; result length is min of arg lengths
19 (let* ((l (apply min (map string-length strings)))
22 ; walk the strings, doing evaluation
27 (string-set! s p (apply proc (map (lambda (s) (string-ref s p)) strings)))
37 (_??_ (string-map (lambda (x) (+ 1 x)) "HAL") "IBM")
40 (lambda (t a f . args)
45 ; handle optional start/end args
47 (if (not (null? args))
50 (if (not (null? (cdr args)))
55 ; flip copy order if dst is
65 ; loop copying one at a time
69 (string-set! t (+ p o) (string-ref f p))
75 (_??_ (string-copy! (make-string 10) 0 "hello" 0 5) "hello ")
76 (_??_ (string-copy! (make-string 10) 1 "hello" 0 5) " hello ")
77 (_??_ (string-copy! (make-string 10) 0 "hello" 0 5) "hello ")
79 (define (string-upcase s) (string-map char-upcase s))
80 (define (string-downcase s) (string-map char-downcase s))
81 (define string-foldcase string-downcase)
86 (h (string-length s)))
87 (if (not (null? args))
90 (if (not (null? (cdr args)))
94 (string-copy! (make-string (- h l)) 0 s l h)
99 (_??_ (string-copy "hello" 0 1) "h")
100 (_??_ (string-copy "hello" 1) "ello")
101 (_??_ (string-copy "hello") "hello")
103 (define substring string-copy)
108 (h (string-length s)))
109 (cond ((not (null? args))
111 (cond ((not (null? (cdr args)))
112 (set! h (cadr args)))
129 (_??_ (string-fill! (make-string 10) #\a) "aaaaaaaaaa")
130 (_??_ (string-fill! (make-string 10) #\a 1 2) " a ")
132 (define string-for-each
133 (lambda (proc . strings)
134 ; result length is min of arg lengths
135 (let* ((l (apply min (map string-length strings)))
137 ; walk the strings, doing evaluation
142 (apply proc (map (lambda (s) (string-ref s p)) strings))
152 (_??_ (string-for-each write-char "IBM\n") #t)