diff options
Diffstat (limited to 'chicanery.extras.scm')
-rw-r--r-- | chicanery.extras.scm | 46 |
1 files changed, 31 insertions, 15 deletions
diff --git a/chicanery.extras.scm b/chicanery.extras.scm index 27968df..bbd044f 100644 --- a/chicanery.extras.scm +++ b/chicanery.extras.scm | |||
@@ -1,15 +1,11 @@ | |||
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 | ||
4 | list-for-each | ||
5 | list-append) | ||
6 | |||
7 | ;;; Generalized map, for-each, ... | 3 | ;;; Generalized map, for-each, ... |
8 | ;; List versions are renamed `list-<function>'. Un-prefixed versions work | 4 | ;; List versions are renamed `list-<function>'. Un-prefixed versions work |
9 | ;; with any (default) datatype. TODO: generalize? | 5 | ;; with any (default) datatype. TODO: generalize? |
10 | (define list-map map) | 6 | (define list-map scheme/map) |
11 | (define list-for-each for-each) | 7 | (define list-for-each scheme/for-each) |
12 | (define list-append append) | 8 | (define list-append scheme/append) |
13 | 9 | ||
14 | (define (map proc . collections) | 10 | (define (map proc . collections) |
15 | (let ((first (car collections))) ; we only need to check the first one | 11 | (let ((first (car collections))) ; we only need to check the first one |
@@ -46,9 +42,6 @@ | |||
46 | (apply bytevector-append collections)) | 42 | (apply bytevector-append collections)) |
47 | (else (error "Bad datatype" first))))) | 43 | (else (error "Bad datatype" first))))) |
48 | 44 | ||
49 | (export ref | ||
50 | copy) | ||
51 | |||
52 | ;;; Extended generic functions. | 45 | ;;; Extended generic functions. |
53 | ;; These functions already have a list- version defined, but no non-prefixed | 46 | ;; These functions already have a list- version defined, but no non-prefixed |
54 | ;; one. So I'm fixing that. | 47 | ;; one. So I'm fixing that. |
@@ -78,13 +71,9 @@ | |||
78 | (bytevector-copy collection)) | 71 | (bytevector-copy collection)) |
79 | (else (error "Bad datatype" collection)))) | 72 | (else (error "Bad datatype" collection)))) |
80 | 73 | ||
81 | ;;; Functions that should be in scheme | 74 | ;;; Definitions that should be in scheme |
82 | ;; This sections should be as small as possible | 75 | ;; This sections should be as small as possible |
83 | 76 | ||
84 | (export atom? | ||
85 | read-port | ||
86 | read-port-chunk-size) | ||
87 | |||
88 | (define (atom? x) | 77 | (define (atom? x) |
89 | (not (pair? x))) | 78 | (not (pair? x))) |
90 | 79 | ||
@@ -113,3 +102,30 @@ | |||
113 | (case-lambda | 102 | (case-lambda |
114 | (() (%read-port (current-input-port))) | 103 | (() (%read-port (current-input-port))) |
115 | ((p) (%read-port p)))) | 104 | ((p) (%read-port p)))) |
105 | |||
106 | (define (defined? sym) | ||
107 | (call-with-current-continuation | ||
108 | (lambda (k) | ||
109 | (with-exception-handler | ||
110 | (lambda (e) (k #f)) | ||
111 | (lambda () | ||
112 | (eval sym (interaction-environment)) | ||
113 | #t))))) | ||
114 | |||
115 | (define (displayed x) | ||
116 | (call-with-port (open-output-string) | ||
117 | (lambda (port) | ||
118 | (display x port) | ||
119 | (get-output-string port)))) | ||
120 | |||
121 | (define (written x) | ||
122 | (call-with-port (open-output-string) | ||
123 | (lambda (port) | ||
124 | (write x port) | ||
125 | (get-output-string port)))) | ||
126 | |||
127 | (define (print x) | ||
128 | (display x) | ||
129 | (newline)) | ||
130 | |||
131 | (define ->string displayed) | ||