diff options
| author | Eduardo Julian | 2016-07-10 23:34:51 -0400 | 
|---|---|---|
| committer | Eduardo Julian | 2016-07-10 23:34:51 -0400 | 
| commit | 7687730b92adf914b3713201b4c49b5b997b31dd (patch) | |
| tree | 1ed605892e8762726e3196d5def473152ddab61b /src | |
| parent | 512598de80963203cf162d2f353d43b47273ffaf (diff) | |
- The compiler no longer complains about not catching RuntimeException and it's derivatives.
- Fixed a bug that cause the exception-handling scope of an outer function or method to be treaded as part of the exception-handling scope of an inner one.
- The return-type of ["jvm" "throw"] is now Bottom.
- Improved error messages coming from lux.base, by adding cursor data.
Diffstat (limited to '')
| -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 | 
