Logical list operator: l& lp&

tk/listlogic.scm

@@ -0,0 +1,14 @@
+(define (lp& p ls1 ls2)
+  (let loop ((ls1 ls1) (ls2 ls2))
+    (cond ((not (and (pair? ls1) (pair? ls2)))
+           '())
+          ((p (car ls1) (car ls2))
+           (cons (car ls1) (loop (cdr ls1) (cdr ls2))))
+          (else '())
+          )))
+
+(define (ls& ls1 ls2)
+  (cond ((eqv? ls1 ls2) ls1)
+        (else (lp& eqv? ls1 ls2))))
+
+