janet/interpreter.janet

@@ -47,7 +47,7 @@
   (def splat? (= :splat ((last members) :type)))
   (when splat?
     (when (< val-len patt-len)
-      (print "mismatched splatted tuple lengths")
+      (print "mismatched splatted tuple lenghts")
       (break {:success false :miss [pattern value]}))
     (print "splat!")
     (set splat (last members))
@@ -75,6 +75,7 @@
     {: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]}))
@@ -85,13 +86,13 @@
   (def splat? (= :splat ((last members) :type)))
   (when splat?
     (when (< val-len patt-len)
-      (print "mismatched splatted list lengths")
+      (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 list lengths")
+    (print "mismatched tuple lengths")
     (break {:success false :miss [pattern value]}))
   (var curr-mem :^nothing)
   (var curr-val :^nothing)
@@ -99,7 +100,7 @@
   (for i 0 (length members)
     (set curr-mem (get members i))
     (set curr-val (get value i))
-    (print "in list, matching " curr-val " with ")
+    (print "in tuple, matching " curr-val " with ")
     (pp curr-mem)
     (def match? (match-pattern curr-mem curr-val ctx))
     (pp match?)
@@ -113,21 +114,6 @@
     {: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)
@@ -150,7 +136,6 @@
     :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)
   ))
@@ -401,20 +386,10 @@
 
 (do 
 (set source `
-match "foooooo" with {
+match "foo" with {
-  "f{foo}{bar}{baz}" -> (foo, bar, baz)
+  "f{ooo}o" -> ooo
   _ -> :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
-* [ ] validate dict patterns
 * [x] compile string-patterns
+* [ ] validate dict 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))
- (def last-term (-> data array/pop string))
+ (array/pop data)
  (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 :main) ~(* ,;rules))
+ (set (grammar (keyword current)) -1)
+ (set (grammar :main) ~(sequence ,;rules))
  (set (ast :grammar) grammar)
  (set (ast :compiled) (peg/compile grammar))
  (set (ast :bindings) bindings))
@@ -622,12 +622,33 @@ Imports are for a later iteration of Ludus:
  (def validator (new-validator ast))
  (validate validator))
 
-# (do
+(do
-(comment
+# (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")