2big commit: stand up fns, definitions and calls, lots of bugfixes
This commit is contained in:
Scott Richmond
parent
265f867a71
commit
8d3d9a2dc5
|
|
@ -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))
|
||||
)
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
)
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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 "{")
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user