diff options
| -rw-r--r-- | src/lux/analyser/host.clj | 72 | ||||
| -rw-r--r-- | src/lux/analyser/lux.clj | 7 | ||||
| -rw-r--r-- | src/lux/base.clj | 21 | ||||
| -rw-r--r-- | src/lux/type.clj | 5 |
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 |