aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/lux/analyser/host.clj72
-rw-r--r--src/lux/analyser/lux.clj7
-rw-r--r--src/lux/base.clj21
-rw-r--r--src/lux/type.clj5
4 files changed, 68 insertions, 37 deletions
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 729ffc4aa..a7b467564 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -23,22 +23,29 @@
(:import (java.lang.reflect Type TypeVariable)))
;; [Utils]
-(defn ^:private ensure-catching [exceptions]
+(defn ^:private ensure-catching [exceptions*]
"(-> (List Text) (Lux Null))"
(|do [class-loader &/loader]
(fn [state]
- (let [exceptions (&/|map #(Class/forName % true class-loader) exceptions)
- catching (->> state (&/get$ &/$host) (&/get$ &/$catching)
- (&/|map #(Class/forName % true class-loader)))]
+ (|let [exceptions (&/|map #(Class/forName % true class-loader) exceptions*)
+ catching (->> state
+ (&/get$ &/$host)
+ (&/get$ &/$catching)
+ (&/|map #(Class/forName % true class-loader)))]
(if-let [missing-ex (&/fold (fn [prev ^Class now]
(or prev
- (if (&/fold (fn [found? ^Class ex-catch]
- (or found?
- (.isAssignableFrom ex-catch now)))
- false
- catching)
- nil
- now)))
+ (cond (.isAssignableFrom java.lang.RuntimeException now)
+ nil
+
+ (&/fold (fn [found? ^Class ex-catch]
+ (or found?
+ (.isAssignableFrom ex-catch now)))
+ false
+ catching)
+ nil
+
+ :else
+ now)))
nil
exceptions)]
((&/fail-with-loc (str "[Analyser Error] Unhandled exception: " missing-ex))
@@ -314,10 +321,11 @@
?ctor-args)
=body (&/with-type-env full-env
(&&env/with-local &&/jvm-this class-type
- (with-catches (&/|map &host-generics/gclass->class-name ?exceptions)
- (&/fold (method-input-folder full-env)
- (&&/analyse-1 analyse output-type ?body)
- (&/|reverse ?inputs)))))]
+ (&/with-no-catches
+ (with-catches (&/|map &host-generics/gclass->class-name ?exceptions)
+ (&/fold (method-input-folder full-env)
+ (&&/analyse-1 analyse output-type ?body)
+ (&/|reverse ?inputs))))))]
(return (&/$ConstructorMethodAnalysis (&/T [=privacy-modifier ?strict ?anns ?gvars ?exceptions ?inputs =ctor-args =body]))))
(&/$VirtualMethodSyntax ?name =privacy-modifier =final? ?strict ?anns ?gvars ?exceptions ?inputs ?output ?body)
@@ -326,10 +334,11 @@
output-type (generic-class->type full-env ?output)
=body (&/with-type-env full-env
(&&env/with-local &&/jvm-this class-type
- (with-catches (&/|map &host-generics/gclass->class-name ?exceptions)
- (&/fold (method-input-folder full-env)
- (&&/analyse-1 analyse output-type ?body)
- (&/|reverse ?inputs)))))]
+ (&/with-no-catches
+ (with-catches (&/|map &host-generics/gclass->class-name ?exceptions)
+ (&/fold (method-input-folder full-env)
+ (&&/analyse-1 analyse output-type ?body)
+ (&/|reverse ?inputs))))))]
(return (&/$VirtualMethodAnalysis (&/T [?name =privacy-modifier =final? ?strict ?anns ?gvars ?exceptions ?inputs ?output =body]))))
(&/$OverridenMethodSyntax ?class-decl ?name ?strict ?anns ?gvars ?exceptions ?inputs ?output ?body)
@@ -339,10 +348,11 @@
output-type (generic-class->type full-env ?output)
=body (&/with-type-env full-env
(&&env/with-local &&/jvm-this class-type
- (with-catches (&/|map &host-generics/gclass->class-name ?exceptions)
- (&/fold (method-input-folder full-env)
- (&&/analyse-1 analyse output-type ?body)
- (&/|reverse ?inputs)))))]
+ (&/with-no-catches
+ (with-catches (&/|map &host-generics/gclass->class-name ?exceptions)
+ (&/fold (method-input-folder full-env)
+ (&&/analyse-1 analyse output-type ?body)
+ (&/|reverse ?inputs))))))]
(return (&/$OverridenMethodAnalysis (&/T [?class-decl ?name ?strict ?anns ?gvars ?exceptions ?inputs ?output =body]))))
(&/$StaticMethodSyntax ?name =privacy-modifier ?strict ?anns ?gvars ?exceptions ?inputs ?output ?body)
@@ -350,10 +360,11 @@
:let [full-env method-env]
output-type (generic-class->type full-env ?output)
=body (&/with-type-env full-env
- (with-catches (&/|map &host-generics/gclass->class-name ?exceptions)
- (&/fold (method-input-folder full-env)
- (&&/analyse-1 analyse output-type ?body)
- (&/|reverse ?inputs))))]
+ (&/with-no-catches
+ (with-catches (&/|map &host-generics/gclass->class-name ?exceptions)
+ (&/fold (method-input-folder full-env)
+ (&&/analyse-1 analyse output-type ?body)
+ (&/|reverse ?inputs)))))]
(return (&/$StaticMethodAnalysis (&/T [?name =privacy-modifier ?strict ?anns ?gvars ?exceptions ?inputs ?output =body]))))
(&/$AbstractMethodSyntax ?name =privacy-modifier ?anns ?gvars ?exceptions ?inputs ?output)
@@ -675,9 +686,12 @@
(defn ^:private analyse-jvm-throw [analyse exo-type ?values]
(|do [:let [(&/$Cons ?ex (&/$Nil)) ?values]
- =ex (&&/analyse-1 analyse (&/$HostT "java.lang.Throwable" &/$Nil) ?ex)
+ =ex (&&/analyse-1+ analyse ?ex)
+ _ (&type/check (&/$HostT "java.lang.Throwable" &/$Nil) (&&/expr-type* =ex))
+ [throw-class throw-params] (ensure-object (&&/expr-type* =ex))
+ _ (ensure-catching (&/|list throw-class))
_cursor &/cursor
- _ (&type/check exo-type &/$VoidT)]
+ _ (&type/check exo-type &type/Bottom)]
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T ["jvm" "throw"]) (&/|list =ex) (&/|list)))))))
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 0ce5c060a..6f8ccae57 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -399,8 +399,8 @@
((&/fail-with-loc error) state)))
module-name &/get-module-name
;; :let [[r-prefix r-name] real-name
- ;; _ (when (or (= "defstruct" r-name)
- ;; (= "struct" r-name)
+ ;; _ (when (or (and (= "lux/data/maybe" r-prefix)
+ ;; (= "?" r-name))
;; ;; (= "@type" r-name)
;; )
;; (->> (&/|map &/show-ast macro-expansion)
@@ -559,7 +559,8 @@
))
(defn analyse-lambda [analyse exo-type ?self ?arg ?body]
- (|do [output (analyse-lambda** analyse exo-type ?self ?arg ?body)]
+ (|do [output (&/with-no-catches
+ (analyse-lambda** analyse exo-type ?self ?arg ?body))]
(return (&/|list output))))
(defn analyse-def [analyse optimize eval! compile-def ?name ?value ?meta]
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 48eb00469..2dc684144 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -756,6 +756,17 @@
(|table)
])))
+(defn with-no-catches [body]
+ "(All [a] (-> (Lux a) (Lux a)))"
+ (fn [state]
+ (let [old-catching (->> state (get$ $host) (get$ $catching))]
+ (|case (body (update$ $host #(set$ $catching $Nil %) state))
+ ($Right state* output)
+ (return* (update$ $host #(set$ $catching old-catching %) state*) output)
+
+ ($Left msg)
+ (fail* msg)))))
+
(defn default-compiler-info [mode]
(T [;; compiler-name
compiler-name
@@ -828,14 +839,14 @@
(return* state datum)
_
- (fail* "Writer hasn't been set.")))))
+ ((fail-with-loc "Writer hasn't been set.") state)))))
(def get-top-local-env
(fn [state]
(try (let [top (|head (get$ $envs state))]
(return* state top))
(catch Throwable _
- (fail* "No local environment.")))))
+ ((fail-with-loc "No local environment.") state)))))
(def gen-id
(fn [state]
@@ -864,7 +875,7 @@
(fn [state]
(|case (|reverse (get$ $envs state))
($Nil)
- (fail* "[Analyser Error] Can't get the module-name without a module.")
+ ((fail-with-loc "[Analyser Error] Can't get the module-name without a module.") state)
($Cons ?global _)
(return* state (get$ $name ?global)))))
@@ -874,7 +885,7 @@
(fn [state]
(if-let [module (|get name (get$ $modules state))]
(return* state module)
- (fail* (str "Unknown module: " name)))))
+ ((fail-with-loc (str "Unknown module: " name)) state))))
(def get-current-module
"(Lux (Module Compiler))"
@@ -983,7 +994,7 @@
(return* state unit-tag)
($Some _)
- (fail* "[Error] All statements must be top-level forms."))))
+ ((fail-with-loc "[Error] All statements must be top-level forms.") state))))
(def cursor
;; (Lux Cursor)
diff --git a/src/lux/type.clj b/src/lux/type.clj
index 295d7bfdb..4661b3166 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -34,6 +34,11 @@
(def Text (&/$NamedT (&/T ["lux" "Text"]) (&/$HostT "java.lang.String" &/$Nil)))
(def Ident (&/$NamedT (&/T ["lux" "Ident"]) (&/$ProdT Text Text)))
+(def Bottom
+ (&/$NamedT (&/T ["lux" "Bottom"])
+ (&/$UnivQ empty-env
+ (&/$BoundT 1))))
+
(def IO
(&/$NamedT (&/T ["lux/codata" "IO"])
(&/$UnivQ empty-env