Compare commits
3 Commits
3903f10c8d
...
bbd41a0f74
Author | SHA1 | Date | |
---|---|---|---|
|
bbd41a0f74 | ||
|
bc1eac46b8 | ||
|
d0a6cdbf54 |
|
@ -362,7 +362,6 @@
|
||||||
(def the-fn @{:name name :^type :fn :body clauses :ctx ctx})
|
(def the-fn @{:name name :^type :fn :body clauses :ctx ctx})
|
||||||
(set (ctx name) the-fn))
|
(set (ctx name) the-fn))
|
||||||
|
|
||||||
# TODO
|
|
||||||
(defn- is_placeholder [x] (= x :_))
|
(defn- is_placeholder [x] (= x :_))
|
||||||
|
|
||||||
(var call-fn nil)
|
(var call-fn nil)
|
||||||
|
@ -389,6 +388,8 @@
|
||||||
(print "Janet function")
|
(print "Janet function")
|
||||||
(break (the-fn ;args)))
|
(break (the-fn ;args)))
|
||||||
(def clauses (the-fn :body))
|
(def clauses (the-fn :body))
|
||||||
|
(when (= :nothing clauses)
|
||||||
|
(error {:node the-fn :value args :msg "cannot call function before it is defined"}))
|
||||||
(def len (length clauses))
|
(def len (length clauses))
|
||||||
(when (the-fn :match) (break ((the-fn :match) 0 args)))
|
(when (the-fn :match) (break ((the-fn :match) 0 args)))
|
||||||
(defn match-fn [i args]
|
(defn match-fn [i args]
|
||||||
|
@ -552,15 +553,18 @@
|
||||||
# (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})
|
||||||
# (try (interpret (parsed :ast) @{})
|
(try (interpret (parsed :ast) @{})
|
||||||
# ([e] (print "Ludus panicked!: "
|
([e] (print "Ludus panicked!: "
|
||||||
# (if (struct? e) (error (e :msg)) (error e)))))
|
(if (struct? e) (error (e :msg)) (error e)))))
|
||||||
)
|
)
|
||||||
|
|
||||||
(do
|
(do
|
||||||
(set source `
|
(set source `
|
||||||
let #{:a ay, :b (:ok, bee), ...c} = #{:a 1, :b (:ok, 42), :c 3}
|
fn foo
|
||||||
|
fn bar () -> foo ()
|
||||||
|
fn foo () -> :foo
|
||||||
|
bar ()
|
||||||
`)
|
`)
|
||||||
(def result (run))
|
(def result (run))
|
||||||
# (b/show result)
|
# (b/show result)
|
||||||
|
|
|
@ -786,7 +786,7 @@
|
||||||
(def data (case (-> parser current type)
|
(def data (case (-> parser current type)
|
||||||
:lbrace (fn-clauses parser)
|
:lbrace (fn-clauses parser)
|
||||||
:lparen (fn-simple parser)
|
:lparen (fn-simple parser)
|
||||||
(panic parser (string "expected clause or clauses, got " (-> current parser type)))))
|
:nothing))
|
||||||
@{:type :fn :name name :data data :token origin})
|
@{:type :fn :name name :data data :token origin})
|
||||||
([err] err)))
|
([err] err)))
|
||||||
|
|
||||||
|
@ -1130,7 +1130,9 @@
|
||||||
(do
|
(do
|
||||||
# (comment
|
# (comment
|
||||||
(def source `
|
(def source `
|
||||||
print! ("hello")
|
fn foo
|
||||||
|
fn bar
|
||||||
|
fn () -> :baz
|
||||||
`)
|
`)
|
||||||
(def scanned (s/scan source))
|
(def scanned (s/scan source))
|
||||||
(print "\n***NEW PARSE***\n")
|
(print "\n***NEW PARSE***\n")
|
||||||
|
|
|
@ -90,6 +90,9 @@ Deferred until a later iteration of Ludus:
|
||||||
(set (validator :ctx) parent)
|
(set (validator :ctx) parent)
|
||||||
validator)
|
validator)
|
||||||
|
|
||||||
|
(defn- resolve-local [ctx name]
|
||||||
|
(get ctx name))
|
||||||
|
|
||||||
(defn- resolve-name [ctx name]
|
(defn- resolve-name [ctx name]
|
||||||
(when (nil? ctx) (break nil))
|
(when (nil? ctx) (break nil))
|
||||||
(def node (get ctx name))
|
(def node (get ctx name))
|
||||||
|
@ -272,6 +275,24 @@ Deferred until a later iteration of Ludus:
|
||||||
(match-clauses validator clauses)
|
(match-clauses validator clauses)
|
||||||
validator)
|
validator)
|
||||||
|
|
||||||
|
(defn- declare [validator fnn]
|
||||||
|
(def status (validator :status))
|
||||||
|
(def declared (get status :declared @{}))
|
||||||
|
(set (declared fnn) true)
|
||||||
|
(set (status :declared) declared)
|
||||||
|
(print "declared function " (fnn :name))
|
||||||
|
(pp declared)
|
||||||
|
validator)
|
||||||
|
|
||||||
|
(defn- define [validator fnn]
|
||||||
|
(def status (validator :status))
|
||||||
|
(def declared (get status :declared @{}))
|
||||||
|
(set (declared fnn) nil)
|
||||||
|
(set (status :declared) declared)
|
||||||
|
(print "defined function " (fnn :name))
|
||||||
|
(pp declared)
|
||||||
|
validator)
|
||||||
|
|
||||||
(defn- fnn [validator]
|
(defn- fnn [validator]
|
||||||
(def ast (validator :ast))
|
(def ast (validator :ast))
|
||||||
(def name (ast :name))
|
(def name (ast :name))
|
||||||
|
@ -281,18 +302,22 @@ Deferred until a later iteration of Ludus:
|
||||||
(set (status :tail) true)
|
(set (status :tail) true)
|
||||||
(when name
|
(when name
|
||||||
(def ctx (validator :ctx))
|
(def ctx (validator :ctx))
|
||||||
(def resolved (resolve-name ctx name))
|
(def resolved (ctx name))
|
||||||
(when resolved
|
(when (and resolved (not= :nothing (resolved :data)))
|
||||||
(def {:line line :input input} (get-in ctx [name :token]))
|
(def {:line line :input input} (get-in ctx [name :token]))
|
||||||
(array/push (validator :errors)
|
(array/push (validator :errors)
|
||||||
{:node ast :msg (string "name is already bound on line " line " of " input)}))
|
{:node ast :msg (string "name is already bound on line " line " of " input)}))
|
||||||
|
(when (and resolved (= :nothing (resolved :data)))
|
||||||
|
(define validator resolved))
|
||||||
(set (ctx name) ast))
|
(set (ctx name) ast))
|
||||||
(match-clauses validator (ast :data))
|
(def data (ast :data))
|
||||||
|
(when (= data :nothing)
|
||||||
|
(break (declare validator ast)))
|
||||||
|
(match-clauses validator data)
|
||||||
(set (status :tail) tail?)
|
(set (status :tail) tail?)
|
||||||
(def clauses (ast :data))
|
|
||||||
(def rest-arities @{})
|
(def rest-arities @{})
|
||||||
(def arities @{:rest rest-arities})
|
(def arities @{:rest rest-arities})
|
||||||
(each clause clauses
|
(each clause data
|
||||||
(print "CLAUSE:")
|
(print "CLAUSE:")
|
||||||
(pp clause)
|
(pp clause)
|
||||||
(def patt (first clause))
|
(def patt (first clause))
|
||||||
|
@ -314,7 +339,7 @@ Deferred until a later iteration of Ludus:
|
||||||
(set (validator :ast) expr)
|
(set (validator :ast) expr)
|
||||||
(validate validator)
|
(validate validator)
|
||||||
(def name (ast :name))
|
(def name (ast :name))
|
||||||
(def resolved (resolve-name ctx name))
|
(def resolved (ctx name))
|
||||||
(when resolved
|
(when resolved
|
||||||
(def {:line line :input input} (get-in ctx [name :token]))
|
(def {:line line :input input} (get-in ctx [name :token]))
|
||||||
(array/push (validator :errors)
|
(array/push (validator :errors)
|
||||||
|
@ -726,26 +751,33 @@ Deferred until a later iteration of Ludus:
|
||||||
|
|
||||||
(set validate validate*)
|
(set validate validate*)
|
||||||
|
|
||||||
|
(defn- cleanup [validator]
|
||||||
|
(def declared (get-in validator [:status :declared] {}))
|
||||||
|
(when (any? declared)
|
||||||
|
(each declaration declared
|
||||||
|
(array/push (validator :errors) {:node declaration :msg "declared fn, but not defined"})))
|
||||||
|
validator)
|
||||||
|
|
||||||
(defn valid [ast &opt ctx]
|
(defn valid [ast &opt ctx]
|
||||||
(default ctx @{})
|
(default ctx @{})
|
||||||
(def validator (new-validator ast))
|
(def validator (new-validator ast))
|
||||||
(def base-ctx @{:^parent ctx})
|
(def base-ctx @{:^parent ctx})
|
||||||
(set (validator :ctx) base-ctx)
|
(set (validator :ctx) base-ctx)
|
||||||
(validate validator))
|
(validate validator)
|
||||||
|
(cleanup validator))
|
||||||
|
|
||||||
(import ./base :as b)
|
(import ./base :as b)
|
||||||
|
|
||||||
(do
|
(do
|
||||||
# (comment
|
# (comment
|
||||||
(def source `
|
(def source `
|
||||||
fn foo {
|
fn foo
|
||||||
() -> foo (:foo)
|
fn bar () -> foo ()
|
||||||
}
|
fn foo () -> bar ()
|
||||||
|
|
||||||
foo ()
|
|
||||||
`)
|
`)
|
||||||
(def scanned (s/scan source))
|
(def scanned (s/scan source))
|
||||||
(def parsed (p/parse scanned))
|
(def parsed (p/parse scanned))
|
||||||
(def validated (valid parsed))
|
(def validated (valid parsed))
|
||||||
|
# (get-in validated [:status :declared])
|
||||||
# (validated :ctx)
|
# (validated :ctx)
|
||||||
)
|
)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user