aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--source/lux.lux4
-rw-r--r--source/lux/control/comonad.lux4
-rw-r--r--source/lux/control/monad.lux2
-rw-r--r--source/lux/data/list.lux2
-rw-r--r--source/lux/data/number.lux4
-rw-r--r--source/lux/data/text.lux4
-rw-r--r--source/lux/host/jvm.lux108
-rw-r--r--source/lux/math.lux5
-rw-r--r--source/lux/meta/lux.lux16
-rw-r--r--source/lux/meta/syntax.lux4
-rw-r--r--source/program.lux10
-rw-r--r--src/lux.clj12
-rw-r--r--src/lux/analyser.clj169
-rw-r--r--src/lux/analyser/host.clj222
-rw-r--r--src/lux/analyser/lux.clj4
-rw-r--r--src/lux/base.clj5
-rw-r--r--src/lux/compiler.clj27
-rw-r--r--src/lux/compiler/base.clj32
-rw-r--r--src/lux/compiler/cache.clj7
-rw-r--r--src/lux/compiler/host.clj206
-rw-r--r--src/lux/compiler/package.clj61
-rw-r--r--src/lux/host.clj16
-rw-r--r--src/lux/type.clj150
23 files changed, 611 insertions, 463 deletions
diff --git a/source/lux.lux b/source/lux.lux
index c51929635..8861bc241 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -2524,8 +2524,8 @@
(let [pattern (record$ (map (: (-> (, Text Type) (, Syntax Syntax))
(lambda [slot]
(let [[sname stype] slot
- full-name (split-slot sname)]
- [(tag$ full-name) (symbol$ full-name)])))
+ [module name] (split-slot sname)]
+ [(tag$ [module name]) (symbol$ ["" name])])))
slots))]
(return (list (` (_lux_case (~ struct) (~ pattern) (~ body))))))
diff --git a/source/lux/control/comonad.lux b/source/lux/control/comonad.lux
index 1830ff44f..ce9a7e7de 100644
--- a/source/lux/control/comonad.lux
+++ b/source/lux/control/comonad.lux
@@ -27,8 +27,8 @@
(All [w a b]
(-> (CoMonad w) (-> (w a) b) (w a) (w b)))
(using w
- (using ;;_functor
- (F;map f (;;split ma)))))
+ (using _functor
+ (map f (split ma)))))
## Syntax
(defmacro #export (be tokens state)
diff --git a/source/lux/control/monad.lux b/source/lux/control/monad.lux
index b5552f987..a03c1499a 100644
--- a/source/lux/control/monad.lux
+++ b/source/lux/control/monad.lux
@@ -82,7 +82,7 @@
(All [m a b]
(-> (Monad m) (-> a (m b)) (m a) (m b)))
(using m
- (;;join (:: ;;_functor (F;map f ma)))))
+ (join (:: _functor (F;map f ma)))))
(def #export (map% m f xs)
(All [m a b]
diff --git a/source/lux/data/list.lux b/source/lux/data/list.lux
index 450dee275..8fd5c2951 100644
--- a/source/lux/data/list.lux
+++ b/source/lux/data/list.lux
@@ -247,4 +247,4 @@
(def (M;join mma)
(using List/Monoid
- (foldL m;++ m;unit mma))))
+ (foldL ++ unit mma))))
diff --git a/source/lux/data/number.lux b/source/lux/data/number.lux
index 453c30a13..8771ef06e 100644
--- a/source/lux/data/number.lux
+++ b/source/lux/data/number.lux
@@ -68,11 +68,11 @@
(def O;< <lt>)
(def (O;<= x y)
(or (<lt> x y)
- (using <eq> (E;= x y))))
+ (:: <eq> (E;= x y))))
(def O;> <gt>)
(def (O;>= x y)
(or (<gt> x y)
- (using <eq> (E;= x y)))))]
+ (:: <eq> (E;= x y)))))]
[ Int/Ord Int Int/Eq i< i>]
[Real/Ord Real Real/Eq r< r>])
diff --git a/source/lux/data/text.lux b/source/lux/data/text.lux
index f7f1a86c0..6ad9cfd63 100644
--- a/source/lux/data/text.lux
+++ b/source/lux/data/text.lux
@@ -46,8 +46,8 @@
(if (and (i< from to)
(i>= from 0)
(i<= to (size x)))
- (_jvm_invokevirtual "java.lang.String" "substring" ["int" "int"]
- x [(_jvm_l2i from) (_jvm_l2i to)])
+ (#;Some (_jvm_invokevirtual "java.lang.String" "substring" ["int" "int"]
+ x [(_jvm_l2i from) (_jvm_l2i to)]))
#;None))
(def #export (sub from x)
diff --git a/source/lux/host/jvm.lux b/source/lux/host/jvm.lux
index a3a74d608..7af043969 100644
--- a/source/lux/host/jvm.lux
+++ b/source/lux/host/jvm.lux
@@ -22,8 +22,7 @@
(Parser Syntax)
(form^ (do Parser/Monad
[_ (symbol?^ ["" "finally"])
- expr id^
- _ end^]
+ expr id^]
(M;wrap expr))))
(def catch^
@@ -32,8 +31,7 @@
[_ (symbol?^ ["" "catch"])
ex-class local-symbol^
ex symbol^
- expr id^
- _ end^]
+ expr id^]
(M;wrap [ex-class ex expr]))))
(def method-decl^
@@ -42,8 +40,7 @@
[modifiers (*^ local-tag^)
name local-symbol^
inputs (tuple^ (*^ local-symbol^))
- output local-symbol^
- _ end^]
+ output local-symbol^]
(M;wrap [modifiers name inputs output]))))
(def field-decl^
@@ -51,16 +48,14 @@
(form^ (do Parser/Monad
[modifiers (*^ local-tag^)
name local-symbol^
- class local-symbol^
- _ end^]
+ class local-symbol^]
(M;wrap [modifiers name class]))))
(def arg-decl^
(Parser (, Text Text))
(form^ (do Parser/Monad
[arg-name local-symbol^
- arg-class local-symbol^
- _ end^]
+ arg-class local-symbol^]
(M;wrap [arg-name arg-class]))))
(def method-def^
@@ -70,8 +65,7 @@
name local-symbol^
inputs (tuple^ (*^ arg-decl^))
output local-symbol^
- body id^
- _ end^]
+ body id^]
(M;wrap [modifiers name inputs output body]))))
(def method-call^
@@ -80,7 +74,6 @@
[method local-symbol^
arity-classes (tuple^ (*^ local-symbol^))
arity-args (tuple^ (*^ id^))
- _ end^
_ (: (Parser (,))
(if (i= (size arity-classes)
(size arity-args))
@@ -108,47 +101,41 @@
(list (` (_jvm_finally (~ finally)))))))))))))
(defsyntax #export (definterface [name local-symbol^] [supers (tuple^ (*^ local-symbol^))] [members (*^ method-decl^)])
- (do Lux/Monad
- [current-module get-module-name
- #let [full-name (:: text;Text/Monoid (m;++ (text;replace "/" "." current-module)
- name))]]
- (let [members' (map (: (-> (, (List Text) Text (List Text) Text) Syntax)
- (lambda [member]
- (let [[modifiers name inputs output] member]
- (` ((~ (symbol$ ["" name])) [(~@ (map text$ inputs))] (~ (text$ output)) [(~@ (map text$ modifiers))])))))
- members)]
- (emit (list (` (_jvm_interface (~ (text$ full-name)) [(~@ (map text$ supers))]
- (~@ members'))))))))
+ (let [members' (map (: (-> (, (List Text) Text (List Text) Text) Syntax)
+ (lambda [member]
+ (let [[modifiers name inputs output] member]
+ (` ((~ (text$ name)) [(~@ (map text$ inputs))] (~ (text$ output)) [(~@ (map text$ modifiers))])))))
+ members)]
+ (emit (list (` (_jvm_interface (~ (text$ name)) [(~@ (map text$ supers))]
+ (~@ members')))))))
(defsyntax #export (defclass [name local-symbol^] [super local-symbol^] [interfaces (tuple^ (*^ local-symbol^))]
[fields (*^ field-decl^)]
[methods (*^ method-def^)])
(do Lux/Monad
[current-module get-module-name
- #let [full-name (:: text;Text/Monoid (m;++ (text;replace "/" "." current-module)
- name))
- fields' (map (: (-> (, (List Text) Text Text) Syntax)
+ #let [fields' (map (: (-> (, (List Text) Text Text) Syntax)
(lambda [field]
(let [[modifiers name class] field]
- (` ((~ (symbol$ ["" name]))
+ (` ((~ (text$ name))
(~ (text$ class))
[(~@ (map text$ modifiers))])))))
fields)
methods' (map (: (-> (, (List Text) Text (List (, Text Text)) Text Syntax) Syntax)
(lambda [methods]
(let [[modifiers name inputs output body] methods]
- (` ((~ (symbol$ ["" name]))
+ (` ((~ (text$ name))
[(~@ (map (: (-> (, Text Text) Syntax)
(lambda [in]
(let [[left right] in]
- (form$ (list (text$ left)
+ (form$ (list (symbol$ ["" left])
(text$ right))))))
inputs))]
(~ (text$ output))
[(~@ (map text$ modifiers))]
(~ body))))))
methods)]]
- (emit (list (` (_jvm_class (~ (text$ full-name)) (~ (text$ super))
+ (emit (list (` (_jvm_class (~ (text$ name)) (~ (text$ super))
[(~@ (map text$ interfaces))]
[(~@ fields')]
[(~@ methods')]))))))
@@ -166,9 +153,9 @@
[g!lock (gensym "")
g!body (gensym "")]
(emit (list (` (;let [(~ g!lock) (~ lock)
- _ (_jvm_monitor-enter (~ g!lock))
+ _ (_jvm_monitorenter (~ g!lock))
(~ g!body) (~ body)
- _ (_jvm_monitor-exit (~ g!lock))]
+ _ (_jvm_monitorexit (~ g!lock))]
(~ g!body)))))
))
@@ -216,24 +203,27 @@
(.= (~ (text$ field)) (~ value) (~ g!obj)))))))))
(defsyntax #export (.! [call method-call^] obj)
- (case obj
- (#;Meta [_ (#;SymbolS obj-name)])
- (do Lux/Monad
- [obj-type (find-var-type obj-name)]
- (case obj-type
- (#;DataT class)
- (let [[m-name ?m-classes m-args] call]
+ (let [[m-name ?m-classes m-args] call]
+ (case obj
+ (#;Meta [_ (#;SymbolS obj-name)])
+ (do Lux/Monad
+ [obj-type (find-var-type obj-name)]
+ (case obj-type
+ (#;DataT class)
(emit (list (` (_jvm_invokevirtual (~ (text$ class)) (~ (text$ m-name)) [(~@ (map text$ ?m-classes))]
- (~ obj) [(~@ m-args)])))))
+ (~ obj) [(~@ m-args)]))))
- _
- (fail "Can only call method on object.")))
+ _
+ (fail "Can only call method on object.")))
- _
- (do Lux/Monad
- [g!obj (gensym "")]
- (emit (list (` (;let [(~ g!obj) (~ obj)]
- (.! (~@ *tokens*)))))))))
+ _
+ (do Lux/Monad
+ [g!obj (gensym "")]
+ (emit (list (` (;let [(~ g!obj) (~ obj)]
+ (.! ((~ (symbol$ ["" m-name]))
+ [(~@ (map (lambda [c] (symbol$ ["" c])) ?m-classes))]
+ [(~@ m-args)])
+ (~ g!obj))))))))))
(defsyntax #export (..? [field local-symbol^] [class local-symbol^])
(emit (list (` (_jvm_getstatic (~ (text$ class)) (~ (text$ field)))))))
@@ -246,25 +236,3 @@
(emit (list (` (_jvm_invokestatic (~ (text$ class)) (~ (text$ m-name))
[(~@ (map text$ m-classes))]
[(~@ m-args)]))))))
-
-## (definterface Function []
-## (#public #abstract apply [java.lang.Object] java.lang.Object))
-
-## (_jvm_interface "Function" []
-## (apply ["java.lang.Object"] "java.lang.Object" ["public" "abstract"]))
-
-## (defclass MyFunction [Function]
-## (#public #static foo java.lang.Object)
-## (#public <init> [] void
-## (_jvm_invokespecial java.lang.Object <init> [] this []))
-## (#public apply [(arg java.lang.Object)] java.lang.Object
-## "YOLO"))
-
-## (_jvm_class "lux.MyFunction" "java.lang.Object" ["lux.Function"]
-## [(foo "java.lang.Object" ["public" "static"])]
-## (<init> [] "void"
-## ["public"]
-## (_jvm_invokespecial java.lang.Object <init> [] this []))
-## (apply [(arg "java.lang.Object")] "java.lang.Object"
-## ["public"]
-## "YOLO"))
diff --git a/source/lux/math.lux b/source/lux/math.lux
index 8a9432261..a495d130c 100644
--- a/source/lux/math.lux
+++ b/source/lux/math.lux
@@ -38,7 +38,6 @@
[ceil "ceil"]
[floor "floor"]
- [round "round"]
[exp "exp"]
[log "log"]
@@ -50,6 +49,10 @@
[->radians "toRadians"]
)
+(def #export (round n)
+ (-> Real Int)
+ (_jvm_invokestatic "java.lang.Math" "round" ["double"] [n]))
+
(do-template [<name> <method>]
[(def #export (<name> x y)
(-> Real Real Real)
diff --git a/source/lux/meta/lux.lux b/source/lux/meta/lux.lux
index 99ca200cf..19b7dd9df 100644
--- a/source/lux/meta/lux.lux
+++ b/source/lux/meta/lux.lux
@@ -187,14 +187,14 @@
(case (get module (get@ #;modules state))
(#;Some =module)
(using List/Monad
- (#;Right [state (M;join (:: M;_functor (F;map (: (-> (, Text (, Bool (DefData' Macro)))
- (List Text))
- (lambda [gdef]
- (let [[name [export? _]] gdef]
- (if export?
- (list name)
- (list)))))
- (get@ #;defs =module))))]))
+ (#;Right [state (join (:: _functor (F;map (: (-> (, Text (, Bool (DefData' Macro)))
+ (List Text))
+ (lambda [gdef]
+ (let [[name [export? _]] gdef]
+ (if export?
+ (list name)
+ (list)))))
+ (get@ #;defs =module))))]))
#;None
(#;Left ($ text:++ "Unknown module: " module))))
diff --git a/source/lux/meta/syntax.lux b/source/lux/meta/syntax.lux
index fcee80b8f..63ab81475 100644
--- a/source/lux/meta/syntax.lux
+++ b/source/lux/meta/syntax.lux
@@ -235,7 +235,7 @@
_
(l;fail "Syntax pattern expects 2-tuples or symbols."))))
args)
- #let [g!tokens (m;symbol$ ["" "*tokens*"])]
+ g!tokens (gensym "tokens")
g!_ (gensym "_")
#let [names (:: List/Functor (F;map first names+parsers))
error-msg (text$ (text:++ "Wrong syntax for " name))
@@ -249,7 +249,7 @@
(~ g!_)
(l;fail (~ error-msg)))))))
body
- (reverse names+parsers))
+ (: (List (, Syntax Syntax)) (list& [(symbol$ ["" ""]) (` end^)] (reverse names+parsers))))
macro-def (: Syntax
(` (m;defmacro ((~ (symbol$ ["" name])) (~ g!tokens))
(~ body'))))]]
diff --git a/source/program.lux b/source/program.lux
index 37391eda9..086506725 100644
--- a/source/program.lux
+++ b/source/program.lux
@@ -41,8 +41,8 @@
(program args
(case args
- #;Nil
- (println "Hello, world!")
-
- (#;Cons [name _])
- (println ($ text:++ "Hello, " name "!"))))
+ (\ (list name))
+ (println ($ text:++ "Hello, " name "!"))
+
+ _
+ (println "Hello, world!")))
diff --git a/src/lux.clj b/src/lux.clj
index 9c913c9ac..7e3627cd7 100644
--- a/src/lux.clj
+++ b/src/lux.clj
@@ -10,13 +10,15 @@
(:gen-class)
(:require [lux.base :as &]
[lux.compiler :as &compiler]
- [lux.type :as &type]
:reload-all))
-(defn -main [& _]
- (time (&compiler/compile-all (&/|list "lux" "program")))
- (System/exit 0))
+(defn -main [& [program-module & _]]
+ (if program-module
+ (time (&compiler/compile-program program-module))
+ (println "Please provide a module name to compile."))
+ (System/exit 0)
+ )
(comment
- ;; cd output && jar cvf program.jar * && java -cp "program.jar" program && cd ..
+ (-main "program")
)
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 1606a95c2..de7fc8497 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -10,7 +10,7 @@
(:require (clojure [template :refer [do-template]])
[clojure.core.match :as M :refer [matchv]]
clojure.core.match.array
- (lux [base :as & :refer [|let |do return fail return* fail* |list]]
+ (lux [base :as & :refer [|let |do return fail return* fail*]]
[reader :as &reader]
[parser :as &parser]
[type :as &type]
@@ -23,16 +23,16 @@
(defn ^:private parse-handler [[catch+ finally+] token]
(matchv ::M/objects [token]
[["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_catch"]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?ex-class]]]]
+ ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?ex-class]]]
["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?ex-arg]]]]
["lux;Cons" [?catch-body
["lux;Nil" _]]]]]]]]]]]]]
- (&/T (&/|++ catch+ (|list (&/T ?ex-class ?ex-arg ?catch-body))) finally+)
+ (&/T (&/|++ catch+ (&/|list (&/T ?ex-class ?ex-arg ?catch-body))) finally+)
[["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_finally"]]]]
["lux;Cons" [?finally-body
["lux;Nil" _]]]]]]]]]
- (&/T catch+ ?finally-body)))
+ (&/T catch+ (&/V "lux;Some" ?finally-body))))
(defn ^:private aba7 [analyse eval! compile-module exo-type token]
(matchv ::M/objects [token]
@@ -62,7 +62,8 @@
["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?super-class]]]
["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?interfaces]]]
["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?fields]]]
- ?methods]]]]]]]]]]]]
+ ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?methods]]]
+ ["lux;Nil" _]]]]]]]]]]]]]]]
(&&host/analyse-jvm-class analyse ?name ?super-class ?interfaces ?fields ?methods)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_interface"]]]]
@@ -85,74 +86,74 @@
(matchv ::M/objects [token]
;; Primitive conversions
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_d2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]
- (&&host/analyse-jvm-d2f analyse ?value)
+ (&&host/analyse-jvm-d2f analyse exo-type ?value)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_d2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]
- (&&host/analyse-jvm-d2i analyse ?value)
+ (&&host/analyse-jvm-d2i analyse exo-type ?value)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_d2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]
- (&&host/analyse-jvm-d2l analyse ?value)
+ (&&host/analyse-jvm-d2l analyse exo-type ?value)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_f2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]
- (&&host/analyse-jvm-f2d analyse ?value)
+ (&&host/analyse-jvm-f2d analyse exo-type ?value)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_f2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]
- (&&host/analyse-jvm-f2i analyse ?value)
+ (&&host/analyse-jvm-f2i analyse exo-type ?value)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_f2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]
- (&&host/analyse-jvm-f2l analyse ?value)
+ (&&host/analyse-jvm-f2l analyse exo-type ?value)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2b"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]
- (&&host/analyse-jvm-i2b analyse ?value)
+ (&&host/analyse-jvm-i2b analyse exo-type ?value)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2c"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]
- (&&host/analyse-jvm-i2c analyse ?value)
+ (&&host/analyse-jvm-i2c analyse exo-type ?value)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]
- (&&host/analyse-jvm-i2d analyse ?value)
+ (&&host/analyse-jvm-i2d analyse exo-type ?value)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]
- (&&host/analyse-jvm-i2f analyse ?value)
+ (&&host/analyse-jvm-i2f analyse exo-type ?value)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]
- (&&host/analyse-jvm-i2l analyse ?value)
+ (&&host/analyse-jvm-i2l analyse exo-type ?value)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2s"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]
- (&&host/analyse-jvm-i2s analyse ?value)
+ (&&host/analyse-jvm-i2s analyse exo-type ?value)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_l2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]
- (&&host/analyse-jvm-l2d analyse ?value)
+ (&&host/analyse-jvm-l2d analyse exo-type ?value)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_l2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]
- (&&host/analyse-jvm-l2f analyse ?value)
+ (&&host/analyse-jvm-l2f analyse exo-type ?value)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_l2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]
- (&&host/analyse-jvm-l2i analyse ?value)
+ (&&host/analyse-jvm-l2i analyse exo-type ?value)
;; Bitwise operators
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_iand"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-iand analyse ?x ?y)
+ (&&host/analyse-jvm-iand analyse exo-type ?x ?y)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ior"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-ior analyse ?x ?y)
+ (&&host/analyse-jvm-ior analyse exo-type ?x ?y)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_land"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-land analyse ?x ?y)
+ (&&host/analyse-jvm-land analyse exo-type ?x ?y)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lor"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-lor analyse ?x ?y)
+ (&&host/analyse-jvm-lor analyse exo-type ?x ?y)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lxor"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-lxor analyse ?x ?y)
+ (&&host/analyse-jvm-lxor analyse exo-type ?x ?y)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lshl"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-lshl analyse ?x ?y)
+ (&&host/analyse-jvm-lshl analyse exo-type ?x ?y)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lshr"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-lshr analyse ?x ?y)
+ (&&host/analyse-jvm-lshr analyse exo-type ?x ?y)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lushr"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-lushr analyse ?x ?y)
+ (&&host/analyse-jvm-lushr analyse exo-type ?x ?y)
[_]
(aba7 analyse eval! compile-module exo-type token)))
@@ -163,40 +164,40 @@
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_null?"]]]]
["lux;Cons" [?object
["lux;Nil" _]]]]]]]
- (&&host/analyse-jvm-null? analyse ?object)
+ (&&host/analyse-jvm-null? analyse exo-type ?object)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_instanceof"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]]
["lux;Cons" [?object
["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-instanceof analyse ?class ?object)
+ (&&host/analyse-jvm-instanceof analyse exo-type ?class ?object)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_new"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]]
["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?classes]]]
["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]]
["lux;Nil" _]]]]]]]]]]]
- (&&host/analyse-jvm-new analyse ?class ?classes ?args)
+ (&&host/analyse-jvm-new analyse exo-type ?class ?classes ?args)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_getstatic"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]]
["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?field]]]
["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-getstatic analyse ?class ?field)
+ (&&host/analyse-jvm-getstatic analyse exo-type ?class ?field)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_getfield"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]]
["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?field]]]
["lux;Cons" [?object
["lux;Nil" _]]]]]]]]]]]
- (&&host/analyse-jvm-getfield analyse ?class ?field ?object)
+ (&&host/analyse-jvm-getfield analyse exo-type ?class ?field ?object)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_putstatic"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]]
["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?field]]]
["lux;Cons" [?value
["lux;Nil" _]]]]]]]]]]]
- (&&host/analyse-jvm-putstatic analyse ?class ?field ?value)
+ (&&host/analyse-jvm-putstatic analyse exo-type ?class ?field ?value)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_putfield"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]]
@@ -204,7 +205,7 @@
["lux;Cons" [?object
["lux;Cons" [?value
["lux;Nil" _]]]]]]]]]]]]]
- (&&host/analyse-jvm-putfield analyse ?class ?field ?object ?value)
+ (&&host/analyse-jvm-putfield analyse exo-type ?class ?field ?object ?value)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_invokestatic"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]]
@@ -212,7 +213,7 @@
["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?classes]]]
["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]]
["lux;Nil" _]]]]]]]]]]]]]
- (&&host/analyse-jvm-invokestatic analyse ?class ?method ?classes ?args)
+ (&&host/analyse-jvm-invokestatic analyse exo-type ?class ?method ?classes ?args)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_invokevirtual"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]]
@@ -221,7 +222,7 @@
["lux;Cons" [?object
["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]]
["lux;Nil" _]]]]]]]]]]]]]]]
- (&&host/analyse-jvm-invokevirtual analyse ?class ?method ?classes ?object ?args)
+ (&&host/analyse-jvm-invokevirtual analyse exo-type ?class ?method ?classes ?object ?args)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_invokeinterface"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]]
@@ -230,7 +231,7 @@
["lux;Cons" [?object
["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]]
["lux;Nil" _]]]]]]]]]]]]]]]
- (&&host/analyse-jvm-invokeinterface analyse ?class ?method ?classes ?object ?args)
+ (&&host/analyse-jvm-invokeinterface analyse exo-type ?class ?method ?classes ?object ?args)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_invokespecial"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]]
@@ -239,29 +240,29 @@
["lux;Cons" [?object
["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]]
["lux;Nil" _]]]]]]]]]]]]]]]
- (&&host/analyse-jvm-invokespecial analyse ?class ?method ?classes ?object ?args)
-
+ (&&host/analyse-jvm-invokespecial analyse exo-type ?class ?method ?classes ?object ?args)
+
;; Exceptions
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_try"]]]]
["lux;Cons" [?body
?handlers]]]]]]
- (&&host/analyse-jvm-try analyse ?body (&/fold parse-handler [(list) nil] ?handlers))
+ (&&host/analyse-jvm-try analyse exo-type ?body (&/fold parse-handler (&/T (&/|list) (&/V "lux;None" nil)) ?handlers))
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_throw"]]]]
["lux;Cons" [?ex
["lux;Nil" _]]]]]]]
- (&&host/analyse-jvm-throw analyse ?ex)
+ (&&host/analyse-jvm-throw analyse exo-type ?ex)
;; Syncronization/monitos
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_monitorenter"]]]]
["lux;Cons" [?monitor
["lux;Nil" _]]]]]]]
- (&&host/analyse-jvm-monitorenter analyse ?monitor)
+ (&&host/analyse-jvm-monitorenter analyse exo-type ?monitor)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_monitorexit"]]]]
["lux;Cons" [?monitor
["lux;Nil" _]]]]]]]
- (&&host/analyse-jvm-monitorexit analyse ?monitor)
+ (&&host/analyse-jvm-monitorexit analyse exo-type ?monitor)
[_]
(aba6 analyse eval! compile-module exo-type token)))
@@ -270,53 +271,53 @@
(matchv ::M/objects [token]
;; Float arithmetic
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-fadd analyse ?x ?y)
+ (&&host/analyse-jvm-fadd analyse exo-type ?x ?y)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-fsub analyse ?x ?y)
+ (&&host/analyse-jvm-fsub analyse exo-type ?x ?y)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-fmul analyse ?x ?y)
+ (&&host/analyse-jvm-fmul analyse exo-type ?x ?y)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fdiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-fdiv analyse ?x ?y)
+ (&&host/analyse-jvm-fdiv analyse exo-type ?x ?y)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_frem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-frem analyse ?x ?y)
+ (&&host/analyse-jvm-frem analyse exo-type ?x ?y)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_feq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-feq analyse ?x ?y)
+ (&&host/analyse-jvm-feq analyse exo-type ?x ?y)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_flt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-flt analyse ?x ?y)
+ (&&host/analyse-jvm-flt analyse exo-type ?x ?y)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-fgt analyse ?x ?y)
+ (&&host/analyse-jvm-fgt analyse exo-type ?x ?y)
;; Double arithmetic
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-dadd analyse ?x ?y)
+ (&&host/analyse-jvm-dadd analyse exo-type ?x ?y)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-dsub analyse ?x ?y)
+ (&&host/analyse-jvm-dsub analyse exo-type ?x ?y)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-dmul analyse ?x ?y)
+ (&&host/analyse-jvm-dmul analyse exo-type ?x ?y)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ddiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-ddiv analyse ?x ?y)
+ (&&host/analyse-jvm-ddiv analyse exo-type ?x ?y)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_drem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-drem analyse ?x ?y)
+ (&&host/analyse-jvm-drem analyse exo-type ?x ?y)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_deq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-deq analyse ?x ?y)
+ (&&host/analyse-jvm-deq analyse exo-type ?x ?y)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dlt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-dlt analyse ?x ?y)
+ (&&host/analyse-jvm-dlt analyse exo-type ?x ?y)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-dgt analyse ?x ?y)
+ (&&host/analyse-jvm-dgt analyse exo-type ?x ?y)
[_]
(aba5 analyse eval! compile-module exo-type token)))
@@ -326,63 +327,63 @@
;; Host special forms
;; Characters
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ceq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-ceq analyse ?x ?y)
+ (&&host/analyse-jvm-ceq analyse exo-type ?x ?y)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_clt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-clt analyse ?x ?y)
+ (&&host/analyse-jvm-clt analyse exo-type ?x ?y)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_cgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-cgt analyse ?x ?y)
+ (&&host/analyse-jvm-cgt analyse exo-type ?x ?y)
;; Integer arithmetic
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_iadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-iadd analyse ?x ?y)
+ (&&host/analyse-jvm-iadd analyse exo-type ?x ?y)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_isub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-isub analyse ?x ?y)
+ (&&host/analyse-jvm-isub analyse exo-type ?x ?y)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_imul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-imul analyse ?x ?y)
+ (&&host/analyse-jvm-imul analyse exo-type ?x ?y)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_idiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-idiv analyse ?x ?y)
+ (&&host/analyse-jvm-idiv analyse exo-type ?x ?y)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_irem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-irem analyse ?x ?y)
+ (&&host/analyse-jvm-irem analyse exo-type ?x ?y)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ieq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-ieq analyse ?x ?y)
+ (&&host/analyse-jvm-ieq analyse exo-type ?x ?y)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ilt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-ilt analyse ?x ?y)
+ (&&host/analyse-jvm-ilt analyse exo-type ?x ?y)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_igt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-igt analyse ?x ?y)
+ (&&host/analyse-jvm-igt analyse exo-type ?x ?y)
;; Long arithmetic
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ladd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-ladd analyse ?x ?y)
+ (&&host/analyse-jvm-ladd analyse exo-type ?x ?y)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-lsub analyse ?x ?y)
+ (&&host/analyse-jvm-lsub analyse exo-type ?x ?y)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-lmul analyse ?x ?y)
+ (&&host/analyse-jvm-lmul analyse exo-type ?x ?y)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ldiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-ldiv analyse ?x ?y)
+ (&&host/analyse-jvm-ldiv analyse exo-type ?x ?y)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lrem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-lrem analyse ?x ?y)
+ (&&host/analyse-jvm-lrem analyse exo-type ?x ?y)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_leq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-leq analyse ?x ?y)
+ (&&host/analyse-jvm-leq analyse exo-type ?x ?y)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_llt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-llt analyse ?x ?y)
+ (&&host/analyse-jvm-llt analyse exo-type ?x ?y)
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
- (&&host/analyse-jvm-lgt analyse ?x ?y)
+ (&&host/analyse-jvm-lgt analyse exo-type ?x ?y)
[_]
(aba4 analyse eval! compile-module exo-type token)))
@@ -445,7 +446,7 @@
[_]
(aba3 analyse eval! compile-module exo-type token)))
-(let [unit (&/V "lux;Meta" (&/T (&/T "" -1 -1) (&/V "lux;TupleS" (|list))))]
+(let [unit (&/V "lux;Meta" (&/T (&/T "" -1 -1) (&/V "lux;TupleS" (&/|list))))]
(defn ^:private aba1 [analyse eval! compile-module exo-type token]
(matchv ::M/objects [token]
;; Standard special forms
@@ -479,7 +480,7 @@
(&&lux/analyse-variant analyse exo-type ?ident unit)
[["lux;SymbolS" [_ "_jvm_null"]]]
- (return (&/|list (&/T (&/V "jvm-null" nil) (&/V "lux;DataT" "null"))))
+ (&&host/analyse-jvm-null analyse exo-type)
[_]
(aba2 analyse eval! compile-module exo-type token)
@@ -505,7 +506,11 @@
[["lux;Left" msg]]
(fail* (add-loc meta msg))
- ))))
+ ))
+
+ ;; [_]
+ ;; (assert false (aget token 0))
+ ))
(defn ^:private just-analyse [analyse-ast eval! compile-module syntax]
(&type/with-var
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 11d43ce9e..5033f4f2c 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -36,13 +36,32 @@
(return (&/T ?item =type)))
)))))
+(defn ^:private ensure-object [token]
+ "(-> Analysis (Lux (,)))"
+ (matchv ::M/objects [token]
+ [[_ ["lux;DataT" _]]]
+ (return nil)
+
+ [_]
+ (fail "[Analyser Error] Expecting object")))
+
+(defn ^:private as-object [type]
+ "(-> Type Type)"
+ (matchv ::M/objects [type]
+ [["lux;DataT" class]]
+ (&/V "lux;DataT" (&type/as-obj class))
+
+ [_]
+ type))
+
;; [Resources]
(do-template [<name> <output-tag> <input-class> <output-class>]
(let [input-type (&/V "lux;DataT" <input-class>)
output-type (&/V "lux;DataT" <output-class>)]
- (defn <name> [analyse ?x ?y]
+ (defn <name> [analyse exo-type ?x ?y]
(|do [=x (&&/analyse-1 analyse input-type ?x)
- =y (&&/analyse-1 analyse input-type ?y)]
+ =y (&&/analyse-1 analyse input-type ?y)
+ _ (&type/check exo-type output-type)]
(return (&/|list (&/T (&/V <output-tag> (&/T =x =y)) output-type))))))
analyse-jvm-iadd "jvm-iadd" "java.lang.Integer" "java.lang.Integer"
@@ -86,94 +105,121 @@
analyse-jvm-dgt "jvm-dgt" "java.lang.Double" "java.lang.Boolean"
)
-(defn analyse-jvm-getstatic [analyse ?class ?field]
- (|do [=type (&host/lookup-static-field ?class ?field)]
- (return (&/|list (&/T (&/V "jvm-getstatic" (&/T ?class ?field)) =type)))))
-
-(defn analyse-jvm-getfield [analyse ?class ?field ?object]
- (|do [=type (&host/lookup-static-field ?class ?field)
- =object (&&/analyse-1 analyse ?object)]
- (return (&/|list (&/T (&/V "jvm-getfield" (&/T ?class ?field =object)) =type)))))
-
-(defn analyse-jvm-putstatic [analyse ?class ?field ?value]
- (|do [=type (&host/lookup-static-field ?class ?field)
- =value (&&/analyse-1 analyse =type ?value)]
- (return (&/|list (&/T (&/V "jvm-putstatic" (&/T ?class ?field =value)) =type)))))
+(defn analyse-jvm-getstatic [analyse exo-type ?class ?field]
+ (|do [class-loader &/loader
+ =type (&host/lookup-static-field class-loader ?class ?field)
+ :let [output-type =type]
+ _ (&type/check exo-type output-type)]
+ (return (&/|list (&/T (&/V "jvm-getstatic" (&/T ?class ?field)) output-type)))))
-(defn analyse-jvm-putfield [analyse ?class ?field ?object ?value]
- (|do [=type (&host/lookup-static-field ?class ?field)
+(defn analyse-jvm-getfield [analyse exo-type ?class ?field ?object]
+ (|do [class-loader &/loader
+ =type (&host/lookup-static-field class-loader ?class ?field)
=object (&&/analyse-1 analyse ?object)
- =value (&&/analyse-1 analyse =type ?value)]
- (return (&/|list (&/T (&/V "jvm-putfield" (&/T ?class ?field =object =value)) =type)))))
-
-(defn analyse-jvm-invokestatic [analyse ?class ?method ?classes ?args]
- (|do [=classes (&/map% extract-text ?classes)
- =return (&host/lookup-static-method ?class ?method =classes)
+ :let [output-type =type]
+ _ (&type/check exo-type output-type)]
+ (return (&/|list (&/T (&/V "jvm-getfield" (&/T ?class ?field =object)) output-type)))))
+
+(defn analyse-jvm-putstatic [analyse exo-type ?class ?field ?value]
+ (|do [class-loader &/loader
+ =type (&host/lookup-static-field class-loader ?class ?field)
+ =value (&&/analyse-1 analyse =type ?value)
+ :let [output-type &type/Unit]
+ _ (&type/check exo-type output-type)]
+ (return (&/|list (&/T (&/V "jvm-putstatic" (&/T ?class ?field =value)) output-type)))))
+
+(defn analyse-jvm-putfield [analyse exo-type ?class ?field ?object ?value]
+ (|do [class-loader &/loader
+ =type (&host/lookup-static-field class-loader ?class ?field)
+ =object (&&/analyse-1 analyse ?object)
+ =value (&&/analyse-1 analyse =type ?value)
+ :let [output-type &type/Unit]
+ _ (&type/check exo-type output-type)]
+ (return (&/|list (&/T (&/V "jvm-putfield" (&/T ?class ?field =object =value)) output-type)))))
+
+(defn analyse-jvm-invokestatic [analyse exo-type ?class ?method ?classes ?args]
+ (|do [class-loader &/loader
+ =classes (&/map% extract-text ?classes)
+ =return (&host/lookup-static-method class-loader ?class ?method =classes)
;; :let [_ (matchv ::M/objects [=return]
;; [["lux;DataT" _return-class]]
;; (prn 'analyse-jvm-invokestatic ?class ?method _return-class))]
=args (&/map2% (fn [_class _arg]
(&&/analyse-1 analyse (&/V "lux;DataT" _class) _arg))
=classes
- ?args)]
- (return (&/|list (&/T (&/V "jvm-invokestatic" (&/T ?class ?method =classes =args)) =return)))))
+ ?args)
+ :let [output-type =return]
+ _ (&type/check exo-type output-type)]
+ (return (&/|list (&/T (&/V "jvm-invokestatic" (&/T ?class ?method =classes =args)) output-type)))))
-(defn analyse-jvm-instanceof [analyse ?class ?object]
+(defn analyse-jvm-instanceof [analyse exo-type ?class ?object]
(|do [=object (analyse-1+ analyse ?object)
- :let [[_obj _type] =object]]
- (matchv ::M/objects [_type]
- [["lux;DataT" _]]
- (return (&/|list (&/T (&/V "jvm-instanceof" (&/T ?class ?object)) (&/V "lux;DataT" "java.lang.Boolean"))))
-
- [_]
- (fail "[Analyser Error] Can only use instanceof with object types."))))
+ _ (ensure-object =object)
+ :let [output-type &type/Bool]
+ _ (&type/check exo-type output-type)]
+ (return (&/|list (&/T (&/V "jvm-instanceof" (&/T ?class =object)) output-type)))))
(do-template [<name> <tag>]
- (defn <name> [analyse ?class ?method ?classes ?object ?args]
- (|do [=classes (&/map% extract-text ?classes)
- =return (&host/lookup-virtual-method ?class ?method =classes)
+ (defn <name> [analyse exo-type ?class ?method ?classes ?object ?args]
+ (|do [class-loader &/loader
+ =classes (&/map% extract-text ?classes)
+ =return (&host/lookup-virtual-method class-loader ?class ?method =classes)
=object (&&/analyse-1 analyse (&/V "lux;DataT" ?class) ?object)
- =args (&/map2% (fn [?c ?o]
- (&&/analyse-1 analyse (&/V "lux;DataT" ?c) ?o))
- =classes ?args)]
- (return (&/|list (&/T (&/V <tag> (&/T ?class ?method =classes =object =args)) =return)))))
+ =args (&/map2% (fn [?c ?o] (&&/analyse-1 analyse (&/V "lux;DataT" ?c) ?o))
+ =classes ?args)
+ :let [output-type =return]
+ _ (&type/check exo-type output-type)]
+ (return (&/|list (&/T (&/V <tag> (&/T ?class ?method =classes =object =args)) output-type)))))
analyse-jvm-invokevirtual "jvm-invokevirtual"
analyse-jvm-invokeinterface "jvm-invokeinterface"
)
-(defn analyse-jvm-invokespecial [analyse ?class ?method ?classes ?object ?args]
- (|do [=classes (&/map% extract-text ?classes)
+(defn analyse-jvm-invokespecial [analyse exo-type ?class ?method ?classes ?object ?args]
+ (|do [class-loader &/loader
+ =classes (&/map% extract-text ?classes)
=return (if (= "<init>" ?method)
- (return &type/$Void)
- (&host/lookup-virtual-method ?class ?method =classes))
+ (return &type/Unit)
+ (&host/lookup-virtual-method class-loader ?class ?method =classes))
=object (&&/analyse-1 analyse (&/V "lux;DataT" ?class) ?object)
=args (&/map2% (fn [?c ?o]
(&&/analyse-1 analyse (&/V "lux;DataT" ?c) ?o))
- =classes ?args)]
- (return (&/|list (&/T (&/V "jvm-invokespecial" (&/T ?class ?method =classes =object =args)) =return)))))
+ =classes ?args)
+ :let [output-type =return]
+ _ (&type/check exo-type output-type)]
+ (return (&/|list (&/T (&/V "jvm-invokespecial" (&/T ?class ?method =classes =object =args)) output-type)))))
+
+(defn analyse-jvm-null? [analyse exo-type ?object]
+ (|do [=object (analyse-1+ analyse ?object)
+ _ (ensure-object =object)
+ :let [output-type &type/Bool]
+ _ (&type/check exo-type output-type)]
+ (return (&/|list (&/T (&/V "jvm-null?" =object) output-type)))))
-(defn analyse-jvm-null? [analyse ?object]
- (|do [=object (&&/analyse-1 analyse ?object)]
- (return (&/|list (&/T (&/V "jvm-null?" =object) (&/V "lux;DataT" "java.lang.Boolean"))))))
+(defn analyse-jvm-null [analyse exo-type]
+ (|do [:let [output-type (&/V "lux;DataT" "null")]
+ _ (&type/check exo-type output-type)]
+ (return (&/|list (&/T (&/V "jvm-null" nil) output-type)))))
-(defn analyse-jvm-new [analyse ?class ?classes ?args]
+(defn analyse-jvm-new [analyse exo-type ?class ?classes ?args]
(|do [=classes (&/map% extract-text ?classes)
- =args (&/flat-map% analyse ?args)]
- (return (&/|list (&/T (&/V "jvm-new" (&/T ?class =classes =args)) (&/V "lux;DataT" ?class))))))
+ =args (&/map% (partial analyse-1+ analyse) ?args)
+ :let [output-type (&/V "lux;DataT" ?class)]
+ _ (&type/check exo-type output-type)]
+ (return (&/|list (&/T (&/V "jvm-new" (&/T ?class =classes =args)) output-type)))))
(defn analyse-jvm-new-array [analyse ?class ?length]
(return (&/|list (&/T (&/V "jvm-new-array" (&/T ?class ?length)) (&/V "array" (&/T (&/V "lux;DataT" ?class)
(&/V "lux;Nil" nil)))))))
(defn analyse-jvm-aastore [analyse ?array ?idx ?elem]
- (|do [=array (&&/analyse-1 analyse &type/$Void ?array)
- =elem (&&/analyse-1 analyse &type/$Void ?elem)
+ (|do [=array (analyse-1+ analyse ?array)
+ =elem (analyse-1+ analyse ?elem)
=array-type (&&/expr-type =array)]
(return (&/|list (&/T (&/V "jvm-aastore" (&/T =array ?idx =elem)) =array-type)))))
(defn analyse-jvm-aaload [analyse ?array ?idx]
- (|do [=array (&&/analyse-1 analyse ?array)
+ (|do [=array (analyse-1+ analyse ?array)
=array-type (&&/expr-type =array)]
(return (&/|list (&/T (&/V "jvm-aaload" (&/T =array ?idx)) =array-type)))))
@@ -259,7 +305,7 @@
(return (&/T (&/ident->text ?input-name) ?input-type))
[_]
- (fail "[Analyser Error] Wrong syntax for method.")))
+ (fail "[Analyser Error] Wrong syntax for method input.")))
?method-inputs)
=method-modifiers (analyse-modifiers ?method-modifiers)
=method-body (&/with-scope (str ?name "_" ?idx)
@@ -302,37 +348,49 @@
:output ?output}))
[_]
- (fail "[Analyser Error] Invalid method signature!")))
+ (fail (str "[Analyser Error] Invalid method signature: " (&/show-ast method)))))
?methods)]
(return (&/|list (&/V "jvm-interface" (&/T ?name =supers =methods))))))
-(defn analyse-jvm-try [analyse ?body [?catches ?finally]]
- (|do [=body (&&/analyse-1 analyse ?body)
+(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]]
- (&&env/with-local ?ex-arg (&/V "lux;DataT" ?ex-class)
- (|do [=catch-body (&&/analyse-1 analyse ?catch-body)]
- (return [?ex-class ?ex-arg =catch-body]))))
+ (|do [=catch-body (&&env/with-local (str ";" ?ex-arg) (&/V "lux;DataT" ?ex-class)
+ (&&/analyse-1 analyse exo-type ?catch-body))
+ idx &&env/next-local-idx]
+ (return (&/T ?ex-class idx =catch-body))))
?catches)
- =finally (&&/analyse-1 analyse ?finally)
- =body-type (&&/expr-type =body)]
- (return (&/|list (&/T (&/V "jvm-try" (&/T =body =catches =finally)) =body-type)))))
-
-(defn analyse-jvm-throw [analyse ?ex]
- (|do [=ex (&&/analyse-1 analyse ?ex)]
+ =finally (matchv ::M/objects [?finally]
+ [["lux;None" _]] (return (&/V "lux;None" nil))
+ [["lux;Some" ?finally*]] (|do [=finally (analyse-1+ analyse ?finally*)]
+ (return (&/V "lux;Some" =finally))))]
+ (return (&/|list (&/T (&/V "jvm-try" (&/T =body =catches =finally)) exo-type)))))
+
+(defn analyse-jvm-throw [analyse exo-type ?ex]
+ (|do [=ex (analyse-1+ analyse ?ex)
+ :let [[_obj _type] =ex]
+ _ (&type/check (&/V "lux;DataT" "java.lang.Throwable") _type)]
(return (&/|list (&/T (&/V "jvm-throw" =ex) &type/$Void)))))
-(defn analyse-jvm-monitorenter [analyse ?monitor]
- (|do [=monitor (&&/analyse-1 analyse ?monitor)]
- (return (&/|list (&/T (&/V "jvm-monitorenter" =monitor) (&/V "lux;TupleT" (&/V "lux;Nil" nil)))))))
-
-(defn analyse-jvm-monitorexit [analyse ?monitor]
- (|do [=monitor (&&/analyse-1 analyse ?monitor)]
- (return (&/|list (&/T (&/V "jvm-monitorexit" =monitor) (&/V "lux;TupleT" (&/V "lux;Nil" nil)))))))
+(do-template [<name> <tag>]
+ (defn <name> [analyse exo-type ?monitor]
+ (|do [=monitor (analyse-1+ analyse ?monitor)
+ _ (ensure-object =monitor)
+ :let [output-type &type/Unit]
+ _ (&type/check exo-type output-type)]
+ (return (&/|list (&/T (&/V <tag> =monitor) output-type)))))
+
+ analyse-jvm-monitorenter "jvm-monitorenter"
+ analyse-jvm-monitorexit "jvm-monitorexit"
+ )
(do-template [<name> <tag> <from-class> <to-class>]
- (defn <name> [analyse ?value]
- (|do [=value (&&/analyse-1 analyse (&/V "lux;DataT" <from-class>) ?value)]
- (return (&/|list (&/T (&/V <tag> =value) (&/V "lux;DataT" <to-class>))))))
+ (let [output-type (&/V "lux;DataT" <to-class>)]
+ (defn <name> [analyse exo-type ?value]
+ (|do [=value (&&/analyse-1 analyse (&/V "lux;DataT" <from-class>) ?value)
+ _ (&type/check exo-type output-type)]
+ (return (&/|list (&/T (&/V <tag> =value) output-type))))))
analyse-jvm-d2f "jvm-d2f" "java.lang.Double" "java.lang.Float"
analyse-jvm-d2i "jvm-d2i" "java.lang.Double" "java.lang.Integer"
@@ -355,9 +413,11 @@
)
(do-template [<name> <tag> <from-class> <to-class>]
- (defn <name> [analyse ?value]
- (|do [=value (&&/analyse-1 analyse (&/V "lux;DataT" <from-class>) ?value)]
- (return (&/|list (&/T (&/V <tag> =value) (&/V "lux;DataT" <to-class>))))))
+ (let [output-type (&/V "lux;DataT" <to-class>)]
+ (defn <name> [analyse exo-type ?value]
+ (|do [=value (&&/analyse-1 analyse (&/V "lux;DataT" <from-class>) ?value)
+ _ (&type/check exo-type output-type)]
+ (return (&/|list (&/T (&/V <tag> =value) output-type))))))
analyse-jvm-iand "jvm-iand" "java.lang.Integer" "java.lang.Integer"
analyse-jvm-ior "jvm-ior" "java.lang.Integer" "java.lang.Integer"
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 4a912f1c1..065e150d9 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -261,11 +261,11 @@
(|do [macro-expansion #(-> macro (.apply ?args) (.apply %))
:let [macro-expansion* (&/|map (partial with-cursor form-cursor) macro-expansion)]
;; :let [_ (when (and ;; (= "lux/control/monad" ?module)
- ;; (= "open" ?name))
+ ;; (= "case" ?name))
;; (->> (&/|map &/show-ast macro-expansion*)
;; (&/|interpose "\n")
;; (&/fold str "")
- ;; (prn ?module "open")))]
+ ;; (prn ?module "case")))]
]
(&/flat-map% (partial analyse exo-type) macro-expansion*))
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 9f0a78fa7..eb94c2c90 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -466,7 +466,10 @@
(findClass [^String class-name]
;; (prn 'findClass class-name)
(if-let [^bytes bytecode (get @store class-name)]
- (.invoke define-class this (to-array [class-name bytecode (int 0) (int (alength bytecode))]))
+ (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))
+ (throw e)))
(do (prn 'memory-class-loader/store class-name (keys @store))
(throw (IllegalStateException. (str "[Class Loader] Unknown class: " class-name)))))))))
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index bb1c72f66..3449900e0 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -28,7 +28,8 @@
[lux :as &&lux]
[host :as &&host]
[case :as &&case]
- [lambda :as &&lambda]))
+ [lambda :as &&lambda]
+ [package :as &&package]))
(:import (org.objectweb.asm Opcodes
Label
ClassWriter
@@ -383,17 +384,18 @@
(fail "[Compiler Error] Can't redefine a module!")
(|do [_ (&a-module/enter-module name)
:let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
- (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
+ (.visit Opcodes/V1_6 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
(str (&host/->module-class name) "/_") nil "java/lang/Object" nil)
(-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_hash" "I" nil file-hash)
.visitEnd)
(-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_compiler" "Ljava/lang/String;" nil &&/version)
- .visitEnd))]]
+ .visitEnd))
+ ;; _ (prn 'compile-module name =class)
+ ]]
(fn [state]
- (matchv ::M/objects [((&/exhaust% compiler-step)
- (->> state
- (&/set$ &/$SOURCE (&reader/from file-name file-content))
- (&/update$ &/$HOST #(&/set$ &/$WRITER (&/V "lux;Some" =class) %))))]
+ (matchv ::M/objects [((&/with-writer =class
+ (&/exhaust% compiler-step))
+ (&/set$ &/$SOURCE (&reader/from file-name file-content) state))]
[["lux;Right" [?state _]]]
(&/run-state (|do [defs &a-module/defs
imports &a-module/imports
@@ -409,7 +411,9 @@
(-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_imports" "Ljava/lang/String;" nil
(->> imports (&/|interpose "\t") (&/fold str "")))
.visitEnd)
- (.visitEnd))]]
+ (.visitEnd))
+ ;; _ (prn 'CLOSED name =class)
+ ]]
(&&/save-class! "_" (.toByteArray =class)))
?state)
@@ -421,12 +425,13 @@
(.mkdirs (java.io.File. &&/output-dir)))
;; [Resources]
-(defn compile-all [modules]
+(defn compile-program [program-module]
(init!)
- (matchv ::M/objects [((&/map% compile-module modules) (&/init-state nil))]
+ (matchv ::M/objects [((&/map% compile-module (&/|list "lux" program-module)) (&/init-state nil))]
[["lux;Right" [?state _]]]
(do (println "Compilation complete!")
- (&&cache/clean ?state))
+ (&&cache/clean ?state)
+ (&&package/package program-module))
[["lux;Left" ?message]]
(assert false ?message)))
diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj
index 0631f51e8..28339c162 100644
--- a/src/lux/compiler/base.clj
+++ b/src/lux/compiler/base.clj
@@ -7,7 +7,8 @@
;; You must not remove this notice, or any other, from this software.
(ns lux.compiler.base
- (:require [clojure.string :as string]
+ (:require (clojure [template :refer [do-template]]
+ [string :as string])
[clojure.java.io :as io]
[clojure.core.match :as M :refer [matchv]]
clojure.core.match.array
@@ -29,6 +30,7 @@
(def ^String version "0.2")
(def ^String input-dir "source")
(def ^String output-dir "target/jvm")
+(def ^String output-package (str output-dir "/program.jar"))
(def ^String function-class "lux/Function")
(def ^String local-prefix "l")
@@ -59,7 +61,31 @@
!classes &/classes
:let [real-name (str (&host/->module-class module) "." name)
_ (swap! !classes assoc real-name bytecode)
- _ (load-class! loader real-name)
_ (when (not eval?)
- (write-output module name bytecode))]]
+ (write-output module name bytecode))
+ _ (load-class! loader real-name)]]
(return nil)))
+
+(do-template [<name> <class> <sig> <dup>]
+ (defn <name> [^MethodVisitor writer]
+ (doto writer
+ (.visitMethodInsn Opcodes/INVOKESTATIC <class> "valueOf" (str <sig> (&host/->type-signature <class>))))
+ ;; (doto writer
+ ;; ;; X
+ ;; (.visitTypeInsn Opcodes/NEW <class>) ;; XW
+ ;; (.visitInsn <dup>) ;; WXW
+ ;; (.visitInsn <dup>) ;; WWXW
+ ;; (.visitInsn Opcodes/POP) ;; WWX
+ ;; (.visitMethodInsn Opcodes/INVOKESPECIAL <class> "<init>" <sig>) ;; W
+ ;; )
+ )
+
+ wrap-boolean "java/lang/Boolean" "(Z)" Opcodes/DUP_X1
+ wrap-byte "java/lang/Byte" "(B)" Opcodes/DUP_X1
+ wrap-short "java/lang/Short" "(S)" Opcodes/DUP_X1
+ wrap-int "java/lang/Integer" "(I)" Opcodes/DUP_X1
+ wrap-long "java/lang/Long" "(J)" Opcodes/DUP_X2
+ wrap-float "java/lang/Float" "(F)" Opcodes/DUP_X1
+ wrap-double "java/lang/Double" "(D)" Opcodes/DUP_X2
+ wrap-char "java/lang/Character" "(C)" Opcodes/DUP_X1
+ )
diff --git a/src/lux/compiler/cache.clj b/src/lux/compiler/cache.clj
index 57e81a2b0..c0d978146 100644
--- a/src/lux/compiler/cache.clj
+++ b/src/lux/compiler/cache.clj
@@ -55,8 +55,11 @@
(defn clean [state]
"(-> Compiler (,))"
(let [needed-modules (->> state (&/get$ &/$MODULES) &/|keys &/->seq set)
- outdated? #(-> ^File % .getName (string/replace " " "/") (->> (contains? needed-modules)) not)
- outdate-files (->> &&/output-dir (new File) .listFiles seq (filter outdated?))]
+ outdated? #(-> ^File % .getName (string/replace &host/module-separator "/") (->> (contains? needed-modules)) not)
+ outdate-files (->> &&/output-dir (new File) .listFiles seq (filter outdated?))
+ program-file (new File &&/output-package)]
+ (when (.exists program-file)
+ (.delete program-file))
(doseq [f outdate-files]
(clean-file f))
nil))
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index 3df09b29e..346b66fd2 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -52,7 +52,7 @@
char-class "java.lang.Character"]
(defn prepare-return! [^MethodVisitor *writer* *type*]
(matchv ::M/objects [*type*]
- [["lux;VariantT" ["lux;Nil" _]]]
+ [["lux;TupleT" ["lux;Nil" _]]]
(.visitInsn *writer* Opcodes/ACONST_NULL)
[["lux;DataT" "boolean"]]
@@ -84,7 +84,7 @@
*writer*))
;; [Resources]
-(do-template [<name> <opcode> <wrapper-class> <value-method> <value-method-sig> <wrapper-method> <wrapper-method-sig>]
+(do-template [<name> <opcode> <wrapper-class> <value-method> <value-method-sig> <wrap>]
(defn <name> [compile *type* ?x ?y]
(|do [:let [+wrapper-class+ (&host/->class <wrapper-class>)]
^MethodVisitor *writer* &/get-writer
@@ -98,32 +98,32 @@
(.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>))
_ (doto *writer*
(.visitInsn <opcode>)
- (.visitMethodInsn Opcodes/INVOKESTATIC +wrapper-class+ <wrapper-method> (str <wrapper-method-sig> (&host/->type-signature <wrapper-class>))))]]
+ (<wrap>))]]
(return nil)))
- compile-jvm-iadd Opcodes/IADD "java.lang.Integer" "intValue" "()I" "valueOf" "(I)"
- compile-jvm-isub Opcodes/ISUB "java.lang.Integer" "intValue" "()I" "valueOf" "(I)"
- compile-jvm-imul Opcodes/IMUL "java.lang.Integer" "intValue" "()I" "valueOf" "(I)"
- compile-jvm-idiv Opcodes/IDIV "java.lang.Integer" "intValue" "()I" "valueOf" "(I)"
- compile-jvm-irem Opcodes/IREM "java.lang.Integer" "intValue" "()I" "valueOf" "(I)"
+ compile-jvm-iadd Opcodes/IADD "java.lang.Integer" "intValue" "()I" &&/wrap-int
+ compile-jvm-isub Opcodes/ISUB "java.lang.Integer" "intValue" "()I" &&/wrap-int
+ compile-jvm-imul Opcodes/IMUL "java.lang.Integer" "intValue" "()I" &&/wrap-int
+ compile-jvm-idiv Opcodes/IDIV "java.lang.Integer" "intValue" "()I" &&/wrap-int
+ compile-jvm-irem Opcodes/IREM "java.lang.Integer" "intValue" "()I" &&/wrap-int
- compile-jvm-ladd Opcodes/LADD "java.lang.Long" "longValue" "()J" "valueOf" "(J)"
- compile-jvm-lsub Opcodes/LSUB "java.lang.Long" "longValue" "()J" "valueOf" "(J)"
- compile-jvm-lmul Opcodes/LMUL "java.lang.Long" "longValue" "()J" "valueOf" "(J)"
- compile-jvm-ldiv Opcodes/LDIV "java.lang.Long" "longValue" "()J" "valueOf" "(J)"
- compile-jvm-lrem Opcodes/LREM "java.lang.Long" "longValue" "()J" "valueOf" "(J)"
-
- compile-jvm-fadd Opcodes/FADD "java.lang.Float" "floatValue" "()F" "valueOf" "(F)"
- compile-jvm-fsub Opcodes/FSUB "java.lang.Float" "floatValue" "()F" "valueOf" "(F)"
- compile-jvm-fmul Opcodes/FMUL "java.lang.Float" "floatValue" "()F" "valueOf" "(F)"
- compile-jvm-fdiv Opcodes/FDIV "java.lang.Float" "floatValue" "()F" "valueOf" "(F)"
- compile-jvm-frem Opcodes/FREM "java.lang.Float" "floatValue" "()F" "valueOf" "(F)"
+ compile-jvm-ladd Opcodes/LADD "java.lang.Long" "longValue" "()J" &&/wrap-long
+ compile-jvm-lsub Opcodes/LSUB "java.lang.Long" "longValue" "()J" &&/wrap-long
+ compile-jvm-lmul Opcodes/LMUL "java.lang.Long" "longValue" "()J" &&/wrap-long
+ compile-jvm-ldiv Opcodes/LDIV "java.lang.Long" "longValue" "()J" &&/wrap-long
+ compile-jvm-lrem Opcodes/LREM "java.lang.Long" "longValue" "()J" &&/wrap-long
+
+ compile-jvm-fadd Opcodes/FADD "java.lang.Float" "floatValue" "()F" &&/wrap-float
+ compile-jvm-fsub Opcodes/FSUB "java.lang.Float" "floatValue" "()F" &&/wrap-float
+ compile-jvm-fmul Opcodes/FMUL "java.lang.Float" "floatValue" "()F" &&/wrap-float
+ compile-jvm-fdiv Opcodes/FDIV "java.lang.Float" "floatValue" "()F" &&/wrap-float
+ compile-jvm-frem Opcodes/FREM "java.lang.Float" "floatValue" "()F" &&/wrap-float
- compile-jvm-dadd Opcodes/DADD "java.lang.Double" "doubleValue" "()D" "valueOf" "(D)"
- compile-jvm-dsub Opcodes/DSUB "java.lang.Double" "doubleValue" "()D" "valueOf" "(D)"
- compile-jvm-dmul Opcodes/DMUL "java.lang.Double" "doubleValue" "()D" "valueOf" "(D)"
- compile-jvm-ddiv Opcodes/DDIV "java.lang.Double" "doubleValue" "()D" "valueOf" "(D)"
- compile-jvm-drem Opcodes/DREM "java.lang.Double" "doubleValue" "()D" "valueOf" "(D)"
+ compile-jvm-dadd Opcodes/DADD "java.lang.Double" "doubleValue" "()D" &&/wrap-double
+ compile-jvm-dsub Opcodes/DSUB "java.lang.Double" "doubleValue" "()D" &&/wrap-double
+ compile-jvm-dmul Opcodes/DMUL "java.lang.Double" "doubleValue" "()D" &&/wrap-double
+ compile-jvm-ddiv Opcodes/DDIV "java.lang.Double" "doubleValue" "()D" &&/wrap-double
+ compile-jvm-drem Opcodes/DREM "java.lang.Double" "doubleValue" "()D" &&/wrap-double
)
(do-template [<name> <opcode> <wrapper-class> <value-method> <value-method-sig>]
@@ -205,31 +205,50 @@
(return ret)))
?classes ?args)
:let [_ (doto *writer*
- (.visitMethodInsn Opcodes/INVOKESTATIC (&host/->class ?class) ?method method-sig)
+ (.visitMethodInsn Opcodes/INVOKESTATIC (&host/->class (&type/as-obj ?class)) ?method method-sig)
(prepare-return! *type*))]]
(return nil)))
(do-template [<name> <op>]
(defn <name> [compile *type* ?class ?method ?classes ?object ?args]
- (|do [^MethodVisitor *writer* &/get-writer
+ (|do [:let [?class* (&host/->class (&type/as-obj ?class))]
+ ^MethodVisitor *writer* &/get-writer
:let [method-sig (str "(" (&/fold str "" (&/|map &host/->type-signature ?classes)) ")" (&host/->java-sig *type*))]
_ (compile ?object)
- :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST (&host/->class ?class))]
+ :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST ?class*)]
_ (&/map2% (fn [class-name arg]
(|do [ret (compile arg)
:let [_ (prepare-arg! *writer* class-name)]]
(return ret)))
?classes ?args)
:let [_ (doto *writer*
- (.visitMethodInsn <op> (&host/->class ?class) ?method method-sig)
+ (.visitMethodInsn <op> ?class* ?method method-sig)
(prepare-return! *type*))]]
(return nil)))
compile-jvm-invokevirtual Opcodes/INVOKEVIRTUAL
compile-jvm-invokeinterface Opcodes/INVOKEINTERFACE
- compile-jvm-invokespecial Opcodes/INVOKESPECIAL
+ ;; compile-jvm-invokespecial Opcodes/INVOKESPECIAL
)
+(defn compile-jvm-invokespecial [compile *type* ?class ?method ?classes ?object ?args]
+ (|do [:let [?class* (&host/->class (&type/as-obj ?class))]
+ ^MethodVisitor *writer* &/get-writer
+ :let [method-sig (str "(" (&/fold str "" (&/|map &host/->type-signature ?classes)) ")" (&host/->java-sig *type*))]
+ _ (compile ?object)
+ ;; :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST ?class*)]
+ :let [_ (when (not= "<init>" ?method)
+ (.visitTypeInsn *writer* Opcodes/CHECKCAST ?class*))]
+ _ (&/map2% (fn [class-name arg]
+ (|do [ret (compile arg)
+ :let [_ (prepare-arg! *writer* class-name)]]
+ (return ret)))
+ ?classes ?args)
+ :let [_ (doto *writer*
+ (.visitMethodInsn Opcodes/INVOKESPECIAL ?class* ?method method-sig)
+ (prepare-return! *type*))]]
+ (return nil)))
+
(defn compile-jvm-null [compile *type*]
(|do [^MethodVisitor *writer* &/get-writer
:let [_ (.visitInsn *writer* Opcodes/ACONST_NULL)]]
@@ -293,31 +312,33 @@
(defn compile-jvm-getstatic [compile *type* ?class ?field]
(|do [^MethodVisitor *writer* &/get-writer
:let [_ (doto *writer*
- (.visitFieldInsn Opcodes/GETSTATIC (&host/->class ?class) ?field (&host/->java-sig *type*))
+ (.visitFieldInsn Opcodes/GETSTATIC (&host/->class (&type/as-obj ?class)) ?field (&host/->java-sig *type*))
(prepare-return! *type*))]]
(return nil)))
(defn compile-jvm-getfield [compile *type* ?class ?field ?object]
- (|do [^MethodVisitor *writer* &/get-writer
+ (|do [:let [class* (&host/->class (&type/as-obj ?class))]
+ ^MethodVisitor *writer* &/get-writer
_ (compile ?object)
:let [_ (doto *writer*
- (.visitTypeInsn Opcodes/CHECKCAST (&host/->class ?class))
- (.visitFieldInsn Opcodes/GETFIELD (&host/->class ?class) ?field (&host/->java-sig *type*))
+ (.visitTypeInsn Opcodes/CHECKCAST class*)
+ (.visitFieldInsn Opcodes/GETFIELD class* ?field (&host/->java-sig *type*))
(prepare-return! *type*))]]
(return nil)))
(defn compile-jvm-putstatic [compile *type* ?class ?field ?value]
(|do [^MethodVisitor *writer* &/get-writer
_ (compile ?value)
- :let [_ (.visitFieldInsn *writer* Opcodes/PUTSTATIC (&host/->class ?class) ?field (&host/->java-sig *type*))]]
+ :let [_ (.visitFieldInsn *writer* Opcodes/PUTSTATIC (&host/->class (&type/as-obj ?class)) ?field (&host/->java-sig *type*))]]
(return nil)))
(defn compile-jvm-putfield [compile *type* ?class ?field ?object ?value]
- (|do [^MethodVisitor *writer* &/get-writer
+ (|do [:let [class* (&host/->class (&type/as-obj ?class))]
+ ^MethodVisitor *writer* &/get-writer
_ (compile ?object)
_ (compile ?value)
- :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST (&host/->class ?class))]
- :let [_ (.visitFieldInsn *writer* Opcodes/PUTFIELD (&host/->class ?class) ?field (&host/->java-sig *type*))]]
+ :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST class*)]
+ :let [_ (.visitFieldInsn *writer* Opcodes/PUTFIELD class* ?field (&host/->java-sig *type*))]]
(return nil)))
(defn ^:private modifiers->int [mods]
@@ -336,11 +357,12 @@
0)))
(defn compile-jvm-instanceof [compile *type* class object]
- (|do [^MethodVisitor *writer* &/get-writer
+ (|do [:let [class* (&host/->class class)]
+ ^MethodVisitor *writer* &/get-writer
_ (compile object)
:let [_ (doto *writer*
- (.visitLdcInsn class)
- (.visitTypeInsn Opcodes/INSTANCEOF class))]]
+ (.visitTypeInsn Opcodes/INSTANCEOF class*)
+ (&&/wrap-boolean))]]
(return nil)))
(defn compile-jvm-class [compile ?name ?super-class ?interfaces ?fields ?methods]
@@ -391,46 +413,50 @@
$to (new Label)
$end (new Label)
$catch-finally (new Label)
- compile-finally (if ?finally
- (|do [_ (return nil)
- _ (compile ?finally)
- :let [_ (doto *writer*
- (.visitInsn Opcodes/POP)
- (.visitJumpInsn Opcodes/GOTO $end))]]
- (return nil))
- (|do [_ (return nil)
- :let [_ (.visitJumpInsn *writer* Opcodes/GOTO $end)]]
- (return nil)))
- _ (.visitLabel *writer* $from)]
+ compile-finally (matchv ::M/objects [?finally]
+ [["lux;Some" ?finally*]] (|do [_ (return nil)
+ _ (compile ?finally*)
+ :let [_ (doto *writer*
+ (.visitInsn Opcodes/POP)
+ (.visitJumpInsn Opcodes/GOTO $end))]]
+ (return nil))
+ [["lux;None" _]] (|do [_ (return nil)
+ :let [_ (.visitJumpInsn *writer* Opcodes/GOTO $end)]]
+ (return nil)))
+ catch-boundaries (&/|map (fn [[?ex-class ?ex-idx ?catch-body]] [?ex-class (new Label) (new Label)])
+ ?catches)
+ _ (doseq [[?ex-class $handler-start $handler-end] (&/->seq catch-boundaries)
+ ;; :let [_ (prn 'HANDLER ?ex-class (&host/->class ?ex-class) $handler-start $handler-end $from $to $catch-finally)]
+ ]
+ (doto *writer*
+ (.visitTryCatchBlock $from $to $handler-start (&host/->class ?ex-class))
+ (.visitTryCatchBlock $handler-start $handler-end $catch-finally nil)))
+ _ (.visitTryCatchBlock *writer* $from $to $catch-finally nil)]
+ :let [_ (.visitLabel *writer* $from)]
_ (compile ?body)
:let [_ (.visitLabel *writer* $to)]
_ compile-finally
- handlers (&/map% (fn [[?ex-class ?ex-arg ?catch-body]]
- (|do [:let [$handler-start (new Label)
- $handler-end (new Label)]
- _ (compile ?catch-body)
- :let [_ (.visitLabel *writer* $handler-end)]
- _ compile-finally]
- (return [?ex-class $handler-start $handler-end])))
- ?catches)
+ handlers (&/map2% (fn [[?ex-class ?ex-idx ?catch-body] [_ $handler-start $handler-end]]
+ (|do [:let [_ (doto *writer*
+ (.visitLabel $handler-start)
+ (.visitVarInsn Opcodes/ASTORE ?ex-idx))]
+ _ (compile ?catch-body)
+ :let [_ (.visitLabel *writer* $handler-end)]]
+ compile-finally))
+ ?catches
+ catch-boundaries)
+ ;; :let [_ (prn 'handlers (&/->seq handlers))]
:let [_ (.visitLabel *writer* $catch-finally)]
- _ (if ?finally
- (|do [_ (compile ?finally)
- :let [_ (doto *writer*
- (.visitInsn Opcodes/POP)
- (.visitInsn Opcodes/ATHROW))]]
- (return nil))
- (|do [_ (return nil)
- :let [_ (.visitInsn *writer* Opcodes/ATHROW)]]
- (return nil)))
+ _ (matchv ::M/objects [?finally]
+ [["lux;Some" ?finally*]] (|do [_ (compile ?finally*)
+ :let [_ (.visitInsn *writer* Opcodes/POP)]
+ :let [_ (.visitInsn *writer* Opcodes/ATHROW)]]
+ (return nil))
+ [["lux;None" _]] (|do [_ (return nil)
+ :let [_ (.visitInsn *writer* Opcodes/ATHROW)]]
+ (return nil)))
:let [_ (.visitJumpInsn *writer* Opcodes/GOTO $end)]
- :let [_ (.visitLabel *writer* $end)]
- :let [_ (doseq [[?ex-class $handler-start $handler-end] handlers]
- (doto *writer*
- (.visitTryCatchBlock $from $to $handler-start ?ex-class)
- (.visitTryCatchBlock $handler-start $handler-end $catch-finally nil))
- )
- _ (.visitTryCatchBlock *writer* $from $to $catch-finally nil)]]
+ :let [_ (.visitLabel *writer* $end)]]
(return nil)))
(defn compile-jvm-throw [compile *type* ?ex]
@@ -518,12 +544,17 @@
)
(defn compile-jvm-program [compile ?body]
- (|do [^ClassWriter *writer* &/get-writer]
+ (|do [module-name &/get-module-name
+ ;; :let [_ (prn 'compile-jvm-program module-name)]
+ ^ClassWriter *writer* &/get-writer]
(&/with-writer (doto (.visitMethod *writer* (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "main" "([Ljava/lang/String;)V" nil nil)
(.visitCode))
(|do [^MethodVisitor main-writer &/get-writer
- :let [$loop (new Label)
+ :let [;; _ (prn "#1" module-name *writer*)
+ $loop (new Label)
+ ;; _ (prn "#2")
$end (new Label)
+ ;; _ (prn "#3")
_ (doto main-writer
;; Tail: Begin
(.visitLdcInsn (int 2)) ;; S
@@ -589,14 +620,21 @@
(.visitLabel $end) ;; VI
(.visitInsn Opcodes/POP) ;; V
(.visitVarInsn Opcodes/ASTORE (int 0)) ;;
- )]
+ )
+ ;; _ (prn "#4")
+ ]
_ (compile ?body)
- :let [_ (doto main-writer
+ :let [;; _ (prn "#5")
+ _ (doto main-writer
(.visitInsn Opcodes/ACONST_NULL)
- (.visitMethodInsn Opcodes/INVOKEINTERFACE &&/function-class "apply" &&/apply-signature))]
+ (.visitMethodInsn Opcodes/INVOKEINTERFACE &&/function-class "apply" &&/apply-signature))
+ ;; _ (prn "#6")
+ ]
:let [_ (doto main-writer
- (.visitInsn Opcodes/POP)
- (.visitInsn Opcodes/RETURN)
- (.visitMaxs 0 0)
- (.visitEnd))]]
+ (.visitInsn Opcodes/POP)
+ (.visitInsn Opcodes/RETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd))
+ ;; _ (prn "#7")
+ ]]
(return nil)))))
diff --git a/src/lux/compiler/package.clj b/src/lux/compiler/package.clj
new file mode 100644
index 000000000..40639e85a
--- /dev/null
+++ b/src/lux/compiler/package.clj
@@ -0,0 +1,61 @@
+;; Copyright (c) Eduardo Julian. All rights reserved.
+;; The use and distribution terms for this software are covered by the
+;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+;; which can be found in the file epl-v10.html at the root of this distribution.
+;; By using this software in any fashion, you are agreeing to be bound by
+;; the terms of this license.
+;; You must not remove this notice, or any other, from this software.
+
+(ns lux.compiler.package
+ (:require [clojure.core.match :as M :refer [matchv]]
+ clojure.core.match.array
+ (lux [base :as & :refer [|let |do return* return fail fail*]]
+ [host :as &host])
+ (lux.compiler [base :as &&]))
+ (:import (java.io File
+ FileInputStream
+ FileOutputStream
+ BufferedInputStream)
+ (java.util.jar Manifest
+ Attributes$Name
+ JarEntry
+ JarOutputStream
+ )))
+
+;; [Utils]
+(def ^:private kilobyte 1024)
+
+(defn ^:private manifest [^String module]
+ "(-> Text Manifest)"
+ (doto (new Manifest)
+ (-> .getMainAttributes (doto (.put Attributes$Name/MAIN_CLASS (str (&host/->module-class module) "._"))
+ (.put Attributes$Name/MANIFEST_VERSION "1.0")))))
+
+(defn ^:private write-class! [^String path ^File file ^JarOutputStream out]
+ "(-> Text File JarOutputStream Unit)"
+ (with-open [in (new BufferedInputStream (new FileInputStream file))]
+ (let [buffer (byte-array (* 10 kilobyte))]
+ (doto out
+ (.putNextEntry (new JarEntry (str path "/" (.getName file))))
+ (-> (.write buffer 0 bytes-read)
+ (->> (when (not= -1 bytes-read))
+ (loop [bytes-read (.read in buffer)])))
+ (.flush)
+ (.closeEntry)
+ ))
+ ))
+
+(defn ^:private write-module! [^File file ^JarOutputStream out]
+ "(-> File JarOutputStream Unit)"
+ (let [module-name (.getName file)]
+ (doseq [$class (.listFiles file)]
+ (write-class! module-name $class out))))
+
+;; [Resources]
+(defn package [module]
+ "(-> Text (,))"
+ ;; (prn 'package module)
+ (with-open [out (new JarOutputStream (->> &&/output-package (new File) (new FileOutputStream)) (manifest module))]
+ (doseq [$group (.listFiles (new File &&/output-dir))]
+ (write-module! $group out))
+ ))
diff --git a/src/lux/host.clj b/src/lux/host.clj
index cf9830169..906e3c714 100644
--- a/src/lux/host.clj
+++ b/src/lux/host.clj
@@ -18,6 +18,7 @@
;; [Constants]
(def prefix "lux.")
(def function-class (str prefix "Function"))
+(def module-separator "_")
;; [Utils]
(defn ^:private class->type [^Class class]
@@ -27,7 +28,7 @@
"")
(.getSimpleName class)))]
(if (.equals "void" base)
- (return &type/$Void)
+ (return &type/Unit)
(return (&/V "lux;DataT" (str (reduce str "" (repeat (int (/ (count arr-level) 2)) "["))
base)))
)))
@@ -40,7 +41,7 @@
(string/replace class #"\." "/"))
(defn ^String ->module-class [module-name]
- (string/replace module-name #"/" " "))
+ (string/replace module-name #"/" module-separator))
(def ->package ->module-class)
@@ -71,13 +72,13 @@
[["lux;LambdaT" [_ _]]]
(->type-signature function-class)
- [["lux;VariantT" ["lux;Nil" _]]]
+ [["lux;TupleT" ["lux;Nil" _]]]
"V"
))
(do-template [<name> <static?>]
- (defn <name> [target field]
- (if-let [type* (first (for [^Field =field (.getDeclaredFields (Class/forName target))
+ (defn <name> [class-loader target field]
+ (if-let [type* (first (for [^Field =field (.getDeclaredFields (Class/forName (&type/as-obj target) true class-loader))
:when (and (.equals ^Object field (.getName =field))
(.equals ^Object <static?> (Modifier/isStatic (.getModifiers =field))))]
(.getType =field)))]
@@ -90,8 +91,9 @@
)
(do-template [<name> <static?>]
- (defn <name> [target method-name args]
- (if-let [method (first (for [^Method =method (.getDeclaredMethods (Class/forName target))
+ (defn <name> [class-loader target method-name args]
+ ;; (prn '<name> target method-name)
+ (if-let [method (first (for [^Method =method (.getDeclaredMethods (Class/forName (&type/as-obj target) true class-loader))
:when (and (.equals ^Object method-name (.getName =method))
(.equals ^Object <static?> (Modifier/isStatic (.getModifiers =method)))
(&/fold2 #(and %1 (.equals ^Object %2 %3))
diff --git a/src/lux/type.clj b/src/lux/type.clj
index af2bbf30f..f5b8d3f25 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -587,12 +587,24 @@
[_]
(fail (str "[Type System] Not type function:\n" (show-type type-fn) "\n"))))
-(def init-fixpoints (&/|list))
-
-(def counter (atom {}))
-(defn ^:private check* [fixpoints expected actual]
- ;; (swap! counter update-in [[(aget expected 0) (aget actual 0)]]
- ;; #(inc (or % 0)))
+(defn as-obj [class]
+ (case class
+ "boolean" "java.lang.Boolean"
+ "byte" "java.lang.Byte"
+ "short" "java.lang.Short"
+ "int" "java.lang.Integer"
+ "long" "java.lang.Long"
+ "float" "java.lang.Float"
+ "double" "java.lang.Double"
+ "char" "java.lang.Character"
+ ;; else
+ class))
+
+(def ^:private primitive-types #{"boolean" "byte" "short" "int" "long" "float" "double" "char"})
+
+(def ^:private init-fixpoints (&/|list))
+
+(defn ^:private check* [class-loader fixpoints expected actual]
(if (clojure.lang.Util/identical expected actual)
(return (&/T fixpoints nil))
(matchv ::M/objects [expected actual]
@@ -619,13 +631,13 @@
(return (&/T fixpoints nil)))
[["lux;Some" etype] ["lux;None" _]]
- (check* fixpoints etype actual)
+ (check* class-loader fixpoints etype actual)
[["lux;None" _] ["lux;Some" atype]]
- (check* fixpoints expected atype)
+ (check* class-loader fixpoints expected atype)
[["lux;Some" etype] ["lux;Some" atype]]
- (check* fixpoints etype atype))))
+ (check* class-loader fixpoints etype atype))))
[["lux;VarT" ?id] _]
(fn [state]
@@ -635,7 +647,7 @@
[["lux;Left" _]]
((|do [bound (deref ?id)]
- (check* fixpoints bound actual))
+ (check* class-loader fixpoints bound actual))
state)))
[_ ["lux;VarT" ?id]]
@@ -646,7 +658,7 @@
[["lux;Left" _]]
((|do [bound (deref ?id)]
- (check* fixpoints expected bound))
+ (check* class-loader fixpoints expected bound))
state)))
[["lux;AppT" [["lux;VarT" ?eid] A1]] ["lux;AppT" [["lux;VarT" ?aid] A2]]]
@@ -654,13 +666,13 @@
(matchv ::M/objects [((|do [F1 (deref ?eid)]
(fn [state]
(matchv ::M/objects [((|do [F2 (deref ?aid)]
- (check* fixpoints (&/V "lux;AppT" (&/T F1 A1)) (&/V "lux;AppT" (&/T F2 A2))))
+ (check* class-loader fixpoints (&/V "lux;AppT" (&/T F1 A1)) (&/V "lux;AppT" (&/T F2 A2))))
state)]
[["lux;Right" [state* output]]]
(return* state* output)
[["lux;Left" _]]
- ((check* fixpoints (&/V "lux;AppT" (&/T F1 A1)) actual)
+ ((check* class-loader fixpoints (&/V "lux;AppT" (&/T F1 A1)) actual)
state))))
state)]
[["lux;Right" [state* output]]]
@@ -668,62 +680,62 @@
[["lux;Left" _]]
(matchv ::M/objects [((|do [F2 (deref ?aid)]
- (check* fixpoints expected (&/V "lux;AppT" (&/T F2 A2))))
+ (check* class-loader fixpoints expected (&/V "lux;AppT" (&/T F2 A2))))
state)]
[["lux;Right" [state* output]]]
(return* state* output)
[["lux;Left" _]]
- ((|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?eid) (&/V "lux;VarT" ?aid))
- [fixpoints** _] (check* fixpoints* A1 A2)]
+ ((|do [[fixpoints* _] (check* class-loader fixpoints (&/V "lux;VarT" ?eid) (&/V "lux;VarT" ?aid))
+ [fixpoints** _] (check* class-loader fixpoints* A1 A2)]
(return (&/T fixpoints** nil)))
state))))
- ;; (|do [_ (check* fixpoints (&/V "lux;VarT" ?eid) (&/V "lux;VarT" ?aid))
- ;; _ (check* fixpoints A1 A2)]
+ ;; (|do [_ (check* class-loader fixpoints (&/V "lux;VarT" ?eid) (&/V "lux;VarT" ?aid))
+ ;; _ (check* class-loader fixpoints A1 A2)]
;; (return (&/T fixpoints nil)))
[["lux;AppT" [["lux;VarT" ?id] A1]] ["lux;AppT" [F2 A2]]]
(fn [state]
(matchv ::M/objects [((|do [F1 (deref ?id)]
- (check* fixpoints (&/V "lux;AppT" (&/T F1 A1)) actual))
+ (check* class-loader fixpoints (&/V "lux;AppT" (&/T F1 A1)) actual))
state)]
[["lux;Right" [state* output]]]
(return* state* output)
[["lux;Left" _]]
- ((|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?id) F2)
+ ((|do [[fixpoints* _] (check* class-loader fixpoints (&/V "lux;VarT" ?id) F2)
e* (apply-type F2 A1)
a* (apply-type F2 A2)
- [fixpoints** _] (check* fixpoints* e* a*)]
+ [fixpoints** _] (check* class-loader fixpoints* e* a*)]
(return (&/T fixpoints** nil)))
state)))
;; [["lux;AppT" [["lux;VarT" ?id] A1]] ["lux;AppT" [F2 A2]]]
- ;; (|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?id) F2)
+ ;; (|do [[fixpoints* _] (check* class-loader fixpoints (&/V "lux;VarT" ?id) F2)
;; e* (apply-type F2 A1)
;; a* (apply-type F2 A2)
- ;; [fixpoints** _] (check* fixpoints* e* a*)]
+ ;; [fixpoints** _] (check* class-loader fixpoints* e* a*)]
;; (return (&/T fixpoints** nil)))
[["lux;AppT" [F1 A1]] ["lux;AppT" [["lux;VarT" ?id] A2]]]
(fn [state]
(matchv ::M/objects [((|do [F2 (deref ?id)]
- (check* fixpoints expected (&/V "lux;AppT" (&/T F2 A2))))
+ (check* class-loader fixpoints expected (&/V "lux;AppT" (&/T F2 A2))))
state)]
[["lux;Right" [state* output]]]
(return* state* output)
[["lux;Left" _]]
- ((|do [[fixpoints* _] (check* fixpoints F1 (&/V "lux;VarT" ?id))
+ ((|do [[fixpoints* _] (check* class-loader fixpoints F1 (&/V "lux;VarT" ?id))
e* (apply-type F1 A1)
a* (apply-type F1 A2)
- [fixpoints** _] (check* fixpoints* e* a*)]
+ [fixpoints** _] (check* class-loader fixpoints* e* a*)]
(return (&/T fixpoints** nil)))
state)))
;; [["lux;AppT" [F1 A1]] ["lux;AppT" [["lux;VarT" ?id] A2]]]
- ;; (|do [[fixpoints* _] (check* fixpoints F1 (&/V "lux;VarT" ?id))
+ ;; (|do [[fixpoints* _] (check* class-loader fixpoints F1 (&/V "lux;VarT" ?id))
;; e* (apply-type F1 A1)
;; a* (apply-type F1 A2)
- ;; [fixpoints** _] (check* fixpoints* e* a*)]
+ ;; [fixpoints** _] (check* class-loader fixpoints* e* a*)]
;; (return (&/T fixpoints** nil)))
[["lux;AppT" [F A]] _]
@@ -745,85 +757,44 @@
[["lux;None" _]]
(|do [expected* (apply-type F A)]
- (check* (fp-put fp-pair true fixpoints) expected* actual))))
+ (check* class-loader (fp-put fp-pair true fixpoints) expected* actual))))
[_ ["lux;AppT" [F A]]]
(|do [actual* (apply-type F A)]
- (check* fixpoints expected actual*))
+ (check* class-loader fixpoints expected actual*))
[["lux;AllT" _] _]
(with-var
(fn [$arg]
(|do [expected* (apply-type expected $arg)]
- (check* fixpoints expected* actual))))
+ (check* class-loader fixpoints expected* actual))))
[_ ["lux;AllT" _]]
(with-var
(fn [$arg]
(|do [actual* (apply-type actual $arg)]
- (check* fixpoints expected actual*))))
-
- [["lux;DataT" "boolean"] ["lux;DataT" "java.lang.Boolean"]]
- (return (&/T fixpoints nil))
-
- [["lux;DataT" "byte"] ["lux;DataT" "java.lang.Byte"]]
- (return (&/T fixpoints nil))
-
- [["lux;DataT" "short"] ["lux;DataT" "java.lang.Short"]]
- (return (&/T fixpoints nil))
-
- [["lux;DataT" "int"] ["lux;DataT" "java.lang.Integer"]]
- (return (&/T fixpoints nil))
-
- [["lux;DataT" "long"] ["lux;DataT" "java.lang.Long"]]
- (return (&/T fixpoints nil))
-
- [["lux;DataT" "float"] ["lux;DataT" "java.lang.Float"]]
- (return (&/T fixpoints nil))
-
- [["lux;DataT" "double"] ["lux;DataT" "java.lang.Double"]]
- (return (&/T fixpoints nil))
-
- [["lux;DataT" "char"] ["lux;DataT" "java.lang.Character"]]
- (return (&/T fixpoints nil))
+ (check* class-loader fixpoints expected actual*))))
- [["lux;DataT" "java.lang.Boolean"] ["lux;DataT" "boolean"]]
- (return (&/T fixpoints nil))
-
- [["lux;DataT" "java.lang.Byte"] ["lux;DataT" "byte"]]
- (return (&/T fixpoints nil))
-
- [["lux;DataT" "java.lang.Short"] ["lux;DataT" "short"]]
- (return (&/T fixpoints nil))
-
- [["lux;DataT" "java.lang.Integer"] ["lux;DataT" "int"]]
- (return (&/T fixpoints nil))
-
- [["lux;DataT" "java.lang.Long"] ["lux;DataT" "long"]]
- (return (&/T fixpoints nil))
-
- [["lux;DataT" "java.lang.Float"] ["lux;DataT" "float"]]
- (return (&/T fixpoints nil))
-
- [["lux;DataT" "java.lang.Double"] ["lux;DataT" "double"]]
- (return (&/T fixpoints nil))
-
- [["lux;DataT" "java.lang.Character"] ["lux;DataT" "char"]]
- (return (&/T fixpoints nil))
+ [["lux;DataT" e!name] ["lux;DataT" "null"]]
+ (if (contains? primitive-types e!name)
+ (fail (str "[Type Error] Can't use \"null\" with primitive types."))
+ (return (&/T fixpoints nil)))
[["lux;DataT" e!name] ["lux;DataT" a!name]]
- (if (or (.equals ^Object e!name a!name)
- (.isAssignableFrom (Class/forName e!name) (Class/forName a!name)))
- (return (&/T fixpoints nil))
- (fail (str "[Type Error] Names don't match: " e!name " =/= " a!name)))
+ (let [e!name (as-obj e!name)
+ a!name (as-obj a!name)]
+ (if (or (.equals ^Object e!name a!name)
+ (.isAssignableFrom (Class/forName e!name true class-loader) (Class/forName a!name true class-loader)))
+ (return (&/T fixpoints nil))
+ (fail (str "[Type Error] Names don't match: " e!name " =/= " a!name))))
[["lux;LambdaT" [eI eO]] ["lux;LambdaT" [aI aO]]]
- (|do [[fixpoints* _] (check* fixpoints aI eI)]
- (check* fixpoints* eO aO))
+ (|do [[fixpoints* _] (check* class-loader fixpoints aI eI)]
+ (check* class-loader fixpoints* eO aO))
[["lux;TupleT" e!members] ["lux;TupleT" a!members]]
(|do [fixpoints* (&/fold2% (fn [fp e a]
- (|do [[fp* _] (check* fp e a)]
+ (|do [[fp* _] (check* class-loader fp e a)]
(return fp*)))
fixpoints
e!members a!members)]
@@ -834,7 +805,7 @@
(|let [[e!name e!type] e!case
[a!name a!type] a!case]
(if (.equals ^Object e!name a!name)
- (|do [[fp* _] (check* fp e!type a!type)]
+ (|do [[fp* _] (check* class-loader fp e!type a!type)]
(return fp*))
(fail (check-error expected actual)))))
fixpoints
@@ -846,7 +817,7 @@
(|let [[e!name e!type] e!slot
[a!name a!type] a!slot]
(if (.equals ^Object e!name a!name)
- (|do [[fp* _] (check* fp e!type a!type)]
+ (|do [[fp* _] (check* class-loader fp e!type a!type)]
(return fp*))
(fail (check-error expected actual)))))
fixpoints
@@ -863,7 +834,8 @@
)))
(defn check [expected actual]
- (|do [_ (check* init-fixpoints expected actual)]
+ (|do [class-loader &/loader
+ _ (check* class-loader init-fixpoints expected actual)]
(return nil)))
(defn apply-lambda [func param]
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-05 01:12:45 +0000