Compare commits

..

2 Commits

Author SHA1 Message Date
Scott Richmond
d5f593b0f3 tuple patterns, with splats! 2024-05-15 12:33:52 -04:00
Scott Richmond
e0919e771d bugfix 2024-05-15 12:33:34 -04:00
2 changed files with 99 additions and 25 deletions

View File

@ -4,6 +4,15 @@
(var stringify nil) (var stringify nil)
(var match-pattern nil) (var match-pattern nil)
(defn- ltype [value]
(def typed? (when (table? value) (:^type value)))
(def the-type (if typed? typed? (type value)))
(case the-type
:boolean :bool
:array :list
:table :dict
the-type))
(defn- resolve-name [name ctx] (defn- resolve-name [name ctx]
(print "resolving " name " in:") (print "resolving " name " in:")
(pp ctx) (pp ctx)
@ -14,16 +23,65 @@
(defn- match-word [word value ctx] (defn- match-word [word value ctx]
(def name (word :data)) (def name (word :data))
{:success true :ctx (set (ctx name) value)}) (print "matched " (stringify value) " to " name)
(set (ctx name) value)
{:success true :ctx ctx})
(defn- match-pattern [pattern value &opt ctx] (defn- typed [pattern value ctx]
(def [type-ast word] (pattern :data))
(def type (type-ast :data))
(if (= type (ltype value))
(match-word word value ctx)
{:success false :miss [pattern value]}))
(defn- match-tuple [pattern value ctx]
(when (not (tuple? 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)
(default ctx @{}) (default ctx @{})
(def data (pattern :data)) (def data (pattern :data))
(case (pattern :type) (case (pattern :type)
# always match # always match
:placeholder {:success true :ctx ctx} :placeholder {:success true :ctx ctx}
:ignored {:success true :ctx ctx} :ignored {:success true :ctx ctx}
:word (match-word value ctx) :word (match-word pattern value ctx)
# match on equality # match on equality
:nil {:success (nil? value) :ctx ctx} :nil {:success (nil? value) :ctx ctx}
@ -32,23 +90,28 @@
:string {:success (= data value) :ctx ctx} :string {:success (= data value) :ctx ctx}
:keyword {:success (= data value) :ctx ctx} :keyword {:success (= data value) :ctx ctx}
# TODO: tuples, lists, dicts # TODO: lists, dicts
:tuple (match-tuple pattern value ctx)
# TODO: string-patterns # TODO: string-patterns
# TODO: typed # TODO: typed
) :typed (typed pattern value ctx)
) ))
(set match-pattern match-pattern*)
(defn- lett [ast ctx] (defn- lett [ast ctx]
(def [patt expr] (ast :data)) (def [patt expr] (ast :data))
(def value (interpret expr ctx)) (def value (interpret expr ctx))
(def match? (match-pattern expr value)) (def match? (match-pattern patt value))
(if match? (if (match? :success)
(do (do
(merge-into ctx (match? :ctx))
) (print "new ctx:")
(error {:node ast :msg (string "could not match " (stringify value) " with " )}) (pp ctx)
) value)
) # TODO: represent patterns textually in errors
(error {:node ast
:msg (string "could not match " (stringify value))})))
(defn- script [ast ctx] (defn- script [ast ctx]
(def lines (ast :data)) (def lines (ast :data))
@ -76,10 +139,11 @@
(defn- stringify* [value] (defn- stringify* [value]
(def typed? (when (table? value) (:^type value))) (def typed? (when (table? value) (:^type value)))
(def type (if typed? typed? (type value))) (def type (if typed? typed? (type value)))
(print "stringifying " (string value))
(case type (case type
:nil "" :nil ""
:number (string value) :number (string value)
:bool (string value) :boolean (string value)
:keyword (string ":" value) :keyword (string ":" value)
:string value :string value
:tuple :tuple
@ -192,25 +256,34 @@
(defn- interpret* [ast ctx] (defn- interpret* [ast ctx]
(print "interpreting node " (ast :type)) (print "interpreting node " (ast :type))
(case (ast :type) (case (ast :type)
# literals
:nil nil :nil nil
:number (ast :data) :number (ast :data)
:bool (ast :data) :bool (ast :data)
:string (ast :data) :string (ast :data)
:interpolated (interpolated ast ctx)
:keyword (ast :data) :keyword (ast :data)
:if (iff ast ctx)
:block (block ast ctx) # collections
:word (word ast ctx)
:tuple (tup ast ctx) :tuple (tup ast ctx)
:list (list ast ctx) :list (list ast ctx)
:set (sett ast ctx) :set (sett ast ctx)
:dict (dict ast ctx) :dict (dict ast ctx)
# composite forms
:if (iff ast ctx)
:block (block ast ctx)
:when (whenn ast ctx) :when (whenn ast ctx)
:ref (ref ast ctx)
:script (script ast ctx) :script (script ast ctx)
:panic (panic ast ctx) :panic (panic ast ctx)
# named/naming forms
:word (word ast ctx)
:interpolated (interpolated ast ctx)
:ref (ref ast ctx)
# patterned forms
:let (lett ast ctx) :let (lett ast ctx)
)) ))
(set interpret interpret*) (set interpret interpret*)
@ -227,14 +300,15 @@
(def scanned (s/scan source)) (def scanned (s/scan source))
(def parsed (p/parse scanned)) (def parsed (p/parse scanned))
(def validated (v/valid parsed)) (def validated (v/valid parsed))
(interpret (parsed :ast) @{})) # (interpret (parsed :ast) @{})
(try (interpret (parsed :ast) @{})
([e] (print "Ludus panicked!: "
(if (struct? e) (error (e :msg)) (error e)))))
)
(do (do
(set source ` (set source `
when {
3 -> :foo
true -> :bar
}
`) `)
(run) (run)
) )

View File

@ -180,7 +180,7 @@ Imports are for a later iteration of Ludus:
(array/push (validator :errors) (array/push (validator :errors)
{:node kw-type :msg "unknown type"})) {:node kw-type :msg "unknown type"}))
(set (validator :ast) word) (set (validator :ast) word)
(pattern word)) (pattern validator))
(defn- pattern* [validator] (defn- pattern* [validator]
(print "PATTERN*") (print "PATTERN*")