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

View File

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

View File

@ -272,7 +272,7 @@
"-" (cond "-" (cond
(= next ">") (add-token (advance scanner) :arrow) (= next ">") (add-token (advance scanner) :arrow)
(digit? next) (add-number char scanner) (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 #{ ## dict #{
"#" (if (= next "{") "#" (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: 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 * [ ] 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