- Added pattern-matching on tuples.

- Extended a bit the types of syntax that can be handled inside macros.

2 files changed, 250 insertions, 124 deletions

diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index eb6ca7fdd..6b823b3ee 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -476,18 +476,38 @@
 (defn ->token [x]
   ;; (prn '->token x)
   (match x
-    [::&parser/tag ?tag]
+    [::&parser/bool ?bool]
     (doto (.newInstance (.loadClass loader "test2.Variant1"))
-      (-> .-tag (set! "Tag"))
-      (-> .-_1 (set! ?tag)))
+      (-> .-tag (set! "Bool"))
+      (-> .-_1 (set! ?bool)))
+    [::&parser/int ?int]
+    (doto (.newInstance (.loadClass loader "test2.Variant1"))
+      (-> .-tag (set! "Int"))
+      (-> .-_1 (set! ?int)))
+    [::&parser/real ?real]
+    (doto (.newInstance (.loadClass loader "test2.Variant1"))
+      (-> .-tag (set! "Real"))
+      (-> .-_1 (set! ?real)))
+    [::&parser/char ?elem]
+    (doto (.newInstance (.loadClass loader "test2.Variant1"))
+      (-> .-tag (set! "Char"))
+      (-> .-_1 (set! ?elem)))
     [::&parser/text ?text]
     (doto (.newInstance (.loadClass loader "test2.Variant1"))
       (-> .-tag (set! "Text"))
       (-> .-_1 (set! ?text)))
+    [::&parser/tag ?tag]
+    (doto (.newInstance (.loadClass loader "test2.Variant1"))
+      (-> .-tag (set! "Tag"))
+      (-> .-_1 (set! ?tag)))
     [::&parser/ident ?ident]
     (doto (.newInstance (.loadClass loader "test2.Variant1"))
       (-> .-tag (set! "Ident"))
       (-> .-_1 (set! ?ident)))
+    [::&parser/tuple ?elems]
+    (doto (.newInstance (.loadClass loader "test2.Variant1"))
+      (-> .-tag (set! "Tuple"))
+      (-> .-_1 (set! (->tokens ?elems))))
     [::&parser/form ?elems]
     (doto (.newInstance (.loadClass loader "test2.Variant1"))
       (-> .-tag (set! "Form"))
@@ -508,9 +528,14 @@
 (defn ->clojure-token [x]
   ;; (prn '->clojure-token x (.-tag x))
   (case (.-tag x)
+    "Bool"  [::&parser/bool (-> x .-_1)]
+    "Int"   [::&parser/int (-> x .-_1)]
+    "Real"  [::&parser/real (-> x .-_1)]
+    "Char"  [::&parser/char (-> x .-_1)]
     "Text"  [::&parser/text (-> x .-_1)]
-    "Ident" [::&parser/ident (-> x .-_1)]
     "Tag"   [::&parser/tag (-> x .-_1)]
+    "Ident" [::&parser/ident (-> x .-_1)]
+    "Tuple" [::&parser/tuple (-> x .-_1 tokens->clojure)]
     "Form"  [::&parser/form (-> x .-_1 tokens->clojure)]))
 
 (defn tokens->clojure [xs]
@@ -576,56 +601,87 @@
   (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))))
+(let [fold-branch (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-local ?local]
+                                    (update-in struct [:defaults] conj [::default ?local (nth entry 1)])
+                                    
+                                    [::pm-tuple ?members]
+                                    (clojure.core.match/match (:type struct)
+                                      ::tuple (update-in struct [:patterns]
+                                                         (fn [{:keys [arity cases] :as branch}]
+                                                           (if (= arity (count ?members))
+                                                             (-> branch
+                                                                 (update-in [:cases] conj {:case ?members
+                                                                                           :body (nth entry 1)})
+                                                                 (update-in [:branches] conj (nth entry 1)))
+                                                             (assert false (str "Arity doesn't match. " (count ?members) "=/=" arity)))))
+                                      nil (-> struct
+                                              (assoc :type ::tuple)
+                                              (assoc :patterns {:arity (count ?members)
+                                                                :cases [{:case ?members
+                                                                         :body (nth entry 1)}]
+                                                                :branches #{(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."))
+                                    )]
+                      (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)]
+                          (let [branches* (reduce fold-branch 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*
+                              ::tuple (do (assert (<= (count (:defaults branches*)) 1))
+                                        {:type ::tuple*
+                                         :patterns (into {} (for [[?tag ?struct] {nil (: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*)})
                               ::adt (do (assert (<= (count (:defaults branches*)) 1))
                                       {:type ::adt*
                                        :patterns (into {} (for [[?tag ?struct] (:patterns branches*)
@@ -648,36 +704,43 @@
                                    :branches (:branches branches*)})))
       get-vars (fn get-vars [pattern]
                  (clojure.core.match/match pattern
-                   [::&parser/ident ?name]
-                   (list ?name)
+                   [::&parser/text ?text]
+                   '()
 
                    [::&parser/tag _]
                    '()
 
-                   [::&parser/form ([[::&parser/tag _] & ?members] :seq)]
+                   [::&parser/ident ?name]
+                   (list ?name)
+
+                   [::&parser/tuple ?members]
                    (mapcat get-vars ?members)
 
                    [::&parser/variant ?tag ?members]
                    (mapcat get-vars ?members)
-                   
-                   [::&parser/text ?text]
-                   '()))
+
+                   [::&parser/form ([[::&parser/tag _] & ?members] :seq)]
+                   (mapcat get-vars ?members)
+                   ))
       ->instructions (fn ->instructions [locals pattern]
                        (clojure.core.match/match pattern
+                         [::&parser/text ?text]
+                         [::pm-text ?text]
+
                          [::&parser/tag ?tag]
                          [::pm-variant ?tag '()]
 
-                         [::&parser/form ([[::&parser/tag ?tag] & ?members] :seq)]
-                         [::pm-variant ?tag (map (partial ->instructions locals) ?members)]
+                         [::&parser/ident ?name]
+                         [::pm-local (get locals ?name)]
+
+                         [::&parser/tuple ?members]
+                         [::pm-tuple (map (partial ->instructions locals) ?members)]
 
                          [::&parser/variant ?tag ?members]
                          [::pm-variant ?tag (map (partial ->instructions locals) ?members)]
-                         
-                         [::&parser/ident ?name]
-                         [::pm-local (get locals ?name)]
-                         
-                         [::&parser/text ?text]
-                         [::pm-text ?text]
+
+                         [::&parser/form ([[::&parser/tag ?tag] & ?members] :seq)]
+                         [::pm-variant ?tag (map (partial ->instructions locals) ?members)]
                          ))]
   (defn ->decision-tree [$scope $base branches]
     (let [;; Step 1: Get all vars
@@ -706,52 +769,64 @@
           ]
       [max-registers branch-mappings (generate-branches branches**)])))
 
-(defanalyser analyse-case
-  [::&parser/form ([[::&parser/ident "case"] ?variant & ?branches] :seq)]
-  (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 [[?pattern ?body]]
-                                                             ;; (prn '?branch ?branch)
-                                                             (match ?pattern
-                                                               [::&parser/ident ?name]
-                                                               (exec [=body (with-locals {?name (annotated [::local $scope $base] [::&type/object "java.lang.Object" []])}
-                                                                              (analyse-form* ?body))]
-                                                                 (return [::case-branch [::&parser/ident ?name] =body]))
-
-                                                               [::&parser/tag ?tag]
-                                                               (exec [=body (analyse-form* ?body)]
-                                                                 (return [::case-branch [::&parser/variant ?tag '()] =body]))
-                                                               
-                                                               [::&parser/form ([[::&parser/tag ?tag] & ?members] :seq)]
-                                                               (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/form ([[::&parser/tag ?subtag] & ?submembers] :seq)]
-                                                                                                (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 [::case-branch [::&parser/variant ?tag ?members] =body]))
-                                                               ))
-                                                           (partition 2 ?branches))]
-                                     (return (->decision-tree $scope $base =branches)))
-         ;; :let [_ (prn 'analyse-case '[registers mappings tree] [registers mappings tree])]
-         ]
-    (return (annotated [::case (dec $base) =variant registers mappings tree] ::&type/nothing))))
+(let [locals-getter (fn [$scope]
+                      (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/tuple ?submembers]
+                          (reduce-m member-fold [$local locals-map] ?submembers)
+
+                          [::&parser/form ([[::&parser/tag ?subtag] & ?submembers] :seq)]
+                          (reduce-m member-fold [$local locals-map] ?submembers)
+
+                          _
+                          (return [$local locals-map])
+                          )))]
+  (defanalyser analyse-case
+    [::&parser/form ([[::&parser/ident "case"] ?variant & ?branches] :seq)]
+    (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 [[?pattern ?body]]
+                                                               ;; (prn '?branch ?branch)
+                                                               (match ?pattern
+                                                                 [::&parser/ident ?name]
+                                                                 (exec [=body (with-locals {?name (annotated [::local $scope $base] [::&type/object "java.lang.Object" []])}
+                                                                                (analyse-form* ?body))]
+                                                                   (return [::case-branch [::&parser/ident ?name] =body]))
+
+                                                                 [::&parser/tag ?tag]
+                                                                 (exec [=body (analyse-form* ?body)]
+                                                                   (return [::case-branch [::&parser/variant ?tag '()] =body]))
+
+                                                                 [::&parser/tuple ?members]
+                                                                 (exec [[_ locals+] (reduce-m (locals-getter $scope) [$base {}] ?members)
+                                                                        ;; :let [_ (prn 'analyse-case 'locals+ locals+)]
+                                                                        =body (with-locals locals+
+                                                                                (analyse-form* ?body))
+                                                                        ;; :let [_ (prn 'analyse-case '=body =body)]
+                                                                        ]
+                                                                   (return [::case-branch [::&parser/tuple ?members] =body]))
+                                                                 
+                                                                 [::&parser/form ([[::&parser/tag ?tag] & ?members] :seq)]
+                                                                 (exec [[_ locals+] (reduce-m (locals-getter $scope) [$base {}] ?members)
+                                                                        ;; :let [_ (prn 'analyse-case 'locals+ locals+)]
+                                                                        =body (with-locals locals+
+                                                                                (analyse-form* ?body))
+                                                                        ;; :let [_ (prn 'analyse-case '=body =body)]
+                                                                        ]
+                                                                   (return [::case-branch [::&parser/variant ?tag ?members] =body]))
+                                                                 ))
+                                                             (partition 2 ?branches))]
+                                       (return (->decision-tree $scope $base =branches)))
+           ;; :let [_ (prn 'analyse-case '[registers mappings tree] [registers mappings tree])]
+           ]
+      (return (annotated [::case (dec $base) =variant registers mappings tree] ::&type/nothing)))))
 
 (defanalyser analyse-let
   [::&parser/form ([[::&parser/ident "let"] [::&parser/ident ?label] ?value ?body] :seq)]
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index a98687971..aea9ea1e2 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -42,6 +42,7 @@
     ))
 
 (def ^:private +variant-class+ "test2.Variant")
+(def ^:private +tuple-class+ "test2.Tuple")
 
 (defmacro ^:private defcompiler [name match body]
   `(defn ~name [~'*state*]
@@ -308,6 +309,7 @@
 
 (let [+tag-sig+ (->type-signature "java.lang.String")
       variant-class* (->class +variant-class+)
+      tuple-class* (->class +tuple-class+)
       oclass (->class "java.lang.Object")
       +variant-field-sig+ (->type-signature "java.lang.Object")
       equals-sig (str "(" (->type-signature "java.lang.Object") ")Z")]
@@ -333,6 +335,32 @@
         (.visitVarInsn Opcodes/ASTORE ?idx)
         (.visitJumpInsn Opcodes/GOTO (get mappings $body)))
       
+      [::test-tuple ?branches ?cases]
+      (let [[_ ?subcases] (first ?cases)
+            arity (-> ?subcases first (nth 2) count)
+            tuple-class** (str tuple-class* arity)]
+        (doto writer
+          ;; object
+          (.visitTypeInsn Opcodes/CHECKCAST tuple-class**) ;; tuple
+          (do (doseq [subcase ?subcases
+                      :let [next-subcase (new Label)]]
+                (match subcase
+                  [::subcase $body ?subseq]
+                  (do (doseq [[?subpart ?subidx] (map vector ?subseq (range (count ?subseq)))
+                              :let [sub-next-elem (new Label)]]
+                        (doto writer
+                          (.visitInsn Opcodes/DUP) ;; tuple, tuple
+                          (.visitFieldInsn Opcodes/GETFIELD tuple-class** (str "_" (inc ?subidx)) +variant-field-sig+) ;; tuple, object
+                          (compile-decision-tree (assoc mappings $body sub-next-elem) next-subcase ?subpart) ;; tuple
+                          (.visitLabel sub-next-elem)))
+                    (doto writer
+                      (.visitInsn Opcodes/POP)
+                      (.visitJumpInsn Opcodes/GOTO (get mappings $body))
+                      (.visitLabel next-subcase)))
+                  )))
+          (.visitInsn Opcodes/POP) ;; ->
+          (.visitJumpInsn Opcodes/GOTO default-label)))
+
       [::test-adt ?branches ?cases]
       (doto writer
         ;; object
@@ -402,6 +430,29 @@
                                    :when (contains? branches ?body)]
                                [[::store ?local ?body] #{?body}]))
 
+                     ::&analyser/tuple*
+                     (concat (let [patterns (into {} (for [[?tag ?struct] (:patterns head)
+                                                           ;; :let [_ (.print System/out (prn-str 'PATTERN ?tag ?struct))]
+                                                           :let [?parts (:parts ?struct)
+                                                                 num-parts (count ?parts)
+                                                                 ?supports (:branches ?struct)
+                                                                 subcases (for [?body (set/intersection branches ?supports)
+                                                                                subseq (sequence-parts #{?body} ?parts)
+                                                                                ;; :let [_ (when (= "Symbol" ?tag)
+                                                                                ;;           (.print System/out (prn-str 'counting ?tag num-parts (count subseq) subseq)))]
+                                                                                :when (= num-parts (count subseq))]
+                                                                            [::subcase ?body subseq])]
+                                                           :when (not (empty? subcases))]
+                                                       [?tag subcases]))]
+                               (if (empty? patterns)
+                                 '()
+                                 (list [[::test-tuple branches patterns]
+                                        branches])))
+                             (if-let [[_ ?local ?body] (:default head)]
+                               (for [?body (set/intersection branches #{?body})]
+                                 [[::default ?local ?body] #{?body}])
+                               '()))
+
                      ::&analyser/adt*
                      (do ;; (prn '(:default head) (:default head))
                          ;; (assert (nil? (:default head)))
@@ -422,27 +473,27 @@
                          ;;     '()
                          ;;     (list [[::test-adt branches patterns]
                          ;;            branches])))
-                       (concat (let [patterns (into {} (for [[?tag ?struct] (:patterns head)
-                                                             ;; :let [_ (.print System/out (prn-str 'PATTERN ?tag ?struct))]
-                                                             :let [?parts (:parts ?struct)
-                                                                   num-parts (count ?parts)
-                                                                   ?supports (:branches ?struct)
-                                                                   subcases (for [?body (set/intersection branches ?supports)
-                                                                                  subseq (sequence-parts #{?body} ?parts)
-                                                                                  ;; :let [_ (when (= "Symbol" ?tag)
-                                                                                  ;;           (.print System/out (prn-str 'counting ?tag num-parts (count subseq) subseq)))]
-                                                                                  :when (= num-parts (count subseq))]
-                                                                              [::subcase ?body subseq])]
-                                                             :when (not (empty? subcases))]
-                                                         [?tag subcases]))]
-                                 (if (empty? patterns)
-                                   '()
-                                   (list [[::test-adt branches patterns]
-                                          branches])))
-                               (if-let [[_ ?local ?body] (:default head)]
-                                 (for [?body (set/intersection branches #{?body})]
-                                   [[::default ?local ?body] #{?body}])
-                                 '()))
+                         (concat (let [patterns (into {} (for [[?tag ?struct] (:patterns head)
+                                                               ;; :let [_ (.print System/out (prn-str 'PATTERN ?tag ?struct))]
+                                                               :let [?parts (:parts ?struct)
+                                                                     num-parts (count ?parts)
+                                                                     ?supports (:branches ?struct)
+                                                                     subcases (for [?body (set/intersection branches ?supports)
+                                                                                    subseq (sequence-parts #{?body} ?parts)
+                                                                                    ;; :let [_ (when (= "Symbol" ?tag)
+                                                                                    ;;           (.print System/out (prn-str 'counting ?tag num-parts (count subseq) subseq)))]
+                                                                                    :when (= num-parts (count subseq))]
+                                                                                [::subcase ?body subseq])]
+                                                               :when (not (empty? subcases))]
+                                                           [?tag subcases]))]
+                                   (if (empty? patterns)
+                                     '()
+                                     (list [[::test-adt branches patterns]
+                                            branches])))
+                                 (if-let [[_ ?local ?body] (:default head)]
+                                   (for [?body (set/intersection branches #{?body})]
+                                     [[::default ?local ?body] #{?body}])
+                                   '()))
                        )
                      )]
       (for [[step branches*] expanded