Reimplemented basic pattern-matching.

5 files changed, 581 insertions, 94 deletions

diff --git a/src/lang.clj b/src/lang.clj
index 16e76f6e5..4dd8e159c 100644
--- a/src/lang.clj
+++ b/src/lang.clj
@@ -8,6 +8,7 @@
 
 (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
@@ -25,7 +26,33 @@
   ;; TODO: Add extra arities (apply2, apply3, ..., apply16)
   ;; TODO: When doing partial application, skip "apply" and just call constructor appropiatedly.
   ;; TODO: Add "new". Allow setting fields.
+  ;; TODO: Don't take into account newlines in strings unless they come from \n to allow better coding.
   ;; TODO: 
+  ;; TODO: 
+  ;; 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)
@@ -34,8 +61,252 @@
         ;; _ (prn 'syntax syntax)
         ann-syntax (&analyser/analyse "test2" syntax)
         ;; _ (prn 'ann-syntax ann-syntax)
-        class-data (&compiler/compile "test2" ann-syntax)]
+        class-data (&compiler/compile "test2" ann-syntax)
+        ;; _ (prn 'class-data class-data)
+        ]
     (write-file "test2.class" 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]]
+                     
+                     [::&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/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]]}}])
+  
+
+  ;; {"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]
+  
+
+  ;; (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>)
+
+  
+
+  ;; (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 4436b0b61..7c94c77d5 100644
--- a/src/lang/analyser.clj
+++ b/src/lang/analyser.clj
@@ -4,7 +4,7 @@
                      [template :refer [do-template]])
             [clojure.core.match :refer [match]]
             (lang [util :as &util :refer [exec return* return fail fail*
-                                          repeat-m try-m try-all-m map-m
+                                          repeat-m try-m try-all-m map-m reduce-m
                                           apply-m within]]
                   [parser :as &parser]
                   [type :as &type])))
@@ -37,6 +37,10 @@
   (fn [state]
     [::&util/ok [state (-> state :env first :counter)]]))
 
+(def ^:private scope-id
+  (fn [state]
+    [::&util/ok [state (-> state :env first :id)]]))
+
 (def ^:private my-frame
   (fn [state]
     [::&util/ok [state (-> state :env first)]]))
@@ -53,6 +57,20 @@
         _
         =return))))
 
+(defn ^:private with-scoped-name [name type body]
+  (fn [state]
+    (let [=return (body (update-in state [:env]
+                                   #(cons (assoc-in (first %) [:mappings name] (annotated [::global (:name state) name] type))
+                                          (rest %))))]
+      (match =return
+        [::&util/ok [?state ?value]]
+        [::&util/ok [(update-in ?state [:env] #(cons (update-in (first %) [:mappings] dissoc name)
+                                                     (rest %)))
+                     ?value]]
+        
+        _
+        =return))))
+
 (defn ^:private with-lambda-scope [body]
   (fn [state]
     (let [;; _ (prn 'with-lambda-scope (get-in state [:lambda-scope 0]) (get-in state [:lambda-scope 1]))
@@ -99,6 +117,36 @@
         =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)
+                                                        (rest %))))]
+      (match =return
+        [::&util/ok [?state ?value]]
+        (do ;; (prn 'POST-WITH-LOCAL name (-> ?state :env first))
+            [::&util/ok [(update-in ?state [:env] #(cons (assoc (first %) :mappings (-> state :env first :mappings))
+                                                         (rest %)))
+                         ?value]])
+        
+        _
+        =return))))
+
 (defn ^:private with-fresh-env [[args-vars args-types] body]
   (with-lambda-scope
     (fn [state]
@@ -119,12 +167,12 @@
         (match =return
           [::&util/ok [?state ?value]]
           (do ;; (prn 'PRE-LAMBDA (:env state))
-            ;; (prn 'POST-LAMBDA (:env ?state) ?value)
-            [::&util/ok [(-> ?state
-                             (update-in [:env] rest)
-                             ;; (update-in [:lambda-scope 1] inc)
-                             )
-                         [(get-in ?state [:lambda-scope 0]) (-> ?state :env first) ?value]]])
+              ;; (prn 'POST-LAMBDA (:env ?state) ?value)
+              [::&util/ok [(-> ?state
+                               (update-in [:env] rest)
+                               ;; (update-in [:lambda-scope 1] inc)
+                               )
+                           [(get-in ?state [:lambda-scope 0]) (-> ?state :env first) ?value]]])
           
           _
           =return)))))
@@ -221,12 +269,12 @@
   )
 
 (defanalyser analyse-variant
-  [::&parser/tagged ?tag ?value]
+  [::&parser/variant ?tag ?data]
   (exec [;; :let [_ (prn 'analyse-variant [?tag ?value])]
-         =value (analyse-form* ?value)
+         =data (map-m analyse-form* ?data)
          ;; :let [_ (prn '=value =value)]
          ]
-    (return (annotated [::variant ?tag =value] [::&type/variant ?tag (:type =value)]))))
+    (return (annotated [::variant ?tag =data] [::&type/variant ?tag (map :type =data)]))))
 
 (defanalyser analyse-tuple
   [::&parser/tuple ?elems]
@@ -239,7 +287,9 @@
   ;;        ;; :let [_ (prn 'analyse-ident ?ident _env)]
   ;;        ]
   ;;   (resolve ?ident))
-  (exec [=ident (resolve ?ident)
+  (exec [;; :let [_ (prn 'analyse-ident '?ident ?ident)]
+         =ident (resolve ?ident)
+         ;; :let [_ (prn 'analyse-ident '=ident =ident)]
          ;; :let [_ (prn 'analyse-ident ?ident =ident)]
          ;; state &util/get-state
          ;; :let [_ (prn 'analyse-ident ?ident (:form =ident) (:env state))]
@@ -378,21 +428,117 @@
   (exec [;; :let [_ (prn '?variant ?variant)]
          =variant (analyse-form* ?variant)
          ;; :let [_ (prn '=variant =variant)]
-         =branches (map-m (fn [branch]
-                            ;; (prn 'branch branch)
-                            (match branch
-                              [::&parser/case-branch [::&parser/tagged ?tag [::&parser/ident ?label]] ?body]
-                              (exec [;; :let [_ (prn ?tag ?label '?body ?body)]
-                                     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)
+         ;; {: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 [=members (reduce-m (fn [[locals-map =members] [?local ?member]]
+                                                                                             (match ?member
+                                                                                               [::&parser/ident ?name]
+                                                                                               (return [(assoc locals-map ?name ?local) (conj =members (:form ?local))])))
+                                                                                           [{} []]
+                                                                                           (map vector =locals ?members))
+                                                                        ;; :let [_ (prn (first =members) ?body)]
+                                                                        =body (with-locals (first =members)
+                                                                                (analyse-form* ?body))
+                                                                        ;; :let [_ (prn '?body ?body =body)]
+                                                                        ]
+                                                                   (return [num-members [::branch-adt ?tag (second =members) =body]])))))))
+                                                       ?branches)]
+                                 (return [(first =locals) =branches]))))
+         :let [total-registers (reduce + 1 (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)]
          ]
-    (return (annotated [::case =variant =branches] ::&type/nothing))))
+    (return (annotated [::case $base =variant total-registers (map second =branches)] ::&type/nothing))))
 
 (defanalyser analyse-let
   [::&parser/let ?label ?value ?body]
@@ -426,9 +572,9 @@
     [::&parser/ident ?name]
     (exec [=value (with-scope ?name
                     (analyse-form* ?value))
-           _ (define ?name {:mode ::constant
+           _ (define ?name {:mode   ::constant
                             :access ::public
-                            :type (:type =value)})]
+                            :type   (:type =value)})]
       (return (annotated [::def ?name =value] ::&type/nothing)))
 
     [::&parser/fn-call [::&parser/ident ?name] ?args]
@@ -443,17 +589,18 @@
              ;;               (into (map vector args =args)))
              ;;       _ (prn 'env env)]
              =value (with-scope ?name
-                      (reduce (fn [inner [label type]]
-                                (with-local label type inner))
-                              (analyse-form* ?value)
-                              (reverse (map vector args =args))))
+                      (with-scoped-name ?name =function
+                        (reduce (fn [inner [label type]]
+                                  (with-local label type inner))
+                                (analyse-form* ?value)
+                                (reverse (map vector args =args)))))
              ;; :let [_ (prn '=value =value)]
              =function (within :types (exec [_ (&type/solve =return (:type =value))]
                                         (&type/clean =function)))
              ;; :let [_ (prn '=function =function)]
-             _ (define ?name {:mode ::function
+             _ (define ?name {:mode   ::function
                               :access ::public
-                              :type =function})]
+                              :type   =function})]
         (return (annotated [::def [?name args] =value] ::&type/nothing))))
     ))
 
diff --git a/src/lang/compiler.clj b/src/lang/compiler.clj
index 1595fe58e..e425fa0f1 100644
--- a/src/lang/compiler.clj
+++ b/src/lang/compiler.clj
@@ -20,7 +20,29 @@
   (with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. file))]
     (.write stream data)))
 
-(def ^:private +variant-class+ "test2.Tagged")
+(defn ^:private normalize-char [char]
+  (case char
+    \* "_ASTER_"
+    \+ "_PLUS_"
+    \- "_DASH_"
+    \/ "_SLASH_"
+    \_ "_UNDERS_"
+    \% "_PERCENT_"
+    \$ "_DOLLAR_"
+    \! "_BANG_"
+    \' "_QUOTE_"
+    \` "_BQUOTE_"
+    \@ "_AT_"
+    \^ "_CARET_"
+    \& "_AMPERS_"
+    \= "_EQ_"
+    ;; default
+    char))
+
+(defn ^:private normalize-ident [ident]
+  (reduce str "" (map normalize-char ident)))
+
+(def ^:private +variant-class+ "test2.Variant")
 
 (defmacro ^:private defcompiler [name match body]
   `(defn ~name [~'*state*]
@@ -28,6 +50,7 @@
            ~'*writer* (:writer ~'*state*)
            ~'*parent* (:parent ~'*state*)
            ~'*type* (:type (:form ~'*state*))]
+       ;; (prn '~name (:form (:form ~'*state*)))
        (match (:form (:form ~'*state*))
          ~match
          (do ~body
@@ -58,6 +81,9 @@
 
 (defn ^:private ->java-sig [type]
   (match type
+    ::&type/any
+    (->java-sig [::&type/object "java.lang.Object" []])
+    
     [::&type/object ?name []]
     (->type-signature ?name)
 
@@ -143,7 +169,7 @@
   (do ;; (prn 'GLOBAL ?owner-class ?name *type*)
       ;; (prn 'compile-global (->class (str ?owner-class "$" ?name)) "_datum")
       (doto *writer*
-        (.visitFieldInsn Opcodes/GETSTATIC (->class (str ?owner-class "$" ?name)) "_datum" "Ljava/lang/Object;" ;; (->java-sig *type*)
+        (.visitFieldInsn Opcodes/GETSTATIC (->class (str ?owner-class "$" (normalize-ident ?name))) "_datum" "Ljava/lang/Object;" ;; (->java-sig *type*)
                          ))))
 
 ;; (defcompiler ^:private compile-call
@@ -169,7 +195,7 @@
               signature (if (> (count ?args) 1)
                           (str "(" (apply str counter-sig (repeat (dec num-args) clo-field-sig)) ")" "V")
                           (str "()" "V"))
-              call-class (str (->class ?owner-class) "$" ?fn-name)]
+              call-class (str (->class ?owner-class) "$" (normalize-ident ?fn-name))]
           (doto *writer*
             (.visitTypeInsn Opcodes/NEW call-class)
             (.visitInsn Opcodes/DUP)
@@ -220,14 +246,15 @@
 
 (defcompiler ^:private compile-dynamic-method
   [::&analyser/dynamic-method ?target ?owner ?method-name ?method-type ?args]
-  (do ;; (prn 'compile-dynamic-access ?target ?owner ?method-name ?method-type ?args)
+  (do ;; (prn 'compile-dynamic-method ?target ?owner ?method-name ?method-type ?args)
       ;; (assert false)
       (do (compile-form (assoc *state* :form ?target))
         (doseq [arg ?args]
           (compile-form (assoc *state* :form arg)))
         (doto *writer*
           (.visitMethodInsn Opcodes/INVOKEVIRTUAL (->class ?owner) ?method-name (method->sig ?method-type))
-          (.visitInsn Opcodes/ACONST_NULL)))
+          (.visitInsn Opcodes/ACONST_NULL)
+          ))
     ))
 
 (defcompiler ^:private compile-if
@@ -235,16 +262,18 @@
   (let [else-label (new Label)
         end-label (new Label)]
     ;; (println "PRE")
-    (assert (compile-form (assoc *state* :form ?test)) "CAN't COMPILE TEST")
+    (compile-form (assoc *state* :form ?test))
     (doto *writer*
       (.visitMethodInsn Opcodes/INVOKEVIRTUAL (->class "java.lang.Boolean") "booleanValue" "()Z")
       (.visitJumpInsn Opcodes/IFEQ else-label))
     ;; (prn 'compile-if/?then (:form ?then))
-    (assert (compile-form (assoc *state* :form ?then)) "CAN't COMPILE THEN")
+    (compile-form (assoc *state* :form ?then))
+    ;; (.visitInsn *writer* Opcodes/POP)
     (doto *writer*
       (.visitJumpInsn Opcodes/GOTO end-label)
       (.visitLabel else-label))
-    (assert (compile-form (assoc *state* :form ?else)) "CAN't COMPILE ELSE")
+    (compile-form (assoc *state* :form ?else))
+    ;; (.visitInsn *writer* Opcodes/POP)
     (.visitLabel *writer* end-label)))
 
 (defcompiler ^:private compile-do
@@ -257,34 +286,48 @@
 (let [oclass (->class "java.lang.Object")
       equals-sig (str "(" (->type-signature "java.lang.Object") ")Z")]
   (defcompiler ^:private compile-case
-    [::&analyser/case ?variant ?branches]
-    (do (compile-form (assoc *state* :form ?variant))
-      (let [end-label (new Label)]
-        (doseq [[?tag ?label ?idx ?body] ?branches]
-          ;; (prn '[?tag ?label ?idx ?body] [?tag ?label ?idx ?body])
-          (let [else-label (new Label)]
-            (doto *writer*
-              (.visitInsn Opcodes/DUP)
-              (.visitFieldInsn Opcodes/GETFIELD (->class +variant-class+) "tag" "Ljava/lang/String;")
-              (.visitLdcInsn ?tag)
-              (.visitMethodInsn Opcodes/INVOKEVIRTUAL oclass "equals" equals-sig)
-              (.visitJumpInsn Opcodes/IFEQ else-label))
-            (let [start-label (new Label)
-                  end-label (new Label)]
-              (doto *writer*
-                (.visitInsn Opcodes/DUP)
-                (.visitFieldInsn Opcodes/GETFIELD (->class +variant-class+) "value" (->type-signature "java.lang.Object")))
-              (.visitLocalVariable *writer* ?label (->type-signature "java.lang.Object") nil start-label end-label ?idx)
-              (doto *writer*
-                (.visitVarInsn Opcodes/ASTORE ?idx)
-                (.visitLabel start-label)
-                (.visitInsn Opcodes/POP))
-              (compile-form (assoc *state* :form ?body))
-              (.visitLabel *writer* end-label))
-            (doto *writer*
-              (.visitJumpInsn Opcodes/GOTO end-label)
-              (.visitLabel else-label))))
-        (.visitLabel *writer* end-label))
+    ;; [::&analyser/case ?variant ?branches]
+    [::&analyser/case ?base ?variant ?registers ?branches]
+    (do ;; (prn [:case ?base ?variant ?registers ?branches])
+      (match (:form ?base)
+        [::&analyser/local _ ?base-idx]
+        (let [start-label (new Label)
+              end-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))
+          (.visitVarInsn *writer* Opcodes/ASTORE ?base-idx)
+          (let [variant-class* (->class +variant-class+)]
+            (doseq [?branch ?branches
+                    :let [else-label (new Label)]]
+              (match ?branch
+                [::&analyser/branch-adt ?tag ?members ?body]
+                (let [tuple-class (str "test2/Tuple" (count ?members))]
+                  (when (not (empty? ?members))
+                    (do (doto *writer*
+                          (.visitVarInsn Opcodes/ALOAD ?base-idx)
+                          (.visitFieldInsn Opcodes/GETFIELD variant-class* "value" (->type-signature "java.lang.Object"))
+                          (.visitTypeInsn Opcodes/CHECKCAST tuple-class))
+                      (doseq [[?tfield member] (map vector (range (count ?members)) ?members)]
+                        (match member
+                          [:lang.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))))
+                      (.visitInsn *writer* Opcodes/POP)))
+                  (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 (compile-form (assoc *state* :form ?body)))
+                    (.visitJumpInsn Opcodes/GOTO end-label)
+                    (.visitLabel else-label))))))
+          (.visitInsn *writer* Opcodes/ACONST_NULL)
+          (.visitLabel *writer* end-label)))
       )))
 
 (defcompiler ^:private compile-let
@@ -293,7 +336,7 @@
         end-label (new Label)
         ?idx (int ?idx)]
     ;; (prn '(:type ?value) (:type ?value) (->java-sig (:type ?value)))
-    (.visitLocalVariable *writer* ?label (->java-sig (:type ?value)) nil start-label end-label ?idx)
+    (.visitLocalVariable *writer* (normalize-ident ?label) (->java-sig (:type ?value)) nil start-label end-label ?idx)
     (assert (compile-form (assoc *state* :form ?value)) "CAN't COMPILE LET-VALUE")
     (doto *writer*
       (.visitVarInsn Opcodes/ASTORE ?idx)
@@ -307,7 +350,7 @@
         counter-sig "I"
         apply-signature "(Ljava/lang/Object;)Ljava/lang/Object;"
         real-signature (str "(" (apply str (repeat num-args clo-field-sig)) ")" "Ljava/lang/Object;")
-        current-class (str outer-class "$" fn-name)
+        current-class (str outer-class "$" (normalize-ident fn-name))
         num-captured (dec num-args)
         init-signature (if (not= 0 num-captured)
                          (str "(" (apply str counter-sig (repeat num-captured clo-field-sig)) ")" "V")
@@ -420,7 +463,7 @@
                     =method (doto (.visitMethod *writer* (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) ?name signature nil nil)
                               (.visitCode))]
                 ;; (prn 'FN/?body ?body)
-                (assert (compile-form (assoc *state* :parent *writer* :writer =method :form ?body)) (str "Body couldn't compile: " (pr-str ?body)))
+                (compile-form (assoc *state* :parent *writer* :writer =method :form ?body))
                 (doto =method
                   (.visitInsn Opcodes/RETURN)
                   (.visitMaxs 0 0)
@@ -605,7 +648,7 @@
       (.write stream (.toByteArray =interface)))))
 
 (defcompiler ^:private compile-variant
-  [::&analyser/variant ?tag ?value]
+  [::&analyser/variant ?tag ?members]
   (let [variant-class* (->class +variant-class+)]
     ;; (prn 'compile-variant ?tag ?value)
     (doto *writer*
@@ -614,9 +657,18 @@
       (.visitMethodInsn Opcodes/INVOKESPECIAL variant-class* "<init>" "()V")
       (.visitInsn Opcodes/DUP)
       (.visitLdcInsn ?tag)
-      (.visitFieldInsn Opcodes/PUTFIELD variant-class* "tag" "Ljava/lang/String;")
+      (.visitFieldInsn Opcodes/PUTFIELD variant-class* "tag" (->type-signature "java.lang.String"))
       (.visitInsn Opcodes/DUP))
-    (assert (compile-form (assoc *state* :form ?value)) (pr-str "Can't compile value: " ?value))
+    (let [tuple-class (str "test2/Tuple" (count ?members))]
+      (doto *writer*
+        (.visitTypeInsn Opcodes/NEW tuple-class)
+        (.visitInsn Opcodes/DUP)
+        (.visitMethodInsn Opcodes/INVOKESPECIAL tuple-class "<init>" "()V"))
+      (doseq [[?tfield ?member] (mapv vector (range (count ?members)) ?members)]
+        (doto *writer*
+          (.visitInsn Opcodes/DUP)
+          (do (compile-form (assoc *state* :form ?member)))
+          (.visitFieldInsn Opcodes/PUTFIELD tuple-class (str "_" ?tfield) "Ljava/lang/Object;"))))
     (doto *writer*
       (.visitFieldInsn Opcodes/PUTFIELD variant-class* "value" "Ljava/lang/Object;"))
     ))
@@ -681,13 +733,15 @@
       (when (not (compile-form (assoc state :form input)))
         (assert false input)))
     (.visitEnd =class)
-    (.toByteArray =class))
-
-  (comment
-    (-> (java.io.File. "./") .toURL vector into-array java.net.URLClassLoader. (.loadClass "test2"))
-    (-> (java.io.File. "./") .toURL vector into-array java.net.URLClassLoader. (.loadClass "test2.Function"))
-    (let [test2 (-> (java.io.File. "./") .toURL vector into-array java.net.URLClassLoader. (.loadClass "test2"))
-          main (first (.getDeclaredMethods test2))]
-      (.invoke main nil (to-array [nil])))
-    )
+    (let [=array (.toByteArray =class)]
+      ;; (prn 'compile class-name =array)
+      =array))
+
+  ;; (comment
+  ;;   (-> (java.io.File. "./") .toURL vector into-array java.net.URLClassLoader. (.loadClass "test2"))
+  ;;   (-> (java.io.File. "./") .toURL vector into-array java.net.URLClassLoader. (.loadClass "test2.Function"))
+  ;;   (let [test2 (-> (java.io.File. "./") .toURL vector into-array java.net.URLClassLoader. (.loadClass "test2"))
+  ;;         main (first (.getDeclaredMethods test2))]
+  ;;     (.invoke main nil (to-array [nil])))
+  ;;   )
   )
diff --git a/src/lang/parser.clj b/src/lang/parser.clj
index 376e376d6..48f624ba4 100644
--- a/src/lang/parser.clj
+++ b/src/lang/parser.clj
@@ -137,10 +137,19 @@
                     [?member [(map ident->string ?inputs) (ident->string ?output)]]))]
     (return [::definterface ?name members])))
 
-(defparser ^:private parse-tagged
-  [::&lexer/list ([[::&lexer/tag ?tag] ?data] :seq)]
-  (exec [=data (apply-m parse-form (list ?data))]
-    (return [::tagged ?tag =data])))
+(defparser ^:private parse-variant
+  ?token
+  (match ?token
+    [::&lexer/tag ?tag]
+    (return [::variant ?tag '()])
+
+    [::&lexer/list ([[::&lexer/tag ?tag] & ?data] :seq)]
+    (exec [=data (map-m #(apply-m parse-form (list %))
+                        ?data)]
+      (return [::variant ?tag =data]))
+
+    _
+    (fail (str "Unmatched token: " ?token))))
 
 (defparser ^:private parse-get
   [::&lexer/list ([[::&lexer/ident "get@"] [::&lexer/tag ?tag] ?record] :seq)]
@@ -191,7 +200,7 @@
               parse-do
               parse-case
               parse-let
-              parse-tagged
+              parse-variant
               parse-get
               parse-set
               parse-remove
diff --git a/src/lang/util.clj b/src/lang/util.clj
index cdfa8555d..e2edfb550 100644
--- a/src/lang/util.clj
+++ b/src/lang/util.clj
@@ -59,14 +59,14 @@
     (match (monad state)
       [::ok [?state ?head]]
       (do ;; (prn 'repeat-m/?state ?state)
-        (match ((repeat-m monad) ?state)
-          [::ok [?state* ?tail]]
-          (do ;; (prn 'repeat-m/?state* ?state*)
-            (return* ?state* (cons ?head ?tail)))))
+          (match ((repeat-m monad) ?state)
+            [::ok [?state* ?tail]]
+            (do ;; (prn 'repeat-m/?state* ?state*)
+                (return* ?state* (cons ?head ?tail)))))
       
       [::failure ?message]
       (do ;; (println "Failed at last:" ?message)
-        (return* state '())))))
+          (return* state '())))))
 
 (defn try-all-m [monads]
   (fn [state]
@@ -89,6 +89,12 @@
            outputs (map-m f (rest inputs))]
       (return (conj outputs output)))))
 
+(defn reduce-m [f init inputs]
+  (if (empty? inputs)
+    (return init)
+    (exec [init* (f init (first inputs))]
+      (reduce-m f init* (rest inputs)))))
+
 (defn apply-m [monad call-state]
   (fn [state]
     ;; (prn 'apply-m monad call-state)