string patterns should now be working

janet/interpreter.janet

@@ -47,7 +47,7 @@
   (def splat? (= :splat ((last members) :type)))
   (when splat?
     (when (< val-len patt-len)
-      (print "mismatched splatted tuple lenghts")
+      (print "mismatched splatted tuple lengths")
       (break {:success false :miss [pattern value]}))
     (print "splat!")
     (set splat (last members))
@@ -75,7 +75,6 @@
     {: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]}))
@@ -86,13 +85,13 @@
   (def splat? (= :splat ((last members) :type)))
   (when splat?
     (when (< val-len patt-len)
-      (print "mismatched splatted tuple lenghts")
+      (print "mismatched splatted list lengths")
       (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")
+    (print "mismatched list lengths")
     (break {:success false :miss [pattern value]}))
   (var curr-mem :^nothing)
   (var curr-val :^nothing)
@@ -100,7 +99,7 @@
   (for i 0 (length members)
     (set curr-mem (get members i))
     (set curr-val (get value i))
-    (print "in tuple, matching " curr-val " with ")
+    (print "in list, matching " curr-val " with ")
     (pp curr-mem)
     (def match? (match-pattern curr-mem curr-val ctx))
     (pp match?)
@@ -114,6 +113,21 @@
     {:success true :ctx ctx}
     {:success false :miss [pattern value]}))
 
+(defn- match-string [pattern value ctx]
+  (when (not (string? value))
+    (break {:success false :miss [pattern value]}))
+  (def {:compiled compiled :bindings bindings} pattern)
+  (print "matching " value " with")
+  (pp (pattern :grammar))
+  (def matches (peg/match compiled value))
+  (when (not matches) 
+    (break {:success false :miss [pattern value]}))
+  (when (not= (length matches) (length bindings))
+    (error "oops: different number of matches and bindings"))
+  (for i 0 (length matches)
+    (set (ctx (bindings i)) (matches i)))
+  {:success true :ctx ctx})
+
 (defn- match-pattern* [pattern value &opt ctx]
   (print "in match-pattern, matching " value " with:")
   (pp pattern)
@@ -136,6 +150,7 @@
     :tuple (match-tuple pattern value ctx)
     :list (match-list pattern value ctx)
     # TODO: string-patterns
+    :interpolated (match-string pattern value ctx)
 
     :typed (typed pattern value ctx)
   ))
@@ -386,10 +401,20 @@
 
 (do 
 (set source `
-match "foo" with {
-  "f{ooo}o" -> ooo
+match "foooooo" with {
+  "f{foo}{bar}{baz}" -> (foo, bar, baz)
   _ -> :nope
 }
 `)
 (run)
 )
+
+(def g @{:0 "f" :1 '(<- (to :2)) :2 "o" :3 -1
+  :main '(* :0 :1 :2 :3)})
+
+(def f '{:0 "b" :1 (<- (to :2)) :2 (* "" -1)
+  :main (* :0 :1 :2)})
+
+(def h ~(* (<- (to "a")) "a" -1))
+
+(peg/match f "barrr")

janet/validate.janet

@@ -7,8 +7,8 @@ Tracking here, before I start writing this code, the kinds of validation we're h
 * [ ] validate `with` forms
 * [ ] first-level property access with pkg, e.g. `Foo :bar`--bar must be on Foo
  - [ ] accept pkg-kws
-* [x] compile string-patterns
 * [ ] validate dict patterns
+* [x] compile string-patterns
 * [x] `loop` form arity checking
 * [x] arity checking of explicit named function calls
 * [x] flag tail calls
@@ -187,7 +187,7 @@ Imports are for a later iteration of Ludus:
 (defn- str-pattern [validator]
  (def ast (validator :ast))
  (def data (ast :data))
- (array/pop data)
+ (def last-term (-> data array/pop string))
  (def grammar @{})
  (def bindings @[])
  (var current 0)
@@ -202,9 +202,9 @@ Imports are for a later iteration of Ludus:
      ~(<- (to ,(keyword (inc current)))))
     (array/push bindings (node :data))))
   (set current (inc current)))
+ (set (grammar (keyword current)) ~(* ,last-term -1))
  (def rules (map keyword (range (length grammar))))
- (set (grammar (keyword current)) -1)
- (set (grammar :main) ~(sequence ,;rules))
+ (set (grammar :main) ~(* ,;rules))
  (set (ast :grammar) grammar)
  (set (ast :compiled) (peg/compile grammar))
  (set (ast :bindings) bindings))
@@ -622,33 +622,12 @@ Imports are for a later iteration of Ludus:
  (def validator (new-validator ast))
  (validate validator))
 
-(do
-# (comment
+# (do
+(comment
 (def source `
 let "{foo}" = "bar"
 `)
 (def scanned (s/scan source))
 (def parsed (p/parse scanned))
 (valid parsed)
-(print "VALIDATED!!")
-(def grammar (get-in parsed [:ast :data 0 :data 0 :grammar]))
-(pp grammar)
-(peg/match grammar "foo"))
-
-(def bar @{
- :0 "" 
- :1 '(<- (to :2)) 
- :2 "" 
- :main '(sequence :0 :1 :2 -1)
- })
-
-(peg/match bar "foo")
-
-(def foo @{
- :0 ""
- :1 '(<- (to :2))
- :2 -1
- :main '(sequence :0 :1 :2)
-})
-
-(peg/match foo "foooooooobar")
+)