Pattern matching compiler now generates optimized code.

2 files changed, 305 insertions, 248 deletions

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]