summaryrefslogtreecommitdiff
path: root/runtime/debug-utils.scm
diff options
context:
space:
mode:
Diffstat (limited to 'runtime/debug-utils.scm')
-rw-r--r--runtime/debug-utils.scm33
1 files changed, 33 insertions, 0 deletions
diff --git a/runtime/debug-utils.scm b/runtime/debug-utils.scm
new file mode 100644
index 0000000..e5fa971
--- /dev/null
+++ b/runtime/debug-utils.scm
@@ -0,0 +1,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))))
+