aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2016-10-03 22:11:21 -0400
committerEduardo Julian2016-10-03 22:11:21 -0400
commit48fc59df88fe93fed5951ee6c693cbf98db736c6 (patch)
treeb86870045140fd395f1bfb738ca6939b9bfb5921
parent54453d32320c5e051c8b5258daadd49e4292d9ae (diff)
- Slight refactoring.
-rw-r--r--src/lux/compiler.clj1
-rw-r--r--src/lux/host/generics.clj9
-rw-r--r--src/lux/type/host.clj45
3 files changed, 27 insertions, 28 deletions
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 3ff4a053d..9443b188c 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -106,7 +106,6 @@
(&o/$function ?arity ?scope ?env ?body)
(&&lambda/compile-function compile-expression &/$None ?arity ?scope ?env ?body)
- ;; TODO: Must get rid of this one...
(&o/$ann ?value-ex ?type-ex)
(compile-expression $begin ?value-ex)
diff --git a/src/lux/host/generics.clj b/src/lux/host/generics.clj
index 0f4339d61..cfd0d2d54 100644
--- a/src/lux/host/generics.clj
+++ b/src/lux/host/generics.clj
@@ -155,7 +155,6 @@
_
(assert false (str 'gclass->class-name " " (&/adt->text gclass)))))
-;; TODO: CLEAN THIS UP, IT'S DOING A HACK BY TREATING GCLASSES AS GVARS
(let [object-bc-name (->bytecode-class-name "java.lang.Object")]
(defn gclass->bytecode-class-name* [gclass type-env]
"(-> GenericClass Text)"
@@ -167,12 +166,18 @@
object-bc-name
(&/$GenericClass name params)
+ ;; When referring to type-parameters during class or method
+ ;; definition, a type-environment is set for storing the names
+ ;; of such parameters.
+ ;; When a "class" shows up with the name of one of those
+ ;; parameters, it must be detected, and the bytecode class-name
+ ;; must correspond to Object's.
(if (&/|get name type-env)
object-bc-name
(->bytecode-class-name name))
(&/$GenericArray param)
- (assert false "gclass->bytecode-class-name doesn't work on arrays."))))
+ (assert false "gclass->bytecode-class-name* doesn't work on arrays."))))
(let [object-bc-name (->bytecode-class-name "java.lang.Object")]
(defn gclass->bytecode-class-name [gclass]
diff --git a/src/lux/type/host.clj b/src/lux/type/host.clj
index 7a244b446..462e1aebe 100644
--- a/src/lux/type/host.clj
+++ b/src/lux/type/host.clj
@@ -156,7 +156,6 @@
(principal-class bound)
(&host-generics/->type-signature "java.lang.Object"))))
-;; TODO: CLEAN THIS UP, IT'S DOING A HACK BY TREATING GCLASSES AS GVARS
(defn instance-gtype [existential matchings gtype]
"(-> (Lux Type) (List (, Text Type)) GenericType (Lux Type))"
(|case gtype
@@ -165,6 +164,13 @@
(return (&/$HostT array-data-tag (&/|list inner-type))))
(&/$GenericClass type-name type-params)
+ ;; When referring to type-parameters during class or method
+ ;; definition, a type-environment is set for storing the names
+ ;; of such parameters.
+ ;; When a "class" shows up with the name of one of those
+ ;; parameters, it must be detected, and the bytecode class-name
+ ;; must correspond to Object's.
+
(if-let [m-type (&/|get type-name matchings)]
(return m-type)
(|do [params* (&/map% (partial instance-gtype existential matchings)
@@ -253,39 +259,28 @@
(|let [[e!name e!params] expected
[a!name a!params] actual]
;; TODO: Delete first branch. It smells like a hack...
- (try (cond (= "java.lang.Object" e!name)
- (return fixpoints)
-
- (= null-data-tag a!name)
- (if (not (primitive-type? e!name))
- (return fixpoints)
- (check-error "" (&/$HostT e!name e!params) (&/$HostT a!name a!params)))
-
- (= null-data-tag e!name)
- (if (= null-data-tag a!name)
- (return fixpoints)
- (check-error "" (&/$HostT e!name e!params) (&/$HostT a!name a!params)))
-
- (and (= array-data-tag e!name)
- (not= array-data-tag a!name))
- (check-error "" (&/$HostT e!name e!params) (&/$HostT a!name a!params))
-
- (or (and (= nat-data-tag e!name)
+ (try (cond (or (= "java.lang.Object" e!name)
+ (and (= nat-data-tag e!name)
(= nat-data-tag a!name))
(and (= frac-data-tag e!name)
- (= frac-data-tag a!name)))
+ (= frac-data-tag a!name))
+ (and (= null-data-tag e!name)
+ (= null-data-tag a!name))
+ (and (not (primitive-type? e!name))
+ (= null-data-tag a!name)))
(return fixpoints)
- (or (= nat-data-tag e!name)
- (= nat-data-tag a!name)
- (= frac-data-tag e!name)
- (= frac-data-tag a!name))
+ (or (and (= array-data-tag e!name)
+ (not= array-data-tag a!name))
+ (= nat-data-tag e!name) (= nat-data-tag a!name)
+ (= frac-data-tag e!name) (= frac-data-tag a!name)
+ (= null-data-tag e!name) (= null-data-tag a!name))
(check-error "" (&/$HostT e!name e!params) (&/$HostT a!name a!params))
:else
(let [e!name (as-obj e!name)
a!name (as-obj a!name)]
- (cond (.equals ^Object e!name a!name)
+ (cond (= e!name a!name)
(if (= (&/|length e!params) (&/|length a!params))
(|do [_ (&/map2% check e!params a!params)]
(return fixpoints))