add match exprs

This commit is contained in:
Scott Richmond 2024-05-18 17:04:23 -04:00
parent 41cd39df2e
commit 95054ef234

View File

@ -13,6 +13,9 @@
: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)
@ -72,6 +75,45 @@
{: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)
@ -92,8 +134,9 @@
# 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)
)) ))
@ -113,6 +156,26 @@
(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)
@ -128,7 +191,6 @@
(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
@ -154,7 +216,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*)
@ -167,9 +229,10 @@
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 (interpret condition ctx) (if (bool (interpret condition ctx))
(interpret then ctx) (interpret then ctx)
(interpret else ctx))) (interpret else ctx)))
@ -178,7 +241,7 @@
(var result :^nothing) (var result :^nothing)
(each clause clauses (each clause clauses
(def [lhs rhs] clause) (def [lhs rhs] clause)
(when (interpret lhs ctx) (when (bool (interpret lhs ctx))
(set result (interpret rhs ctx)) (set result (interpret rhs ctx))
(break))) (break)))
(when (= result :^nothing) (when (= result :^nothing)
@ -257,7 +320,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)
@ -280,9 +343,19 @@
: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)
)) ))
@ -296,10 +369,15 @@
(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!: "
@ -308,7 +386,10 @@
(do (do
(set source ` (set source `
match "foo" with {
"f{ooo}o" -> ooo
_ -> :nope
}
`) `)
(run) (run)
) )