tag-match handles size; tag 0.8.39

calcit-lang · Mar 12, 2024 · a46d3e4 · a46d3e4
1 parent c99138a
commit a46d3e4
Show file tree

Hide file tree

Showing 6 changed files with 45 additions and 26 deletions.
diff --git a/Cargo.lock b/Cargo.lock
diff --git a/Cargo.toml b/Cargo.toml
@@ -1,6 +1,6 @@
 [package]
 name = "calcit"
-version = "0.8.38"
+version = "0.8.39"
 authors = ["jiyinyiyong <jiyinyiyong@gmail.com>"]
 edition = "2021"
 license = "MIT"

diff --git a/calcit/test-cond.cirru b/calcit/test-cond.cirru
@@ -112,6 +112,12 @@
         |test-tag-match $ %{} :CodeEntry (:doc |)
           :code $ quote
             fn () (log-title "|Testing tag-match")
+
+              ; println |EXPANDED $ format-to-cirru $ macroexpand-all $ quote $ tag-match (:: :a 1)
+                (:a x) 1
+                (:a x y) 2
+                _ :none
+
               &let
                 match-ab $ fn (data)
                   tag-match data
@@ -130,7 +136,7 @@
                   [] "|no match"
                 assert=
                   match-ab $ :: :a 1 2
-                  [] "|pattern a:" 1
+                  [] "|no match"
                 assert=
                   match-ab $ :: :b 1 2
                   [] "|pattern b:" 1 2

diff --git a/calcit/test-tuple.cirru b/calcit/test-tuple.cirru
@@ -52,6 +52,23 @@
                   (:none) (:: :empty)
                   (:some k0 v0 ms)
                     :: :parts $ count ms
+
+              assert= 1 $ try-size $ :: :dyn
+              assert= 2 $ try-size $ :: :dyn 1
+              assert= 3 $ try-size $ :: :dyn 1 2
+              assert= 4 $ try-size $ :: :dyn 1 2 3
+              assert= :many $ try-size $ :: :dyn 1 2 3 4
+              assert= :many $ try-size $ :: :dyn 1 2 3 4 5
+        |try-size $ %{} :CodeEntry (:doc |)
+          :code $ quote
+            defn try-size (x)
+              tag-match x
+                (:dyn) 1
+                (:dyn x) 2
+                (:dyn x y) 3
+                (:dyn x y z) 4
+                _ :many
+
       :ns $ %{} :CodeEntry (:doc |)
         :code $ quote
           ns test-tuple.main $ :require

diff --git a/package.json b/package.json
@@ -1,6 +1,6 @@
 {
   "name": "@calcit/procs",
-  "version": "0.8.38",
+  "version": "0.8.39",
   "main": "./lib/calcit.procs.mjs",
   "devDependencies": {
     "@types/node": "^20.11.8",

diff --git a/src/cirru/calcit-core.cirru b/src/cirru/calcit-core.cirru
@@ -456,14 +456,17 @@
                     if (list? pattern)
                       &let
                         k $ &list:first pattern
-                        quasiquote $ if (&= ~t ~k)
-                          let
-                            ~ $ map-indexed (&list:rest pattern)
-                              defn %tag-match (idx x)
-                                [] x $ quasiquote
-                                  &tuple:nth ~value $ ~ (inc idx)
-                            , ~branch
-                          &tag-match-internal ~value ~t $ ~@ (&list:rest body)
+                        &let
+                          size $ &list:count pattern
+                          quasiquote $ if
+                            if (&= ~t ~k) (&= ~size (&tuple:count ~value)) false
+                            let
+                              ~ $ map-indexed (&list:rest pattern)
+                                defn %tag-match (idx x)
+                                  [] x $ quasiquote
+                                    &tuple:nth ~value $ ~ (inc idx)
+                              , ~branch
+                            &tag-match-internal ~value ~t $ ~@ (&list:rest body)
                       if (&= pattern '_) branch $ raise (str-spaced "|unknown supported pattern:" pair)
         |* $ %{} :CodeEntry (:doc |)
           :code $ quote
@@ -1632,23 +1635,16 @@
                 quasiquote $ eprintln "|[Error] tag-match expected some patterns and matches" ~value
                 &let
                   t# $ gensym |tag
-                  if (list? value)
-                    &let
-                      v# $ gensym |v
-                      quasiquote $ &let (~v# ~value)
-                        if
-                          not $ tuple? ~v#
-                          raise $ str "|tag-match expected tuple, got" ~v#
-                        &let
-                          ~t# $ &tuple:nth ~value 0
-                          &tag-match-internal ~v# ~t# $ ~@ body
-                    quasiquote $ &let ()
+                  &let
+                    v# $ gensym |v
+                    quasiquote $ &let (~v# ~value)
                       if
-                        not $ tuple? ~value
-                        raise $ str "|tag-match expected tuple, got" ~value
+                        not $ tuple? ~v#
+                        raise $ str "|tag-match expected tuple, got" ~v#
                       &let
                         ~t# $ &tuple:nth ~value 0
-                        &tag-match-internal ~value ~t# $ ~@ body
+                        &tag-match-internal ~v# ~t# $ ~@ body
+
         |tag? $ %{} :CodeEntry (:doc |)
           :code $ quote
             defn tag? (x)