aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--source/lux.lux35
-rw-r--r--source/lux/codata/lazy.lux7
-rw-r--r--source/lux/meta/lux.lux6
-rw-r--r--source/program.lux4
-rw-r--r--src/lux/analyser.clj43
-rw-r--r--src/lux/analyser/base.clj19
-rw-r--r--src/lux/analyser/env.clj2
-rw-r--r--src/lux/analyser/host.clj152
-rw-r--r--src/lux/analyser/lambda.clj10
-rw-r--r--src/lux/analyser/lux.clj129
-rw-r--r--src/lux/base.clj7
-rw-r--r--src/lux/compiler.clj628
-rw-r--r--src/lux/compiler/case.clj2
-rw-r--r--src/lux/compiler/host.clj90
-rw-r--r--src/lux/compiler/lambda.clj10
-rw-r--r--src/lux/compiler/lux.clj28
-rw-r--r--src/lux/compiler/type.clj20
17 files changed, 656 insertions, 536 deletions
diff --git a/source/lux.lux b/source/lux.lux
index 7d00cd077..3ede6d75b 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -292,18 +292,10 @@
#Nil))))))))
(_lux_export DefData')
-## (deftype LuxVar
-## (| (#Local Int)
-## (#Global Ident)))
-(_lux_def LuxVar
- (#NamedT ["lux" "LuxVar"]
- (#VariantT (#Cons [## "lux;Local"
- Int
- (#Cons [## "lux;Global"
- Ident
- #Nil])]))))
-(_lux_export LuxVar)
-(_lux_declare-tags [#Local #Global] LuxVar)
+(_lux_def Analysis
+ (#NamedT ["lux" "Analysis"]
+ Void))
+(_lux_export Analysis)
## (deftype (Module Compiler)
## (& #module-aliases (List (, Text Text))
@@ -349,7 +341,7 @@
## (& #source Source
## #cursor Cursor
## #modules (List (, Text (Module Compiler)))
-## #envs (List (Env Text (, LuxVar Type)))
+## #envs (List (Env Text (Meta (, Type Cursor) Analysis)))
## #type-vars (Bindings Int Type)
## #expected Type
## #seed Int
@@ -369,7 +361,9 @@
#Nil))))
(#Cons ## "lux;envs"
(#AppT List (#AppT (#AppT Env Text)
- (#TupleT (#Cons LuxVar (#Cons Type #Nil)))))
+ (#AppT (#AppT Meta
+ (#TupleT (#Cons Type (#Cons Cursor #Nil))))
+ Analysis)))
(#Cons ## "lux;type-vars"
(#AppT (#AppT Bindings Int) Type)
(#Cons ## "lux;expected"
@@ -2711,16 +2705,15 @@
#envs envs #type-vars types #host host
#seed seed #eval? eval? #expected expected
#cursor cursor}
- (some (: (-> (Env Text (, LuxVar Type)) (Maybe Type))
+ (some (: (-> (Env Text (Meta (, Type Cursor) Analysis)) (Maybe Type))
(lambda [env]
(case env
{#name _ #inner-closures _ #locals {#counter _ #mappings locals} #closure {#counter _ #mappings closure}}
- (try-both (some (: (-> (, Text (, LuxVar Type)) (Maybe Type))
- (lambda [binding]
- (let [[bname [_ type]] binding]
- (if (text:= name bname)
- (#Some type)
- #None)))))
+ (try-both (some (: (-> (, Text (Meta (, Type Cursor) Analysis)) (Maybe Type))
+ (lambda [[bname [[type _] _]]]
+ (if (text:= name bname)
+ (#Some type)
+ #None))))
locals
closure))))
envs)))
diff --git a/source/lux/codata/lazy.lux b/source/lux/codata/lazy.lux
index 37fbbac64..c0c79fc1a 100644
--- a/source/lux/codata/lazy.lux
+++ b/source/lux/codata/lazy.lux
@@ -34,9 +34,14 @@
(def #export (call/cc f)
(All [a b c] (Lazy (-> a (Lazy b c)) (Lazy a c)))
(lambda [k]
- (f (lambda [a _] (k a))
+ (f (lambda [a _]
+ (k a))
k)))
+(def #export (run-lazy l k)
+ (All [a z] (-> (Lazy a z) (-> a z) z))
+ (l k))
+
## [Structs]
(defstruct #export Lazy/Functor (Functor Lazy)
(def (map f ma)
diff --git a/source/lux/meta/lux.lux b/source/lux/meta/lux.lux
index b9e07083f..650e67133 100644
--- a/source/lux/meta/lux.lux
+++ b/source/lux/meta/lux.lux
@@ -236,13 +236,13 @@
#;envs envs #;type-vars types #;host host
#;seed seed #;eval? eval? #;expected expected
#;cursor cursor}
- (some (: (-> (Env Text (, LuxVar Type)) (Maybe Type))
+ (some (: (-> (Env Text (Meta (, Type Cursor) Analysis)) (Maybe Type))
(lambda [env]
(case env
{#;name _ #;inner-closures _ #;locals {#;counter _ #;mappings locals} #;closure {#;counter _ #;mappings closure}}
- (try-both (some (: (-> (, Text (, LuxVar Type)) (Maybe Type))
+ (try-both (some (: (-> (, Text (Meta (, Type Cursor) Analysis)) (Maybe Type))
(lambda [binding]
- (let [[bname [_ type]] binding]
+ (let [[bname [[type _] _]] binding]
(if (text:= name bname)
(#;Some type)
#;None)))))
diff --git a/source/program.lux b/source/program.lux
index fa8b3a055..f013655bc 100644
--- a/source/program.lux
+++ b/source/program.lux
@@ -19,7 +19,6 @@
char
(either #as e)
id
- io
list
maybe
(number (int #refer (#only) #open ("i:" Int/Show))
@@ -32,7 +31,8 @@
(lazy #refer (#only))
(function #refer (#only))
(reader #as r)
- (state #refer (#only)))
+ (state #refer (#only))
+ io)
(host jvm
io)
(meta ast
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index a412362d9..190b34b03 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -60,9 +60,9 @@
(if (or ? (&&/type-tag? module tag-name))
(&&lux/analyse-variant analyser (&/V &/$Right exo-type) idx values)
(|do [wanted-type (&&module/tag-type module tag-name)
- [variant-analysis variant-type] (&&/cap-1 (&&lux/analyse-variant analyser (&/V &/$Left wanted-type) idx values))
+ [[variant-type variant-cursor] variant-analysis] (&&/cap-1 (&&lux/analyse-variant analyser (&/V &/$Left wanted-type) idx values))
_ (&type/check exo-type variant-type)]
- (return (&/|list (&/T variant-analysis exo-type))))))
+ (return (&/|list (&&/|meta exo-type variant-cursor variant-analysis))))))
_
(&&lux/analyse-variant analyser (&/V &/$Right exo-type) idx values)
@@ -324,10 +324,10 @@
(&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_putfield")]
(&/$Cons [_ (&/$TextS ?class)]
(&/$Cons [_ (&/$TextS ?field)]
- (&/$Cons ?object
- (&/$Cons ?value
+ (&/$Cons ?value
+ (&/$Cons ?object
(&/$Nil)))))))
- (&&host/analyse-jvm-putfield analyse exo-type ?class ?field ?object ?value)
+ (&&host/analyse-jvm-putfield analyse exo-type ?class ?field ?value ?object)
(&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_invokestatic")]
(&/$Cons [_ (&/$TextS ?class)]
@@ -584,24 +584,29 @@
(|case token
;; Standard special forms
(&/$BoolS ?value)
- (|do [_ (&type/check exo-type &type/Bool)]
- (return (&/|list (&/T (&/V &&/$bool ?value) exo-type))))
+ (|do [_ (&type/check exo-type &type/Bool)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor (&/V &&/$bool ?value)))))
(&/$IntS ?value)
- (|do [_ (&type/check exo-type &type/Int)]
- (return (&/|list (&/T (&/V &&/$int ?value) exo-type))))
+ (|do [_ (&type/check exo-type &type/Int)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor (&/V &&/$int ?value)))))
(&/$RealS ?value)
- (|do [_ (&type/check exo-type &type/Real)]
- (return (&/|list (&/T (&/V &&/$real ?value) exo-type))))
+ (|do [_ (&type/check exo-type &type/Real)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor (&/V &&/$real ?value)))))
(&/$CharS ?value)
- (|do [_ (&type/check exo-type &type/Char)]
- (return (&/|list (&/T (&/V &&/$char ?value) exo-type))))
+ (|do [_ (&type/check exo-type &type/Char)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor (&/V &&/$char ?value)))))
(&/$TextS ?value)
- (|do [_ (&type/check exo-type &type/Text)]
- (return (&/|list (&/T (&/V &&/$text ?value) exo-type))))
+ (|do [_ (&type/check exo-type &type/Text)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor (&/V &&/$text ?value)))))
(&/$TupleS ?elems)
(&&lux/analyse-tuple analyse (&/V &/$Right exo-type) ?elems)
@@ -657,16 +662,16 @@
(defn ^:private just-analyse [analyser syntax]
(&type/with-var
(fn [?var]
- (|do [[?output-term ?output-type] (&&/analyse-1 analyser ?var syntax)]
+ (|do [[[?output-type ?output-cursor] ?output-term] (&&/analyse-1 analyser ?var syntax)]
(|case [?var ?output-type]
[(&/$VarT ?e-id) (&/$VarT ?a-id)]
(if (= ?e-id ?a-id)
(|do [?output-type* (&type/deref ?e-id)]
- (return (&/T ?output-term ?output-type*)))
- (return (&/T ?output-term ?output-type)))
+ (return (&&/|meta ?output-type* ?output-cursor ?output-term)))
+ (return (&&/|meta ?output-type ?output-cursor ?output-term)))
[_ _]
- (return (&/T ?output-term ?output-type)))
+ (return (&&/|meta ?output-type ?output-cursor ?output-term)))
))))
(defn ^:private analyse-ast [eval! compile-module compile-token exo-type token]
diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj
index b12425ac7..664ba4450 100644
--- a/src/lux/analyser/base.clj
+++ b/src/lux/analyser/base.clj
@@ -152,7 +152,7 @@
;; [Exports]
(defn expr-type* [syntax+]
- (|let [[_ type] syntax+]
+ (|let [[[type _] _] syntax+]
type))
(def jvm-this "_jvm_this")
@@ -173,18 +173,21 @@
(&type/with-var
(fn [$var]
(|do [=expr (analyse-1 analyse $var ?token)
- :let [[?item ?type] =expr]
+ :let [[[?type ?cursor] ?item] =expr]
=type (&type/clean $var ?type)]
- (return (&/T ?item =type))))))
+ (return (&/T (&/T =type ?cursor) ?item))))))
(defn resolved-ident [ident]
- (|let [[?module ?name] ident]
- (|do [module* (if (.equals "" ?module)
- &/get-module-name
- (return ?module))]
- (return (&/T module* ?name)))))
+ (|do [:let [[?module ?name] ident]
+ module* (if (.equals "" ?module)
+ &/get-module-name
+ (return ?module))]
+ (return (&/T module* ?name))))
(let [tag-names #{"DataT" "VariantT" "TupleT" "LambdaT" "BoundT" "VarT" "ExT" "UnivQ" "ExQ" "AppT" "NamedT"}]
(defn type-tag? [module name]
(and (= "lux" module)
(contains? tag-names name))))
+
+(defn |meta [type cursor analysis]
+ (&/T (&/T type cursor) analysis))
diff --git a/src/lux/analyser/env.clj b/src/lux/analyser/env.clj
index 66478eecc..a7ce52c1f 100644
--- a/src/lux/analyser/env.clj
+++ b/src/lux/analyser/env.clj
@@ -24,7 +24,7 @@
(let [bound-unit (&/V &&/$var (&/V &/$Local (->> (&/|head stack) (&/get$ &/$locals) (&/get$ &/$counter))))]
(&/Cons$ (&/update$ &/$locals #(->> %
(&/update$ &/$counter inc)
- (&/update$ &/$mappings (fn [m] (&/|put name (&/T bound-unit type) m))))
+ (&/update$ &/$mappings (fn [m] (&/|put name (&&/|meta type &/empty-cursor bound-unit) m))))
(&/|head stack))
(&/|tail stack))))
state))]
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index f17be2a7c..292d3d4b1 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -115,8 +115,10 @@
(defn <name> [analyse exo-type x y]
(|do [=x (&&/analyse-1 analyse input-type x)
=y (&&/analyse-1 analyse input-type y)
- _ (&type/check exo-type output-type)]
- (return (&/|list (&/T (&/V <output-tag> (&/T =x =y)) output-type))))))
+ _ (&type/check exo-type output-type)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta output-type _cursor
+ (&/V <output-tag> (&/T =x =y))))))))
analyse-jvm-iadd &&/$jvm-iadd "java.lang.Integer" "java.lang.Integer"
analyse-jvm-isub &&/$jvm-isub "java.lang.Integer" "java.lang.Integer"
@@ -163,33 +165,41 @@
(|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)))))
+ _ (&type/check exo-type output-type)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta output-type _cursor
+ (&/V &&/$jvm-getstatic (&/T class field output-type)))))))
(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)
:let [output-type =type]
- _ (&type/check exo-type output-type)]
- (return (&/|list (&/T (&/V &&/$jvm-getfield (&/T class field =object)) output-type)))))
+ _ (&type/check exo-type output-type)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta output-type _cursor
+ (&/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)))))
+ _ (&type/check exo-type output-type)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta output-type _cursor
+ (&/V &&/$jvm-putstatic (&/T class field =value output-type)))))))
-(defn analyse-jvm-putfield [analyse exo-type class field object value]
+(defn analyse-jvm-putfield [analyse exo-type class field value 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)
:let [output-type &type/Unit]
- _ (&type/check exo-type output-type)]
- (return (&/|list (&/T (&/V &&/$jvm-putfield (&/T class field =object =value)) output-type)))))
+ _ (&type/check exo-type output-type)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta output-type _cursor
+ (&/V &&/$jvm-putfield (&/T class field =value =object (&&/expr-type* =object))))))))
(defn analyse-jvm-invokestatic [analyse exo-type class method classes args]
(|do [class-loader &/loader
@@ -205,15 +215,19 @@
classes
args)
:let [output-type =return]
- _ (&type/check exo-type (as-otype+ output-type))]
- (return (&/|list (&/T (&/V &&/$jvm-invokestatic (&/T class method classes =args)) output-type)))))
+ _ (&type/check exo-type (as-otype+ output-type))
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta output-type _cursor
+ (&/V &&/$jvm-invokestatic (&/T class method classes =args output-type)))))))
(defn analyse-jvm-instanceof [analyse exo-type class 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-instanceof (&/T class =object)) output-type)))))
+ _ (&type/check exo-type output-type)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta output-type _cursor
+ (&/V &&/$jvm-instanceof (&/T class =object)))))))
(do-template [<name> <tag>]
(defn <name> [analyse exo-type class method classes object args]
@@ -228,8 +242,10 @@
: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)))))
+ _ (&type/check exo-type (as-otype+ output-type))
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta output-type _cursor
+ (&/V <tag> (&/T class method classes =object =args output-type)))))))
analyse-jvm-invokevirtual &&/$jvm-invokevirtual
analyse-jvm-invokeinterface &&/$jvm-invokeinterface
@@ -248,20 +264,26 @@
(&&/analyse-1 analyse (&type/Data$ c &/Nil$) o))
classes args)
:let [output-type =return]
- _ (&type/check exo-type (as-otype+ output-type))]
- (return (&/|list (&/T (&/V &&/$jvm-invokespecial (&/T class method classes =object =args)) output-type)))))
+ _ (&type/check exo-type (as-otype+ output-type))
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta output-type _cursor
+ (&/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)))))
+ _ (&type/check exo-type output-type)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta output-type _cursor
+ (&/V &&/$jvm-null? =object))))))
(defn analyse-jvm-null [analyse exo-type]
(|do [:let [output-type (&type/Data$ &host/null-data-tag &/Nil$)]
- _ (&type/check exo-type output-type)]
- (return (&/|list (&/T (&/V &&/$jvm-null nil) output-type)))))
+ _ (&type/check exo-type output-type)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta output-type _cursor
+ (&/V &&/$jvm-null nil))))))
(defn analyse-jvm-new [analyse exo-type class classes args]
(|do [class-loader &/loader
@@ -270,8 +292,10 @@
classes args)
_ (ensure-catching exceptions)
: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)))))
+ _ (&type/check exo-type output-type)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta output-type _cursor
+ (&/V &&/$jvm-new (&/T class classes =args)))))))
(do-template [<class> <new-name> <new-tag> <load-name> <load-tag> <store-name> <store-tag>]
(let [elem-type (&type/Data$ <class> &/Nil$)
@@ -279,19 +303,25 @@
length-type &type/Int
idx-type &type/Int]
(defn <new-name> [analyse length]
- (|do [=length (&&/analyse-1 analyse length-type length)]
- (return (&/|list (&/T (&/V <new-tag> =length) array-type)))))
+ (|do [=length (&&/analyse-1 analyse length-type length)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta array-type _cursor
+ (&/V <new-tag> =length))))))
(defn <load-name> [analyse array idx]
(|do [=array (&&/analyse-1 analyse array-type array)
- =idx (&&/analyse-1 analyse idx-type idx)]
- (return (&/|list (&/T (&/V <load-tag> (&/T =array =idx)) elem-type)))))
+ =idx (&&/analyse-1 analyse idx-type idx)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta elem-type _cursor
+ (&/V <load-tag> (&/T =array =idx)))))))
(defn <store-name> [analyse array idx elem]
(|do [=array (&&/analyse-1 analyse array-type array)
=idx (&&/analyse-1 analyse idx-type idx)
- =elem (&&/analyse-1 analyse elem-type elem)]
- (return (&/|list (&/T (&/V <store-tag> (&/T =array =idx =elem)) array-type)))))
+ =elem (&&/analyse-1 analyse elem-type elem)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta array-type _cursor
+ (&/V <store-tag> (&/T =array =idx =elem)))))))
)
"java.lang.Boolean" analyse-jvm-znewarray &&/$jvm-znewarray analyse-jvm-zaload &&/$jvm-zaload analyse-jvm-zastore &&/$jvm-zastore
@@ -309,23 +339,29 @@
(defn analyse-jvm-anewarray [analyse class length]
(let [elem-type (&type/Data$ class &/Nil$)
array-type (&type/Data$ &host/array-data-tag (&/|list elem-type))]
- (|do [=length (&&/analyse-1 analyse length-type length)]
- (return (&/|list (&/T (&/V &&/$jvm-anewarray (&/T class =length)) array-type))))))
+ (|do [=length (&&/analyse-1 analyse length-type length)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta array-type _cursor
+ (&/V &&/$jvm-anewarray (&/T class =length))))))))
(defn analyse-jvm-aaload [analyse class array idx]
(let [elem-type (&type/Data$ class &/Nil$)
array-type (&type/Data$ &host/array-data-tag (&/|list elem-type))]
(|do [=array (&&/analyse-1 analyse array-type array)
- =idx (&&/analyse-1 analyse idx-type idx)]
- (return (&/|list (&/T (&/V &&/$jvm-aaload (&/T class =array =idx)) elem-type))))))
+ =idx (&&/analyse-1 analyse idx-type idx)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta elem-type _cursor
+ (&/V &&/$jvm-aaload (&/T class =array =idx))))))))
(defn analyse-jvm-aastore [analyse class array idx elem]
(let [elem-type (&type/Data$ class &/Nil$)
array-type (&type/Data$ &host/array-data-tag (&/|list elem-type))]
(|do [=array (&&/analyse-1 analyse array-type array)
=idx (&&/analyse-1 analyse idx-type idx)
- =elem (&&/analyse-1 analyse elem-type elem)]
- (return (&/|list (&/T (&/V &&/$jvm-aastore (&/T class =array =idx =elem)) array-type)))))))
+ =elem (&&/analyse-1 analyse elem-type elem)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta array-type _cursor
+ (&/V &&/$jvm-aastore (&/T class =array =idx =elem)))))))))
(let [length-type (&type/Data$ "java.lang.Long" &/Nil$)]
(defn analyse-jvm-arraylength [analyse array]
@@ -333,8 +369,11 @@
(fn [$var]
(let [elem-type $var
array-type (&type/Data$ &host/array-data-tag (&/|list elem-type))]
- (|do [=array (&&/analyse-1 analyse array-type array)]
- (return (&/|list (&/T (&/V &&/$jvm-arraylength =array) length-type)))))))))
+ (|do [=array (&&/analyse-1 analyse array-type array)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta length-type _cursor
+ (&/V &&/$jvm-arraylength =array)
+ )))))))))
(defn ^:private analyse-modifiers [modifiers]
(&/fold% (fn [so-far modif]
@@ -492,7 +531,7 @@
(defn ^:private captured-source [env-entry]
(|case env-entry
- [name [(&&/$captured _ _ source) _]]
+ [name [_ (&&/$captured _ _ source)]]
source))
(let [captured-slot-modifier {:visibility "private"
@@ -527,8 +566,11 @@
;; :let [_ (prn 'analyse-jvm-anon-class/_5 name anon-class)]
;; _ (compile-token (&/T (&/V &&/$jvm-anon-class (&/T name super-class interfaces =captured =methods)) exo-type))
_ (compile-token (&/V &&/$jvm-class (&/T name super-class interfaces =fields =methods =captured)))
- :let [_ (println 'DEF anon-class)]]
- (return (&/|list (&/T (&/V &&/$jvm-new (&/T anon-class (&/|repeat (&/|length sources) captured-slot-type) sources)) (&type/Data$ anon-class (&/|list)))))
+ :let [_ (println 'DEF anon-class)]
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta (&type/Data$ anon-class (&/|list)) _cursor
+ (&/V &&/$jvm-new (&/T anon-class (&/|repeat (&/|length sources) captured-slot-type) sources))
+ )))
;; (analyse-jvm-new analyse exo-type anon-class (&/|repeat (&/|length sources) captured-slot-type) sources)
))))
@@ -546,20 +588,24 @@
=finally (|case ?finally
(&/$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)))))
+ (return (&/V &/$Some =finally))))
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor
+ (&/V &&/$jvm-try (&/T =body =catches =finally)))))))
(defn analyse-jvm-throw [analyse exo-type ?ex]
- (|do [=ex (&&/analyse-1 analyse (&type/Data$ "java.lang.Throwable" &/Nil$) ?ex)]
- (return (&/|list (&/T (&/V &&/$jvm-throw =ex) exo-type)))))
+ (|do [=ex (&&/analyse-1 analyse (&type/Data$ "java.lang.Throwable" &/Nil$) ?ex)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor (&/V &&/$jvm-throw =ex))))))
(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)))))
+ _ (&type/check exo-type output-type)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta output-type _cursor (&/V <tag> =monitor))))))
analyse-jvm-monitorenter &&/$jvm-monitorenter
analyse-jvm-monitorexit &&/$jvm-monitorexit
@@ -569,8 +615,9 @@
(let [output-type (&type/Data$ <to-class> &/Nil$)]
(defn <name> [analyse exo-type ?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))))))
+ _ (&type/check exo-type output-type)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta output-type _cursor (&/V <tag> =value)))))))
analyse-jvm-d2f &&/$jvm-d2f "java.lang.Double" "java.lang.Float"
analyse-jvm-d2i &&/$jvm-d2i "java.lang.Double" "java.lang.Integer"
@@ -596,8 +643,9 @@
(let [output-type (&type/Data$ <to-class> &/Nil$)]
(defn <name> [analyse exo-type ?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))))))
+ _ (&type/check exo-type output-type)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta output-type _cursor (&/V <tag> =value)))))))
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/lambda.clj b/src/lux/analyser/lambda.clj
index 819f07583..bbb5d2dc7 100644
--- a/src/lux/analyser/lambda.clj
+++ b/src/lux/analyser/lambda.clj
@@ -22,11 +22,11 @@
(return (&/T scope-name =captured =return))))))))
(defn close-over [scope name register frame]
- (|let [[_ register-type] register
- register* (&/T (&/V &&/$captured (&/T scope
- (->> frame (&/get$ &/$closure) (&/get$ &/$counter))
- register))
- register-type)]
+ (|let [[[register-type register-cursor] _] register
+ register* (&&/|meta register-type register-cursor
+ (&/V &&/$captured (&/T scope
+ (->> frame (&/get$ &/$closure) (&/get$ &/$counter))
+ register)))]
(&/T register* (&/update$ &/$closure #(->> %
(&/update$ &/$counter inc)
(&/update$ &/$mappings (fn [mps] (&/|put name register* mps))))
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 6546990e6..488b7ae4f 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -52,7 +52,7 @@
(&type/with-var
(fn [$var]
(|do [exo-type** (&type/apply-type exo-type* $var)
- [tuple-analysis tuple-type] (&&/cap-1 (analyse-tuple analyse (&/V &/$Left exo-type**) ?elems))
+ [[tuple-type tuple-cursor] tuple-analysis] (&&/cap-1 (analyse-tuple analyse (&/V &/$Left exo-type**) ?elems))
=var (&type/resolve-type $var)
inferred-type (|case =var
(&/$VarT iid)
@@ -63,7 +63,8 @@
_
(&type/clean $var tuple-type))]
- (return (&/|list (&/T tuple-analysis inferred-type))))))
+ (return (&/|list (&&/|meta inferred-type tuple-cursor
+ tuple-analysis))))))
_
(analyse-tuple analyse (&/V &/$Right exo-type*) ?elems)))
@@ -74,23 +75,28 @@
(|do [=elems (&/map% #(|do [=analysis (&&/analyse-1+ analyse %)]
(return =analysis))
?elems)
- _ (&type/check exo-type (&/V &/$TupleT (&/|map &&/expr-type* =elems)))]
- (return (&/|list (&/T (&/V &&/$tuple =elems)
- exo-type))))
+ _ (&type/check exo-type (&/V &/$TupleT (&/|map &&/expr-type* =elems)))
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor
+ (&/V &&/$tuple =elems)
+ ))))
(|do [exo-type* (&type/actual-type exo-type)]
(|case exo-type*
(&/$TupleT ?members)
(|do [=elems (&/map2% (fn [elem-t elem]
(&&/analyse-1 analyse elem-t elem))
- ?members ?elems)]
- (return (&/|list (&/T (&/V &&/$tuple =elems)
- exo-type))))
+ ?members ?elems)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor
+ (&/V &&/$tuple =elems)
+ ))))
(&/$UnivQ _)
(|do [$var &type/existential
exo-type** (&type/apply-type exo-type* $var)
- [tuple-analysis tuple-type] (&&/cap-1 (analyse-tuple analyse (&/V &/$Right exo-type**) ?elems))]
- (return (&/|list (&/T tuple-analysis exo-type))))
+ [[tuple-type tuple-cursor] tuple-analysis] (&&/cap-1 (analyse-tuple analyse (&/V &/$Right exo-type**) ?elems))]
+ (return (&/|list (&&/|meta exo-type tuple-cursor
+ tuple-analysis))))
_
(fail (str "[Analyser Error] Tuples require tuple-types: " (&type/show-type exo-type*) " " (&type/show-type exo-type) " " "[" (->> ?elems (&/|map &/show-ast) (&/|interpose " ") (&/fold str "")) "]"))
@@ -146,7 +152,7 @@
(fn [$var]
(|do [exo-type** (&type/apply-type exo-type* $var)
;; :let [_ (println 'analyse-variant/Left 2 (&type/show-type exo-type**))]
- [variant-analysis variant-type] (&&/cap-1 (analyse-variant analyse (&/V &/$Left exo-type**) idx ?values))
+ [[variant-type variant-cursor] variant-analysis] (&&/cap-1 (analyse-variant analyse (&/V &/$Left exo-type**) idx ?values))
;; :let [_ (println 'analyse-variant/Left 3 (&type/show-type variant-type))]
=var (&type/resolve-type $var)
;; :let [_ (println 'analyse-variant/Left 4 (&type/show-type =var))]
@@ -161,7 +167,8 @@
(&type/clean $var variant-type))
;; :let [_ (println 'analyse-variant/Left 5 (&type/show-type inferred-type))]
]
- (return (&/|list (&/T variant-analysis inferred-type))))))
+ (return (&/|list (&&/|meta inferred-type variant-cursor
+ variant-analysis))))))
_
(analyse-variant analyse (&/V &/$Right exo-type*) idx ?values)))
@@ -188,9 +195,11 @@
(|do [_exo-type (&type/deref+ exo-type)]
(fail (str err "\n"
'analyse-variant " " idx " " (&type/show-type exo-type) " " (&type/show-type _exo-type)
- " " (->> ?values (&/|map &/show-ast) (&/|interpose " ") (&/fold str "")))))))]
- (return (&/|list (&/T (&/V &&/$variant (&/T idx =value))
- exo-type))))
+ " " (->> ?values (&/|map &/show-ast) (&/|interpose " ") (&/fold str "")))))))
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor
+ (&/V &&/$variant (&/T idx =value))
+ ))))
(&/$None)
(fail (str "[Analyser Error] There is no case " idx " for variant type " (&type/show-type exo-type*))))
@@ -210,9 +219,10 @@
(|do [? (&type/bound? id)]
(if ?
(analyse-tuple analyse (&/V &/$Right exo-type) rec-members)
- (|do [[tuple-analysis tuple-type] (&&/cap-1 (analyse-tuple analyse (&/V &/$Left rec-type) rec-members))
+ (|do [[[tuple-type tuple-cursor] tuple-analysis] (&&/cap-1 (analyse-tuple analyse (&/V &/$Left rec-type) rec-members))
_ (&type/check exo-type tuple-type)]
- (return (&/|list (&/T tuple-analysis exo-type))))))
+ (return (&/|list (&&/|meta exo-type tuple-cursor
+ tuple-analysis))))))
_
(analyse-tuple analyse (&/V &/$Right exo-type) rec-members)
@@ -234,9 +244,11 @@
_ (if (and (clojure.lang.Util/identical &type/Type endo-type)
(clojure.lang.Util/identical &type/Type exo-type))
(return nil)
- (&type/check exo-type endo-type))]
- (return (&/|list (&/T (&/V &&/$var (&/V &/$Global (&/T r-module r-name)))
- endo-type)))))
+ (&type/check exo-type endo-type))
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta endo-type _cursor
+ (&/V &&/$var (&/V &/$Global (&/T r-module r-name)))
+ )))))
(defn ^:private analyse-local [analyse exo-type name]
(fn [state]
@@ -270,9 +282,11 @@
_ (if (and (clojure.lang.Util/identical &type/Type endo-type)
(clojure.lang.Util/identical &type/Type exo-type))
(return nil)
- (&type/check exo-type endo-type))]
- (return (&/|list (&/T (&/V &&/$var (&/V &/$Global (&/T r-module r-name)))
- endo-type))))
+ (&type/check exo-type endo-type))
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta endo-type _cursor
+ (&/V &&/$var (&/V &/$Global (&/T r-module r-name)))
+ ))))
state)
_
@@ -354,7 +368,7 @@
(defn analyse-apply [analyse exo-type form-cursor =fn ?args]
(|do [loader &/loader]
- (|let [[=fn-form =fn-type] =fn]
+ (|let [[[=fn-type =fn-cursor] =fn-form] =fn]
(|case =fn-form
(&&/$var (&/$Global ?module ?name))
(|do [[real-name $def] (&&module/find-def ?module ?name)]
@@ -363,7 +377,7 @@
(|do [;; :let [_ (prn 'MACRO-EXPAND|PRE (&/ident->text real-name))]
macro-expansion #(-> macro (.apply ?args) (.apply %))
;; :let [_ (prn 'MACRO-EXPAND|POST (&/ident->text real-name))]
- ;; :let [_ (when (or (= "invoke-interface$" (aget real-name 1))
+ ;; :let [_ (when (or (= "do" (aget real-name 1))
;; ;; (= "..?" (aget real-name 1))
;; ;; (= "try$" (aget real-name 1))
;; )
@@ -376,13 +390,15 @@
_
(|do [[=output-t =args] (analyse-apply* analyse exo-type =fn-type ?args)]
- (return (&/|list (&/T (&/V &&/$apply (&/T =fn =args))
- =output-t))))))
+ (return (&/|list (&&/|meta =output-t =fn-cursor
+ (&/V &&/$apply (&/T =fn =args))
+ ))))))
_
(|do [[=output-t =args] (analyse-apply* analyse exo-type =fn-type ?args)]
- (return (&/|list (&/T (&/V &&/$apply (&/T =fn =args))
- =output-t)))))
+ (return (&/|list (&&/|meta =output-t =fn-cursor
+ (&/V &&/$apply (&/T =fn =args))
+ )))))
)))
(defn analyse-case [analyse exo-type ?value ?branches]
@@ -390,9 +406,11 @@
_ (&/assert! (> num-branches 0) "[Analyser Error] Can't have empty branches in \"case'\" expression.")
_ (&/assert! (even? num-branches) "[Analyser Error] Unbalanced branches in \"case'\" expression.")
=value (&&/analyse-1+ analyse ?value)
- =match (&&case/analyse-branches analyse exo-type (&&/expr-type* =value) (&/|as-pairs ?branches))]
- (return (&/|list (&/T (&/V &&/$case (&/T =value =match))
- exo-type)))))
+ =match (&&case/analyse-branches analyse exo-type (&&/expr-type* =value) (&/|as-pairs ?branches))
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor
+ (&/V &&/$case (&/T =value =match))
+ )))))
(defn analyse-lambda* [analyse exo-type ?self ?arg ?body]
(|case exo-type
@@ -406,7 +424,7 @@
(fn [$input]
(&type/with-var
(fn [$output]
- (|do [[lambda-analysis lambda-type] (analyse-lambda* analyse (&type/Lambda$ $input $output) ?self ?arg ?body)
+ (|do [[[lambda-type lambda-cursor] lambda-analysis] (analyse-lambda* analyse (&type/Lambda$ $input $output) ?self ?arg ?body)
=input (&type/resolve-type $input)
=output (&type/resolve-type $output)
inferred-type (|case =input
@@ -421,9 +439,9 @@
(|do [=output* (&type/clean $input =output)
=output** (&type/clean $output =output*)]
(return (embed-inferred-input =input =output**))))
- _ (&type/check exo-type inferred-type)
- ]
- (return (&/T lambda-analysis inferred-type)))
+ _ (&type/check exo-type inferred-type)]
+ (return (&&/|meta inferred-type lambda-cursor
+ lambda-analysis)))
))))))
_
@@ -437,8 +455,10 @@
(&/$LambdaT ?arg-t ?return-t)
(|do [[=scope =captured =body] (&&lambda/with-lambda ?self exo-type*
?arg ?arg-t
- (&&/analyse-1 analyse ?return-t ?body))]
- (return (&/T (&/V &&/$lambda (&/T =scope =captured =body)) exo-type*)))
+ (&&/analyse-1 analyse ?return-t ?body))
+ _cursor &/cursor]
+ (return (&&/|meta exo-type* _cursor
+ (&/V &&/$lambda (&/T =scope =captured =body)))))
@@ -452,9 +472,10 @@
(&/$UnivQ _)
(|do [$var &type/existential
exo-type* (&type/apply-type exo-type $var)
- [_expr _] (analyse-lambda** analyse exo-type* ?self ?arg ?body)]
- (return (&/T _expr exo-type)))
-
+ [_ _expr] (analyse-lambda** analyse exo-type* ?self ?arg ?body)
+ _cursor &/cursor]
+ (return (&&/|meta exo-type _cursor _expr)))
+
(&/$VarT id)
(|do [? (&type/bound? id)]
(if ?
@@ -484,7 +505,7 @@
(|do [=value (&/with-scope ?name
(&&/analyse-1+ analyse ?value))]
(|case =value
- [(&&/$var (&/$Global ?r-module ?r-name)) _]
+ [_ (&&/$var (&/$Global ?r-module ?r-name))]
(|do [_ (&&module/def-alias module-name ?name ?r-module ?r-name (&&/expr-type* =value))
;; :let [_ (println 'analyse-def/ALIAS (str module-name ";" ?name) '=> (str ?r-module ";" ?r-name))
;; _ (println)]
@@ -501,7 +522,7 @@
;; (return nil))
;; (return nil))
:let [;; _ (println 'DEF/COMPILED (str module-name ";" ?name))
- [def-analysis def-type] =value
+ [[def-type def-cursor] def-analysis] =value
_ (println 'DEF (str module-name ";" ?name) ;; (&type/show-type def-type)
)]]
(return &/Nil$))))
@@ -533,8 +554,7 @@
(return nil))]
(&/save-module
(|do [already-compiled? (&&module/exists? path)
- ;; :let [_ (prn 'analyse-import module-name path
- ;; already-compiled?)]
+ ;; :let [_ (prn 'analyse-import module-name path already-compiled?)]
active? (&/active-module? path)
_ (&/assert! (not active?) (str "[Analyser Error] Can't import a module that is mid-compilation: " path " @ " module-name))
_ (&&module/add-import path)
@@ -554,15 +574,22 @@
(defn analyse-check [analyse eval! exo-type ?type ?value]
(|do [=type (&&/analyse-1 analyse &type/Type ?type)
==type (eval! =type)
+ ;; :let [_ (prn 'analyse-check/_0 (&type/show-type ==type))]
_ (&type/check exo-type ==type)
- =value (&&/analyse-1 analyse ==type ?value)]
- (return (&/|list (&/T (&/V &&/$ann (&/T =value =type))
- ==type)))))
+ =value (&&/analyse-1 analyse ==type ?value)
+ ;; :let [_ (prn 'analyse-check/_1 (&/adt->text =value))]
+ _cursor &/cursor
+ ]
+ (return (&/|list (&&/|meta ==type _cursor
+ (&/V &&/$ann (&/T =value =type))
+ )))))
(defn analyse-coerce [analyse eval! exo-type ?type ?value]
(|do [=type (&&/analyse-1 analyse &type/Type ?type)
==type (eval! =type)
_ (&type/check exo-type ==type)
- =value (&&/analyse-1+ analyse ?value)]
- (return (&/|list (&/T (&/V &&/$ann (&/T =value =type))
- ==type)))))
+ =value (&&/analyse-1+ analyse ?value)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta ==type _cursor
+ (&/V &&/$ann (&/T =value =type))
+ )))))
diff --git a/src/lux/base.clj b/src/lux/base.clj
index e57cb0957..19f236ce1 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -132,6 +132,8 @@
(def Nil$ (V $Nil nil))
(defn Cons$ [h t] (V $Cons (T h t)))
+(def empty-cursor (T "" -1 -1))
+
(defn get$ [slot ^objects record]
(aget record slot))
@@ -792,6 +794,11 @@
_
output)))))
+(def cursor
+ ;; (Lux Cursor)
+ (fn [state]
+ (return* state (get$ $cursor state))))
+
(defn show-ast [ast]
;; (prn 'show-ast/GOOD (aget ast 0) (aget ast 1 1 0))
(|case ast
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 048b9ee1d..d89684bcc 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -35,374 +35,388 @@
MethodVisitor)))
;; [Utils/Compilers]
+(def ^:private !source->last-line (atom nil))
+
(defn ^:private compile-expression [syntax]
- (|let [[?form ?type] syntax]
- (|case ?form
- (&a/$bool ?value)
- (&&lux/compile-bool compile-expression ?type ?value)
-
- (&a/$int ?value)
- (&&lux/compile-int compile-expression ?type ?value)
-
- (&a/$real ?value)
- (&&lux/compile-real compile-expression ?type ?value)
-
- (&a/$char ?value)
- (&&lux/compile-char compile-expression ?type ?value)
-
- (&a/$text ?value)
- (&&lux/compile-text compile-expression ?type ?value)
-
- (&a/$tuple ?elems)
- (&&lux/compile-tuple compile-expression ?type ?elems)
-
- (&a/$var (&/$Local ?idx))
- (&&lux/compile-local compile-expression ?type ?idx)
-
- (&a/$captured ?scope ?captured-id ?source)
- (&&lux/compile-captured compile-expression ?type ?scope ?captured-id ?source)
-
- (&a/$var (&/$Global ?owner-class ?name))
- (&&lux/compile-global compile-expression ?type ?owner-class ?name)
-
- (&a/$apply ?fn ?args)
- (&&lux/compile-apply compile-expression ?type ?fn ?args)
-
- (&a/$variant ?tag ?members)
- (&&lux/compile-variant compile-expression ?type ?tag ?members)
-
- (&a/$case ?value ?match)
- (&&case/compile-case compile-expression ?type ?value ?match)
-
- (&a/$lambda ?scope ?env ?body)
- (&&lambda/compile-lambda compile-expression ?scope ?env ?body)
-
- (&a/$ann ?value-ex ?type-ex)
- (&&lux/compile-ann compile-expression ?type ?value-ex ?type-ex)
-
- ;; Characters
- (&a/$jvm-ceq ?x ?y)
- (&&host/compile-jvm-ceq compile-expression ?type ?x ?y)
-
- (&a/$jvm-clt ?x ?y)
- (&&host/compile-jvm-clt compile-expression ?type ?x ?y)
-
- (&a/$jvm-cgt ?x ?y)
- (&&host/compile-jvm-cgt compile-expression ?type ?x ?y)
-
- ;; Integer arithmetic
- (&a/$jvm-iadd ?x ?y)
- (&&host/compile-jvm-iadd compile-expression ?type ?x ?y)
-
- (&a/$jvm-isub ?x ?y)
- (&&host/compile-jvm-isub compile-expression ?type ?x ?y)
-
- (&a/$jvm-imul ?x ?y)
- (&&host/compile-jvm-imul compile-expression ?type ?x ?y)
-
- (&a/$jvm-idiv ?x ?y)
- (&&host/compile-jvm-idiv compile-expression ?type ?x ?y)
-
- (&a/$jvm-irem ?x ?y)
- (&&host/compile-jvm-irem compile-expression ?type ?x ?y)
-
- (&a/$jvm-ieq ?x ?y)
- (&&host/compile-jvm-ieq compile-expression ?type ?x ?y)
-
- (&a/$jvm-ilt ?x ?y)
- (&&host/compile-jvm-ilt compile-expression ?type ?x ?y)
-
- (&a/$jvm-igt ?x ?y)
- (&&host/compile-jvm-igt compile-expression ?type ?x ?y)
-
- ;; Long arithmetic
- (&a/$jvm-ladd ?x ?y)
- (&&host/compile-jvm-ladd compile-expression ?type ?x ?y)
-
- (&a/$jvm-lsub ?x ?y)
- (&&host/compile-jvm-lsub compile-expression ?type ?x ?y)
-
- (&a/$jvm-lmul ?x ?y)
- (&&host/compile-jvm-lmul compile-expression ?type ?x ?y)
-
- (&a/$jvm-ldiv ?x ?y)
- (&&host/compile-jvm-ldiv compile-expression ?type ?x ?y)
-
- (&a/$jvm-lrem ?x ?y)
- (&&host/compile-jvm-lrem compile-expression ?type ?x ?y)
-
- (&a/$jvm-leq ?x ?y)
- (&&host/compile-jvm-leq compile-expression ?type ?x ?y)
-
- (&a/$jvm-llt ?x ?y)
- (&&host/compile-jvm-llt compile-expression ?type ?x ?y)
-
- (&a/$jvm-lgt ?x ?y)
- (&&host/compile-jvm-lgt compile-expression ?type ?x ?y)
-
- ;; Float arithmetic
- (&a/$jvm-fadd ?x ?y)
- (&&host/compile-jvm-fadd compile-expression ?type ?x ?y)
-
- (&a/$jvm-fsub ?x ?y)
- (&&host/compile-jvm-fsub compile-expression ?type ?x ?y)
-
- (&a/$jvm-fmul ?x ?y)
- (&&host/compile-jvm-fmul compile-expression ?type ?x ?y)
-
- (&a/$jvm-fdiv ?x ?y)
- (&&host/compile-jvm-fdiv compile-expression ?type ?x ?y)
-
- (&a/$jvm-frem ?x ?y)
- (&&host/compile-jvm-frem compile-expression ?type ?x ?y)
-
- (&a/$jvm-feq ?x ?y)
- (&&host/compile-jvm-feq compile-expression ?type ?x ?y)
-
- (&a/$jvm-flt ?x ?y)
- (&&host/compile-jvm-flt compile-expression ?type ?x ?y)
-
- (&a/$jvm-fgt ?x ?y)
- (&&host/compile-jvm-fgt compile-expression ?type ?x ?y)
-
- ;; Double arithmetic
- (&a/$jvm-dadd ?x ?y)
- (&&host/compile-jvm-dadd compile-expression ?type ?x ?y)
-
- (&a/$jvm-dsub ?x ?y)
- (&&host/compile-jvm-dsub compile-expression ?type ?x ?y)
-
- (&a/$jvm-dmul ?x ?y)
- (&&host/compile-jvm-dmul compile-expression ?type ?x ?y)
-
- (&a/$jvm-ddiv ?x ?y)
- (&&host/compile-jvm-ddiv compile-expression ?type ?x ?y)
-
- (&a/$jvm-drem ?x ?y)
- (&&host/compile-jvm-drem compile-expression ?type ?x ?y)
-
- (&a/$jvm-deq ?x ?y)
- (&&host/compile-jvm-deq compile-expression ?type ?x ?y)
-
- (&a/$jvm-dlt ?x ?y)
- (&&host/compile-jvm-dlt compile-expression ?type ?x ?y)
-
- (&a/$jvm-dgt ?x ?y)
- (&&host/compile-jvm-dgt compile-expression ?type ?x ?y)
-
- (&a/$jvm-null _)
- (&&host/compile-jvm-null compile-expression ?type)
-
- (&a/$jvm-null? ?object)
- (&&host/compile-jvm-null? compile-expression ?type ?object)
-
- (&a/$jvm-new ?class ?classes ?args)
- (&&host/compile-jvm-new compile-expression ?type ?class ?classes ?args)
-
- (&a/$jvm-getstatic ?class ?field)
- (&&host/compile-jvm-getstatic compile-expression ?type ?class ?field)
+ ;; (prn 'compile-expression (&/adt->text syntax))
+ (|let [[[?type [_file-name _line _column]] ?form] syntax]
+ (|do [^MethodVisitor *writer* &/get-writer
+ :let [debug-label (new Label)
+ _ (when (not= _line (get @!source->last-line _file-name))
+ (doto *writer*
+ (.visitLabel debug-label)
+ (.visitLineNumber (int _line) debug-label))
+ (swap! !source->last-line assoc _file-name _line))]]
+ (|case ?form
+ (&a/$bool ?value)
+ (&&lux/compile-bool compile-expression ?value)
+
+ (&a/$int ?value)
+ (do ;; (prn 'compile-expression (&/adt->text syntax))
+ (&&lux/compile-int compile-expression ?value))
+
+ (&a/$real ?value)
+ (&&lux/compile-real compile-expression ?value)
+
+ (&a/$char ?value)
+ (&&lux/compile-char compile-expression ?value)
+
+ (&a/$text ?value)
+ (&&lux/compile-text compile-expression ?value)
+
+ (&a/$tuple ?elems)
+ (&&lux/compile-tuple compile-expression ?elems)
+
+ (&a/$var (&/$Local ?idx))
+ (&&lux/compile-local compile-expression ?idx)
+
+ (&a/$captured ?scope ?captured-id ?source)
+ (&&lux/compile-captured compile-expression ?scope ?captured-id ?source)
+
+ (&a/$var (&/$Global ?owner-class ?name))
+ (&&lux/compile-global compile-expression ?owner-class ?name)
+
+ (&a/$apply ?fn ?args)
+ (&&lux/compile-apply compile-expression ?fn ?args)
+
+ (&a/$variant ?tag ?members)
+ (&&lux/compile-variant compile-expression ?tag ?members)
+
+ (&a/$case ?value ?match)
+ (&&case/compile-case compile-expression ?value ?match)
+
+ (&a/$lambda ?scope ?env ?body)
+ (&&lambda/compile-lambda compile-expression ?scope ?env ?body)
+
+ (&a/$ann ?value-ex ?type-ex)
+ (&&lux/compile-ann compile-expression ?value-ex ?type-ex)
+
+ ;; Characters
+ (&a/$jvm-ceq ?x ?y)
+ (&&host/compile-jvm-ceq compile-expression ?x ?y)
+
+ (&a/$jvm-clt ?x ?y)
+ (&&host/compile-jvm-clt compile-expression ?x ?y)
+
+ (&a/$jvm-cgt ?x ?y)
+ (&&host/compile-jvm-cgt compile-expression ?x ?y)
+
+ ;; Integer arithmetic
+ (&a/$jvm-iadd ?x ?y)
+ (&&host/compile-jvm-iadd compile-expression ?x ?y)
+
+ (&a/$jvm-isub ?x ?y)
+ (&&host/compile-jvm-isub compile-expression ?x ?y)
+
+ (&a/$jvm-imul ?x ?y)
+ (&&host/compile-jvm-imul compile-expression ?x ?y)
+
+ (&a/$jvm-idiv ?x ?y)
+ (&&host/compile-jvm-idiv compile-expression ?x ?y)
+
+ (&a/$jvm-irem ?x ?y)
+ (&&host/compile-jvm-irem compile-expression ?x ?y)
+
+ (&a/$jvm-ieq ?x ?y)
+ (&&host/compile-jvm-ieq compile-expression ?x ?y)
+
+ (&a/$jvm-ilt ?x ?y)
+ (&&host/compile-jvm-ilt compile-expression ?x ?y)
+
+ (&a/$jvm-igt ?x ?y)
+ (&&host/compile-jvm-igt compile-expression ?x ?y)
+
+ ;; Long arithmetic
+ (&a/$jvm-ladd ?x ?y)
+ (&&host/compile-jvm-ladd compile-expression ?x ?y)
+
+ (&a/$jvm-lsub ?x ?y)
+ (&&host/compile-jvm-lsub compile-expression ?x ?y)
+
+ (&a/$jvm-lmul ?x ?y)
+ (&&host/compile-jvm-lmul compile-expression ?x ?y)
+
+ (&a/$jvm-ldiv ?x ?y)
+ (&&host/compile-jvm-ldiv compile-expression ?x ?y)
+
+ (&a/$jvm-lrem ?x ?y)
+ (&&host/compile-jvm-lrem compile-expression ?x ?y)
+
+ (&a/$jvm-leq ?x ?y)
+ (&&host/compile-jvm-leq compile-expression ?x ?y)
+
+ (&a/$jvm-llt ?x ?y)
+ (&&host/compile-jvm-llt compile-expression ?x ?y)
+
+ (&a/$jvm-lgt ?x ?y)
+ (&&host/compile-jvm-lgt compile-expression ?x ?y)
+
+ ;; Float arithmetic
+ (&a/$jvm-fadd ?x ?y)
+ (&&host/compile-jvm-fadd compile-expression ?x ?y)
+
+ (&a/$jvm-fsub ?x ?y)
+ (&&host/compile-jvm-fsub compile-expression ?x ?y)
+
+ (&a/$jvm-fmul ?x ?y)
+ (&&host/compile-jvm-fmul compile-expression ?x ?y)
+
+ (&a/$jvm-fdiv ?x ?y)
+ (&&host/compile-jvm-fdiv compile-expression ?x ?y)
+
+ (&a/$jvm-frem ?x ?y)
+ (&&host/compile-jvm-frem compile-expression ?x ?y)
+
+ (&a/$jvm-feq ?x ?y)
+ (&&host/compile-jvm-feq compile-expression ?x ?y)
+
+ (&a/$jvm-flt ?x ?y)
+ (&&host/compile-jvm-flt compile-expression ?x ?y)
+
+ (&a/$jvm-fgt ?x ?y)
+ (&&host/compile-jvm-fgt compile-expression ?x ?y)
+
+ ;; Double arithmetic
+ (&a/$jvm-dadd ?x ?y)
+ (&&host/compile-jvm-dadd compile-expression ?x ?y)
+
+ (&a/$jvm-dsub ?x ?y)
+ (&&host/compile-jvm-dsub compile-expression ?x ?y)
+
+ (&a/$jvm-dmul ?x ?y)
+ (&&host/compile-jvm-dmul compile-expression ?x ?y)
+
+ (&a/$jvm-ddiv ?x ?y)
+ (&&host/compile-jvm-ddiv compile-expression ?x ?y)
+
+ (&a/$jvm-drem ?x ?y)
+ (&&host/compile-jvm-drem compile-expression ?x ?y)
+
+ (&a/$jvm-deq ?x ?y)
+ (&&host/compile-jvm-deq compile-expression ?x ?y)
+
+ (&a/$jvm-dlt ?x ?y)
+ (&&host/compile-jvm-dlt compile-expression ?x ?y)
+
+ (&a/$jvm-dgt ?x ?y)
+ (&&host/compile-jvm-dgt compile-expression ?x ?y)
+
+ (&a/$jvm-null _)
+ (&&host/compile-jvm-null compile-expression)
+
+ (&a/$jvm-null? ?object)
+ (&&host/compile-jvm-null? compile-expression ?object)
+
+ (&a/$jvm-new ?class ?classes ?args)
+ (&&host/compile-jvm-new compile-expression ?class ?classes ?args)
+
+ (&a/$jvm-getstatic ?class ?field ?output-type)
+ (&&host/compile-jvm-getstatic compile-expression ?class ?field ?output-type)
+
+ (&a/$jvm-getfield ?class ?field ?object ?output-type)
+ (&&host/compile-jvm-getfield compile-expression ?class ?field ?object ?output-type)
- (&a/$jvm-getfield ?class ?field ?object)
- (&&host/compile-jvm-getfield compile-expression ?type ?class ?field ?object)
+ (&a/$jvm-putstatic ?class ?field ?value ?output-type)
+ (&&host/compile-jvm-putstatic compile-expression ?class ?field ?value)
- (&a/$jvm-putstatic ?class ?field ?value)
- (&&host/compile-jvm-putstatic compile-expression ?type ?class ?field ?value)
+ (&a/$jvm-putfield ?class ?field ?value ?object ?output-type)
+ (&&host/compile-jvm-putfield compile-expression ?class ?field ?object ?value)
- (&a/$jvm-putfield ?class ?field ?object ?value)
- (&&host/compile-jvm-putfield compile-expression ?type ?class ?field ?object ?value)
+ (&a/$jvm-invokestatic ?class ?method ?classes ?args ?output-type)
+ (&&host/compile-jvm-invokestatic compile-expression ?class ?method ?classes ?args ?output-type)
- (&a/$jvm-invokestatic ?class ?method ?classes ?args)
- (&&host/compile-jvm-invokestatic compile-expression ?type ?class ?method ?classes ?args)
+ (&a/$jvm-invokevirtual ?class ?method ?classes ?object ?args ?output-type)
+ (&&host/compile-jvm-invokevirtual compile-expression ?class ?method ?classes ?object ?args ?output-type)
- (&a/$jvm-invokevirtual ?class ?method ?classes ?object ?args)
- (&&host/compile-jvm-invokevirtual compile-expression ?type ?class ?method ?classes ?object ?args)
+ (&a/$jvm-invokeinterface ?class ?method ?classes ?object ?args ?output-type)
+ (&&host/compile-jvm-invokeinterface compile-expression ?class ?method ?classes ?object ?args ?output-type)
- (&a/$jvm-invokeinterface ?class ?method ?classes ?object ?args)
- (&&host/compile-jvm-invokeinterface compile-expression ?type ?class ?method ?classes ?object ?args)
+ (&a/$jvm-invokespecial ?class ?method ?classes ?object ?args ?output-type)
+ (&&host/compile-jvm-invokespecial compile-expression ?class ?method ?classes ?object ?args ?output-type)
+
+ (&a/$jvm-znewarray ?length)
+ (&&host/compile-jvm-znewarray compile-expression ?length)
- (&a/$jvm-invokespecial ?class ?method ?classes ?object ?args)
- (&&host/compile-jvm-invokespecial compile-expression ?type ?class ?method ?classes ?object ?args)
-
- (&a/$jvm-znewarray ?length)
- (&&host/compile-jvm-znewarray compile-expression ?type ?length)
+ (&a/$jvm-zastore ?array ?idx ?elem)
+ (&&host/compile-jvm-zastore compile-expression ?array ?idx ?elem)
- (&a/$jvm-zastore ?array ?idx ?elem)
- (&&host/compile-jvm-zastore compile-expression ?type ?array ?idx ?elem)
+ (&a/$jvm-zaload ?array ?idx)
+ (&&host/compile-jvm-zaload compile-expression ?array ?idx)
- (&a/$jvm-zaload ?array ?idx)
- (&&host/compile-jvm-zaload compile-expression ?type ?array ?idx)
+ (&a/$jvm-bnewarray ?length)
+ (&&host/compile-jvm-bnewarray compile-expression ?length)
- (&a/$jvm-bnewarray ?length)
- (&&host/compile-jvm-bnewarray compile-expression ?type ?length)
+ (&a/$jvm-bastore ?array ?idx ?elem)
+ (&&host/compile-jvm-bastore compile-expression ?array ?idx ?elem)
- (&a/$jvm-bastore ?array ?idx ?elem)
- (&&host/compile-jvm-bastore compile-expression ?type ?array ?idx ?elem)
+ (&a/$jvm-baload ?array ?idx)
+ (&&host/compile-jvm-baload compile-expression ?array ?idx)
- (&a/$jvm-baload ?array ?idx)
- (&&host/compile-jvm-baload compile-expression ?type ?array ?idx)
+ (&a/$jvm-snewarray ?length)
+ (&&host/compile-jvm-snewarray compile-expression ?length)
- (&a/$jvm-snewarray ?length)
- (&&host/compile-jvm-snewarray compile-expression ?type ?length)
+ (&a/$jvm-sastore ?array ?idx ?elem)
+ (&&host/compile-jvm-sastore compile-expression ?array ?idx ?elem)
- (&a/$jvm-sastore ?array ?idx ?elem)
- (&&host/compile-jvm-sastore compile-expression ?type ?array ?idx ?elem)
+ (&a/$jvm-saload ?array ?idx)
+ (&&host/compile-jvm-saload compile-expression ?array ?idx)
- (&a/$jvm-saload ?array ?idx)
- (&&host/compile-jvm-saload compile-expression ?type ?array ?idx)
+ (&a/$jvm-inewarray ?length)
+ (&&host/compile-jvm-inewarray compile-expression ?length)
- (&a/$jvm-inewarray ?length)
- (&&host/compile-jvm-inewarray compile-expression ?type ?length)
+ (&a/$jvm-iastore ?array ?idx ?elem)
+ (&&host/compile-jvm-iastore compile-expression ?array ?idx ?elem)
- (&a/$jvm-iastore ?array ?idx ?elem)
- (&&host/compile-jvm-iastore compile-expression ?type ?array ?idx ?elem)
+ (&a/$jvm-iaload ?array ?idx)
+ (&&host/compile-jvm-iaload compile-expression ?array ?idx)
- (&a/$jvm-iaload ?array ?idx)
- (&&host/compile-jvm-iaload compile-expression ?type ?array ?idx)
+ (&a/$jvm-lnewarray ?length)
+ (&&host/compile-jvm-lnewarray compile-expression ?length)
- (&a/$jvm-lnewarray ?length)
- (&&host/compile-jvm-lnewarray compile-expression ?type ?length)
+ (&a/$jvm-lastore ?array ?idx ?elem)
+ (&&host/compile-jvm-lastore compile-expression ?array ?idx ?elem)
- (&a/$jvm-lastore ?array ?idx ?elem)
- (&&host/compile-jvm-lastore compile-expression ?type ?array ?idx ?elem)
+ (&a/$jvm-laload ?array ?idx)
+ (&&host/compile-jvm-laload compile-expression ?array ?idx)
- (&a/$jvm-laload ?array ?idx)
- (&&host/compile-jvm-laload compile-expression ?type ?array ?idx)
+ (&a/$jvm-fnewarray ?length)
+ (&&host/compile-jvm-fnewarray compile-expression ?length)
- (&a/$jvm-fnewarray ?length)
- (&&host/compile-jvm-fnewarray compile-expression ?type ?length)
+ (&a/$jvm-fastore ?array ?idx ?elem)
+ (&&host/compile-jvm-fastore compile-expression ?array ?idx ?elem)
- (&a/$jvm-fastore ?array ?idx ?elem)
- (&&host/compile-jvm-fastore compile-expression ?type ?array ?idx ?elem)
+ (&a/$jvm-faload ?array ?idx)
+ (&&host/compile-jvm-faload compile-expression ?array ?idx)
- (&a/$jvm-faload ?array ?idx)
- (&&host/compile-jvm-faload compile-expression ?type ?array ?idx)
+ (&a/$jvm-dnewarray ?length)
+ (&&host/compile-jvm-dnewarray compile-expression ?length)
- (&a/$jvm-dnewarray ?length)
- (&&host/compile-jvm-dnewarray compile-expression ?type ?length)
+ (&a/$jvm-dastore ?array ?idx ?elem)
+ (&&host/compile-jvm-dastore compile-expression ?array ?idx ?elem)
- (&a/$jvm-dastore ?array ?idx ?elem)
- (&&host/compile-jvm-dastore compile-expression ?type ?array ?idx ?elem)
+ (&a/$jvm-daload ?array ?idx)
+ (&&host/compile-jvm-daload compile-expression ?array ?idx)
- (&a/$jvm-daload ?array ?idx)
- (&&host/compile-jvm-daload compile-expression ?type ?array ?idx)
+ (&a/$jvm-cnewarray ?length)
+ (&&host/compile-jvm-cnewarray compile-expression ?length)
- (&a/$jvm-cnewarray ?length)
- (&&host/compile-jvm-cnewarray compile-expression ?type ?length)
+ (&a/$jvm-castore ?array ?idx ?elem)
+ (&&host/compile-jvm-castore compile-expression ?array ?idx ?elem)
- (&a/$jvm-castore ?array ?idx ?elem)
- (&&host/compile-jvm-castore compile-expression ?type ?array ?idx ?elem)
+ (&a/$jvm-caload ?array ?idx)
+ (&&host/compile-jvm-caload compile-expression ?array ?idx)
- (&a/$jvm-caload ?array ?idx)
- (&&host/compile-jvm-caload compile-expression ?type ?array ?idx)
+ (&a/$jvm-anewarray ?class ?length)
+ (&&host/compile-jvm-anewarray compile-expression ?class ?length)
- (&a/$jvm-anewarray ?class ?length)
- (&&host/compile-jvm-anewarray compile-expression ?type ?class ?length)
+ (&a/$jvm-aastore ?class ?array ?idx ?elem)
+ (&&host/compile-jvm-aastore compile-expression ?class ?array ?idx ?elem)
- (&a/$jvm-aastore ?class ?array ?idx ?elem)
- (&&host/compile-jvm-aastore compile-expression ?type ?class ?array ?idx ?elem)
+ (&a/$jvm-aaload ?class ?array ?idx)
+ (&&host/compile-jvm-aaload compile-expression ?class ?array ?idx)
- (&a/$jvm-aaload ?class ?array ?idx)
- (&&host/compile-jvm-aaload compile-expression ?type ?class ?array ?idx)
+ (&a/$jvm-arraylength ?array)
+ (&&host/compile-jvm-arraylength compile-expression ?array)
- (&a/$jvm-arraylength ?array)
- (&&host/compile-jvm-arraylength compile-expression ?type ?array)
+ (&a/$jvm-try ?body ?catches ?finally)
+ (&&host/compile-jvm-try compile-expression ?body ?catches ?finally)
- (&a/$jvm-try ?body ?catches ?finally)
- (&&host/compile-jvm-try compile-expression ?type ?body ?catches ?finally)
+ (&a/$jvm-throw ?ex)
+ (&&host/compile-jvm-throw compile-expression ?ex)
- (&a/$jvm-throw ?ex)
- (&&host/compile-jvm-throw compile-expression ?type ?ex)
+ (&a/$jvm-monitorenter ?monitor)
+ (&&host/compile-jvm-monitorenter compile-expression ?monitor)
- (&a/$jvm-monitorenter ?monitor)
- (&&host/compile-jvm-monitorenter compile-expression ?type ?monitor)
+ (&a/$jvm-monitorexit ?monitor)
+ (&&host/compile-jvm-monitorexit compile-expression ?monitor)
- (&a/$jvm-monitorexit ?monitor)
- (&&host/compile-jvm-monitorexit compile-expression ?type ?monitor)
+ (&a/$jvm-d2f ?value)
+ (&&host/compile-jvm-d2f compile-expression ?value)
- (&a/$jvm-d2f ?value)
- (&&host/compile-jvm-d2f compile-expression ?type ?value)
+ (&a/$jvm-d2i ?value)
+ (&&host/compile-jvm-d2i compile-expression ?value)
- (&a/$jvm-d2i ?value)
- (&&host/compile-jvm-d2i compile-expression ?type ?value)
+ (&a/$jvm-d2l ?value)
+ (&&host/compile-jvm-d2l compile-expression ?value)
+
+ (&a/$jvm-f2d ?value)
+ (&&host/compile-jvm-f2d compile-expression ?value)
- (&a/$jvm-d2l ?value)
- (&&host/compile-jvm-d2l compile-expression ?type ?value)
-
- (&a/$jvm-f2d ?value)
- (&&host/compile-jvm-f2d compile-expression ?type ?value)
+ (&a/$jvm-f2i ?value)
+ (&&host/compile-jvm-f2i compile-expression ?value)
- (&a/$jvm-f2i ?value)
- (&&host/compile-jvm-f2i compile-expression ?type ?value)
+ (&a/$jvm-f2l ?value)
+ (&&host/compile-jvm-f2l compile-expression ?value)
+
+ (&a/$jvm-i2b ?value)
+ (&&host/compile-jvm-i2b compile-expression ?value)
- (&a/$jvm-f2l ?value)
- (&&host/compile-jvm-f2l compile-expression ?type ?value)
-
- (&a/$jvm-i2b ?value)
- (&&host/compile-jvm-i2b compile-expression ?type ?value)
+ (&a/$jvm-i2c ?value)
+ (&&host/compile-jvm-i2c compile-expression ?value)
- (&a/$jvm-i2c ?value)
- (&&host/compile-jvm-i2c compile-expression ?type ?value)
+ (&a/$jvm-i2d ?value)
+ (&&host/compile-jvm-i2d compile-expression ?value)
- (&a/$jvm-i2d ?value)
- (&&host/compile-jvm-i2d compile-expression ?type ?value)
+ (&a/$jvm-i2f ?value)
+ (&&host/compile-jvm-i2f compile-expression ?value)
- (&a/$jvm-i2f ?value)
- (&&host/compile-jvm-i2f compile-expression ?type ?value)
+ (&a/$jvm-i2l ?value)
+ (&&host/compile-jvm-i2l compile-expression ?value)
- (&a/$jvm-i2l ?value)
- (&&host/compile-jvm-i2l compile-expression ?type ?value)
+ (&a/$jvm-i2s ?value)
+ (&&host/compile-jvm-i2s compile-expression ?value)
- (&a/$jvm-i2s ?value)
- (&&host/compile-jvm-i2s compile-expression ?type ?value)
+ (&a/$jvm-l2d ?value)
+ (&&host/compile-jvm-l2d compile-expression ?value)
- (&a/$jvm-l2d ?value)
- (&&host/compile-jvm-l2d compile-expression ?type ?value)
+ (&a/$jvm-l2f ?value)
+ (&&host/compile-jvm-l2f compile-expression ?value)
- (&a/$jvm-l2f ?value)
- (&&host/compile-jvm-l2f compile-expression ?type ?value)
+ (&a/$jvm-l2i ?value)
+ (&&host/compile-jvm-l2i compile-expression ?value)
- (&a/$jvm-l2i ?value)
- (&&host/compile-jvm-l2i compile-expression ?type ?value)
+ (&a/$jvm-iand ?x ?y)
+ (&&host/compile-jvm-iand compile-expression ?x ?y)
- (&a/$jvm-iand ?x ?y)
- (&&host/compile-jvm-iand compile-expression ?type ?x ?y)
+ (&a/$jvm-ior ?x ?y)
+ (&&host/compile-jvm-ior compile-expression ?x ?y)
- (&a/$jvm-ior ?x ?y)
- (&&host/compile-jvm-ior compile-expression ?type ?x ?y)
+ (&a/$jvm-ixor ?x ?y)
+ (&&host/compile-jvm-ixor compile-expression ?x ?y)
- (&a/$jvm-ixor ?x ?y)
- (&&host/compile-jvm-ixor compile-expression ?type ?x ?y)
+ (&a/$jvm-ishl ?x ?y)
+ (&&host/compile-jvm-ishl compile-expression ?x ?y)
- (&a/$jvm-ishl ?x ?y)
- (&&host/compile-jvm-ishl compile-expression ?type ?x ?y)
+ (&a/$jvm-ishr ?x ?y)
+ (&&host/compile-jvm-ishr compile-expression ?x ?y)
- (&a/$jvm-ishr ?x ?y)
- (&&host/compile-jvm-ishr compile-expression ?type ?x ?y)
+ (&a/$jvm-iushr ?x ?y)
+ (&&host/compile-jvm-iushr compile-expression ?x ?y)
- (&a/$jvm-iushr ?x ?y)
- (&&host/compile-jvm-iushr compile-expression ?type ?x ?y)
+ (&a/$jvm-land ?x ?y)
+ (&&host/compile-jvm-land compile-expression ?x ?y)
- (&a/$jvm-land ?x ?y)
- (&&host/compile-jvm-land compile-expression ?type ?x ?y)
+ (&a/$jvm-lor ?x ?y)
+ (&&host/compile-jvm-lor compile-expression ?x ?y)
- (&a/$jvm-lor ?x ?y)
- (&&host/compile-jvm-lor compile-expression ?type ?x ?y)
+ (&a/$jvm-lxor ?x ?y)
+ (&&host/compile-jvm-lxor compile-expression ?x ?y)
- (&a/$jvm-lxor ?x ?y)
- (&&host/compile-jvm-lxor compile-expression ?type ?x ?y)
+ (&a/$jvm-lshl ?x ?y)
+ (&&host/compile-jvm-lshl compile-expression ?x ?y)
- (&a/$jvm-lshl ?x ?y)
- (&&host/compile-jvm-lshl compile-expression ?type ?x ?y)
+ (&a/$jvm-lshr ?x ?y)
+ (&&host/compile-jvm-lshr compile-expression ?x ?y)
- (&a/$jvm-lshr ?x ?y)
- (&&host/compile-jvm-lshr compile-expression ?type ?x ?y)
+ (&a/$jvm-lushr ?x ?y)
+ (&&host/compile-jvm-lushr compile-expression ?x ?y)
- (&a/$jvm-lushr ?x ?y)
- (&&host/compile-jvm-lushr compile-expression ?type ?x ?y)
+ (&a/$jvm-instanceof ?class ?object)
+ (&&host/compile-jvm-instanceof compile-expression ?class ?object)
- (&a/$jvm-instanceof ?class ?object)
- (&&host/compile-jvm-instanceof compile-expression ?type ?class ?object)
- )
+ _
+ (assert false (prn-str 'compile-expression (&/adt->text syntax)))
+ ))
))
(defn ^:private compile-token [syntax]
@@ -429,13 +443,15 @@
(&/with-eval
(|do [module &/get-module-name
id &/gen-id
+ [file-name _ _] &/cursor
:let [class-name (str (&host/->module-class module) "/" id)
;; _ (prn 'eval! id class-name)
=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
(.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
class-name nil "java/lang/Object" nil)
(-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) &/eval-field "Ljava/lang/Object;" nil nil)
- (doto (.visitEnd))))]
+ (doto (.visitEnd)))
+ (.visitSource file-name nil))]
_ (&/with-writer (.visitMethod =class Opcodes/ACC_PUBLIC "<clinit>" "()V" nil nil)
(|do [^MethodVisitor *writer* &/get-writer
:let [_ (.visitCode *writer*)]
@@ -475,7 +491,8 @@
(-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) &/hash-field "I" nil file-hash)
.visitEnd)
(-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) &/compiler-field "Ljava/lang/String;" nil &&/version)
- .visitEnd))
+ .visitEnd)
+ (.visitSource file-name nil))
;; _ (prn 'compile-module name =class)
]]
(fn [state]
@@ -524,6 +541,7 @@
))
(defn ^:private init! []
+ (reset! !source->last-line {})
(.mkdirs (java.io.File. &&/output-dir)))
;; [Resources]
diff --git a/src/lux/compiler/case.clj b/src/lux/compiler/case.clj
index 5f9d6cd2d..64237f3db 100644
--- a/src/lux/compiler/case.clj
+++ b/src/lux/compiler/case.clj
@@ -161,7 +161,7 @@
))
;; [Resources]
-(defn compile-case [compile *type* ?value ?matches]
+(defn compile-case [compile ?value ?matches]
(|do [^MethodVisitor *writer* &/get-writer
:let [$end (new Label)]
_ (compile ?value)
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index 2ca613633..179b5423c 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -88,7 +88,7 @@
;; [Resources]
(do-template [<name> <opcode> <wrapper-class> <value-method> <value-method-sig> <wrap>]
- (defn <name> [compile *type* ?x ?y]
+ (defn <name> [compile ?x ?y]
(|do [:let [+wrapper-class+ (&host/->class <wrapper-class>)]
^MethodVisitor *writer* &/get-writer
_ (compile ?x)
@@ -130,7 +130,7 @@
)
(do-template [<name> <opcode> <wrapper-class> <value-method> <value-method-sig>]
- (defn <name> [compile *type* ?x ?y]
+ (defn <name> [compile ?x ?y]
(|do [:let [+wrapper-class+ (&host/->class <wrapper-class>)]
^MethodVisitor *writer* &/get-writer
_ (compile ?y)
@@ -162,7 +162,7 @@
)
(do-template [<name> <cmpcode> <cmp-output> <wrapper-class> <value-method> <value-method-sig>]
- (defn <name> [compile *type* ?x ?y]
+ (defn <name> [compile ?x ?y]
(|do [:let [+wrapper-class+ (&host/->class <wrapper-class>)]
^MethodVisitor *writer* &/get-writer
_ (compile ?y)
@@ -199,9 +199,9 @@
compile-jvm-dgt Opcodes/FCMPG -1 "java.lang.Double" "doubleValue" "()D"
)
-(defn compile-jvm-invokestatic [compile *type* ?class ?method ?classes ?args]
+(defn compile-jvm-invokestatic [compile ?class ?method ?classes ?args ?output-type]
(|do [^MethodVisitor *writer* &/get-writer
- :let [method-sig (str "(" (&/fold str "" (&/|map &host/->type-signature ?classes)) ")" (&host/->java-sig *type*))]
+ :let [method-sig (str "(" (&/fold str "" (&/|map &host/->type-signature ?classes)) ")" (&host/->java-sig ?output-type))]
_ (&/map2% (fn [class-name arg]
(|do [ret (compile arg)
:let [_ (prepare-arg! *writer* class-name)]]
@@ -209,14 +209,14 @@
?classes ?args)
:let [_ (doto *writer*
(.visitMethodInsn Opcodes/INVOKESTATIC (&host/->class (&type/as-obj ?class)) ?method method-sig)
- (prepare-return! *type*))]]
+ (prepare-return! ?output-type))]]
(return nil)))
(do-template [<name> <op>]
- (defn <name> [compile *type* ?class ?method ?classes ?object ?args]
+ (defn <name> [compile ?class ?method ?classes ?object ?args ?output-type]
(|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*))]
+ :let [method-sig (str "(" (&/fold str "" (&/|map &host/->type-signature ?classes)) ")" (&host/->java-sig ?output-type))]
_ (compile ?object)
:let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST ?class*)]
_ (&/map2% (fn [class-name arg]
@@ -226,7 +226,7 @@
?classes ?args)
:let [_ (doto *writer*
(.visitMethodInsn <op> ?class* ?method method-sig)
- (prepare-return! *type*))]]
+ (prepare-return! ?output-type))]]
(return nil)))
compile-jvm-invokevirtual Opcodes/INVOKEVIRTUAL
@@ -234,10 +234,10 @@
;; compile-jvm-invokespecial Opcodes/INVOKESPECIAL
)
-(defn compile-jvm-invokespecial [compile *type* ?class ?method ?classes ?object ?args]
+(defn compile-jvm-invokespecial [compile ?class ?method ?classes ?object ?args ?output-type]
(|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*))]
+ :let [method-sig (str "(" (&/fold str "" (&/|map &host/->type-signature ?classes)) ")" (&host/->java-sig ?output-type))]
_ (compile ?object)
;; :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST ?class*)]
:let [_ (when (not= "<init>" ?method)
@@ -249,15 +249,15 @@
?classes ?args)
:let [_ (doto *writer*
(.visitMethodInsn Opcodes/INVOKESPECIAL ?class* ?method method-sig)
- (prepare-return! *type*))]]
+ (prepare-return! ?output-type))]]
(return nil)))
-(defn compile-jvm-null [compile *type*]
+(defn compile-jvm-null [compile]
(|do [^MethodVisitor *writer* &/get-writer
:let [_ (.visitInsn *writer* Opcodes/ACONST_NULL)]]
(return nil)))
-(defn compile-jvm-null? [compile *type* ?object]
+(defn compile-jvm-null? [compile ?object]
(|do [^MethodVisitor *writer* &/get-writer
_ (compile ?object)
:let [$then (new Label)
@@ -271,7 +271,7 @@
(.visitLabel $end))]]
(return nil)))
-(defn compile-jvm-new [compile *type* ?class ?classes ?args]
+(defn compile-jvm-new [compile ?class ?classes ?args]
(|do [^MethodVisitor *writer* &/get-writer
:let [init-sig (str "(" (&/fold str "" (&/|map &host/->type-signature ?classes)) ")V")
class* (&host/->class ?class)
@@ -288,14 +288,14 @@
(return nil)))
(do-template [<prim-type> <new-name> <load-name> <load-op> <store-name> <store-op> <wrapper> <unwrapper>]
- (do (defn <new-name> [compile *type* ?length]
+ (do (defn <new-name> [compile ?length]
(|do [^MethodVisitor *writer* &/get-writer
_ (compile ?length)
:let [_ (.visitInsn *writer* Opcodes/L2I)]
:let [_ (.visitIntInsn *writer* Opcodes/NEWARRAY <prim-type>)]]
(return nil)))
- (defn <load-name> [compile *type* ?array ?idx]
+ (defn <load-name> [compile ?array ?idx]
(|do [^MethodVisitor *writer* &/get-writer
_ (compile ?array)
:let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST "[Ljava/lang/Object;")]
@@ -306,7 +306,7 @@
<wrapper>)]]
(return nil)))
- (defn <store-name> [compile *type* ?array ?idx ?elem]
+ (defn <store-name> [compile ?array ?idx ?elem]
(|do [^MethodVisitor *writer* &/get-writer
_ (compile ?array)
:let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST "[Ljava/lang/Object;")]
@@ -330,14 +330,14 @@
Opcodes/T_CHAR compile-jvm-cnewarray compile-jvm-caload Opcodes/CALOAD compile-jvm-castore Opcodes/CASTORE &&/wrap-char &&/unwrap-char
)
-(defn compile-jvm-anewarray [compile *type* ?class ?length]
+(defn compile-jvm-anewarray [compile ?class ?length]
(|do [^MethodVisitor *writer* &/get-writer
_ (compile ?length)
:let [_ (.visitInsn *writer* Opcodes/L2I)]
:let [_ (.visitTypeInsn *writer* Opcodes/ANEWARRAY (&host/->class ?class))]]
(return nil)))
-(defn compile-jvm-aaload [compile *type* ?class ?array ?idx]
+(defn compile-jvm-aaload [compile ?class ?array ?idx]
(|do [^MethodVisitor *writer* &/get-writer
_ (compile ?array)
:let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST "[Ljava/lang/Object;")]
@@ -346,7 +346,7 @@
:let [_ (.visitInsn *writer* Opcodes/AALOAD)]]
(return nil)))
-(defn compile-jvm-aastore [compile *type* ?class ?array ?idx ?elem]
+(defn compile-jvm-aastore [compile ?class ?array ?idx ?elem]
(|do [^MethodVisitor *writer* &/get-writer
_ (compile ?array)
:let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST "[Ljava/lang/Object;")]
@@ -357,7 +357,7 @@
:let [_ (.visitInsn *writer* Opcodes/AASTORE)]]
(return nil)))
-(defn compile-jvm-arraylength [compile *type* ?array]
+(defn compile-jvm-arraylength [compile ?array]
(|do [^MethodVisitor *writer* &/get-writer
_ (compile ?array)
:let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST "[Ljava/lang/Object;")]
@@ -367,36 +367,38 @@
&&/wrap-long)]]
(return nil)))
-(defn compile-jvm-getstatic [compile *type* ?class ?field]
+(defn compile-jvm-getstatic [compile ?class ?field ?output-type]
(|do [^MethodVisitor *writer* &/get-writer
:let [_ (doto *writer*
- (.visitFieldInsn Opcodes/GETSTATIC (&host/->class (&type/as-obj ?class)) ?field (&host/->java-sig *type*))
- (prepare-return! *type*))]]
+ (.visitFieldInsn Opcodes/GETSTATIC (&host/->class (&type/as-obj ?class)) ?field (&host/->java-sig ?output-type))
+ (prepare-return! ?output-type))]]
(return nil)))
-(defn compile-jvm-getfield [compile *type* ?class ?field ?object]
+(defn compile-jvm-getfield [compile ?class ?field ?object ?output-type]
(|do [:let [class* (&host/->class (&type/as-obj ?class))]
^MethodVisitor *writer* &/get-writer
_ (compile ?object)
:let [_ (doto *writer*
(.visitTypeInsn Opcodes/CHECKCAST class*)
- (.visitFieldInsn Opcodes/GETFIELD class* ?field (&host/->java-sig *type*))
- (prepare-return! *type*))]]
+ (.visitFieldInsn Opcodes/GETFIELD class* ?field (&host/->java-sig ?output-type))
+ (prepare-return! ?output-type))]]
(return nil)))
-(defn compile-jvm-putstatic [compile *type* ?class ?field ?value]
+(defn compile-jvm-putstatic [compile ?class ?field ?value ?output-type]
(|do [^MethodVisitor *writer* &/get-writer
_ (compile ?value)
- :let [_ (.visitFieldInsn *writer* Opcodes/PUTSTATIC (&host/->class (&type/as-obj ?class)) ?field (&host/->java-sig *type*))]]
+ :let [_ (.visitFieldInsn *writer* Opcodes/PUTSTATIC (&host/->class (&type/as-obj ?class)) ?field (&host/->java-sig ?output-type))]
+ :let [_ (.visitInsn *writer* Opcodes/ACONST_NULL)]]
(return nil)))
-(defn compile-jvm-putfield [compile *type* ?class ?field ?object ?value]
+(defn compile-jvm-putfield [compile ?class ?field ?object ?value ?output-type]
(|do [:let [class* (&host/->class (&type/as-obj ?class))]
^MethodVisitor *writer* &/get-writer
_ (compile ?object)
+ :let [_ (.visitInsn *writer* Opcodes/DUP)]
_ (compile ?value)
:let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST class*)]
- :let [_ (.visitFieldInsn *writer* Opcodes/PUTFIELD class* ?field (&host/->java-sig *type*))]]
+ :let [_ (.visitFieldInsn *writer* Opcodes/PUTFIELD class* ?field (&host/->java-sig ?output-type))]]
(return nil)))
(defn ^:private modifiers->int [mods]
@@ -414,7 +416,7 @@
;; else
0)))
-(defn compile-jvm-instanceof [compile *type* class object]
+(defn compile-jvm-instanceof [compile class object]
(|do [:let [class* (&host/->class class)]
^MethodVisitor *writer* &/get-writer
_ (compile object)
@@ -463,7 +465,7 @@
(.visitFieldInsn Opcodes/PUTFIELD class-name captured-name clo-field-sig))
(->> (let [captured-name (str &&/closure-prefix ?captured-id)])
(|case ?name+?captured
- [?name [(&a/$captured _ ?captured-id ?source) _]])
+ [?name [_ (&a/$captured _ ?captured-id ?source)]])
(doseq [?name+?captured (&/->seq env)])))
(.visitInsn Opcodes/RETURN)
(.visitMaxs 0 0)
@@ -474,11 +476,13 @@
(|do [;; :let [_ (prn 'compile-jvm-class/_0)]
module &/get-module-name
;; :let [_ (prn 'compile-jvm-class/_1)]
+ [file-name _ _] &/cursor
:let [full-name (str module "/" ?name)
super-class* (&host/->class ?super-class)
=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
(.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
- full-name nil super-class* (->> ?interfaces (&/|map &host/->class) &/->seq (into-array String))))
+ full-name nil super-class* (->> ?interfaces (&/|map &host/->class) &/->seq (into-array String)))
+ (.visitSource file-name nil))
_ (&/|map (fn [field]
(doto (.visitField =class (modifiers->int (:modifiers field)) (:name field)
(&host/->type-signature (:type field)) nil nil)
@@ -495,15 +499,17 @@
(defn compile-jvm-interface [compile ?name ?supers ?methods]
;; (prn 'compile-jvm-interface (->> ?supers &/->seq pr-str))
- (|do [module &/get-module-name]
+ (|do [module &/get-module-name
+ [file-name _ _] &/cursor]
(let [=interface (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
(.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_INTERFACE)
- (str module "/" ?name) nil "java/lang/Object" (->> ?supers (&/|map &host/->class) &/->seq (into-array String))))
+ (str module "/" ?name) nil "java/lang/Object" (->> ?supers (&/|map &host/->class) &/->seq (into-array String)))
+ (.visitSource file-name nil))
_ (do (&/|map (partial compile-method-decl =interface) ?methods)
(.visitEnd =interface))]
(&&/save-class! ?name (.toByteArray =interface)))))
-(defn compile-jvm-try [compile *type* ?body ?catches ?finally]
+(defn compile-jvm-try [compile ?body ?catches ?finally]
(|do [^MethodVisitor *writer* &/get-writer
:let [$from (new Label)
$to (new Label)
@@ -555,14 +561,14 @@
:let [_ (.visitLabel *writer* $end)]]
(return nil)))
-(defn compile-jvm-throw [compile *type* ?ex]
+(defn compile-jvm-throw [compile ?ex]
(|do [^MethodVisitor *writer* &/get-writer
_ (compile ?ex)
:let [_ (.visitInsn *writer* Opcodes/ATHROW)]]
(return nil)))
(do-template [<name> <op>]
- (defn <name> [compile *type* ?monitor]
+ (defn <name> [compile ?monitor]
(|do [^MethodVisitor *writer* &/get-writer
_ (compile ?monitor)
:let [_ (doto *writer*
@@ -575,7 +581,7 @@
)
(do-template [<name> <op> <from-class> <from-method> <from-sig> <to-class> <to-sig>]
- (defn <name> [compile *type* ?value]
+ (defn <name> [compile ?value]
(|do [^MethodVisitor *writer* &/get-writer
:let [_ (doto *writer*
(.visitTypeInsn Opcodes/NEW (&host/->class <to-class>))
@@ -609,7 +615,7 @@
)
(do-template [<name> <op> <from1-method> <from1-sig> <from1-class> <from2-method> <from2-sig> <from2-class> <to-class> <to-sig>]
- (defn <name> [compile *type* ?x ?y]
+ (defn <name> [compile ?x ?y]
(|do [^MethodVisitor *writer* &/get-writer
:let [_ (doto *writer*
(.visitTypeInsn Opcodes/NEW (&host/->class <to-class>))
diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj
index 86bc08534..77dc316b8 100644
--- a/src/lux/compiler/lambda.clj
+++ b/src/lux/compiler/lambda.clj
@@ -44,7 +44,7 @@
(.visitFieldInsn Opcodes/PUTFIELD class-name captured-name clo-field-sig))
(->> (let [captured-name (str &&/closure-prefix ?captured-id)])
(|case ?name+?captured
- [?name [(&a/$captured _ ?captured-id ?source) _]])
+ [?name [_ (&a/$captured _ ?captured-id ?source)]])
(doseq [?name+?captured (&/->seq env)])))
(.visitInsn Opcodes/RETURN)
(.visitMaxs 0 0)
@@ -82,7 +82,7 @@
(.visitInsn Opcodes/DUP))]
_ (&/map% (fn [?name+?captured]
(|case ?name+?captured
- [?name [(&a/$captured _ _ ?source) _]]
+ [?name [_ (&a/$captured _ _ ?source)]]
(compile ?source)))
closed-over)
:let [_ (.visitMethodInsn *writer* Opcodes/INVOKESPECIAL lambda-class "<init>" init-signature)]]
@@ -93,7 +93,8 @@
datum-flags (+ Opcodes/ACC_PRIVATE Opcodes/ACC_FINAL)]
(defn compile-lambda [compile ?scope ?env ?body]
;; (prn 'compile-lambda (->> ?scope &/->seq))
- (|do [:let [name (&host/location (&/|tail ?scope))
+ (|do [[file-name _ _] &/cursor
+ :let [name (&host/location (&/|tail ?scope))
class-name (str (&host/->module-class (&/|head ?scope)) "/" name)
=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
(.visit Opcodes/V1_5 lambda-flags
@@ -102,8 +103,9 @@
(.visitEnd))
(->> (let [captured-name (str &&/closure-prefix ?captured-id)])
(|case ?name+?captured
- [?name [(&a/$captured _ ?captured-id ?source) _]])
+ [?name [_ (&a/$captured _ ?captured-id ?source)]])
(doseq [?name+?captured (&/->seq ?env)])))
+ (.visitSource file-name nil)
(add-lambda-apply class-name ?env)
(add-lambda-<init> class-name ?env)
)]
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index e85af8b0d..f7cd905e8 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -26,13 +26,13 @@
MethodVisitor)))
;; [Exports]
-(defn compile-bool [compile *type* ?value]
+(defn compile-bool [compile ?value]
(|do [^MethodVisitor *writer* &/get-writer
:let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC "java/lang/Boolean" (if ?value "TRUE" "FALSE") "Ljava/lang/Boolean;")]]
(return nil)))
(do-template [<name> <class> <sig> <caster>]
- (defn <name> [compile *type* value]
+ (defn <name> [compile value]
(|do [^MethodVisitor *writer* &/get-writer
:let [_ (doto *writer*
(.visitTypeInsn Opcodes/NEW <class>)
@@ -46,12 +46,12 @@
compile-char "java/lang/Character" "(C)V" char
)
-(defn compile-text [compile *type* ?value]
+(defn compile-text [compile ?value]
(|do [^MethodVisitor *writer* &/get-writer
:let [_ (.visitLdcInsn *writer* ?value)]]
(return nil)))
-(defn compile-tuple [compile *type* ?elems]
+(defn compile-tuple [compile ?elems]
(|do [^MethodVisitor *writer* &/get-writer
:let [num-elems (&/|length ?elems)
_ (doto *writer*
@@ -67,7 +67,7 @@
(&/|range num-elems) ?elems)]
(return nil)))
-(defn compile-variant [compile *type* ?tag ?value]
+(defn compile-variant [compile ?tag ?value]
;; (prn 'compile-variant ?tag (class ?tag))
(|do [^MethodVisitor *writer* &/get-writer
:let [_ (doto *writer*
@@ -84,12 +84,12 @@
:let [_ (.visitInsn *writer* Opcodes/AASTORE)]]
(return nil)))
-(defn compile-local [compile *type* ?idx]
+(defn compile-local [compile ?idx]
(|do [^MethodVisitor *writer* &/get-writer
:let [_ (.visitVarInsn *writer* Opcodes/ALOAD (int ?idx))]]
(return nil)))
-(defn compile-captured [compile *type* ?scope ?captured-id ?source]
+(defn compile-captured [compile ?scope ?captured-id ?source]
(|do [^MethodVisitor *writer* &/get-writer
:let [_ (doto *writer*
(.visitVarInsn Opcodes/ALOAD 0)
@@ -99,12 +99,12 @@
"Ljava/lang/Object;"))]]
(return nil)))
-(defn compile-global [compile *type* ?owner-class ?name]
+(defn compile-global [compile ?owner-class ?name]
(|do [^MethodVisitor *writer* &/get-writer
:let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (str (&host/->module-class ?owner-class) "/" (&/normalize-name ?name)) &/datum-field "Ljava/lang/Object;")]]
(return nil)))
-(defn compile-apply [compile *type* ?fn ?args]
+(defn compile-apply [compile ?fn ?args]
(|do [^MethodVisitor *writer* &/get-writer
_ (compile ?fn)
_ (&/map% (fn [?arg]
@@ -142,10 +142,10 @@
"value"
(|let [;; _ (prn '?body (aget ?body 0) (aget ?body 1 0))
?def-type (|case ?body
- [(&a/$ann ?def-value ?type-expr) ?def-type]
+ [[?def-type ?def-cursor] (&a/$ann ?def-value ?type-expr)]
?type-expr
- [?def-value ?def-type]
+ [[?def-type ?def-cursor] ?def-value]
(&&type/->analysis ?def-type))]
(|do [:let [_ (doto **writer**
(.visitLdcInsn (int 2)) ;; S
@@ -186,6 +186,7 @@
"value")]
^ClassWriter *writer* &/get-writer
module-name &/get-module-name
+ [file-name _ _] &/cursor
:let [datum-sig "Ljava/lang/Object;"
def-name (&/normalize-name ?name)
current-class (str (&host/->module-class module-name) "/" def-name)
@@ -197,7 +198,8 @@
(-> (.visitField field-flags &/datum-field datum-sig nil nil)
(doto (.visitEnd)))
(-> (.visitField field-flags &/meta-field datum-sig nil nil)
- (doto (.visitEnd))))]
+ (doto (.visitEnd)))
+ (.visitSource file-name nil))]
_ (&/with-writer (.visitMethod =class Opcodes/ACC_PUBLIC "<clinit>" "()V" nil nil)
(|do [^MethodVisitor **writer** &/get-writer
:let [_ (.visitCode **writer**)]
@@ -217,7 +219,7 @@
_ (&a-module/define module-name ?name (-> def-class (.getField &/meta-field) (.get nil)) =value-type)]
(return nil))))
-(defn compile-ann [compile *type* ?value-ex ?type-ex]
+(defn compile-ann [compile ?value-ex ?type-ex]
(compile ?value-ex))
(defn compile-declare-macro [compile module name]
diff --git a/src/lux/compiler/type.clj b/src/lux/compiler/type.clj
index 00e66410f..c1615f9b6 100644
--- a/src/lux/compiler/type.clj
+++ b/src/lux/compiler/type.clj
@@ -13,23 +13,27 @@
;; [Utils]
(defn ^:private variant$ [tag body]
"(-> Text Analysis Analysis)"
- (&/T (&/V &a/$variant (&/T tag body))
- &type/$Void))
+ (&a/|meta &type/$Void &/empty-cursor
+ (&/V &a/$variant (&/T tag body))
+ ))
(defn ^:private tuple$ [members]
"(-> (List Analysis) Analysis)"
- (&/T (&/V &a/$tuple members)
- &type/$Void))
+ (&a/|meta &type/$Void &/empty-cursor
+ (&/V &a/$tuple members)
+ ))
(defn ^:private int$ [value]
"(-> Int Analysis)"
- (&/T (&/V &a/$int value)
- &type/$Void))
+ (&a/|meta &type/$Void &/empty-cursor
+ (&/V &a/$int value)
+ ))
(defn ^:private text$ [text]
"(-> Text Analysis)"
- (&/T (&/V &a/$text text)
- &type/$Void))
+ (&a/|meta &type/$Void &/empty-cursor
+ (&/V &a/$text text)
+ ))
(def ^:private $Nil
"Analysis"
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-28 17:43:01 +0000