The Magnificent Seven by Michael Fogus creating a Lisp variant in seven forms

Lisp

History John McCarthy

1958

Massachusetts Institute of Technology

IBM 704 (origin of car and cdr )

and ) Recursive Functions of Symbolic Expressions and Their Computation by Machine, Part I[1] [1] http://www-formal.stanford.edu/jmc/recursive.html

Lisp Innovations Dynamic types

Garbage collection

if-then-else (via cond )

) Tree data structures

Homoiconicity...

McCarthy's

Magnificent Seven

McCarthy's Seven [2] atom

car

cdr

cons cond

quote

eq Had label , lambda , dynamic scoping [3], lists (kinda), recursion Didn't Have closures, macros, numbers [2] paulgraham.com/rootsoflisp.html

[3] github.com/fogus/lithp

Building from parts (label and (lambda (x y) (cond (x (cond (y t) (t nil))) (t nil)))) (and t nil) ;=> nil (and t t) ;=> t

Building from parts (continued) (label list (lambda (x y) (cons x (cons y (quote ()))))) (label null (lambda (x) (eq x (quote ())))) (label append (lambda (x y) (cond ((null x) y) (t (cons (car x) (append (cdr x) y)))))) (append (list 1 2) (list 3 4)) ;=> (1 2 3 4) You can see where this is going...

Meta-circular Evaluator FTW (def eval (lambda (expr binds) (cond ((atom expr) (assoc expr binds)) ((atom (car expr)) (cond ((eq (car expr) (quote quote)) (cadr expr)) ((eq (car expr) (quote atom)) (atom (eval (cadr expr) binds))) ((eq (car expr) (quote eq)) (eq (eval (cadr expr) binds) (eval (caddr expr) binds))) ((eq (car expr) (quote car)) (car (eval (cadr expr) binds))) ((eq (car expr) (quote cdr)) (cdr (eval (cadr expr) binds))) ((eq (car expr) (quote cons)) (cons (eval (cadr expr) binds) (eval (caddr expr) binds))) ((eq (car expr) (quote cond)) (eval-cond (cdr expr) binds)) (t (eval (cons (assoc (car expr) binds) (cdr expr)) binds)))) ((eq (caar expr) (quote def)) (eval (cons (caddar expr) (cdr expr)) (cons (list (cadar expr) (car expr)) binds))) ((eq (caar expr) (quote lambda)) (eval (caddar expr) (append (pair (cadar expr) (eval-args (cdr expr) binds)) binds))) (t (assoc expr binds))))) note: not all code shown

Meta-circular Evaluator (cont) (eval (quote (car a)) (quote ((a (1st 2nd 3rd))))) ;=> 1st (eval (quote (cdr a)) (quote ((a (1st 2nd 3rd))))) ;=> (2nd 3rd) (eval (quote (fun (quote 1st) nil)) (quote ((fun cons) (nil ())))) ;=> (1st) (eval (quote (cons (quote 1st) (cons (quote 2nd) nil))) (quote ((nil ()) (c nil)))) ;=> (1st 2nd)

Breathtaking!

Fojure

Feajures 7 core funcjions and 2 spejial fjorms

Symbolj

Lajy

Single immutable data strucjure

Funcjional

Lexical Scopjure

Closures

The Magnificent Seven fn

def

No Need For car and cdr (def CAR (fn [[h & _]] h)) (def CDR (fn [[_ & t]] t)) (CAR [1 2 3]) ;=> 1 (CDR [1 2 3]) ;=> (2 3)

Wait! What?!? I never mentioned anything about vectors

No Need For cons (def CONS (fn [h t] (fn ([] h) ([_] t)))) (CONS 1 (CONS 2 (CONS 3 nil))) ;=> #<user$CONS$fn__85 user$CONS$fn__85@445e228> A closure over the head and tail A good start...

Closure: A Poor Man's Object

Closure Dissection (def CONS (fn [h t] (fn ([] h ) ([_] t )) )) A closure head tail A closure is an Object with a single method .apply(...)

The New first and rest (def FIRST (fn [s] (s))) (def REST (fn [s] (s nil))) (def a (CONS 1 (CONS 2 (CONS 3 nil)))) (FIRST a) ;=> 1 (REST a) ;=> #<user$CONS$fn__85 user$CONS$fn__85@375e293a> (FIRST (REST a)) ;=> 2

Saplings 1 = 2 if 3 ' 4 :keywords

Yet Another CONS (def CONS (fn [h t] (fn [d] (if (= d :type) 'CONS (if (= d :head) h t))))) (def $ (CONS 'a (CONS 'b nil))) ;=> #<user$CONS$fn__4 user$CONS$fn__4@61578aab> ($ :type) ;=> CONS ($ :head) ;=> a (($ :tail) :head) ;=> b Now what does this look like?

Cons Cell

Object: A Poor Man's Closure

A Protocol for seqs Call with :type to inspect the seq type

to inspect the seq type Return CONS when type is a cons cell

when type is a cons cell Call with :head to get the head

to get the head Call with antyhing else to get the tail

first and rest (def FIRST (fn [x] (if x (if (= (x :type) 'CONS) (x :head) (if (x) ((x) :head)))))) (def REST (fn [x] (if x (if (= (x :type) 'CONS) (x :tail) (if (x) ((x) :tail)))))) (FIRST $) ;=> a (REST $) ;=> #<user$CONS$fn__17 user$CONS$fn__17@2eb0a3f5> (FIRST (REST $)) ;=> b

We can do a ton with only CONS , FIRST and REST !

seq (def SEQ (fn [x] (if x (if (= (x :type) 'CONS) x (if (x) (SEQ (x))))))) (SEQ $) ;=> #<user$CONS$fn__97 user$CONS$fn__97@293b9fae> (FIRST (SEQ $)) ;=> a (SEQ (REST (REST $))) ;=> nil

prn (def PRN (fn [s] (if (SEQ s) (do (print (FIRST (SEQ s))) (print " ") (recur (REST s))) (println)))) (PRN $) ; a b (PRN (CONS 'a nil)) ; a This doesn't count

append (def APPEND (fn app [l r] (if (FIRST l) (CONS (FIRST l) (app (REST l) r)) r))) (PRN (APPEND (CONS 'x nil) (CONS 'y (CONS 'z nil)))) ; x y z But this is not a convenient way to deal with lists

Lists 5 apply

list (def LIST (fn ls ([h] (CONS h nil)) ([h t] (CONS h (CONS t nil))) ([h m & [f & r]] (if (CAR r) (if (CAR (CDR r)) (APPEND (LIST h m) (apply ls f (CAR r) (CDR r))) (APPEND (LIST h m) (LIST f (CAR r)))) (CONS h (LIST m f)))))) (PRN (LIST 'a 'b 'c 'd 'e 'f)) ; a b c d e f (SEQ (REST (LIST 'a))) ;=> nil (PRN (APPEND (LIST 'a 'b) (LIST 'x 'y))) ; a b x y Using CAR , CDR , and destructuring as the primordial first and rest

Being Lazy

Being Lazy TODO

Lazy seqs

Lazy seq (def LAZY-SEQ (fn [f] (fn ([x] (if (= x :type) 'LAZY-SEQ)) ([] (f))))) (FIRST ((LAZY-SEQ (fn [] (LIST 'a 'b 'c))))) ;=> a (PRN ((LAZY-SEQ (fn [] (LIST 'a 'b 'c))))) ; a b c Now we have a protocol for lazy seqs

A Protocol for lazy seqs Wrap the part that you want to be lazy in a fn

Pass that fn to LAZY-SEQ

Conform to the semantics of :type

Deal with the extra level of indirection when dealing with lazy seqs

map (def MAP (fn [f s] (LAZY-SEQ (fn [] (if (SEQ s) (CONS (f (FIRST s)) (MAP f (REST s)))))))) (PRN (MAP keyword (LIST 'a 'b 'c))) ; :a :b :c (PRN (MAP LIST (LIST 'a 'b))) ; #<user$CONS$fn__356 user$CONS$fn__356@54cb2185> ... (PRN (FIRST (MAP LIST (LIST 'a 'b)))) ; a

Bindings 6 defmacro

7 `

let (let [a 1] (let [b 2] (println [a b])) (println [a b])) ; java.lang.Exception: Unable to resolve symbol: b in this context Defines a scope for named values

LET (defmacro LET [[bind val] & body] `((fn [~bind] ~@body) ~val)) (LET (a 1) (LET (b 2) (println [a b]))) produces... ((fn [a] ((fn [b] (println [a b])) 2)) 1) more or less

More LET (FIRST (LET (x 'a) (CONS x nil))) ;=> a (PRN (LET (x 'x) (LET (y 'y) (CONS x (CONS y $))))) ; x y a b

And the rest is mechanical

but...

We didn't need keywords...

Symbols would have worked just as well (def CONS (fn [a b] (fn ([x] (if (= x 'lazy) 'CONS (if (= x 'head) a b)))))) (def $$ (CONS 'a (CONS 'b nil))) ($$ 'head) ;=> a ($$ 'tail) ;=> #<user$CONS$fn__91 user$CONS$fn__91@58e22f2b>

The Magnificent 6 = if ' :keywords apply defmacro `

and...

We didn't need apply ...

defmacro gives us that for free (defmacro APPLY [f args] `(~f ~@args)) (APPLY + [1 2 3 4]) ;=> 10 (PRN (APPLY LIST '[a b c d e])) ; a b c d e

The Magnificent 5 = if ' :keywords apply defmacro `

and...

We didn't need defmacro and ` ... why not?

Meta-circular Evaluator FTW (def EVAL (fn (expr binds) (COND ((ATOM expr) (ASSOC expr binds)) ((ATOM (FIRST expr)) (COND ((= (FIRST expr) 'quote) (SECOND expr)) ((= (FIRST expr) 'ATOM) (ATOM (EVAL (SECOND expr) binds))) ((= (FIRST expr) '=) (= (EVAL (SECOND expr) binds) (EVAL (THIRD expr) binds))) ((= (FIRST expr) 'FIRST) (FIRST (EVAL (SECOND expr) binds))) ((= (FIRST expr) 'REST) (REST (EVAL (SECOND expr) binds))) ((= (FIRST expr) 'CONS) (CONS (EVAL (SECOND expr) binds) (EVAL (THIRD expr) binds))) ((= (FIRST expr) 'COND) (EVAL-COND (REST expr) binds)) ('true (EVAL (CONS (ASSOC (FIRST expr) binds) (REST expr)) binds)))) ((= (CAAR expr) 'def) (EVAL (CONS (CADDAR expr) (REST expr)) (CONS (LIST (CADAR expr) (FIRST expr)) binds))) ((= (CAAR expr) 'fn) (EVAL (CADDAR expr) (APPEND (PAIR (CADAR expr) (EVAL-ARGS (REST expr) binds)) binds))) ('true (ASSOC expr binds))))) note: not all code shown

The Magnificent 3 = if ' :keywords apply defmacro `

The Magnificent 3!?!

Our Options deftype defprotocol reify intern . defmulti defmethod defrecord first rest [] ^ {} delay force new defclass proxy list* fn* fn? seq clojure.lang.RT and so on...

The Garden of Forking Paths