diff --git a/janet/validate.janet b/janet/validate.janet index 7b8f550..4480391 100644 --- a/janet/validate.janet +++ b/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")