From c9560da3760d0d277a715a966496451020f3f2f8 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 12 Sep 2015 22:36:34 -0400 Subject: - Added exhaustiveness testing for exception-handling code. - Added some optimizations for using List & Maybe within the compiler. --- source/lux.lux | 7 ++- source/lux/host/io.lux | 10 ++-- src/lux/analyser.clj | 4 +- src/lux/analyser/case.clj | 8 +-- src/lux/analyser/host.clj | 135 +++++++++++++++++++++++++++++++------------- src/lux/analyser/lux.clj | 26 ++++----- src/lux/analyser/module.clj | 2 +- src/lux/analyser/record.clj | 2 +- src/lux/base.clj | 53 ++++++++++------- src/lux/compiler/cache.clj | 6 +- src/lux/compiler/type.clj | 2 +- src/lux/host.clj | 4 +- src/lux/parser.clj | 8 +-- src/lux/type.clj | 45 ++++++++------- 14 files changed, 196 insertions(+), 116 deletions(-) diff --git a/source/lux.lux b/source/lux.lux index 39cbb7765..ee01c8bdf 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -275,7 +275,8 @@ ## (deftype Host ## (& #writer (^ org.objectweb.asm.ClassWriter) ## #loader (^ java.net.URLClassLoader) -## #classes (^ clojure.lang.Atom))) +## #classes (^ clojure.lang.Atom) +## #catching (List Text))) (_lux_def Host (#NamedT ["lux" "Host"] (#TupleT (#Cons [## "lux;writer" @@ -284,7 +285,9 @@ (#DataT "java.lang.ClassLoader" #Nil) (#Cons [## "lux;classes" (#DataT "clojure.lang.Atom" #Nil) - #Nil])])])))) + (#Cons [## "lux;catching" + (#AppT List Text) + #Nil])])])])))) (_lux_declare-tags [#writer #loader #classes] Host) ## (deftype (DefData' m) diff --git a/source/lux/host/io.lux b/source/lux/host/io.lux index 4542b0519..99e15722d 100644 --- a/source/lux/host/io.lux +++ b/source/lux/host/io.lux @@ -30,11 +30,11 @@ (let [in (_jvm_getstatic "java.lang.System" "in") reader (_jvm_new "java.io.InputStreamReader" ["java.io.InputStream"] [in]) buff-reader (_jvm_new "java.io.BufferedReader" ["java.io.Reader"] [reader])] - (@io (let [output (: (Either Text ) (try ))] - (exec (_jvm_invokeinterface "java.io.Closeable" "close" [] buff-reader []) - (case output - (#;Left _) #;None - (#;Right input) (#;Some input)))))))] + (@io (let [output (: (Either Text ) (try )) + _close (: (Either Text (,)) (try (_jvm_invokeinterface "java.io.Closeable" "close" [] buff-reader [])))] + (case [output _close] + (\or [(#;Left _) _] [_ (#;Left _)]) #;None + [(#;Right input) (#;Right _)] (#;Some input))))))] [read-char Char (_jvm_i2c (_jvm_invokevirtual "java.io.BufferedReader" "read" [] buff-reader []))] [read-line Text (_jvm_invokevirtual "java.io.BufferedReader" "readLine" [] buff-reader [])] diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index e1c167ce6..03709b226 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -364,7 +364,7 @@ (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_try")] (&/$Cons ?body ?handlers))) - (|do [catches+finally (&/fold% parse-handler (&/T (&/|list) (&/V &/$None nil)) ?handlers)] + (|do [catches+finally (&/fold% parse-handler (&/T &/Nil$ &/None$) ?handlers)] (&&host/analyse-jvm-try analyse exo-type ?body catches+finally)) (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_throw")] @@ -602,7 +602,7 @@ (&&lux/analyse-record analyse exo-type ?elems) (&/$TagS ?ident) - (analyse-variant+ analyse exo-type ?ident (&/|list)) + (analyse-variant+ analyse exo-type ?ident &/Nil$) (&/$SymbolS _ "_jvm_null") (&&host/analyse-jvm-null analyse exo-type) diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj index a0f07cdce..109ba7c41 100644 --- a/src/lux/analyser/case.clj +++ b/src/lux/analyser/case.clj @@ -39,7 +39,7 @@ ;; [Utils] (def ^:private unit - (&/T (&/T "" -1 -1) (&/V &/$TupleS (&/|list)))) + (&/T (&/T "" -1 -1) (&/V &/$TupleS &/Nil$))) (defn ^:private resolve-type [type] (|case type @@ -118,7 +118,7 @@ (defn adjust-type [type] "(-> Type (Lux Type))" - (adjust-type* (&/|list) type)) + (adjust-type* &/Nil$ type)) (defn ^:private analyse-pattern [value-type pattern kont] (|let [[meta pattern*] pattern] @@ -170,7 +170,7 @@ (|do [[=test [=tests =kont]] (analyse-pattern v m kont*)] (return (&/T (&/Cons$ =test =tests) =kont))))) (|do [=kont kont] - (return (&/T (&/|list) =kont))) + (return (&/T &/Nil$ =kont))) (&/|reverse (&/zip2 ?member-types ?members)))] (return (&/T (&/V $TupleTestAC =tests) =kont))))) @@ -392,7 +392,7 @@ (|do [patterns (&/fold% (fn [patterns branch] (|let [[pattern body] branch] (analyse-branch analyse exo-type value-type pattern body patterns))) - (&/|list) + &/Nil$ branches) struct (&/fold% merge-total (&/V $DefaultTotal false) patterns) ? (check-totality value-type struct)] diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index 0eb89b251..db04a60c0 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -23,6 +23,48 @@ _ (fail "[Analyser/Host Error] Can't extract text."))) +(defn ^:private ensure-catching [exceptions] + "(-> (List Text) (Lux (,)))" + (|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)))] + (if-let [missing-ex (&/fold (fn [prev now] + (or prev + (if (&/fold (fn [found? ex-catch] + (or found? + (.isAssignableFrom ex-catch now))) + false + catching) + nil + now))) + nil + exceptions)] + (assert false (str "[Analyser Error] Unhandled exception: " missing-ex)) + ;; (&/fail* (str "[Analyser Error] Unhandled exception: " missing-ex)) + (&/return* state nil))) + ))) + +(defn ^:private with-catches [catches body] + "(All [a] (-> (List Text) (Lux a) (Lux a)))" + (fn [state] + (let [;; _ (prn 'with-catches/_0 (&/->seq catches)) + old-catches (->> state (&/get$ &/$host) (&/get$ &/$catching)) + ;; _ (prn 'with-catches/_1 (&/->seq (->> state (&/get$ &/$host) (&/get$ &/$catching)))) + state* (->> state (&/update$ &/$host #(&/update$ &/$catching (partial &/|++ catches) %))) + ;; _ (prn 'with-catches/_2 (&/->seq (->> state* (&/get$ &/$host) (&/get$ &/$catching)))) + ] + (|case (&/run-state body state*) + (&/$Left msg) + (&/V &/$Left msg) + + (&/$Right state** output) + (do ;; (prn 'with-catches/_3 (&/->seq (->> state** (&/get$ &/$host) (&/get$ &/$catching)))) + (&/V &/$Right (&/T (->> state** (&/update$ &/$host #(&/set$ &/$catching old-catches %))) + output))))) + )) + (defn ^:private analyse-1+ [analyse token] (&type/with-var (fn [$var] @@ -74,8 +116,8 @@ ;; [Resources] (do-template [ ] - (let [input-type (&type/Data$ (&/|list)) - output-type (&type/Data$ (&/|list))] + (let [input-type (&type/Data$ &/Nil$) + output-type (&type/Data$ &/Nil$)] (defn [analyse exo-type x y] (|do [=x (&&/analyse-1 analyse input-type x) =y (&&/analyse-1 analyse input-type y) @@ -157,12 +199,15 @@ (defn analyse-jvm-invokestatic [analyse exo-type class method classes args] (|do [class-loader &/loader - =return (&host/lookup-static-method class-loader class method classes) + =return+exceptions (&host/lookup-static-method class-loader class method classes) + :let [[=return exceptions] =return+exceptions] + ;; :let [_ (prn 'analyse-jvm-invokestatic (&/adt->text =return+exceptions))] + _ (ensure-catching exceptions) ;; :let [_ (matchv ::M/objects [=return] - ;; [[&/$DataT _return-class (&/|list)]] + ;; [[&/$DataT _return-class &/Nil$]] ;; (prn 'analyse-jvm-invokestatic class method _return-class))] =args (&/map2% (fn [_class _arg] - (&&/analyse-1 analyse (&type/Data$ _class (&/|list)) _arg)) + (&&/analyse-1 analyse (&type/Data$ _class &/Nil$) _arg)) classes args) :let [output-type =return] @@ -179,11 +224,16 @@ (do-template [ ] (defn [analyse exo-type class method classes object args] (|do [class-loader &/loader - =return (&host/lookup-virtual-method class-loader class method classes) - =object (&&/analyse-1 analyse (&type/Data$ class (&/|list)) object) - =args (&/map2% (fn [c o] (&&/analyse-1 analyse (&type/Data$ c (&/|list)) o)) + =return+exceptions (&host/lookup-virtual-method class-loader class method classes) + ;; :let [_ (prn ' [class method] (&/adt->text =return+exceptions))] + :let [[=return exceptions] =return+exceptions] + _ (ensure-catching exceptions) + =object (&&/analyse-1 analyse (&type/Data$ class &/Nil$) object) + =args (&/map2% (fn [c o] (&&/analyse-1 analyse (&type/Data$ c &/Nil$) o)) classes args) :let [output-type =return] + ;; :let [_ (prn ' [class method] '=return (&type/show-type =return))] + ;; :let [_ (prn ' '(as-otype+ output-type) (&type/show-type (as-otype+ output-type)))] _ (&type/check exo-type (as-otype+ output-type))] (return (&/|list (&/T (&/V (&/T class method classes =object =args)) output-type))))) @@ -193,12 +243,15 @@ (defn analyse-jvm-invokespecial [analyse exo-type class method classes object args] (|do [class-loader &/loader - =return (if (= "" method) - (return &type/Unit) - (&host/lookup-virtual-method class-loader class method classes)) - =object (&&/analyse-1 analyse (&type/Data$ class (&/|list)) object) + =return+exceptions (if (= "" method) + (return (&/T &type/Unit &/Nil$)) + (&host/lookup-virtual-method class-loader class method classes)) + :let [[=return exceptions] =return+exceptions] + ;; :let [_ (prn 'analyse-jvm-invokespecial (&/adt->text =return+exceptions))] + _ (ensure-catching exceptions) + =object (&&/analyse-1 analyse (&type/Data$ class &/Nil$) object) =args (&/map2% (fn [c o] - (&&/analyse-1 analyse (&type/Data$ c (&/|list)) o)) + (&&/analyse-1 analyse (&type/Data$ c &/Nil$) o)) classes args) :let [output-type =return] _ (&type/check exo-type (as-otype+ output-type))] @@ -212,21 +265,21 @@ (return (&/|list (&/T (&/V &&/$jvm-null? =object) output-type))))) (defn analyse-jvm-null [analyse exo-type] - (|do [:let [output-type (&type/Data$ "null" (&/|list))] + (|do [:let [output-type (&type/Data$ "null" &/Nil$)] _ (&type/check exo-type output-type)] (return (&/|list (&/T (&/V &&/$jvm-null nil) output-type))))) (defn analyse-jvm-new [analyse exo-type class classes args] (|do [class-loader &/loader =return (&host/lookup-constructor class-loader class classes) - =args (&/map2% (fn [c o] (&&/analyse-1 analyse (&type/Data$ c (&/|list)) o)) + =args (&/map2% (fn [c o] (&&/analyse-1 analyse (&type/Data$ c &/Nil$) o)) classes args) - :let [output-type (&type/Data$ class (&/|list))] + :let [output-type (&type/Data$ class &/Nil$)] _ (&type/check exo-type output-type)] (return (&/|list (&/T (&/V &&/$jvm-new (&/T class classes =args)) output-type))))) (do-template [ ] - (let [elem-type (&type/Data$ (&/|list)) + (let [elem-type (&type/Data$ &/Nil$) array-type (&type/Data$ "Array" (&/|list elem-type))] (defn [analyse length] (return (&/|list (&/T (&/V length) array-type)))) @@ -252,24 +305,24 @@ ) (defn analyse-jvm-anewarray [analyse class length] - (let [elem-type (&type/Data$ class (&/|list)) + (let [elem-type (&type/Data$ class &/Nil$) array-type (&type/Data$ "Array" (&/|list elem-type))] (return (&/|list (&/T (&/V &&/$jvm-anewarray (&/T class length)) array-type))))) (defn analyse-jvm-aaload [analyse class array idx] - (let [elem-type (&type/Data$ class (&/|list)) + (let [elem-type (&type/Data$ class &/Nil$) array-type (&type/Data$ "Array" (&/|list elem-type))] (|do [=array (&&/analyse-1 analyse array-type array)] (return (&/|list (&/T (&/V &&/$jvm-aaload (&/T class =array idx)) elem-type)))))) (defn analyse-jvm-aastore [analyse class array idx elem] - (let [elem-type (&type/Data$ class (&/|list)) + (let [elem-type (&type/Data$ class &/Nil$) array-type (&type/Data$ "Array" (&/|list elem-type))] (|do [=array (&&/analyse-1 analyse array-type array) =elem (&&/analyse-1 analyse elem-type elem)] (return (&/|list (&/T (&/V &&/$jvm-aastore (&/T class =array idx =elem)) array-type)))))) -(let [length-type (&type/Data$ "java.lang.Long" (&/|list))] +(let [length-type (&type/Data$ "java.lang.Long" &/Nil$)] (defn analyse-jvm-arraylength [analyse array] (&type/with-var (fn [$var] @@ -353,11 +406,11 @@ =method-body (&/with-scope (str ?name "_" ?idx) (&/fold (fn [body* input*] (|let [[iname itype] input*] - (&&env/with-local iname (&type/Data$ (as-otype itype) (&/|list)) + (&&env/with-local iname (&type/Data$ (as-otype itype) &/Nil$) body*))) (if (= "void" ?method-output) (analyse-1+ analyse ?method-body) - (&&/analyse-1 analyse (&type/Data$ (as-otype ?method-output) (&/|list)) ?method-body)) + (&&/analyse-1 analyse (&type/Data$ (as-otype ?method-output) &/Nil$) ?method-body)) (&/|reverse (if (:static? =method-modifiers) =method-inputs (&/Cons$ (&/T "this" ?super-class) @@ -396,7 +449,7 @@ _ (compile-token (&/V &&/$jvm-class (&/T ?name ?super-class ?interfaces =fields =methods))) ;; :let [_ (prn 'analyse-jvm-class ?name ?super-class)] ] - (return (&/|list)))) + (return &/Nil$))) (defn analyse-jvm-interface [analyse compile-token name supers methods] (|do [=methods (&/map% (fn [method] @@ -417,19 +470,21 @@ (fail (str "[Analyser Error] Invalid method signature: " (&/show-ast method))))) methods) _ (compile-token (&/V &&/$jvm-interface (&/T name supers =methods)))] - (return (&/|list)))) + (return &/Nil$))) (defn analyse-jvm-try [analyse exo-type ?body ?catches+?finally] (|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 ?ex-arg (&type/Data$ ?ex-class (&/|list)) + (|do [=catch-body (&&env/with-local ?ex-arg (&type/Data$ ?ex-class &/Nil$) (&&/analyse-1 analyse exo-type ?catch-body)) idx &&env/next-local-idx] (return (&/T ?ex-class idx =catch-body)))) ?catches) + :let [catched-exceptions (&/|map #(aget % 0) =catches)] + =body (with-catches catched-exceptions + (&&/analyse-1 analyse exo-type ?body)) =finally (|case ?finally - (&/$None) (return (&/V &/$None nil)) + (&/$None) (return &/None$) (&/$Some ?finally*) (|do [=finally (analyse-1+ analyse ?finally*)] (return (&/V &/$Some =finally))))] (return (&/|list (&/T (&/V &&/$jvm-try (&/T =body =catches =finally)) exo-type))))) @@ -437,7 +492,7 @@ (defn analyse-jvm-throw [analyse exo-type ?ex] (|do [=ex (analyse-1+ analyse ?ex) :let [[_obj _type] =ex] - _ (&type/check (&type/Data$ "java.lang.Throwable" (&/|list)) _type)] + _ (&type/check (&type/Data$ "java.lang.Throwable" &/Nil$) _type)] (return (&/|list (&/T (&/V &&/$jvm-throw =ex) &type/$Void))))) (do-template [ ] @@ -453,9 +508,9 @@ ) (do-template [ ] - (let [output-type (&type/Data$ (&/|list))] + (let [output-type (&type/Data$ &/Nil$)] (defn [analyse exo-type ?value] - (|do [=value (&&/analyse-1 analyse (&type/Data$ (&/|list)) ?value) + (|do [=value (&&/analyse-1 analyse (&type/Data$ &/Nil$) ?value) _ (&type/check exo-type output-type)] (return (&/|list (&/T (&/V =value) output-type)))))) @@ -480,9 +535,9 @@ ) (do-template [ ] - (let [output-type (&type/Data$ (&/|list))] + (let [output-type (&type/Data$ &/Nil$)] (defn [analyse exo-type ?value] - (|do [=value (&&/analyse-1 analyse (&type/Data$ (&/|list)) ?value) + (|do [=value (&&/analyse-1 analyse (&type/Data$ &/Nil$) ?value) _ (&type/check exo-type output-type)] (return (&/|list (&/T (&/V =value) output-type)))))) @@ -501,9 +556,11 @@ analyse-jvm-lushr &&/$jvm-lushr "java.lang.Long" "java.lang.Integer" ) -(defn analyse-jvm-program [analyse compile-token ?args ?body] - (|do [=body (&/with-scope "" - (&&env/with-local ?args (&/V &/$AppT (&/T &type/List &type/Text)) - (&&/analyse-1 analyse (&/V &/$AppT (&/T &type/IO &type/Unit)) ?body))) - _ (compile-token (&/V &&/$jvm-program =body))] - (return (&/|list)))) +(let [input-type (&type/App$ &type/List &type/Text) + output-type (&type/App$ &type/IO &type/Unit)] + (defn analyse-jvm-program [analyse compile-token ?args ?body] + (|do [=body (&/with-scope "" + (&&env/with-local ?args input-type + (&&/analyse-1 analyse output-type ?body))) + _ (compile-token (&/V &&/$jvm-program =body))] + (return &/Nil$)))) diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index 6205adccb..4a03c4848 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -59,7 +59,7 @@ (|do [:let [=var* (next-bound-type tuple-type)] _ (&type/set-var iid =var*) tuple-type* (&type/clean $var tuple-type)] - (return (&type/Univ$ (&/|list) tuple-type*))) + (return (&type/Univ$ &/Nil$ tuple-type*))) _ (&type/clean $var tuple-type))] @@ -110,7 +110,7 @@ (|do [output (with-attempt (|case ?values (&/$Nil) - (analyse-tuple analyse (&/V &/$Right exo-type) (&/|list)) + (analyse-tuple analyse (&/V &/$Right exo-type) &/Nil$) (&/$Cons ?value (&/$Nil)) (analyse exo-type ?value) @@ -155,7 +155,7 @@ (|do [:let [=var* (next-bound-type variant-type)] _ (&type/set-var iid =var*) variant-type* (&type/clean $var variant-type)] - (return (&type/Univ$ (&/|list) variant-type*))) + (return (&type/Univ$ &/Nil$ variant-type*))) _ (&type/clean $var variant-type)) @@ -291,7 +291,7 @@ (&/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)) + &/Nil$) (&/|reverse inner) scopes)] ((|do [_ (&type/check exo-type (&&/expr-type* =local))] (return (&/|list =local))) @@ -313,7 +313,7 @@ _ (&type/check exo-type fun-type) ;; :let [_ (prn 'analyse-apply*/_1 'SUCCESS (str "(_ " (->> ?args (&/|map &/show-ast) (&/|interpose " ") (&/fold str "")) ")"))] ] - (return (&/T fun-type (&/|list)))) + (return (&/T fun-type &/Nil$))) (&/$Cons ?arg ?args*) (|do [?fun-type* (&type/actual-type fun-type)] @@ -416,7 +416,7 @@ _ (&type/set-var iid =input*) =output* (&type/clean $input =output) =output** (&type/clean $output =output*)] - (return (&type/Univ$ (&/|list) (embed-inferred-input =input* =output**)))) + (return (&type/Univ$ &/Nil$ (embed-inferred-input =input* =output**)))) _ (|do [=output* (&type/clean $input =output) @@ -490,7 +490,7 @@ ;; :let [_ (println 'analyse-def/ALIAS (str module-name ";" ?name) '=> (str ?r-module ";" ?r-name)) ;; _ (println)] ] - (return (&/|list))) + (return &/Nil$)) _ (do ;; (println 'DEF (str module-name ";" ?name)) @@ -505,7 +505,7 @@ [def-analysis def-type] =value _ (println 'DEF (str module-name ";" ?name) ;; (&type/show-type def-type) )]] - (return (&/|list))))) + (return &/Nil$)))) )))) (defn analyse-declare-macro [analyse compile-token ?name] @@ -515,7 +515,7 @@ _ (compile-token (&/V &&/$declare-macro (&/T module-name ?name))) ;; :let [_ (prn 'analyse-declare-macro ?name "2")] ] - (return (&/|list)))) + (return &/Nil$))) (defn analyse-declare-tags [tags type-name] (|do [module-name &/get-module-name @@ -524,7 +524,7 @@ ;; :let [_ (prn 'analyse-declare-tags (&/ident->text (&/T module-name type-name)) (&/->seq tags) (&/adt->text def-data))] def-type (&&module/ensure-type-def def-data) _ (&&module/declare-tags module-name tags def-type)] - (return (&/|list)))) + (return &/Nil$))) (defn analyse-import [analyse compile-module compile-token path] ;; (prn 'analyse-import path) @@ -537,17 +537,17 @@ ;; :let [_ (prn 'analyse-import module-name path already-compiled?)] _ (&&module/add-import path) _ (&/when% (not already-compiled?) (compile-module path))] - (return (&/|list)))))) + (return &/Nil$))))) (defn analyse-export [analyse compile-token name] (|do [module-name &/get-module-name _ (&&module/export module-name name)] - (return (&/|list)))) + (return &/Nil$))) (defn analyse-alias [analyse compile-token ex-alias ex-module] (|do [module-name &/get-module-name _ (&&module/alias module-name ex-alias ex-module)] - (return (&/|list)))) + (return &/Nil$))) (defn analyse-check [analyse eval! exo-type ?type ?value] (|do [=type (&&/analyse-1 analyse &type/Type ?type) diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj index 97365ba08..deb6be69e 100644 --- a/src/lux/analyser/module.clj +++ b/src/lux/analyser/module.clj @@ -27,7 +27,7 @@ ;; "lux;defs" (&/|table) ;; "lux;imports" - (&/|list) + &/Nil$ ;; "lux;tags" (&/|table) ;; "lux;types" diff --git a/src/lux/analyser/record.clj b/src/lux/analyser/record.clj index 0f860888b..ddc9616fd 100644 --- a/src/lux/analyser/record.clj +++ b/src/lux/analyser/record.clj @@ -16,7 +16,7 @@ "(-> (List (, Syntax Syntax)) (Lux (List Syntax)))" (|do [[tag-group tag-type] (|case pairs (&/$Nil) - (return (&/T (&/|list) &type/Unit)) + (return (&/T &/Nil$ &type/Unit)) (&/$Cons [[_ (&/$TagS tag1)] _] _) (|do [[module name] (&&/resolved-ident tag1) diff --git a/src/lux/base.clj b/src/lux/base.clj index c0f28f519..aefa0cf4c 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -84,7 +84,8 @@ (deftags ["writer" "loader" - "classes"]) + "classes" + "catching"]) ;; Compiler (deftags @@ -179,13 +180,13 @@ (defmacro |list [& elems] (reduce (fn [tail head] `(V $Cons (T ~head ~tail))) - `(V $Nil nil) + `Nil$ (reverse elems))) (defmacro |table [& elems] (reduce (fn [table [k v]] `(|put ~k ~v ~table)) - `(|list) + `Nil$ (reverse (partition 2 elems)))) (defn |get [slot table] @@ -201,7 +202,7 @@ (defn |put [slot value table] (|case table ($Nil) - (V $Cons (T (T slot value) (V $Nil nil))) + (V $Cons (T (T slot value) Nil$)) ($Cons [k v] table*) (if (.equals ^Object k slot) @@ -344,7 +345,7 @@ (if (p x) (|let [[pre post] (|split-with p xs*)] (T (Cons$ x pre) post)) - (T (V $Nil nil) xs)))) + (T Nil$ xs)))) (defn |contains? [k table] (|case table @@ -355,6 +356,14 @@ (or (.equals ^Object k k*) (|contains? k table*)))) +(defn |member? [x xs] + (|case xs + ($Nil) + false + + ($Cons x* xs*) + (or (= x x*) (|member? x xs*)))) + (defn fold [f init xs] (|case xs ($Nil) @@ -386,7 +395,7 @@ (let [|range* (fn |range* [from to] (if (< from to) (V $Cons (T from (|range* (inc from) to))) - (V $Nil nil)))] + Nil$))] (defn |range [n] (|range* 0 n))) @@ -404,12 +413,12 @@ (V $Cons (T (T x y) (zip2 xs* ys*))) [_ _] - (V $Nil nil))) + Nil$)) (defn |keys [plist] (|case plist ($Nil) - (|list) + Nil$ ($Cons [k v] plist*) (Cons$ k (|keys plist*)))) @@ -417,7 +426,7 @@ (defn |vals [plist] (|case plist ($Nil) - (|list) + Nil$ ($Cons [k v] plist*) (Cons$ v (|vals plist*)))) @@ -448,7 +457,7 @@ flat-map% |++) (defn list-join [xss] - (fold |++ (V $Nil nil) xss)) + (fold |++ Nil$ xss)) (defn |as-pairs [xs] (|case xs @@ -456,12 +465,12 @@ (V $Cons (T (T x y) (|as-pairs xs*))) _ - (V $Nil nil))) + Nil$)) (defn |reverse [xs] (fold (fn [tail head] (Cons$ head tail)) - (|list) + Nil$ xs)) (defn assert! [test message] @@ -497,7 +506,7 @@ (try-all% (|list (|do [head monad tail (repeat% monad)] (return (Cons$ head tail))) - (return (|list))))) + (return Nil$)))) (defn exhaust% [step] (fn [state] @@ -580,6 +589,7 @@ (try (.invoke define-class this (to-array [class-name bytecode (int 0) (int (alength bytecode))])) (catch java.lang.reflect.InvocationTargetException e (prn 'InvocationTargetException (.getCause e)) + (prn 'memory-class-loader/findClass class-name (get @store class-name)) (throw e))) (do (prn 'memory-class-loader/store class-name (keys @store)) (throw (IllegalStateException. (str "[Class Loader] Unknown class: " class-name))))))))) @@ -591,7 +601,10 @@ ;; "lux;loader" (memory-class-loader store) ;; "lux;classes" - store))) + store + ;; "lux;catching" + Nil$ + ))) (defn init-state [_] (T ;; "lux;source" @@ -601,11 +614,11 @@ ;; "lux;modules" (|table) ;; "lux;envs" - (|list) + Nil$ ;; "lux;types" +init-bindings+ ;; "lux;expected" - (V $VariantT (|list)) + (V $VariantT Nil$) ;; "lux;seed" 0 ;; "lux;eval?" @@ -671,13 +684,13 @@ (defn ->list [seq] (if (empty? seq) - (|list) + Nil$ (Cons$ (first seq) (->list (rest seq))))) (defn |repeat [n x] (if (> n 0) (Cons$ x (|repeat (dec n) x)) - (|list))) + Nil$)) (def get-module-name (fn [state] @@ -830,7 +843,7 @@ (return (Cons$ z zs))) [($Nil) ($Nil)] - (return (V $Nil nil)) + (return Nil$) [_ _] (fail "Lists don't match in size."))) @@ -841,7 +854,7 @@ (Cons$ (f x y) (map2 f xs* ys*)) [_ _] - (V $Nil nil))) + Nil$)) (defn fold2 [f init xs ys] (|case [xs ys] diff --git a/src/lux/compiler/cache.clj b/src/lux/compiler/cache.clj index e47da2678..3532cf843 100644 --- a/src/lux/compiler/cache.clj +++ b/src/lux/compiler/cache.clj @@ -92,7 +92,7 @@ (|do [content (&&io/read-file (str &&/input-dir "/" _import ".lux"))] (load _import (hash content) compile-module))) (if (= [""] imports) - (&/|list) + &/Nil$ (&/->list imports)))] (if (->> loads &/->seq (every? true?)) (do (doseq [^File file (seq (.listFiles (File. module-path))) @@ -109,7 +109,7 @@ ;; (string/split (get-field &/tags-field module-meta) (re-pattern (java.util.regex.Pattern/quote &&/tag-group-separator)))) tag-groups (let [all-tags (get-field &/tags-field module-meta)] (if (= "" all-tags) - (&/|list) + &/Nil$ (-> all-tags (string/split (re-pattern (java.util.regex.Pattern/quote &&/tag-group-separator))) (->> (map (fn [_group] @@ -149,7 +149,7 @@ (return nil))) )) (if (= [""] defs) - (&/|list) + &/Nil$ (&/->list defs))) _ (&/map% (fn [group] (|let [[_type _tags] group] diff --git a/src/lux/compiler/type.clj b/src/lux/compiler/type.clj index 6c128df80..00e66410f 100644 --- a/src/lux/compiler/type.clj +++ b/src/lux/compiler/type.clj @@ -33,7 +33,7 @@ (def ^:private $Nil "Analysis" - (variant$ &/$Nil (tuple$ (&/|list)))) + (variant$ &/$Nil (tuple$ &/Nil$))) (defn ^:private Cons$ [head tail] "(-> Analysis Analysis Analysis)" diff --git a/src/lux/host.clj b/src/lux/host.clj index 8d6135d64..9137f3874 100644 --- a/src/lux/host.clj +++ b/src/lux/host.clj @@ -32,7 +32,7 @@ &type/Unit (&type/Data$ (str (reduce str "" (repeat (int (/ (count arr-level) 2)) "[")) base) - (&/|list)) + &/Nil$) ))) (defn ^:private method->type [^Method method] @@ -115,7 +115,7 @@ args (&/|map #(.getName ^Class %) param-types)))))] =method))] - (return (method->type method)) + (return (&/T (method->type method) (->> method .getExceptionTypes &/->list (&/|map #(.getName %))))) (fail (str "[Host Error] Method does not exist: " target "." method-name)))) lookup-static-method true diff --git a/src/lux/parser.clj b/src/lux/parser.clj index dbd6ca2c5..516b6a947 100644 --- a/src/lux/parser.clj +++ b/src/lux/parser.clj @@ -17,7 +17,7 @@ token &lexer/lex] (|case token [meta [ _]] - (return (&/V (&/fold &/|++ (&/|list) elems))) + (return (&/V (&/fold &/|++ &/Nil$ elems))) _ (fail (str "[Parser Error] Unbalanced " "."))))) @@ -29,7 +29,7 @@ (defn ^:private parse-record [parse] (|do [elems* (&/repeat% parse) token &lexer/lex - :let [elems (&/fold &/|++ (&/|list) elems*)]] + :let [elems (&/fold &/|++ &/Nil$ elems*)]] (|case token [meta (&lexer/$Close_Brace _)] (if (even? (&/|length elems)) @@ -45,10 +45,10 @@ :let [[meta token*] token]] (|case token* (&lexer/$White_Space _) - (return (&/|list)) + (return &/Nil$) (&lexer/$Comment _) - (return (&/|list)) + (return &/Nil$) (&lexer/$Bool ?value) (return (&/|list (&/T meta (&/V &/$BoolS (Boolean/parseBoolean ?value))))) diff --git a/src/lux/type.clj b/src/lux/type.clj index 0da579cf4..8a1e11bed 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -23,7 +23,7 @@ _ false)) -(def ^:private empty-env (&/V &/$Nil nil)) +(def ^:private empty-env &/Nil$) (defn Data$ [name params] (&/V &/$DataT (&/T name params))) (defn Bound$ [idx] @@ -46,13 +46,13 @@ (&/V &/$NamedT (&/T name type))) -(def Bool (Named$ (&/T "lux" "Bool") (Data$ "java.lang.Boolean" (&/|list)))) -(def Int (Named$ (&/T "lux" "Int") (Data$ "java.lang.Long" (&/|list)))) -(def Real (Named$ (&/T "lux" "Real") (Data$ "java.lang.Double" (&/|list)))) -(def Char (Named$ (&/T "lux" "Char") (Data$ "java.lang.Character" (&/|list)))) -(def Text (Named$ (&/T "lux" "Text") (Data$ "java.lang.String" (&/|list)))) -(def Unit (Named$ (&/T "lux" "Unit") (Tuple$ (&/|list)))) -(def $Void (Named$ (&/T "lux" "Void") (Variant$ (&/|list)))) +(def Bool (Named$ (&/T "lux" "Bool") (Data$ "java.lang.Boolean" &/Nil$))) +(def Int (Named$ (&/T "lux" "Int") (Data$ "java.lang.Long" &/Nil$))) +(def Real (Named$ (&/T "lux" "Real") (Data$ "java.lang.Double" &/Nil$))) +(def Char (Named$ (&/T "lux" "Char") (Data$ "java.lang.Character" &/Nil$))) +(def Text (Named$ (&/T "lux" "Text") (Data$ "java.lang.String" &/Nil$))) +(def Unit (Named$ (&/T "lux" "Unit") (Tuple$ &/Nil$))) +(def $Void (Named$ (&/T "lux" "Void") (Variant$ &/Nil$))) (def Ident (Named$ (&/T "lux" "Ident") (Tuple$ (&/|list Text Text)))) (def IO @@ -221,11 +221,14 @@ (Tuple$ (&/|list ;; "lux;writer" - (Data$ "org.objectweb.asm.ClassWriter" (&/|list)) + (Data$ "org.objectweb.asm.ClassWriter" &/Nil$) ;; "lux;loader" - (Data$ "java.lang.ClassLoader" (&/|list)) + (Data$ "java.lang.ClassLoader" &/Nil$) ;; "lux;classes" - (Data$ "clojure.lang.Atom" (&/|list)))))) + (Data$ "clojure.lang.Atom" &/Nil$) + ;; "lux;catching" + (App$ List Text) + )))) (def DefData* (Univ$ empty-env @@ -367,7 +370,7 @@ (let [id (->> state (&/get$ &/$type-vars) (&/get$ &/$counter))] (return* (&/update$ &/$type-vars #(->> % (&/update$ &/$counter inc) - (&/update$ &/$mappings (fn [ms] (&/|put id (&/V &/$None nil) ms)))) + (&/update$ &/$mappings (fn [ms] (&/|put id &/None$ ms)))) state) id)))) @@ -396,7 +399,7 @@ (|case ?type* (&/$VarT ?id*) (if (.equals ^Object id ?id*) - (return (&/T ?id (&/V &/$None nil))) + (return (&/T ?id &/None$)) (return binding)) _ @@ -465,7 +468,7 @@ (&/T ??out (&/Cons$ ?in ?args))) _ - (&/T type (&/|list)))) + (&/T type &/Nil$))) (defn ^:private unravel-app [fun-type] (|case fun-type @@ -474,7 +477,7 @@ (&/T ?fun-type (&/|++ ?args (&/|list ?right)))) _ - (&/T fun-type (&/|list)))) + (&/T fun-type &/Nil$))) (defn show-type [^objects type] (|case type @@ -581,7 +584,7 @@ (|let [[e a] k] (|case fixpoints (&/$Nil) - (&/V &/$None nil) + &/None$ (&/$Cons [[e* a*] v*] fixpoints*) (if (and (type= e e*) @@ -674,7 +677,7 @@ (def ^:private primitive-types #{"boolean" "byte" "short" "int" "long" "float" "double" "char"}) -(def ^:private init-fixpoints (&/|list)) +(def ^:private init-fixpoints &/Nil$) (defn ^:private check* [class-loader fixpoints invariant?? expected actual] (if (clojure.lang.Util/identical expected actual) @@ -689,14 +692,14 @@ (return* state* (&/V &/$Some ebound)) (&/$Left _) - (return* state (&/V &/$None nil)))) + (return* state &/None$))) abound (fn [state] (|case ((deref ?aid) state) (&/$Right state* abound) (return* state* (&/V &/$Some abound)) (&/$Left _) - (return* state (&/V &/$None nil))))] + (return* state &/None$)))] (|case [ebound abound] [(&/$None _) (&/$None _)] (|do [_ (set-var ?eid actual)] @@ -873,6 +876,10 @@ (return (&/T fixpoints nil))) (and (not invariant??) + ;; (do (println '[Data Data] [e!name a!name] + ;; [(str "(" (->> e!params (&/|map show-type) (&/|interpose " ") (&/fold str "")) ")") + ;; (str "(" (->> a!params (&/|map show-type) (&/|interpose " ") (&/fold str "")) ")")]) + ;; true) (.isAssignableFrom (Class/forName e!name true class-loader) (Class/forName a!name true class-loader))) (return (&/T fixpoints nil)) -- cgit v1.2.3