Compare commits

..

No commits in common. "95054ef234990c6254697f0c2122e4c06b5219a3" and "b0c912b16c2621e7699831bd426cd277ca5be3eb" have entirely different histories.

4 changed files with 24 additions and 164 deletions

View File

@ -13,9 +13,6 @@
:table :dict :table :dict
the-type)) the-type))
(defn- bool [value]
(if (= value :^nil nil) value))
(defn- resolve-name [name ctx] (defn- resolve-name [name ctx]
(print "resolving " name " in:") (print "resolving " name " in:")
(pp ctx) (pp ctx)
@ -75,45 +72,6 @@
{:success true :ctx ctx} {:success true :ctx ctx}
{:success false :miss [pattern value]})) {:success false :miss [pattern value]}))
(defn- match-list [pattern value ctx]
(when (not (array? value))
(break {:success false :miss [pattern value]}))
(def val-len (length value))
(var members (pattern :data))
(def patt-len (length members))
(var splat nil)
(def splat? (= :splat ((last members) :type)))
(when splat?
(when (< val-len patt-len)
(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 tuple lengths")
(break {:success false :miss [pattern value]}))
(var curr-mem :^nothing)
(var curr-val :^nothing)
(var success true)
(for i 0 (length members)
(set curr-mem (get members i))
(set curr-val (get value i))
(print "in tuple, matching " curr-val " with ")
(pp curr-mem)
(def match? (match-pattern curr-mem curr-val ctx))
(pp match?)
(when (not (match? :success))
(set success false)
(break)))
(when (and splat? (splat :data))
(def rest (array/slice value (length members)))
(match-word (splat :data) rest ctx))
(if success
{:success true :ctx ctx}
{:success false :miss [pattern value]}))
(defn- match-pattern* [pattern value &opt ctx] (defn- match-pattern* [pattern value &opt ctx]
(print "in match-pattern, matching " value " with:") (print "in match-pattern, matching " value " with:")
(pp pattern) (pp pattern)
@ -134,9 +92,8 @@
# TODO: lists, dicts # TODO: lists, dicts
:tuple (match-tuple pattern value ctx) :tuple (match-tuple pattern value ctx)
:list (match-list pattern value ctx)
# TODO: string-patterns # TODO: string-patterns
# TODO: typed
:typed (typed pattern value ctx) :typed (typed pattern value ctx)
)) ))
@ -156,26 +113,6 @@
(error {:node ast (error {:node ast
:msg (string "could not match " (stringify value))}))) :msg (string "could not match " (stringify value))})))
(defn- matchh [ast ctx]
(def [to-match clauses] (ast :data))
(def value (interpret to-match ctx))
(var result :^nothing)
(each clause clauses
(def [patt guard expr] clause)
(print "matching ")
(pp patt)
(def match? (match-pattern patt value))
(when (match? :success)
(def inner-ctx (match? :ctx))
(def guard? (if (bool guard)
(interpret guard inner-ctx) true))
(when guard?
(set result (interpret expr inner-ctx))
(break))))
(if (= result :^nothing)
(error {:node ast :value value :msg "no match"})
result))
(defn- script [ast ctx] (defn- script [ast ctx]
(def lines (ast :data)) (def lines (ast :data))
(var result nil) (var result nil)
@ -191,6 +128,7 @@
(set result (interpret line ctx))) (set result (interpret line ctx)))
result) result)
(defn- dict-str [dict] (defn- dict-str [dict]
(string/join (string/join
(map (map
@ -216,7 +154,7 @@
:set :set
(string/join (map stringify (keys value)) ", ") (string/join (map stringify (keys value)) ", ")
:ref (stringify (value :^value)) :ref (stringify (value :^value))
# XXX: pkg, fn # XXX: pkg, fn,
)) ))
(set stringify stringify*) (set stringify stringify*)
@ -229,10 +167,9 @@
terms)) terms))
(string/join interpolations)) (string/join interpolations))
(defn- iff [ast ctx] (defn- iff [ast ctx]
(def [condition then else] (ast :data)) (def [condition then else] (ast :data))
(if (bool (interpret condition ctx)) (if (interpret condition ctx)
(interpret then ctx) (interpret then ctx)
(interpret else ctx))) (interpret else ctx)))
@ -241,7 +178,7 @@
(var result :^nothing) (var result :^nothing)
(each clause clauses (each clause clauses
(def [lhs rhs] clause) (def [lhs rhs] clause)
(when (bool (interpret lhs ctx)) (when (interpret lhs ctx)
(set result (interpret rhs ctx)) (set result (interpret rhs ctx))
(break))) (break)))
(when (= result :^nothing) (when (= result :^nothing)
@ -320,7 +257,7 @@
(print "interpreting node " (ast :type)) (print "interpreting node " (ast :type))
(case (ast :type) (case (ast :type)
# literals # literals
:nil :^nil :nil nil
:number (ast :data) :number (ast :data)
:bool (ast :data) :bool (ast :data)
:string (ast :data) :string (ast :data)
@ -343,19 +280,9 @@
:word (word ast ctx) :word (word ast ctx)
:interpolated (interpolated ast ctx) :interpolated (interpolated ast ctx)
:ref (ref ast ctx) :ref (ref ast ctx)
# :ns (ns ast ctx)
# :pkg (pkg ast ctx)
# patterned forms # patterned forms
:let (lett ast ctx) :let (lett ast ctx)
:match (matchh ast ctx)
# :with (withh ast ctx)
# functions
# :fn (fnn ast ctx)
# synthetic
# :synthetic (synthetic ast ctx)
)) ))
@ -369,15 +296,10 @@
(var source nil) (var source nil)
(defn- has-errors? [{:errors errors}] (and errors (not (empty? errors))))
(defn run [] (defn run []
(def scanned (s/scan source)) (def scanned (s/scan source))
(when (has-errors? scanned) (break (scanned :errors)))
(def parsed (p/parse scanned)) (def parsed (p/parse scanned))
(when (has-errors? parsed) (break (parsed :errors)))
(def validated (v/valid parsed)) (def validated (v/valid parsed))
(when (has-errors? validated) (break (validated :errors)))
# (interpret (parsed :ast) @{}) # (interpret (parsed :ast) @{})
(try (interpret (parsed :ast) @{}) (try (interpret (parsed :ast) @{})
([e] (print "Ludus panicked!: " ([e] (print "Ludus panicked!: "
@ -386,10 +308,7 @@
(do (do
(set source ` (set source `
match "foo" with {
"f{ooo}o" -> ooo
_ -> :nope
}
`) `)
(run) (run)
) )

View File

@ -228,7 +228,7 @@
(array/push data curr) (array/push data curr)
(def interpolated (map scan-interpolations data)) (def interpolated (map scan-interpolations data))
(advance parser) (advance parser)
(def ast @{:type :interpolated :data interpolated :token origin}) (def ast {:type :interpolated :data interpolated :token origin})
(if (some is-error? interpolated) (if (some is-error? interpolated)
(do (do
(def err {:type :error :msg "bad interpolated string" :data ast :token origin}) (def err {:type :error :msg "bad interpolated string" :data ast :token origin})
@ -620,23 +620,19 @@
(defn- matchh [parser] (defn- matchh [parser]
(def origin (current parser)) (def origin (current parser))
(def ast {:type :match :data @[] :token origin}) (def ast {:type :match :data @[] :token origin})
(var to-match nil)
(def clauses @[])
(expect parser :match) (expect parser :match)
(advance parser) (advance parser)
(try (try
(do (do
(set to-match (simple parser)) (simple parser)
(expect parser :with) (advance parser) (expect parser :with) (advance parser)
(def open-brace (current parser))
(expect parser :lbrace) (advance parser) (expect parser :lbrace) (advance parser)
(accept-many parser :newline) (accept-many parser :newline)
(while (not (check parser :rbrace)) (while (not (check parser :rbrace))
(when (check parser :eof) (when (check parser :eof) (error {:type :error :token origin :data ast :msg "unclosed brace"}))
(error {:type :error :token open-brace :msg "unclosed brace"})) (array/push (ast :data) (match-clause parser)))
(array/push clauses (match-clause parser)))
(advance parser) (advance parser)
{:type :match :data [to-match clauses] :token origin}) ast)
([err] err))) ([err] err)))
# {pattern} = {nonbinding} {terminators} # {pattern} = {nonbinding} {terminators}
@ -1094,15 +1090,15 @@
) )
(do # (do
# (comment (comment
(def source ` (def source `
"{bar}{quux}" loop (1, 2) with (x, y) -> :bar
`) `)
(def scanned (s/scan source)) (def scanned (s/scan source))
(print "\n***NEW PARSE***\n") (print "\n***NEW PARSE***\n")
(def a-parser (new-parser scanned)) (def a-parser (new-parser scanned))
(def parsed (interpolated a-parser)) (def parsed (toplevel a-parser))
# (print (pp-ast parsed)) # (print (pp-ast parsed))
(pp scanned) (pp scanned)

View File

@ -327,7 +327,7 @@
(if (at-end? scanner) (if (at-end? scanner)
(let [scanner (add-token (add-token scanner :break) :eof)] (let [scanner (add-token (add-token scanner :break) :eof)]
{:tokens (get scanner :tokens) {:tokens (get scanner :tokens)
:errors (get scanner :errors [])}) :errors (get scanner :errors)})
(recur (-> scanner (scan-token) (next-token))))) (recur (-> scanner (scan-token) (next-token)))))
(recur (new-scanner source input))) (recur (new-scanner source input)))

View File

@ -7,8 +7,6 @@ Tracking here, before I start writing this code, the kinds of validation we're h
* [ ] validate `with` forms * [ ] validate `with` forms
* [ ] first-level property access with pkg, e.g. `Foo :bar`--bar must be on Foo * [ ] first-level property access with pkg, e.g. `Foo :bar`--bar must be on Foo
- [ ] accept pkg-kws - [ ] accept pkg-kws
* [x] compile string-patterns
* [ ] validate dict patterns
* [x] `loop` form arity checking * [x] `loop` form arity checking
* [x] arity checking of explicit named function calls * [x] arity checking of explicit named function calls
* [x] flag tail calls * [x] flag tail calls
@ -184,31 +182,6 @@ Imports are for a later iteration of Ludus:
(set (validator :ast) word) (set (validator :ast) word)
(pattern validator)) (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] (defn- pattern* [validator]
(print "PATTERN*") (print "PATTERN*")
(def ast (validator :ast)) (def ast (validator :ast))
@ -225,7 +198,6 @@ Imports are for a later iteration of Ludus:
:tuple (simple-coll-pattern validator) :tuple (simple-coll-pattern validator)
:splat (splattern validator) :splat (splattern validator)
:typed (typed validator) :typed (typed validator)
:interpolated (str-pattern validator)
))) )))
(set pattern pattern*) (set pattern pattern*)
@ -235,7 +207,6 @@ Imports are for a later iteration of Ludus:
(defn- guard [validator]) (defn- guard [validator])
(defn- match-clauses [validator clauses] (defn- match-clauses [validator clauses]
(print "validating clauses in match-clauses")
(each clause clauses (each clause clauses
(def parent (validator :ctx)) (def parent (validator :ctx))
(def ctx @{:^parent parent}) (def ctx @{:^parent parent})
@ -253,15 +224,8 @@ Imports are for a later iteration of Ludus:
(set (validator :ctx) parent))) (set (validator :ctx) parent)))
(defn- matchh [validator] (defn- matchh [validator]
(print "validating in matchh")
(def ast (validator :ast)) (def ast (validator :ast))
(def [to-match clauses] (ast :data)) (match-clauses validator (ast :data))
(print "validating expression:")
(pp to-match)
(set (validator :ast) to-match)
(validate validator)
(print "validating clauses")
(match-clauses validator clauses)
validator) validator)
(defn- fnn [validator] (defn- fnn [validator]
@ -326,6 +290,7 @@ Imports are for a later iteration of Ludus:
# * [ ] ensure properties are on pkgs (if *only* pkgs from root) # * [ ] ensure properties are on pkgs (if *only* pkgs from root)
(defn- pkg-root [validator]) (defn- pkg-root [validator])
# * [ ] flag tail calls (where last term is not-partial args)
(defn- tail-call [validator] (defn- tail-call [validator]
(def ast (validator :ast)) (def ast (validator :ast))
(when (ast :partial) (break validator)) (when (ast :partial) (break validator))
@ -335,6 +300,8 @@ Imports are for a later iteration of Ludus:
(def args (last data)) (def args (last data))
(set (args :tail-call) true)) (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] (defn- check-arity [validator]
(def ast (validator :ast)) (def ast (validator :ast))
(when (ast :partial) (break validator)) (when (ast :partial) (break validator))
@ -381,6 +348,7 @@ Imports are for a later iteration of Ludus:
(check-arity validator)) (check-arity validator))
validator) validator)
### XXX: todos from parser
(defn- pair [validator] (defn- pair [validator]
(def ast (validator :ast)) (def ast (validator :ast))
(def [k v] (ast :data)) (def [k v] (ast :data))
@ -420,7 +388,6 @@ Imports are for a later iteration of Ludus:
(validate validator)) (validate validator))
validator) validator)
# XXX: do this!
(defn- withh [validator]) (defn- withh [validator])
# XXX: tail calls in last position # XXX: tail calls in last position
@ -625,30 +592,8 @@ Imports are for a later iteration of Ludus:
(do (do
# (comment # (comment
(def source ` (def source `
let "{foo}" = "bar"
`) `)
(def scanned (s/scan source)) (def scanned (s/scan source))
(def parsed (p/parse scanned)) (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")