/src/str/str.scm

 1
 2;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 3
 4(define (str-obj s)
 5
 6  (let ((len (string-length s))
 7	(ref (lambda (i) (string-ref s i)))
 8	(set (lambda (i elt) (string-set! s i elt))))
 9
10    (let ((first-index 0)
11	  (last-index (- len 1)))
12
13      (let ((before-beginning? (lambda (i) (< i first-index)))
14	    (after-end?        (lambda (i) (> i last-index))))
15
16	(let ((index-start-at
17	       (lambda (pred i past? step)
18		 (let loop ((i i))
19		   (cond
20		    ((past? i) #f)
21		    ((pred (ref i)) i)
22		    (else (loop (step i 1))))))))
23
24	  (let ((index-forward-start-at
25		 (lambda (pred i)
26		   (index-start-at pred i after-end? +)))
27
28		(index-backward-start-at
29		 (lambda (pred i)
30		   (index-start-at pred i before-beginning? -))))
31
32	    (let ((index-forward
33		   (lambda (pred)
34		     (index-forward-start-at pred first-index)))
35
36		  (index-backward
37		   (lambda (pred)
38		     (index-backward-start-at pred last-index))))
39
40	      (let ((message-handler
41
42		     (lambda (msg)
43
44		       (case msg
45
46			 ((len) len)
47			 ((ref) ref)
48			 ((set) set)
49
50			 ((index-forward)  index-forward)
51			 ((index-backward) index-backward)
52
53			 ;;
54
55			 ((raw) s)
56
57			 ))))
58		
59      (vector 'str s message-handler)))))))))
60
61;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
62