One of my friends described Lambdajam 2013 Brisbane as ‘One of the funnest conferences I’ve been on.’ I had a blast.

I gave a Lightning Talk on Clojure.

One of my friends described Lambdajam 2013 Brisbane as ‘One of the funnest conferences I’ve been on.’ I had a blast.

I gave a Lightning Talk on Clojure.

*This is the tenth 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, working with multiple occurrences of a match in the list, changing our functions to work with nested lists, building a numerical expression evaluator, performing analysis on sets and numeric functions and deriving the Y-Combinator.

Now we’ll come to the pinnacle of the book (and some would say the peak of LISP itself). We’re building a metacircular interpreter. “What on earth is that?” you might ask. In trying to think of the most concise way to convey this idea – I came across this image:

This is another one that gets the same idea across. It might seem unimaginably crude, but it conveys the big idea of what this post is all about. LISP is a programmable programming language.

It is also the language with the most minimal syntax. If it has the most minimal syntax – then it must also be the easiest to implement. So one of the benefits of Lisp is that it is the easiest to implement (even it itself). That’s what we’ll do today.

But I hear you asking, “Um, practical use case? How would I explain to my manager that I need to eval my eval?”

This is the building block for a couple of different directions. First – if a language is easy to implement – then it is easy to build it into a transpiler/code generator. Clojure is a DSL for JVM bytecode, just as Clojurescript is a DSL for javascript. (One might argue that C is a DSL for ASM). Work is being done on a Clojure to X10C assembler, as well as work on Clojure to x86 generator.

On the business end of things – there comes a time when we need to build a parser for a client app. This might be for a calculator that reads an equation to build a graph or do a financial calculation. Or it might be one of the other seven scenarios Steve Yegge lists here. The point is – you need to write a program that reads programs (and even evaluates them).

Now please have some patience with what follows. This is a port from Scheme to Clojure. (This is 1974ish Scheme in a point in time with dinosaurs down the road and no built in map data structures in the language). This is trying to build everything the book has covered from the the ground up – so <sigh> we’re going to build a map data structure.

We’ll start with a key-value pair to put in our map.

(def new-entry build)

Then we’ll build a function to get a value out of the map by key value. But first we’ll write a handler that gets passed in saying what the author wants to happen when the entry is not found.

(def lookup-in-entry-help (fn [name names values entry-f] (cond (empty? names) (entry-f name) (= (first names) name) (first values) true (lookup-in-entry-help name (rest names) (rest values) entry-f))))

We’d use it with a helper function together like this:

(def couldntfind (fn [a] (println "couldn't find" a))) (println (lookup-in-entry-help 'entree '(mains dessert) '(chicken icecream) couldntfind))

Now we’ll lookup the value in a key-value entry:

(def lookup-in-entry (fn [name entry entry-f] (lookup-in-entry-help name (first_ entry) (second_ entry) entry-f)))

Here is an illustration of how you’d use this:

(println (lookup-in-entry 'entree '((entree mains dessert) (garlicbread chicken icecream)) println))

Now we’ll add the ability to extend our table – which is a cons list:

(def extend-table cons)

Now we’ll lookup a value in the map

(def lookup-in-table (fn [name table table-f] (cond (null? table) (table-f name) true (lookup-in-entry name (first table) (fn [name] (lookup-in-table name (rest table) table-f))))))

We can use it like this:

(println (lookup-in-table 'mains '( ((mains dessert) (steak gelato))) println)) ;//=> steak

Ok – we’ve done our data structure. Now we’re going to start handling s-expressions. We’re going to handle six types:

* self-evaluating

* quote

* identifier

* lambda

* cond, and

* application

We’ll build a table to capture our environment:

(def initial-table (fn [name] (cond (= name 't) true (= name 'nil) nil true (build 'primitive name))))

The basic building blocks of lisp are functions and data. We’ll refer to our basic functions as identifiers, and our basic data atoms as self-evaluating. We’ll create some functions to capture this idea:

For functions we take the expression and go and lookup the handler in our table:

(def *identifier (fn [e table] (lookup-in-table e table initial-table)))

For data atoms – we just leave them as they are – but keep the function convention:

(def *self-evaluating (fn [e table] e))

For our data atoms – we’ll split these into numbers and strings – and build a handler to do that:

(def atom-to-action (fn [e] (cond (number? e) *self-evaluating true *identifier)))

Now we’ll look at the `quote`

function. First we’ll build a function to get the value being quoted

(def text-of-quotation second_)

The only quirk to this definition is that we only take the first atom quoted and ignore the rest. You may consider this a bug in the book! We’ll stick to the book’s definition for now.

Then we’ll build our `quote`

function handler which basically gets the value being quoted:

(def *quote (fn [e table] (text-of-quotation e)))

Now we start to get into some interesting territory. We’re going to handle `lambda`

. We’ll do this by creating a new entry in the table marked as a non-primitive and storing the body (and the argument) of the lambda function in the entry value:

(def *lambda (fn [e table] (build 'non-primitive (cons table (rest e)))))

Giving this a try- we get:

(println (*lambda '(*lambda (b) (println b)) '())) ;//=>(non-primitive (() (b) (println b)))

We’re now going to look at `cond`

(defined in the scheme way – not the Clojure way).

Now we’ll add some abstractions to get out the truth test and conditional expression to be evaluated from a line in a `cond`

test:

(def question-of first_) (def answer-of second_)

I’m sure you didn’t really need that – but the authors of the book seemed to think it would aid readability.

Now we’ll write some code to evaluate a line in a `cond`

expression:

(def evcon (fn [lines table] (cond (meaning (question-of (first lines)) table) (meaning (answer-of (first lines)) table) true (evcon (rest lines) table))))

(We’ll define the function meaning in a moment. Yes there are a few circular references here. You can see on the code running page how they all hang together. )

Now we’ll get the body of a `cond`

expression:

(def cond-lines rest)

Now we’ll write the code to evaluate a condition using all our build block functions:

(def *cond (fn [e table] (evcon (cond-lines e) table)))

Now we’ll build our s-expression function handler – based on the types we looked at before:

(def list-to-action (fn [e] (cond (atom? (first e)) (cond (= (first e) 'quote) *quote (= (first e) 'lambda) *lambda (= (first e) 'cond) *cond true *application) true *application)))

You’ll notice we excluded self-evaluating and identifier as these relate to atoms not functions. What we’ll build now is a function to do that step of filtering:

(def expression-to-action (fn [e] (cond (atom? e) (atom-to-action e) true (list-to-action e))))

This next function the book authors have assigned a profound meaning – but really it is just a combination of the function handler and the environment table. This is functions + data, not at an s-expression level, but at a program level. The beautiful thing about a LISP is that the s-expression level conceptually mirrors the program level. Let’s look at the function `meaning`

:

(def meaning (fn [e table] ((expression-to-action e) e table)))

Now we need a bootstrap function to be able to use our `meaning`

function. In LISPs – this is the `eval`

function. The authors here have chosen to call it `value`

. All it is doing is calling the meaning function, with an empty environment table:

(def value (fn [e] (meaning e '())))

Now we’ll do a handler for primitive identifiers:

(def apply-primitive (fn [name vals] (cond (= name 'car ) (first (first_ vals)) (= name 'cdr ) (rest (first_ vals)) (= name 'cons ) (cons (first_ vals) (second_ vals)) (= name 'eq ) (= (first_ vals) (second_ vals)) (= name 'atom? ) (atom? (first_ vals)) (= name 'not ) (not (first_ vals)) (= name 'null? ) (null? (first_ vals)) (= name 'number? ) (number? (first_ vals)) (= name 'zero? ) (zero? (first_ vals)) (= name 'add1 ) (add1 (first_ vals)) (= name 'sub1 ) (sub1 (first_ vals)))))

This maps the scheme primitive functions to corresponding clojure ones.

Now we’ll look at evaluating a list of items in the table:

(def evlis (fn [args table] (cond (null? args) '() true (cons (meaning (first args) table) (evlis (rest args) table)))))

Now we’ll look at evaluating lambda functions as closures. We’ll start by getting a lambda expression identifier out of the table:

(def table-of first_)

Next we’ll get the lambda function arguments:

(def formals-of second_)

Next we’ll get the body of the lambda expression:

(def body-of third_)

For a given expression in a lambda body, we’ll extract the function from the s-expression:

(def function-of first_)

Next we’ll get the body of the s-expression inside the lambda expression:

(def arguments-of rest)

Now we’ll test to see if an expression in the table has been tagged as a primitive:

(def primitive? (fn [l] (= (first_ l) 'primitive)))

Now we’ll see the opposite – if an expression in the table has been tagged as a non-primitive:

(def non-primitive? (fn [l] (= (first_ l) 'non-primitive)))

Now we’ll evaluate our lambda expression against the arguments passed in. Note that we can nest lambda expressions to make a function return a function:

(def apply-closure (fn [closure vals] (meaning (body-of closure) (extend-table (new-entry (formals-of closure) vals) (table-of closure)))))

Now we’ll apply values to both primitive and non-primitive expressions:

(def apply_ (fn [fun vals] (cond (primitive? fun) (apply-primitive (second_ fun) vals) (non-primitive? fun) (apply-closure (second_ fun) vals))))

Now we’ll step up a level and apply the results of one expression to return a function – to the results of another function to get the arguments to the first function:

(def *application (fn [e table] (apply_ (meaning (function-of e) table) (evlis (arguments-of e) table))))

To approach self-hosting (we won’t get there – but it is the principle of the thing) – we’ll build our own `cons`

function:

(def cons_ (fn [u v] (fn [b] (cond b u true v))))

Note that instead of returning a list – we’re returning a function:

(println (cons_ 'apple '())) ;//=> #<Chapter10WhatIsTheValueOfAllThis$cons_$fn__862 Chapter10WhatIsTheValueOfAllThis$cons_$fn__862@272b72f4> (def lunch (cons_ 'apple '())) (println (lunch 'apple )) ;//=> 'apple (println (lunch '1 )) ;//=> apple (println (lunch nil )) ;//=> ()

Now we’ll define car and cdr to operate on this concept of function-chaining to represent lists:

(def car_ (fn [l] (l true))) (def cdr_ (fn [l] (l nil)))

As an aside – this reliance on function chaining is almost the opposite of what we want. Instead we want to be able to represent chained function calls as data structures – to make the overhead of calls in recursion much cheaper. This representation makes it more expensive. Consider it a toy to stretch your brain and how you think about functions.

We’ve got to the end now – and are about to do our closing demos – and yet the book leaves out a critical piece which is disappointing. We want to be able to take all the functions in the book, and run them in our new evaluator – to fully close the conceptual loop. The authors however leave out `define`

. We’re left to define everything with anonymous functions. We could do it ourselves, but that’s beyond the scope of this blog post.

We’ll finish by taking our evaluator for a spin.

(value '(add1 1)) ;//=> 2 (value '(eq 2 1)) ;//=> false (value '(eq 1 1)) ;//=> true (value '(quote hello)) ;//=> hello (value '((lambda (x) 1) 2)) ;//=> 1 (value '((lambda (x) x) 2)) ;//=> 2 (value '((lambda (x) (add1 x)) 2)) ;//=> 3 (value '(((lambda (y) (lambda (x) 1) y) 4) 3)) ;//=> 1 (value '(((lambda (y) (lambda (x) x) y) 4) 3)) ;//=> 3 (value '(((lambda (x y) (lambda (u) (cond (u x) (t y)))) 1 '()) nil)) ;//=> () (value '((lambda (x) ((lambda (x) (add1 x)) (add1 4))) 6)) ;//=> 6

You can see an example of this running here.

*This is the ninth 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, working with multiple occurrences of a match in the list, changing our functions to work with nested lists, building a numerical expression evaluator and performing analysis on sets and numeric functions.

This chapter is one of the high points of the whole book. You may have heard of Paul Graham’s VC fund, YCombinator – in this session we’ll not only explain the programming concept of the YCombinator – we’ll derive it in Clojure.

Ok – so before we get started – what is it? What is this YCombinator concept everyone is so excited about? Here goes. *The YCombinator is a way to do recursion in a language that doesn’t support recursion*. Instead recursion is defined as a set of rewrite rules.

“What?” I hear you saying. “All the languages I use have recursion, is this just some old hack that people used in the 60’s before they had real languages? Why should I get excited about that?” Fair enough. On it’s own its utility is limited, but it becomes a conceptual building block for lazy functional data structures – which are one of the things that people get excited about in Clojure – and something we don’t see in curly brace languages.

So anyway – let’s get started.

We’ll start with the `rember-f`

function. This takes a list of items, an addition atom and a comparison function. The point is to demonstrate passing functions around.

;demonstrating passing functions around (def rember-f (fn [test? a l] (cond (null? l) '() true (cond (test? (first l) a) (rest l) true (cons (first l) (rember-f test? a (rest l))))))) (println (rember-f = '(pop corn) '(lemonade (pop corn) and (cake)))) ;//=>(lemonade and (cake))

So we passed in the equals function (`=`

) and it was used to test equality with the other item passed in.

Now we’ll rewrite the `rember-f`

function to remove the second conditional:

(def rember-f (fn [test? a l] (cond (null? l) '() (test? (first l) a) (rest l) true (cons (first l) (rember-f test? a (rest l)))))) (println (rember-f = '(pop corn) '(lemonade (pop corn) and (cake)))) ;//=>(lemonade and (cake))

Now we’re going to start looking at writing functions to be curried. By currying we’re referring to the Mathematician Haskell Curry – for whom this is named. The idea of currying a function is that you can pass in fewer than all the functions required for the function to execute, and still pass the result around as a function (now with fewer arguments).

(def eq?-c (fn [a] (fn [x] (= x a)))) (println (eq?-c 'lemonade)) => (println (eq?-c 'lemonade)) #<Chapter9LambdaTheUltimate$eq_QMARK__c$fn__974 Chapter9LambdaTheUltimate$eq_QMARK__c$fn__974@2a2a2ae9> (println ((eq?-c 'lemonade) 'coke)) ;//=> false (println ((eq?-c 'lemonade) 'lemonade)) ;//=> true (def eq?-salad (eq?-c 'salad)) (println (eq?-salad 'tuna)) ;//=>false (println (eq?-salad 'salad)) ;//=>true

Ok – taking that principle to the next level – can we curry our `rember-f`

function? Here goes:

(def rember-f (fn [test?] (fn [a l] (cond (null? l) '() (test? (first l) a) (rest l) true (cons (first l) ((rember-f test?) a (rest l))))))) (println ((rember-f =) 'tuna '(tuna salad is good))) ;//=>(salad is good) (def rember-eq? (rember-f =)) (println (rember-eq? 'tuna '(tuna salad is good))) ;//=>(salad is good)

That was so much fun, we’ll do it again with something similar, the `insertL-f`

function.

(def insertL-f (fn [test?] (fn [new old l] (cond (null? l) '() (test? (first l) old) (cons new (cons old (rest l))) true (cons (first l) ((insertL-f test?) new old (rest l))))))) (println ((insertL-f =) 'creamy 'latte '(a hot cup of latte)))

One more time! Let’s look at `insertR-f`

:

(def insertR-f (fn [test?] (fn [new old l] (cond (null? l) '() (test? (first l) old) (cons old (cons new (rest l))) true (cons (first l) ((insertR-f test?) new old (rest l))))))) (println ((insertR-f =) 'cake 'cheese '(new york cheese)))

Ok – so you’ve probably noticed that `insertR`

and `insertL`

are quite similar except for a piece of code in the middle. Now we’re going to try and replace these two functions with a single function `insert-g`

, that gets another function argument passed in for the difference. We’ll call the functions we insert `seqL`

and `seqR`

. Here goes:

(def seqL (fn [new old l] (cons new (cons old l)))) (def seqR (fn [new old l] (cons old (cons new l)))) (def insert-g (fn [seqarg] (fn [new old l] (cond (null? l) '() (= (first l) old) (seqarg new old (rest l)) true (cons (first l) ((insert-g seqarg) new old (rest l))))))) (def insertL (insert-g seqL)) (println (insertL 'creamy 'latte '(a hot cup of latte))) ;//=>(a hot cup of creamy latte) (def insertR (insert-g seqR)) (println (insertR 'cake 'cheese '(new york cheese))) ;//=>(new york cheese cake)

Ok – what if we do that again – but don’t pass in `seqL`

as a named function – just implement it in the definition of `insertL`

?

(def insertL (insert-g (fn [new old l] (cons new (cons old l))))) (println (insertL 'creamy 'latte '(a hot cup of latte))) ;//=>(a hot cup of creamy latte)

You can argue that this is better as we don’t have to remember as many function names.

Now we’ll look at the `subst`

function from Chapter 3.

(def subst (fn [new old l] (cond (null? l) '() (= (first l) old) (cons new (rest l)) true (cons (first l) (subst new old (rest l)))))) (println (subst 'espresso 'latte '(a hot cup of latte))) ;//=>(a hot cup of espresso)

So what we notice is that `subst`

is quite close to `insertL`

and `insertR`

. So now we can write a new seq function for `insert-g`

. Then we can plug it into a new definition of `subst`

:

(def seqS (fn [new old l] (cons new l))) (def subst (insert-g seqS)) (println (subst 'espresso 'latte '(a hot cup of latte))) ;//>(a hot cup of espresso)

Cool – now we can use this technique on the `rember`

function:

(def seqrem (fn [new old l] l)) (def rember (fn [a l] ((insert-g seqrem) nil a l))) (println (rember 'hot '(a hot cup of espresso))) ;//=>(a cup of espresso)

It’s time for another *Commandment*. The Tenth Commandment states that you should “**Abstract functions with common structures into a single function**“. This is kind of like extract method – except that you pass the method in as a closure.

Now we’ll go back to the value function from Chapter 7.

(def number_? (fn [a] (cond (null? a) false (number? a) true true false))) (def first-sub-exp (fn [aexp] (first (rest aexp)))) (def second-sub-exp (fn [aexp] (first (rest (rest aexp))))) (def operator (fn [aexp] (first aexp))) (use 'clojure.math.numeric-tower) (def value (fn [aexp] (cond (number_? aexp) aexp (= (operator aexp) '+) (+ (value (first-sub-exp aexp)) (value (second-sub-exp aexp))) (= (operator aexp) '*) (* (value (first-sub-exp aexp)) (value (second-sub-exp aexp))) (= (operator aexp) 'exp) (expt (value (first-sub-exp aexp)) (value (second-sub-exp aexp)))))) (println (value '(+ 1 1))) ;//=>2

Now we’ll simplify this down by using a function to take a symbol and return a function:

(def atom-to-function (fn [x] (cond (= x '+ ) + (= x '* ) * (= x 'exp ) expt ))) (def value (fn [aexp] (cond (number_? aexp) aexp true ((atom-to-function (operator aexp)) (value (first-sub-exp aexp)) (value (second-sub-exp aexp)))))) (println (value '(+ 1 1))) ;//=> 2

So that was a bit shorter.

Now we’ll look at `subset?`

and `intersect?`

from Chapter 8.

(def member? (fn [a lat] (cond (null? lat) false true (or (= (first lat) a) (member? a (rest lat)))) )) (def subset? (fn [set1 set2] (cond (null? set1) true true (and (member? (first set1) set2) (subset? (rest set1) set2))))) (println (subset? '(a b c) '(b c d))) ;//=>false (println (subset? '(b c) '(b c d))) ;//=>true (def intersect? (fn [set1 set2] (cond (null? set1) false true (or (member? (first set1) set2) (intersect? (rest set1) set2))))) (println (intersect? '(a b c) '(b c d))) ;//=>true

What we notice is that these two functions only differ in their use of and true and or nil. We can try and abstract them as we’ve done before.

(def set-f? (fn [logical? const] (fn [set1 set2] (cond (null? set1) const true (logical? (member? (first set1) set2) ((set-f? logical? const) (rest set1) set2)))))) ;(def subset? (set-f? and true)) ;(def intersect? (set-f? or nil)) ; note - doesn't work yet

But this doesn’t work. (This is where a light bulb comes on and we start learning). We need to redefine the and and or functions for the functions we’re using:

(def and-prime (fn [x y] (and x y))) (def or-prime (fn [x y] (or x y))) ; still doesn't work (def or-prime (fn [x set1 set2] (or x (intersect? (rest set1) set2)))) (def and-prime (fn [x set1 set2] (and x (subset? (rest set1) set2)))) (def set-f? (fn [logical? const] (fn [set1 set2] (cond (null? set1) const true (logical? (member? (first set1) set2) set1 set2))))) (def intersect? (set-f? or-prime false)) (def subset? (set-f? and-prime true)) (println (intersect? '(toasted banana bread) '(breakfast toasted banana bread with butter for breakfast))) ;//=>true (println (subset? '(banana butter) '(breakfast toasted banana bread with butter for breakfast))) ;//=>true

The tricky thing there was the recursive use and definition of `intersect?`

ie assuming we could use a function before we had defined it in one function, and then using that function to define `insersect?`

– somewhat brain bending!

You can see we wrote `set-f`

to accept `and-prime`

and `or-prime`

as functions passed in as arguments.

Ok – so we’re all warmed up with passing functions around as arguments. Let’s get on with this Y Combinator derivation. We’ll start with multirember from Chapter 5. We’ll simplify it to remove the redundant `cond`

:

(def multirember (fn [a lat] (cond (null? lat) '() (= (first lat) a) (multirember a (rest lat)) true (cons (first lat) (multirember a (rest lat)))))) (println (multirember 'breakfast '(breakfast toasted banana bread with butter for breakfast))) ;//=>(toasted banana bread with butter for)

Too easy. Now we’ll curry this function to return a function that removes a particular list member:

(def mrember-curry (fn [l] (multirember 'curry l))) (println (mrember-curry '(curry chicken with curry rice))) ;//=>(chicken with rice)

Again we’ve done this before – not too hard. Now we’ll rewrite mrember-curry in full without currying it:

(def mrember-curry (fn [l] (cond (null? l) '() (= (first l) 'curry) (mrember-curry (rest l)) true (cons (first l) (mrember-curry (rest l)))))) (println (mrember-curry '(curry chicken with curry rice))) ;//=>(chicken with rice)

Now let’s curry the function above *again* with an argument that the curried function can be applied to:

(def curry-maker (fn [future] (fn [l] (cond (null? l) '() (= (first l) 'curry) ((curry-maker future) (rest l)) true (cons (first l) ((curry-maker future) (rest l))))))) (def mrember-curry (curry-maker 0)) ;//=>(chicken with rice)

Ok so why did we bother with that one? We’ll its like how we replaced `insertL`

with `insert-g`

– except we applied it to a function that already returns functions.

Let’s look at how we use it. We can use `curry-maker`

to define `mrember-curry`

with `curry-maker`

.

(def mrember-curry (curry-maker curry-maker)) (println (mrember-curry '(curry chicken with curry rice))) ;//=>(chicken with rice)

Ok – that wasn’t a big deal – we replaced a zero value with another function. Let’s apply it further. We’ll use this zero replacement in `curry-maker`

to write a function `function-maker`

:

(def function-maker (fn [future] (fn [l] (cond (null? l) '() (= (first l) 'curry) ((future future) (rest l)) true (cons (first l) ((future future) (rest l))))))) ;for yielding mrember-curry when applied to a fcuntion ; (def mrember-curry (function-maker function-maker)) (println (mrember-curry '(curry chicken with curry rice))) ;//=>(chicken with rice)

Ok – we’re about half way there. Now for any internal expression inside a function, we can wrap it in an applied `lamdba`

(`fn`

in clojure) and still have it return the same result. We’ll do that for our function-maker function.

(def function-maker (fn [future] (fn [l] (cond (null? l) '() (= (first l) 'curry) ((fn [arg] ((future future) arg)) (rest l)) true (cons (first l) ((fn [arg] ((future future) arg)) (rest l))))))) (def mrember-curry (function-maker function-maker)) (println (mrember-curry '(curry chicken with curry rice))) ;//=>(chicken with rice)

Ok – that all still works ok.

Now – our `function-maker`

is in a way double-curried. What if we curry it again?

(def function-maker (fn [future] ((fn [recfun] (fn [l] (cond (null? l) '() (= (first l) 'curry) (recfun (rest l)) true (cons (first l) ((future future)))))) (fn [arg] ((future future) arg))))) ;abstraction above to remove l ; just take my word on this for now

Now we’ll split our triple-curried function into two functions:

(def M (fn [recfun] (fn [l] (cond (null? l) '() (= (first l) 'curry) (recfun (rest l)) true (cons (first l) (recfun (rest l))))))) (def function-maker (fn [future] (M (fn [arg] ((future future) arg)))))

Now we’ll refactor `mrember-curry`

without an explicit reference to `function-maker`

:

;Now we'll change this (def mrember-curry (function-maker function-maker)) ;to this (def mrember-curry ((fn [future] (M (fn [arg] ((future future) arg)))) (fn [future] (M (fn [arg] ((future future) arg))))))

This is where the book recommends you take a rest. We’ll push on.

Now we’ll refactor this definition by allowing you to pass in M as a function:

(def Y (fn [M] ((fn [future] (M (fn [arg] ((future future) arg)))) (fn [future] (M (fn [arg] ((future future) arg))))))) (def mrember-curry (Y M)) (println (mrember-curry '(curry chicken with curry rice))) ;//=>(chicken with rice)

That wasn’t too bad. We just used the y-combinator on the `mrember`

function. Now we’ll do it for `length`

:

;using add1 from chapter 7 not chapter 4 (def add1 (fn [n] (cons '() n))) ; now we'll look at using the y-combinator to look at the length of a list (def L (fn [recfun] (fn [l] (cond (null? l) '() true (add1 (recfun (rest l))))))) (def length (Y L)) (println (length '(curry chicken with curry rice))) ;//=>(() () () () ()) ie 5

Now we’ll do it again, but won’t pass in a definition for `L`

– but just use the definition inline:

(def add1 (fn [n] (+ 1 n))) ;just for the sake of it - we'll rewrite length without the L function (def length (Y (fn [recfun] (fn [l] (cond (null? l) 0 true (add1 (recfun (rest l)))))))) (println (length '(curry chicken with curry rice))) ;//=>5

Now we’ll rewrite `length`

without `Y`

or `L`

:

(def length ((fn [M] ((fn [future] (M (fn [arg] ((future future) arg)))) (fn [future] (M (fn [arg] ((future future) arg)))))) (fn [recfun] (fn [l] (cond (null? l) 0 true (add1 (recfun (rest l)))))))) (println (length '(curry chicken with curry rice))) ;//=>5

Ok that ends the Chapter – but we want to take this thing to the next level. Let’s use the ycombinator to start defining a lazy function:

;building a pair with an S-expression and a thunk leads to a stream (def first$ first) (def second$ (fn [str] ((second str)))) ; careful re use of first and second here - as yet undefined! (def build (fn [a b] (cond true (cons a (cons b '()))))) (def str-maker (fn [next n] (build n (fn [] (str-maker next (next n)))))) (def int_ (str-maker add1 0)) (def even (str-maker (fn [n] (+ 2 n)) 0)) ;sub1 from chapter 4 (def sub1 (fn [n] (- n 1))) (def frontier (fn [str n] (cond (zero? n) '() true (cons (first$ str) (frontier (second$ str) (sub1 n)))))) (frontier int_ 10) ;//=>(0 1 2 3 4 5 6 7 8 9)

So that got us the creation of a lazy data structure for a basic example. Now let’s try a more interesting one:

(def Q (fn [str n] (cond (zero? (rem (first$ str) n)) (Q (second$ str) n) true (build (first$ str) (fn [] (Q (second$ str) n)))))) ; note new function call rem - re new primitve (def P (fn [str] (build (first$ str) (fn [] (P (Q str (first$ str))))))) (frontier (P (second$ (second$ int_))) 10) ;//=>(2 3 5 7 11 13 17 19 23 29)

What an interesting stream of numbers!

That’s enough for today.

You can see it working here.

**References**

Here are some additional references on deriving the Y-Combinator

*This is the eighth 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, working with multiple occurrences of a match in the list, changing our functions to work with nested lists and building a numerical expression evaluator.

This chapter we’ll look at sets, relations and functions (in the mathematical sense). So starting with `set?`

let’s see if a list contains a set of unique items.

(def set_? (fn [lat] (cond (null? lat) true true (cond (member? (first lat) (rest lat)) false true (set_? (rest lat)))))) (println (set_? '(toasted banana bread with butter for breakfast))) ;//=>true (println (set_? '(breakfast toasted banana bread with butter for breakfast))) ;//=>false

Note that this assumes the implementation of `member?`

from Chapter 5.

Now let’s simplify our definition of `set?`

:

(def member (fn [lat] (cond (null? lat) true (member? (first lat) (rest lat)) false true (set? (rest lat))))) (println (set_? '(toasted banana bread with butter for breakfast))) ;//=>true (println (set_? '(breakfast toasted banana bread with butter for breakfast))) ;//=>false

Now given a non-unique list of items, let’s return a set of unique items based on the original list with `makeset`

:

(def makeset (fn [lat] (cond (null? lat) '() (member? (first lat) (rest lat)) (makeset (rest lat)) true (cons (first lat) (makeset (rest lat)))))) (println (makeset '(breakfast toasted banana bread with butter for breakfast))) ;//=> (toasted banana bread with butter for breakfast) (println (set_? (makeset '(breakfast toasted banana bread with butter for breakfast)))) ;//=>true

Now we’ll refactor makeset using our definition of `multirember`

from Chapter 5:

(def makeset (fn [lat] (cond (null? lat) '() true (cons (first lat) (makeset (multirember (first lat) (rest lat))))))) (println "") (println "makeset - refactored with multirember") (println (makeset '(breakfast toasted banana bread with butter for breakfast))) ;//=> (breakfast toasted banana bread with butter for) ; note other way around (println (set_? (makeset '(breakfast toasted banana bread with butter for breakfast)))) ;//=>true

While we’re looking at sets, let’s write a function to work out if one set is a `subset`

of another:

(def subset? (fn [set1 set2] (cond (null? set1) true true (cond (member? (first set1) set2) (subset? (rest set1) set2) true false)))) (println (subset? '(banana butter) '(breakfast toasted banana bread with butter for breakfast))) ;//=>true (println (subset? '(banana butter) '(toasted banana bread with butter for breakfast))) ;//=>true (println (subset? '(peanut butter) '(toasted banana bread with butter for breakfast))) ;//=>false

Now we’ll refactor `subset`

to remove the second conditional:

(def subset? (fn [set1 set2] (cond (null? set1) true (member? (first set1) set2) (subset? (rest set1) set2) true false))) (println (subset? '(banana butter) '(breakfast toasted banana bread with butter for breakfast))) ;//=>true (println (subset? '(banana butter) '(toasted banana bread with butter for breakfast))) ;//=>true (println (subset? '(peanut butter) '(toasted banana bread with butter for breakfast))) ;//=>false

Now we’ll refactor `subset`

again to make better use of the trailing final condition:

(def subset? (fn [set1 set2] (cond (null? set1) true true (and (member? (first set1) set2) (subset? (rest set1) set2))))) (println (subset? '(banana butter) '(breakfast toasted banana bread with butter for breakfast))) ;//=>true (println (subset? '(banana butter) '(toasted banana bread with butter for breakfast))) ;//=>true (println (subset? '(peanut butter) '(toasted banana bread with butter for breakfast))) ;//=>false

Now we’ll write `eqset`

to see if two sets are equal (regardless of order):

(def eqset? (fn [set1 set2] (cond (subset? set1 set2) (subset? set2 set1) true false))) (println (eqset? '(toasted banana bread) '(breakfast toasted banana bread with butter for breakfast))) ;//=>false (println (eqset? '(toasted banana bread) '(toasted banana bread))) ;//=>true (println (subset? '(toasted peanut butter for breakfast) '(toasted banana bread ))) ;//=>false

Now we’ll refactor `eqset`

to have only one condition line:

(def eqset? (fn [set1 set2] (cond true (and (subset? set1 set2) (subset? set2 set1))))) (println (eqset? '(toasted banana bread) '(breakfast toasted banana bread with butter for breakfast))) ;//=>false (println (eqset? '(toasted banana bread) '(toasted banana bread))) ;//=>true (println (subset? '(toasted peanut butter for breakfast) '(toasted banana bread ))) ;//=>false

Now we’ll refactor `eqset`

to remove the condition line altogether:

(def eqset? (fn [set1 set2] (and (subset? set1 set2) (subset? set2 set1)))) (println (eqset? '(toasted banana bread) '(breakfast toasted banana bread with butter for breakfast))) ;//=>false (println (eqset? '(toasted banana bread) '(toasted banana bread))) ;//=>true (println (subset? '(toasted peanut butter for breakfast) '(toasted banana bread ))) ;//=>false

Now we’ll write a test to see if two sets `intersect?`

:

(def intersect? (fn [set1 set2] (cond (null? set1) false true (cond (member? (first set1) set2) true true (intersect? (rest set1) set2))))) (println (intersect? '(toasted banana bread) '(breakfast toasted banana bread with butter for breakfast))) ;//=>true (println (intersect? '(toasted banana bread) '(toasted banana bread))) ;//=>true (println (intersect? '(toasted peanut butter for breakfast) '(toasted banana bread ))) ;//=>true (println (intersect? '(strawberry yoghurt) '(toasted banana bread ))) ;//=>false

Now we’ll refactor intersect? to remove the redundant second conditional:

(def intersect? (fn [set1 set2] (cond (null? set1) false (member? (first set1) set2) true true (intersect? (rest set1) set2)))) (println (intersect? '(toasted banana bread) '(breakfast toasted banana bread with butter for breakfast))) ;//=>true (println (intersect? '(toasted banana bread) '(toasted banana bread))) ;//=>true (println (intersect? '(toasted peanut butter for breakfast) '(toasted banana bread ))) ;//=>true (println (intersect? '(strawberry yoghurt) '(toasted banana bread ))) ;//=>false

Now we’ll refactor intersect? to make better use of the trailing conditional:

(def intersect? (fn [set1 set2] (cond (null? set1) false true (or (member? (first set1) set2) (intersect? (rest set1) set2))))) (println (intersect? '(toasted banana bread) '(breakfast toasted banana bread with butter for breakfast))) ;//=>true (println (intersect? '(toasted banana bread) '(toasted banana bread))) ;//=>true (println (intersect? '(toasted peanut butter for breakfast) '(toasted banana bread ))) ;//=>true (println (intersect? '(strawberry yoghurt) '(toasted banana bread ))) ;//=>false

Now we’ll actually get the values at the `intersect`

ion:

(def intersect (fn [set1 set2] (cond (null? set1) '() (member? (first set1) set2) (cons (first set1) (intersect (rest set1) set2)) true (intersect (rest set1) set2)))) (println (intersect '(toasted banana bread) '(breakfast toasted banana bread with butter for breakfast))) ;//=>(toasted banana bread) (println (intersect '(toasted peanut butter for breakfast) '(toasted banana bread ))) ;//=>(toasted) (println (intersect '(strawberry yoghurt) '(toasted banana bread ))) ;//=>()

Now we’ll refactor `intersect`

to filter out non-members first:

(def intersect (fn [set1 set2] (cond (null? set1) '() (not (member? (first set1) set2)) (intersect (rest set1) set2) true (cons (first set1) (intersect (rest set1) set2))))) (println (intersect '(toasted banana bread) '(breakfast toasted banana bread with butter for breakfast))) ;//=>(toasted banana bread) (println (intersect '(toasted peanut butter for breakfast) '(toasted banana bread ))) ;//=>(toasted) (println (intersect '(strawberry yoghurt) '(toasted banana bread ))) ;//=>()

The opposite of getting the intersection of two sets is to get the `union`

– we’ll do that now:

(def union (fn [set1 set2] (cond (null? set1) set2 (member? (first set1) set2) (union (rest set1) set2) true (cons (first set1) (union (rest set1) set2))))) (println (union '(toasted banana bread) '(breakfast toasted banana bread with butter for breakfast))) ;//=>(breakfast toasted banana bread with butter for breakfast) ;// note not a set since not given a set (println (union '(toasted peanut butter for breakfast) '(toasted banana bread ))) ;//=>(peanut butter for breakfast toasted banana bread) (println (union '(strawberry yoghurt) '(toasted banana bread ))) ;//=>(strawberry yoghurt toasted banana bread)

The function next in the line is the `complement`

of two sets:

(def complement_ (fn [set1 set2] (cond (null? set1) '() (member? (first set1) set2) (complement_ (rest set1) set2) true (cons (first set1) (complement_ (rest set1) set2))))) (println (complement_ '(toasted banana bread) '(breakfast toasted banana bread with butter for breakfast))) ;//=>() (println (complement_ '(toasted peanut butter for breakfast) '(toasted banana bread ))) ;//=>(peanut butter for breakfast) (println (complement_ '(strawberry yoghurt) '(toasted banana bread ))) ;//=>(strawberry yoghurt)

Now we’ll look at the intersection of more than two sets with `intersect-all`

:

(def intersect-all (fn [l-set] (cond (null? (rest l-set)) (first l-set) true (intersect (first l-set) (intersect-all (rest l-set)))))) (println "") (println "intersect-all") (println (intersect-all '( (toasted banana bread) (breakfast toasted banana bread with butter for breakfast) (toasted peanut butter for breakfast) (toasted banana bread )))) ;//=>(toasted)

Here the book changes direction – our work on sets has been a building block for looking at functions and relations. Assuming that we can express a function as a set of value pairs – we need to be able to have the building blocks to work with pairs. We’ll start by getting the `first`

and `second`

value out of a pair:

(def first_ (fn [p] (cond true (first p)))) (println (first_ '(a b))) ;//=>a (def second_ (fn [p] (cond true (first (rest p))))) (println (second_ '(a b))) ;//=>b

Next we’ll add the ability to `build`

a pair:

(def build (fn [a b] (cond true (cons a (cons b '()))))) (println (build 'a 'b)) ;//=>(a b)

For the sake of keeping our brain going – we’ll get the `third`

item of a pair just to keep you wondering:

(def third_ (fn [p] (cond true (first (rest (rest p)))))) (println (third_ '(a b c))) ;//=>c

Now we’ll look closer at functions. You’ll remember that for a set of pairs to be a `fun`

ction, there must be only one domain value – ie the first values from a set of pairs must themselves be a set. We’ll borrow our definition of `member*`

from Chapter 6.

(def firsts (fn [l] (cond (empty? l) '() true (cons (first (first l)) (firsts (rest l)))))) (println "") (println "firsts") (println (firsts '((8 3)(4 2)(7 6)(6 2)(3 4)))) ;//=>(8 4 7 6 3) (def fun? (fn [rel] (set? (firsts rel)))) (println "") (println "fun? - refactored to use set? and firsts") (println (fun? '((4 3)(4 2)(7 6)(6 2)(3 4)))) ;//=>false (println (fun? '((8 3)(4 2)(7 6)(6 2)(3 4)))) ;//=>true (println (fun? '((8 3)(4 2)(7 1)(6 0)(9 5)))) ;//=>true

Now just in case you ever wanted to reverse the elements in their pairs and order in the list – we bring you `revrel`

. (It is actually a building block for other functions to come).

(def revrel (fn [rel] (cond (null? rel) '() true (cons (build (second_ (first rel)) (first_ (first rel))) (revrel (rest rel)))))) (println (revrel '((4 3)(4 2)(7 6)(6 2)(3 4)))) ;//=>((3 4) (2 4) (6 7) (2 6) (4 3)) (println (revrel '((8 3)(4 2)(7 6)(6 2)(3 4)))) ;//=>((3 8) (2 4) (6 7) (2 6) (4 3)) (println (revrel '((8 3)(4 2)(7 1)(6 0)(9 5)))) ;//=>((3 8) (2 4) (1 7) (0 6) (5 9))

So applying what we’ve just learned – a full function is one in which both the values of the domain are unique, and the values of the range are unique. We can test this with `fullfun?`

:

(def fullfun? (fn [fun] (set_? (seconds_ fun)))) (println (fullfun? '((4 3)(4 2)(7 6)(6 2)(3 4)))) ;//=>false (println (fullfun? '((8 3)(4 2)(7 6)(6 2)(3 4)))) ;//=>false (println (fullfun? '((8 3)(4 2)(7 1)(6 0)(9 5)))) ;//=>true

A simpler way to express this idea is that the domain of the function is unique – even if the range values are swapped with the domain values – we call this `one-to-one`

:

(def one-to-one? (fn [fun] (fun? (revrel fun)))) (println (one-to-one? '((4 3)(4 2)(7 6)(6 2)(3 4)))) ;//=>false (println (one-to-one? '((8 3)(4 2)(7 6)(6 2)(3 4)))) ;//=>false (println (one-to-one? '((8 3)(4 2)(7 1)(6 0)(9 5))))

You can see this running here.

**Conclusion**:

This chapter we’ve looked at sets, relations and functions (in the mathematical sense). We haven’t really added any new primitives this chapter (thank goodness!).

In total our primitives so far are: `atom?`

, `null?`

, `first`

, `rest`

, `cond`

, `fn`

, `def`

, `empty?`

,`=`

, `cons`

, `add1,`

, `sub1`

, `one?`

and `expt`

. These are all the functions (and those in the chapters to come) that we’ll need to implement to get our metacircular interpreter working.

*This is the seventh 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, working with multiple occurrences of a match in the list, and changing our functions to work with nested lists.

In this chapter we’re driving towards our metacircular interpreter by starting to look at evaluating numerical values. So we’ll look at building an expression, breaking it down into operators and operands, and then handling it and returning a result. So let’s get started!

First we’re going to test with a test function to see if the S-expression passed in is a valid numeric expression that we can evaluate. We’re going to call this function `numbered`

. But first we’ll expand Clojure’s definition of `number?`

– so it can return a null for an invalid expression as we expect

;we need to define number_? to handle true/false (def number_? (fn [a] (cond (null? a) false (number? a) true true false))) (println (number_? 3)) ;//=> true (println (number_? 'a)) ;//=> false

So now let’s do `numbered`

to test for S-expressions that we can evaluate as a numeric expression.

(def numbered? (fn [aexp] (cond (atom? aexp) (number_? aexp) (= (first (rest aexp)) '+) (and (numbered? (first aexp)) (numbered? (first (rest (rest aexp))))) (= (first (rest aexp)) '*) (and (numbered? (first aexp)) (numbered? (first (rest (rest aexp))))) (= (first (rest aexp)) 'exp) (and (numbered? (first aexp)) (numbered? (first (rest (rest aexp))))) true false))) (println (numbered? '(a b c))) ;//=> false (println (numbered? '(3 + (4 * 5)))) ;//=> true (println (numbered? '(3 a (4 * 5)))) ;//=> false

Ok – so can we simplify numbered? Yes:

(def numbered? (fn [aexp] (cond (atom? aexp) (number_? aexp) true (and (numbered? (first aexp)) (numbered? (first (rest (rest aexp)))))))) (println (numbered? '(a b c))) ;//=> false (println (numbered? '(3 + (4 * 5)))) ;//=> true (println (numbered? '(3 a (4 * 5)))) ;//=> true

Hmm – notice that the final expression became true in this version, but was false in the previous? That’s an assumption we’re making with this new version – that we know already this is an arithmetic expression. One might think this defeats the purpose of this function. I digress.

Now we’ll look at the **Eight Commandment**. This states that you *recur on all subparts that are of the same nature including*:

– On all sublists of a list

– On all the subexpressions of a representation of an arithmetic expression.

The big idea is that we’re starting to make a distinction between code and data. We’re saying that data functions recur on data, and code functions recur on code.

Now you’ll remember the infamous function `eval`

from many languages – especially LISP. We’ll start writing the first version of `eval`

for our metacircular interpreter starting with a basic version that just looks at arithmetic expressions. We’ll call it `value`

:

(use 'clojure.math.numeric-tower) ; note use of new primitive expt (def value (fn [aexp] (cond (number_? aexp) aexp (= (first (rest aexp)) '+) (+ (value (first aexp)) (value (first (rest (rest aexp))))) (= (first (rest aexp)) '*) (* (value (first aexp)) (value (first (rest (rest aexp))))) (= (first (rest aexp)) 'exp) (expt (value (first aexp)) (value (first (rest (rest aexp)))))))) (println (value '(1 + 1))) ;//=> 2 (println (value '(2 + 2))) ;//=> 4 (println (value '(3 exp 3))) ;//=> 27 (println (value '(4 b 4))) ;//=> nil

Now we’re going to take the function above and move from prefix to infix – just to illustrate how trivial the distinction is from an implementation point of view

(def value (fn [aexp] (cond (number_? aexp) aexp (= (first aexp) '+) (+ (value (rest aexp)) (value (rest (rest aexp)))) (= (first (rest aexp)) '*) (* (value (first aexp)) (value (first (rest (rest aexp))))) (= (first (rest aexp)) 'exp) (expt (value (first aexp)) (value (first (rest (rest aexp))))))))

Now in my view that was a little silly. The book included a non-working version of value just to illustrate a violation of the Eighth Commandment. Let’s get on with it.

Now we’ll extract out helper functions to get the subexpressions and the operator

(def first-sub-exp (fn [aexp] (first (rest aexp)))) (def second-sub-exp (fn [aexp] (first (rest (rest aexp))))) (def operator (fn [aexp] (first aexp))) (def value (fn [aexp] (cond (number_? aexp) aexp (= (operator aexp) '+) (+ (value (first-sub-exp aexp)) (value (second-sub-exp aexp))) (= (operator aexp) '*) (* (value (first-sub-exp aexp)) (value (second-sub-exp aexp))) (= (operator aexp) 'exp) (expt (value (first-sub-exp aexp)) (value (second-sub-exp aexp)))))) (println (value '(+ 1 1))) ;//=> 2 (println (value '(* 2 2))) ;//=> 4 (println (value '(exp 3 3))) ;//=> 27 (println (value '(b 4 4))) ;//=> nil

Cool – now – just to illustrate the power of abstraction by functions – we’ll switch back from prefix to infix functions.

(def first-sub-exp (fn [aexp] (first aexp))) (def operator (fn [aexp] (first (rest aexp)))) (println (value '(1 + 1))) ;//=> 2 (println (value '(2 * 2))) ;//=> 4 (println (value '(3 exp 3))) ;//=> 27 (println (value '(4 b 4)))

Time for another **Commandment** – The Ninth Commandment States *Use helper functions to abstract from representations*. Part of this is the java concept of eclipse’s extract method. Part of it is the power this gives you to change the function across the whole application and have it impact many parts of the system – ie a wide-ranging refactor.

Now we’re testing for `null?`

. Although we had to write our own helper method for this in Chapter 1 – now as part of implementing the metacircular interpreter – we’re re-implementing it in terms of other functions so keep our api minimal.

;This is what we had (def null? (fn [a] (or (nil? a) (= () a)))) ;This is what they're proposing (def null? (fn [s] (and (atom? s) (= s '()))))

Now it turns out this fails the conversion from Scheme to Clojure. We get the big idea. We’ll just move on.

Now we’re going to build our own numeric system out of parenthesis – again, just to make the implementation of our metacircular interpreter more pure and easier to implement. This is significant because we’re going to build up our own number representation out of parentheses – admittedly a strange exercise – but going to prove that we can do maths in a lisp implemented in itself.

We’ll start with `zero?`

:

(def zero_? (fn [n] (null? n))) (println (zero_? '())) ;//=>true (println (zero_? 0)) ;=>false

Ok – maybe that didn’t make sense – let’s give a few examples. So now zero is `()`

, one is `(())`

, and two is `(()())`

.

Let’s do some operations on our new numeric representation – we’ll start with a new definition of `add1`

.

(def add1 (fn [n] (cons '() n))) (println (add1 '())) ;//=>(()) ie 1 (println (add1 '(()))) ;//=> (() ()) ie 2

Now let’s do `sub1`

:

(def sub1 (fn [n] (rest n))) (println (sub1 '(()()))) ;//=>(()) ie 1 (println (sub1 '(()))) ;//=>() ie 0 (println (sub1 '())) ;//=> () unfortunately with our implementation sub1 of zero returns zero

Now we’ll reimplement our `plus`

function:

(def +_ (fn [n m] (cond (zero_? m) n true (add1 (+_ n (sub1 m)))))) (println (+_ '() '())) ;//=> () ;// zero plus zero is zero (println (+_ '(()) '(()))) ;//=> (()()) ie 1 plus 1 is 2

Now we’ll test for valid numbers in our new scheme by rewriting our function `number?`

:

(def number_? (fn [n] (cond (null? n) true true (and (null? (first n)) (number_? (rest n)))))) (println (number_? '() )) ;//=>true (println (number_? '(()) )) ;//=>true (println (number_? '((())) )) ;//=>false (println (number_? '(()()) )) ;//=>true

You can see it running here.

**Conclusion:**

Why is this chapter called shadows? I haven’t figured that out. Perhaps it is a shadow of things to come.

Here we’ve started on the journey of the metacircular interpreter by writing an evaluator for arithmetic expressions. The only primitive we added was `expt`

.

In total our primitives so far are: `atom?`

, `null?`

, `first`

, `rest`

, `cond`

, `fn`

, `def`

, `empty?`

,`=`

, `cons`

, `add1,`

, `sub1`

, `one?`

and `expt`

. These are all the functions (and those in the chapters to come) that we’ll need to implement to get our metacircular interpreter working.

*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.

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

Ok – so far we’ve introduced lists [Ch1], we’ve pulled things out of lists [Ch2], we’ve built lists [Ch3] and we’ve assembled a minimal numeric tower[Ch4]. The assumption behind all of these was that we were only reading or making one change at a time. This time we’ll extend our capabilities to handle multiple items. To put it another way – this chapter is all about the ‘find all’ and the ‘replace all’.

We’ll start with some revision – we’ll go back to our old friend `member`

.

(def member? (fn [a lat] (cond (null? lat) false true (or (= (first lat) a) (member? a (rest lat)))) )) (println (member? 'sweet '(potato wedges with sweet chilli sauce))) ; //=> true (println (member? 'sweet '(potato wedges with sweet sweet chilli sauce))) ; //=> true

Now the particular point we’re looking at now is that this function will stop at the first occurrence of `a`

in `lat`

. Now we’ll go back to another old friend `rember`

.

(def rember (fn [ a lat] (cond (null? lat) '() true (cond (= (first lat) a) (rest lat) true (cons (first lat) (rember a (rest lat))))))) (println (rember 'banana '(apple banana orange))) ; //=> (apple orange) (println (rember 'banana '(apple banana banana orange))); //=> (apple banana orange)

Again – the point was that only the first occurrence is dealt with – this chapter is about how we will to address that. So let’s start with `multirember`

:

(def multirember (fn [a lat] (cond (null? lat) '() true (cond (= (first lat) a) (multirember a (rest lat)) true (cons (first lat) (multirember a (rest lat))))))) (println (multirember 'sweet '(potato wedges with sweet sweet chilli sauce))); //=> (potato wedges with chilli sauce)

The main difference is that we keep calling the function until the end of the lat, even if the result is found.

Now let’s do `multiinsertR`

:

(def multiinsertR (fn [new old lat] (cond (null? lat) '() true (cond (= (first lat) old) (cons (first lat) (cons new (multiinsertR new old (rest lat)))) true (cons (first lat) (multiinsertR new old (rest lat))))))) (println (multiinsertR 'hot 'with '(with potato wedges with chilli sauce))); //=> (with hot potato wedges with hot chilli sauce)

Too easy! Now let’s do `multiinsertL`

:

(def multiinsertL (fn [new old lat] (cond (null? lat) '() true (cond (= (first lat) old) (cons new (cons old (multiinsertL new old (rest lat)))) true (cons (first lat) (multiinsertL new old (rest lat))))))) (println (multiinsertL 'with 'hot '(hot potato wedges hot chilli sauce))); //=> (with hot potato wedges with hot chilli sauce)

So a pattern is developing here – which means it’s time for another Commandment. Here Goes. The Sixth commandment states that you Always change at least one argument while recurring. The changing argument(s) should be tested in the termination condition(s) and it should be changed to be closer to termination. For example:

when using `rest`

, test termination with `empty?`

when using `sub1`

, test termination with `zero?`

Ok – so apart from knowing the principles to have confidence in writing recursive code in the future – why else is this relevant? It’s important for building more complex data structures. One of Clojure’s key strengths is that it has lazy functional data structures. Clojure’s data structures are built around this idea of hash-trie. It’s the idea that you can modify a tree structure that is still immutable and performant. The point being – you need to start building blocks for how you think about data structures.

Now we’re going to look at `multisubst`

:

(def multisubst (fn [new old lat] (cond (null? lat) '() true (cond (= (first lat) old) (cons new (multisubst new old (rest lat))) true (cons (first lat) (multisubst new old (rest lat))))))) (println (multisubst 'hot 'sweet '(sweet potato wedges with sweet chilli sauce))); //=> (hot potato wedges with hot chilli sauce)

Now we’re going to do `occur`

which is a bit like the aggregate `count`

function in sql.

(def occur (fn [a lat] (cond (null? lat) 0 true (cond (= (first lat) a) (add1 (occur a (rest lat))) true (occur a (rest lat)))))) (println (occur 'hot '(potato wedges with hot hot hot chilli sauce))); //=> 3

This chapter ends strangely – we digress into an optimisation of the `rempick`

function by adding a new primitive `one?`

:

(def one? (fn [n] (= n 1))) (def rempick (fn [n lat] (cond (null? lat) '() (one? n) (rest lat) true (cons (first lat) (rempick (sub1 n) (rest lat)))))) (println (rempick 4 '(potato wedges with hot chilli sauce))); //=> (potato wedges with chilli sauce)

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. We’ve added one new primitive function: `one? `

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.

**Bringing it Back to Clojure**

So how do we do a `multirember`

in Clojure normally? Here is an online example:

(remove #{:foo} #{:foo :bar}) ;// => (:bar) (remove #{:foo} [:foo :bar]) ;// => (:bar) (remove #{:foo} (list :foo :bar)) ;// => (:bar)

Other functions that apply to other data structures to consider:

(disj #{:foo :bar} :foo) ;// => #{:bar} (dissoc {:foo 1 :bar 2} :foo) ;// => {:bar 2} (pop [:bar :foo]) ;// => [:bar] (pop (list :foo :bar)) ;// => (:bar)

So how is `remove`

implemented in Clojure?

(defn remove [pred coll] (filter (complement pred) coll))

This is more concise – but requires knowledge of the `filter`

and `complement`

functions – which we’ve chosen to exclude to keep a simple set of primitives.

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

You’ll notice that in the first three chapters, we introduced lists [Ch1], then we pulled things out of lists [Ch2], and then we built lists [Ch3]. The bigger principle of the book is to be able to operate on data structures with a minimal set of primitives using the power of recursion and lambdas.

Now we’re driving at the meta-circular interpreter with these principles. We also want to be able to do mathematical operations, and yet still keep a minimal number of primitives. Interestingly enough, we’ll just use `equals`

, `add1`

and `sub1`

and build up to multiplication, division and exponents. So let’s get started!

Our first function is `+_`

(plus) – we’re going to define it terms of add1 and sub1. (We’ll rename the functions with an _ suffix so they don’t clash with the existing clojure definitions of `+`

and `zero?`

(def zero_? (fn [n] (= 0 n))) (def add1 (fn [n] (+ 1 n))) (def sub1 (fn [n] (- n 1))) (def +_ (fn [n m] (cond (zero_? m) n true (add1 (+ n (sub1 m)))))) (println (+_ 1 2))

Now this is kind of frustrating. Why bother doing all this recursion for an operation that is already built into the CPU? Especially when you limit yourself to integers anyway?

This is about making you think about numeric implementations. Part of it is that LISPs generally implement their own ‘numeric tower’ – you can see what fresh thinking has done for Clojure’s ability to handle numbers – particularly irrational fractions.

The other reason is the purity of the metacircular interpreter that you’ll build – you’ll literally be able to count the number of primitives required to build it and have no holes. (There is an assumption that recursion is cheap.)

Our next function is – (minus) which is quite similar to the above:

(def -_ (fn [n m] (cond (zero_? m) n true (sub1 (- n (sub1 m)))))) (println (-_ 2 1))

From here we extend our concept of the `lat`

(a List-ATom) – being a non-nested list of atoms. We extend it to what the book calls a `vec`

, which is a non-nested list of integers.

From here we arrive at [The Fourth Commandment]. This states When recurring on a list of atoms, `lat`

, or a `vec`

, ask two questions about them, and use `(cdr lat)`

or `(cdr vec)`

for the natural recursion.

It then goes on to apply this to lists of numbers as well. It goes on: When recurring on a number, `n`

, ask two questions, and use `(sub1 n)`

for the natural recursion.

Now we get to the `addvec`

function. This is really like a `sum`

function from sql land:

(def addvec (fn [vec] (cond (empty? vec) 0 true (+_ (first vec) (addvec (rest vec)))))) (println (addvec '(1 2 3)))

Next we look at the multiply function `*_`

.

(def *_ (fn [n m] (cond (zero_? m) 0 true (+_ n (*_ n (sub1 m)))))) (println (*_ 4 5))

Again – we’ve built this in terms of our existing primitives.

Now we get onto T*he Fifth Commandment*. I know these could come across as boring and self-righteous. On the other hand, if you write recursive code from scratch (and don’t rely on a library to do it for you) you want to have absolute confidence that it will run and terminate as you expect. These Commandments give you that confidence.

The Fifth Commandment states: When building a value with `+_`

(plus), always use `0`

for the value of the terminating line, for adding 0 does not change the value of an addition.

It goes on to say: when building a value with `*_`

(multiply), always use `1`

for the value of the terminating line, for multiplying by 1 does not change the value of a multiplication.

It then finishes with: when building a value with `cons`

, always consider `()`

for the value of the terminating line.

Now we’ll look at `vec+`

. The big idea is to be able to add two lists of numbers matching each corresponding element in the sum operation. This has uses in matrix operations:

(def vec+ (fn [vec1 vec2] (cond (empty? vec1) vec2 (empty? vec2) vec1 true (cons (+_ (first vec1) (first vec2)) (vec+ (rest vec1) (rest vec2)))))) (println (vec+ '(1 2 3) '(4 5 6)))

Now we’ll look at `>_`

(greater than). We’ll define it in terms of our primitives.

(def >_ (fn [n m] (cond (zero_? n) false (zero_? m) true true (>_ (sub1 n) (sub1 m))))) (println (>_ 10 1)) (println (>_ 1 10))

We’ll reuse this for less-than. It actually turns out remarkably similar:

(def <_ (fn [n m] (cond (zero_? m) false (zero_? n) true true (<_ (sub1 n) (sub1 m))))) (println (>_ 10 1)) (println (>_ 1 10))

Next we’ll define equals:

(def =_ (fn [n m] (cond (>_ n m) false (<_ n m) false true true))) (println "=_") (println (=_ 1 10)) (println (=_ 10 1)) (println (=_ 10 10))

Next we’ll look at exponents:

(def exp (fn [n m] (cond (zero_? m) 1 true (*_ n (exp n (sub1 m)))))) (println (exp 2 3))

Now we’ll start using our numbers functions on atoms and lats – this gets used in our metacircular evaluator later. First we’ll start with length:

(def length (fn [lat] (cond (empty? lat) 0 true (add1 (length (rest lat)))))) (println (length '(pasta with pesto and mushrooms)))

Now we’re going to write a function `pick`

to get an item out of a list using an index.

(def pick (fn [n lat] (cond (empty? lat) '() (zero_? (sub1 n)) (first lat) true (pick (sub1 n) (rest lat))))) (println (pick 3 '(pasta with pesto and mushrooms)))

Now we’re going to extend this to remove an indexed item from a list using `rempick`

:

(def rempick (fn [n lat] (cond (empty? lat) '() (zero_? (sub1 n)) (rest lat) true (cons (first lat) (rempick (sub1 n) (rest lat)))))) (println (rempick 2 '(pasta with pesto and mushrooms)))

Now we’re going to write a function to strip all the numbers out of a list. We’ll cheat a little bit, as we’ll introduce a new primitive function `number?`

. We’ll call our strip function `no-nums`

.

(def no-nums (fn [lat] (cond (empty? lat) '() true (cond (number? (first lat)) (no-nums (rest lat)) true (cons (first lat) (no-nums (rest lat))))))) (println (no-nums '(1 potato 2 potato 3 potato 4)))

This time we’ll flip it over – and write a function to strip out all the non-numbers from the list:

(def all-nums (fn [lat] (cond (empty? lat) '() true (cond (number? (first lat)) (cons (first lat) (all-nums (rest lat))) true (all-nums (rest lat)))))) (println (all-nums '(1 potato 2 potato 3 potato 4)))

Our final function `eqan?`

is our first building block towards rewriting the equals function in terms of our own primitives. This function will get us about half way there:

(def eqan? (fn [a1 a2] (cond (number? a1) (cond (number? a2) (=_ a1 a2) true false) (number? a2) false true (= a1 a2)))) (println (eqan? 1 10)) (println (eqan? 10 1)) (println (eqan? 10 10)) (println (eqan? 'a 'b)) (println (eqan? 'a 'a))

**Conclusion**

This chapter we’ve introduced two new primtives `add1`

and `sub1`

– and used them along with all our existing primitives to build all the functions above.

In total our primitives so far are: `atom?`

, `null?`

, `first`

, `rest`

, `cond`

, `fn`

, `def`

, `empty?`

, `=`

, `cons`

, `add1`

and `sub1`

. These are all the functions (and those in the chapters to come) that we’ll need to implement to get our metacircular interpreter working.

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

The first function we look at is `rember`

.

(def rember (fn [ a lat] (cond (null? lat) '() true (cond (= (first lat) a) (rest lat) true (cons (first lat) (rember a (rest lat))))))) (println (rember 'banana '(apple banana orange)))

The big idea here is list construction. We’re applying the second commandment of the Little Lisper – *use cons to build lists* [sequences].

The next function we look at is `firsts`

.

(def firsts (fn [l] (cond (null? l) '() true (cons (first (first l)) (firsts (rest l)))))) (println (firsts '((large burger)(fries coke)(chocolate sundae))))

Here we also meet the Third Commandment of TLS. This states *when building a list, describe the typical element, and then cons it onto the natural recursion*. This goes back to the discussion on `lat?`

we were having in the previous chapter. You have to identify the base case, and then build on it.

*You can see it working here. *

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

This chapter introduces functions – and the idea of the list of atoms and the `member`

function.

When looking at list atoms, known as a `'lat'`

we are introduced to writing functions in Scheme. We write the `lat?`

function in Clojure to test for a non-nested list of atoms.

(def lat? (fn [l] (cond (null? l) true (and (seq? l) (atom? (first l))) (lat? (rest l)) true false)))

There are a couple of things we’ve transposed here. The key one to raise is the usage of `def... fn[]`

rather than `defn`

. This is a convention in the book, and glues in the readers minds that functions are by default anonymous, and we give them labels after the fact. This enables the reader to get into the feel of passing anonymous functions around later.

The other thing that is introduced here is the application of the Ten Commandments (of The Little Schemer). The big ideas of the 10 Commandments is to help you solve problems recursively. The first one states that you should a*lways ask null? as the first question in expressing any function*. In idiomatic Clojure we would use the

`empty?`

function for this – but for the sake of being closer to the book, we will not apply it in this function, but use `null?`

.The question behind this is *what is a non-nested list of atoms and why do we care*? One of the big themes in this book is solving problems using recursion rather than iteration. The point is that before you can solve a problem using recursion (where you’ve got a nested list) you need to learn to solve it for the base case where there is no nested list. To validate the base case – we use the `lat?`

function.

The next function we look at is the `member?`

function.

(def member? (fn [a lat] (cond (null? lat) false true (or (= (first lat) a) (member? a (rest lat)))) ))

Why do we have this function? It’s the first useful function in the book. We also keep building our recursion skills, and it is a key building block for later functions.

*You can see it working here. *