From 6a84a06475463ffdaf3d6512696c7577afc8fed1 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 16 Sep 2015 18:54:38 -0400 Subject: - Now the file-name & the line numbers are stored inside the .class files for debug info. --- source/lux.lux | 35 +-- source/lux/codata/lazy.lux | 7 +- source/lux/meta/lux.lux | 6 +- source/program.lux | 4 +- src/lux/analyser.clj | 43 +-- src/lux/analyser/base.clj | 19 +- src/lux/analyser/env.clj | 2 +- src/lux/analyser/host.clj | 152 +++++++---- src/lux/analyser/lambda.clj | 10 +- src/lux/analyser/lux.clj | 129 +++++---- src/lux/base.clj | 7 + src/lux/compiler.clj | 628 +++++++++++++++++++++++--------------------- src/lux/compiler/case.clj | 2 +- src/lux/compiler/host.clj | 90 ++++--- src/lux/compiler/lambda.clj | 10 +- src/lux/compiler/lux.clj | 28 +- src/lux/compiler/type.clj | 20 +- 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 [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 (&/T =x =y)) output-type)))))) + _ (&type/check exo-type output-type) + _cursor &/cursor] + (return (&/|list (&&/|meta output-type _cursor + (&/V (&/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 [ ] (defn [analyse exo-type class method classes object args] @@ -228,8 +242,10 @@ :let [output-type =return] ;; :let [_ (prn ' [class method] '=return (&type/show-type =return))] ;; :let [_ (prn ' '(as-otype+ output-type) (&type/show-type (as-otype+ output-type)))] - _ (&type/check exo-type (as-otype+ output-type))] - (return (&/|list (&/T (&/V (&/T class method classes =object =args)) output-type))))) + _ (&type/check exo-type (as-otype+ output-type)) + _cursor &/cursor] + (return (&/|list (&&/|meta output-type _cursor + (&/V (&/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 [ ] (let [elem-type (&type/Data$ &/Nil$) @@ -279,19 +303,25 @@ length-type &type/Int idx-type &type/Int] (defn [analyse length] - (|do [=length (&&/analyse-1 analyse length-type length)] - (return (&/|list (&/T (&/V =length) array-type))))) + (|do [=length (&&/analyse-1 analyse length-type length) + _cursor &/cursor] + (return (&/|list (&&/|meta array-type _cursor + (&/V =length)))))) (defn [analyse array idx] (|do [=array (&&/analyse-1 analyse array-type array) - =idx (&&/analyse-1 analyse idx-type idx)] - (return (&/|list (&/T (&/V (&/T =array =idx)) elem-type))))) + =idx (&&/analyse-1 analyse idx-type idx) + _cursor &/cursor] + (return (&/|list (&&/|meta elem-type _cursor + (&/V (&/T =array =idx))))))) (defn [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 (&/T =array =idx =elem)) array-type))))) + =elem (&&/analyse-1 analyse elem-type elem) + _cursor &/cursor] + (return (&/|list (&&/|meta array-type _cursor + (&/V (&/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 [ ] (defn [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 =monitor) output-type))))) + _ (&type/check exo-type output-type) + _cursor &/cursor] + (return (&/|list (&&/|meta output-type _cursor (&/V =monitor)))))) analyse-jvm-monitorenter &&/$jvm-monitorenter analyse-jvm-monitorexit &&/$jvm-monitorexit @@ -569,8 +615,9 @@ (let [output-type (&type/Data$ &/Nil$)] (defn [analyse exo-type ?value] (|do [=value (&&/analyse-1 analyse (&type/Data$ &/Nil$) ?value) - _ (&type/check exo-type output-type)] - (return (&/|list (&/T (&/V =value) output-type)))))) + _ (&type/check exo-type output-type) + _cursor &/cursor] + (return (&/|list (&&/|meta output-type _cursor (&/V =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$ &/Nil$)] (defn [analyse exo-type ?value] (|do [=value (&&/analyse-1 analyse (&type/Data$ &/Nil$) ?value) - _ (&type/check exo-type output-type)] - (return (&/|list (&/T (&/V =value) output-type)))))) + _ (&type/check exo-type output-type) + _cursor &/cursor] + (return (&/|list (&&/|meta output-type _cursor (&/V =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 "" "()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 [ ] - (defn [compile *type* ?x ?y] + (defn [compile ?x ?y] (|do [:let [+wrapper-class+ (&host/->class )] ^MethodVisitor *writer* &/get-writer _ (compile ?x) @@ -130,7 +130,7 @@ ) (do-template [ ] - (defn [compile *type* ?x ?y] + (defn [compile ?x ?y] (|do [:let [+wrapper-class+ (&host/->class )] ^MethodVisitor *writer* &/get-writer _ (compile ?y) @@ -162,7 +162,7 @@ ) (do-template [ ] - (defn [compile *type* ?x ?y] + (defn [compile ?x ?y] (|do [:let [+wrapper-class+ (&host/->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 [ ] - (defn [compile *type* ?class ?method ?classes ?object ?args] + (defn [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 ?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= "" ?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 [ ] - (do (defn [compile *type* ?length] + (do (defn [compile ?length] (|do [^MethodVisitor *writer* &/get-writer _ (compile ?length) :let [_ (.visitInsn *writer* Opcodes/L2I)] :let [_ (.visitIntInsn *writer* Opcodes/NEWARRAY )]] (return nil))) - (defn [compile *type* ?array ?idx] + (defn [compile ?array ?idx] (|do [^MethodVisitor *writer* &/get-writer _ (compile ?array) :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST "[Ljava/lang/Object;")] @@ -306,7 +306,7 @@ )]] (return nil))) - (defn [compile *type* ?array ?idx ?elem] + (defn [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 [ ] - (defn [compile *type* ?monitor] + (defn [compile ?monitor] (|do [^MethodVisitor *writer* &/get-writer _ (compile ?monitor) :let [_ (doto *writer* @@ -575,7 +581,7 @@ ) (do-template [ ] - (defn [compile *type* ?value] + (defn [compile ?value] (|do [^MethodVisitor *writer* &/get-writer :let [_ (doto *writer* (.visitTypeInsn Opcodes/NEW (&host/->class )) @@ -609,7 +615,7 @@ ) (do-template [ ] - (defn [compile *type* ?x ?y] + (defn [compile ?x ?y] (|do [^MethodVisitor *writer* &/get-writer :let [_ (doto *writer* (.visitTypeInsn Opcodes/NEW (&host/->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-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- 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 [ ] - (defn [compile *type* value] + (defn [compile value] (|do [^MethodVisitor *writer* &/get-writer :let [_ (doto *writer* (.visitTypeInsn Opcodes/NEW ) @@ -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 "" "()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" -- cgit v1.2.3