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

This commit is contained in:
Scott Richmond 2024-05-18 17:04:04 -04:00
parent 32cf7d6cc4
commit 41cd39df2e

View File

@ -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")