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.clj211
1 files changed, 0 insertions, 211 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
deleted file mode 100644
index 4133927e7..000000000
--- a/src/lux/analyser.clj
+++ /dev/null
@@ -1,211 +0,0 @@
-;; Copyright (c) Eduardo Julian. All rights reserved.
-;; This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
-;; If a copy of the MPL was not distributed with this file,
-;; You can obtain one at http://mozilla.org/MPL/2.0/.
-
-(ns lux.analyser
- (:require (clojure [template :refer [do-template]])
- clojure.core.match
- clojure.core.match.array
- (lux [base :as & :refer [|let |do return fail return* fail* |case]]
- [reader :as &reader]
- [parser :as &parser]
- [type :as &type]
- [host :as &host])
- (lux.analyser [base :as &&]
- [lux :as &&lux]
- [host :as &&host]
- [module :as &&module]
- [parser :as &&a-parser])))
-
-;; [Utils]
-(defn analyse-variant+ [analyse exo-type ident values]
- (|do [[module tag-name] (&/normalize ident)
- _ (&&module/ensure-can-see-tag module tag-name)
- idx (&&module/tag-index module tag-name)
- group (&&module/tag-group module tag-name)
- :let [is-last? (= idx (dec (&/|length group)))]]
- (if (= 1 (&/|length group))
- (|do [_cursor &/cursor]
- (analyse exo-type (&/T [_cursor (&/$TupleS values)])))
- (|case exo-type
- (&/$VarT id)
- (|do [? (&type/bound? id)]
- (if (or ? (&&/type-tag? module tag-name))
- (&&lux/analyse-variant analyse (&/$Right exo-type) idx is-last? values)
- (|do [wanted-type (&&module/tag-type module tag-name)
- wanted-type* (&type/instantiate-inference wanted-type)
- [[variant-type variant-cursor] variant-analysis] (&&/cap-1 (&&lux/analyse-variant analyse (&/$Left wanted-type*) idx is-last? values))
- _ (&type/check exo-type variant-type)]
- (return (&/|list (&&/|meta exo-type variant-cursor variant-analysis))))))
-
- _
- (&&lux/analyse-variant analyse (&/$Right exo-type) idx is-last? values)
- ))
- ))
-
-(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)]
- (return (&/|list (&&/|meta exo-type cursor (&&/$bool ?value)))))
-
- (&/$NatS ?value)
- (|do [_ (&type/check exo-type &type/Nat)]
- (return (&/|list (&&/|meta exo-type cursor (&&/$nat ?value)))))
-
- (&/$IntS ?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)]
- (return (&/|list (&&/|meta exo-type cursor (&&/$real ?value)))))
-
- (&/$CharS ?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)]
- (return (&/|list (&&/|meta exo-type cursor (&&/$text ?value)))))
-
- (&/$TupleS ?elems)
- (&/with-analysis-meta cursor exo-type
- (&&lux/analyse-tuple analyse (&/$Right exo-type) ?elems))
-
- (&/$RecordS ?elems)
- (&/with-analysis-meta cursor exo-type
- (&&lux/analyse-record analyse exo-type ?elems))
-
- (&/$TagS ?ident)
- (&/with-analysis-meta cursor exo-type
- (analyse-variant+ analyse exo-type ?ident &/$Nil))
-
- (&/$SymbolS ?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_module"
- (|let [(&/$Cons ?meta (&/$Nil)) parameters]
- (&/with-cursor cursor
- (&&lux/analyse-module analyse optimize eval! compile-module ?meta)))
-
- "_lux_program"
- (|let [(&/$Cons [_ (&/$SymbolS "" ?args)]
- (&/$Cons ?body
- (&/$Nil))) parameters]
- (&/with-cursor cursor
- (&&lux/analyse-program analyse optimize compile-program ?args ?body)))
-
- ;; else
- (&/with-cursor cursor
- (|do [=fn (just-analyse analyse (&/T [command-meta command]))]
- (&&lux/analyse-apply analyse cursor exo-type =fn parameters))))
-
- (&/$NatS 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))
-
- _
- (&/with-cursor cursor
- (|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])))))
- )))
-
-;; [Resources]
-(defn analyse [optimize eval! compile-module compilers]
- (|do [asts &parser/parse]
- (&/flat-map% (partial analyse-ast optimize eval! compile-module compilers &/$VoidT) asts)))
-
-(defn clean-output [?var analysis]
- (|do [:let [[[?output-type ?output-cursor] ?output-term] analysis]
- =output-type (&type/clean ?var ?output-type)]
- (return (&&/|meta =output-type ?output-cursor ?output-term))))
-
-(defn repl-analyse [optimize eval! compile-module compilers]
- (|do [asts &parser/parse]
- (&/flat-map% (fn [ast]
- (&type/with-var
- (fn [?var]
- (|do [=outputs (&/with-closure
- (analyse-ast optimize eval! compile-module compilers ?var ast))]
- (&/map% (partial clean-output ?var) =outputs)))))
- asts)))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 17:11:23 +0000