diff options
| -rw-r--r-- | src/lux/analyser/host.clj | 106 | ||||
| -rw-r--r-- | src/lux/analyser/parser.clj | 4 | ||||
| -rw-r--r-- | src/lux/compiler.clj | 8 | ||||
| -rw-r--r-- | src/lux/compiler/base.clj | 2 | ||||
| -rw-r--r-- | src/lux/compiler/host.clj | 22 | ||||
| -rw-r--r-- | src/lux/host.clj | 142 | ||||
| -rw-r--r-- | src/lux/host/generics.clj | 16 | ||||
| -rw-r--r-- | src/lux/type/host.clj | 72 |
8 files changed, 209 insertions, 163 deletions
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index ecd2edc36..bec12c4de 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -16,7 +16,7 @@ [env :as &&env] [parser :as &&a-parser]) [lux.compiler.base :as &c!base]) - (:import (java.lang.reflect TypeVariable))) + (:import (java.lang.reflect Type TypeVariable))) ;; [Utils] (defn ^:private ensure-catching [exceptions] @@ -209,7 +209,7 @@ (defn analyse-jvm-getstatic [analyse exo-type class field] (|do [class-loader &/loader [gvars gtype] (&host/lookup-static-field class-loader class field) - :let [=type (&host-type/class->type (cast Class gtype))] + =type (&host-type/instance-param &type/existential (&/|list) gtype) :let [output-type =type] _ (&type/check exo-type output-type) _cursor &/cursor] @@ -231,26 +231,27 @@ (defn analyse-jvm-putstatic [analyse exo-type class field value] (|do [class-loader &/loader [gvars gtype] (&host/lookup-static-field class-loader class field) - :let [=type (&host-type/class->type (cast Class gtype))] + =type (&host-type/instance-param &type/existential (&/|list) gtype) =value (&&/analyse-1 analyse =type value) :let [output-type &type/Unit] _ (&type/check exo-type output-type) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor - (&/V &&/$jvm-putstatic (&/T class field =value output-type))))))) + (&/V &&/$jvm-putstatic (&/T class field =value =type))))))) (defn analyse-jvm-putfield [analyse exo-type class field value object] (|do [class-loader &/loader =object (&&/analyse-1+ analyse object) - _ (ensure-object (&&/expr-type* =object)) + :let [obj-type (&&/expr-type* =object)] + _ (ensure-object obj-type) [gvars gtype] (&host/lookup-field class-loader class field) - =type (analyse-field-access-helper (&&/expr-type* =object) gvars gtype) + =type (analyse-field-access-helper obj-type gvars gtype) =value (&&/analyse-1 analyse =type value) :let [output-type &type/Unit] _ (&type/check exo-type output-type) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor - (&/V &&/$jvm-putfield (&/T class field =value =object (&&/expr-type* =object)))))))) + (&/V &&/$jvm-putfield (&/T class field =value =object =type))))))) (defn analyse-jvm-instanceof [analyse exo-type class object] (|do [=object (&&/analyse-1+ analyse object) @@ -547,64 +548,64 @@ (defn ^:private analyse-method [analyse class-decl class-env all-supers method] "(-> Analyser ClassDecl (List (, TypeVar Type)) (List SuperClassDecl) MethodSyntax (Lux MethodAnalysis))" (|let [[?cname ?cparams] class-decl - class-type (&/V &/$GenericClass (&/T ?cname &/Nil$))] + class-type (&/V &/$DataT (&/T ?cname (&/|map &/|second class-env)))] (|case method (&/$ConstructorMethodSyntax ?anns ?gvars ?exceptions ?inputs ?ctor-args ?body) - (|do [:let [all-gvars (&/|++ ?cparams ?gvars)] - gvar-env (&/map% (fn [gvar] - (|do [ex &type/existential] - (return (&/T gvar ex)))) - all-gvars) + (|do [method-env (&/map% (fn [gvar] + (|do [ex &type/existential] + (return (&/T gvar ex)))) + ?gvars) + :let [full-env (&/|++ class-env method-env)] :let [output-type &type/Unit] =ctor-args (&/map% (fn [ctor-arg] (|do [:let [[ca-type ca-term] ctor-arg] - =ca-type (generic-class->type gvar-env ca-type) + =ca-type (generic-class->type full-env ca-type) =ca-term (&&/analyse-1 analyse =ca-type ca-term)] (return (&/T =ca-type =ca-term)))) ?ctor-args) - =body (&/fold (fn [body* input*] - (|do [:let [[iname itype*] input*] - itype (generic-class->type gvar-env itype*)] - (&&env/with-local iname itype - body*))) - (&&/analyse-1 analyse output-type ?body) - (&/|reverse (&/Cons$ (&/T &&/jvm-this class-type) - ?inputs)))] + =body (&&env/with-local &&/jvm-this class-type + (&/fold (fn [body* input*] + (|do [:let [[iname itype*] input*] + itype (generic-class->type full-env itype*)] + (&&env/with-local iname itype + body*))) + (&&/analyse-1 analyse output-type ?body) + (&/|reverse ?inputs)))] (return (&/V &/$ConstructorMethodAnalysis (&/T ?anns ?gvars ?exceptions ?inputs =ctor-args =body)))) (&/$VirtualMethodSyntax ?name ?anns ?gvars ?exceptions ?inputs ?output ?body) - (|do [:let [all-gvars (&/|++ ?cparams ?gvars)] - all-env (&/map% (fn [gvar] - (|do [ex &type/existential] - (return (&/T gvar ex)))) - all-gvars) - output-type (generic-class->type all-env ?output) - =body (&/fold (fn [body* input*] - (|do [:let [[iname itype*] input*] - itype (generic-class->type all-env itype*)] - (&&env/with-local iname itype - body*))) - (&&/analyse-1 analyse output-type ?body) - (&/|reverse (&/Cons$ (&/T &&/jvm-this class-type) - ?inputs)))] + (|do [method-env (&/map% (fn [gvar] + (|do [ex &type/existential] + (return (&/T gvar ex)))) + ?gvars) + :let [full-env (&/|++ class-env method-env)] + output-type (generic-class->type full-env ?output) + =body (&&env/with-local &&/jvm-this class-type + (&/fold (fn [body* input*] + (|do [:let [[iname itype*] input*] + itype (generic-class->type full-env itype*)] + (&&env/with-local iname itype + body*))) + (&&/analyse-1 analyse output-type ?body) + (&/|reverse ?inputs)))] (return (&/V &/$VirtualMethodAnalysis (&/T ?name ?anns ?gvars ?exceptions ?inputs ?output =body)))) (&/$OverridenMethodSyntax ?class-decl ?name ?anns ?gvars ?exceptions ?inputs ?output ?body) (|do [super-env (gen-super-env class-env all-supers ?class-decl) - gvar-env (&/map% (fn [gvar] - (|do [ex &type/existential] - (return (&/T gvar ex)))) - ?gvars) - :let [full-env (&/|++ super-env gvar-env)] + method-env (&/map% (fn [gvar] + (|do [ex &type/existential] + (return (&/T gvar ex)))) + ?gvars) + :let [full-env (&/|++ super-env method-env)] output-type (generic-class->type full-env ?output) - =body (&/fold (fn [body* input*] - (|do [:let [[iname itype*] input*] - itype (generic-class->type full-env itype*)] - (&&env/with-local iname itype - body*))) - (&&/analyse-1 analyse output-type ?body) - (&/|reverse (&/Cons$ (&/T &&/jvm-this class-type) - ?inputs)))] + =body (&&env/with-local &&/jvm-this class-type + (&/fold (fn [body* input*] + (|do [:let [[iname itype*] input*] + itype (generic-class->type full-env itype*)] + (&&env/with-local iname itype + body*))) + (&&/analyse-1 analyse output-type ?body) + (&/|reverse ?inputs)))] (return (&/V &/$OverridenMethodAnalysis (&/T ?class-decl ?name ?anns ?gvars ?exceptions ?inputs ?output =body)))) ))) @@ -664,7 +665,7 @@ ;; :let [_ (prn 'analyse-jvm-class/_2)] _ (check-method-completion all-supers =methods) ;; :let [_ (prn 'analyse-jvm-class/_3)] - _ (compile-token (&/V &&/$jvm-class (&/T class-decl super-class interfaces =anns =fields =methods nil))) + _ (compile-token (&/V &&/$jvm-class (&/T class-decl super-class interfaces =anns =fields =methods (&/|list) &/None$))) :let [_ (println 'DEF full-name)]] (return &/Nil$)))) @@ -685,7 +686,8 @@ (&/|list) (&/|list) (&/V &/$TupleS (&/|list)))) - captured-slot-type "java.lang.Object"] + captured-slot-class "java.lang.Object" + captured-slot-type (&/V &/$GenericClass (&/T captured-slot-class (&/|list)))] (defn analyse-jvm-anon-class [analyse compile-token exo-type super-class interfaces ctor-args methods] (&/with-closure (|do [module &/get-module-name @@ -716,7 +718,7 @@ _ (compile-token (&/V &&/$jvm-class (&/T class-decl super-class interfaces (&/|list) =fields =methods =captured (&/Some$ =ctor-args)))) _cursor &/cursor] (return (&/|list (&&/|meta anon-class-type _cursor - (&/V &&/$jvm-new (&/T anon-class (&/|repeat (&/|length sources) captured-slot-type) sources)) + (&/V &&/$jvm-new (&/T anon-class (&/|repeat (&/|length sources) captured-slot-class) sources)) ))) )))) diff --git a/src/lux/analyser/parser.clj b/src/lux/analyser/parser.clj index 5aca6feb8..3fcf71d8b 100644 --- a/src/lux/analyser/parser.clj +++ b/src/lux/analyser/parser.clj @@ -149,7 +149,7 @@ (&/$Cons [_ (&/$TupleS gvars)] (&/$Cons [_ (&/$TupleS exceptions)] (&/$Cons [_ (&/$TupleS inputs)] - (&/$Cons ?ctor-args + (&/$Cons [_ (&/$TupleS ?ctor-args)] (&/$Cons body (&/$Nil)))))))))] (|do [=anns (&/map% parse-ann anns) =gvars (&/map% parse-text gvars) @@ -197,7 +197,7 @@ (|case ast [_ (&/$FormS (&/$Cons [_ (&/$TextS ?name)] (&/$Cons [_ (&/$TupleS ?anns)] - (&/$Cons [_ (&/$TextS ?type)] + (&/$Cons ?type (&/$Nil)))))] (|do [=anns (&/map% parse-ann ?anns) =type (parse-gclass ?type)] diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index b4b76e0a6..7fe6871b0 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -219,11 +219,11 @@ (&o/$jvm-getfield ?class ?field ?object ?output-type) (&&host/compile-jvm-getfield compile-expression ?class ?field ?object ?output-type) - (&o/$jvm-putstatic ?class ?field ?value ?output-type) - (&&host/compile-jvm-putstatic compile-expression ?class ?field ?value) + (&o/$jvm-putstatic ?class ?field ?value ?input-type) + (&&host/compile-jvm-putstatic compile-expression ?class ?field ?value ?input-type) - (&o/$jvm-putfield ?class ?field ?value ?object ?output-type) - (&&host/compile-jvm-putfield compile-expression ?class ?field ?object ?value) + (&o/$jvm-putfield ?class ?field ?value ?object ?input-type) + (&&host/compile-jvm-putfield compile-expression ?class ?field ?object ?value ?input-type) (&o/$jvm-invokestatic ?class ?method ?classes ?args ?output-type) (&&host/compile-jvm-invokestatic compile-expression ?class ?method ?classes ?args ?output-type) diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj index 910a9a05a..4358ebdac 100644 --- a/src/lux/compiler/base.clj +++ b/src/lux/compiler/base.clj @@ -25,7 +25,7 @@ (java.lang.reflect Field))) ;; [Constants] -(def ^String version "0.3.1") +(def ^String version "0.3.2") (def ^String input-dir "source") (def ^String output-dir "target/jvm") (def ^String output-package (str output-dir "/" "program.jar")) diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj index 3c937b2af..0401593f7 100644 --- a/src/lux/compiler/host.clj +++ b/src/lux/compiler/host.clj @@ -389,23 +389,23 @@ (prepare-return! ?output-type))]] (return nil))) -(defn compile-jvm-putstatic [compile ?class ?field ?value ?output-type] +(defn compile-jvm-putstatic [compile ?class ?field ?value ?input-type] (|do [^MethodVisitor *writer* &/get-writer _ (compile ?value) - =output-type (&host/->java-sig ?output-type) - :let [_ (.visitFieldInsn *writer* Opcodes/PUTSTATIC (&host-generics/->bytecode-class-name (&host-type/as-obj ?class)) ?field =output-type)] + =input-sig (&host/->java-sig ?input-type) + :let [_ (.visitFieldInsn *writer* Opcodes/PUTSTATIC (&host-generics/->bytecode-class-name (&host-type/as-obj ?class)) ?field =input-sig)] :let [_ (.visitInsn *writer* Opcodes/ACONST_NULL)]] (return nil))) -(defn compile-jvm-putfield [compile ?class ?field ?object ?value ?output-type] +(defn compile-jvm-putfield [compile ?class ?field ?object ?value ?input-type] (|do [:let [class* (&host-generics/->bytecode-class-name (&host-type/as-obj ?class))] ^MethodVisitor *writer* &/get-writer _ (compile ?object) :let [_ (.visitInsn *writer* Opcodes/DUP)] _ (compile ?value) :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST class*)] - =output-type (&host/->java-sig ?output-type) - :let [_ (.visitFieldInsn *writer* Opcodes/PUTFIELD class* ?field =output-type)]] + =input-sig (&host/->java-sig ?input-type) + :let [_ (.visitFieldInsn *writer* Opcodes/PUTFIELD class* ?field =input-sig)]] (return nil))) (defn compile-jvm-instanceof [compile class object] @@ -428,7 +428,8 @@ (defn ^:private compile-field [^ClassWriter writer field] (|let [[=name =anns =type] field =field (.visitField writer Opcodes/ACC_PUBLIC =name - (&host-generics/->type-signature =type) nil nil)] + (&host-generics/gclass->simple-signature =type) + (&host-generics/gclass->signature =type) nil)] (do (&/|map (partial compile-annotation =field) =anns) (.visitEnd =field) nil))) @@ -633,7 +634,7 @@ super-class* (&host-generics/->bytecode-class-name (&host-generics/super-class-name ?super-class)) =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) (.visit &host/bytecode-version (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) - full-name nil super-class* (->> ?interfaces (&/|map (comp &host-generics/->bytecode-class-name &host-generics/super-class-name)) &/->seq (into-array String))) + full-name (if (= "" class-signature) nil class-signature) super-class* (->> ?interfaces (&/|map (comp &host-generics/->bytecode-class-name &host-generics/super-class-name)) &/->seq (into-array String))) (.visitSource file-name nil)) _ (&/|map (partial compile-annotation =class) ?anns) _ (&/|map (partial compile-field =class) @@ -651,10 +652,11 @@ (|do [:let [[interface-name interface-vars] interface-decl] module &/get-module-name [file-name _ _] &/cursor - :let [=interface (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) + :let [interface-signature (&host-generics/gclass-decl->signature interface-decl ?supers) + =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) + (if (= "" interface-signature) nil interface-signature) "java/lang/Object" (->> ?supers (&/|map (comp &host-generics/->bytecode-class-name &host-generics/super-class-name)) &/->seq (into-array String))) (.visitSource file-name nil)) diff --git a/src/lux/host.clj b/src/lux/host.clj index 87600b43b..048051009 100644 --- a/src/lux/host.clj +++ b/src/lux/host.clj @@ -89,7 +89,7 @@ (do-template [<name> <static?>] (defn <name> [class-loader target field] (|let [target-class (Class/forName (&host-type/as-obj target) true class-loader)] - (if-let [^Type gtype (first (for [^Field =field (.getDeclaredFields target-class) + (if-let [^Type gtype (first (for [^Field =field (seq (.getDeclaredFields target-class)) :when (and (.equals ^Object field (.getName =field)) (.equals ^Object <static?> (Modifier/isStatic (.getModifiers =field))))] (.getGenericType =field)))] @@ -129,7 +129,6 @@ ) (defn lookup-constructor [class-loader target args] - ;; (prn 'lookup-constructor class-loader target (&host-type/as-obj target)) (let [target-class (Class/forName (&host-type/as-obj target) true class-loader)] (if-let [^Constructor ctor (first (for [^Constructor =method (.getDeclaredConstructors target-class) :when (let [param-types (&/->list (seq (.getParameterTypes =method)))] @@ -163,57 +162,91 @@ false)) (defn dummy-value [^MethodVisitor writer class] - (case class - "boolean" (doto writer - (.visitLdcInsn false)) - "byte" (doto writer - (.visitLdcInsn (byte 0))) - "short" (doto writer - (.visitLdcInsn (short 0))) - "int" (doto writer - (.visitLdcInsn (int 0))) - "long" (doto writer - (.visitLdcInsn (long 0))) - "float" (doto writer - (.visitLdcInsn (float 0.0))) - "double" (doto writer - (.visitLdcInsn (double 0.0))) - "char" (doto writer - (.visitLdcInsn (char 0))) - ;; else + (|case class + (&/$GenericClass "boolean" (&/$Nil)) + (doto writer + (.visitLdcInsn false)) + + (&/$GenericClass "byte" (&/$Nil)) + (doto writer + (.visitLdcInsn (byte 0))) + + (&/$GenericClass "short" (&/$Nil)) + (doto writer + (.visitLdcInsn (short 0))) + + (&/$GenericClass "int" (&/$Nil)) + (doto writer + (.visitLdcInsn (int 0))) + + (&/$GenericClass "long" (&/$Nil)) + (doto writer + (.visitLdcInsn (long 0))) + + (&/$GenericClass "float" (&/$Nil)) + (doto writer + (.visitLdcInsn (float 0.0))) + + (&/$GenericClass "double" (&/$Nil)) + (doto writer + (.visitLdcInsn (double 0.0))) + + (&/$GenericClass "char" (&/$Nil)) + (doto writer + (.visitLdcInsn (char 0))) + + _ (doto writer (.visitInsn Opcodes/ACONST_NULL)))) (defn ^:private dummy-return [^MethodVisitor writer output] - (case output - "void" (.visitInsn writer Opcodes/RETURN) - "boolean" (doto writer - (.visitLdcInsn false) - (.visitInsn Opcodes/IRETURN)) - "byte" (doto writer - (.visitLdcInsn (byte 0)) - (.visitInsn Opcodes/IRETURN)) - "short" (doto writer - (.visitLdcInsn (short 0)) - (.visitInsn Opcodes/IRETURN)) - "int" (doto writer - (.visitLdcInsn (int 0)) - (.visitInsn Opcodes/IRETURN)) - "long" (doto writer - (.visitLdcInsn (long 0)) - (.visitInsn Opcodes/LRETURN)) - "float" (doto writer - (.visitLdcInsn (float 0.0)) - (.visitInsn Opcodes/FRETURN)) - "double" (doto writer - (.visitLdcInsn (double 0.0)) - (.visitInsn Opcodes/DRETURN)) - "char" (doto writer - (.visitLdcInsn (char 0)) - (.visitInsn Opcodes/IRETURN)) - ;; else + (|case output + (&/$GenericClass "void" (&/$Nil)) + (.visitInsn writer Opcodes/RETURN) + + (&/$GenericClass "boolean" (&/$Nil)) + (doto writer + (dummy-value output) + (.visitInsn Opcodes/IRETURN)) + + (&/$GenericClass "byte" (&/$Nil)) + (doto writer + (dummy-value output) + (.visitInsn Opcodes/IRETURN)) + + (&/$GenericClass "short" (&/$Nil)) + (doto writer + (dummy-value output) + (.visitInsn Opcodes/IRETURN)) + + (&/$GenericClass "int" (&/$Nil)) + (doto writer + (dummy-value output) + (.visitInsn Opcodes/IRETURN)) + + (&/$GenericClass "long" (&/$Nil)) + (doto writer + (dummy-value output) + (.visitInsn Opcodes/LRETURN)) + + (&/$GenericClass "float" (&/$Nil)) + (doto writer + (dummy-value output) + (.visitInsn Opcodes/FRETURN)) + + (&/$GenericClass "double" (&/$Nil)) + (doto writer + (dummy-value output) + (.visitInsn Opcodes/DRETURN)) + + (&/$GenericClass "char" (&/$Nil)) + (doto writer + (dummy-value output) + (.visitInsn Opcodes/IRETURN)) + + _ (doto writer - (.visitInsn Opcodes/ACONST_NULL) + (dummy-value output) (.visitInsn Opcodes/ARETURN)))) (def init-method-name "<init>") @@ -281,19 +314,20 @@ (|do [module &/get-module-name :let [[?name ?params] class-decl full-name (str module "/" ?name) - class-signature (&host-generics/gclass-decl->signature class-decl interfaces) + class-signature (&host-generics/gclass-decl->signature class-decl (&/Cons$ super-class interfaces)) =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) (.visit bytecode-version (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) full-name - class-signature + (if (= "" class-signature) nil class-signature) (&host-generics/->bytecode-class-name (&host-generics/super-class-name super-class)) (->> interfaces (&/|map (comp &host-generics/->bytecode-class-name &host-generics/super-class-name)) &/->seq (into-array String)))) _ (&/|map (fn [field] (|let [[=name =anns =type] field] - (do (prn 'use-dummy-class/=name =name (&host-generics/->type-signature =type) (&/adt->text =type)) - (doto (.visitField =class Opcodes/ACC_PUBLIC =name - (&host-generics/->type-signature =type) nil nil) - (.visitEnd))))) + (doto (.visitField =class Opcodes/ACC_PUBLIC =name + (&host-generics/gclass->simple-signature =type) + (&host-generics/gclass->signature =type) + nil) + (.visitEnd)))) fields) _ (&/|map (partial compile-dummy-method =class super-class) methods) bytecode (.toByteArray (doto =class .visitEnd))] diff --git a/src/lux/host/generics.clj b/src/lux/host/generics.clj index 70ed9ecab..30d7629c1 100644 --- a/src/lux/host/generics.clj +++ b/src/lux/host/generics.clj @@ -47,7 +47,9 @@ super-name)) (defn class-decl-params->signature [params] - (str "<" (->> params (&/|interpose " ") (&/fold str "")) ">")) + (if (&/|empty? params) + "" + (str "<" (->> params (&/|interpose " ") (&/fold str "")) ">"))) (defn gclass->signature [super] "(-> GenericClass Text)" @@ -66,7 +68,9 @@ "float" "F" "double" "D" "char" "C" - (let [params* (str "<" (->> params (&/|map gclass->signature) (&/|interpose " ") (&/fold str "")) ">")] + (let [params* (if (&/|empty? params) + "" + (str "<" (->> params (&/|map gclass->signature) (&/|interpose " ") (&/fold str "")) ">"))] (str "L" (->bytecode-class-name name) params* ";"))) (&/$GenericArray param) @@ -75,7 +79,9 @@ (defn gsuper-decl->signature [super] "(-> GenericSuperClassDecl Text)" (|let [[super-name super-params] super - params* (str "<" (->> super-params (&/|map gclass->signature) (&/|interpose " ") (&/fold str "")) ">")] + params* (if (&/|empty? super-params) + "" + (str "<" (->> super-params (&/|map gclass->signature) (&/|interpose " ") (&/fold str "")) ">"))] (str "L" (->bytecode-class-name super-name) params* ";"))) (defn gclass-decl->signature [class-decl supers] @@ -132,7 +138,9 @@ (defn method-signatures [method-decl] (|let [[=name =anns =gvars =exceptions =inputs =output] method-decl simple-signature (str "(" (&/fold str "" (&/|map gclass->simple-signature =inputs)) ")" (gclass->simple-signature =output)) - generic-signature (str "<" (->> =gvars (&/|interpose " ") (&/fold str "")) ">" + generic-signature (str (if (&/|empty? =gvars) + "" + (str "<" (->> =gvars (&/|interpose " ") (&/fold str "")) ">")) "(" (&/fold str "" (&/|map gclass->signature =inputs)) ")" (gclass->signature =output) (->> =exceptions (&/|map gclass->signature) (&/|interpose " ") (&/fold str "")))] diff --git a/src/lux/type/host.clj b/src/lux/type/host.clj index 5f19904d3..ff5759923 100644 --- a/src/lux/type/host.clj +++ b/src/lux/type/host.clj @@ -20,35 +20,35 @@ (defn ^:private trace-lineage* [^Class super-class ^Class sub-class] "(-> Class Class (List Class))" ;; Either they're both interfaces, of they're both classes - (cond (.isInterface sub-class) - (let [interface<=interface? #(if (or (= super-class %) - (.isAssignableFrom super-class %)) - % - nil)] + (let [valid-sub? #(if (or (= super-class %) + (.isAssignableFrom super-class %)) + % + nil)] + (cond (.isInterface sub-class) (loop [sub-class sub-class stack (&/|list)] - (let [super-interface (some interface<=interface? - (.getInterfaces sub-class))] + (let [super-interface (some valid-sub? (.getInterfaces sub-class))] (if (= super-class super-interface) (&/Cons$ super-interface stack) - (recur super-interface (&/Cons$ super-interface stack)))))) + (recur super-interface (&/Cons$ super-interface stack))))) - (.isInterface super-class) - (let [class<=interface? #(if (= super-class %) % nil)] + (.isInterface super-class) (loop [sub-class sub-class stack (&/|list)] - (if-let [super-interface (some class<=interface? (.getInterfaces sub-class))] - (&/Cons$ super-interface stack) + (if-let [super-interface (some valid-sub? (.getInterfaces sub-class))] + (if (= super-class super-interface) + (&/Cons$ super-interface stack) + (recur super-interface (&/Cons$ super-interface stack))) (let [super* (.getSuperclass sub-class)] - (recur super* (&/Cons$ super* stack)))))) + (recur super* (&/Cons$ super* stack))))) - :else - (loop [sub-class sub-class - stack (&/|list)] - (let [super* (.getSuperclass sub-class)] - (if (= super* super-class) - (&/Cons$ super* stack) - (recur super* (&/Cons$ super* stack))))))) + :else + (loop [sub-class sub-class + stack (&/|list)] + (let [super* (.getSuperclass sub-class)] + (if (= super* super-class) + (&/Cons$ super* stack) + (recur super* (&/Cons$ super* stack)))))))) (defn ^:private trace-lineage [^Class sub-class ^Class super-class] "(-> Class Class (List Class))" @@ -236,21 +236,21 @@ (defn class-name->type [class-name] (case class-name - "[Z" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "java.lang.Boolean" (&/|list)))))) - "[B" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "java.lang.Byte" (&/|list)))))) - "[S" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "java.lang.Short" (&/|list)))))) - "[I" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "java.lang.Integer" (&/|list)))))) - "[J" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "java.lang.Long" (&/|list)))))) - "[F" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "java.lang.Float" (&/|list)))))) - "[D" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "java.lang.Double" (&/|list)))))) - "[C" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "java.lang.Character" (&/|list)))))) - ;; "[Z" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "boolean" (&/|list)))))) - ;; "[B" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "byte" (&/|list)))))) - ;; "[S" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "short" (&/|list)))))) - ;; "[I" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "int" (&/|list)))))) - ;; "[J" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "long" (&/|list)))))) - ;; "[F" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "float" (&/|list)))))) - ;; "[D" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "double" (&/|list)))))) - ;; "[C" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "char" (&/|list)))))) + ;; "[Z" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "java.lang.Boolean" (&/|list)))))) + ;; "[B" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "java.lang.Byte" (&/|list)))))) + ;; "[S" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "java.lang.Short" (&/|list)))))) + ;; "[I" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "java.lang.Integer" (&/|list)))))) + ;; "[J" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "java.lang.Long" (&/|list)))))) + ;; "[F" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "java.lang.Float" (&/|list)))))) + ;; "[D" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "java.lang.Double" (&/|list)))))) + ;; "[C" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "java.lang.Character" (&/|list)))))) + "[Z" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "boolean" (&/|list)))))) + "[B" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "byte" (&/|list)))))) + "[S" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "short" (&/|list)))))) + "[I" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "int" (&/|list)))))) + "[J" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "long" (&/|list)))))) + "[F" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "float" (&/|list)))))) + "[D" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "double" (&/|list)))))) + "[C" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "char" (&/|list)))))) ;; else (&/V &/$DataT (&/T class-name (&/|list))))) |