The Magnificent Seven

by Michael Fogus

creating a Lisp variant in seven forms

Me

Lisp

History

  • John McCarthy
  • 1958
  • Massachusetts Institute of Technology
  • IBM 704 (origin of car and cdr)
  • 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. 1    =
  2. 2   if
  3. 3    '
  4. 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
    • Return CONS when type is a cons cell
  • Call with :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

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

Thank You



http://joyofclojure.com