aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/lux/analyser.clj71
-rw-r--r--src/lux/analyser/host.clj124
-rw-r--r--src/lux/analyser/parser.clj166
-rw-r--r--src/lux/base.clj5
-rw-r--r--src/lux/compiler.clj4
-rw-r--r--src/lux/compiler/host.clj47
-rw-r--r--src/lux/compiler/lambda.clj2
-rw-r--r--src/lux/compiler/lux.clj2
-rw-r--r--src/lux/host.clj3
-rw-r--r--src/lux/host/generics.clj49
10 files changed, 285 insertions, 188 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 56ed31a96..eb9bd29cc 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -15,50 +15,10 @@
(lux.analyser [base :as &&]
[lux :as &&lux]
[host :as &&host]
- [module :as &&module])))
+ [module :as &&module]
+ [parser :as &&a-parser])))
;; [Utils]
-(defn ^:private parse-handler [[catch+ finally+] token]
- (|case token
- [meta (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_catch")]
- (&/$Cons [_ (&/$TextS ?ex-class)]
- (&/$Cons [_ (&/$SymbolS "" ?ex-arg)]
- (&/$Cons ?catch-body
- (&/$Nil))))))]
- (return (&/T (&/|++ catch+ (&/|list (&/T ?ex-class ?ex-arg ?catch-body))) finally+))
-
- [meta (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_finally")]
- (&/$Cons ?finally-body
- (&/$Nil))))]
- (return (&/T catch+ (&/V &/$Some ?finally-body)))
-
- _
- (fail (str "[Analyser Error] Wrong syntax for exception handler: " (&/show-ast token)))))
-
-(defn ^:private parse-tag [ast]
- (|case ast
- [_ (&/$TagS "" name)]
- (return name)
-
- _
- (fail (str "[Analyser Error] Not a tag: " (&/show-ast ast)))))
-
-(defn ^:private parse-text [ast]
- (|case ast
- [_ (&/$TextS text)]
- (return text)
-
- _
- (fail (str "[Analyser Error] Not text: " (&/show-ast ast)))))
-
-(defn ^:private parse-ctor-arg [ast]
- (|case ast
- [_ (&/$TupleT (&/$Cons ?class (&/$Cons (&/$TextS ?term) (&/$Nil))))]
- (return (&/T ?class ?term))
-
- _
- (fail (str "[Analyser Error] Can't extract text: " (&/show-ast ast)))))
-
(defn analyse-variant+ [analyser exo-type ident values]
(|do [[module tag-name] (&/normalize ident)
idx (&&module/tag-index module tag-name)]
@@ -199,16 +159,17 @@
(&/$Cons [_ (&/$TupleS ?fields)]
(&/$Cons [_ (&/$TupleS ?methods)]
(&/$Nil)))))))))
- (|do [=interfaces (&/map% parse-text ?interfaces)]
+ (|do [=interfaces (&/map% &&a-parser/parse-text ?interfaces)]
(&&host/analyse-jvm-class analyse compile-token ?name ?super-class =interfaces ?anns ?fields ?methods))
(&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_interface")]
- (&/$Cons [_ (&/$TextS ?name)]
+ (&/$Cons ?class-decl
(&/$Cons [_ (&/$TupleS ?supers)]
(&/$Cons [_ (&/$TupleS ?anns)]
?methods)))))
- (|do [=supers (&/map% parse-text ?supers)]
- (&&host/analyse-jvm-interface analyse compile-token ?name =supers ?anns ?methods))
+ (|do [=gclass-decl (&&a-parser/parse-gclass-decl ?class-decl)
+ =supers (&/map% &&a-parser/parse-gclass-super ?supers)]
+ (&&host/analyse-jvm-interface analyse compile-token =gclass-decl =supers ?anns ?methods))
(&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_anon-class")]
(&/$Cons [_ (&/$TextS ?super-class)]
@@ -216,8 +177,8 @@
(&/$Cons [_ (&/$TupleS ?ctor-args)]
(&/$Cons [_ (&/$TupleS ?methods)]
(&/$Nil)))))))
- (|do [=interfaces (&/map% parse-text ?interfaces)
- =ctor-args (&/map% parse-ctor-arg ?ctor-args)]
+ (|do [=interfaces (&/map% &&a-parser/parse-text ?interfaces)
+ =ctor-args (&/map% &&a-parser/parse-ctor-arg ?ctor-args)]
(&&host/analyse-jvm-anon-class analyse compile-token exo-type ?super-class =interfaces =ctor-args ?methods))
;; Programs
@@ -345,7 +306,7 @@
(&/$Cons [_ (&/$TupleS ?arg-classes)]
(&/$Cons [_ (&/$TupleS ?args)]
(&/$Nil))))))
- (|do [=arg-classes (&/map% parse-text ?arg-classes)]
+ (|do [=arg-classes (&/map% &&a-parser/parse-text ?arg-classes)]
(&&host/analyse-jvm-new analyse exo-type ?class =arg-classes ?args))
(&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_getstatic")]
@@ -382,7 +343,7 @@
(&/$Cons [_ (&/$TupleS ?arg-classes)]
(&/$Cons [_ (&/$TupleS ?args)]
(&/$Nil)))))))
- (|do [=arg-classes (&/map% parse-text ?arg-classes)]
+ (|do [=arg-classes (&/map% &&a-parser/parse-text ?arg-classes)]
(&&host/analyse-jvm-invokestatic analyse exo-type ?class ?method =arg-classes ?args))
(&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_invokevirtual")]
@@ -392,7 +353,7 @@
(&/$Cons ?object
(&/$Cons [_ (&/$TupleS ?args)]
(&/$Nil))))))))
- (|do [=arg-classes (&/map% parse-text ?arg-classes)]
+ (|do [=arg-classes (&/map% &&a-parser/parse-text ?arg-classes)]
(&&host/analyse-jvm-invokevirtual analyse exo-type ?class ?method =arg-classes ?object ?args))
(&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_invokeinterface")]
@@ -402,7 +363,7 @@
(&/$Cons ?object
(&/$Cons [_ (&/$TupleS ?args)]
(&/$Nil))))))))
- (|do [=arg-classes (&/map% parse-text ?arg-classes)]
+ (|do [=arg-classes (&/map% &&a-parser/parse-text ?arg-classes)]
(&&host/analyse-jvm-invokeinterface analyse exo-type ?class ?method =arg-classes ?object ?args))
(&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_invokespecial")]
@@ -412,14 +373,14 @@
(&/$Cons ?object
(&/$Cons [_ (&/$TupleS ?args)]
(&/$Nil))))))))
- (|do [=arg-classes (&/map% parse-text ?arg-classes)]
+ (|do [=arg-classes (&/map% &&a-parser/parse-text ?arg-classes)]
(&&host/analyse-jvm-invokespecial analyse exo-type ?class ?method =arg-classes ?object ?args))
;; Exceptions
(&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_try")]
(&/$Cons ?body
?handlers)))
- (|do [catches+finally (&/fold% parse-handler (&/T &/Nil$ &/None$) ?handlers)]
+ (|do [catches+finally (&/fold% &&a-parser/parse-handler (&/T &/Nil$ &/None$) ?handlers)]
(&&host/analyse-jvm-try analyse exo-type ?body catches+finally))
(&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_throw")]
@@ -590,7 +551,7 @@
(&/$Cons [_ (&/$TupleS tags)]
(&/$Cons [_ (&/$SymbolS "" type-name)]
(&/$Nil)))))
- (|do [tags* (&/map% parse-tag tags)]
+ (|do [tags* (&/map% &&a-parser/parse-tag tags)]
(&&lux/analyse-declare-tags tags* type-name))
(&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_import")]
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 5ddf17a1e..b51dc21e7 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -8,25 +8,17 @@
clojure.core.match
clojure.core.match.array
(lux [base :as & :refer [|let |do return fail |case assert!]]
- [parser :as &parser]
[type :as &type]
[host :as &host])
[lux.type.host :as &host-type]
(lux.analyser [base :as &&]
[lambda :as &&lambda]
- [env :as &&env])
+ [env :as &&env]
+ [parser :as &&a-parser])
[lux.compiler.base :as &c!base])
(:import (java.lang.reflect TypeVariable)))
;; [Utils]
-(defn ^:private extract-text [ast]
- (|case ast
- [_ (&/$TextS text)]
- (return text)
-
- _
- (fail "[Analyser/Host Error] Can't extract text.")))
-
(defn ^:private ensure-catching [exceptions]
"(-> (List Text) (Lux (,)))"
(|do [class-loader &/loader]
@@ -459,69 +451,6 @@
(&/V &&/$jvm-arraylength =array)
)))))
-(defn ^:private analyse-modifiers [modifiers]
- (&/fold% (fn [so-far modif]
- (|case modif
- [_ (&/$TextS "public")]
- (return (assoc so-far :visibility "public"))
-
- [_ (&/$TextS "private")]
- (return (assoc so-far :visibility "private"))
-
- [_ (&/$TextS "protected")]
- (return (assoc so-far :visibility "protected"))
-
- [_ (&/$TextS "static")]
- (return (assoc so-far :static? true))
-
- [_ (&/$TextS "final")]
- (return (assoc so-far :final? true))
-
- [_ (&/$TextS "abstract")]
- (return (assoc so-far :abstract? true))
-
- [_ (&/$TextS "synchronized")]
- (return (assoc so-far :concurrency "synchronized"))
-
- [_ (&/$TextS "volatile")]
- (return (assoc so-far :concurrency "volatile"))
-
- _
- (fail (str "[Analyser Error] Unknown modifier: " (&/show-ast modif)))))
- {:visibility "default"
- :static? false
- :final? false
- :abstract? false
- :concurrency nil}
- modifiers))
-
-(let [failure (fail (str "[Analyser Error] Invalid annotation parameter."))]
- (defn ^:private extract-ann-param [param]
- (|case param
- [[_ (&/$TextS param-name)] param-value]
- (|case param-value
- [_ (&/$BoolS param-value*)] (return (&/T param-name (boolean param-value*)))
- [_ (&/$IntS param-value*)] (return (&/T param-name (int param-value*)))
- [_ (&/$RealS param-value*)] (return (&/T param-name (float param-value*)))
- [_ (&/$CharS param-value*)] (return (&/T param-name (char param-value*)))
- [_ (&/$TextS param-value*)] (return (&/T param-name param-value*))
-
- _
- failure)
-
- _
- failure)))
-
-(defn ^:private analyse-ann [ann]
- (|case ann
- [_ (&/$FormS (&/$Cons [_ (&/$TextS ann-name)] (&/$Cons [_ (&/$RecordS ann-params)] (&/$Nil))))]
- (|do [=ann-params (&/map% extract-ann-param ann-params)]
- (return {:name ann-name
- :params ann-params}))
-
- _
- (fail (str "[Analyser Error] Invalid annotation: " (&/show-ast ann)))))
-
(defn ^:private analyse-field [field]
(|case field
[_ (&/$FormS (&/$Cons [_ (&/$TextS ?field-name)]
@@ -529,8 +458,8 @@
(&/$Cons [_ (&/$TupleS ?anns)]
(&/$Cons [_ (&/$TextS ?field-type)]
(&/$Nil))))))]
- (|do [=field-modifiers (analyse-modifiers ?field-modifiers)
- =anns (&/map% analyse-ann ?anns)]
+ (|do [=field-modifiers (&&a-parser/parse-modifiers ?field-modifiers)
+ =anns (&/map% &&a-parser/parse-ann ?anns)]
(return {:name ?field-name
:modifiers =field-modifiers
:anns =anns
@@ -549,8 +478,8 @@
(&/$Cons [_ (&/$TextS method-output)]
(&/$Cons method-body
(&/$Nil)))))))))]
- (|do [=method-modifiers (analyse-modifiers method-modifiers)
- =method-exs (&/map% extract-text method-exs)
+ (|do [=method-modifiers (&&a-parser/parse-modifiers method-modifiers)
+ =method-exs (&/map% &&a-parser/parse-text method-exs)
=method-inputs (&/map% (fn [minput]
(|case minput
[_ (&/$FormS (&/$Cons [_ (&/$SymbolS "" input-name)]
@@ -581,9 +510,9 @@
(&/$Cons [_ (&/$TextS method-output)]
(&/$Cons method-body
(&/$Nil)))))))))]
- (|do [=method-modifiers (analyse-modifiers method-modifiers)
- =anns (&/map% analyse-ann method-anns)
- =method-exs (&/map% extract-text method-exs)
+ (|do [=method-modifiers (&&a-parser/parse-modifiers method-modifiers)
+ =anns (&/map% &&a-parser/parse-ann method-anns)
+ =method-exs (&/map% &&a-parser/parse-text method-exs)
=method-inputs (&/map% (fn [minput]
(|case minput
[_ (&/$FormS (&/$Cons [_ (&/$SymbolS "" input-name)]
@@ -614,29 +543,6 @@
_
(fail (str "[Analyser Error] Wrong syntax for method: " (&/show-ast method)))))
-(defn ^:private analyse-method-decl [method]
- (|case method
- [_ (&/$FormS (&/$Cons [_ (&/$TextS method-name)]
- (&/$Cons [_ (&/$TupleS modifiers)]
- (&/$Cons [_ (&/$TupleS ?anns)]
- (&/$Cons [_ (&/$TupleS method-exs)]
- (&/$Cons [_ (&/$TupleS inputs)]
- (&/$Cons [_ (&/$TextS output)]
- (&/$Nil))))))))]
- (|do [=modifiers (analyse-modifiers modifiers)
- =anns (&/map% analyse-ann ?anns)
- =inputs (&/map% extract-text inputs)
- =method-exs (&/map% extract-text method-exs)]
- (return {:name method-name
- :modifiers =modifiers
- :anns =anns
- :exceptions =method-exs
- :inputs =inputs
- :output output}))
-
- _
- (fail (str "[Analyser Error] Invalid method signature: " (&/show-ast method)))))
-
(defn ^:private mandatory-methods [supers]
(|do [class-loader &/loader]
(&/flat-map% (partial &host/abstract-methods class-loader) supers)))
@@ -671,7 +577,7 @@
(|do [module &/get-module-name
:let [full-name (str module "." name)]
;; :let [_ (prn 'analyse-jvm-class/_0)]
- =anns (&/map% analyse-ann anns)
+ =anns (&/map% &&a-parser/parse-ann anns)
=fields (&/map% analyse-field fields)
;; :let [_ (prn 'analyse-jvm-class/_1)]
=method-descs (&/map% dummy-method-desc methods)
@@ -684,12 +590,12 @@
:let [_ (println 'DEF (str module "." name))]]
(return &/Nil$))))
-(defn analyse-jvm-interface [analyse compile-token name supers anns methods]
+(defn analyse-jvm-interface [analyse compile-token interface-decl supers anns methods]
(|do [module &/get-module-name
- =anns (&/map% analyse-ann anns)
- =methods (&/map% analyse-method-decl methods)
- _ (compile-token (&/V &&/$jvm-interface (&/T name supers =anns =methods)))
- :let [_ (println 'DEF (str module "." name))]]
+ =anns (&/map% &&a-parser/parse-ann anns)
+ =methods (&/map% &&a-parser/parse-method-decl methods)
+ _ (compile-token (&/V &&/$jvm-interface (&/T interface-decl supers =anns =methods)))
+ :let [_ (println 'DEF (str module "." (&/|first interface-decl)))]]
(return &/Nil$)))
(defn ^:private captured-source [env-entry]
diff --git a/src/lux/analyser/parser.clj b/src/lux/analyser/parser.clj
new file mode 100644
index 000000000..feb9d1928
--- /dev/null
+++ b/src/lux/analyser/parser.clj
@@ -0,0 +1,166 @@
+;; Copyright (c) Eduardo Julian. All rights reserved.
+;; This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+;; If a copy of the MPL was not distributed with this file,
+;; You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(ns lux.analyser.parser
+ (:require (clojure [template :refer [do-template]])
+ clojure.core.match
+ clojure.core.match.array
+ (lux [base :as & :refer [|do return* return fail fail* |let |case]])))
+
+;; [Parsers]
+(defn parse-tag [ast]
+ (|case ast
+ [_ (&/$TagS "" name)]
+ (return name)
+
+ _
+ (fail (str "[Analyser Error] Not a tag: " (&/show-ast ast)))))
+
+(defn parse-text [ast]
+ (|case ast
+ [_ (&/$TextS text)]
+ (return text)
+
+ _
+ (fail (str "[Analyser Error] Not text: " (&/show-ast ast)))))
+
+(defn parse-ctor-arg [ast]
+ (|case ast
+ [_ (&/$TupleS (&/$Cons ?class (&/$Cons [_ (&/$TextS ?term)] (&/$Nil))))]
+ (return (&/T ?class ?term))
+
+ _
+ (fail (str "[Analyser Error] Not constructor argument: " (&/show-ast ast)))))
+
+(defn parse-gclass-decl [ast]
+ (|case ast
+ [_ (&/$FormS (&/$Cons [_ (&/$TextS class-name)] (&/$Cons [_ (&/$TupleS args)] (&/$Nil))))]
+ (|do [=args (&/map% parse-text args)]
+ (return (&/T class-name =args)))
+
+ _
+ (fail (str "[Analyser Error] Not generic class declaration: " (&/show-ast ast)))))
+
+(defn parse-gclass [ast]
+ (|case ast
+ [_ (&/$FormS (&/$Cons [_ (&/$TextS class-name)] (&/$Cons [_ (&/$TupleS params)] (&/$Nil))))]
+ (|do [=params (&/map% parse-gclass params)]
+ (return (&/V &/$GClass (&/T class-name =params))))
+
+ [_ (&/$TextS var-name)]
+ (return (&/V &/$GTypeVar var-name))
+
+ _
+ (fail (str "[Analyser Error] Not generic class: " (&/show-ast ast)))))
+
+(defn parse-gclass-super [ast]
+ (|case ast
+ [_ (&/$FormS (&/$Cons [_ (&/$TextS class-name)] (&/$Cons [_ (&/$TupleS params)] (&/$Nil))))]
+ (|do [=params (&/map% parse-gclass params)]
+ (return (&/T class-name =params)))
+
+ _
+ (fail (str "[Analyser Error] Not generic super-class: " (&/show-ast ast)))))
+
+(defn parse-handler [[catch+ finally+] token]
+ (|case token
+ [meta (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_catch")]
+ (&/$Cons [_ (&/$TextS ?ex-class)]
+ (&/$Cons [_ (&/$SymbolS "" ?ex-arg)]
+ (&/$Cons ?catch-body
+ (&/$Nil))))))]
+ (return (&/T (&/|++ catch+ (&/|list (&/T ?ex-class ?ex-arg ?catch-body))) finally+))
+
+ [meta (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_finally")]
+ (&/$Cons ?finally-body
+ (&/$Nil))))]
+ (return (&/T catch+ (&/V &/$Some ?finally-body)))
+
+ _
+ (fail (str "[Analyser Error] Wrong syntax for exception handler: " (&/show-ast token)))))
+
+(defn parse-modifiers [modifiers]
+ (&/fold% (fn [so-far modif]
+ (|case modif
+ [_ (&/$TextS "public")]
+ (return (assoc so-far :visibility "public"))
+
+ [_ (&/$TextS "private")]
+ (return (assoc so-far :visibility "private"))
+
+ [_ (&/$TextS "protected")]
+ (return (assoc so-far :visibility "protected"))
+
+ [_ (&/$TextS "static")]
+ (return (assoc so-far :static? true))
+
+ [_ (&/$TextS "final")]
+ (return (assoc so-far :final? true))
+
+ [_ (&/$TextS "abstract")]
+ (return (assoc so-far :abstract? true))
+
+ [_ (&/$TextS "synchronized")]
+ (return (assoc so-far :concurrency "synchronized"))
+
+ [_ (&/$TextS "volatile")]
+ (return (assoc so-far :concurrency "volatile"))
+
+ _
+ (fail (str "[Analyser Error] Unknown modifier: " (&/show-ast modif)))))
+ {:visibility "default"
+ :static? false
+ :final? false
+ :abstract? false
+ :concurrency nil}
+ modifiers))
+
+(let [failure (fail (str "[Analyser Error] Invalid annotation parameter."))]
+ (defn ^:private parse-ann-param [param]
+ (|case param
+ [[_ (&/$TextS param-name)] param-value]
+ (|case param-value
+ [_ (&/$BoolS param-value*)] (return (&/T param-name (boolean param-value*)))
+ [_ (&/$IntS param-value*)] (return (&/T param-name (int param-value*)))
+ [_ (&/$RealS param-value*)] (return (&/T param-name (float param-value*)))
+ [_ (&/$CharS param-value*)] (return (&/T param-name (char param-value*)))
+ [_ (&/$TextS param-value*)] (return (&/T param-name param-value*))
+
+ _
+ failure)
+
+ _
+ failure)))
+
+(defn parse-ann [ast]
+ (|case ast
+ [_ (&/$FormS (&/$Cons [_ (&/$TextS ann-name)] (&/$Cons [_ (&/$RecordS ann-params)] (&/$Nil))))]
+ (|do [=ann-params (&/map% parse-ann-param ann-params)]
+ (return {:name ann-name
+ :params ann-params}))
+
+ _
+ (fail (str "[Analyser Error] Invalid annotation: " (&/show-ast ast)))))
+
+(defn parse-method-decl [ast]
+ (|case ast
+ [_ (&/$FormS (&/$Cons [_ (&/$TextS method-name)]
+ (&/$Cons [_ (&/$TupleS modifiers)]
+ (&/$Cons [_ (&/$TupleS anns)]
+ (&/$Cons [_ (&/$TupleS gvars)]
+ (&/$Cons [_ (&/$TupleS method-exs)]
+ (&/$Cons [_ (&/$TupleS inputs)]
+ (&/$Cons output
+ (&/$Nil)))))))))]
+ (|do [=modifiers (parse-modifiers modifiers)
+ =anns (&/map% parse-ann anns)
+ =gvars (&/map% parse-text gvars)
+ =method-exs (&/map% parse-gclass method-exs)
+ =inputs (&/map% parse-gclass inputs)
+ =output (parse-gclass output)]
+ (return (&/T method-name =modifiers =anns =gvars =method-exs =inputs =output)))
+
+ _
+ (fail (str "[Analyser Error] Invalid method declaration: " (&/show-ast ast)))))
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 1da3859fc..6e527db1e 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -106,6 +106,11 @@
"eval?"
"host"])
+;; Compiler
+(deftags
+ ["GClass"
+ "GTypeVar"])
+
;; [Exports]
(def datum-field "_datum")
(def meta-field "_meta")
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index f35bc47e3..579d6b33e 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -448,7 +448,7 @@
[file-name _ _] &/cursor
:let [class-name (str (&host/->module-class module) "/" id)
=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
- (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
+ (.visit &host/bytecode-version (+ 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)))
@@ -486,7 +486,7 @@
_ (&a-module/enter-module name)
_ (&/flag-active-module name)
:let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
- (.visit Opcodes/V1_6 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
+ (.visit &host/bytecode-version (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
(str (&host/->module-class name) "/_") nil "java/lang/Object" nil)
(-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) &/hash-field "I" nil file-hash)
.visitEnd)
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index 7111f7339..a02022228 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -16,9 +16,9 @@
[analyser :as &analyser]
[host :as &host])
[lux.type.host :as &host-type]
+ [lux.host.generics :as &host-generics]
[lux.analyser.base :as &a]
- [lux.compiler.base :as &&]
- :reload)
+ [lux.compiler.base :as &&])
(:import (org.objectweb.asm Opcodes
Label
ClassWriter
@@ -479,11 +479,16 @@
(return nil)))))
(defn ^:private compile-method-decl [^ClassWriter class-writer method]
- (|let [signature (str "(" (&/fold str "" (&/|map &host/->type-signature (:inputs method))) ")"
- (&host/->type-signature (:output method)))]
- (let [=method (.visitMethod class-writer (&host/modifiers->int (:modifiers method)) (:name method) signature nil (->> (:exceptions method) (&/|map &host/->class) &/->seq (into-array java.lang.String)))]
- (&/|map (partial compile-annotation =method) (:anns method))
- nil)))
+ (|let [[=name =modifiers =anns =gvars =exceptions =inputs =output] method
+ simple-signature (str "(" (&/fold str "" (&/|map &host-generics/gclass->simple-signature =inputs)) ")" (&host-generics/gclass->simple-signature =output))
+ generic-signature (str "<" (->> =gvars (&/|interpose " ") (&/fold str "")) ">"
+ "(" (&/fold str "" (&/|map &host-generics/gclass->signature =inputs)) ")"
+ (&host-generics/gclass->signature =output)
+ (->> =exceptions (&/|map &host-generics/gclass->signature) (&/|interpose " ") (&/fold str "")))
+ =method (.visitMethod class-writer (&host/modifiers->int =modifiers) =name simple-signature generic-signature (->> =exceptions (&/|map &host-generics/gclass->simple-signature) &/->seq (into-array java.lang.String)))
+ _ (&/|map (partial compile-annotation =method) =anns)
+ _ (.visitEnd =method)]
+ nil))
(defn ^:private prepare-ctor-arg [^MethodVisitor writer type]
(case type
@@ -555,7 +560,7 @@
: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)
+ (.visit &host/bytecode-version (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
full-name nil super-class* (->> ?interfaces (&/|map &host/->class) &/->seq (into-array String)))
(.visitSource file-name nil))
_ (&/|map (partial compile-annotation =class) ?anns)
@@ -570,17 +575,21 @@
(return nil))]
(&&/save-class! ?name (.toByteArray (doto =class .visitEnd)))))
-(defn compile-jvm-interface [compile ?name ?supers ?anns ?methods]
- (|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)))
- (.visitSource file-name nil))
- _ (&/|map (partial compile-annotation =interface) ?anns)
- _ (do (&/|map (partial compile-method-decl =interface) ?methods)
- (.visitEnd =interface))]
- (&&/save-class! ?name (.toByteArray =interface)))))
+(defn compile-jvm-interface [compile interface-decl ?supers ?anns ?methods]
+ (|do [:let [[interface-name interface-vars] interface-decl]
+ module &/get-module-name
+ [file-name _ _] &/cursor
+ :let [=interface (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
+ (.visit &host/bytecode-version (+ Opcodes/ACC_PUBLIC Opcodes/ACC_ABSTRACT Opcodes/ACC_INTERFACE)
+ (str module "/" interface-name)
+ (&host-generics/gclass-decl->signature interface-decl ?supers)
+ "java/lang/Object"
+ (->> ?supers (&/|map (comp &host/->class &host-generics/super-class-name)) &/->seq (into-array String)))
+ (.visitSource file-name nil))
+ _ (&/|map (partial compile-annotation =interface) ?anns)
+ _ (do (&/|map (partial compile-method-decl =interface) ?methods)
+ (.visitEnd =interface))]]
+ (&&/save-class! interface-name (.toByteArray =interface))))
(defn compile-jvm-try [compile ?body ?catches ?finally]
(|do [^MethodVisitor *writer* &/get-writer
diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj
index cb8ad0037..a719084ab 100644
--- a/src/lux/compiler/lambda.clj
+++ b/src/lux/compiler/lambda.clj
@@ -96,7 +96,7 @@
: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
+ (.visit &host/bytecode-version lambda-flags
class-name nil "java/lang/Object" (into-array [&&/function-class]))
(-> (doto (.visitField datum-flags captured-name clo-field-sig nil nil)
(.visitEnd))
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index 4566ef186..4548f2bc4 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -187,7 +187,7 @@
def-name (&/normalize-name ?name)
current-class (str (&host/->module-class module-name) "/" def-name)
=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
- (.visit Opcodes/V1_5 class-flags
+ (.visit &host/bytecode-version class-flags
current-class nil "java/lang/Object" (into-array [&&/function-class]))
(-> (.visitField field-flags &/name-field "Ljava/lang/String;" nil ?name)
(doto (.visitEnd)))
diff --git a/src/lux/host.clj b/src/lux/host.clj
index 0ce6d5e6a..8c73246c7 100644
--- a/src/lux/host.clj
+++ b/src/lux/host.clj
@@ -24,6 +24,7 @@
(def module-separator "/")
(def class-name-separator ".")
(def class-separator "/")
+(def bytecode-version Opcodes/V1_6)
;; [Resources]
(do-template [<name> <old-sep> <new-sep>]
@@ -271,7 +272,7 @@
(|do [module &/get-module-name
:let [full-name (str module "/" name)
=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
- (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
+ (.visit bytecode-version (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
full-name nil (->class super-class) (->> interfaces (&/|map ->class) &/->seq (into-array String))))
_ (&/|map (fn [field]
(doto (.visitField =class (modifiers->int (:modifiers field)) (:name field)
diff --git a/src/lux/host/generics.clj b/src/lux/host/generics.clj
new file mode 100644
index 000000000..df04d9305
--- /dev/null
+++ b/src/lux/host/generics.clj
@@ -0,0 +1,49 @@
+;; Copyright (c) Eduardo Julian. All rights reserved.
+;; This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+;; If a copy of the MPL was not distributed with this file,
+;; You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(ns lux.host.generics
+ (:require (clojure [template :refer [do-template]])
+ clojure.core.match
+ clojure.core.match.array
+ (lux [base :as & :refer [|do return* return fail fail* |let |case]]
+ [host :as &host])))
+
+(defn super-class-name [super]
+ "(-> GenericSuperClassDecl Text)"
+ (|let [[super-name super-params] super]
+ super-name))
+
+(defn gclass->signature [super]
+ "(-> GenericClass Text)"
+ (|case super
+ (&/$GTypeVar name)
+ (str "T" name ";")
+
+ (&/$GClass name params)
+ (|let [params-sigs (->> params (&/|map gclass->signature) (&/|interpose " ") (&/fold str ""))]
+ (str "L" (&host/->class name) "<" params-sigs ">" ";"))))
+
+(defn gsuper-decl->signature [super]
+ "(-> GenericSuperClassDecl Text)"
+ (|let [[super-name super-params] super
+ params-sigs (->> super-params (&/|map gclass->signature) (&/|interpose " ") (&/fold str ""))]
+ (str "L" (&host/->class super-name) "<" params-sigs ">" ";")))
+
+(defn gclass-decl->signature [class-decl supers]
+ "(-> GenericClassDecl (List GenericSuperClassDecl) Text)"
+ (|let [[class-name class-vars] class-decl
+ vars-section (str "<" (->> class-vars (&/|interpose " ") (&/fold str "")) ">")
+ super-section (->> (&/|map gsuper-decl->signature supers) (&/|interpose " ") (&/fold str ""))]
+ (str vars-section super-section)))
+
+(let [object-simple-signature (&host/->type-signature "java.lang.Object")]
+ (defn gclass->simple-signature [gclass]
+ "(-> GenericClass Text)"
+ (|case gclass
+ (&/$GTypeVar name)
+ object-simple-signature
+
+ (&/$GClass name params)
+ (&host/->type-signature name))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-05 16:51:37 +0000