vl_8_1_2015

(ns macros.core
  (:use clojure.walk
        [clojure.algo.monads]))


(defn my-read [foo]
  (let [data (read-string foo)
        result (try (eval data) (catch Throwable t (.getMessage t)))]
    {:input foo
     :read data
     :eval result
     :data-type (class data)
     :eval-type (class result)
     }))

(comment


  ;; Auswertung in Clojure

  ;; Reader: Text -> AST Datenstruktur

  (type (read-string "(cond :foo :bar)"))

  ;; Macroexpansion: AST -> AST
  (macroexpand-all '(cond :foo :bar))

  ;; Evaluation: AST -> Datenstruktur
  (type (eval '(if :foo :bar (cond))))

  ;; Print: Datenstruktur -> Text



  ;; Syntax Quote

  `foo
  (let [x 5] `(inc x))
  (let [x 5] `(inc ~x))
  (let [a (range 5)] `(+ ~@a))
  `(fn [x#] (inc x#))
  (read-string "'(foo bar)")
  (read-string "`(foo bar)")

  ;; Syntax quote von komplexen Strukturen erzeugt Code, der die
  ;; Struktur erzeugt


  ;; Haupteinsatzzweck: Macros
  ;; Aber man kann es auch in normalen Funktionen benutzen



  ;; Einfache Macros in drei Schritten


  ;; 1. Schreibe auf, wie das Resultat für ein Beispiel aussehen soll

  (defmacro ifn [ifn_test ifn_then ifn_else]
    (if ifn_test ifn_else ifn_then))

  (defn foo [x] (ifn (= 0 x) (println :a) (println :b)))

  (foo 1)
  (foo 0)

  (defmacro ifn [ifn_test ifn_then ifn_else]
    (println ifn_test)
    (if ifn_test (println :a) (println :b)))

  (defn foo [x] (ifn (= 0 x) (println :x) (println :y)))

  ;; 2. Benutz den Syntaxquote

  (defmacro ifn [test then else]
    `(if test else then))


  (defn foo [x] (ifn (= 0 x) (println :a) (println :b)))

  ;; 3. Unquote, was ein Parameter ist

  (defmacro ifn [test then else]
    `(if ~test ~else ~then))

  (defn foo [x] (ifn (= 0 x) (println :a) (println :b)))

  (foo 0)
  (foo 1)



  ;; Denk an splice unquote!


  (defmacro whenn [wtest & wbody]
    (if (not wtest) (apply do wbody) nil))

  (defmacro whenn [wtest & wbody]
    `(if (not wtest) (apply do wbody) nil))

  (defmacro whenn [wtest & wbody]
    `(if (not ~wtest) (do ~@wbody) nil))

  (whenn true (println 1) (println 2))
  (whenn false (println 1) (println 2))


  ;; Es ist nicht immer so einfach!

  (defn plus [a b c] (+ a b c))

  (plus 1 2)
  (plus 1 2 3)

  (defn plus' [a] (fn [b c] (+ a b c)))

  (plus' 1)
  ((plus' 1) 2 3)

  ;; Eine n stellige (n>1) Funktion kann man als lambda Ausdruck schreiben,
  ;; der den ersten Parameter als Input nimmt und eine n-1 stellige
  ;; Funktion zurückgibt.

  ;; Das kann man wiederholen

  (defn plus'' [a] (fn [b] (fn [c] (+ a b c))))

  (plus'' 1)
  ((plus'' 1) 2)
  (((plus'' 1) 2) 3)

  ;; Das nennt man currying (selten schönfinkeln)
  ;; In Haskell ist jede Funktion eine Funktion von einem Argument

  ;; Beispiele für Types in Haskell:
  ;; Int -> (Int -> Int)
  ;; [a] -> Int
  ;; (a -> b) -> ([a] -> [b])
  ;; (a -> Bool) -> [a] -> [a]
  ;; (a -> b -> a) -> a -> [b] -> a

  ;; Lesart: (a -> b) -> [a] -> [b] ist eine Funktion, die eine
  ;; einstellige Funktion vom Typ a nach b und eine Liste vom Typ a
  ;; nimmt und eine Liste von typ b liefert.

  ;; Prelude> incr 4
  ;; <interactive>:17:1: Not in scope: `incr'
  ;; Prelude> let incr = (+) 1
  ;; Prelude> incr 4
  ;; 5

  ;; Das nennt man partielle Anwendung.

  ;; In Clojure ist das aus zwei Gründen eher schwierig.

  ;; Welche Gründe sind das?




















  ;; Grund 1: Viele Klammern
  ;; Grund 2: Wann hört man auf?

  ;; Hat ((+ 1) 2) den Wert 3 oder nimmt es noch 12 weitere Argumente?


  (def incr (partial + 1 2 3))
  (incr 4)


  ;; ACHTUNG: Currying und partielle Anwendung hängen zwar zusammen,
  ;; aber sind nicht dasselbe!

  ;; Aber wenn man Currying haben will, dann kann man es bekommen: Macro!


  (defmacro curry
    ([f n] `(curry ~f ~n []))
    ([f n p]
       (if (= 0 n)
         `(~f ~@p)
         (let [x (gensym)] `(fn [~x] (curry ~f ~(dec n) ~(conj p x)))))))


  (def ++++
    (curry + 4))

  (++++ 1)
  ((++++ 1) 2)
  (((++++ 1) 2) 3)
  ((((++++ 1) 2) 3) 4)


  (macroexpand-1 '(curry + 2))
  (macroexpand-1 '(curry + 2 []))
  (macroexpand-1 '(fn [G_3634] (curry + 1 [G_3634])))
  (macroexpand-1 '(curry + 1 [G_3634]))
  (macroexpand-1 '(curry + 0 [G_3634 G_3654]))

  (macroexpand-all '(curry + 3))

  ;; Nochmal Higher Order Funktionen


  (let [a 2
        b (inc a)
        c (* a b)]
    (dec c))

  ;; Was wäre, wenn es kein let gäbe?














  ;; ((fn [a] ... ) 2)
  ;; ((fn [a] ((fn [b] ...) (inc a))   ) 2)
  ((fn [a] ((fn [b] ((fn [c] (dec c)) (* a b))) (inc a))) 2)

  ;; Uarghhhhh!!!!

  ;; Das ist ziemlich hässlich!
  ;; Wie bekommen wir das in die richtige Reihenfolge?

  (defn flip [v f] (f v))

  (flip 4 inc)

  (flip 2 (fn [a]
            (flip (inc a) (fn [b]
                            (flip (* a b) (fn [c] (dec c)))))))

  ;; Umformatieren

  ;; (flip 2       (fn [a]
  ;; (flip (inc a) (fn [b]
  ;; (flip (* a b) (fn [c]
  ;;     (dec c)))))))

  ;; Wir können das mit einem Macro etwas aufhübschen

  (defmacro let-m [[v expr & bindings] expression]
    `(flip ~expr (fn [~v]
                   ~(if (seq bindings)
                      `(let-m ~bindings ~expression)
                      `~expression))))


  (macroexpand-all '(let-m [a 2
                            b (inc a)
                            c (* a b)]
                           (dec c)))

  (let-m [a 2
          b (inc a)
          c (* a b)]
         (dec c))

  ;; Etwas Anderes ... Nicht-Determinismus

  (defn unscharf [x] [(dec x) x (inc x)])

  (unscharf 10)

  ;; Das hier geht nicht :-(
  (let [a (unscharf 10)
        b (unscharf a)
        c (unscharf b)]
    c)

  ;; Das auch nicht ...
  (let [a (unscharf 10)
        b (map unscharf a)
        c (map unscharf b)]
    c)










  ;; Aber so geht es
  (let [a (unscharf 10)
        b (mapcat unscharf a)
        c (mapcat unscharf b)]
    c)

  ;; Warum muss ich jedesmal mapcat schreiben?







  ;; Kann etwas wie let-m helfen?








  ;; Wir geben flip als parameter mit:

  (defmacro let-m' [flip [v expr & bindings] expression]
    `(~flip ~expr (fn [~v]
                    ~(if (seq bindings)
                       `(let-m' ~flip ~bindings ~expression)
                       `~expression))))


  (let-m' flip [a 2
                b (inc a)
                c (* a b)] (dec c))


  (defn flip2 [v f] (mapcat f v))

  (let-m' flip2 [a [(unscharf 10)]
                 b (unscharf a)
                 c (unscharf b)]
          c)

  ;; Das geht noch nicht so ganz ...

  (macroexpand-all '(let-m' flip2 [a [(unscharf 10)]
                                   b (unscharf a)
                                   c (unscharf b)]
                            c))









  ;; (fn* ([c] c)) ist das, was schief geht

  (mapcat (fn [c] c) [1 2 3])

  ;; Die Funktion muss eine Sequenz zurückgeben

  (let-m' flip2 [a (unscharf 10)
                 b (unscharf a)
                 c (unscharf b)]
          [c])


  ;; Das reparieren wir im Macro

  (defmacro do-m [transform prepare [v expr & bindings] expression]
    `(~transform ~expr (fn [~v]
                         ~(if (seq bindings)
                            `(do-m ~transform ~prepare ~bindings ~expression)
                            `(~prepare ~expression)))))


  (do-m flip2 list [a (unscharf 10)
                    b (unscharf a)
                    c (unscharf b)]
        c)

  (do-m flip identity [a 2
                       b (inc a)
                       c (* a b)]
        (dec  c))



  ;; Vergleichen wir doch mal (do-m flip2 list ...)
  ;; mit for

  (for [a (unscharf 10)
        b (unscharf a)
        c (unscharf b)] c)


  ;; do-m mit flip2 und list ist das Gleiche wie for !!!!
  ;; do-m mit flip und identity ist das Gleiche wie let !!!



  ;; Probieren wir mal was ganz Anderes

  (defn half [x]
    (when (even? x) (/ x 2)))

  ;; Komposition geht natürlich wie gewohnt
  (def double-half (comp half half))

  (double-half 20)
  (double-half 10)
  (double-half 5) ;; Autsch

  (def inc-double-half (comp inc half half))

  (inc-double-half 20)
  (inc-double-half 10) ;; Und es kommt noch schlimmer


  ;; OK, schreiben wir es mal so:
  (let [a (half 10)
        b (when a (half a))
        c (when b (half b))]
    c)

  (let [a (half 80)
        b (when a (half a))
        c (when b (half b))]
    c)






  ;; Ein let ... da könnte man doch ...



  (defn safe [v f] (when v (f v)))

  (do-m safe identity [a (half 10)
                       b (half a)
                       c (half b)] c)

  (do-m safe identity [a (half 80)
                       b (half a)
                       c (half b)] c)



  ;; Wir haben hier mit do-m offensichtlich eine ziemlich interessante
  ;; Abstraktion gefunden. Das Verhalten von do-m ist anders, je
  ;; nachdem welches Paar von Funktionen wir verwenden.

  ;; In der Literatur bezeichnet man prepare als return und transform
  ;; als bind (>>=)
  ;; Die Kombination aus bind und return nennt man eine Monade. do-m
  ;; nennt man Monad Comprehension.

  ;; Streng genommen besteht eine Monade aus einen Typkonstruktor, der
  ;; return Funktion und einer Funktion zur Komposition (bind ist nur
  ;; eine Möglichkeit). Der Typkonstruktor spielt in Clojure nur eine
  ;; untergeordnete Rolle.

  ;; Typen:

  ;; inc           : Long -> Long
  ;; half          : Long -> Long | nil
  ;; unscharf      : Long -> [Long]
  ;; (comp seq str): a    -> [Character]

  ;; Die Funktionen nehmen ein Argument vom Typ a und liefern einen
  ;; Wert mit Kontext. Ein Wert mit Kontext heisst monadischer Wert.
  ;; Funktionen, die aus einem normalen Wert einen monadischen Wert
  ;; machen heissen monadische Funktionen.

  ;; Kontext kann zum Beispiel sein, das die Berechnung fehlgeschlagen
  ;; ist oder nicht-deterministisch war. Den Kontext beschreibt man
  ;; mit M. Mit M a wird der im Kontext verpackte Typ a bezeichnet.

  ;; return: a -> M a
  ;; >>= : M a -> (a -> M b) -> M b

  ;; Es gibt verschiedene valide Kombinationen von bind und return,
  ;; die unterschiedliches Verhalten erzeugen.

  ;; Die zwei Funktionen müssen folgende Regeln erfüllen um mit do-m
  ;; zu funktionieren:

  ;; Rechts/Links Identität
  ;; (>>= (return a) f) =  (f a)
  ;; (>>= m return) =  m

  ;; Assoziativität
  ;; (>>= (>>= m f) g) = (>>= m (fn [x] (>>= (f x) g)))


  ;; Ab hier verwenden wir die Bibliothek algo.monades
  ;; do-m heisst domonad
  ;; bind heisst m-bind
  ;; return heisst m-result

  ;; triviale Monade / Identitätsmonade (let)
  (domonad identity-m [a 3
                       b (+ a 4)
                       c (* a b)] c)

  ;; Sequence Monad/ Listmonad (for)
  (domonad sequence-m [a (unscharf 10)
                       b (unscharf a)
                       c (unscharf b)] c)

  ;; Maybe Monad
  (domonad maybe-m [a 20
                    b (half a)
                    c (half b)] c)

  (domonad maybe-m [a 10
                    b (half a)
                    c (half b)] c)


  ;; Wenn es identity-m nicht gäbe:

  (defmonad trivial-m
    [m-result identity
     m-bind (fn [mv f] (f mv))])

  (domonad trivial-m [a 3
                      b (+ a 4)
                      c (* a b)] c)


  ;; Der erste Parameter ist eine Map mit der bind und return  Funktion
  trivial-m

  (macroexpand-all '(defmonad trivial-m
                      [M-result identity
                       m-bind (fn [mv f] (f mv))]))






  ;; Legen wir noch ein Brikett nach: state-m

  ;; Ziel: stateful calculations
  ;;       in einem puren Kontext
  ;;       ausführen


  ;; public int incX() {
  ;;   x = x + 1;
  ;;   return x;
  ;; }

  ;; public int foo() {
  ;;   int r = incX()
  ;;   int t = incX()
  ;;   return t;
  ;; }

  ;; Beobachtung 1: Der Rückgabewert hängt vom Ausführungskontext ab
  ;; Beobachtung 2: Der Kontext wird geändert

  ;;  {:x 4} -> int r = incX() -> {:x 5 :r 5} ->
  ;;            int t = incX() -> {:x 6 :r 5 :t 6} ->
  ;;            return t -> {:x 6}

  ;; Die State Monade kann in solchen Situationen nützlich sein

  ;; == Monadischer Wert der State Monade:
  ;; Ist eine Funktion, die einen Zustand nimmt und ein Tupel aus
  ;; einem Wert und einem Folgezustand zurückgibt

  (defn x++ []
    (fn [{x :x :as env}] (let [x' (inc x)
                              env' (assoc env :x x')]
                          [x' env'])))

  ;; x++ ist eine monadische Funktion
  ;; (x++) ist ein monadischer Wert

  ((x++) {:x 4})

  (defn state-return [v] (fn [env] [v env]))

  ((state-return 5) 22)

  (defn state-bind [mv f]
    (fn [env]
      (let [ [v ss] (mv env)
             next-mv (f v)]
        (next-mv ss))))

  ((domonad state-m [r (x++) t (x++)] [r t]) {:x 4})

  ;; domonad desugaring

  ((domonad state-m [r (x++) t (x++)] [r t]) {:x 4})

  ((state-bind (x++) (fn [r]
                       (state-bind (x++) (fn [t]
                                           (state-return t))))) {:x 4})

  ((state-bind (x++) (fn [r]
                       (state-bind (x++) (fn [t]
                                           (fn [env] [t env]))))) {:x 4})

  ((state-bind (x++) (fn [r]
                       (fn [e1] (let [[v ss] ((x++) e1)
                                     nmv ((fn [t] (fn [env] [t env])) v)]
                                 (nmv ss))))) {:x 4})

  (fn [e0] (let [[v0 ss0] ((x++) e0)
                nmv0 ((fn [r]
                        (fn [e1] (let [[v ss] ((x++) e1)
                                      nmv ((fn [t] (fn [env] [t env])) v)]
                                  (nmv ss)))) v0)]
            (nmv0 ss0)))



  ((fn [e0] (let [[v0 ss0] ((x++) e0)
                 nmv0 ((fn [r]
                         (fn [e1] (let [[v ss] ((x++) e1)
                                       nmv ((fn [t] (fn [env] [t env])) v)]
                                   (nmv ss)))) v0)]
             (nmv0 ss0))) {:x 4})




  ;; Zur Erinnerung:

  ;; public int foo() {
  ;;   int r = incX()
  ;;   int t = incX()
  ;;   return t;
  ;; }

  (def foo
    (domonad state-m [r (x++) t (x++)] t))

  foo

  (foo {:x 4})

  (def tripple-foo (domonad state-m [a foo b foo c foo] c))

  (tripple-foo {:x 4})


  ;; Weitere nützliche Funktionen
  (defn get-from-env [k]
    (fn [env] [(env k) env]))

  ((get-from-env :x) {:x 6 :y 7})

  (defn update-in-env [k f]
    (fn [env] (let [ov (env k)]
               [ov (assoc env k (f ov))])))

  ((update-in-env :x inc) {:x 6 :y 7})

  (defn set-in-env [k v]
    (fn [env] (let [ov (env k)]
               [ov (assoc env k v)])))

  ((set-in-env :x 99) {:x 6 :y 7})

  ;; in algo monads gibt es die drei
  ;; Funktionen schon

  ;; get-from-env = fetch-val
  ;; update-in-env = update-val
  ;; set-in-env = set-val


  ;; Auch ziemlich nützlich: lifting
  (+ 5 nil)
  (def +m (with-monad maybe-m (m-lift 2 +)))
  (+m 2 4)
  (+m 5 nil)

  (+ [1 5] [2 4 5])
  (def +s (with-monad sequence-m (m-lift 2 +)))
  (+s [1 2] [1 2 3])

  (def +s2 (with-monad sequence-m (m-lift 1 inc)))
  (+s2 [1 2 3])


  (defn ++ [k]
    (domonad state-m
             [x  (fetch-val k)
              x' ((m-lift 1 inc) (m-result x))
              _  (set-val k x')]
             x'))

  ((++ :y) {:x 5 :y 3})

  ((domonad state-m [_ (++ :x)
                     _ (++ :y)
                     c (++ :x)] c)
   {:x 2 :y 5})


  ;; Monaden Transformer
  (+s [1 2] [1 2 3])

  ;; Was passiert wenn nil auftaucht?
  (+s [1 2 4] nil)
  (+s [1 2] [1 nil 3])

  (def sequence-maybe-m (sequence-t maybe-m))
  (def +sm (with-monad sequence-maybe-m (m-lift 2 +)))
  (+sm [1 2 4] nil)
  (+sm [1 2] [1 nil 3])

  (def maybe-sequence-m (maybe-t sequence-m))
  (def +ms (with-monad maybe-sequence-m (m-lift 2 +)))
  (+ms [1 2] [1 nil 3])
  (+ms [1 2 4] nil)

  (def maybe-sequence-maybe-m (-> maybe-m sequence-t maybe-t))
  (def +msm (with-monad maybe-sequence-maybe-m (m-lift 2 +)))

  (+msm [1 2] [1 nil 3])
  (+msm [1 2] nil)

  ;; Whut ???
  (def sequence-sequence-m (sequence-t sequence-m))
  (def +ss (with-monad sequence-sequence-m (m-lift 2 +)))
  (+ss [[1 2] [3 4]] [[-1 0 1]])

  ;; Maybe?
  (def maybe-sequence-sequence-m (-> sequence-m sequence-t maybe-t))

  ;; etc...

  ;; Aus einem meiner Projekte:
  (def wd-state-m (maybe-t state-m))



  )