add match exprs
This commit is contained in:
parent
41cd39df2e
commit
95054ef234
|
@ -13,6 +13,9 @@
|
|||
:table :dict
|
||||
the-type))
|
||||
|
||||
(defn- bool [value]
|
||||
(if (= value :^nil nil) value))
|
||||
|
||||
(defn- resolve-name [name ctx]
|
||||
(print "resolving " name " in:")
|
||||
(pp ctx)
|
||||
|
@ -72,6 +75,45 @@
|
|||
{:success true :ctx ctx}
|
||||
{: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]
|
||||
(print "in match-pattern, matching " value " with:")
|
||||
(pp pattern)
|
||||
|
@ -92,8 +134,9 @@
|
|||
|
||||
# TODO: lists, dicts
|
||||
:tuple (match-tuple pattern value ctx)
|
||||
:list (match-list pattern value ctx)
|
||||
# TODO: string-patterns
|
||||
# TODO: typed
|
||||
|
||||
:typed (typed pattern value ctx)
|
||||
))
|
||||
|
||||
|
@ -113,6 +156,26 @@
|
|||
(error {:node ast
|
||||
: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]
|
||||
(def lines (ast :data))
|
||||
(var result nil)
|
||||
|
@ -128,7 +191,6 @@
|
|||
(set result (interpret line ctx)))
|
||||
result)
|
||||
|
||||
|
||||
(defn- dict-str [dict]
|
||||
(string/join
|
||||
(map
|
||||
|
@ -154,7 +216,7 @@
|
|||
:set
|
||||
(string/join (map stringify (keys value)) ", ")
|
||||
:ref (stringify (value :^value))
|
||||
# XXX: pkg, fn,
|
||||
# XXX: pkg, fn
|
||||
))
|
||||
|
||||
(set stringify stringify*)
|
||||
|
@ -167,9 +229,10 @@
|
|||
terms))
|
||||
(string/join interpolations))
|
||||
|
||||
|
||||
(defn- iff [ast ctx]
|
||||
(def [condition then else] (ast :data))
|
||||
(if (interpret condition ctx)
|
||||
(if (bool (interpret condition ctx))
|
||||
(interpret then ctx)
|
||||
(interpret else ctx)))
|
||||
|
||||
|
@ -178,7 +241,7 @@
|
|||
(var result :^nothing)
|
||||
(each clause clauses
|
||||
(def [lhs rhs] clause)
|
||||
(when (interpret lhs ctx)
|
||||
(when (bool (interpret lhs ctx))
|
||||
(set result (interpret rhs ctx))
|
||||
(break)))
|
||||
(when (= result :^nothing)
|
||||
|
@ -257,7 +320,7 @@
|
|||
(print "interpreting node " (ast :type))
|
||||
(case (ast :type)
|
||||
# literals
|
||||
:nil nil
|
||||
:nil :^nil
|
||||
:number (ast :data)
|
||||
:bool (ast :data)
|
||||
:string (ast :data)
|
||||
|
@ -280,9 +343,19 @@
|
|||
:word (word ast ctx)
|
||||
:interpolated (interpolated ast ctx)
|
||||
:ref (ref ast ctx)
|
||||
# :ns (ns ast ctx)
|
||||
# :pkg (pkg ast ctx)
|
||||
|
||||
# patterned forms
|
||||
:let (lett ast ctx)
|
||||
:match (matchh ast ctx)
|
||||
# :with (withh ast ctx)
|
||||
|
||||
# functions
|
||||
# :fn (fnn ast ctx)
|
||||
|
||||
# synthetic
|
||||
# :synthetic (synthetic ast ctx)
|
||||
|
||||
))
|
||||
|
||||
|
@ -296,10 +369,15 @@
|
|||
|
||||
(var source nil)
|
||||
|
||||
(defn- has-errors? [{:errors errors}] (and errors (not (empty? errors))))
|
||||
|
||||
(defn run []
|
||||
(def scanned (s/scan source))
|
||||
(when (has-errors? scanned) (break (scanned :errors)))
|
||||
(def parsed (p/parse scanned))
|
||||
(when (has-errors? parsed) (break (parsed :errors)))
|
||||
(def validated (v/valid parsed))
|
||||
(when (has-errors? validated) (break (validated :errors)))
|
||||
# (interpret (parsed :ast) @{})
|
||||
(try (interpret (parsed :ast) @{})
|
||||
([e] (print "Ludus panicked!: "
|
||||
|
@ -308,7 +386,10 @@
|
|||
|
||||
(do
|
||||
(set source `
|
||||
|
||||
match "foo" with {
|
||||
"f{ooo}o" -> ooo
|
||||
_ -> :nope
|
||||
}
|
||||
`)
|
||||
(run)
|
||||
)
|
||||
|
|
Loading…
Reference in New Issue
Block a user