From 0839750d8df2ab05e12dd5fb92ce2eb6d59cbf87 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 30 Nov 2015 18:34:28 -0400 Subject: - Refactored some of the parsing done inside the analyser to a separate namespace. - Added a new namespace for generating generics signatures for classes & methods. - Added generics-based polymorphism to JVM interface definition. - Fixed a bug wherein inconsistent bytecode versions where being used for the generation of classes (1.6 for some, 1.5 for others). --- src/lux/analyser.clj | 71 +++++-------------- src/lux/analyser/host.clj | 124 ++++----------------------------- src/lux/analyser/parser.clj | 166 ++++++++++++++++++++++++++++++++++++++++++++ src/lux/base.clj | 5 ++ src/lux/compiler.clj | 4 +- src/lux/compiler/host.clj | 47 ++++++++----- src/lux/compiler/lambda.clj | 2 +- src/lux/compiler/lux.clj | 2 +- src/lux/host.clj | 3 +- src/lux/host/generics.clj | 49 +++++++++++++ 10 files changed, 285 insertions(+), 188 deletions(-) create mode 100644 src/lux/analyser/parser.clj create mode 100644 src/lux/host/generics.clj 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 [ ] @@ -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)))) -- cgit v1.2.3