about summary refs log tree commit diff stats
path: root/chicanery.extras.scm
diff options
context:
space:
mode:
Diffstat (limited to 'chicanery.extras.scm')
-rw-r--r--chicanery.extras.scm46
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)