Immanuel Kant and the Categorical Imperative

Immanuel Kant and the Transcendental Unity of Apperception

The Joy of Scala

Joel vs. Mike

The Magnificent Seven

by Michael Fogus

creating a Lisp variant in seven forms

Who am I?

  • Michael Fogus
  • Software Programmer
  • 12 years experience
  • Lisp, C, CLIPS, Prolog, C++, Java, Jess, Python, Scala, Clojure
  • Co-author of The Joy of Clojure
  • @fogus on the Intertweets

@fogus is very handsome and/or smart.

Baysick®

Baysick example

object EndlessLoop extends Baysick {
  def main(args:Array[String]) = {
    10 PRINT "Haikeeba!"
    20 GOTO 10
    30 END

    RUN
  }
}

Baysick example 2

object Lunar extends Baysick {
  def main(args:Array[String]) = {
    20 LET ('dist := 100)
    30 LET ('v := 1)
    40 LET ('fuel := 1000)
    50 LET ('mass := 1000)
    60 PRINT "You are a in control of a lunar lander, drifting towards the moon."
    80 PRINT "Each turn you must decide how much fuel to burn."
    90 PRINT "To accelerate enter a positive number, to decelerate a negative"
    100 PRINT "Dist " % 'dist % "km, " % "Vel " % 'v % "km/s, " % "Fuel " % 'fuel
    110 INPUT 'burn
    120 IF ABS('burn) <= 'fuel THEN 150
    130 PRINT "You don't have that much fuel"
    140 GOTO 100
    150 LET ('v := 'v + 'burn * 10 / ('fuel + 'mass))
    160 LET ('fuel := 'fuel - ABS('burn))
    170 LET ('dist := 'dist - 'v)
    180 IF 'dist > 0 THEN 100
    190 PRINT "You have hit the surface"
    200 IF 'v < 3 THEN 240
    210 PRINT "Hit surface too fast (" % 'v % ")km/s"
    220 PRINT "You Crashed!"
    230 GOTO 250
    240 PRINT "Well done"
    250 END
    RUN }}

Rave Reviews!

  • "Insane!"
  • "...abuse of the programming facilities"
  • "gratuitous!"
  • "Dumb Specific Language"
  • "I decided to implement a BASIC DSL..."

Lisp

History

  • John McCarthy
  • 1958
  • Massachusetts Institute of Technology (MIT)
  • 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]
  • car
  • cons
  • atom
  • quote
  • cdr
  • cond
  • eq

Had

label and lambda, dynamic scoping [3], lists (kinda)

Didn't Have

closures, macros, numbers

 [2] paulgraham.com/rootsoflisp.html
[3] github.com/fogus/lithp

Building from parts

(label and
  (lambda (and_x and_y)
    (cond (and_x
            (cond (and_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 ())))))

(def append
  (lambda (append_x append_y)
    (cond ((null append_x) append_y)
           (t (cons (car append_x) 
              (append (cdr append_x) append_y))))))

(append (list 1 2) (list 3 4))
;=> (1 2 3 4)

You can see where this is going...

Meta-circular Evaluator

(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

Breathtaking!

Lithp

http://fogus.me/fun/lithp

Fojure™

®

Feajures

  • 7 core fjorms
  • Symbolj
  • Lajy
  • Single immutable data strucjure
  • Funcjional
  • Closures

The Magnificent Seven

  • 1. fn
  • 2. def
  • 3. apply

Path of least resistence

(def CAR (fn [[h & _]] h))
(def CDR  (fn [[_ & t]] t))
(def LST  (fn [& args] args))
(def KONS (fn [h t] (apply LST h t)))

(CAR [1 2 3])
;=> 1

(CDR [1 2 3])
;=> (2 3)

(LST 1 2 3 4)
;=> (1 2 3 4)

(KONS 1 [2 3 4 5])
;=> (1 2 3 4 5)

yawn

The Magnificent Seven

  • 4. if
  • 5. =

A nil-y thing instead

(def NIL ((fn [x y] (if (= x y) x))
           = (= = =)))

NIL
;=> nil

CONS (take 1)

(def CONS
  (fn [h t]
    (fn ([] h)
        ([_] t))))

(def x (CONS CAR (CONS CDR NIL)))

(x)
;=> #<fojure.core$CAR>

(x NIL)
;=> #<fojure.core$CONS$fn>

((x NIL))
;=> #<fojure.core$CDR>

((x NIL) NIL)
;=> nil

A closure over the head and tail

A good start...

FIRST and REST

(def FIRST (fn [s] (s)))
(def REST (fn [s] (s NIL)))

(FIRST x)
;=> #<fojure.core$CAR>

(REST x)
;=> #<fojure.core$CONS$fn>

(FIRST (REST x))
;=> #<fojure.core$CDR>

(REST (REST x))
;=> nil

Closure:

A Poor Man's Object

The Magnificent Seven

  • 6. `

shown as unqualified herein

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

pretty printing

this doesn't count...

(defmethod print-method (class $)
  [f w] 
  (print-method (FIRST f) w)
  (print " ") (print-method '. w) (print " ")
  (print-method (REST f) w))

$
;=> a . b . nil

What does this look like?

Cons Cell

Object:

A Poor Man's Closure

A Protocol for Fojure™ seqs

  • Call with `fojure.core/type to inspect the seq type
    • Return CONS when type is a cons cell
  • Call with `fojure.core/head to get the first element
  • Call with antyhing else to get the rest of the elements

Yet Another 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 $)
;=> b . nil

(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 $)
;=> a . b . nil

(FIRST (SEQ $))
;=> a

(SEQ (REST (REST $)))
;=> nil

APPEND

(def APPEND
  (fn [l r]
    (if (FIRST l)
      (CONS (FIRST l)
            (APPEND (REST l) r))
      r)))

(APPEND (CONS `x nil) (CONS `y (CONS `z NIL)))
;=> x . y . z . nil

(APPEND $ $)
;=> a . b . a . b . nil

But this is not a convenient way to deal with lists

Cons Cells


how quaint

Lists

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))))))

(LIST `a `b `c `d `e `f)
;=> a . b . c . d . e . f . nil

(SEQ (REST (LIST `a)))
;=> nil

(APPEND (LIST `a `b) (LIST `x `y))
;=> a . b . x . y . nil

Using CAR, CDR, and destructuring as the primordial first and rest

Maps

Maps implementation

(defn ASSOC [k v alist]
  (CONS (LIST k v) alist))

(ASSOC `a `foo NIL)
;=> a . foo . nil . nil



(defn GET [k alist]
  (if (SEQ alist)
    (if (= (FIRST (FIRST alist)) k)
      (FIRST (REST (FIRST alist)))
      (GET k (REST alist)))))

(GET `a (ASSOC `a `foo NIL))
;=> foo

Maps implementation (cont)

(defn MAKE-MAP [& kvs]
  (if kvs
    (ASSOC (CAR kvs)
           (CAR (CDR kvs))
           (apply MAKE-MAP (CDR (CDR kvs))))))

(GET `b (MAKE-MAP `a 1 `b 2))
;=> 2

Baby-steps toward EVAL

(defn ATOM? [x]
  (if x
    (if (= (x `type) `CONS)
      NIL
      `TRUTHY)))

(ATOM? (LIST 1 2))
;=> nil

(ATOM? `x)
;=> TRUTHY

EVAL v0.0.1

(defn EVAL [expr binds]
  (if (ATOM? expr)
    (GET expr binds)))


(EVAL `a (MAKE-MAP `a 42 `b 2))
;=> 42

yawn

EVAL v0.1.0

(defn SECOND [s]
  (FIRST (REST s)))


(defn EVAL [expr binds]
  (if (ATOM? expr)
    (GET expr binds)
    (if (ATOM? (FIRST expr))
      (if (= (FIRST expr) `|quote|
        (SECOND expr)))))

(EVAL (LIST `|quote| `a) NIL)
;=> a

(EVAL (LIST `|quote| (LIST `a `b)) NIL)
;=> a . b . nil

☃

EVAL v0.1.5

(defn EVAL [expr binds]
  (if (ATOM? expr)
    (GET expr binds)
    (if (ATOM? (FIRST expr))
      (if (= (FIRST expr) `|quote|)
        (SECOND expr)
        (if (= (FIRST expr) `|atom?|)
          (ATOM? (EVAL (SECOND expr) binds)))))))

(EVAL (LIST `|atom?| (LIST `|quote| `a)) NIL)
; i.e. (|atom?| (QUOTE a))
;=> TRUTHY

(EVAL (LIST `|atom?| `a)
      (MAKE-MAP `a `foo))

;=> TRUTHY

(EVAL (LIST `|atom?| `a)
      (MAKE-MAP `a (LIST `a)))

;=> nil

@fogus just blew my mind!
#clojure

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

((LAZY-SEQ (fn [] (LIST `a `b `c))))
; a . b . c . nil

What is the protocol for LAZY-SEQ?

pretty printing

(defmethod print-method (class (LAZY-SEQ $))
  [f, w] 
  (print-method (FIRST f) w)
  (print " ") (print ". <unrealized>"))

(LAZY-SEQ (fn [] (LIST `a `b `c)))
;=> a . <unrealized>

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 `fojure.core/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))))))))

(MAP keyword (LIST `a `b `c))
;=> :a . <unrealized>

(MAP LIST (LIST `a `b))
;=> a . nil . <unrealized>

(FIRST (MAP LIST (LIST `a `b)))
;=> a . nil

Bindings

  • 7   defmacro

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
    (LIST a b)))

produces...

((fn [a]
   ((fn [b]
      (LIST a b))
    2))
 1)
;=> 1 . 2 . nil

more or less

More LET

(FIRST
  (LET x `a
    (CONS x nil)))

;=> a

(LET x `x
  (LET y `y
    (CONS x (CONS y $))))

; x . y . a . b . nil

And the rest is mechanical

but...

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 6

def   fn   apply   =   if   `   defmacro  

and...

We didn't (really) need defmacro

why not?

EVAL v1.0.0

(defn EVAL [expr binds]
  (if (ATOM? expr)
    (GET expr binds)
    (if (ATOM? (FIRST expr))
      (if (= (FIRST expr) `|quote|)
        (SECOND expr)
        (if (= (FIRST expr) `|atom?|)
          (ATOM? (EVAL (SECOND expr) binds))
          ...
          do defmacro stuff down here
          ...)))))

The Magnificent 5

def   fn   apply   =   if   `   defmacro  

The Magnificent 5!?!

The Garden of Forking Paths

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

Thank You


http://github.com/fogus/fojure