diff options
Diffstat (limited to '')
| -rw-r--r-- | src/lux/analyser.clj | 262 |
1 files changed, 125 insertions, 137 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index 93092c9ac..cf2e4bab7 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -44,168 +44,156 @@ )) )) -(defn ^:private aba1 [analyse optimize eval! compile-module compilers exo-type token] - (|let [[compile-def compile-program compile-class compile-interface] compilers] +(defn ^:private just-analyse [analyser syntax] + (&type/with-var + (fn [?var] + (|do [[[?output-type ?output-cursor] ?output-term] (&&/analyse-1 analyser ?var syntax)] + (|case [?var ?output-type] + [(&/$VarT ?e-id) (&/$VarT ?a-id)] + (if (= ?e-id ?a-id) + (|do [=output-type (&type/clean ?var ?output-type)] + (return (&&/|meta =output-type ?output-cursor ?output-term))) + (|do [=output-type (&type/clean ?var ?var)] + (return (&&/|meta =output-type ?output-cursor ?output-term)))) + + [_ _] + (|do [=output-type (&type/clean ?var ?output-type)] + (return (&&/|meta =output-type ?output-cursor ?output-term)))) + )))) + +(defn ^:private analyse-ast [optimize eval! compile-module compilers exo-type ?token] + (|let [analyse (partial analyse-ast optimize eval! compile-module compilers) + [cursor token] ?token + [compile-def compile-program compile-class compile-interface] compilers] (|case token ;; Standard special forms (&/$BoolS ?value) - (|do [_ (&type/check exo-type &type/Bool) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor (&&/$bool ?value))))) + (|do [_ (&type/check exo-type &type/Bool)] + (return (&/|list (&&/|meta exo-type cursor (&&/$bool ?value))))) (&/$IntS ?value) - (|do [_ (&type/check exo-type &type/Int) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor (&&/$int ?value))))) + (|do [_ (&type/check exo-type &type/Int)] + (return (&/|list (&&/|meta exo-type cursor (&&/$int ?value))))) (&/$RealS ?value) - (|do [_ (&type/check exo-type &type/Real) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor (&&/$real ?value))))) + (|do [_ (&type/check exo-type &type/Real)] + (return (&/|list (&&/|meta exo-type cursor (&&/$real ?value))))) (&/$CharS ?value) - (|do [_ (&type/check exo-type &type/Char) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor (&&/$char ?value))))) + (|do [_ (&type/check exo-type &type/Char)] + (return (&/|list (&&/|meta exo-type cursor (&&/$char ?value))))) (&/$TextS ?value) - (|do [_ (&type/check exo-type &type/Text) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor (&&/$text ?value))))) + (|do [_ (&type/check exo-type &type/Text)] + (return (&/|list (&&/|meta exo-type cursor (&&/$text ?value))))) (&/$TupleS ?elems) - (&&lux/analyse-tuple analyse (&/$Right exo-type) ?elems) + (&/with-analysis-meta cursor exo-type + (&&lux/analyse-tuple analyse (&/$Right exo-type) ?elems)) (&/$RecordS ?elems) - (&&lux/analyse-record analyse exo-type ?elems) + (&/with-analysis-meta cursor exo-type + (&&lux/analyse-record analyse exo-type ?elems)) (&/$TagS ?ident) - (analyse-variant+ analyse exo-type ?ident &/$Nil) + (&/with-analysis-meta cursor exo-type + (analyse-variant+ analyse exo-type ?ident &/$Nil)) (&/$SymbolS ?ident) - (&&lux/analyse-symbol analyse exo-type ?ident) + (&/with-analysis-meta cursor exo-type + (&&lux/analyse-symbol analyse exo-type ?ident)) + + (&/$FormS (&/$Cons [command-meta command] parameters)) + (|case command + (&/$SymbolS _ command-name) + (case command-name + "_lux_case" + (|let [(&/$Cons ?value ?branches) parameters] + (&/with-analysis-meta cursor exo-type + (&&lux/analyse-case analyse exo-type ?value ?branches))) + + "_lux_lambda" + (|let [(&/$Cons [_ (&/$SymbolS "" ?self)] + (&/$Cons [_ (&/$SymbolS "" ?arg)] + (&/$Cons ?body + (&/$Nil)))) parameters] + (&/with-analysis-meta cursor exo-type + (&&lux/analyse-lambda analyse exo-type ?self ?arg ?body))) + + "_lux_proc" + (|let [(&/$Cons [_ (&/$TupleS (&/$Cons [_ (&/$TextS ?category)] + (&/$Cons [_ (&/$TextS ?proc)] + (&/$Nil))))] + (&/$Cons [_ (&/$TupleS ?args)] + (&/$Nil))) parameters] + (&/with-analysis-meta cursor exo-type + (&&host/analyse-host analyse exo-type compilers ?category ?proc ?args))) + + "_lux_:" + (|let [(&/$Cons ?type + (&/$Cons ?value + (&/$Nil))) parameters] + (&/with-analysis-meta cursor exo-type + (&&lux/analyse-ann analyse eval! exo-type ?type ?value))) + + "_lux_:!" + (|let [(&/$Cons ?type + (&/$Cons ?value + (&/$Nil))) parameters] + (&/with-analysis-meta cursor exo-type + (&&lux/analyse-coerce analyse eval! exo-type ?type ?value))) + + "_lux_def" + (|let [(&/$Cons [_ (&/$SymbolS "" ?name)] + (&/$Cons ?value + (&/$Cons ?meta + (&/$Nil)) + )) parameters] + (&/with-cursor cursor + (&&lux/analyse-def analyse optimize eval! compile-def ?name ?value ?meta))) + + "_lux_alias" + (|let [(&/$Cons [_ (&/$TextS ?alias)] + (&/$Cons [_ (&/$TextS ?module)] + (&/$Nil))) parameters] + (&/with-cursor cursor + (&&lux/analyse-alias analyse ?alias ?module))) + + "_lux_import" + (|let [(&/$Cons [_ (&/$TextS ?path)] + (&/$Nil)) parameters] + (&/with-cursor cursor + (&&lux/analyse-import analyse compile-module ?path))) + + "_lux_program" + (|let [(&/$Cons [_ (&/$SymbolS "" ?args)] + (&/$Cons ?body + (&/$Nil))) parameters] + (&/with-cursor cursor + (&&lux/analyse-program analyse optimize compile-program ?args ?body))) + + ;; else + (&/with-analysis-meta cursor exo-type + (|do [=fn (just-analyse analyse (&/T [command-meta command]))] + (&&lux/analyse-apply analyse cursor exo-type =fn parameters)))) + + (&/$IntS idx) + (&/with-analysis-meta cursor exo-type + (&&lux/analyse-variant analyse (&/$Right exo-type) idx nil parameters)) + + (&/$TagS ?ident) + (&/with-analysis-meta cursor exo-type + (analyse-variant+ analyse exo-type ?ident parameters)) - (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_case")] - (&/$Cons ?value ?branches))) - (&&lux/analyse-case analyse exo-type ?value ?branches) - - (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_lambda")] - (&/$Cons [_ (&/$SymbolS "" ?self)] - (&/$Cons [_ (&/$SymbolS "" ?arg)] - (&/$Cons ?body - (&/$Nil)))))) - (&&lux/analyse-lambda analyse exo-type ?self ?arg ?body) - - (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_def")] - (&/$Cons [_ (&/$SymbolS "" ?name)] - (&/$Cons ?value - (&/$Cons ?meta - (&/$Nil)) - )))) - (&&lux/analyse-def analyse optimize eval! compile-def ?name ?value ?meta) - - (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_import")] - (&/$Cons [_ (&/$TextS ?path)] - (&/$Nil)))) - (&&lux/analyse-import analyse compile-module ?path) - - (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_:")] - (&/$Cons ?type - (&/$Cons ?value - (&/$Nil))))) - (&&lux/analyse-ann analyse eval! exo-type ?type ?value) - - (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_:!")] - (&/$Cons ?type - (&/$Cons ?value - (&/$Nil))))) - (&&lux/analyse-coerce analyse eval! exo-type ?type ?value) - - (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_alias")] - (&/$Cons [_ (&/$TextS ?alias)] - (&/$Cons [_ (&/$TextS ?module)] - (&/$Nil))))) - (&&lux/analyse-alias analyse ?alias ?module) - - (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_proc")] - (&/$Cons [_ (&/$TupleS (&/$Cons [_ (&/$TextS ?category)] - (&/$Cons [_ (&/$TextS ?proc)] - (&/$Nil))))] - (&/$Cons [_ (&/$TupleS ?args)] - (&/$Nil))))) - (&&host/analyse-host analyse exo-type compilers ?category ?proc ?args) - - (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_program")] - (&/$Cons [_ (&/$SymbolS "" ?args)] - (&/$Cons ?body - (&/$Nil))))) - (&&lux/analyse-program analyse optimize compile-program ?args ?body) + _ + (&/with-analysis-meta cursor exo-type + (|do [=fn (just-analyse analyse (&/T [command-meta command]))] + (&&lux/analyse-apply analyse cursor exo-type =fn parameters)))) _ (&/fail-with-loc (str "[Analyser Error] Unknown syntax: " (prn-str (&/show-ast (&/T [(&/T ["" -1 -1]) token]))))) ))) -(defn ^:private analyse-basic-ast [analyse optimize eval! compile-module compilers exo-type token] - (|case token - [meta ?token] - (fn [state] - (|case ((aba1 analyse optimize eval! compile-module compilers exo-type ?token) state) - (&/$Right state* output) - (return* state* output) - - (&/$Left msg) - (if (= "" msg) - (fail* (&/add-loc (&/get$ &/$cursor state) (str "[Analyser Error] Unrecognized token: " (&/show-ast token)))) - (fail* (&/add-loc (&/get$ &/$cursor state) msg))) - )))) - -(defn ^:private just-analyse [analyser syntax] - (&type/with-var - (fn [?var] - (|do [[[?output-type ?output-cursor] ?output-term] (&&/analyse-1 analyser ?var syntax)] - (|case [?var ?output-type] - [(&/$VarT ?e-id) (&/$VarT ?a-id)] - (if (= ?e-id ?a-id) - (|do [=output-type (&type/clean ?var ?output-type)] - (return (&&/|meta =output-type ?output-cursor ?output-term))) - (|do [=output-type (&type/clean ?var ?var)] - (return (&&/|meta =output-type ?output-cursor ?output-term)))) - - [_ _] - (|do [=output-type (&type/clean ?var ?output-type)] - (return (&&/|meta =output-type ?output-cursor ?output-term)))) - )))) - -(defn ^:private analyse-ast [optimize eval! compile-module compilers exo-type token] - (|let [[cursor _] token - analyser (partial analyse-ast optimize eval! compile-module compilers)] - (&/with-cursor cursor - (&/with-expected-type exo-type - (|case token - [meta (&/$FormS (&/$Cons [_ (&/$IntS idx)] ?values))] - (&&lux/analyse-variant analyser (&/$Right exo-type) idx nil ?values) - - [meta (&/$FormS (&/$Cons [_ (&/$TagS ?ident)] ?values))] - (analyse-variant+ analyser exo-type ?ident ?values) - - [meta (&/$FormS (&/$Cons ?fn ?args))] - (|case ?fn - [_ (&/$SymbolS _)] - (fn [state] - (|case ((just-analyse analyser ?fn) state) - (&/$Right state* =fn) - ((&&lux/analyse-apply analyser exo-type =fn ?args) state*) - - _ - ((analyse-basic-ast analyser optimize eval! compile-module compilers exo-type token) state))) - - _ - (|do [=fn (just-analyse analyser ?fn)] - (&&lux/analyse-apply analyser exo-type =fn ?args))) - - _ - (analyse-basic-ast analyser optimize eval! compile-module compilers exo-type token)))))) - ;; [Resources] (defn analyse [optimize eval! compile-module compilers] (|do [asts &parser/parse] |