aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorEduardo Julian2015-09-12 22:36:34 -0400
committerEduardo Julian2015-09-12 22:36:34 -0400
commitc9560da3760d0d277a715a966496451020f3f2f8 (patch)
treea0cb370dee25c4e1b919cc8e4ea936823389e59e /src
parent45a102bae3707d1a5220d7e124221ed46882f22d (diff)
- Added exhaustiveness testing for exception-handling code.
- Added some optimizations for using List & Maybe within the compiler.
Diffstat (limited to 'src')
-rw-r--r--src/lux/analyser.clj4
-rw-r--r--src/lux/analyser/case.clj8
-rw-r--r--src/lux/analyser/host.clj135
-rw-r--r--src/lux/analyser/lux.clj26
-rw-r--r--src/lux/analyser/module.clj2
-rw-r--r--src/lux/analyser/record.clj2
-rw-r--r--src/lux/base.clj53
-rw-r--r--src/lux/compiler/cache.clj6
-rw-r--r--src/lux/compiler/type.clj2
-rw-r--r--src/lux/host.clj4
-rw-r--r--src/lux/parser.clj8
-rw-r--r--src/lux/type.clj45
12 files changed, 186 insertions, 109 deletions
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 [<name> <output-tag> <input-class> <output-class>]
- (let [input-type (&type/Data$ <input-class> (&/|list))
- output-type (&type/Data$ <output-class> (&/|list))]
+ (let [input-type (&type/Data$ <input-class> &/Nil$)
+ output-type (&type/Data$ <output-class> &/Nil$)]
(defn <name> [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 [<name> <tag>]
(defn <name> [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 '<name> [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 '<name> [class method] '=return (&type/show-type =return))]
+ ;; :let [_ (prn '<name> '(as-otype+ output-type) (&type/show-type (as-otype+ output-type)))]
_ (&type/check exo-type (as-otype+ output-type))]
(return (&/|list (&/T (&/V <tag> (&/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 (= "<init>" 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 (= "<init>" 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 [<class> <new-name> <new-tag> <load-name> <load-tag> <store-name> <store-tag>]
- (let [elem-type (&type/Data$ <class> (&/|list))
+ (let [elem-type (&type/Data$ <class> &/Nil$)
array-type (&type/Data$ "Array" (&/|list elem-type))]
(defn <new-name> [analyse length]
(return (&/|list (&/T (&/V <new-tag> 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 [<name> <tag>]
@@ -453,9 +508,9 @@
)
(do-template [<name> <tag> <from-class> <to-class>]
- (let [output-type (&type/Data$ <to-class> (&/|list))]
+ (let [output-type (&type/Data$ <to-class> &/Nil$)]
(defn <name> [analyse exo-type ?value]
- (|do [=value (&&/analyse-1 analyse (&type/Data$ <from-class> (&/|list)) ?value)
+ (|do [=value (&&/analyse-1 analyse (&type/Data$ <from-class> &/Nil$) ?value)
_ (&type/check exo-type output-type)]
(return (&/|list (&/T (&/V <tag> =value) output-type))))))
@@ -480,9 +535,9 @@
)
(do-template [<name> <tag> <from-class> <to-class>]
- (let [output-type (&type/Data$ <to-class> (&/|list))]
+ (let [output-type (&type/Data$ <to-class> &/Nil$)]
(defn <name> [analyse exo-type ?value]
- (|do [=value (&&/analyse-1 analyse (&type/Data$ <from-class> (&/|list)) ?value)
+ (|do [=value (&&/analyse-1 analyse (&type/Data$ <from-class> &/Nil$) ?value)
_ (&type/check exo-type output-type)]
(return (&/|list (&/T (&/V <tag> =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 [<close-token> _]]
- (return (&/V <tag> (&/fold &/|++ (&/|list) elems)))
+ (return (&/V <tag> (&/fold &/|++ &/Nil$ elems)))
_
(fail (str "[Parser Error] Unbalanced " <description> ".")))))
@@ -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))