Compare commits
No commits in common. "1120f21df2327bcb2162f028978ccd8dfea4bc5e" and "6bf4dde4878dc334280fdcb47163832a381c5c97" have entirely different histories.
1120f21df2
...
6bf4dde487
|
@ -11,8 +11,8 @@
|
||||||
(defn- todo [msg] (error (string "not yet implemented: " msg)))
|
(defn- todo [msg] (error (string "not yet implemented: " msg)))
|
||||||
|
|
||||||
(defn- resolve-name [name ctx]
|
(defn- resolve-name [name ctx]
|
||||||
# (print "resolving " name " in:")
|
(print "resolving " name " in:")
|
||||||
# (pp ctx)
|
(pp ctx)
|
||||||
(when (not ctx) (break :^not-found))
|
(when (not ctx) (break :^not-found))
|
||||||
(if (has-key? ctx name)
|
(if (has-key? ctx name)
|
||||||
(ctx name)
|
(ctx name)
|
||||||
|
@ -20,7 +20,7 @@
|
||||||
|
|
||||||
(defn- match-word [word value ctx]
|
(defn- match-word [word value ctx]
|
||||||
(def name (word :data))
|
(def name (word :data))
|
||||||
# (print "matched " (b/show value) " to " name)
|
(print "matched " (b/show value) " to " name)
|
||||||
(set (ctx name) value)
|
(set (ctx name) value)
|
||||||
{:success true :ctx ctx})
|
{:success true :ctx ctx})
|
||||||
|
|
||||||
|
@ -126,49 +126,7 @@
|
||||||
(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]
|
(defn- match-dict [pattern value ctx] (todo "dict pattern"))
|
||||||
(when (not (table? value))
|
|
||||||
(break {:success false :miss [pattern value]}))
|
|
||||||
(def val-size (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?
|
|
||||||
(when (< val-size patt-len)
|
|
||||||
(print "mismatched splatted dict lengths")
|
|
||||||
(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-size patt-len))
|
|
||||||
(print "mismatched dict lengths")
|
|
||||||
(break {:success false :miss [pattern value]}))
|
|
||||||
(var success true)
|
|
||||||
(def matched-keys @[])
|
|
||||||
(for i 0 (length members)
|
|
||||||
(def curr-pair (get members i))
|
|
||||||
(def [curr-key curr-patt] (curr-pair :data))
|
|
||||||
(def key (interpret curr-key ctx))
|
|
||||||
(def curr-val (value key))
|
|
||||||
(def match? (match-pattern curr-patt curr-val ctx))
|
|
||||||
(array/push matched-keys key)
|
|
||||||
(when (not (match? :success))
|
|
||||||
(set success false)
|
|
||||||
(break)))
|
|
||||||
(when (and splat? (splat :data) success)
|
|
||||||
(def rest (merge value))
|
|
||||||
(each key matched-keys
|
|
||||||
(set (rest key) nil))
|
|
||||||
(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:")
|
||||||
|
@ -363,30 +321,14 @@
|
||||||
(set (ctx name) the-fn))
|
(set (ctx name) the-fn))
|
||||||
|
|
||||||
# TODO
|
# TODO
|
||||||
(defn- is_placeholder [x] (= x :_))
|
(defn- partial [the-fn args] (todo "partially applied functions"))
|
||||||
|
|
||||||
(var call-fn nil)
|
(defn- call-fn [the-fn args]
|
||||||
|
|
||||||
(defn- partial [the-fn partial-args]
|
|
||||||
(print "calling partially applied function")
|
|
||||||
(def args (partial-args :args))
|
|
||||||
(def pos (find-index is_placeholder args))
|
|
||||||
(def name (string (the-fn :name) "<partial>"))
|
|
||||||
(fn [missing]
|
|
||||||
(print "calling function with arg " (b/show missing))
|
|
||||||
(pp partial-args)
|
|
||||||
(def full-args (array/slice args))
|
|
||||||
(set (full-args pos) missing)
|
|
||||||
(print "all args: " (b/show full-args))
|
|
||||||
(call-fn the-fn [;full-args])))
|
|
||||||
|
|
||||||
(defn- call-fn* [the-fn args]
|
|
||||||
(print "calling " (b/show the-fn))
|
(print "calling " (b/show the-fn))
|
||||||
(print "with args " (b/show args))
|
(print "with args " (b/show args))
|
||||||
(when (or
|
(when (or
|
||||||
(= :function (type the-fn))
|
(= :function (type the-fn))
|
||||||
(= :cfunction (type the-fn)))
|
(= :cfunction (type the-fn)))
|
||||||
(print "Janet function")
|
|
||||||
(break (the-fn ;args)))
|
(break (the-fn ;args)))
|
||||||
(def clauses (the-fn :body))
|
(def clauses (the-fn :body))
|
||||||
(def len (length clauses))
|
(def len (length clauses))
|
||||||
|
@ -411,11 +353,11 @@
|
||||||
(set (the-fn :match) match-fn)
|
(set (the-fn :match) match-fn)
|
||||||
(match-fn 0 args))
|
(match-fn 0 args))
|
||||||
|
|
||||||
(set call-fn call-fn*)
|
|
||||||
|
|
||||||
(defn- apply-synth-term [prev curr]
|
(defn- apply-synth-term [prev curr]
|
||||||
(print "applying " (b/show prev))
|
(print "applying")
|
||||||
(print "to" (b/show curr))
|
(pp curr)
|
||||||
|
(print "to")
|
||||||
|
(pp prev)
|
||||||
(def types [(b/ludus/type prev) (b/ludus/type curr)])
|
(def types [(b/ludus/type prev) (b/ludus/type curr)])
|
||||||
(print "typle:")
|
(print "typle:")
|
||||||
(pp types)
|
(pp types)
|
||||||
|
@ -464,7 +406,9 @@
|
||||||
|
|
||||||
(defn- recur [ast ctx] (todo "recur"))
|
(defn- recur [ast ctx] (todo "recur"))
|
||||||
|
|
||||||
(defn- testt [ast ctx] (todo "test"))
|
(defn- repeatt [ast ctx] (todo "repeat"))
|
||||||
|
|
||||||
|
(defn - testt [ast ctx] (todo "test"))
|
||||||
|
|
||||||
(defn- interpret* [ast ctx]
|
(defn- interpret* [ast ctx]
|
||||||
(print "interpreting node " (ast :type))
|
(print "interpreting node " (ast :type))
|
||||||
|
@ -539,7 +483,7 @@
|
||||||
(def parsed (p/parse scanned))
|
(def parsed (p/parse scanned))
|
||||||
(when (has-errors? parsed) (break (parsed :errors)))
|
(when (has-errors? parsed) (break (parsed :errors)))
|
||||||
(def validated (v/valid parsed b/ctx))
|
(def validated (v/valid parsed b/ctx))
|
||||||
# (when (has-errors? validated) (break (validated :errors)))
|
(when (has-errors? validated) (break (validated :errors)))
|
||||||
# (def cleaned (get-in parsed [:ast :data 1]))
|
# (def cleaned (get-in parsed [:ast :data 1]))
|
||||||
# (pp cleaned)
|
# (pp cleaned)
|
||||||
(interpret (parsed :ast) @{:^parent b/ctx})
|
(interpret (parsed :ast) @{:^parent b/ctx})
|
||||||
|
@ -550,9 +494,9 @@
|
||||||
|
|
||||||
(do
|
(do
|
||||||
(set source `
|
(set source `
|
||||||
let #{:a ay, :b (:ok, bee), ...c} = #{:a 1, :b (:ok, 42), :c 3}
|
|
||||||
`)
|
`)
|
||||||
(def result (run))
|
(def result (run))
|
||||||
# (b/show result)
|
(b/show result)
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
|
@ -411,7 +411,7 @@
|
||||||
:token origin})
|
:token origin})
|
||||||
{:type :pair :data [key value] :token origin})
|
{:type :pair :data [key value] :token origin})
|
||||||
:keyword (do
|
:keyword (do
|
||||||
(def key (capture kw-only parser))
|
(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))
|
||||||
|
@ -507,7 +507,7 @@
|
||||||
(def key {:type :keyword :data (keyword name) :token origin})
|
(def key {:type :keyword :data (keyword name) :token origin})
|
||||||
{:type :pair :data [key word] :token origin})
|
{:type :pair :data [key word] :token origin})
|
||||||
:keyword (do
|
:keyword (do
|
||||||
(def key (capture kw-only parser))
|
(def key (capture kw parser))
|
||||||
(def value (capture pattern parser))
|
(def value (capture pattern 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))
|
||||||
|
@ -1104,8 +1104,8 @@
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
# (do
|
(do
|
||||||
(comment
|
# (comment
|
||||||
(def source `a :b :c
|
(def source `a :b :c
|
||||||
`)
|
`)
|
||||||
(def scanned (s/scan source))
|
(def scanned (s/scan source))
|
||||||
|
|
|
@ -144,6 +144,9 @@ Deferred until a later iteration of Ludus:
|
||||||
(set (status :last) nil)
|
(set (status :last) nil)
|
||||||
validator)
|
validator)
|
||||||
|
|
||||||
|
### XXX: to do
|
||||||
|
(defn- dict-pattern [validator])
|
||||||
|
|
||||||
(defn- word-pattern [validator]
|
(defn- word-pattern [validator]
|
||||||
(def ast (validator :ast))
|
(def ast (validator :ast))
|
||||||
(def name (ast :data))
|
(def name (ast :data))
|
||||||
|
@ -207,12 +210,6 @@ Deferred until a later iteration of Ludus:
|
||||||
(set (ast :compiled) (peg/compile grammar))
|
(set (ast :compiled) (peg/compile grammar))
|
||||||
(set (ast :bindings) bindings))
|
(set (ast :bindings) bindings))
|
||||||
|
|
||||||
(defn- pair [validator]
|
|
||||||
(def ast (validator :ast))
|
|
||||||
(def [_ patt] (ast :data))
|
|
||||||
(set (validator :ast) patt)
|
|
||||||
(pattern validator))
|
|
||||||
|
|
||||||
(defn- pattern* [validator]
|
(defn- pattern* [validator]
|
||||||
(print "PATTERN*")
|
(print "PATTERN*")
|
||||||
(def ast (validator :ast))
|
(def ast (validator :ast))
|
||||||
|
@ -227,11 +224,9 @@ Deferred until a later iteration of Ludus:
|
||||||
:word (word-pattern validator)
|
:word (word-pattern validator)
|
||||||
:list (simple-coll-pattern validator)
|
:list (simple-coll-pattern validator)
|
||||||
:tuple (simple-coll-pattern validator)
|
:tuple (simple-coll-pattern validator)
|
||||||
:dict (simple-coll-pattern validator)
|
|
||||||
:splat (splattern validator)
|
:splat (splattern validator)
|
||||||
:typed (typed validator)
|
:typed (typed validator)
|
||||||
:interpolated (str-pattern validator)
|
:interpolated (str-pattern validator)
|
||||||
:pair (pair validator)
|
|
||||||
)))
|
)))
|
||||||
|
|
||||||
(set pattern pattern*)
|
(set pattern pattern*)
|
||||||
|
@ -343,15 +338,14 @@ Deferred until a later iteration of Ludus:
|
||||||
|
|
||||||
(defn- check-arity [validator]
|
(defn- check-arity [validator]
|
||||||
(def ast (validator :ast))
|
(def ast (validator :ast))
|
||||||
# (when (ast :partial) (break validator))
|
(when (ast :partial) (break validator))
|
||||||
(def ctx (validator :ctx))
|
(def ctx (validator :ctx))
|
||||||
(def data (ast :data))
|
(def data (ast :data))
|
||||||
(def fn-word (first data))
|
(def fn-word (first data))
|
||||||
(def the-fn (resolve-name ctx (fn-word :data)))
|
(def the-fn (resolve-name ctx (fn-word :data)))
|
||||||
(when (not the-fn) (break validator))
|
(when (not the-fn) (break validator))
|
||||||
(when (= :function (type the-fn)) (break validator))
|
(when (= :function (type the-fn)) (break validator))
|
||||||
(when (= :cfunction (type the-fn) (break validator)))
|
(when (= :cfunction (type the-fn)) (break validator))
|
||||||
(when (not= :fn (the-fn :type)) (break validator))
|
|
||||||
(print "fn name: " (the-fn :name))
|
(print "fn name: " (the-fn :name))
|
||||||
(def arities (the-fn :arities))
|
(def arities (the-fn :arities))
|
||||||
(print "arities: ")
|
(print "arities: ")
|
||||||
|
@ -359,7 +353,6 @@ Deferred until a later iteration of Ludus:
|
||||||
(def args (get data 1))
|
(def args (get data 1))
|
||||||
(def num-args (length (args :data)))
|
(def num-args (length (args :data)))
|
||||||
(print "called with #args " num-args)
|
(print "called with #args " num-args)
|
||||||
(pp (get (validator :ctx) "bar"))
|
|
||||||
(when (has-key? arities num-args) (break validator))
|
(when (has-key? arities num-args) (break validator))
|
||||||
(def rest-arities (keys (arities :rest)))
|
(def rest-arities (keys (arities :rest)))
|
||||||
(when (empty? rest-arities)
|
(when (empty? rest-arities)
|
||||||
|
@ -636,15 +629,17 @@ Deferred until a later iteration of Ludus:
|
||||||
(set (validator :ctx) base-ctx)
|
(set (validator :ctx) base-ctx)
|
||||||
(validate validator))
|
(validate validator))
|
||||||
|
|
||||||
(import ./base :as b)
|
(defn foo [] :foo)
|
||||||
|
(def base {
|
||||||
|
"foo" foo
|
||||||
|
})
|
||||||
|
|
||||||
(do
|
(do
|
||||||
# (comment
|
# (comment
|
||||||
(def source `
|
(def source `
|
||||||
let #{a, b} = #{:a 1}
|
foo ()
|
||||||
b
|
|
||||||
`)
|
`)
|
||||||
(def scanned (s/scan source))
|
(def scanned (s/scan source))
|
||||||
(def parsed (p/parse scanned))
|
(def parsed (p/parse scanned))
|
||||||
(valid parsed b/ctx)
|
(valid parsed base)
|
||||||
)
|
)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user