Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- (require-extension test) ; chicken-install -s test
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; Expr -> Bool
- ;; Takes an expression and produce #t if it is an atom; #f otherwise.
- ;;
- ;; NOTE:
- ;; Chicken has its own implementation of atom?. It produces
- ;; `#t` for '(). This version (from the book) produces #f for '().
- (test-group "`atom?':"
- (test "is 'yoda an atom? Yes, it is."
- #t
- (atom? 'yoda))
- (test "'(foo) should not be an atom"
- #f
- (atom? '(foo))))
- (define atom?
- (lambda (x)
- (and (not (pair? x)) (not (null? x)))))
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; (list-of Atom) -> Bool
- ;; Produce #t if l is a list of atoms, #f otherwise.
- (test-group "`lat?'"
- (test "list with only atoms should be #t"
- #t
- (lat? '(a b c)))
- (test "list with lists inside should not be #t"
- #f
- (lat? '(a (b) c))))
- (define lat?
- (lambda (l)
- (cond
- ((null? l) #t)
- ((atom? (car l)) (lat? (cdr l)))
- (else #f))))
- ;; Atom (list-of Atom) -> Bool
- ;; Produce #t if the atom a exists in lat.
- (define member?
- (lambda (a lat)
- (cond
- ((null? lat) #f)
- (else
- (or (eq? (car lat) a)
- (member? a (cdr lat)))))))
- ;; Atom (list-of Atom) -> (list-of Atom)
- ;; Produce list of atoms with first occurrence of `a' removed.
- ;; If `a' doesn't exist in `lat', produce the unmodified list.
- (define rember
- (lambda (a lat)
- (cond
- ((null? lat) '())
- ((eq? (car lat) a) (cdr lat))
- (else
- (cons (car lat) (rember a (cdr lat)))))))
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; List -> List
- ;; Produce list with first element in each sub-list.
- ;; ASSUME: input list can be empty or contain only
- ;; non-empty lists.
- (test-group "`firsts':"
- (test "should produce '()"
- '()
- (firsts '()))
- (test "should get firsts"
- '(a c y k)
- (firsts '((a b) (c) (y z) (k t x)))))
- (define firsts
- (lambda (l)
- (cond
- ((null? l) '())
- (else
- (cons (car (car l))
- (firsts (cdr l)))))))
Add Comment
Please, Sign In to add comment