diff options
| -rw-r--r-- | algebraic-structures.foldable.scm | 17 | ||||
| -rw-r--r-- | tests/run.scm | 6 |
2 files changed, 19 insertions, 4 deletions
diff --git a/algebraic-structures.foldable.scm b/algebraic-structures.foldable.scm index be3d615..25c66bb 100644 --- a/algebraic-structures.foldable.scm +++ b/algebraic-structures.foldable.scm @@ -3,10 +3,11 @@ length count any - every) + every + member?) (import (except scheme length) F - (only (chicken base) add1 call/cc)) + (only (chicken base) add1 call/cc assert)) (define (length xs) (fold (lambda (_ acc) (add1 acc)) @@ -36,4 +37,16 @@ (fold (lambda (e acc) (or (pred e) (return #f))) #t + xs)))) + + (define (member? x xs #!optional (= equal?)) + (call/cc + (lambda (return) + (fold (lambda (e _) + (if (= e x) + (return #t) + #f)) + #f xs))))) + + diff --git a/tests/run.scm b/tests/run.scm index d316f75..be0845b 100644 --- a/tests/run.scm +++ b/tests/run.scm @@ -107,8 +107,10 @@ (test #f (list:every (cut member 'x <>) '((a b c) (d x f)))) (test '(x f) (list:every (cut member 'x <>) '((a x c) (d x f)))) -(test 7 (list:maximum '(1 3 7 5) <)) -(test -3 (list:minimum '(4 -3 0 1 7 8) <)) +(test #t (list:member? 3 '(1 3 7 5) =)) +(test #f (list:member? 3 '(1 7 5) =)) +(test #t (list:member? 'c '(a b c) eq?)) +(test #f (list:member? 'c '(a b) eq?)) (test-end "foldable") |