aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/lux/analyser/case.clj2
-rw-r--r--src/lux/analyser/lux.clj50
-rw-r--r--src/lux/analyser/parser.clj10
-rw-r--r--src/lux/base.clj5
-rw-r--r--src/lux/host/generics.clj18
5 files changed, 49 insertions, 36 deletions
diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj
index d975d8989..e0db07092 100644
--- a/src/lux/analyser/case.clj
+++ b/src/lux/analyser/case.clj
@@ -184,7 +184,7 @@
(return (&/T (&/V $TupleTestAC =tests) =kont))))
_
- (fail (str "[Pattern-matching Error] Tuples require tuple-types: " (&type/show-type value-type*) " -- " (&/show-ast pattern)))))
+ (fail (str "[Pattern-matching Error] Tuples require tuple-types: " (&type/show-type value-type)))))
(&/$RecordS pairs)
(|do [[rec-members rec-type] (&&record/order-record pairs)]
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 1ad187f77..3b65d77b1 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -434,32 +434,34 @@
))))))
_
- (|do [exo-type* (&type/actual-type exo-type)]
- (|case exo-type
- (&/$UnivQ _)
- (|do [$var &type/existential
- exo-type** (&type/apply-type exo-type* $var)]
- (analyse-lambda* analyse exo-type** ?self ?arg ?body))
+ (&/with-attempt
+ (|do [exo-type* (&type/actual-type exo-type)]
+ (|case exo-type
+ (&/$UnivQ _)
+ (|do [$var &type/existential
+ exo-type** (&type/apply-type exo-type* $var)]
+ (analyse-lambda* analyse exo-type** ?self ?arg ?body))
- (&/$ExQ _)
- (&type/with-var
- (fn [$var]
- (|do [exo-type** (&type/apply-type exo-type* $var)]
- (analyse-lambda* analyse exo-type** ?self ?arg ?body))))
-
- (&/$LambdaT ?arg-t ?return-t)
- (|do [[=scope =captured =body] (&&lambda/with-lambda ?self exo-type*
- ?arg ?arg-t
- (&&/analyse-1 analyse ?return-t ?body))
- _cursor &/cursor]
- (return (&&/|meta exo-type* _cursor
- (&/V &&/$lambda (&/T =scope =captured =body)))))
+ (&/$ExQ _)
+ (&type/with-var
+ (fn [$var]
+ (|do [exo-type** (&type/apply-type exo-type* $var)]
+ (analyse-lambda* analyse exo-type** ?self ?arg ?body))))
+
+ (&/$LambdaT ?arg-t ?return-t)
+ (|do [[=scope =captured =body] (&&lambda/with-lambda ?self exo-type*
+ ?arg ?arg-t
+ (&&/analyse-1 analyse ?return-t ?body))
+ _cursor &/cursor]
+ (return (&&/|meta exo-type* _cursor
+ (&/V &&/$lambda (&/T =scope =captured =body)))))
-
-
- _
- (fail (str "[Analyser Error] Functions require function types: "
- (&type/show-type exo-type*)))))
+
+
+ _
+ (fail "")))
+ (fn [err]
+ (fail (str "[Analyser Error] Functions require function types: " (&type/show-type exo-type)))))
))
(defn analyse-lambda** [analyse exo-type ?self ?arg ?body]
diff --git a/src/lux/analyser/parser.clj b/src/lux/analyser/parser.clj
index feb9d1928..238defe69 100644
--- a/src/lux/analyser/parser.clj
+++ b/src/lux/analyser/parser.clj
@@ -45,12 +45,16 @@
(defn parse-gclass [ast]
(|case ast
+ [_ (&/$TextS var-name)]
+ (return (&/V &/$GenericTypeVar var-name))
+
[_ (&/$FormS (&/$Cons [_ (&/$TextS class-name)] (&/$Cons [_ (&/$TupleS params)] (&/$Nil))))]
(|do [=params (&/map% parse-gclass params)]
- (return (&/V &/$GClass (&/T class-name =params))))
+ (return (&/V &/$GenericClass (&/T class-name =params))))
- [_ (&/$TextS var-name)]
- (return (&/V &/$GTypeVar var-name))
+ [_ (&/$FormS (&/$Cons [_ (&/$TextS "Array")] (&/$Cons param (&/$Nil))))]
+ (|do [=param (parse-gclass param)]
+ (return (&/V &/$GenericArray =param)))
_
(fail (str "[Analyser Error] Not generic class: " (&/show-ast ast)))))
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 6e527db1e..e570a1399 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -108,8 +108,9 @@
;; Compiler
(deftags
- ["GClass"
- "GTypeVar"])
+ ["GenericTypeVar"
+ "GenericClass"
+ "GenericArray"])
;; [Exports]
(def datum-field "_datum")
diff --git a/src/lux/host/generics.clj b/src/lux/host/generics.clj
index df04d9305..9ec451ed6 100644
--- a/src/lux/host/generics.clj
+++ b/src/lux/host/generics.clj
@@ -18,12 +18,15 @@
(defn gclass->signature [super]
"(-> GenericClass Text)"
(|case super
- (&/$GTypeVar name)
+ (&/$GenericTypeVar name)
(str "T" name ";")
- (&/$GClass name params)
+ (&/$GenericClass name params)
(|let [params-sigs (->> params (&/|map gclass->signature) (&/|interpose " ") (&/fold str ""))]
- (str "L" (&host/->class name) "<" params-sigs ">" ";"))))
+ (str "L" (&host/->class name) "<" params-sigs ">" ";"))
+
+ (&/$GenericArray param)
+ (str "[" (gclass->signature param))))
(defn gsuper-decl->signature [super]
"(-> GenericSuperClassDecl Text)"
@@ -42,8 +45,11 @@
(defn gclass->simple-signature [gclass]
"(-> GenericClass Text)"
(|case gclass
- (&/$GTypeVar name)
+ (&/$GenericTypeVar name)
object-simple-signature
- (&/$GClass name params)
- (&host/->type-signature name))))
+ (&/$GenericClass name params)
+ (&host/->type-signature name)
+
+ (&/$GenericArray param)
+ (str "[" (gclass->simple-signature param)))))