aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/lux/analyser/base.clj4
-rw-r--r--src/lux/analyser/case.clj85
-rw-r--r--src/lux/analyser/host.clj2
-rw-r--r--src/lux/analyser/lux.clj151
-rw-r--r--src/lux/base.clj6
-rw-r--r--src/lux/compiler/host.clj2
-rw-r--r--src/lux/compiler/type.clj6
-rw-r--r--src/lux/host.clj2
-rw-r--r--src/lux/type.clj37
-rw-r--r--src/lux/type/host.clj2
10 files changed, 178 insertions, 119 deletions
diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj
index 2e431770a..710da6eda 100644
--- a/src/lux/analyser/base.clj
+++ b/src/lux/analyser/base.clj
@@ -6,7 +6,7 @@
(ns lux.analyser.base
(:require clojure.core.match
clojure.core.match.array
- (lux [base :as & :refer [deftags |let |do return fail |case]]
+ (lux [base :as & :refer [deftags |let |do return* return fail |case]]
[type :as &type])))
;; [Tags]
@@ -185,7 +185,7 @@
(return ?module))]
(return (&/T module* ?name))))
-(let [tag-names #{"DataT" "VariantT" "TupleT" "LambdaT" "BoundT" "VarT" "ExT" "UnivQ" "ExQ" "AppT" "NamedT"}]
+(let [tag-names #{"DataT" "VoidT" "UnitT" "VariantT" "TupleT" "LambdaT" "BoundT" "VarT" "ExT" "UnivQ" "ExQ" "AppT" "NamedT"}]
(defn type-tag? [module name]
(and (= "lux" module)
(contains? tag-names name))))
diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj
index e0db07092..0fad10cea 100644
--- a/src/lux/analyser/case.clj
+++ b/src/lux/analyser/case.clj
@@ -116,6 +116,9 @@
(&/$NamedT ?name ?type)
(adjust-type* up ?type)
+ (&/$UnitT)
+ (return type)
+
_
(fail (str "[Pattern-matching Error] Can't adjust type: " (&type/show-type type)))
))
@@ -169,22 +172,29 @@
(return (&/T (&/V $TextTestAC ?value) =kont)))
(&/$TupleS ?members)
- (|do [value-type* (adjust-type value-type)]
- (|case value-type*
- (&/$TupleT ?member-types)
- (if (not (.equals ^Object (&/|length ?member-types) (&/|length ?members)))
- (fail (str "[Pattern-matching Error] Pattern-matching mismatch. Require tuple[" (&/|length ?member-types) "]. Given tuple [" (&/|length ?members) "]" " -- " (&/show-ast pattern)))
- (|do [[=tests =kont] (&/fold (fn [kont* vm]
- (|let [[v m] vm]
- (|do [[=test [=tests =kont]] (analyse-pattern &/None$ v m kont*)]
- (return (&/T (&/Cons$ =test =tests) =kont)))))
- (|do [=kont kont]
- (return (&/T &/Nil$ =kont)))
- (&/|reverse (&/zip2 ?member-types ?members)))]
- (return (&/T (&/V $TupleTestAC =tests) =kont))))
+ (|case ?members
+ (&/$Nil)
+ (|do [_ (&type/check value-type &type/Unit)
+ =kont kont]
+ (return (&/T (&/V $TupleTestAC (&/|list)) =kont)))
- _
- (fail (str "[Pattern-matching Error] Tuples require tuple-types: " (&type/show-type value-type)))))
+ _
+ (|do [value-type* (adjust-type value-type)]
+ (|case value-type*
+ (&/$TupleT ?member-types)
+ (if (not (.equals ^Object (&/|length ?member-types) (&/|length ?members)))
+ (fail (str "[Pattern-matching Error] Pattern-matching mismatch. Require tuple[" (&/|length ?member-types) "]. Given tuple [" (&/|length ?members) "]" " -- " (&/show-ast pattern)))
+ (|do [[=tests =kont] (&/fold (fn [kont* vm]
+ (|let [[v m] vm]
+ (|do [[=test [=tests =kont]] (analyse-pattern &/None$ v m kont*)]
+ (return (&/T (&/Cons$ =test =tests) =kont)))))
+ (|do [=kont kont]
+ (return (&/T &/Nil$ =kont)))
+ (&/|reverse (&/zip2 ?member-types ?members)))]
+ (return (&/T (&/V $TupleTestAC =tests) =kont))))
+
+ _
+ (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)]
@@ -340,24 +350,35 @@
(return ?total))
($TupleTotal ?total ?structs)
- (|do [unknown? (&type/unknown? value-type)]
- (if unknown?
- (|do [=structs (&/map% (check-totality+ check-totality) ?structs)
- _ (&type/check value-type (&/V &/$TupleT (&/|map &/|second =structs)))]
- (return (or ?total
- (&/fold #(and %1 %2) true (&/|map &/|first =structs)))))
- (if ?total
+ (|case ?structs
+ (&/$Nil)
+ (|do [value-type* (resolve-type value-type)]
+ (|case value-type*
+ (&/$UnitT)
(return true)
- (|do [value-type* (resolve-type value-type)]
- (|case value-type*
- (&/$TupleT ?members)
- (|do [totals (&/map2% (fn [sub-struct ?member]
- (check-totality ?member sub-struct))
- ?structs ?members)]
- (return (&/fold #(and %1 %2) true totals)))
-
- _
- (fail "[Pattern-maching Error] Tuple is not total."))))))
+
+ _
+ (fail "[Pattern-maching Error] Unit is not total.")))
+
+ _
+ (|do [unknown? (&type/unknown? value-type)]
+ (if unknown?
+ (|do [=structs (&/map% (check-totality+ check-totality) ?structs)
+ _ (&type/check value-type (&/V &/$TupleT (&/|map &/|second =structs)))]
+ (return (or ?total
+ (&/fold #(and %1 %2) true (&/|map &/|first =structs)))))
+ (if ?total
+ (return true)
+ (|do [value-type* (resolve-type value-type)]
+ (|case value-type*
+ (&/$TupleT ?members)
+ (|do [totals (&/map2% (fn [sub-struct ?member]
+ (check-totality ?member sub-struct))
+ ?structs ?members)]
+ (return (&/fold #(and %1 %2) true totals)))
+
+ _
+ (fail "[Pattern-maching Error] Tuple is not total.")))))))
($VariantTotal ?total ?structs)
(if ?total
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index b729ffd33..5a85fbe66 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -677,9 +677,7 @@
?params)
_ (&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)
- ;; :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 (&/|list) &/None$)))
:let [_ (println 'DEF full-name)]]
(return &/Nil$))))
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 09e01b6aa..834b75f5a 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -43,73 +43,88 @@
(&type/Lambda$ input output)))
;; [Exports]
-(defn analyse-tuple [analyse ?exo-type ?elems]
- (|case ?exo-type
- (&/$Left exo-type)
- (|do [exo-type* (&type/actual-type exo-type)]
- (|case exo-type*
- (&/$UnivQ _)
- (&type/with-var
- (fn [$var]
- (|do [exo-type** (&type/apply-type exo-type* $var)
- [[tuple-type tuple-cursor] tuple-analysis] (&&/cap-1 (analyse-tuple analyse (&/V &/$Left exo-type**) ?elems))
- =var (&type/resolve-type $var)
- inferred-type (|case =var
- (&/$VarT iid)
- (|do [:let [=var* (next-bound-type tuple-type)]
- _ (&type/set-var iid =var*)
- tuple-type* (&type/clean $var tuple-type)]
- (return (&type/Univ$ &/Nil$ tuple-type*)))
+(defn analyse-unit [analyse ?exo-type]
+ (|do [_cursor &/cursor
+ _ (&type/check ?exo-type &type/Unit)]
+ (return (&/|list (&&/|meta ?exo-type _cursor
+ (&/V &&/$tuple (&/|list)))))))
- _
- (&type/clean $var tuple-type))]
- (return (&/|list (&&/|meta inferred-type tuple-cursor
- tuple-analysis))))))
+(defn analyse-tuple [analyse ?exo-type ?elems]
+ (|case ?elems
+ (&/$Nil)
+ (analyse-unit analyse (|case ?exo-type
+ (&/$Left exo-type) exo-type
+ (&/$Right exo-type) exo-type))
- _
- (analyse-tuple analyse (&/V &/$Right exo-type*) ?elems)))
+ _
+ (|case ?exo-type
+ (&/$Left exo-type)
+ (|do [exo-type* (&type/actual-type exo-type)]
+ (|case exo-type*
+ (&/$UnivQ _)
+ (&type/with-var
+ (fn [$var]
+ (|do [exo-type** (&type/apply-type exo-type* $var)
+ [[tuple-type tuple-cursor] tuple-analysis] (&&/cap-1 (analyse-tuple analyse (&/V &/$Left exo-type**) ?elems))
+ =var (&type/resolve-type $var)
+ inferred-type (|case =var
+ (&/$VarT iid)
+ (|do [:let [=var* (next-bound-type tuple-type)]
+ _ (&type/set-var iid =var*)
+ tuple-type* (&type/clean $var tuple-type)]
+ (return (&type/Univ$ &/Nil$ tuple-type*)))
+
+ _
+ (&type/clean $var tuple-type))]
+ (return (&/|list (&&/|meta inferred-type tuple-cursor
+ tuple-analysis))))))
- (&/$Right exo-type)
- (|do [unknown? (&type/unknown? exo-type)]
- (if unknown?
- (|do [=elems (&/map% #(|do [=analysis (&&/analyse-1+ analyse %)]
- (return =analysis))
- ?elems)
- _ (&type/check exo-type (&/V &/$TupleT (&/|map &&/expr-type* =elems)))
- _cursor &/cursor]
- (return (&/|list (&&/|meta exo-type _cursor
- (&/V &&/$tuple =elems)
- ))))
- (|do [exo-type* (&type/actual-type exo-type)]
- (&/with-attempt
- (|case exo-type*
- (&/$TupleT ?members)
- (|do [=elems (&/map2% (fn [elem-t elem]
- (&&/analyse-1 analyse elem-t elem))
- ?members ?elems)
- _cursor &/cursor]
- (return (&/|list (&&/|meta exo-type _cursor
- (&/V &&/$tuple =elems)
- ))))
-
- (&/$UnivQ _)
- (|do [$var &type/existential
- exo-type** (&type/apply-type exo-type* $var)
- [[tuple-type tuple-cursor] tuple-analysis] (&&/cap-1 (analyse-tuple analyse (&/V &/$Right exo-type**) ?elems))]
- (return (&/|list (&&/|meta exo-type tuple-cursor
- tuple-analysis))))
-
- _
- (fail (str "[Analyser Error] Tuples require tuple-types: " (&type/show-type exo-type*)))
- )
- (fn [err]
- (fail (str err "\n" "[Analyser Error] Tuples require tuple-types: " (&type/show-type exo-type))))))))))
+ _
+ (analyse-tuple analyse (&/V &/$Right exo-type*) ?elems)))
+
+ (&/$Right exo-type)
+ (|do [unknown? (&type/unknown? exo-type)]
+ (if unknown?
+ (|do [=elems (&/map% #(|do [=analysis (&&/analyse-1+ analyse %)]
+ (return =analysis))
+ ?elems)
+ _ (&type/check exo-type (&/V &/$TupleT (&/|map &&/expr-type* =elems)))
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor
+ (&/V &&/$tuple =elems)
+ ))))
+ (|do [exo-type* (&type/actual-type exo-type)]
+ (&/with-attempt
+ (|case exo-type*
+ (&/$TupleT ?members)
+ (|do [=elems (&/map2% (fn [elem-t elem]
+ (&&/analyse-1 analyse elem-t elem))
+ ?members ?elems)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor
+ (&/V &&/$tuple =elems)
+ ))))
+
+ (&/$UnivQ _)
+ (|do [$var &type/existential
+ exo-type** (&type/apply-type exo-type* $var)
+ [[tuple-type tuple-cursor] tuple-analysis] (&&/cap-1 (analyse-tuple analyse (&/V &/$Right exo-type**) ?elems))]
+ (return (&/|list (&&/|meta exo-type tuple-cursor
+ tuple-analysis))))
+
+ _
+ (fail (str "[Analyser Error] Tuples require tuple-types: " (&type/show-type exo-type*)))
+ )
+ (fn [err]
+ (fail (str err "\n" "[Analyser Error] Tuples require tuple-types: " (&type/show-type exo-type)))))))))
+ ))
(defn ^:private analyse-variant-body [analyse exo-type ?values]
- (|do [output (&/with-attempt
+ (|do [_cursor &/cursor
+ output (&/with-attempt
(|case ?values
(&/$Nil)
- (analyse-tuple analyse (&/V &/$Right exo-type) &/Nil$)
+ (analyse-unit analyse exo-type)
(&/$Cons ?value (&/$Nil))
(analyse exo-type ?value)
@@ -169,7 +184,8 @@
(&/$VariantT ?cases)
(|case (&/|at idx ?cases)
(&/$Some vtype)
- (|do [=value (&/with-attempt
+ (|do [_cursor &/cursor
+ =value (&/with-attempt
(analyse-variant-body analyse vtype ?values)
(fn [err]
(|do [_exo-type (&type/deref+ exo-type)]
@@ -340,14 +356,7 @@
(|do [[real-name [?type ?meta ?value]] (&&module/find-def ?module ?name)]
(|case (&&meta/meta-get &&meta/macro?-tag ?meta)
(&/$Some _)
- (|do [macro-expansion (fn [state] (-> ?value (.apply ?args) (.apply state)))
- ;; :let [_ (when (or (= "import" (aget real-name 1))
- ;; (= "defsig" (aget real-name 1)))
- ;; (->> (&/|map &/show-ast macro-expansion)
- ;; (&/|interpose "\n")
- ;; (&/fold str "")
- ;; (prn (&/ident->text real-name))))]
- ]
+ (|do [macro-expansion (fn [state] (-> ?value (.apply ?args) (.apply state)))]
(&/flat-map% (partial analyse exo-type) macro-expansion))
_
@@ -359,8 +368,8 @@
(defn analyse-case [analyse exo-type ?value ?branches]
(|do [:let [num-branches (&/|length ?branches)]
- _ (&/assert! (> num-branches 0) "[Analyser Error] Can't have empty branches in \"case'\" expression.")
- _ (&/assert! (even? num-branches) "[Analyser Error] Unbalanced branches in \"case'\" expression.")
+ _ (&/assert! (> num-branches 0) "[Analyser Error] Can't have empty branches in \"case\" expression.")
+ _ (&/assert! (even? num-branches) "[Analyser Error] Unbalanced branches in \"case\" expression.")
=value (&&/analyse-1+ analyse ?value)
:let [var?? (|case =value
[_ (&&/$var =var-kind)]
diff --git a/src/lux/base.clj b/src/lux/base.clj
index ee5e728a1..e0517940a 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -45,6 +45,8 @@
;; Type
(deftags
["DataT"
+ "VoidT"
+ "UnitT"
"VariantT"
"TupleT"
"LambdaT"
@@ -183,7 +185,7 @@
(seq? pattern) (let [parts (mapv transform-pattern (rest pattern))]
(vec (cons (eval (first pattern))
(list (case (count parts)
- 0 '_
+ 0 nil
1 (first parts)
;; else
`[~@parts])))))
@@ -660,7 +662,7 @@
;; "lux;types"
+init-bindings+
;; "lux;expected"
- (V $VariantT Nil$)
+ (V $VoidT nil)
;; "lux;seed"
0
;; "lux;eval?"
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index 19af75dce..afa2d1bf9 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -53,7 +53,7 @@
char-class "java.lang.Character"]
(defn prepare-return! [^MethodVisitor *writer* *type*]
(|case *type*
- (&/$TupleT (&/$Nil))
+ (&/$UnitT)
(.visitInsn *writer* Opcodes/ACONST_NULL)
(&/$DataT "boolean" (&/$Nil))
diff --git a/src/lux/compiler/type.clj b/src/lux/compiler/type.clj
index 5b460858c..06aac90a0 100644
--- a/src/lux/compiler/type.clj
+++ b/src/lux/compiler/type.clj
@@ -61,6 +61,12 @@
(&/$DataT class params)
(variant$ &/$DataT (tuple$ (&/|list (text$ class)
(List$ (&/|map type->analysis params)))))
+
+ (&/$VoidT)
+ (variant$ &/$VoidT (tuple$ (&/|list)))
+
+ (&/$UnitT)
+ (variant$ &/$UnitT (tuple$ (&/|list)))
(&/$TupleT members)
(variant$ &/$TupleT (List$ (&/|map type->analysis members)))
diff --git a/src/lux/host.clj b/src/lux/host.clj
index e32a60065..3b0cc241d 100644
--- a/src/lux/host.clj
+++ b/src/lux/host.clj
@@ -63,7 +63,7 @@
(&/$LambdaT _ _)
(return (&host-generics/->type-signature function-class))
- (&/$TupleT (&/$Nil))
+ (&/$UnitT)
(return "V")
(&/$VariantT _)
diff --git a/src/lux/type.clj b/src/lux/type.clj
index b03558d38..8a43eeda6 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -36,8 +36,10 @@
(defn App$ [fun arg]
(&/V &/$AppT (&/T fun arg)))
(defn Tuple$ [members]
+ (assert (> (&/|length members) 0))
(&/V &/$TupleT members))
(defn Variant$ [members]
+ (assert (> (&/|length members) 0))
(&/V &/$VariantT members))
(defn Univ$ [env body]
(&/V &/$UnivQ (&/T env body)))
@@ -46,14 +48,13 @@
(defn Named$ [name type]
(&/V &/$NamedT (&/T name type)))
-
+(def $Void (&/V &/$VoidT nil))
+(def Unit (&/V &/$UnitT nil))
(def Bool (Named$ (&/T "lux" "Bool") (Data$ "java.lang.Boolean" &/Nil$)))
(def Int (Named$ (&/T "lux" "Int") (Data$ "java.lang.Long" &/Nil$)))
(def Real (Named$ (&/T "lux" "Real") (Data$ "java.lang.Double" &/Nil$)))
(def Char (Named$ (&/T "lux" "Char") (Data$ "java.lang.Character" &/Nil$)))
(def Text (Named$ (&/T "lux" "Text") (Data$ "java.lang.String" &/Nil$)))
-(def Unit (Named$ (&/T "lux" "Unit") (Tuple$ &/Nil$)))
-(def $Void (Named$ (&/T "lux" "Void") (Variant$ &/Nil$)))
(def Ident (Named$ (&/T "lux" "Ident") (Tuple$ (&/|list Text Text))))
(def IO
@@ -92,6 +93,10 @@
(Variant$ (&/|list
;; DataT
(Tuple$ (&/|list Text TypeList))
+ ;; VoidT
+ Unit
+ ;; UnitT
+ Unit
;; VariantT
TypeList
;; TupleT
@@ -254,7 +259,10 @@
(|case type
(&/$VarT ?id)
(if (.equals ^Object ?tid ?id)
- (deref ?id)
+ (|do [? (bound? ?id)]
+ (if ?
+ (deref ?id)
+ (return type)))
(return type))
(&/$LambdaT ?arg ?return)
@@ -319,6 +327,12 @@
_
(str "(^ " name " " (->> params (&/|map show-type) (&/|interpose " ") (&/fold str "")) ")"))
+
+ (&/$VoidT)
+ "Void"
+
+ (&/$UnitT)
+ "Unit"
(&/$TupleT elems)
(if (&/|empty? elems)
@@ -374,6 +388,12 @@
(= (&/|length xparams) (&/|length yparams))
(&/fold2 #(and %1 (type= %2 %3)) true xparams yparams))
+ [(&/$VoidT) (&/$VoidT)]
+ true
+
+ [(&/$UnitT) (&/$UnitT)]
+ true
+
[(&/$TupleT xelems) (&/$TupleT yelems)]
(&/fold2 (fn [old x y] (and old (type= x y)))
true
@@ -676,6 +696,12 @@
e!data
a!data)
+ [(&/$VoidT) (&/$VoidT)]
+ (return (&/T fixpoints nil))
+
+ [(&/$UnitT) (&/$UnitT)]
+ (return (&/T fixpoints nil))
+
[(&/$LambdaT eI eO) (&/$LambdaT aI aO)]
(|do [[fixpoints* _] (check* class-loader fixpoints invariant?? aI eI)]
(check* class-loader fixpoints* invariant?? eO aO))
@@ -688,9 +714,6 @@
e!members a!members)]
(return (&/T fixpoints* nil)))
- [_ (&/$VariantT (&/$Nil))]
- (return (&/T fixpoints nil))
-
[(&/$VariantT e!cases) (&/$VariantT a!cases)]
(|do [fixpoints* (&/fold2% (fn [fp e a]
(|do [[fp* _] (check* class-loader fp invariant?? e a)]
diff --git a/src/lux/type/host.clj b/src/lux/type/host.clj
index b03fd9828..b83c74a60 100644
--- a/src/lux/type/host.clj
+++ b/src/lux/type/host.clj
@@ -64,7 +64,7 @@
;; [Exports]
(let [class-name-re #"((\[+)L([\.a-zA-Z0-9]+);|([\.a-zA-Z0-9]+)|(\[+)([ZBSIJFDC]))"
- Unit (&/V &/$TupleT (&/|list))
+ Unit (&/V &/$UnitT nil)
jprim->lprim (fn [prim]
(case prim
"Z" "boolean"
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-09 19:56:11 +0000