blob: e5fa971d41ec43f715a2cb490965f0976a20c6e7 (
about) (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
|
;;; This has some diagnostic stuff
;;; This forces all delays in a structure
(define (force-all x)
(cond ((delay? x)
(force-all (force x)))
((pair? x)
(force-all (car x))
(force-all (cdr x)))
((vector? x)
(dotimes (i (vector-length x))
(force-all (vector-ref x i)))))
x)
;;; This forces & removes all delays in a structure.
(define (remove-delays x)
(cond ((delay? x)
(remove-delays (force x)))
((pair? x)
(cons (remove-delays (car x))
(remove-delays (cdr x))))
((vector? x)
(list->vector (map (function remove-delays) (vector->list x))))
(else x)))
(define (delay? x)
(and (pair? x)
(or (eq? (car x) '#t)
(eq? (car x) '#f))))
|
