Pattern matching compiler now generates optimized code.

4 files changed, 481 insertions, 536 deletions

diff --git a/src/lang.clj b/src/lang.clj
index 4dd8e159c..5e4316db4 100644
--- a/src/lang.clj
+++ b/src/lang.clj
@@ -6,11 +6,6 @@
                   [compiler :as &compiler])
             :reload))
 
-(defn write-file [file data]
-  (with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. file))]
-    ;; (prn 'write-file 'file file 'stream stream 'data data)
-    (.write stream data)))
-
 (comment
   ;; TODO: Add macros.
   ;; TODO: Re-implement compiler in language.
@@ -32,28 +27,6 @@
   ;; TODO: 
   ;; TODO: 
 
-  (let [test '([:lang.parser/case-branch [:lang.parser/variant "Nil" ()]
-                [:lang.parser/ident "yx"]]
-                 [:lang.parser/case-branch [:lang.parser/variant "Cons" ([:lang.parser/ident "x"] [:lang.parser/ident "xs*"])]
-                  [:lang.parser/variant "Cons" ([:lang.parser/ident "x"] [:lang.parser/fn-call [:lang.parser/ident "++"] ([:lang.parser/ident "xs*"] [:lang.parser/ident "ys"])])]])
-        convert (fn [cases]
-                  (list (reduce (fn [acc [_ shape body]]
-                                  (clojure.core.match/match shape
-                                    [::&parser/variant ?tag ?elems]
-                                    (let [=elems (map (fn [elem]
-                                                        (clojure.core.match/match elem
-                                                          [::&parser/ident ?ident]
-                                                          [::ident ?ident]))
-                                                      ?elems)]
-                                      (conj acc [?tag =elems body]))))
-                                []
-                                cases)))]
-    (convert test))
-
-  (enumerate (list (list '["Nil" [] branch-0]
-                         '["Cons" [x xs*] branch-1])))
-  
-  
   (let [source-code (slurp "test2.lang")
         tokens (&lexer/lex source-code)
         ;; _ (prn 'tokens tokens)
@@ -64,249 +37,171 @@
         class-data (&compiler/compile "test2" ann-syntax)
         ;; _ (prn 'class-data class-data)
         ]
-    (write-file "test2.class" class-data))
+    (with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. "test2.class"))]
+      (.write stream class-data)))
 
   ;; jar cvf test2.jar *.class test2 && java -cp "test2.jar" test2
   )
 
 (comment
-
-  (let [data '([::&parser/case-branch [::&parser/variant "Nil" ()]
-                [::&parser/ident "ys"]]
-                 [::&parser/case-branch [::&parser/variant "Cons" ([::&parser/ident "x"] [::&parser/ident "xs*"])]
-                  [::&parser/variant "Cons" ([::&parser/ident "x"] [::&parser/fn-call [::&parser/ident "++"] ([::&parser/ident "xs*"] [::&parser/ident "ys"])])]])
-        ;; count-registers (fn count-registers [pattern]
-        ;;                   (clojure.core.match/match pattern
-        ;;                     [::&parser/ident _]
-        ;;                     0
-        
-        ;;                     [::&parser/variant _ ?members]
-        ;;                     (reduce + (count ?members) (map count-registers ?members))))
-        gen-impl (fn gen-impl [offset pattern]
-                   (clojure.core.match/match pattern
-                     [::&parser/ident _]
-                     [1 [::case-bind -1 offset]]
+  ;; (let [branches '([::&parser/case-branch [::&parser/variant "Cons" ([::&parser/variant "Symbol" ([::&parser/string "~"])] [::&parser/variant "Cons" ([::&parser/ident "unquoted"] [::&parser/variant "Nil" ()])])] [::&parser/variant "Cons" ([::&parser/ident "unquoted"] [::&parser/fn-call [::&parser/ident "template"] ([::&parser/ident "tail"])])]]
+  ;;                    [::&parser/case-branch [::&parser/variant "Cons" ([::&parser/variant "Symbol" ([::&parser/string "~@"])] [::&parser/variant "Cons" ([::&parser/ident "spliced"] [::&parser/variant "Nil" ()])])] [::&parser/variant "Cons" ([::&parser/variant "Symbol" ([::&parser/string "++"])] [::&parser/variant "Cons" ([::&parser/ident "spliced"] [::&parser/fn-call [::&parser/ident "template"] ([::&parser/ident "tail"])])])]]
+  ;;                      [::&parser/case-branch [::&parser/ident "_"] [::&parser/variant "Cons" ([::&parser/ident "head"] [::&parser/fn-call [::&parser/ident "template"] ([::&parser/ident "tail"])])]])
+  ;;       ;; Step 1: Get all vars
+  ;;       get-vars (fn get-vars [pattern]
+  ;;                  (clojure.core.match/match pattern
+  ;;                    [::&parser/ident ?name]
+  ;;                    (list ?name)
                      
-                     [::&parser/variant ?tag ?members]
-                     (let [regs+insns (mapv (fn [idx member]
-                                              (clojure.core.match/match member
-                                                [::&parser/ident _]
-                                                [1 [::case-sub-bind (+ offset (inc idx))]]))
-                                            (range (count ?members))
-                                            ?members)]
-                       [(reduce + 1 (map first regs+insns)) [::case-try ?tag (mapv second regs+insns)]])
-                     (reduce + (count ?members) (map gen-impl ?members))))]
-    (reduce (fn [accum branch]
-              (clojure.core.match/match branch
-                [::&parser/case-branch ?pattern ?body]
-                (clojure.core.match/match ?pattern
-                  [::&parser/variant ?tag ?members]
-                  (let [[extra-registers impl] (gen-impl 0 ?pattern)
-                        _ (prn 'impl extra-registers impl)
-                        $branch (get-in accum [:paths :total])]
-                    (-> accum
-                        (update-in [:patterns]
-                                   (fn [patterns]
-                                     (if (contains? patterns ?tag)
-                                       (if (= (get patterns [?tag :arity]) (count ?members))
-                                         (update-in patterns [?tag :branches] conj {:test impl
-                                                                                    :link $branch})
-                                         (assert "Pattern arity doesn't match!"))
-                                       (assoc patterns ?tag {:arity (count ?members)
-                                                             :branches [{:test impl
-                                                                         :link $branch}]}))))
-                        (update-in [:paths]
-                                   (fn [paths]
-                                     (-> paths
-                                         (update-in [:total] inc)
-                                         (assoc-in [:links $branch] ?body))))
-                        (update-in [:registers] + (dec extra-registers)))))
-                ))
-            {:registers 1
-             :patterns {}
-             :paths {:total 0
-                     :links {}}}
-            data))
+  ;;                    [::&parser/variant ?tag ?members]
+  ;;                    (mapcat get-vars ?members)
+
+  ;;                    [::&parser/string ?text]
+  ;;                    '()))
+  ;;       vars+body (for [branch branches]
+  ;;                   (clojure.core.match/match branch
+  ;;                     [::&parser/case-branch ?pattern ?body]
+  ;;                     [(get-vars ?pattern) ?body]))
+  ;;       ;; _ (prn 'vars+body vars+body)
+  ;;       max-registers (reduce max 0 (map (comp count first) vars+body))
+  ;;       ;; _ (prn 'max-registers max-registers)
+  ;;       ;; Step 2: Analyse bodies
+  ;;       ;; all-analysis (map (fn [[vars body]]
+  ;;       ;;                     (reduce #(with-local %2 [::&type/object "java.lang.Object" []] %1)
+  ;;       ;;                             (analyse-form* body)
+  ;;       ;;                             (reverse vars)))
+  ;;       ;;                   vars+body)
+  ;;       ;; Step 3: Extract bodies
+  ;;       [_ branch-mappings branches*] (reduce (fn [[$link links branches*] branch]
+  ;;                                               (clojure.core.match/match branch
+  ;;                                                 [::&parser/case-branch ?pattern ?body]
+  ;;                                                 [(inc $link) (assoc links $link ?body) (conj branches* [::&parser/case-branch ?pattern $link])]))
+  ;;                                             [0 {} []]
+  ;;                                             branches)
+  ;;       ;; Step 4: Pattens -> Instructions
+  ;;       ;; ->instructions (fn ->instructions [locals pattern]
+  ;;       ;;                  (clojure.core.match/match pattern
+  ;;       ;;                    [::&parser/variant ?tag ?members]
+  ;;       ;;                    [::pm-variant ?tag (map (partial ->instructions locals) ?members)]
+                           
+  ;;       ;;                    [::&parser/ident ?name]
+  ;;       ;;                    [::pm-local (get locals ?name)]
+                           
+  ;;       ;;                    [::&parser/string ?text]
+  ;;       ;;                    [::pm-text ?text]
+  ;;       ;;                    ))
+  ;;       ;; $scope 0 ;; scope-id
+  ;;       ;; $local 11 ;; next-local-idx
+  ;;       ;; branches** (for [[branch branch-vars] (map vector branches* (map first vars+body))
+  ;;       ;;                  :let [[_ locals] (reduce (fn [[$local =locals] $var]
+  ;;       ;;                                             [(inc $local) (assoc =locals $var [::local $scope $local])])
+  ;;       ;;                                           [$local {}] branch-vars)]]
+  ;;       ;;              (clojure.core.match/match branch
+  ;;       ;;                [::&parser/case-branch ?pattern ?body]
+  ;;       ;;                [(->instructions locals ?pattern) ?body]))
+  ;;       ;; _ (prn branches**)
+  ;;       ;; Step 5: Re-structure branching
+  ;;       ]
+  ;;   ;; [branch-mappings branches**]
+  ;;   branches*)
 
-  '([::&parser/case-branch [::&parser/variant "Nil" ()]
-     [::&parser/ident "ys"]]
-    [::&parser/case-branch [::&parser/variant "Cons" ([::&parser/ident "x"] [::&parser/ident "xs*"])]
-     [::&parser/variant "Cons" ([::&parser/ident "x"] [::&parser/fn-call [::&parser/ident "++"] ([::&parser/ident "xs*"] [::&parser/ident "ys"])])]])
-
-  '([:try "Nil" []]
-    [:try "Cons" [[:bind 0 1] [:bind 1 2]]])
   
-  (list '["Nil" [] branch-0]
-        '["Cons" [x xs*] branch-1])
-
-  [:if [% tag "Nil"]
-   branch-0
-   [:let [%0 %1]
-    branch-1]]
   
-  (let [enumerate (fn [xs] (map vector (range (count xs)) xs))
-        cases (enumerate (list (list '["Nil" [] branch-0]
-                                     '["Cons" [x xs*] branch-1])))
-        classify-cases (fn [[idx cases]]
-                         [idx (reduce (fn [order [tag members branch]]
-                                        (if-let [{:keys [arity branches] :as sub-struct} (get order tag)]
-                                          (if (= arity (count members))
-                                            (update-in order [tag :branches] conj [members branch])
-                                            (assert (str "Arity doesn't match:" (count members) " != " arity)))
-                                          (assoc order tag {:arity (count members)
-                                                            :branches (vector [members branch])})))
-                                      {}
-                                      cases)])
-        ;; case->struct (fn [cases]
-        ;;                (let [struct (classify-case cases)
-        ;;                      struct* (seq struct)]
-        ;;                  (reduce (fn [inner [tag {:keys [arity branches]}]]
-        ;;                            [:if [% tag "Nil"]
-        ;;                             branch-0
-        ;;                             inner])
-        ;;                          (second (last struct*))
-        ;;                          (butlast struct*))
-        ;;                  ))
-        ]
-    ;; (classify-case cases)
-    (let [;; separated (apply map list cases)
-          classifications (map classify-cases cases)
-          classifications* (sort-by first > classifications)]
-      ((fn [[idx struct]]
-         (prn idx struct)
-         (if-let [default (get struct nil)]
-           (reduce (fn [[dbinds dbranch] [tag [binds branch]]]
-                     [:if tag
-                      [:let binds
-                       branch]
-                      [:let dbinds
-                       dbranch]])
-                   (-> default :branches first)
-                   (seq struct))
-           (let [struct* (seq struct)]
-             (reduce (fn [[dbinds dbranch] [tag sub-struct]]
-                       (let [[binds branch] (-> sub-struct :branches first)]
-                         [:if tag
-                          [:let binds
-                           branch]
-                          [:let dbinds
-                           dbranch]]))
-                     (-> struct* last second :branches first)
-                     (butlast struct*)))))
-       (first classifications*))
-      ))
 
-  ;; ([0 {"Cons" {:arity 2, :branches [[[x xs*] branch-1]]}, "Nil" {:arity 0, :branches [[[] branch-0]]}}])
   
+  ;; (let [data '([[:lang/pm-variant "Cons" ([:lang/pm-variant "Symbol" ([:lang/pm-text "~"])]  [:lang/pm-variant "Cons" ([:lang/pm-local [:lang/local 0 11]] [:lang/pm-variant "Nil" ()])])] 0]
+  ;;                [[:lang/pm-variant "Cons" ([:lang/pm-variant "Symbol" ([:lang/pm-text "~@"])] [:lang/pm-variant "Cons" ([:lang/pm-local [:lang/local 0 11]] [:lang/pm-variant "Nil" ()])])] 1]
+  ;;                  [[:lang/pm-local [:lang/local 0 11]] 2])
+  ;;       classify-outer (fn [struct [branch $body]]
+  ;;                        (clojure.core.match/match branch
+  ;;                          [::pm-variant ?tag ?members]
+  ;;                          (update-in struct [:cases ?tag] conj {:members ?members
+  ;;                                                                :body $body})
+                           
+  ;;                          [::pm-text ?text]
+  ;;                          (update-in struct [:tests] conj {:test [::text ?text]
+  ;;                                                           :body $body})
+
+  ;;                          [::pm-local ?binding]
+  ;;                          (assoc struct :default {:storage ?binding
+  ;;                                                  :body $body})))
+  ;;       outer-classification (reduce classify-outer
+  ;;                                    {:cases {}
+  ;;                                     :tests '()
+  ;;                                     :default nil}
+  ;;                                    data)
+  ;;       full-classifier (fn full-classifier [global]
+  ;;                         (prn 'full-classifier global)
+  ;;                         (let [subcases (:cases global)]
+  ;;                           (if (empty? subcases)
+  ;;                             global
+  ;;                             (let [crossed (sort (fn [x1 x2] (> (-> x1 second :cases count) (-> x2 second :cases count)))
+  ;;                                                 (for [[tag subs] subcases
+  ;;                                                       :let [_ (prn 'subcases tag subs)]
+  ;;                                                       :let [parts (for [cross (apply map list (map :members subs))
+  ;;                                                                         :let [_ (prn 'cross tag cross)]
+  ;;                                                                         ;; :let [_ (prn '(map :body subs) (map :body subs))]
+  ;;                                                                         ;; :let [_ (prn (class cross)            (count cross)
+  ;;                                                                         ;;              (class (map :body subs)) (count (map :body subs)))]
+  ;;                                                                         :let [cross+ (map vector cross (map :body subs))]
+  ;;                                                                         ;; :let [_ (prn 'cross+ tag (class cross+) (count cross+))]
+  ;;                                                                         ;; :let [_ (prn 'cross+ tag cross+)]
+  ;;                                                                         :let [cross++ (reduce classify-outer
+  ;;                                                                                               {:cases {}
+  ;;                                                                                                :tests '()
+  ;;                                                                                                :default nil}
+  ;;                                                                                               cross+)]
+  ;;                                                                         ;; :let [_ (prn 'cross++ tag cross++)]
+  ;;                                                                         ]
+  ;;                                                                     cross++)]
+  ;;                                                       :let [_ (prn 'parts parts)]]
+  ;;                                                   [tag parts]))
+                                    
+  ;;                                   ]
+  ;;                               (assoc global :cases (reduce (fn [tree [tag subcases]]
+  ;;                                                              (update-in tree [tag] #(conj (or % []) (full-classifier subcases))))
+  ;;                                                            {}
+  ;;                                                            crossed))))))]
+  ;;   (full-classifier outer-classification))
+  )
 
-  ;; {"Cons" {:arity 2, :branches [[[x xs*] branch-1]]},
-  ;;  "Nil" {:arity 0, :branches [[[] branch-0]]}}
-
-
-  ;; .........................
-
-  ;; (case elems
-  ;;   #Nil
-  ;;   elems
-
-  ;;   (#Cons head tail)
-  ;;   (case head
-  ;;     (#Cons (#Symbol "~") (#Cons unquoted #Nil))
-  ;;     (#Cons unquoted (template tail))
-
-  ;;     (#Cons (#Symbol "~@") (#Cons spliced #Nil))
-  ;;     (#Cons (#Symbol "++") (#Cons spliced (template tail)))
-
-  ;;     _
-  ;;     (#Cons head (template tail)))
-  ;;   )
-
-  ;; Total registers: 3
-  ;; [{:tag "Nil" :data [] :path path-1}
-  ;;  {:tag "Cons" :data [[:bind head] [:bind tail]] :path path-2}]
-
-  ;; {path-0 [:branch "Nil" []]
-  ;;  path-1 [:branch "Cons" [[:bind head] [:bind tail]]]}
-
-  ;; Total registers: 6
-  ;; {path-0 [:branch "Cons" [[:adt "Symbol" [[:string-cmp "~"]]] [:adt "Cons" [[:bind unquoted] [:adt "Nil" []]]]]]
-  ;;  path-1 [:branch "Cons" [[:adt "Symbol" [[:string-cmp "~@"]]] [:adt "Cons" [[:bind spliced] [:adt "Nil" []]]]]]
-  ;;  path-2 [:default _]}
-
-  ;; {"#default#" [:default path-2 _]
-  ;;  "Cons" [:branches [path-0 path-1]
-  ;;          [[[:adt "Symbol" [[:string-cmp "~"]]] [:adt "Cons" [[:bind unquoted] [:adt "Nil" []]]]]
-  ;;           [[:adt "Symbol" [[:string-cmp "~@"]]] [:adt "Cons" [[:bind spliced] [:adt "Nil" []]]]]]]}
-
-  ;; [:branches]
+(comment
+  [{2 [:lang.parser/variant "Cons" ([:lang.parser/ident "head"] [:lang.parser/fn-call [:lang.parser/ident "template"] ([:lang.parser/ident "tail"])])],
+    1 [:lang.parser/variant "Cons" ([:lang.parser/variant "Symbol" ([:lang.parser/string "++"])] [:lang.parser/variant "Cons" ([:lang.parser/ident "spliced"] [:lang.parser/fn-call [:lang.parser/ident "template"] ([:lang.parser/ident "tail"])])])],
+    0 [:lang.parser/variant "Cons" ([:lang.parser/ident "unquoted"] [:lang.parser/fn-call [:lang.parser/ident "template"] ([:lang.parser/ident "tail"])])]}
+   {:type :lang/adt*,
+    :patterns {"Cons" ({:type :lang/adt*,
+                        :patterns {"Symbol" ({:type :lang/text-tests,
+                                              :patterns {"~@" #{1},
+                                                         "~" #{0}},
+                                              :defaults [],
+                                              :branches #{0 1}})},
+                        :default nil,
+                        :branches #{0 1}}
+                       {:type :lang/adt*,
+                        :patterns {"Cons" ({:type :lang/defaults,
+                                            :stores {[:lang/local 0 11] #{0 1}},
+                                            :branches #{0 1}}
+                                           {:type :lang/adt*,
+                                            :patterns {"Nil" ()},
+                                            :default nil,
+                                            :branches #{0 1}})},
+                        :default nil,
+                        :branches #{0 1}})},
+    :default [:lang/default [:lang/local 0 11] 2],
+    :branches #{0 1 2}}]
   
-
-  ;; (case elems
-  ;;   #Nil
-  ;;   elems
-
-  ;;   (#Cons (list (' ~) unquoted) tail)
-  ;;   (list* unquoted (template tail))
-
-  ;;   (#Cons (list (' ~@) spliced) tail)
-  ;;   (list* "++" spliced (template tail))
-
-  ;;   _
-  ;;   (#Cons head (template tail))
-  ;;   )
-
-  ;; [{:tag "Nil" :data [] :path path-1}
-  ;;  {:tag "Cons" :data [[:bind head] [:bind tail]] :path path-2}]
-
-  ;; [[{:tag "Cons" :data [%0 %1] :path nil
-  ;;    :sub-cases [[{:tag "Symbol" :data [[:string-cmp "~"]] :path path-1}
-  ;;                 {:tag "Symbol" :data [[:string-cmp "~@"]] :path path-2}]
-  ;;                [{:tag "Cons" :data [[:bind unquoted] {:tag "Nil" :data []}] :path path-1}
-  ;;                 {:tag "Cons" :data [[:bind spliced] {:tag "Nil" :data []}] :path path-2}]]}
-  ;;   {:tag ::default :path path-3}]]
-
-  ;; [[["Cons" ["Symbol" "~"] ["Cons" unquoted ["Nil"]]]
-  ;;   ["Cons" ["Symbol" "~@"] ["Cons" spliced ["Nil"]]]
-  ;;   _]]
-
-  ;; [[["Symbol" "~"]
-  ;;   ["Symbol" "~@"]]
-  ;;  [["Cons" unquoted ["Nil"]]
-  ;;   ["Cons" spliced ["Nil"]]]]
-
-  ;; (if (= "Cons" (:: % tag))
-  ;;   (let [%0 (:: % _0)
-  ;;         %1 (:: % _1)]
-  ;;     (if (= "Symbol" (:: %0 tag))
-  ;;       (let [%0|0 (:: %0 _0)]
-  ;;         (if (= "~" %0|0)
-  ;;           (if (= "Cons" (:: %1 tag))
-  ;;             (let [%1|0 (:: %1 _0)
-  ;;                   %1|1 (:: %1 _1)]
-  ;;               (if (= "Nil" (:: %1|1 tag))
-  ;;                 (let [unquoted %1|0]
-  ;;                   <path-1>)
-  ;;                 <path-3>))
-  ;;             <path-3>)
-  ;;           (if (= "@~" %0|0)
-  ;;             (if (= "Cons" (:: %1 tag))
-  ;;               (let [%1|0 (:: %1 _0)
-  ;;                     %1|1 (:: %1 _1)]
-  ;;                 (if (= "Nil" (:: %1|1 tag))
-  ;;                   (let [unquoted %1|0]
-  ;;                     <path-2>)
-  ;;                   <path-3>))
-  ;;               <path-3>)
-  ;;             <path-3>)))
-  ;;       <path-3>))
-  ;;   <path-3>)
-
+  (let [data '([[:lang/pm-variant "Cons" ([:lang/pm-variant "Symbol" ([:lang/pm-text "~"])]  [:lang/pm-variant "Cons" ([:lang/pm-local [:lang/local 0 11]] [:lang/pm-variant "Nil" ()])])] 0]
+                 [[:lang/pm-variant "Cons" ([:lang/pm-variant "Symbol" ([:lang/pm-text "~@"])] [:lang/pm-variant "Cons" ([:lang/pm-local [:lang/local 0 11]] [:lang/pm-variant "Nil" ()])])] 1]
+                   [[:lang/pm-local [:lang/local 0 11]] 2])
+        ]
+    (generate-branches data))
+
+  ;; (def (workday? d)
+  ;;   (case d
+  ;;     (or [#Monday #Tuesday #Wednesday #Thursday #Friday]
+  ;;         true)
+  ;;     (or [#Saturday #Sunday]
+  ;;         false)))
   
-
-  ;; (list (list '["Nil" [] ...]
-  ;;             '["Cons" [head tail] ...]))
-
-  ;; (list (list '["Cons" [["Symbol" ["~"]] ["Cons" [unquoted ["Nil" []]]]] ...]
-  ;;             '["Cons" [["Symbol" ["~@"]] ["Cons" [spliced ["Nil" []]]]] ...]))
   )
-
diff --git a/src/lang/analyser.clj b/src/lang/analyser.clj
index 72ea43e69..f45f44138 100644
--- a/src/lang/analyser.clj
+++ b/src/lang/analyser.clj
@@ -117,22 +117,6 @@
         =return)
       )))
 
-(defn ^:private with-anon-locals [amount k]
-  (fn [state]
-    (let [env (-> state :env first)
-          $scope (:id env)
-          =locals (for [$local (take amount (iterate inc (:counter env)))]
-                    (annotated [::local $scope $local] [::&type/object "java.lang.Object" []]))
-          =return ((k =locals) (update-in state [:env] #(cons (update-in (first %) [:counter] + amount) (rest %))))]
-      (match =return
-        [::&util/ok [?state ?value]]
-        (do ;; (prn 'POST-WITH-LOCAL name (-> ?state :env first))
-            [::&util/ok [(update-in ?state [:env] #(cons (update-in (first %) [:counter] - amount) (rest %)))
-                         ?value]])
-        
-        _
-        =return))))
-
 (defn ^:private with-locals [mappings monad]
   (fn [state]
     (let [=return (monad (update-in state [:env] #(cons (update-in (first %) [:mappings] merge mappings)
@@ -423,142 +407,159 @@
   (exec [=exprs (map-m analyse-form* ?exprs)]
     (return (annotated [::do =exprs] (-> =exprs last :type)))))
 
+(let [fold-branches (fn [struct entry]
+                      (let [struct* (clojure.core.match/match (nth entry 0)
+                                      [::pm-text ?text]
+                                      (clojure.core.match/match (:type struct)
+                                        ::text-tests (update-in struct [:patterns ?text] (fn [bodies]
+                                                                                           (if bodies
+                                                                                             (conj bodies (nth entry 1))
+                                                                                             #{(nth entry 1)})))
+                                        nil (-> struct
+                                                (assoc :type ::text-tests)
+                                                (assoc-in [:patterns ?text] #{(nth entry 1)}))
+                                        _ (assert false "Can't do match."))
+                                      [::pm-variant ?tag ?members]
+                                      (clojure.core.match/match (:type struct)
+                                        ::adt (update-in struct [:patterns]
+                                                         (fn [branches]
+                                                           (if-let [{:keys [arity cases]} (get branches ?tag)]
+                                                             (if (= arity (count ?members))
+                                                               (-> branches
+                                                                   (update-in [?tag :cases] conj {:case ?members
+                                                                                                  :body (nth entry 1)})
+                                                                   (update-in [?tag :branches] conj (nth entry 1)))
+                                                               (assert false (str "Arity doesn't match. " (count ?members) "=/=" arity)))
+                                                             (assoc branches ?tag {:arity (count ?members)
+                                                                                   :cases [{:case ?members
+                                                                                            :body (nth entry 1)}]
+                                                                                   :branches #{(nth entry 1)}}))))
+                                        nil (-> struct
+                                                (assoc :type ::adt)
+                                                (assoc-in [:patterns ?tag] {:arity (count ?members)
+                                                                            :cases [{:case ?members
+                                                                                     :body (nth entry 1)}]
+                                                                            :branches #{(nth entry 1)}}))
+                                        _ (assert false "Can't do match."))
+
+                                      [::pm-local ?local]
+                                      (update-in struct [:defaults] conj [::default ?local (nth entry 1)]))]
+                        (update-in struct* [:branches] conj (nth entry 1))))
+      base-struct {:type nil
+                   :patterns {}
+                   :defaults []
+                   :branches #{}}
+      generate-branches (fn generate-branches [data]
+                          (let [branches* (reduce fold-branches base-struct data)]
+                            ;; (prn 'generate-branches data)
+                            ;; (prn 'branches* branches*)
+                            ;; (.print System/out (prn-str 'branches* branches*))
+                            ;; (.print System/out (prn-str '(:type branches*) (:type branches*)))
+                            (clojure.core.match/match (:type branches*)
+                              ::text-tests branches*
+                              ::adt (do (assert (<= (count (:defaults branches*)) 1))
+                                      {:type ::adt*
+                                       :patterns (into {} (for [[?tag ?struct] (:patterns branches*)
+                                                                ;; :let [_ (prn '(:patterns branches*) ?tag ?struct)]
+                                                                ]
+                                                            [?tag {:parts (let [grouped-parts (apply map list (for [{:keys [case body]} (:cases ?struct)]
+                                                                                                                (map #(vector % body) case)))]
+                                                                            (map generate-branches grouped-parts))
+                                                                   :branches (:branches ?struct)}]))
+                                       :default (-> branches* :defaults first)
+                                       :branches (:branches branches*)})
+                              nil {:type ::defaults,
+                                   :stores (reduce (fn [total [_ ?store ?body]]
+                                                     (update-in total [?store] (fn [mapping]
+                                                                                 (if mapping
+                                                                                   (conj mapping ?body)
+                                                                                   #{?body}))))
+                                                   {}
+                                                   (:defaults branches*))
+                                   :branches (:branches branches*)})))
+      get-vars (fn get-vars [pattern]
+                 (clojure.core.match/match pattern
+                   [::&parser/ident ?name]
+                   (list ?name)
+                   
+                   [::&parser/variant ?tag ?members]
+                   (mapcat get-vars ?members)
+
+                   [::&parser/string ?text]
+                   '()))
+      ->instructions (fn ->instructions [locals pattern]
+                       (clojure.core.match/match pattern
+                         [::&parser/variant ?tag ?members]
+                         [::pm-variant ?tag (map (partial ->instructions locals) ?members)]
+                         
+                         [::&parser/ident ?name]
+                         [::pm-local (get locals ?name)]
+                         
+                         [::&parser/string ?text]
+                         [::pm-text ?text]
+                         ))]
+  (defn ->decision-tree [$scope $base branches]
+    (let [;; Step 1: Get all vars
+          vars+body (for [branch branches]
+                      (clojure.core.match/match branch
+                        [::&parser/case-branch ?pattern ?body]
+                        [(get-vars ?pattern) ?body]))
+          max-registers (reduce max 0 (map (comp count first) vars+body))
+          ;; Step 2: Analyse bodies
+          [_ branch-mappings branches*] (reduce (fn [[$link links branches*] branch]
+                                                  (clojure.core.match/match branch
+                                                    [::&parser/case-branch ?pattern ?body]
+                                                    [(inc $link) (assoc links $link ?body) (conj branches* [::&parser/case-branch ?pattern $link])]))
+                                                [0 {} []]
+                                                branches)
+          ;; Step 4: Pattens -> Instructions
+          branches** (for [[branch branch-vars] (map vector branches* (map first vars+body))
+                           :let [[_ locals] (reduce (fn [[$local =locals] $var]
+                                                      [(inc $local) (assoc =locals $var [::local $scope $local])])
+                                                    [$base {}] branch-vars)]]
+                       (clojure.core.match/match branch
+                         [::&parser/case-branch ?pattern ?body]
+                         [(->instructions locals ?pattern) ?body]))
+          ;; _ (prn branches**)
+          ;; Step 5: Re-structure branching
+          ]
+      [max-registers branch-mappings (generate-branches branches**)])))
+
 (defanalyser analyse-case
   [::&parser/case ?variant ?branches]
-  (exec [;; :let [_ (prn '?variant ?variant)]
-         =variant (analyse-form* ?variant)
-         ;; :let [_ (prn '=variant =variant)]
-         ;; {:registers 3,
-         ;;  :patterns {"Cons" {:arity 2, :branches [{:test [:lang/case-try "Cons" [[:lang/case-sub-bind 1] [:lang/case-sub-bind 2]]], :link 1}]},
-         ;;             "Nil" {:arity 0, :branches [{:test [:lang/case-try "Nil" []], :link 0}]}},
-         ;;  :paths {:total 2,
-         ;;          :links {1 [:lang.parser/variant "Cons" ([:lang.parser/ident "x"] [:lang.parser/fn-call [:lang.parser/ident "++"] ([:lang.parser/ident "xs*"] [:lang.parser/ident "ys"])])],
-         ;;                  0 [:lang.parser/ident "ys"]}}}
-         [$base =branches] (with-anon-locals 1
-                             (fn [=locals]
-                               ;; (prn 'analyse-case '=locals (map :form =locals))
-                               (exec [=branches (map-m (fn [?branch]
-                                                         ;; (prn '?branch ?branch)
-                                                         (match ?branch
-                                                           [::&parser/case-branch [::&parser/variant ?tag ?members] ?body]
-                                                           (let [num-members (count ?members)]
-                                                             (with-anon-locals num-members
-                                                               (fn [=locals]
-                                                                 ;; (prn '?branch/=locals (map :form =locals))
-                                                                 (exec [[inner-num locals+ members+] (reduce-m (fn member-fold [[?inner-num locals-map =members] [?local ?member]]
-                                                                                                                 (match ?member
-                                                                                                                   [::&parser/ident ?name]
-                                                                                                                   (return [?inner-num
-                                                                                                                            (assoc locals-map ?name ?local)
-                                                                                                                            (conj =members (:form ?local))])
-
-                                                                                                                   [::&parser/string ?text]
-                                                                                                                   (return [?inner-num
-                                                                                                                            locals-map
-                                                                                                                            (conj =members [::match-text ?text])])
-
-                                                                                                                   [::&parser/variant ?subtag ?submembers]
-                                                                                                                   (let [num-submembers (count ?submembers)]
-                                                                                                                     (with-anon-locals num-submembers
-                                                                                                                       (fn [=sublocals]
-                                                                                                                         (exec [[subinner-num sublocals+ submembers+] (reduce-m member-fold [0 {} []] (map vector =sublocals ?submembers))
-                                                                                                                                ;; :let [_ (prn 'subinner-num subinner-num 'sublocals+ sublocals+ 'submembers+ submembers+)]
-                                                                                                                                ]
-                                                                                                                           (return [(+ ?inner-num num-submembers subinner-num)
-                                                                                                                                    (merge locals-map sublocals+)
-                                                                                                                                    (conj =members [::subcase ?subtag submembers+])])))))
-                                                                                                                   ))
-                                                                                                               [0 {} []]
-                                                                                                               (map vector =locals ?members))
-                                                                        ;; :let [_ (prn 'inner-num inner-num 'locals+ locals+ 'members+ members+)]
-                                                                        ;; :let [_ (prn (first =members) ?body)]
-                                                                        =body (with-locals locals+
-                                                                                (analyse-form* ?body))
-                                                                        ;; :let [_ (prn '?body ?body =body)]
-                                                                        ]
-                                                                   (return [(+ num-members inner-num) [::branch-adt ?tag members+ =body]])))))))
-                                                       ?branches)]
-                                 (return [(first =locals) =branches]))))
-         :let [total-registers (+ 1 (reduce max 0 (map first =branches)))
-               ;; _ (prn '=branches total-registers (map second =branches))
-               ;; _ (assert false)
-               ]
-         ;; ([::&parser/case-branch [::&parser/variant "Nil" ()]
-         ;;   [::&parser/ident "ys"]]
-         ;;    [::&parser/case-branch [::&parser/variant "Cons" ([::&parser/ident "x"] [::&parser/ident "xs*"])]
-         ;;     [::&parser/variant "Cons" ([::&parser/ident "x"] [::&parser/fn-call [::&parser/ident "++"] ([::&parser/ident "xs*"] [::&parser/ident "ys"])])]])
-         ;; :let [_ (prn '?branches ?branches)
-         ;;       case-analysis (let [gen-impl (fn gen-impl [offset pattern]
-         ;;                                      (clojure.core.match/match pattern
-         ;;                                        [::&parser/ident _]
-         ;;                                        [1 [::case-bind -1 offset]]
-                                                
-         ;;                                        [::&parser/variant ?tag ?members]
-         ;;                                        (let [regs+insns (mapv (fn [idx member]
-         ;;                                                                 (clojure.core.match/match member
-         ;;                                                                   [::&parser/ident _]
-         ;;                                                                   [1 [::case-sub-bind (+ offset (inc idx))]]))
-         ;;                                                               (range (count ?members))
-         ;;                                                               ?members)]
-         ;;                                          [(reduce + 1 (map first regs+insns)) [::case-try ?tag (mapv second regs+insns)]])
-         ;;                                        (reduce + (count ?members) (map gen-impl ?members))))]
-         ;;                       (reduce (fn [accum branch]
-         ;;                                 (clojure.core.match/match branch
-         ;;                                   [::&parser/case-branch ?pattern ?body]
-         ;;                                   (clojure.core.match/match ?pattern
-         ;;                                     [::&parser/variant ?tag ?members]
-         ;;                                     (let [[extra-registers impl] (gen-impl 0 ?pattern)
-         ;;                                           _ (prn 'impl extra-registers impl)
-         ;;                                           $branch (get-in accum [:paths :total])]
-         ;;                                       (-> accum
-         ;;                                           (update-in [:patterns]
-         ;;                                                      (fn [patterns]
-         ;;                                                        (if (contains? patterns ?tag)
-         ;;                                                          (if (= (get patterns [?tag :arity]) (count ?members))
-         ;;                                                            (update-in patterns [?tag :branches] conj {:test impl
-         ;;                                                                                                       :link $branch})
-         ;;                                                            (assert "Pattern arity doesn't match!"))
-         ;;                                                          (assoc patterns ?tag {:arity (count ?members)
-         ;;                                                                                :branches [{:test impl
-         ;;                                                                                            :link $branch}]}))))
-         ;;                                           (update-in [:paths]
-         ;;                                                      (fn [paths]
-         ;;                                                        (-> paths
-         ;;                                                            (update-in [:total] inc)
-         ;;                                                            (assoc-in [:links $branch] ?body))))
-         ;;                                           (update-in [:registers] + (dec extra-registers)))))
-         ;;                                   ))
-         ;;                               {:registers 1
-         ;;                                :patterns {}
-         ;;                                :paths {:total 0
-         ;;                                        :links {}}}
-         ;;                               ?branches))
-         ;;       _ (prn 'case-analysis case-analysis)
-         ;;       _ (assert false)]
-         ;; =branches (map-m identity ;; (fn [branch]
-         ;;                  ;;   ;; (prn 'branch branch)
-         ;;                  ;;   (match branch
-         ;;                  ;;     [::&parser/case-branch [::&parser/variant ?tag ?parts] ?body]
-         ;;                  ;;     (exec [;; :let [_ (prn ?tag ?label '?body ?body)]
-         ;;                  ;;            ;; (reduce-m (fn [?part]
-         ;;                  ;;            ;;             (match ?part
-         ;;                  ;;            ;;               [::&parser/ident ?label]
-         ;;                  ;;            ;;               (exec [idx next-local-idx
-         ;;                  ;;            ;;                      =body (with-local ?label [::&type/object "java.lang.Object" []]
-         ;;                  ;;            ;;                              (analyse-form* ?body))]
-         ;;                  ;;            ;;                 (return ...)))
-         ;;                  ;;            ;;             )
-         ;;                  ;;            ;;           ?parts)
-         ;;                  ;;            idx next-local-idx
-         ;;                  ;;            =body (with-local ?label [::&type/object "java.lang.Object" []]
-         ;;                  ;;                    (analyse-form* ?body))
-         ;;                  ;;            ;; :let [_ (prn ?tag ?label '=body =body)]
-         ;;                  ;;            ]
-         ;;                  ;;       (return [?tag ?label idx =body]))))
-         ;;                  ?branches)
-         ;; :let [_ (prn '=branches =branches)]
+  (exec [=variant (analyse-form* ?variant)
+         ;; :let [_ (prn 'analyse-case '=variant =variant)]
+         $scope scope-id
+         ;; :let [_ (prn 'analyse-case '$scope $scope)]
+         $base next-local-idx
+         ;; :let [_ (prn 'analyse-case '$base $base)]
+         [registers mappings tree] (exec [=branches (map-m (fn [?branch]
+                                                             (match ?branch
+                                                               [::&parser/case-branch [::&parser/variant ?tag ?members] ?body]
+                                                               (exec [[_ locals+] (reduce-m (fn member-fold [[$local locals-map] ?member]
+                                                                                              (match ?member
+                                                                                                [::&parser/ident ?name]
+                                                                                                (return [(inc $local) (assoc locals-map ?name (annotated [::local $scope $local] [::&type/object "java.lang.Object" []]))])
+
+                                                                                                [::&parser/variant ?subtag ?submembers]
+                                                                                                (reduce-m member-fold [$local locals-map] ?submembers)
+
+                                                                                                _
+                                                                                                (return [$local locals-map])
+                                                                                                ))
+                                                                                            [$base {}]
+                                                                                            ?members)
+                                                                      ;; :let [_ (prn 'analyse-case 'locals+ locals+)]
+                                                                      =body (with-locals locals+
+                                                                              (analyse-form* ?body))
+                                                                      ;; :let [_ (prn 'analyse-case '=body =body)]
+                                                                      ]
+                                                                 (return [::&parser/case-branch [::&parser/variant ?tag ?members] =body]))))
+                                                           ?branches)]
+                                     (return (->decision-tree $scope $base =branches)))
+         ;; :let [_ (prn 'analyse-case '[registers mappings tree] [registers mappings tree])]
          ]
-    (return (annotated [::case $base =variant total-registers (map second =branches)] ::&type/nothing))))
+    (return (annotated [::case (dec $base) =variant registers mappings tree] ::&type/nothing))))
 
 (defanalyser analyse-let
   [::&parser/let ?label ?value ?body]
diff --git a/src/lang/compiler.clj b/src/lang/compiler.clj
index c6c75558e..e04178fed 100644
--- a/src/lang/compiler.clj
+++ b/src/lang/compiler.clj
@@ -1,6 +1,7 @@
 (ns lang.compiler
   (:refer-clojure :exclude [compile])
   (:require [clojure.string :as string]
+            [clojure.set :as set]
             [clojure.core.match :refer [match]]
             (lang [type :as &type]
                   [lexer :as &lexer]
@@ -283,108 +284,163 @@
         (.visitInsn *writer* Opcodes/POP))
     (compile-form (assoc *state* :form (last ?exprs)))))
 
-(let [oclass (->class "java.lang.Object")
+(let [+tag-sig+ (->type-signature "java.lang.String")
+      variant-class* (->class +variant-class+)
+      oclass (->class "java.lang.Object")
+      +tuple-field-sig+ (->type-signature "java.lang.Object")
       equals-sig (str "(" (->type-signature "java.lang.Object") ")Z")]
+  (defn compile-decision-tree [writer mappings cleanup-level next-label default-label decision-tree]
+    ;; (prn 'compile-decision-tree cleanup-level decision-tree)
+    (match decision-tree
+      [::test-text ?text $body]
+      (let [$else (new Label)]
+        (doto writer
+          ;; object
+          (.visitInsn Opcodes/DUP) ;; object, object
+          (.visitLdcInsn ?text) ;; object, object, text
+          (.visitMethodInsn Opcodes/INVOKEVIRTUAL oclass "equals" equals-sig) ;; object, B
+          (.visitJumpInsn Opcodes/IFEQ $else) ;; object
+          (.visitInsn Opcodes/POP) ;; 
+          (.visitJumpInsn Opcodes/GOTO next-label)
+          (.visitLabel $else)
+          (-> (doto (.visitInsn Opcodes/POP))
+              (->> (dotimes [_ (inc cleanup-level)])))
+          (.visitJumpInsn Opcodes/GOTO default-label)))
+      
+      [::store [::&analyser/local 0 ?idx] _]
+      ;; object
+      (.visitVarInsn writer Opcodes/ASTORE ?idx) ;; 
+      
+      [::test-adt ?branches ?cases]
+      (doto writer
+        ;; object
+        (.visitTypeInsn Opcodes/CHECKCAST variant-class*) ;; variant
+        (.visitInsn Opcodes/DUP) ;; variant, variant
+        (.visitFieldInsn Opcodes/GETFIELD variant-class* "tag" +tag-sig+) ;; variant, tag
+        (-> (doto (.visitInsn Opcodes/DUP) ;; variant, tag, tag
+              (.visitLdcInsn ?tag) ;; variant, tag, tag, text
+              (.visitMethodInsn Opcodes/INVOKEVIRTUAL oclass "equals" equals-sig) ;; variant, tag, B
+              (.visitJumpInsn Opcodes/IFEQ tag-else-label) ;; variant, tag
+              (.visitInsn Opcodes/POP) ;; variant
+              (do (let [arity (-> ?subcases first (nth 2) count)
+                        tuple-class (str "test2/Tuple" arity)]
+                    (when (> arity 0)
+                      (doto writer
+                        (.visitInsn Opcodes/DUP) ;; variant, variant
+                        (.visitFieldInsn Opcodes/GETFIELD variant-class* "value" +tuple-field-sig+) ;; variant, object
+                        (.visitTypeInsn Opcodes/CHECKCAST tuple-class) ;; variant, tuple
+                        ))
+                    (doseq [subcase ?subcases
+                            :let [else-label (new Label)]]
+                      (match subcase
+                        [::subcase $body ?subseq]
+                        (do (when (not (empty? ?subseq))
+                              (doseq [[?subpart ?subidx] (map vector ?subseq (range (count ?subseq)))
+                                      :let [next-label (new Label)]]
+                                (doto writer
+                                  (.visitInsn Opcodes/DUP) ;; variant, tuple, tuple
+                                  (.visitFieldInsn Opcodes/GETFIELD tuple-class (str "_" ?subidx) +tuple-field-sig+) ;; variant, tuple, object
+                                  (compile-decision-tree mappings cleanup-level next-label else-label ?subpart) ;; variant, tuple
+                                  (.visitLabel next-label))))
+                          (doto writer
+                            (-> (doto (.visitInsn Opcodes/POP))
+                                (->> (dotimes [_ (+ cleanup-level (if (> arity 0) 2 1))]))) ;; 
+                            (.visitJumpInsn Opcodes/GOTO (or next-label (get mappings $body)))
+                            (.visitLabel else-label)))
+                        ))
+                    ))
+              ;; variant, tag ->
+              (.visitLabel tag-else-label))
+            (->> (doseq [[?tag ?subcases] ?cases
+                         :let [tag-else-label (new Label)]])))
+        (-> (doto (.visitInsn Opcodes/POP))
+            (->> (dotimes [_ (+ cleanup-level 2)])))
+        (.visitJumpInsn Opcodes/GOTO default-label)))
+    ))
+
+(defn sequence-parts [branches parts]
+  ;; (.print System/out (prn-str 'sequence-parts branches parts))
+  (if (empty? parts)
+    '(())
+    (let [[head & tail] parts
+          expanded (case (:type head)
+                     ::&analyser/defaults
+                     (for [[?local ?supports] (:stores head)
+                           ?body (set/intersection branches ?supports)
+                           ;; :when (set/subset? branches ?supports)
+                           ]
+                       [[::store ?local ?body] #{?body}])
+
+                     ::&analyser/text-tests
+                     (concat (for [[?text ?supports] (:patterns head)
+                                   ?body (set/intersection branches ?supports)
+                                   ;; :when (set/subset? branches ?supports)
+                                   ]
+                               [[::test-text ?text ?body] #{?body}])
+                             (for [[_ ?local ?body] (:defaults head)
+                                   :when (contains? branches ?body)]
+                               [[::store ?local ?body] #{?body}]))
+
+                     ::&analyser/adt*
+                     (do (assert (nil? (:default head)))
+                       (list (list [::test-adt branches (into {} (for [[?tag ?struct] (:patterns head)
+                                                                       :let [?supports (:branches ?struct)]]
+                                                                   [?tag (for [?body (set/intersection branches ?supports)
+                                                                               subseq (sequence-parts #{?body} (:parts ?struct))]
+                                                                           [::subcase ?body subseq])]))])))
+                     )]
+      (for [[step branches*] expanded
+            tail* (sequence-parts branches* tail)
+            ;; :let [_ (.print System/out (prn-str 'tail* tail*))]
+            ]
+        (cons step tail*)))))
+
+(let [oclass (->class "java.lang.Object")
+      equals-sig (str "(" (->type-signature "java.lang.Object") ")Z")
+      ex-class (->class "java.lang.IllegalStateException")]
   (defcompiler ^:private compile-case
     ;; [::&analyser/case ?variant ?branches]
-    [::&analyser/case ?base ?variant ?registers ?branches]
-    (let [variant-class* (->class +variant-class+)]
-      ;; (prn [:case ?base ?variant ?registers ?branches])
-        (match (:form ?base)
-          [::&analyser/local _ ?base-idx]
-          (let [start-label (new Label)
-                end-label (new Label)
-                default-label (new Label)]
-            (dotimes [idx ?registers]
-              (.visitLocalVariable *writer* (str "__" idx "__") (->java-sig ::&type/any) nil start-label end-label (+ ?base-idx idx)))
-            (.visitLabel *writer* start-label)
-            (compile-form (assoc *state* :form ?variant))
-            (.visitTypeInsn *writer* Opcodes/CHECKCAST variant-class*)
-            (.visitVarInsn *writer* Opcodes/ASTORE ?base-idx)
-            (doseq [?branch ?branches
-                    :let [else-label (new Label)]]
-              (match ?branch
-                [::&analyser/branch-adt ?tag ?members ?body]
-                (doto *writer*
-                  (.visitVarInsn Opcodes/ALOAD ?base-idx)
-                  (.visitFieldInsn Opcodes/GETFIELD variant-class* "tag" (->type-signature "java.lang.String"))
-                  (.visitLdcInsn ?tag)
-                  (.visitMethodInsn Opcodes/INVOKEVIRTUAL oclass "equals" equals-sig)
-                  (.visitJumpInsn Opcodes/IFEQ else-label)
-                  (do (when (not (empty? ?members))
-                        (let [tuple-class (str "test2/Tuple" (count ?members))
-                              mk-sub-fold (fn mk-sub-fold [cleanup-level default-label tuple-class]
-                                            (fn sub-fold [?tfield member]
-                                              (let [next-label (new Label)
-                                                    cleanup-label (new Label)]
-                                                (match member
-                                                  [::&analyser/local 0 ?idx]
-                                                  (doto *writer*
-                                                    (.visitInsn Opcodes/DUP)
-                                                    (.visitFieldInsn Opcodes/GETFIELD tuple-class (str "_" ?tfield) (->type-signature "java.lang.Object"))
-                                                    (.visitVarInsn Opcodes/ASTORE ?idx)
-                                                    (.visitLabel next-label))
-
-                                                  [::&analyser/match-text ?text]
-                                                  (doto *writer*
-                                                    (.visitInsn Opcodes/DUP)
-                                                    (.visitFieldInsn Opcodes/GETFIELD tuple-class (str "_" ?tfield) (->type-signature "java.lang.Object"))
-                                                    (.visitLdcInsn ?text)
-                                                    (.visitMethodInsn Opcodes/INVOKEVIRTUAL oclass "equals" equals-sig)
-                                                    (.visitJumpInsn Opcodes/IFEQ cleanup-label)
-                                                    (.visitJumpInsn Opcodes/GOTO next-label)
-                                                    (.visitLabel cleanup-label)
-                                                    (-> (doto (.visitInsn Opcodes/POP))
-                                                        (->> (dotimes [_ cleanup-level])))
-                                                    (.visitJumpInsn Opcodes/GOTO default-label)
-                                                    (.visitLabel next-label))
-
-                                                  [::&analyser/subcase ?subtag ?submembers]
-                                                  (let [tuple-class* (str "test2/Tuple" (count ?submembers))]
-                                                    (doto *writer*
-                                                      (.visitInsn Opcodes/DUP)
-                                                      (.visitFieldInsn Opcodes/GETFIELD tuple-class (str "_" ?tfield) (->type-signature "java.lang.Object"))
-                                                      (.visitTypeInsn Opcodes/CHECKCAST variant-class*)
-                                                      (.visitInsn Opcodes/DUP)
-                                                      (.visitFieldInsn Opcodes/GETFIELD variant-class* "tag" (->type-signature "java.lang.String"))
-                                                      (.visitLdcInsn ?subtag)
-                                                      (.visitMethodInsn Opcodes/INVOKEVIRTUAL oclass "equals" equals-sig)
-                                                      (.visitJumpInsn Opcodes/IFEQ cleanup-label)
-                                                      (.visitFieldInsn Opcodes/GETFIELD variant-class* "value" (->type-signature "java.lang.Object"))
-                                                      (.visitTypeInsn Opcodes/CHECKCAST tuple-class*)
-                                                      (do (dorun (map (mk-sub-fold (inc cleanup-level) default-label tuple-class*)
-                                                                      (range (count ?submembers))
-                                                                      ?submembers)))
-                                                      (.visitInsn Opcodes/POP)
-                                                      (.visitJumpInsn Opcodes/GOTO next-label)
-                                                      (.visitLabel cleanup-label)
-                                                      (-> (doto (.visitInsn Opcodes/POP))
-                                                          (->> (dotimes [_ (inc cleanup-level)])))
-                                                      (.visitJumpInsn Opcodes/GOTO default-label)
-                                                      (.visitLabel next-label)
-                                                      ))))))]
-                          (doto *writer*
-                            (.visitVarInsn Opcodes/ALOAD ?base-idx)
-                            (.visitFieldInsn Opcodes/GETFIELD variant-class* "value" (->type-signature "java.lang.Object"))
-                            (.visitTypeInsn Opcodes/CHECKCAST tuple-class))
-                          (dorun (map (mk-sub-fold 1 else-label tuple-class)
-                                      (range (count ?members))
-                                      ?members))
-                          (.visitInsn *writer* Opcodes/POP)))
-                    (compile-form (assoc *state* :form ?body)))
-                  (.visitJumpInsn Opcodes/GOTO end-label)
-                  (.visitLabel else-label))))
-            ;; Default branch
-            (let [ex-class (->class "java.lang.IllegalStateException")]
-              (doto *writer*
-                (.visitLabel default-label)
-                (.visitInsn Opcodes/ACONST_NULL)
-                (.visitTypeInsn Opcodes/NEW ex-class)
-                (.visitInsn Opcodes/DUP)
-                (.visitMethodInsn Opcodes/INVOKESPECIAL ex-class "<init>" "()V")
-                (.visitInsn Opcodes/ATHROW)))
-            (.visitLabel *writer* end-label)))
-      )))
+    [::&analyser/case ?base-idx ?variant ?max-registers ?branch-mappings ?decision-tree]
+    (do ;; (prn 'compile-case ?base-idx ?variant ?max-registers ?branch-mappings ?decision-tree)
+      ;; (assert false)
+      (let [start-label (new Label)
+            end-label (new Label)
+            ;; default-label (new Label)
+            entries (for [[?branch ?body] ?branch-mappings
+                          :let [label (new Label)]]
+                      [[?branch label]
+                       [label ?body]])
+            mappings* (into {} (map first entries))]
+        (dotimes [idx ?max-registers]
+          (.visitLocalVariable *writer* (str "__" idx "__") (->java-sig ::&type/any) nil start-label end-label (+ ?base-idx (inc idx))))
+        (compile-form (assoc *state* :form ?variant))
+        (.visitLabel *writer* start-label)
+        (let [default-label (new Label)
+              default-code (:default ?decision-tree)]
+          (compile-decision-tree *writer* mappings* 0 nil default-label
+                                 (-> (sequence-parts (:branches ?decision-tree) (list ?decision-tree))
+                                     first first))
+          (.visitLabel *writer* default-label)
+          (if default-code
+            (do (prn 'default-code default-code)
+              (assert false)
+              ;; (.visitInsn Opcodes/POP) ;; ...
+              (compile-form (assoc *state* :form default-code))
+              (.visitJumpInsn *writer* Opcodes/GOTO end-label))
+            (doto *writer*
+              ;; (.visitInsn Opcodes/POP)
+              (.visitTypeInsn Opcodes/NEW ex-class)
+              (.visitInsn Opcodes/DUP)
+              (.visitMethodInsn Opcodes/INVOKESPECIAL ex-class "<init>" "()V")
+              (.visitInsn Opcodes/ATHROW))))
+        ;; (compile-decision-tree *state* *writer* mappings* 1 nil (:branches ?decision-tree) ?decision-tree)
+        (doseq [[?label ?body] (map second entries)]
+          (.visitLabel *writer* ?label)
+          (compile-form (assoc *state* :form ?body))
+          (.visitJumpInsn *writer* Opcodes/GOTO end-label))
+        (.visitLabel *writer* end-label)
+        ))
+    ))
 
 (defcompiler ^:private compile-let
   [::&analyser/let ?idx ?label ?value ?body]
diff --git a/test2.lang b/test2.lang
index 73c6d206e..c697ae3c8 100644
--- a/test2.lang
+++ b/test2.lang
@@ -10,35 +10,13 @@
 
 (defclass Variant [[java.lang.String tag] [java.lang.Object value]])
 
-#( (def (++ xs ys)
-     (case xs
-       #Nil
-       ys
-
-       (#Cons x xs*)
-       (#Cons x (++ xs* ys)))) )#
-
-#( (def (main args)
-     (if true
-       (case (#Pair "Pattern" "Matching")
-         (#Pair first second)
-         (do (:: (:: System out) (println first))
-           (:: (:: System out) (println second))))
-       (:: (:: System out) (println "FALSE")))) )#
+(def (++ xs ys)
+  (case xs
+    #Nil
+    ys
 
-(def (main args)
-  (if true
-    (let xs+ys (#Cons "Pattern" (#Cons "Matching" #Nil))
-         (case xs+ys
-           (#Cons "Pattern" (#Cons second #Nil))
-           (do (:: (:: System out) (println "Branch #1"))
-             (:: (:: System out) (println second)))
-
-           (#Cons first (#Cons second #Nil))
-           (do (:: (:: System out) (println "Branch #2"))
-             (:: (:: System out) (println first))
-             (:: (:: System out) (println second)))))
-    (:: (:: System out) (println "FALSE"))))
+    (#Cons x xs*)
+    (#Cons x (++ xs* ys))))
 
 #( (def (template elems)
      (case elems
@@ -55,9 +33,24 @@
 
          _
          (#Cons head (template tail)))
-       ))
+       )) )#
+
+#(  )#
+
+(def (main args)
+  (if true
+    (case (++ (#Cons "Pattern" #Nil) (#Cons "Matching" #Nil))
+      (#Cons "Pattern" (#Cons second #Nil))
+      (do (:: (:: System out) (println "Branch #1"))
+        (:: (:: System out) (println second)))
+
+      (#Cons first (#Cons second #Nil))
+      (do (:: (:: System out) (println "Branch #2"))
+        (:: (:: System out) (println first))
+        (:: (:: System out) (println second))))
+    (:: (:: System out) (println "FALSE"))))
 
-   (defmacro (' form)
+#( (defmacro (' form)
      (case form
        (#Cons form* #Nil)
        (case form*