check + compile string patterns; some cleanup, some messes still

janet/validate.janet

@@ -7,6 +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] `loop` form arity checking
 * [x] arity checking of explicit named function calls
 * [x] flag tail calls
@@ -182,6 +184,31 @@ Imports are for a later iteration of Ludus:
  (set (validator :ast) word)
  (pattern validator))
 
+(defn- str-pattern [validator]
+ (def ast (validator :ast))
+ (def data (ast :data))
+ (array/pop data)
+ (def grammar @{})
+ (def bindings @[])
+ (var current 0)
+ (each node data
+  (when (not (buffer? node))
+   (set (validator :ast) node)
+   (pattern validator))
+  (if (buffer? node)
+   (set (grammar (keyword current)) (string node)) 
+   (do
+    (set (grammar (keyword current))
+     ~(<- (to ,(keyword (inc current)))))
+    (array/push bindings (node :data))))
+  (set current (inc current)))
+ (def rules (map keyword (range (length grammar))))
+ (set (grammar (keyword current)) -1)
+ (set (grammar :main) ~(sequence ,;rules))
+ (set (ast :grammar) grammar)
+ (set (ast :compiled) (peg/compile grammar))
+ (set (ast :bindings) bindings))
+
 (defn- pattern* [validator]
  (print "PATTERN*")
  (def ast (validator :ast))
@@ -198,6 +225,7 @@ Imports are for a later iteration of Ludus:
    :tuple (simple-coll-pattern validator)
    :splat (splattern validator)
    :typed (typed validator)
+   :interpolated (str-pattern validator)
    )))
 
 (set pattern pattern*)
@@ -207,6 +235,7 @@ Imports are for a later iteration of Ludus:
 (defn- guard [validator])
 
 (defn- match-clauses [validator clauses]
+ (print "validating clauses in match-clauses")
  (each clause clauses
   (def parent (validator :ctx))
   (def ctx @{:^parent parent})
@@ -224,8 +253,15 @@ Imports are for a later iteration of Ludus:
   (set (validator :ctx) parent)))
 
 (defn- matchh [validator]
+ (print "validating in matchh")
  (def ast (validator :ast))
- (match-clauses validator (ast :data))
+ (def [to-match clauses] (ast :data))
+ (print "validating expression:")
+ (pp to-match)
+ (set (validator :ast) to-match)
+ (validate validator)
+ (print "validating clauses")
+ (match-clauses validator clauses)
  validator)
 
 (defn- fnn [validator]
@@ -290,7 +326,6 @@ Imports are for a later iteration of Ludus:
 # * [ ] ensure properties are on pkgs (if *only* pkgs from root)
 (defn- pkg-root [validator])
 
-# * [ ] flag tail calls (where last term is not-partial args)
 (defn- tail-call [validator]
  (def ast (validator :ast))
  (when (ast :partial) (break validator))
@@ -300,8 +335,6 @@ Imports are for a later iteration of Ludus:
  (def args (last data))
  (set (args :tail-call) true))
 
-# * [ ] arity checking if first term is name that resolves to a function and args aren't partial
-# XXX: now just check number of args against arity map
 (defn- check-arity [validator]
  (def ast (validator :ast))
  (when (ast :partial) (break validator))
@@ -348,7 +381,6 @@ Imports are for a later iteration of Ludus:
   (check-arity validator))
  validator)
 
-### XXX: todos from parser
 (defn- pair [validator]
  (def ast (validator :ast))
  (def [k v] (ast :data))
@@ -388,6 +420,7 @@ Imports are for a later iteration of Ludus:
   (validate validator))
  validator)
 
+# XXX: do this!
 (defn- withh [validator])
 
 # XXX: tail calls in last position
@@ -592,8 +625,30 @@ Imports are for a later iteration of Ludus:
 (do
 # (comment
 (def source `
-
+let "{foo}" = "bar"
 `)
 (def scanned (s/scan source))
 (def parsed (p/parse scanned))
-(valid parsed))
+(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")