]> birchwood-abbey.net Git - mit-scheme.git/commitdiff
Add test for predicate continuation with dynamic link.
authorTaylor R Campbell <campbell+mit-scheme@mumble.net>
Sat, 14 May 2022 14:24:31 +0000 (14:24 +0000)
committerTaylor R Campbell <campbell+mit-scheme@mumble.net>
Sat, 14 May 2022 14:40:52 +0000 (14:40 +0000)
(cherry picked from commit 039098c99c87216bfa52a28953b5bd4a9c65b88f)

src/compiler/tests/dlink-pred.scm [new file with mode: 0644]

diff --git a/src/compiler/tests/dlink-pred.scm b/src/compiler/tests/dlink-pred.scm
new file mode 100644 (file)
index 0000000..e6e155f
--- /dev/null
@@ -0,0 +1,31 @@
+; Test for predicate continuations with dynamic links.
+
+(declare (usual-integrations))
+
+(let ()
+  (declare (no-type-checks))
+  (define any
+    (identity
+     (let ()
+       (define (any pred list)
+        (let lp ((list list))
+          (or (null? list)
+              (pred (car list))
+              (lp (cdr list)))))
+       any)))
+  (define (rexists pred thing)
+    (let tlp ((thing thing))
+      (cond ((pred thing) #t)
+           ((vector? thing)
+            (let ((n (vector-length thing)))
+              (let lp ((i 0))
+                (cond ((fix:= i n) #f)
+                      ((tlp (vector-ref thing i)) #t) ;(*)
+                      (else (lp (fix:+ i 1)))))))
+           ((pair? thing)
+            (any tlp thing))
+           (else #f))))
+  ((ucode-primitive exit-with-value 1)
+   (if ((identity rexists) (lambda (x) (symbol? x)) (vector 1 2))
+       123
+       0)))
\ No newline at end of file