diff options
Diffstat (limited to 'chicanery.extras.scm')
-rw-r--r-- | chicanery.extras.scm | 58 |
1 files changed, 50 insertions, 8 deletions
diff --git a/chicanery.extras.scm b/chicanery.extras.scm index 27968df..bcb4929 100644 --- a/chicanery.extras.scm +++ b/chicanery.extras.scm | |||
@@ -1,8 +1,7 @@ | |||
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 | 3 | (export list-map list-for-each list-append |
4 | list-for-each | 4 | map for-each append) |
5 | list-append) | ||
6 | 5 | ||
7 | ;;; Generalized map, for-each, ... | 6 | ;;; Generalized map, for-each, ... |
8 | ;; List versions are renamed `list-<function>'. Un-prefixed versions work | 7 | ;; List versions are renamed `list-<function>'. Un-prefixed versions work |
@@ -81,13 +80,9 @@ | |||
81 | ;;; Functions that should be in scheme | 80 | ;;; Functions that should be in scheme |
82 | ;; This sections should be as small as possible | 81 | ;; This sections should be as small as possible |
83 | 82 | ||
84 | (export atom? | 83 | (export read-port |
85 | read-port | ||
86 | read-port-chunk-size) | 84 | read-port-chunk-size) |
87 | 85 | ||
88 | (define (atom? x) | ||
89 | (not (pair? x))) | ||
90 | |||
91 | (define read-port-chunk-size | 86 | (define read-port-chunk-size |
92 | (make-parameter 512)) | 87 | (make-parameter 512)) |
93 | 88 | ||
@@ -113,3 +108,50 @@ | |||
113 | (case-lambda | 108 | (case-lambda |
114 | (() (%read-port (current-input-port))) | 109 | (() (%read-port (current-input-port))) |
115 | ((p) (%read-port p)))) | 110 | ((p) (%read-port p)))) |
111 | |||
112 | (export atom? defined?) | ||
113 | |||
114 | (define (atom? x) | ||
115 | (not (or (null? x) | ||
116 | (pair? x)))) | ||
117 | |||
118 | (define (defined? sym) | ||
119 | (call-with-current-continuation | ||
120 | (lambda (k) | ||
121 | (with-exception-handler | ||
122 | (lambda (e) (k #f)) | ||
123 | (lambda () | ||
124 | (eval sym (interaction-environment)) | ||
125 | #t))))) | ||
126 | |||
127 | (export with-output-to-string | ||
128 | with-input-from-string) | ||
129 | |||
130 | (define (with-output-to-string thunk) | ||
131 | (call-with-port (open-output-string) | ||
132 | (lambda (port) | ||
133 | (parameterize ((current-output-port port)) | ||
134 | (thunk)) | ||
135 | (get-output-string port)))) | ||
136 | |||
137 | (define (with-input-from-string s thunk) | ||
138 | (call-with-port (open-input-string s) | ||
139 | (lambda (port) | ||
140 | (parameterize ((current-input-port port)) | ||
141 | (thunk))))) | ||
142 | |||
143 | (export displayed ->string written print) | ||
144 | |||
145 | (define (displayed x) | ||
146 | (with-output-to-string | ||
147 | (lambda () (display x)))) | ||
148 | |||
149 | (define (written x) | ||
150 | (with-output-to-string | ||
151 | (lambda () (write x)))) | ||
152 | |||
153 | (define (print . xs) | ||
154 | (for-each display xs) | ||
155 | (newline)) | ||
156 | |||
157 | (define ->string displayed) | ||