- Added support for bounded polymorphism.

- Fixed some minor JVM-interop bugs.

5 files changed, 110 insertions, 58 deletions

diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 11914b1fa..18b4a9dd6 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -4,7 +4,8 @@
 ;;  You can obtain one at http://mozilla.org/MPL/2.0/.
 
 (ns lux.analyser.host
-  (:require (clojure [template :refer [do-template]])
+  (:require (clojure [template :refer [do-template]]
+                     [string :as string])
             clojure.core.match
             clojure.core.match.array
             (lux [base :as & :refer [|let |do return* return fail |case assert!]]
@@ -464,7 +465,7 @@
     (&/$GenericTypeVar var-name)
     "java.lang.Object"
 
-    (&/$GenericWildcard)
+    (&/$GenericWildcard _)
     "java.lang.Object"
     
     (&/$GenericClass name params)
@@ -505,7 +506,7 @@
       (&/$GenericTypeVar var-name)
       "[Ljava.lang.Object;"
 
-      (&/$GenericWildcard)
+      (&/$GenericWildcard _)
       "[Ljava.lang.Object;")
     ))
 
@@ -536,8 +537,8 @@
     (|do [=param (generic-class->type env param)]
       (return (&/$DataT &host-type/array-data-tag (&/|list =param))))
 
-    (&/$GenericWildcard)
-    (return (&/$ExT &/$Nil (&/$BoundT 1)))
+    (&/$GenericWildcard _)
+    (return (&/$ExQ &/$Nil (&/$BoundT 1)))
     ))
 
 (defn gen-super-env [class-env supers class-decl]
@@ -546,7 +547,7 @@
     (|case (&/|some (fn [super]
                       (|let [[super-name super-params] super]
                         (if (= class-name super-name)
-                          (&/$Some (&/zip2 class-vars super-params))
+                          (&/$Some (&/zip2 (&/|map &/|first class-vars) super-params))
                           &/$None)))
                     supers)
       (&/$None)
@@ -560,16 +561,21 @@
               vars+gtypes)
       )))
 
+(defn ^:private make-type-env [type-params]
+  "(-> (List TypeParam) (Lux (List [Text Type])))"
+  (&/map% (fn [gvar]
+            (|do [:let [[gvar-name _] gvar]
+                  ex &type/existential]
+              (return (&/T [gvar-name ex]))))
+          type-params))
+
 (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 (&/$DataT ?cname (&/|map &/|second class-env))]
     (|case method
       (&/$ConstructorMethodSyntax =privacy-modifier ?strict ?anns ?gvars ?exceptions ?inputs ?ctor-args ?body)
-      (|do [method-env (&/map% (fn [gvar]
-                                 (|do [ex &type/existential]
-                                   (return (&/T [gvar ex]))))
-                               ?gvars)
+      (|do [method-env (make-type-env ?gvars)
             :let [full-env (&/|++ class-env method-env)]
             :let [output-type &/$UnitT]
             =ctor-args (&/map% (fn [ctor-arg]
@@ -590,10 +596,7 @@
         (return (&/$ConstructorMethodAnalysis (&/T [=privacy-modifier ?strict ?anns ?gvars ?exceptions ?inputs =ctor-args =body]))))
       
       (&/$VirtualMethodSyntax ?name =privacy-modifier =final? ?strict ?anns ?gvars ?exceptions ?inputs ?output ?body)
-      (|do [method-env (&/map% (fn [gvar]
-                                 (|do [ex &type/existential]
-                                   (return (&/T [gvar ex]))))
-                               ?gvars)
+      (|do [method-env (make-type-env ?gvars)
             :let [full-env (&/|++ class-env method-env)]
             output-type (generic-class->type full-env ?output)
             =body (&/with-type-env full-env
@@ -609,10 +612,7 @@
       
       (&/$OverridenMethodSyntax ?class-decl ?name ?strict ?anns ?gvars ?exceptions ?inputs ?output ?body)
       (|do [super-env (gen-super-env class-env all-supers ?class-decl)
-            method-env (&/map% (fn [gvar]
-                                 (|do [ex &type/existential]
-                                   (return (&/T [gvar ex]))))
-                               ?gvars)
+            method-env (make-type-env ?gvars)
             :let [full-env (&/|++ super-env method-env)]
             output-type (generic-class->type full-env ?output)
             =body (&/with-type-env full-env
@@ -627,10 +627,7 @@
         (return (&/$OverridenMethodAnalysis (&/T [?class-decl ?name ?strict ?anns ?gvars ?exceptions ?inputs ?output =body]))))
 
       (&/$StaticMethodSyntax ?name =privacy-modifier ?strict ?anns ?gvars ?exceptions ?inputs ?output ?body)
-      (|do [method-env (&/map% (fn [gvar]
-                                 (|do [ex &type/existential]
-                                   (return (&/T [gvar ex]))))
-                               ?gvars)
+      (|do [method-env (make-type-env ?gvars)
             :let [full-env method-env]
             output-type (generic-class->type full-env ?output)
             =body (&/with-type-env full-env
@@ -716,15 +713,13 @@
   (&/with-closure
     (|do [module &/get-module-name
           :let [[?name ?params] class-decl
-                full-name (str module "." ?name)
+                full-name (str (string/replace module "/" ".") "." ?name)
+                class-decl* (&/T [full-name ?params])
                 all-supers (&/$Cons super-class interfaces)]
-          class-env (&/map% (fn [gvar]
-                              (|do [ex &type/existential]
-                                (return (&/T [gvar ex]))))
-                            ?params)
+          class-env (make-type-env ?params)
           =fields (&/map% (partial analyse-field analyse class-env) ?fields)
           _ (&host/use-dummy-class class-decl super-class interfaces &/$None =fields methods)
-          =methods (&/map% (partial analyse-method analyse class-decl class-env all-supers) methods)
+          =methods (&/map% (partial analyse-method analyse class-decl* class-env all-supers) methods)
           _ (check-method-completion all-supers =methods)
           _ (compile-token (&&/$jvm-class (&/T [class-decl super-class interfaces =inheritance-modifier =anns =fields =methods &/$Nil &/$None])))
           :let [_ (println 'DEF full-name)]]
@@ -757,7 +752,7 @@
             scope &/get-scope-name
             :let [name (&host/location (&/|tail scope))
                   class-decl (&/T [name &/$Nil])
-                  anon-class (str module "." name)
+                  anon-class (str (string/replace module "/" ".") "." name)
                   anon-class-type (&/$DataT anon-class &/$Nil)]
             =ctor-args (&/map% (fn [ctor-arg]
                                  (|let [[arg-type arg-term] ctor-arg]
diff --git a/src/lux/analyser/parser.clj b/src/lux/analyser/parser.clj
index 980e23535..dca09bb61 100644
--- a/src/lux/analyser/parser.clj
+++ b/src/lux/analyser/parser.clj
@@ -9,6 +9,8 @@
             clojure.core.match.array
             (lux [base :as & :refer [|do return* return fail fail* |let |case]])))
 
+(declare parse-gclass)
+
 ;; [Parsers]
 (defn parse-tag [ast]
   (|case ast
@@ -26,19 +28,44 @@
     _
     (fail (str "[Analyser Error] Not text: " (&/show-ast ast)))))
 
+(defn parse-type-param [ast]
+  (|case ast
+    [_ (&/$TupleS (&/$Cons [_ (&/$TextS tname)] (&/$Cons [_ (&/$TupleS ?bounds)] (&/$Nil))))]
+    (|do [=bounds (&/map% parse-gclass ?bounds)]
+      (return (&/T [tname =bounds])))
+
+    _
+    (fail (str "[Analyser Error] Not a type-param: " (&/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)]
+    (|do [=args (&/map% parse-type-param args)]
       (return (&/T [class-name =args])))
 
     _
     (fail (str "[Analyser Error] Not generic class declaration: " (&/show-ast ast)))))
 
+(defn parse-bound-kind [ast]
+  (|case ast
+    [_ (&/$TextS "<")]
+    (return &/$UpperBound)
+
+    [_ (&/$TextS ">")]
+    (return &/$LowerBound)
+
+    _
+    (fail (str "[Analyser Error] Not a bound kind: " (&/show-ast ast)))))
+
 (defn parse-gclass [ast]
   (|case ast
-    [_ (&/$TextS "*")]
-    (return (&/$GenericWildcard &/unit-tag))
+    [_ (&/$TupleS (&/$Cons [_ (&/$TextS "*")] (&/$Nil)))]
+    (return (&/$GenericWildcard &/$None))
+
+    [_ (&/$TupleS (&/$Cons [_ (&/$TextS "*")] (&/$Cons ?bound-kind (&/$Cons ?bound (&/$Nil)))))]
+    (|do [=bound-kind (parse-bound-kind ?bound-kind)
+          =bound (parse-gclass ?bound)]
+      (return (&/$GenericWildcard (&/$Some (&/T [=bound-kind =bound])))))
 
     [_ (&/$TextS var-name)]
     (return (&/$GenericTypeVar var-name))
@@ -135,7 +162,8 @@
                                    (&/$Cons [_ (&/$TupleS gvars)]
                                             (&/$Cons [_ (&/$TupleS exceptions)]
                                                      (&/$Cons [_ (&/$TupleS inputs)]
-                                                              (&/$Cons output (&/$Nil))))))))]
+                                                              (&/$Cons output
+                                                                       (&/$Nil))))))))]
     (|do [=anns (&/map% parse-ann anns)
           =gvars (&/map% parse-text gvars)
           =exceptions (&/map% parse-gclass exceptions)
@@ -201,10 +229,11 @@
                                                               (&/$Cons [_ (&/$TupleS exceptions)]
                                                                        (&/$Cons [_ (&/$TupleS inputs)]
                                                                                 (&/$Cons [_ (&/$TupleS ?ctor-args)]
-                                                                                         (&/$Cons body (&/$Nil)))))))))))]
+                                                                                         (&/$Cons body
+                                                                                                  (&/$Nil)))))))))))]
     (|do [=privacy-modifier (parse-privacy-modifier ?privacy-modifier)
           =anns (&/map% parse-ann anns)
-          =gvars (&/map% parse-text gvars)
+          =gvars (&/map% parse-type-param gvars)
           =exceptions (&/map% parse-gclass exceptions)
           =inputs (&/map% parse-arg-decl inputs)
           =ctor-args (&/map% parse-ctor-arg ?ctor-args)]
@@ -225,10 +254,11 @@
                                                                                 (&/$Cons [_ (&/$TupleS exceptions)]
                                                                                          (&/$Cons [_ (&/$TupleS inputs)]
                                                                                                   (&/$Cons output
-                                                                                                           (&/$Cons body (&/$Nil)))))))))))))]
+                                                                                                           (&/$Cons body
+                                                                                                                    (&/$Nil)))))))))))))]
     (|do [=privacy-modifier (parse-privacy-modifier ?privacy-modifier)
           =anns (&/map% parse-ann anns)
-          =gvars (&/map% parse-text gvars)
+          =gvars (&/map% parse-type-param gvars)
           =exceptions (&/map% parse-gclass exceptions)
           =inputs (&/map% parse-arg-decl inputs)
           =output (parse-gclass output)]
@@ -248,11 +278,12 @@
                                                                        (&/$Cons [_ (&/$TupleS exceptions)]
                                                                                 (&/$Cons [_ (&/$TupleS inputs)]
                                                                                          (&/$Cons output
-                                                                                                  (&/$Cons body (&/$Nil))))))))))))]
+                                                                                                  (&/$Cons body
+                                                                                                           (&/$Nil))))))))))))]
     (|do [=name (parse-text ?name)
           =class-decl (parse-gclass-decl ?class-decl)
           =anns (&/map% parse-ann anns)
-          =gvars (&/map% parse-text gvars)
+          =gvars (&/map% parse-type-param gvars)
           =exceptions (&/map% parse-gclass exceptions)
           =inputs (&/map% parse-arg-decl inputs)
           =output (parse-gclass output)]
@@ -272,10 +303,11 @@
                                                                        (&/$Cons [_ (&/$TupleS exceptions)]
                                                                                 (&/$Cons [_ (&/$TupleS inputs)]
                                                                                          (&/$Cons output
-                                                                                                  (&/$Cons body (&/$Nil))))))))))))]
+                                                                                                  (&/$Cons body
+                                                                                                           (&/$Nil))))))))))))]
     (|do [=privacy-modifier (parse-privacy-modifier ?privacy-modifier)
           =anns (&/map% parse-ann anns)
-          =gvars (&/map% parse-text gvars)
+          =gvars (&/map% parse-type-param gvars)
           =exceptions (&/map% parse-gclass exceptions)
           =inputs (&/map% parse-arg-decl inputs)
           =output (parse-gclass output)]
@@ -297,7 +329,7 @@
                                                                                          (&/$Nil))))))))))]
     (|do [=privacy-modifier (parse-privacy-modifier ?privacy-modifier)
           =anns (&/map% parse-ann anns)
-          =gvars (&/map% parse-text gvars)
+          =gvars (&/map% parse-type-param gvars)
           =exceptions (&/map% parse-gclass exceptions)
           =inputs (&/map% parse-arg-decl inputs)
           =output (parse-gclass output)]
@@ -319,7 +351,7 @@
                                                                                          (&/$Nil))))))))))]
     (|do [=privacy-modifier (parse-privacy-modifier ?privacy-modifier)
           =anns (&/map% parse-ann anns)
-          =gvars (&/map% parse-text gvars)
+          =gvars (&/map% parse-type-param gvars)
           =exceptions (&/map% parse-gclass exceptions)
           =inputs (&/map% parse-arg-decl inputs)
           =output (parse-gclass output)]
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 581930e3a..5e46694e2 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -153,6 +153,10 @@
 
 ;; Compiler
 (defvariant
+  ("UpperBound" 0)
+  ("LowerBound" 0))
+
+(defvariant
   ("GenericTypeVar" 1)
   ("GenericClass" 2)
   ("GenericArray" 1)
diff --git a/src/lux/host/generics.clj b/src/lux/host/generics.clj
index 0d34fe1a4..53cc98e6e 100644
--- a/src/lux/host/generics.clj
+++ b/src/lux/host/generics.clj
@@ -11,6 +11,8 @@
             (lux [base :as & :refer [|do return* return fail fail* |let |case]]))
   (:import java.util.regex.Pattern))
 
+(declare gclass->signature)
+
 (do-template [<name> <old-sep> <new-sep>]
   (let [regex (-> <old-sep> Pattern/quote re-pattern)]
     (defn <name> [old]
@@ -46,10 +48,23 @@
   (|let [[super-name super-params] super]
     super-name))
 
-(defn class-decl-params->signature [params]
+(defn formal-type-parameter->signature [param]
+  (|let [[pname pbounds] param]
+    (|case pbounds
+      (&/$Nil)
+      pname
+
+      _
+      (->> pbounds
+           (&/|map (fn [pbound] (str ": " (gclass->signature pbound))))
+           (&/|interpose " ")
+           (str pname " "))
+      )))
+
+(defn formal-type-parameters->signature [params]
   (if (&/|empty? params)
     ""
-    (str "<" (->> params (&/|interpose " ") (&/fold str "")) ">")))
+    (str "<" (->> params (&/|map formal-type-parameter->signature) (&/|interpose " ") (&/fold str "")) ">")))
 
 (defn gclass->signature [super]
   "(-> GenericClass Text)"
@@ -57,8 +72,14 @@
     (&/$GenericTypeVar name)
     (str "T" name ";")
 
-    (&/$GenericWildcard)
+    (&/$GenericWildcard (&/$None))
     "*"
+
+    (&/$GenericWildcard (&/$Some [(&/$UpperBound) ?bound]))
+    (str "+" (gclass->signature ?bound))
+
+    (&/$GenericWildcard (&/$Some [(&/$LowerBound) ?bound]))
+    (str "-" (gclass->signature ?bound))
     
     (&/$GenericClass name params)
     (case name
@@ -67,7 +88,7 @@
       "byte"    "B"
       "short"   "S"
       "int"     "I"
-      "long"    "L"
+      "long"    "J"
       "float"   "F"
       "double"  "D"
       "char"    "C"
@@ -90,7 +111,7 @@
 (defn gclass-decl->signature [class-decl supers]
   "(-> GenericClassDecl (List GenericSuperClassDecl) Text)"
   (|let [[class-name class-vars] class-decl
-         vars-section (class-decl-params->signature class-vars)
+         vars-section (formal-type-parameters->signature class-vars)
          super-section (->> (&/|map gsuper-decl->signature supers) (&/|interpose " ") (&/fold str ""))]
     (str vars-section super-section)))
 
@@ -101,7 +122,7 @@
       (&/$GenericTypeVar name)
       object-simple-signature
 
-      (&/$GenericWildcard)
+      (&/$GenericWildcard _)
       object-simple-signature
       
       (&/$GenericClass name params)
@@ -119,7 +140,7 @@
     (&/$GenericTypeVar name)
     (->bytecode-class-name "java.lang.Object")
 
-    (&/$GenericWildcard)
+    (&/$GenericWildcard _)
     (->bytecode-class-name "java.lang.Object")
     
     (&/$GenericClass name params)
@@ -139,7 +160,7 @@
       (&/$GenericTypeVar name)
       object-bc-name
 
-      (&/$GenericWildcard)
+      (&/$GenericWildcard _)
       object-bc-name
       
       (&/$GenericClass name params)
@@ -157,7 +178,7 @@
       (&/$GenericTypeVar name)
       object-bc-name
 
-      (&/$GenericWildcard)
+      (&/$GenericWildcard _)
       object-bc-name
       
       (&/$GenericClass name params)
@@ -169,9 +190,7 @@
 (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 (if (&/|empty? =gvars)
-                                  ""
-                                  (str "<" (->> =gvars (&/|interpose " ") (&/fold str "")) ">"))
+         generic-signature (str (formal-type-parameters->signature =gvars)
                                 "(" (&/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 9717b0e75..096fb2182 100644
--- a/src/lux/type/host.clj
+++ b/src/lux/type/host.clj
@@ -271,8 +271,10 @@
 
         (instance? WildcardType gtype)
         (if-let [bound (->> ^WildcardType gtype .getUpperBounds seq first)]
-          (gtype->gclass bound)
-          &/$GenericWildcard)))
+          (&/$GenericWildcard (&/$Some (&/T &/$UpperBound (gtype->gclass bound))))
+          (if-let [bound (->> ^WildcardType gtype .getLowerBounds seq first)]
+            (&/$GenericWildcard (&/$Some (&/T &/$LowerBound (gtype->gclass bound))))
+            (&/$GenericWildcard &/$None)))))
 
 (let [generic-type-sig "Ljava/lang/Object;"]
   (defn gclass->sig [gclass]
@@ -297,6 +299,6 @@
       (&/$GenericTypeVar ?vname)
       generic-type-sig
 
-      (&/$GenericWildcard)
+      (&/$GenericWildcard _)
       generic-type-sig
       )))