2big commit: stand up fns, definitions and calls, lots of bugfixes

This commit is contained in:
Scott Richmond 2024-05-19 01:58:10 -04:00
parent 265f867a71
commit 8d3d9a2dc5
4 changed files with 172 additions and 60 deletions

View File

@ -4,8 +4,10 @@
(var stringify nil)
(var match-pattern nil)
(defn- todo [msg] (error (string "not yet implemented: " msg)))
(defn- ltype [value]
(def typed? (when (table? value) (:^type value)))
(def typed? (when (dictionary? value) (value :^type)))
(def the-type (if typed? typed? (type value)))
(case the-type
:boolean :bool
@ -43,6 +45,10 @@
(def val-len (length value))
(var members (pattern :data))
(def patt-len (length members))
(when (empty? members)
(break (if (empty? value)
{:success true :ctx ctx}
{:success false :miss [pattern value]})))
(var splat nil)
(def splat? (= :splat ((last members) :type)))
(when splat?
@ -128,6 +134,8 @@
(set (ctx (bindings i)) (matches i)))
{:success true :ctx ctx})
(defn- match-dict [pattern value ctx] (todo "dict pattern"))
(defn- match-pattern* [pattern value &opt ctx]
(print "in match-pattern, matching " value " with:")
(pp pattern)
@ -149,7 +157,8 @@
# TODO: lists, dicts
:tuple (match-tuple pattern value ctx)
:list (match-list pattern value ctx)
# TODO: string-patterns
:dict (match-dict pattern value ctx)
:interpolated (match-string pattern value ctx)
:typed (typed pattern value ctx)
@ -164,57 +173,55 @@
(if (match? :success)
(do
(merge-into ctx (match? :ctx))
(print "new ctx:")
(pp ctx)
value)
# TODO: represent patterns textually in errors
(error {:node ast
:msg (string "could not match " (stringify value))})))
(error {:node ast :value value :msg "no match"})))
(defn- matchh [ast ctx]
(def [to-match clauses] (ast :data))
(def value (interpret to-match ctx))
(var result :^nothing)
(each clause clauses
(def len (length clauses))
(when (ast :match) (break ((ast :match) 0 value ctx)))
(defn match-fn [i value ctx]
(when (= len i)
(error {:node ast :value value :msg "no match"}))
(def clause (clauses i))
(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))
(def match? (match-pattern patt value @{:^parent ctx}))
(when (not (match? :success))
(break (match-fn (inc i) value ctx)))
(def body-ctx (match? :ctx))
(def guard? (if guard
(bool (interpret guard body-ctx)) true))
(when (not guard?)
(break (match-fn (inc i) value ctx)))
(interpret expr body-ctx))
(set (ast :match) match-fn)
(match-fn 0 value ctx))
(defn- script [ast ctx]
(def lines (ast :data))
(var result nil)
(each line lines
(set result (interpret line ctx)))
result)
(def last-line (last lines))
(for i 0 (-> lines length dec)
(interpret (lines i) ctx))
(interpret last-line ctx))
(defn- block [ast parent]
(def lines (ast :data))
(var result nil)
(def last-line (last lines))
(def ctx @{:^parent parent})
(each line lines
(set result (interpret line ctx)))
result)
(for i 0 (-> lines length dec)
(interpret (lines i) ctx))
(interpret last-line ctx))
(defn- dict-str [dict]
(string/join
(map
(fn [[k v]] (string (stringify k) " " (stringify v)))
dict)
(pairs dict))
", "))
(defn- stringify* [value]
(def typed? (when (table? value) (:^type value)))
(def typed? (when (dictionary? value) (value :^type)))
(def type (if typed? typed? (type value)))
(print "stringifying " (string value))
(case type
@ -238,22 +245,21 @@
(defn- stringish? [x] (or (string? x) (buffer? x)))
(defn- to_string [ctx] (fn [x]
(if (stringish? x) x (stringify (interpret x ctx)))))
(defn- interpolated [ast ctx]
(def terms (ast :data))
(each term terms (pp term))
(def interpolations
(map (fn [x]
(if (stringish? x) x (stringify (interpret x ctx))))
terms))
(def interpolations (map (to_string ctx) terms))
(string/join interpolations))
(defn- iff [ast ctx]
(def [condition then else] (ast :data))
(if (bool (interpret condition ctx))
(interpret then ctx)
(interpret else ctx)))
# TODO: use a tail call here
(defn- whenn [ast ctx]
(def clauses (ast :data))
(var result :^nothing)
@ -267,15 +273,23 @@
result)
(defn- word [ast ctx]
(def name (ast :data))
(resolve-name name ctx))
(resolve-name (ast :data) ctx))
(defn- tup [ast ctx]
(def members (ast :data))
(def the-tup @[])
(each member members
(array/push the-tup (interpret member ctx)))
(tuple ;the-tup))
[;the-tup])
(defn- args [ast ctx]
(def members (ast :data))
(def the-args @[])
(each member members
(array/push the-args (interpret member ctx)))
(if (ast :partial)
{:^type :partial :args the-args}
[;the-args]))
(defn- sett [ast ctx]
(def members (ast :data))
@ -312,6 +326,10 @@
(merge-into the-dict splatted))
(do
(def [key-ast value-ast] (member :data))
(print "dict key")
(pp key-ast)
(print "dict value")
(pp value-ast)
(def key (interpret key-ast ctx))
(def value (interpret value-ast ctx))
(set (the-dict key) value))))
@ -334,6 +352,79 @@
(def info (interpret (ast :data) ctx))
(error {:node ast :msg info}))
# TODO: add docstrings & pattern docs to fns
# Depends on: good string representation of patterns
# For now, this should be enough to tall the thing
(defn- fnn [ast ctx]
(def {:name name :data clauses} ast)
(def the-fn @{:name name :^type :fn :body clauses :ctx ctx})
(set (ctx name) the-fn))
# TODO
(defn- partial [the-fn args] (todo "partially applied functions"))
(defn- call-fn [the-fn args]
(print "calling fn " (the-fn :name))
(print "with args " args)
(def clauses (the-fn :body))
(def len (length clauses))
(when (the-fn :match) (break ((the-fn :match) 0 args)))
(defn match-fn [i args]
(when (= len i)
(error {:node the-fn :value args :msg "no match"}))
(def clause (clauses i))
(def [patt guard expr] clause)
(def match?
(match-pattern patt args @{:^parent (the-fn :ctx)}))
(when (not (match? :success))
(break (match-fn (inc i) args)))
(print "matched!")
(def body-ctx (match? :ctx))
(def guard? (if guard
(bool (interpret guard body-ctx)) true))
(print "passed guard")
(when (not guard?)
(break (match-fn (inc i) args)))
(interpret expr body-ctx))
(set (the-fn :match) match-fn)
(match-fn 0 args))
(defn- apply-synth-term [prev curr]
(print "applying")
(pp curr)
(print "to")
(pp prev)
(def types [(ltype prev) (ltype curr)])
(print "typle:")
(pp types)
(match types
[:fn :tuple] (call-fn prev curr)
[:fn :partial] (partial prev curr)
[:keyword :args] (get (first curr) prev :^nil)
[:dict :keyword] (get prev curr :^nil)
[:nil :keyword] :^nil
[:pkg :keyword] (get prev curr :^nil)
[:pkg :pkg-kw] (get prev curr :^nil)))
(defn- synthetic [ast ctx]
(def terms (ast :data))
(print "interpreting synthetic")
(pp ast)
(pp terms)
(def first-term (first terms))
(def last-term (last terms))
(var prev (interpret first-term ctx))
(print "root term: ")
(pp prev)
(for i 1 (-> terms length dec)
(def curr (interpret (terms i) ctx))
(print "term " i ": " curr)
(set prev (apply-synth-term prev curr)))
(print "done with inner terms, applying last term")
(apply-synth-term prev (interpret last-term ctx)))
(defn- doo [ast ctx] (todo "do expressions"))
(defn- interpret* [ast ctx]
(print "interpreting node " (ast :type))
(case (ast :type)
@ -343,9 +434,11 @@
:bool (ast :data)
:string (ast :data)
:keyword (ast :data)
:placeholder :_
# collections
:tuple (tup ast ctx)
:args (args ast ctx)
:list (list ast ctx)
:set (sett ast ctx)
:dict (dict ast ctx)
@ -370,10 +463,13 @@
# :with (withh ast ctx)
# functions
# :fn (fnn ast ctx)
:fn (fnn ast ctx)
# synthetic
# :synthetic (synthetic ast ctx)
:synthetic (synthetic ast ctx)
# do
:do (doo ast ctx)
))
@ -396,6 +492,8 @@
(when (has-errors? parsed) (break (parsed :errors)))
(def validated (v/valid parsed))
(when (has-errors? validated) (break (validated :errors)))
(def cleaned (get-in parsed [:ast :data 1]))
(pp cleaned)
(interpret (parsed :ast) @{})
# (try (interpret (parsed :ast) @{})
# ([e] (print "Ludus panicked!: "
@ -404,8 +502,10 @@
(do
(set source `
let verb = "love"
"{verb}"
fn foo () -> :foo
let bar = #{foo}
bar :foo ()
`)
(run)
(def result (run))
)

View File

@ -157,6 +157,12 @@
{:type :keyword :data (curr :literal) :token curr}
)
(defn- kw-only [parser]
(expect parser :keyword)
(def curr (-> parser current))
(advance parser)
{:type :keyword :data (curr :literal) :token curr})
(defn- nill [parser]
(expect parser :nil)
(def curr (current parser))
@ -308,17 +314,17 @@
(defrec synthetic [parser]
(print "parsing synthetic")
(def origin (current parser))
(def ast {:type :synthetic :data @[(synth-root parser)] :token origin})
# (def ast {:type :synthetic :data @[(synth-root parser)] :token origin})
(def terms @[(synth-root parser)])
(while (has-value? sequels (-> parser current type))
(def term
(case (-> parser current type)
:lparen (args parser)
:keyword (kw parser)
:keyword (kw-only parser)
))
(array/push (ast :data) term)
(array/push terms term)
)
ast
)
{:type :synthetic :data [;terms] :token origin})
# collections
(defn- tup [parser]
@ -399,9 +405,13 @@
(def origin (current parser))
(def term (case (type origin)
:splat {:type :splat :data (capture word-only (advance parser)) :token origin}
:word (try (word-only parser) ([e] e))
:word (do
(def value (capture word-only parser))
(def key {:type :keyword :data (keyword (value :data))
:token origin})
{:type :pair :data [key value] :token origin})
:keyword (do
(def key (try (kw parser) ([e] e)))
(def key (capture kw parser))
(def value (capture nonbinding parser))
{:type :pair :data [key value] :token origin})
(try (panic parser (string "expected dict term, got " (type origin))) ([e] e))
@ -636,7 +646,7 @@
(error {:type :error :token open-brace :msg "unclosed brace"}))
(array/push clauses (match-clause parser)))
(advance parser)
{:type :match :data [to-match clauses] :token origin})
@{:type :match :data [to-match clauses] :token origin})
([err] err)))
# {pattern} = {nonbinding} {terminators}
@ -1096,17 +1106,18 @@
(do
# (comment
(def source `
"{bar}{quux}"
(def source `a :b :c
`)
(def scanned (s/scan source))
(print "\n***NEW PARSE***\n")
(def a-parser (new-parser scanned))
(def parsed (interpolated a-parser))
(def parsed (expr a-parser))
# (print (pp-ast parsed))
(pp scanned)
(pp parsed)
# (pp scanned)
# (pp parsed)
(def cleaned (get-in parsed [:data 2]))
(pp cleaned)
)

View File

@ -272,7 +272,7 @@
"-" (cond
(= next ">") (add-token (advance scanner) :arrow)
(digit? next) (add-number char scanner)
:else (add-error scanner (string "Expected -> or negative number after `-`. Got `" char next "`")))
:else (add-error scanner (string "Expected > or negative number after `-`. Got `" char next "`")))
## dict #{
"#" (if (= next "{")

View File

@ -4,6 +4,7 @@
Tracking here, before I start writing this code, the kinds of validation we're hoping to accomplish:
* [ ] ensure called keywords are only called w/ one arg
* [ ] validate `with` forms
* [ ] first-level property access with pkg, e.g. `Foo :bar`--bar must be on Foo
- [ ] accept pkg-kws