diff options
| -rw-r--r-- | src/lux/analyser/case.clj | 2 | ||||
| -rw-r--r-- | src/lux/analyser/lux.clj | 50 | ||||
| -rw-r--r-- | src/lux/analyser/parser.clj | 10 | ||||
| -rw-r--r-- | src/lux/base.clj | 5 | ||||
| -rw-r--r-- | src/lux/host/generics.clj | 18 |
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))))) |