check + compile string patterns; some cleanup, some messes still
This commit is contained in:
parent
32cf7d6cc4
commit
41cd39df2e
|
@ -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")
|
||||
|
|
Loading…
Reference in New Issue
Block a user