From 95054ef234990c6254697f0c2122e4c06b5219a3 Mon Sep 17 00:00:00 2001
From: Scott Richmond <kredati@users.noreply.github.com>
Date: Sat, 18 May 2024 17:04:23 -0400
Subject: [PATCH] add match exprs

---
 janet/interpreter.janet | 95 ++++++++++++++++++++++++++++++++++++++---
 1 file changed, 88 insertions(+), 7 deletions(-)

diff --git a/janet/interpreter.janet b/janet/interpreter.janet
index fd3c500..7def00f 100644
--- a/janet/interpreter.janet
+++ b/janet/interpreter.janet
@@ -13,6 +13,9 @@
     :table :dict
     the-type))
 
+(defn- bool [value]
+  (if (= value :^nil nil) value))
+
 (defn- resolve-name [name ctx]
   (print "resolving " name " in:")
   (pp ctx)
@@ -72,6 +75,45 @@
     {:success true :ctx ctx}
     {:success false :miss [pattern value]}))
 
+
+(defn- match-list [pattern value ctx]
+  (when (not (array? value))
+    (break {:success false :miss [pattern value]}))
+  (def val-len (length value))
+  (var members (pattern :data))
+  (def patt-len (length members))
+  (var splat nil)
+  (def splat? (= :splat ((last members) :type)))
+  (when splat?
+    (when (< val-len patt-len)
+      (print "mismatched splatted tuple lenghts")
+      (break {:success false :miss [pattern value]}))
+    (print "splat!")
+    (set splat (last members))
+    (set members (slice members 0 (dec patt-len))))
+  (when (and (not splat?) (not= val-len patt-len))
+    (print "mismatched tuple lengths")
+    (break {:success false :miss [pattern value]}))
+  (var curr-mem :^nothing)
+  (var curr-val :^nothing)
+  (var success true)
+  (for i 0 (length members)
+    (set curr-mem (get members i))
+    (set curr-val (get value i))
+    (print "in tuple, matching " curr-val " with ")
+    (pp curr-mem)
+    (def match? (match-pattern curr-mem curr-val ctx))
+    (pp match?)
+    (when (not (match? :success))
+      (set success false)
+      (break)))
+  (when (and splat? (splat :data))
+    (def rest (array/slice value (length members)))
+    (match-word (splat :data) rest ctx))
+  (if success
+    {:success true :ctx ctx}
+    {:success false :miss [pattern value]}))
+
 (defn- match-pattern* [pattern value &opt ctx]
   (print "in match-pattern, matching " value " with:")
   (pp pattern)
@@ -92,8 +134,9 @@
 
     # TODO: lists, dicts
     :tuple (match-tuple pattern value ctx)
+    :list (match-list pattern value ctx)
     # TODO: string-patterns
-    # TODO: typed
+
     :typed (typed pattern value ctx)
   ))
 
@@ -113,6 +156,26 @@
     (error {:node ast 
       :msg (string "could not match " (stringify value))})))
 
+(defn- matchh [ast ctx]
+  (def [to-match clauses] (ast :data))
+  (def value (interpret to-match ctx))
+  (var result :^nothing)
+  (each clause clauses
+    (def [patt guard expr] clause)
+    (print "matching ")
+    (pp patt)
+    (def match? (match-pattern patt value))
+    (when (match? :success)
+      (def inner-ctx (match? :ctx))
+      (def guard? (if (bool guard)
+        (interpret guard inner-ctx) true))
+      (when guard?
+        (set result (interpret expr inner-ctx))
+        (break))))
+  (if (= result :^nothing)
+    (error {:node ast :value value :msg "no match"})
+    result))
+
 (defn- script [ast ctx]
   (def lines (ast :data))
   (var result nil)
@@ -128,7 +191,6 @@
     (set result (interpret line ctx)))
   result)
 
-
 (defn- dict-str [dict]
   (string/join 
     (map 
@@ -154,7 +216,7 @@
     :set
       (string/join (map stringify (keys value)) ", ")
     :ref (stringify (value :^value))
-    # XXX: pkg, fn, 
+    # XXX: pkg, fn 
   ))
 
 (set stringify stringify*)
@@ -167,9 +229,10 @@
       terms))
   (string/join interpolations))
 
+
 (defn- iff [ast ctx]
   (def [condition then else] (ast :data))
-  (if (interpret condition ctx)
+  (if (bool (interpret condition ctx))
     (interpret then ctx)
     (interpret else ctx)))
 
@@ -178,7 +241,7 @@
   (var result :^nothing)
   (each clause clauses
     (def [lhs rhs] clause)
-    (when (interpret lhs ctx)
+    (when (bool (interpret lhs ctx))
       (set result (interpret rhs ctx))
       (break)))
   (when (= result :^nothing)
@@ -257,7 +320,7 @@
   (print "interpreting node " (ast :type))
   (case (ast :type)
     # literals
-    :nil nil
+    :nil :^nil
     :number (ast :data)
     :bool (ast :data)
     :string (ast :data)
@@ -280,9 +343,19 @@
     :word (word ast ctx)
     :interpolated (interpolated ast ctx)
     :ref (ref ast ctx)
+    # :ns (ns ast ctx)
+    # :pkg (pkg ast ctx)
 
     # patterned forms
     :let (lett ast ctx)
+    :match (matchh ast ctx)
+    # :with (withh ast ctx)
+
+    # functions
+    # :fn (fnn ast ctx)
+
+    # synthetic
+    # :synthetic (synthetic ast ctx)
 
     ))
 
@@ -296,10 +369,15 @@
 
 (var source nil)
 
+(defn- has-errors? [{:errors errors}] (and errors (not (empty? errors))))
+
 (defn run []
   (def scanned (s/scan source))
+  (when (has-errors? scanned) (break (scanned :errors)))
   (def parsed (p/parse scanned))
+  (when (has-errors? parsed) (break (parsed :errors)))
   (def validated (v/valid parsed))
+  (when (has-errors? validated) (break (validated :errors)))
   # (interpret (parsed :ast) @{})
   (try (interpret (parsed :ast) @{})
     ([e] (print "Ludus panicked!: " 
@@ -308,7 +386,10 @@
 
 (do 
 (set source `
-
+match "foo" with {
+  "f{ooo}o" -> ooo
+  _ -> :nope
+}
 `)
 (run)
 )