This is the sixth Chapter of a series of posts about porting The Little Schemer to Clojure. You may wish to read the intro.

So far we’ve covered flat data structures, reading flat data structures, creating data structures, creating a numeric tower, and working with multiple occurrences of a match in the list.

What about nested lists? Would our functions work for those? Not yet. This chapter we’ll fix that.

First we’ll look at leftmost (which also involves defining non-atom? and not). The point of this function is to find the leftmost S-expression, even if it is an empty list ().

(def not_
  (fn [b]
    (cond
      b false
      true true)))

(println (not_ (= 'a 'b)))

(def non-atom?
  (fn [s]
    (not_ (atom? s))))

(println (non-atom? (quote thai)))

(def leftmost
  (fn [l]
    (println "(leftmost " l)
    (println (non-atom? l))
    (cond
      (null? l) '()
      (non-atom? (first l)) (leftmost (first l))
      true (first l))))

(println (leftmost (quote ((((pad))thai))chicken())))

Now we’ll write rember*. What we’re doing here is to remove all matching list members from within the nested list.

(def rember*
  (fn [a l]
    (cond
      (null? l) '()
      (non-atom? (first l)) (cons (rember* a (first l)) (rember* a (rest l)))
      true (cond
             (= (first l) a) (rember* a (rest l))
             true (cons (first l) (rember* a (rest l)))))))

(println (rember* 'bacon '(((bbq sauce)) (with (egg and (bacon))))))

Now we’ll do insertR*. The point of this one is to insert a new element to the right of the matching element, no matter where is occurs in the nested list.

(def insertR*
  (fn [new old l]
    (cond
      (null? l) '()
      (non-atom? (first l)) (cons (insertR* new old (first l)) (insertR* new old (rest l)))
      true (cond
             (= (first l) old) (cons old (cons new (insertR* new old (rest l))))
             true (cons (first l) (insertR* new old (rest l)))))))

(println (insertR* 'chicken 'baked '(((baked)) (with roast) vegetables)))

Well it is time for another Commandment. Well it would be, but instead we’re going to revise an existing one. Here goes:

When recurring on a list of atoms, lat, or a vec, vec, ask two questions about them, and use (rest lat) or (rest vec) for the natural recursion.

When recurring on a list of S-expressions, l, ask three questions: (null? l), (atom? (first l)), and (non-atom? (first l)); and use (first l) and (rest l) for the natural recursion.

When recurring on a number, n, ask two questions, and use (sub1 n) for the natural recursion.

So what happened there? We extended our recursion checks to be able to handle nested lists.

Now let’s do occur*. The point of this one is to count the occurrences of a matching list member inside a nested list.

(def occur*
  (fn [a l]
    (cond
      (null? l) 0
      (non-atom? (first l)) (+_ (occur* a (first l)) (occur* a (rest l)))
      true (cond
             (= (first l) a) (add1 (occur* a (rest l)))
             true (occur* a (rest l))))))

(println (occur* 'creamy '(((creamy)) new (york (cheesecake)) with a ((creamy) latte))))

Now we’ll do subst*. What we want to achieve is a find and replace inside a nested list.

(def subst*
  (fn [new old l]
    (cond
      (null? l) '()
      (non-atom? (first l)) (cons (subst* new old (first l)) (subst* new old (rest l)))
      true (cond
             (= (first l) old) (cons new (subst* new old (rest l)))
             true (cons (first l) (subst* new old (rest l)))))))

(println (subst* 'baked 'creamy '(((creamy) cheesecake) (with (hot (espresso))))))

Now let’s look at insertL. This is quite similar to insertR above – but now we insert the new value to the left of the matching value.

(def insertL*
  (fn [new old l]
    (cond
      (null? l) '()
      (non-atom? (first l))
        (cons
          (insertL* new old (first l))
          (insertL* new old (rest l)))
      true (cond
        (= (first l) old)
          (cons new
            (cons old
              (insertL*
                new old (rest l))))
        true (cons (first l)
          (insertL*
            new old (rest l)))))))

(println (insertL* 'fresh 'creamy '(((creamy) cheesecake) (with (hot (espresso))))))

Now we’ll rewrite member* without using the non-atom? function:

(def member*
  (fn [a l]
    (cond
      (null? l) '()
      (atom? (first l))
        (or
          (= (first l) a)
          (member* a (rest l)))
      true (or
        (member* a (first l))
        (member* a (rest l))))))

(println (member* 'creamy '(((creamy) cheesecake) (with (hot (espresso))))))

Now we’ll look at testing list equality using eqlist?

(def eqlist?
  (fn [l1 l2]
    (cond
      (and (null? l1) (null? l2)) true
      (or (null? l1) (null? l2)) false
      (and (non-atom? (first l1)) (non-atom? (first l2)))
        (and (eqlist? (first l1) (first l2))
             (eqlist? (rest l1) (rest l2)))
      (or (non-atom? (first l1)) (non-atom? (first l2))) false
      true (and
        (eqan? (first l1) (first l2))
        (eqlist? (rest l1) (rest l2))))))

(println (eqlist? '(with (hot (espresso))) '(with (hot (espresso)))));//=>true
(println (eqlist? '(with (hot (espresso))) '((creamy) cheesecake)));//=>false

Now we’ll take a look at rember. At this point the Chapter takes a brief digression from modifying algorithms handle nested lists to focus on the art of refactoring itself. This version of rember differs from the one before by removing a matching S-expression rather than the first matching atom.

(def rember
  (fn [s l]
    (cond
      (null? l) '()
      (non-atom? (first l))
        (cond
          (equal? (first l) s) (rest l)
          true (cons (first l) (rember s (rest l))))
      true (cond
        (equal? (first l) s) (rest l)
        true (cons (first l) (rember s (rest l)))))))

(println (rember 'fresh '(((fresh creamy) cheesecake) (with (hot (espresso))))))
;//=> (((fresh creamy) cheesecake) (with (hot (espresso))))

(println (rember 'fresh '(fresh creamy cheesecake with hot espresso)))
;//=> (creamy cheesecake with hot espresso)

Now we’ll do a refactor of rember. The point here is just to illustrate simplification by removing redundant code.

(def rember
  (fn [s l]
    (cond
      (null? l) '()
      true (cond
        (equal? (first l) s) (rest l)
        true (cons (first l) (rember s (rest l)))))))

(println (rember 'fresh '(((fresh creamy) cheesecake) (with (hot (espresso))))))
;//=> (((fresh creamy) cheesecake) (with (hot (espresso))))

(println (rember 'fresh '(fresh creamy cheesecake with hot espresso)))
;//=> (creamy cheesecake with hot espresso)

Now we’ll do a another refactor of rember. Now we’re making it similar by pushing out the tests from the outer cond to the inner.

(def rember
  (fn [s l]
    (cond
      (null? l) '()
      (= (first l) s) (rest l)
      true (cons (first l) (rember s (rest l)))))))

(println (rember 'fresh '(((fresh creamy) cheesecake) (with (hot (espresso))))))
;//=> (((fresh creamy) cheesecake) (with (hot (espresso))))

(println (rember 'fresh '(fresh creamy cheesecake with hot espresso)))
;//=> (creamy cheesecake with hot espresso)

Now we’ll take one more crack at refactoring insertL*. This time by removing redundant code.

(def insertL*
  (fn [new old l]
    (cond
      (null? l) '()
      (non-atom? (first l))
        (cons
          (insertL* new old (first l))
          (insertL* new old (rest l)))
      (= (first l) old)
        (cons new
          (cons old
            (insertL*
              new old (rest l))))
      true (cons (first l)
        (insertL*
          new old (rest l))))))

(println (insertL* 'fresh 'creamy '(((creamy) cheesecake) (with (hot (espresso))))))

Now we’ll look at another commandment:

Simplify only after the function is correct

In some ways obvious – in other ways so profound that Martin Fowler wrote a whole book about it. The point is that optimisations of your code size are great – but get it working first.

You can see it running here.

Conclusion:
Here we’ve adapted our existing functions to be able to work for multiple occurrences of the search result. This chapter we didn’t add any true primitives, not_ and non-atom are entirely composed of existing primtives.

In total our primitives so far are: atom?, null?, first, rest, cond, fn, def, empty?,=, cons, add1, sub1 and one?. These are all the functions (and those in the chapters to come) that we’ll need to implement to get our metacircular interpreter working.