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
16 (define string (lambda chars (list->string chars)))
21 (lambda (proc . strings)
22 ; result length is min of arg lengths
23 (let* ((l (apply min (map string-length strings)))
26 ; walk the strings, doing evaluation
31 (string-set! s p (apply proc (map (lambda (s) (string-ref s p)) strings)))
41 (string-map (lambda (x) (+ 1 x)) "HAL")
44 (lambda (t a f . args)
49 ; handle optional start/end args
51 (if (not (null? args))
54 (if (not (null? (cdr args)))
59 ; flip copy order if dst is
69 ; loop copying one at a time
73 (string-set! t (+ p o) (string-ref f p))
79 (string-copy! (make-string 10) 0 "hello" 0 5)
80 (string-copy! (make-string 10) 1 "hello" 0 5)
81 (string-copy! (make-string 10) 0 "hello" 0 5)
83 (define (string-upcase s) (string-map char-upcase s))
84 (define (string-downcase s) (string-map char-downcase s))
85 (define string-foldcase string-downcase)
90 (h (string-length s)))
91 (if (not (null? args))
94 (if (not (null? (cdr args)))
98 (string-copy! (make-string (- h l)) 0 s l h)
103 (string-copy "hello" 0 1)
104 (string-copy "hello" 1)
105 (string-copy "hello")
107 (define substring string-copy)
112 (h (string-length s)))
113 (cond ((not (null? args))
115 (cond ((not (null? (cdr args)))
116 (set! h (cadr args)))
133 (string-fill! (make-string 10) #\a)
134 (string-fill! (make-string 10) #\a 1 2)
136 (define string-for-each
137 (lambda (proc . strings)
138 ; result length is min of arg lengths
139 (let* ((l (apply min (map string-length strings)))
141 ; walk the strings, doing evaluation
146 (apply proc (map (lambda (s) (string-ref s p)) strings))
156 (string-for-each write-char "IBM\n")