validate forward declarations
This commit is contained in:
parent
d0a6cdbf54
commit
bc1eac46b8
|
@ -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