From b7d44ba74240a2421896205af56dda7e1f929762 Mon Sep 17 00:00:00 2001
From: Calvin Rose <calsrose@gmail.com>
Date: Fri, 7 Dec 2018 23:57:19 -0500
Subject: [PATCH] Fix compiler optimization for if. Add pattern matching
 library.

---
 lib/match.janet     | 49 +++++++++++++++++++++++++++++++++++++++++++++
 src/core/core.janet | 12 ++++++++++-
 src/core/specials.c |  2 +-
 3 files changed, 61 insertions(+), 2 deletions(-)
 create mode 100644 lib/match.janet

diff --git a/lib/match.janet b/lib/match.janet
new file mode 100644
index 00000000..a936f66e
--- /dev/null
+++ b/lib/match.janet
@@ -0,0 +1,49 @@
+
+# Sentinel value bad matches
+(def- sentinel ~',(gensym))
+
+(defn- match-1
+  [pattern expr onmatch seen]
+  (cond
+    (and (symbol? pattern) (not (keyword? pattern)))
+    (if (get seen pattern)
+      ~(if (= ,pattern ,expr) ,onmatch ,sentinel)
+      (do
+        (put seen pattern true)
+        ~(if (= nil (def ,pattern ,expr)) ,sentinel ,onmatch)))
+    (indexed? pattern) 
+    (do
+      (def len (length pattern))
+      (def $arr (gensym))
+      (defn aux [i]
+        (if (= i len)
+          onmatch
+          (match-1 pattern.i ~(get ,$arr ,i) (aux (+ i 1)) seen)))
+      ~(do (def ,$arr ,expr) ,(aux 0)))
+    (dictionary? pattern)
+    (do
+      (def $dict (gensym))
+      (defn aux [key]
+        (if (= key nil)
+          onmatch
+          (match-1 (get pattern key) ~(get ,$dict ,key) (aux (next pattern key)) seen)))
+      ~(do (def ,$dict ,expr) ,(aux (next pattern nil))))
+    :else ~(if (= ,pattern ,expr) ,onmatch ,sentinel)))
+
+(defmacro match
+  "Pattern matching."
+  [x & cases]
+  (if (not (atomic? x))
+    (do (def $x (gensym)) ~(do (def ,$x ,x) ,(match $x ;cases)))
+    (do
+      (def len (length cases))
+      (def len-1 (dec len))
+      (defn aux [i]
+        (cond
+          (= i len-1) (get cases i)
+          (< i len-1) (do
+                        (def $res (gensym))
+                        ~(if (= ,sentinel (def ,$res ,(match-1 cases.i x (get cases (inc i)) @{})))
+                           ,(aux (+ 2 i))
+                           ,$res))))
+      (aux 0))))
diff --git a/src/core/core.janet b/src/core/core.janet
index a502fc9e..af9d4275 100644
--- a/src/core/core.janet
+++ b/src/core/core.janet
@@ -60,7 +60,7 @@
 (defmacro def-
   "Define a private value that will not be exported."
   [name & more]
-  ~(def name :private ,;more))
+  ~(def ,name :private ,;more))
 
 (defn defglobal
   "Dynamically create a global def."
@@ -614,6 +614,16 @@
       (array/push res item)))
   res)
 
+(defn count
+  "Count the number of items in ind for which (pred item)
+  is true."
+  [pred ind]
+  (var counter 0)
+  (loop [item :in ind]
+    (if (pred item)
+      (++ counter)))
+  counter)
+
 (defn keep
   "Given a predicate, take only elements from an array or tuple for
   which (pred element) is truthy. Returns a new array of truthy predicate results."
diff --git a/src/core/specials.c b/src/core/specials.c
index 58c6d52b..ab7b56ad 100644
--- a/src/core/specials.c
+++ b/src/core/specials.c
@@ -359,8 +359,8 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
         janetc_scope(&tempscope, c, 0, "if-body");
         target = janetc_value(bodyopts, truebody);
         janetc_popscope(c);
-        janetc_popscope(c);
         janetc_throwaway(bodyopts, falsebody);
+        janetc_popscope(c);
         return target;
     }