aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/lux/analyser.clj18
-rw-r--r--src/lux/analyser/case.clj7
-rw-r--r--src/lux/analyser/host.clj17
-rw-r--r--src/lux/analyser/lambda.clj24
-rw-r--r--src/lux/analyser/lux.clj167
5 files changed, 118 insertions, 115 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index d18c2cfcf..7dc4c7607 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -24,15 +24,18 @@
(matchv ::M/objects [token]
[["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_catch"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?ex-class]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?ex-arg]]]]
+ ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?ex-arg]]]]
["lux;Cons" [?catch-body
["lux;Nil" _]]]]]]]]]]]]]
- (&/T (&/|++ catch+ (&/|list (&/T ?ex-class ?ex-arg ?catch-body))) finally+)
+ (return (&/T (&/|++ catch+ (&/|list (&/T ?ex-class ?ex-arg ?catch-body))) finally+))
[["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_finally"]]]]
["lux;Cons" [?finally-body
["lux;Nil" _]]]]]]]]]
- (&/T catch+ (&/V "lux;Some" ?finally-body))))
+ (return (&/T catch+ (&/V "lux;Some" ?finally-body)))
+
+ [_]
+ (fail (str "[Analyser Error] Wrong syntax for exception handler: " (&/show-ast token)))))
(defn ^:private aba7 [analyse eval! compile-module compile-token exo-type token]
(matchv ::M/objects [token]
@@ -74,7 +77,7 @@
;; Programs
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_program"]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ?args]]]
+ ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?args]]]]
["lux;Cons" [?body
["lux;Nil" _]]]]]]]]]
(&&host/analyse-jvm-program analyse compile-token ?args ?body)
@@ -246,7 +249,8 @@
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_try"]]]]
["lux;Cons" [?body
?handlers]]]]]]
- (&&host/analyse-jvm-try analyse exo-type ?body (&/fold parse-handler (&/T (&/|list) (&/V "lux;None" nil)) ?handlers))
+ (|do [catches+finally (&/fold% parse-handler (&/T (&/|list) (&/V "lux;None" nil)) ?handlers)]
+ (&&host/analyse-jvm-try analyse exo-type ?body catches+finally))
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_throw"]]]]
["lux;Cons" [?ex
@@ -398,8 +402,8 @@
(&&lux/analyse-case analyse exo-type ?value ?branches)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_lambda"]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ?self]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ?arg]]]
+ ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?self]]]]
+ ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?arg]]]]
["lux;Cons" [?body
["lux;Nil" _]]]]]]]]]]]
(&&lux/analyse-lambda analyse exo-type ?self ?arg ?body)
diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj
index 77f8c418c..7f2c34924 100644
--- a/src/lux/analyser/case.clj
+++ b/src/lux/analyser/case.clj
@@ -116,12 +116,15 @@
(matchv ::M/objects [pattern]
[["lux;Meta" [_ pattern*]]]
(matchv ::M/objects [pattern*]
- [["lux;SymbolS" ?ident]]
- (|do [=kont (&env/with-local (&/ident->text ?ident) value-type
+ [["lux;SymbolS" ["" name]]]
+ (|do [=kont (&env/with-local name value-type
kont)
idx &env/next-local-idx]
(return (&/T (&/V "StoreTestAC" idx) =kont)))
+ [["lux;SymbolS" ident]]
+ (fail (str "[Pattern-matching Error] Symbols must be unqualified: " (&/ident->text ident)))
+
[["lux;BoolS" ?value]]
(|do [_ (&type/check value-type &type/Bool)
=kont kont]
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 663c650e7..d03d0e65c 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -299,10 +299,10 @@
["lux;Nil" _]]]]]]]]]]]]]]]]
(|do [=method-inputs (&/map% (fn [minput]
(matchv ::M/objects [minput]
- [["lux;Meta" [_ ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ?input-name]]]
+ [["lux;Meta" [_ ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?input-name]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?input-type]]]
["lux;Nil" _]]]]]]]]]
- (return (&/T (&/ident->text ?input-name) ?input-type))
+ (return (&/T ?input-name ?input-type))
[_]
(fail "[Analyser Error] Wrong syntax for method input.")))
@@ -358,7 +358,7 @@
(|do [:let [[?catches ?finally] ?catches+?finally]
=body (&&/analyse-1 analyse exo-type ?body)
=catches (&/map% (fn [[?ex-class ?ex-arg ?catch-body]]
- (|do [=catch-body (&&env/with-local (str ";" ?ex-arg) (&/V "lux;DataT" ?ex-class)
+ (|do [=catch-body (&&env/with-local ?ex-arg (&/V "lux;DataT" ?ex-class)
(&&/analyse-1 analyse exo-type ?catch-body))
idx &&env/next-local-idx]
(return (&/T ?ex-class idx =catch-body))))
@@ -434,9 +434,8 @@
)
(defn analyse-jvm-program [analyse compile-token ?args ?body]
- (|let [[_module _name] ?args]
- (|do [=body (&/with-scope ""
- (&&env/with-local (str _module ";" _name) (&/V "lux;AppT" (&/T &type/List &type/Text))
- (&&/analyse-1 analyse (&/V "lux;AppT" (&/T &type/IO &type/Unit)) ?body)))
- _ (compile-token (&/V "jvm-program" =body))]
- (return (&/|list)))))
+ (|do [=body (&/with-scope ""
+ (&&env/with-local ?args (&/V "lux;AppT" (&/T &type/List &type/Text))
+ (&&/analyse-1 analyse (&/V "lux;AppT" (&/T &type/IO &type/Unit)) ?body)))
+ _ (compile-token (&/V "jvm-program" =body))]
+ (return (&/|list))))
diff --git a/src/lux/analyser/lambda.clj b/src/lux/analyser/lambda.clj
index b1b9e2c22..7c7b80577 100644
--- a/src/lux/analyser/lambda.clj
+++ b/src/lux/analyser/lambda.clj
@@ -16,26 +16,22 @@
;; [Resource]
(defn with-lambda [self self-type arg arg-type body]
- (|let [[?module1 ?name1] self
- [?module2 ?name2] arg]
- (&/with-closure
- (|do [scope-name &/get-scope-name]
- (&env/with-local (str ?module1 ";" ?name1) self-type
- (&env/with-local (str ?module2 ";" ?name2) arg-type
- (|do [=return body
- =captured &env/captured-vars]
- (return (&/T scope-name =captured =return)))))))))
+ (&/with-closure
+ (|do [scope-name &/get-scope-name]
+ (&env/with-local self self-type
+ (&env/with-local arg arg-type
+ (|do [=return body
+ =captured &env/captured-vars]
+ (return (&/T scope-name =captured =return))))))))
-(defn close-over [scope ident register frame]
+(defn close-over [scope name register frame]
(matchv ::M/objects [register]
[[_ register-type]]
(|let [register* (&/T (&/V "captured" (&/T scope
(->> frame (&/get$ &/$CLOSURE) (&/get$ &/$COUNTER))
register))
- register-type)
- [?module ?name] ident
- full-name (str ?module ";" ?name)]
+ register-type)]
(&/T register* (&/update$ &/$CLOSURE #(->> %
(&/update$ &/$COUNTER inc)
- (&/update$ &/$MAPPINGS (fn [mps] (&/|put full-name register* mps))))
+ (&/update$ &/$MAPPINGS (fn [mps] (&/|put name register* mps))))
frame)))))
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index c86df3027..7aba5dd39 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -143,90 +143,91 @@
?elems)]
(return (&/|list (&/T (&/V "record" =slots) (&/V "lux;RecordT" exo-type))))))
+(defn ^:private analyse-global [analyse exo-type module name]
+ (|do [[[r-module r-name] $def] (&&module/find-def module name)
+ ;; :let [_ (prn 'analyse-symbol/_1.1 r-module r-name)]
+ endo-type (matchv ::M/objects [$def]
+ [["lux;ValueD" [?type _]]]
+ (return ?type)
+
+ [["lux;MacroD" _]]
+ (return &type/Macro)
+
+ [["lux;TypeD" _]]
+ (return &type/Type))
+ _ (if (and (clojure.lang.Util/identical &type/Type endo-type)
+ (clojure.lang.Util/identical &type/Type exo-type))
+ (return nil)
+ (&type/check exo-type endo-type))]
+ (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name))
+ endo-type)))))
+
+(defn ^:private analyse-local [analyse exo-type name]
+ (fn [state]
+ (|let [stack (&/get$ &/$ENVS state)
+ no-binding? #(and (->> % (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|contains? name) not)
+ (->> % (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS) (&/|contains? name) not))
+ [inner outer] (&/|split-with no-binding? stack)]
+ (matchv ::M/objects [outer]
+ [["lux;Nil" _]]
+ (&/run-state (|do [module-name &/get-module-name]
+ (analyse-global analyse exo-type module-name name))
+ state)
+
+ [["lux;Cons" [?genv ["lux;Nil" _]]]]
+ (do ;; (prn 'analyse-symbol/_2 ?module name name (->> ?genv (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) &/|keys &/->seq))
+ (if-let [global (->> ?genv (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|get name))]
+ (do ;; (prn 'analyse-symbol/_2.1 ?module name name (aget global 0))
+ (matchv ::M/objects [global]
+ [[["lux;Global" [?module* name*]] _]]
+ ((|do [[[r-module r-name] $def] (&&module/find-def ?module* name*)
+ ;; :let [_ (prn 'analyse-symbol/_2.1.1 r-module r-name)]
+ endo-type (matchv ::M/objects [$def]
+ [["lux;ValueD" [?type _]]]
+ (return ?type)
+
+ [["lux;MacroD" _]]
+ (return &type/Macro)
+
+ [["lux;TypeD" _]]
+ (return &type/Type))
+ _ (if (and (clojure.lang.Util/identical &type/Type endo-type)
+ (clojure.lang.Util/identical &type/Type exo-type))
+ (return nil)
+ (&type/check exo-type endo-type))]
+ (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name))
+ endo-type))))
+ state)
+
+ [_]
+ (do ;; (prn 'analyse-symbol/_2.1.2 ?module name name)
+ (fail* "[Analyser Error] Can't have anything other than a global def in the global environment."))))
+ (fail* "_{_ analyse-symbol _}_")))
+
+ [["lux;Cons" [top-outer _]]]
+ (do ;; (prn 'analyse-symbol/_3 ?module name)
+ (|let [scopes (&/|tail (&/folds #(&/|cons (&/get$ &/$NAME %2) %1)
+ (&/|map #(&/get$ &/$NAME %) outer)
+ (&/|reverse inner)))
+ [=local inner*] (&/fold2 (fn [register+new-inner frame in-scope]
+ (|let [[register new-inner] register+new-inner
+ [register* frame*] (&&lambda/close-over (&/|reverse in-scope) name register frame)]
+ (&/T register* (&/|cons frame* new-inner))))
+ (&/T (or (->> top-outer (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|get name))
+ (->> top-outer (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS) (&/|get name)))
+ (&/|list))
+ (&/|reverse inner) scopes)]
+ ((|do [btype (&&/expr-type =local)
+ _ (&type/check exo-type btype)]
+ (return (&/|list =local)))
+ (&/set$ &/$ENVS (&/|++ inner* outer) state))))
+ ))))
+
(defn analyse-symbol [analyse exo-type ident]
- (|do [module-name &/get-module-name]
- (fn [state]
- (|let [[?module ?name] ident
- ;; _ (prn 'analyse-symbol/_0 ?module ?name)
- local-ident (str ?module ";" ?name)
- stack (&/get$ &/$ENVS state)
- no-binding? #(and (->> % (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|contains? local-ident) not)
- (->> % (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS) (&/|contains? local-ident) not))
- [inner outer] (&/|split-with no-binding? stack)]
- (matchv ::M/objects [outer]
- [["lux;Nil" _]]
- (do ;; (prn 'analyse-symbol/_1
- ;; [?module ?name]
- ;; [(if (.equals "" ?module) module-name ?module)
- ;; ?name])
- ((|do [[[r-module r-name] $def] (&&module/find-def (if (.equals "" ?module) module-name ?module)
- ?name)
- ;; :let [_ (prn 'analyse-symbol/_1.1 r-module r-name)]
- endo-type (matchv ::M/objects [$def]
- [["lux;ValueD" [?type _]]]
- (return ?type)
-
- [["lux;MacroD" _]]
- (return &type/Macro)
-
- [["lux;TypeD" _]]
- (return &type/Type))
- _ (if (and (clojure.lang.Util/identical &type/Type endo-type)
- (clojure.lang.Util/identical &type/Type exo-type))
- (return nil)
- (&type/check exo-type endo-type))]
- (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name))
- endo-type))))
- state))
-
- [["lux;Cons" [?genv ["lux;Nil" _]]]]
- (do ;; (prn 'analyse-symbol/_2 ?module ?name local-ident (->> ?genv (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) &/|keys &/->seq))
- (if-let [global (->> ?genv (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|get local-ident))]
- (do ;; (prn 'analyse-symbol/_2.1 ?module ?name local-ident (aget global 0))
- (matchv ::M/objects [global]
- [[["lux;Global" [?module* ?name*]] _]]
- ((|do [[[r-module r-name] $def] (&&module/find-def ?module* ?name*)
- ;; :let [_ (prn 'analyse-symbol/_2.1.1 r-module r-name)]
- endo-type (matchv ::M/objects [$def]
- [["lux;ValueD" [?type _]]]
- (return ?type)
-
- [["lux;MacroD" _]]
- (return &type/Macro)
-
- [["lux;TypeD" _]]
- (return &type/Type))
- _ (if (and (clojure.lang.Util/identical &type/Type endo-type)
- (clojure.lang.Util/identical &type/Type exo-type))
- (return nil)
- (&type/check exo-type endo-type))]
- (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name))
- endo-type))))
- state)
-
- [_]
- (do ;; (prn 'analyse-symbol/_2.1.2 ?module ?name local-ident)
- (fail* "[Analyser Error] Can't have anything other than a global def in the global environment."))))
- (fail* "_{_ analyse-symbol _}_")))
-
- [["lux;Cons" [top-outer _]]]
- (do ;; (prn 'analyse-symbol/_3 ?module ?name)
- (|let [scopes (&/|tail (&/folds #(&/|cons (&/get$ &/$NAME %2) %1)
- (&/|map #(&/get$ &/$NAME %) outer)
- (&/|reverse inner)))
- [=local inner*] (&/fold2 (fn [register+new-inner frame in-scope]
- (|let [[register new-inner] register+new-inner
- [register* frame*] (&&lambda/close-over (&/|reverse in-scope) ident register frame)]
- (&/T register* (&/|cons frame* new-inner))))
- (&/T (or (->> top-outer (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|get local-ident))
- (->> top-outer (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS) (&/|get local-ident)))
- (&/|list))
- (&/|reverse inner) scopes)]
- ((|do [btype (&&/expr-type =local)
- _ (&type/check exo-type btype)]
- (return (&/|list =local)))
- (&/set$ &/$ENVS (&/|++ inner* outer) state))))
- )))
+ (|do [:let [[?module ?name] ident]]
+ (if (= "" ?module)
+ (analyse-local analyse exo-type ?name)
+ (analyse-global analyse exo-type ?module ?name))
))
(defn ^:private analyse-apply* [analyse exo-type fun-type ?args]
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-09 19:57:38 +0000