tuple patterns, with splats!

janet/interpreter.janet

@@ -4,6 +4,15 @@
 (var stringify nil)
 (var match-pattern nil)
 
+(defn- ltype [value]
+  (def typed? (when (table? value) (:^type value)))
+  (def the-type (if typed? typed? (type value)))
+  (case the-type
+    :boolean :bool
+    :array :list
+    :table :dict
+    the-type))
+
 (defn- resolve-name [name ctx]
   (print "resolving " name " in:")
   (pp ctx)
@@ -14,16 +23,65 @@
 
 (defn- match-word [word value ctx]
   (def name (word :data))
-  {:success true :ctx (set (ctx name) value)})
+  (print "matched " (stringify value) " to " name)
+  (set (ctx name) value)
+  {:success true :ctx ctx})
 
-(defn- match-pattern [pattern value &opt ctx]
+(defn- typed [pattern value ctx]
+  (def [type-ast word] (pattern :data))
+  (def type (type-ast :data))
+  (if (= type (ltype value))
+    (match-word word value ctx)
+    {:success false :miss [pattern value]}))
+
+(defn- match-tuple [pattern value ctx]
+  (when (not (tuple? 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)
   (default ctx @{})
   (def data (pattern :data))
   (case (pattern :type)
     # always match
     :placeholder {:success true :ctx ctx}
     :ignored {:success true :ctx ctx}
-    :word (match-word value ctx)
+    :word (match-word pattern value ctx)
 
     # match on equality
     :nil {:success (nil? value) :ctx ctx}
@@ -32,23 +90,28 @@
     :string {:success (= data value) :ctx ctx}
     :keyword {:success (= data value) :ctx ctx}
 
-    # TODO: tuples, lists, dicts
+    # TODO: lists, dicts
+    :tuple (match-tuple pattern value ctx)
     # TODO: string-patterns
     # TODO: typed
-  )
+    :typed (typed pattern value ctx)
-)
+  ))
+
+(set match-pattern match-pattern*)
 
 (defn- lett [ast ctx]
   (def [patt expr] (ast :data))
   (def value (interpret expr ctx))
-  (def match? (match-pattern expr value))
+  (def match? (match-pattern patt value))
-  (if match?
+  (if (match? :success)
     (do
-    
+      (merge-into ctx (match? :ctx))
-    )
+      (print "new ctx:")
-    (error {:node ast :msg (string "could not match " (stringify value) " with " )})
+      (pp ctx)
-  )
+      value)
-)
+    # TODO: represent patterns textually in errors
+    (error {:node ast 
+      :msg (string "could not match " (stringify value))})))
 
 (defn- script [ast ctx]
   (def lines (ast :data))
@@ -76,10 +139,11 @@
 (defn- stringify* [value]
   (def typed? (when (table? value) (:^type value)))
   (def type (if typed? typed? (type value)))
+  (print "stringifying " (string value))
   (case type
     :nil ""
     :number (string value)
-    :bool (string value)
+    :boolean (string value)
     :keyword (string ":" value)
     :string value
     :tuple 
@@ -192,25 +256,34 @@
 (defn- interpret* [ast ctx]
   (print "interpreting node " (ast :type))
   (case (ast :type)
+    # literals
     :nil nil
     :number (ast :data)
     :bool (ast :data)
     :string (ast :data)
-    :interpolated (interpolated ast ctx)
     :keyword (ast :data)
-    :if (iff ast ctx)
+
-    :block (block ast ctx)
+    # collections
-    :word (word ast ctx)
     :tuple (tup ast ctx)
     :list (list ast ctx)
     :set (sett ast ctx)
     :dict (dict ast ctx)
+
+    # composite forms
+    :if (iff ast ctx)
+    :block (block ast ctx)
     :when (whenn ast ctx)
-    :ref (ref ast ctx)
     :script (script ast ctx)
     :panic (panic ast ctx)
 
+    # named/naming forms
+    :word (word ast ctx)
+    :interpolated (interpolated ast ctx)
+    :ref (ref ast ctx)
+
+    # patterned forms
     :let (lett ast ctx)
+
     ))
 
 (set interpret interpret*)
@@ -227,14 +300,15 @@
   (def scanned (s/scan source))
   (def parsed (p/parse scanned))
   (def validated (v/valid parsed))
-  (interpret (parsed :ast) @{}))
+  # (interpret (parsed :ast) @{})
+  (try (interpret (parsed :ast) @{})
+    ([e] (print "Ludus panicked!: " 
+      (if (struct? e) (error (e :msg)) (error e)))))
+  )
 
 (do 
 (set source `
-when {
+
-  3 -> :foo
-  true -> :bar
-}
 `)
 (run)
 )

janet/validate.janet

@@ -180,7 +180,7 @@ Imports are for a later iteration of Ludus:
   (array/push (validator :errors)
    {:node kw-type :msg "unknown type"}))
  (set (validator :ast) word)
- (pattern word))
+ (pattern validator))
 
 (defn- pattern* [validator]
  (print "PATTERN*")