about summary refs log tree commit diff stats
diff options
context:
space:
mode:
-rw-r--r--chicanery.extras.scm47
1 files changed, 42 insertions, 5 deletions
diff --git a/chicanery.extras.scm b/chicanery.extras.scm index 24cdff9..27968df 100644 --- a/chicanery.extras.scm +++ b/chicanery.extras.scm
@@ -1,8 +1,10 @@
1;;; chicanery extras --- extra stuff from ur old pal acdw 1;;; chicanery extras --- extra stuff from ur old pal acdw
2 2
3(export list-map list-for-each list-append) 3(export list-map
4 list-for-each
5 list-append)
4 6
5;; Generalized map, for-each, ... 7;;; Generalized map, for-each, ...
6;; List versions are renamed `list-<function>'. Un-prefixed versions work 8;; List versions are renamed `list-<function>'. Un-prefixed versions work
7;; with any (default) datatype. TODO: generalize? 9;; with any (default) datatype. TODO: generalize?
8(define list-map map) 10(define list-map map)
@@ -44,9 +46,10 @@
44 (apply bytevector-append collections)) 46 (apply bytevector-append collections))
45 (else (error "Bad datatype" first))))) 47 (else (error "Bad datatype" first)))))
46 48
47(export ref copy) 49(export ref
50 copy)
48 51
49;; Extended generic functions. 52;;; Extended generic functions.
50;; These functions already have a list- version defined, but no non-prefixed 53;; These functions already have a list- version defined, but no non-prefixed
51;; one. So I'm fixing that. 54;; one. So I'm fixing that.
52(define (ref collection k) 55(define (ref collection k)
@@ -75,4 +78,38 @@
75 (bytevector-copy collection)) 78 (bytevector-copy collection))
76 (else (error "Bad datatype" collection)))) 79 (else (error "Bad datatype" collection))))
77 80
78;; TODO: look at set! semantics -- generalizable? 81;;; Functions that should be in scheme
82;; This sections should be as small as possible
83
84(export atom?
85 read-port
86 read-port-chunk-size)
87
88(define (atom? x)
89 (not (pair? x)))
90
91(define read-port-chunk-size
92 (make-parameter 512))
93
94(define (%read-port port)
95 (let ((chunk-size (read-port-chunk-size)))
96 (let loop ((next (read-string chunk-size port))
97 (blank? #f)
98 (acc '()))
99 (cond
100 ((or (eof-object? next)
101 (and blank? (equal? next "")))
102 (apply string-append (reverse acc)))
103 ((equal? next "")
104 (loop (read-string chunk-size port)
105 #t
106 (cons next acc)))
107 (else
108 (loop (read-string chunk-size port)
109 blank?
110 (cons next acc)))))))
111
112(define read-port
113 (case-lambda
114 (() (%read-port (current-input-port)))
115 ((p) (%read-port p))))