aboutsummaryrefslogtreecommitdiff
path: root/src/lux/analyser.clj
diff options
context:
space:
mode:
Diffstat (limited to 'src/lux/analyser.clj')
-rw-r--r--src/lux/analyser.clj262
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]